image of READY prompt

Wang2200.org

Listing of file='3741102A' on disk='vmedia/3741_util.wvd.zip'

# Sector 225, program filename = '3741102A'
0010 REM 3741102A 02.00(12/1/78),THIS PROGRAM IS A PRODUCT OF WANG LABS. INC.
     1978
3000 % THIS MUST BE STATEMENT 3000
3020 DIM X$(4)62,X0$(1)1,Y$(4)64,F1$17,A$18,C1$(4)64,H1$64,N$64,E$(4)64,E6$(1)
     2,E4$1,E5$1
3040 DEFFN1(E2)=E2*(VAL(STR(E$(1),5,1))*256+VAL(STR(E$(1),6,1))-(VAL(STR(E$(1)
     ,3,1))*256+VAL(STR(E$(1),4,1))))
3060 DEFFN'15
3070 PRINT HEX(03);,"CONVERT 5110 TO TC FORMAT FILE"
   : PRINT "MOUNT DISK PLATTERS."
   : GOSUB '254
   : PRINT HEX(03);,"CONVERT 5110 FILE TO TC FORMAT"
   : GOSUB '200("1","2",1,0,"ENTER MODE (1-ALL OR 2-ONE FILE)",1)
   : C=Q9
3150 GOSUB '248(8,10,0)
   : IF C=1THEN 3210
   : C$="MODE - ONE FILE"
   : PRINT C$
   : GOTO 3300
3210 C$="MODE - ALL"
   : PRINT C$
   : STR(H1$,1,3)=HEX(0D0C0E)
   : STR(H1$,4,18)="CONVERT 5110 TO TC"
   : STR(H1$,22,3)=HEX(0D0A0E)
   : STR(H1$,25)="INPUT NAME           OUTPUT NAME"
   : GOSUB '50(H1$)
3300 GOSUB '200("1","2",1,0,"ENTER OPTION (1-TRANSLATE; 2-LEAVE IN EBCDIC)",1)
   : A=Q9
   : IF A=1THEN 3350
   : A$="LEAVE IN EBCDIC"
   : GOTO 3370
3350 A$="TRANSLATE TO ASCII"
3370 GOSUB '248(9,10,0)
   : PRINT "OPTION - ";A$
   : GOSUB '248(1,0,3)
   : IF C=2THEN 3500
   : C1=16389
3450 GOSUB '91(C1)
   : IF C1-16384>=27THEN 4660
   : GOTO 3720
3500 GOSUB '200(" "," ",17,0,"ENTER THE INPUT FILE NAME",2)
   : F1$=Q6$
   : GOSUB '186(F1$)
   : IF Z3-Z1>0THEN 3560
   : GOSUB '255
   : GOTO 3500
3560 IF STR(Z0$(2),32,7)="IBM5100"THEN 3590
   : PRINT HEX(010A0A0A07);"ERROR - IMPROPER FILE TYPE"
   : GOTO 3500
3590 IF Q$=" "THEN 3640
   : PRINT HEX(010A0A0A07);"ERROR - FILE DOES NOT EXIST"
   : GOTO 3500
3640 GOSUB '200(" "," ",8,0,"ENTER THE OUTPUT FILE NAME",2)
   : Y$=Q6$
   : GOSUB '229(5,Y$)
   : IF R=0THEN 3720
   : PRINT HEX(010A0A0A07);"ERROR - FILE ALREADY EXISTS."
   : GOTO 3640
3720 GOSUB '248(10,10,1)
   : PRINT "INPUT FILE NAME - ";F1$;TAB(17-LEN(F1$))
   : GOSUB '248(11,10,1)
   : PRINT "OUTPUT FILE NAME - ";Y$;TAB(8-LEN(Y$))
   : K,X,E7,E8,Y=0
   : E9=Z1
3820 GOSUB '75
   : IF FN1(1)>=3THEN 3910
   : GOSUB '248(1,0,3)
   : PRINT "AVAILABLE SECTORS - ";FN1(1);"MINIMUM # OF SECTORS REQUIRED - 3";
   : GOSUB '254
   : GOTO 3820
3910 GOSUB '248(1,0,3)
3920 IF E9=Z3THEN 4570
   : E7=0
   : IF A=1THEN 3990
   : E4$=HEX(15)
   : GOSUB '197
   : GOTO 4010
3990 E4$=HEX(FC)
   : GOSUB '181
4010 E9=E9+1
   : IF Q$<>HEX(20)THEN 4570
4050 MAT SEARCHZ$(),=E4$TO E6$()
   : IF STR(Z$(1),1,1)=HEX(1E)THEN 4570
   : IF E6$(1)<>HEX(0000)THEN 4330
   : IF K>=2THEN 4230
   : IF E9<Z1+1THEN 4230
   : GOSUB '50(HEX(0D0A))
   : GOSUB '50(F1$)
   : GOSUB '50(" IS NOT A 5110 PROGRAM")
   : IF C=2THEN 4660
   : GOTO 3450
4230 Y=128-E7
   : E5=Y
   : IF Z$(1)=HEX(20)THEN 3920
   : MAT COPY Z$()<1,Y>TO Y$()<E8+1,Y>
   : E8=E8+Y
   : GOTO 3920
