Listing of file='@FORMAT' on disk='vmedia/734-8446-A.wvd.zip'
# Sector 2471, program filename = '@FORMAT' 0010 % @FORMAT 03/20/90 -- (c) Copr. Wang Laboratories, Inc. 1986 0020 % (c) Copr. Wang Laboratories, Inc. 1986 0030 % -------------------------------------- 0040 % Program Name = @FORMAT 0050 % Author = Steve McGarry 0060 % Date Written = 22 April 1986 0070 % Last Revised = 20 March 1990 (TBO) 0080 % -------------------------------------- 0090 % 0095 DIM A1$3,A2$1,S$3,Q$1 0100 REM %VARIABLE DEFINITIONS 0110 DIM V$8 : V$="01.05.00" : REM - VERSION NUMBER 0120 DIM D$3,K,P$1 : REM - DEVICE/PLATTER ADDRESS VARIABLES 0130 DIM E$(40)1,G$(15)1 : REM - STATUS/$GIO VARIABLES 0160 DIM K$1 : REM - KEYIN BYTE 0170 DIM M$40 : REM - MESSAGE ('201) 0180 DIM M : REM - ERROR HANDLER WORK VARIABLE 0190 DIM I0$(1)80,I0$1,I1$80,I0,I1,I2,I3 : REM - VARIABLES FOR ACCEPTING A FIELD 0200 DIM I,J,J0 : REM - LOOP INDEXES 0210 DIM N : REM - GENERAL WORK VARIABLE 0220 DIM M2,C,R : REM - DISK MENU VARIABLES ('210) 0230 DIM D,D1 : REM - DISK SIZE, DESCRIPTION NUMBER ('222) 0240 DIM D0$3 : REM - "OTHER" DISK ADDRESS 0250 DIM S$(128)2 : REM - INDEX SECTOR BUFFER 0260 DIM V$(3)5 : REM - INDEX SECTOR DATA CONVERSION VARIABLES 0270 DIM V1,V3 : REM - INDEX INFORMATION VALUES 0280 DIM G1$17,E1$32,P$1,G1$(32)3,B$3,G2$1 : P$=HEX(10) : REM VARIABLES FOR GETTING DISK STATUS 0290 DIM D$(32)4,K1$80,T$1,D$3,D2$2 : DIM G$40,E$40 : DIM G$(15)1 0300 REM %^.Initialize everything : REM %.1st display 0510 SELECT PRINT /005(80) : PRINT HEX(020D0C030F) 0520 $CLOSE#1 : PRINT HEX(03060E);TAB(15);"SOFTWARE FORMATTABLE DISK PLATTER FORMAT UTILI TY" : PRINT TAB(20);"(c) Copr. Wang Laboratories, Inc. 1990" : PRINT TAB(31);"Release ";V$ 0540 PRINT AT(22,52);"RETURN - Proceed";AT(23,52);"FN/TAB - Previous Menu";HEX (01) 0560 REM %Get Disk Address 0565 PRINT AT(4,0);HEX(020402040F);"Enter platter address: ";HEX(0E);D0$;HEX(0 20402000F) 0570 F=0 : PRINT AT(4,22); : LINPUT HEX(0E),-D0$ 0572 GOSUB '201(" ") 0580 A1$=D0$ : $TRAN(A1$,"BbDd")R : B$=A1$ : GOSUB '100(A1$) : IF Q$=" "THEN 610 0585 GOSUB '201("Platter address must be 3 hex digits") : PRINT HEX(07) : GOTO 570 0600 REM %.Show Platter information : REM .Unhog disk and show 2nd screen 0610 $CLOSE#1 : PRINT HEX(03060E);TAB(15);"SOFTWARE FORMATTABLE DISK PLATTER FORMAT UTILI TY" : PRINT TAB(30);"Platter Information" : PRINT AT(4,0);"Platter address = ";D0$, : M2=-1 : A2$="1" : IF A1$="D10"OR A1$="D20"OR A1$="D30"THEN 615 : GOTO 620 0615 GOSUB 5040 : ON T+1GOTO 565,565,565 : A$="360 KB" : IF VAL(STR(E$,6,3),3)=4160THEN A$="1.2 mB" : PRINT AT(5,0,80);HEX(0E);STR(A$,,LEN(A$));" Floppy Drive. Please Select" : PRINT " [1] CS/2200 format" : PRINT " [2] DOS format" : LINPUT " "-A2$ : PRINT HEX(06); 0620 PRINT AT(9,0);HEX(0E);"Mount disk to be formatted and press RETURN:"; : REM - PROMPT 0625 GOSUB '201(M$) : REM - DISPLAY MESSAGE (IF ANY) 0630 PRINT AT(22,52);"RETURN - Proceed";AT(23,52);"FN/TAB - Previous Screen";H EX(01) 0650 F=1 : KEYIN K$ : IF K$=HEX(7E)OR K$=HEX(7F)THEN 1880 : IF K$<>HEX(0D)THEN 650 0700 REM %GET & DISPLAY INDEX INFORMATION (IF INDEX SECTORS > 0) 0705 IF A2$="2"THEN 795 0710 IF M2=-1THEN SELECT #1<A1$> : ERRORGOSUB '255 : GOTO 610 : REM - SELECT DISK hhh 0725 V$(1)="24" : V$(2)=" " : V$(3)="0" : REM - INITIALIZE THE INDEX INFORMATION FIELDS : X=0 0730 $OPEN 732,#1 : ERRORGOSUB '255 : GOTO 610 : REM - "HOG" THE DISK 0731 GOTO 740 : REM - SKIP THE "CAN'T $OPEN" MESSAGE 0732 M$="Drive Already In Use or Not Ready" : PRINT HEX(07) : GOTO 610 : REM - DISPLAY MESSAGE IF CAN'T $OPEN DRIVE 0740 IF D0$="340"THEN 760 : G$(11)=HEX(FF) : $GIOGETDISKTYPE#1(0200030F12220600070070A04000870B,G$()) : REM - GET THE DRIVE TYPE (DPU TYPE) 0750 IF STR(G$(),6,3)=HEX(000000)THEN 752 : M$="Drive Not Responding" : PRINT HEX(07) : GOTO 610 0752 IF G$(11)=HEX(D0)THEN 760 : IF G$(11)=HEX(C0)THEN 760 : IF G$(11)=HEX(FF)THEN PRINT AT(6,0,80);"No disk controller at address" : GOTO 565 0760 DATA LOAD BA T#1,(0)S$() : ERRORGOSUB '255 : IF M<>93THEN 610 : M$=" " : GOTO 800 : REM - GET FIRST INDEX SECTOR. FORMAT DISK IF FORMAT ERROR. REPORT ALL O THER ERRORS 0765 IF STR(S$(),2,1)=HEX(00)THEN 800 : REM - IF INDEX SECTORS = 00000, FORMAT IT 0770 FOR I=1TO 3 : IF I=1THEN CONVERT VAL(STR(S$(I),2,1))TO V$(I),(#####) : ELSE CONVERT VAL(S$(I),2)-1TO V$(I),(#####) : IF V$(I)="00000"THEN V$(I)="0" : ELSE V$(I)=STR(V$(I),POS(V$(I)<>"0")) : NEXT I : REM - CHANGE THE 2-BYTE VALUES TO STRINGS 0775 PRINT AT(13,27);"\C3\F5\F2\F2\E5\EE\F4\A0\C9\EE\E4\E5\F8\A0\C9\EE\E6\EF\F 2\ED\E1\F4\E9\EF\EE";AT(15,29);"Index Sectors = ";V$(1);AT(16,29);"End Ca t. Area = ";V$(3);AT(17,29);"Current End = ";V$(2) : REM - SHOW HIM THE CURRENT INDEX 0776 IF STR(S$(),,1)<>HEX(00)THEN PRINT AT(15,51);"'" 0780 PRINT HEX(07) : GOSUB '201("Are you sure (Y/N)?") : M$=" " : GOSUB '204 : IF K$="N"THEN 610 : REM - GIVE HIM THE FINAL WARNING 0795 REM %TRASH THE SUCKER! 0800 M$=HEX(020404000E)&"(Formatting)"&HEX(020400000E) : GOSUB '201(M$) : REM - TELL HIM THE NASTY THINGS WE'RE DOING 0810 IF A2$="2"THEN 812 : $FORMATDISK T#1 : ERRORGOSUB '255 : GOTO 610 : REM - FINALLY! FORMAT THE DISK 0811 GOTO 820 0812 REM ! PC FORMAT : SELECT #1<A1$> : G$=ALL(20) : $GIO#1(0600070070A0400288D0704001306A10680240018B67,G$) 0813 IF STR(G$,6,3)=HEX(000000)THEN 815 0814 IF STR(G$,6,3)<>HEX(000000)THEN DO : PRINT HEX(07); : M$=HEX(0204020E)&"Disk Error - Press any Key "&HEX(0F) : GOSUB '201(M$) : KEYIN K$ : M$=ALL(" ") : END DO : GOTO 610 0815 GOTO 510 0820 GOSUB '201("Format Completed") : REM - WE MADE IT! 0822 F=2 0825 REM %GET NEW INDEX PARAMETERS & SCRATCH THE DISK 0830 PRINT AT(6,0,80);HEX(0E);"Enter new index information and press RUN:" : REM - CHANGE THE PROMPT 0835 IF STR(S$(),,1)=HEX(01)THEN V$(2)="NEW" : ELSE V$(2)="OLD" : REM - INITIALIZE THE STRUCTURE FIELD 0840 PRINT AT(13,0,400);HEX(020402040F);AT(13,29);"\CE\E5\F7\A0\C9\EE\E4\E5\F8 \A0\C9\EE\E6\EF\F2\ED\E1\F4\E9\EF\EE";AT(15,29);"Index Sectors = ";HEX(0E );STR(V$(1));HEX(0F);AT(16,29);"End Cat. Area = ";HEX(0E);STR(V$(3));HEX( 0F);AT(17,29);"Structure = ";HEX(0E);STR(V$(2),,3);HEX(020402000F);" (OLD or NEW)" : REM - DISPLAY THE FIELDS 0845 PRINT AT(21,52);"RETURN - Next Field";AT(22,52);"RUN - Accept paramete rs" : REM - ADDITIONAL KEY DEFINITIONS 0850 K0=1 : REM - RESET FIELD COUNTER 0855 ON K0GOSUB 875,880,885 : REM - PROCESS THE CURRENT FIELD 0858 GOSUB '201(" ") : REM - ERASE THE MESSAGE (IF ANY) 0860 ON POS(HEX(827E7F)=K$)GOTO 900,520,520 : REM - RUN , FN / TAB 0865 K0=K0+1 : IF K0>3THEN K0=1 : GOTO 855 : REM - RETURN PRESSED, ADVANCE TO NEXT FIELD 0875 GOSUB '202(15,45,V$(1),5,"#",HEX(7F7E)) : V$(1)=I0$(1) : RETURN : REM - ACCEPT INDEX SECTORS 0880 GOSUB '202(16,45,V$(3),5,"#",HEX(7F7E)) : V$(3)=I0$(1) : RETURN : REM - ACCEPT END OF CATALOGED AREA 0885 GOSUB '202(17,45,V$(2),3,"A",HEX(7F7E)) : V$(2)=I0$(1) : $TRAN(V$(2),"AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz")R : IF V$(2)="OLD"OR V$(2)="NEW"THEN RETURN : GOSUB '201("Index Structure Must be 'OLD' or 'NEW'") : PRINT HEX(07) : GOTO 885 : REM - ACCEPT INDEX STRUCTURE 0900 GOSUB '201("(Creating Disk Index)") : REM - TELL HIM WHAT WE'RE UP TO 0910 CONVERT V$(1)TO V1 : ERRORPRINT HEX(07) : GOSUB '201("Index Sectors may not be blank") : GOTO 850 : REM - CHANGE INDEX SECTORS INTO A NUMERIC VALUE 0912 IF V1>=1AND V1<=255THEN 915 : PRINT HEX(07) : GOSUB '201("Index Sectors must be from 1 to 255") : GOTO 850 : REM - VALIDATE INDEX SECTORS VALUE 0915 CONVERT V$(3)TO V3 : ERRORPRINT HEX(07) : GOSUB '201("End Cat. Area may not be blank") : GOTO 850 : REM - CHANGE END OF CATALOGED AREA INTO A NUMERIC VALUE 0917 IF V1<=V3THEN 920 : PRINT HEX(07) : GOSUB '201("End Cat. Area less than Index Sectors") : GOTO 850 0920 IF V$(2)="OLD"THEN SCRATCH DISK T#1,LS=V1,END =V3 : ERRORGOSUB '255 : GOSUB '201(M$) : GOTO 850 : REM - BUILD THE OLD INDEX STRUCTURE & HANDLE ERROR 0930 IF V$(2)="NEW"THEN SCRATCH DISK 'T#1,LS=V1,END =V3 : ERRORGOSUB '255 : GOSUB '201(M$) : GOTO 850 : REM - BUILD THE NEW INDEX STRUCTURE & HANDLE ERROR 0940 GOSUB '201("Index Created - Press Any Key to Exit") : PRINT HEX(07) : KEYIN K$ : REM - LET HIM KNOW WE'RE FINISHED 0999 $CLOSE#1 : GOTO 520 : REM - FORMAT/SCRATCH COMPLETED. "UNHOG" THE DISK & GO TO THE DISK ADDRES S MENU 1870 DEFFN'126 1880 DEFFN'127 : GOSUB '201("FN/TAB keyed") 1890 IF F=1THEN 510 2000 COM CLEAR : GOSUB '201("(Returning to System Menu)") : $PSTAT=" " : LOAD DC T"@MENU" : END : REM - THAT'S ALL SHE WROTE 5025 DEFFN'100(S$) : IF S$="340"THEN 5035 : $TRAN(S$,"AaBbCcDdEeFf")R : IF POS("DB3"=S$)>0AND POS("123567"=STR(S$,2))>0AND VER(STR(S$,3),"H")>0TH EN 5030 : Q$="I" : RETURN 5030 IF POS("3B"=S$)=0OR POS("123"=STR(S$,2))=0OR STR(S$,3)<>"0"THEN 5035 : IF STR(S$,,1)="3"THEN STR(S$,3)="1" : STR(S$,,1)="D" 5035 Q$=" " : RETURN 5040 REM %^.Get disk status 5050 A$=ALL(20) : STR(B$,2,1)=STR(B$,2,1)AND HEX(33) : SELECT #2<B$> 5080 $GIOGETDISKTYPE#2(0200030F12220600070070A04000870B,G$()) 5090 T$=G$(11) : T=POS(HEX(C0D0)=T$) : IF T=0THEN 5140 : IF T=2THEN GOSUB 5150 5100 ON TGOSUB 5260,5250,5240,5230 : PRINT K1$ 5110 D$=D$(1) 5130 RETURN 5140 PRINT "Unknown disk type check connector" : D$()=" " : RETURN 5150 REM %^.Check for DS cabinet 5160 G$=HEX(30) : STR(G$,2,7)=ALL(00) : $GIOSTATUSREQUEST#2(0E140F0012E20600070070A0400288D070406A106816400087051 A00C340,G$)G$;STR(E$,,VAL(STR(G$,5,1))) 5170 T=VAL(E$)-47 5180 G1$=STR(G$,8,1)AND HEX(10) : IF G1$=HEX(00)THEN 5190 : K1$="Disk unavailable" : RETURN 5190 IF STR(G$,8,1)<>HEX(00)THEN 5200 : IF STR(E$,1,1)=HEX(33)THEN 5220 : IF I=32AND STR(E$,1,2)=HEX(4533)THEN 5210 5200 REM "specified disk is not a DS" : RETURN 5210 STR(E$,1,2)=HEX(3345) 5220 RETURN 5230 K1$="DS cabinet" : RETURN 5240 K1$="2275 type" : RETURN 5250 K1$="Phoenix type" : RETURN 5260 K1$="2270 type" : RETURN 6000 REM % GET DISK STATUS 7000 DEFFN'201(M$) : REM % DISPLAY M$ IN LOWER LEFT CORNER OF THE DISPLAY 7010 PRINT AT(23,0,33);HEX(0E);STR(M$);HEX(01) : REM - DISPLAY MESSAGE 7020 RETURN 7030 DEFFN'202(I1,I2,I0$(1),I3,I0$,I1$) : REM % ACCEPT FIELD (I1,I2=ROW,COL I0$(1)=DATA I3=LEN I0$=VER MASK I1$=EXI T SFKEYS) 7040 MAT REDIM I0$(1)I3 : REM - CHANGE LENGTH OF FIELD TO LENGTH SPECIFIED 7050 PRINT HEX(020402040E) : REM - SET ATTRIBUTES TO BRIGHT/UNDERSCORE 7060 I0=1 : REM - INITIALIZE CURSOR POSITION 7070 PRINT HEX(06);AT(I1,I2);STR(I0$(1)) : REM - DISPLAY THE FIELD 7080 PRINT AT(I1,I2+I0-1);HEX(02050F); : REM - POSITION CURSOR 7090 KEYIN K$,,7200 : REM - WAIT FOR A KEY. BRANCH IF SF KEY PRESSED 7100 PRINT HEX(06); : REM - "NORMAL" KEY PRESSED; SHUT OFF THE CURSOR 7110 ON POS(HEX(20080D82)=K$)GOTO 7130,7150,7180,7190 : REM - BRANCH IF SPACE, BACKSPACE, RETURN OR RUN/EXEC 7120 IF VER(K$,I0$)<>1THEN 7080 : REM - IF NOT A VALID KEY, WAIT FOR ANOTHER 7130 IF I0$=HEX(00)THEN 7080 : STR(I0$(1),I0,1)=K$ : PRINT K$; : REM - IF ACCEPTING CHARACTERS, PUT THE CHARACTER INTO THE FIELD & PRINT I T 7140 IF I0<I3THEN I0=I0+1 : GOTO 7080 : REM - INCREMENT CURSOR POSITION & UPDATE IT 7150 IF I0=1THEN 7080 : REM - BACKSPACE PRESSED; GET ANOTHER KEY IF AT LEFTMOST COLUMN 7160 IF I0<I3OR STR(I0$(1),I0,1)=" "THEN I0=I0-1 : REM - DON'T DECREMENT CURSOR POSITION IF AT RIGHTMOST POSITION & IT'S NON -BLANK 7170 STR(I0$(1),I0,1)=" " : GOTO 7070 : REM - REMOVE THE CHARACTER & UPDATE THE CRT 7180 K$=HEX(20) : GOTO 7280 : REM - RETURN PRESSED; TRANSLATE IT TO HEX(20) & EXIT 7190 GOTO 7280 : REM - RUN/EXEC PRESSED; EXIT 7200 PRINT HEX(06); : REM - SF KEY PRESSED; SHUT OFF THE CURSOR 7210 IF POS(I1$=K$)<>0THEN 7280 : REM - IF AN EXIT KEY, EXIT 7220 IF I0$<>HEX(00)THEN ON POS(HEX(48494A4C4D)=K$)GOTO 7230,7240,7250,7260,72 70 : GOTO 7080 : REM - IF MODIFIABLE, BRANCH TO ERASE, DELETE, INSERT, RIGHT OR LEFT 7230 STR(I0$(1),I0)=" " : GOTO 7070 : REM - ERASE PRESSED; DO IT & UPDATE THE CRT 7240 IF I0<I3THEN STR(I0$(1),I0)=STR(I0$(1),I0+1) : STR(I0$(1),I3,1)=" " : GOTO 7070 : REM - DELETE PRESSED; DO IT & UPDATE THE CRT 7250 IF I0<I3THEN MAT COPY -STR(I0$(1),I0,I3-I0)TO -STR(I0$(1),I0+1) : STR(I0$(1),I0,1)=" " : GOTO 7070 : REM - INSERT PRESSED; DO IT & UPDATE THE CRT 7260 IF I0<I3THEN I0=I0+1 : GOTO 7070 : REM - RIGHT PRESSED; MOVE CURSOR & REPOSITION IT 7270 IF I0>1THEN I0=I0-1 : GOTO 7070 : REM - LEFT PRESSED; MOVE CURSOR & REPOSITION IT 7280 PRINT HEX(020402000F) : REM - SET THE ATTRIBUTES TO BRIGHT (NORMAL) 7290 MAT REDIM I0$(1)80 : REM - RESET THE FIELD LENGTH TO ITS MAXIMUM 7300 RETURN 7310 DEFFN'204 : REM % RETURN K$ = "Y" or "N" 7320 KEYIN K$ 7325 IF K$=HEX(7E)OR K$=HEX(7F)THEN K$="N" 7330 $TRAN(K$,"YyNn")R : IF K$<>"Y"AND K$<>"N"THEN 7320 7340 RETURN 9000 DEFFN'255 : REM % ERROR HANDLER (SETS M$=ERROR DESCRIPTION & BEEPS) 9005 M=ERR : REM - GET THE ERROR NUMBER 9010 M$=" " : REM - INITIALIZE MESSAGE 9015 IF M<90THEN 9025 : RESTORE LINE9020,M-89 : READ M$ : REM - GET MESSAGE IF DISK ERROR 9020 DATA "Disk Hardware Error","Disk Drive Not Ready","Disk Drive Time-Out"," Disk Format Error","Disk Format Key Engaged" : REM - DISK ERRORS 9021 DATA "Disk Seek Error or Platter Protected","Disk CRC Error","Disk LRC Er ror","Bad Sector Address/Platter Not Mounted","Verify Error" : REM - DISK ERRORS (CONT.) 9025 IF M=48THEN M$="Illegal Device Specification" 9030 IF M$<>" "THEN 9040 : M$="Unexpected Error ### Occurred" : CONVERT MTO STR(M$,18,3),(###) : REM - CATCH-ALL 9040 PRINT HEX(07) : RETURN