4330 Y=VAL(E6$(1))*256+VAL(STR(E6$(1),2,1))-1
   : MAT COPY Z$()<1,Y>TO Y$()<E8+1,Y>
   : E8=E8+Y
   : E7=E7+Y+1
   : MAT COPY Z$()<Y+2,128-E7>TO Z$()
   : K=K+1
   : PRINT HEX(010A0A0A0A0A0A);"CONVERTING STMT - ";K
   : IF X=0THEN 4840
   : IF X+E8>248THEN 4910
4440 Y=Y+E5
   : BIN(X0$(1))=Y
   : MAT COPY X0$()<1,1>TO X$()<X,1>
   : MAT COPY Y$()TO X$()<X+1,Y>
   : X=X+Y+1
   : E5=0
   : BIN(STR(X$(1),2,1))=X
   : INIT(20)Y$()
   : E8=0
   : GOTO 4050
4570 STR(X$(1),1,1)=HEX(F0)
   : DATA SAVE DC #5,X$()
   : DATA SAVE DC #5,END
   : GOSUB '227(5,Y$,0)
   : GOSUB '188
   : IF C=2THEN 4660
   : GOTO 3450
4660 PRINT HEX(03);"CONVERT 5110 TO TC FILE FORMAT"
4670 GOSUB '200(" "," ",1,0,"DO YOU WANT TO RERUN THIS PROGRAM? (Y/N)",2)
   : IF Q6$="Y"THEN 3070
   : IF Q6$="N"THEN 4740
   : GOSUB '255
   : GOTO 4670
4740 DEFFN'31
   : GOSUB '229(1,"3741020A")
   : IF R=1THEN 4800
   : PRINT HEX(030A);"MOUNT SYSTEM DISK"
   : GOSUB '254
   : GOTO 4740
4800 PRINT HEX(03);"SYSTEM NOW LOADING - SYSTEM MENU"
   : LOAD DC T#1,"3741020A"3000,6990
4840 GOSUB '228(5,Y$,1)
4850 INIT(20)X$()
   : X$(1)=HEX(0003)
   : X=3
   : GOTO 4440
4910 DATA SAVE DC #5,X$()
   : GOSUB '92
   : GOTO 4850
4960 DEFFN'91(C1)
4970 C1=C1+1
   : IF C1-16384<27THEN 5020
   : RETURN
5020 Z0=C1-16384
   : GOSUB '199
   : C1$(1)=Z0$(1)
   : C1$(3)=Z0$(3)
   : F1$=STR(C1$(1),6,17)
   : GOSUB '186(F1$)
   : IF STR(C1$(1),1,3)<>"HDR"THEN 4970
   : IF STR(C1$(3),1,1)=HEX(F8)THEN 4970
   : IF Q$<>" "THEN 4970
   : IF STR(Z0$(2),32,7)="IBM5100"THEN 5200
   : GOTO 5230
5200 IF Z3-Z1>0THEN 5370
5230 GOSUB '50(HEX(0D0A))
   : GOSUB '50(F1$)
   : GOSUB '50(" IS NOT A 5110 FILE")
   : GOTO 4970
5290 INIT(20)N$
   : STR(N$,1,2)=HEX(0D0A)
   : STR(N$,3,22)=F1$
   : STR(N$,24)=" CANNOT BE CONVERTED TO 'EOD'"
   : GOSUB '50(N$)
   : GOTO 4970
5370 IF LEN(F1$)<=8THEN 5400
   : Y$=STR(F1$,1,8)
   : GOTO 5420
5400 Y$=F1$
5420 GOSUB '40
   : RETURN
5460 DEFFN'40
   : N0=0
5490 GOSUB '229(5,Y$)
   : IF R<>0THEN 5610
   : INIT(20)N$
   : STR(N$,1,2)=HEX(0D0A)
   : STR(N$,3)=F1$
   : STR(N$,46)=Y$
   : GOSUB '50(N$)
   : RETURN
5610 N0=N0+1
   : CONVERT N0TO STR(Y$,7,2),(##)
   : GOTO 5490
5660 DEFFN'92
   : LIMITS T#5,O7,O8,O9
   : IF O9=O8-1THEN 5730
   : RETURN
5730 DBACKSPACE #5,1S
   : STR(X$(1),1,1)=HEX(F0)
   : DATA SAVE DC #5,X$()
   : DATA SAVE DC #5,END
   : GOSUB '248(1,0,3)
   : PRINT "MOUNT PLATTER TO CONTAIN NEXT VOLUME OF OUTPUT FILE"
   : GOSUB '254
5820 GOSUB '75
   : IF FN1(1)>=3THEN 5900
   : GOSUB '248(1,0,3)
   : PRINT "AVAILABLE SECTORS - ";FN1(1);" MINIMUM # OF SECTORS REQUIRED - 3";
   : GOSUB '254
   : GOTO 5820
5900 GOSUB '248(1,0,3)
   : GOSUB '228(5,Y$,1)
   : RETURN
5950 DEFFN'75
   : DATA LOAD BA T#5,(0,E)E$()
   : AND (STR(E$(1),3,1),7F)
   : AND (STR(E$(1),5,1),7F)
   : RETURN