Listing of file='TPUT010A' on disk='vmedia/733-1004.wvd.zip'
# Sector 29, program filename = 'TPUT010A' 0012 REM . TPUT010A, 00-01 (05/11/78), 10189A : COM Q6$64,W3$6,W4$1,W5$5,W8$1,W9$1,B$10,T$(4)64,T1$(8)32,L$(6)40,L9$(80)1 ,Z$1,V0$1,V1$1,O1$1,O$1,T,A2$40,Z0$64,Z1$64,S9,B1$10 0025 DIM C$(2)40 : INIT(".")T$() : T$(1)=HEX(000102032E092E7F2E2E2E0B0C0D0E0F101112132E2E082E18192E2E1C1D1E1 F2E2E2E2E2E0A171B2E2E2E2E2E0506072E2E162E2E2E2E042E2E2E2E14152E1A) 0040 T$(2)=" ...........<(+!&.........!$*);.-/.........,%.>?..........:#@'=" : STR(T$(2),64)=HEX(22) : STR(T$(2),11,1)=HEX(5B) : STR(T$(2),16,1)=HEX(C7) : STR(T$(2),43,1)=HEX(7C) : STR(T$(2),46,1)=HEX(5F) 0070 STR(T$(2),32,1)=HEX(5E) : STR(T$(2),58,1)=HEX(60) : STR(T$(3),1,42)=".abcdefghi.......jklmnopqr....... stuvwxyz" : STR(T$(3),34,1)=HEX(7E) 0090 T$(4)=".ABCDEFGHI.......JKLMNOPQR........STUVWXYZ......0123456789......" : STR(T$(4),1,1)=HEX(7B) : STR(T$(4),17,1)=HEX(7D) : STR(T$(4),33,1)=HEX(5C) 0110 INIT(2E)T1$() : T1$(1)=HEX(000102032E2D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E 1F) : T1$(2)=HEX(405A7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E 6F) 0120 T1$(3)=HEX(7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E94AE02E5F 6D) : T1$(4)=HEX(79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C06AD0A1 07) : STR(T1$(7),8,1)=HEX(4F) 0130 INIT(20)A2$ : PRINT HEX(03);"2209A UTILITY LOADER ROUTINE" : PRINT "ENTER THE NUMBER TO CHOOSE THE OPTION" : PRINT HEX(0A0A); : PRINT "-----------------------------------------" 0155 PRINT " 1. INITIALIZE /REWRITE VOLUME LABEL" : PRINT " 2. WRITE DATA ON TAPE" : PRINT " 3. READ DATA FROM TAPE" : PRINT " 4. TAPE TO DISK DATA TRANSFER" : PRINT " 5. DISK TO TAPE DATA TRANSFER" 0180 PRINT " 6. CARD READER TO TAPE DATA TRANSFER" : PRINT " 7. DUMP THE TAPE CONTENTS" : PRINT " 8. END OF PROCESS" : PRINT HEX(010A0A); 0200 INPUT W3$ : IF LEN(W3$)>1THEN 240 : O1$=STR(W3$,1,1) : IF O1$<>"8"THEN 230 0220 PRINT HEX(030A0A);TAB(12);"END OF PROCESS" : STOP 0230 IF O1$>HEX(38)THEN 240 : IF O1$>=HEX(31)THEN 255 0240 PRINT HEX(010A0A0A);"RE-ENTER" : GOSUB '248(2,0,1) : GOTO 200 0255 IF O1$<>"1"THEN 270 0260 GOSUB 9420 : LOAD DC T"TPUT020A"12,1040 0270 IF O1$<>"5"THEN 285 0275 GOSUB 9420 : LOAD DC T"TPUT050A"12,9499 0285 IF O1$<>"6"THEN 300 0290 GOSUB 9420 : LOAD DC T"TPUT060A"12,9499 0300 GOSUB '248(1,0,12) : PRINT HEX(0A0A0A);" '''''''''''''''''" : PRINT " ' I = IBM LABEL '" : PRINT " ' A = ANSI LABEL '" : PRINT " ' N = NO LABEL '" : PRINT " '.................'" 0330 GOSUB '243("ENTER THE VOLUME LABEL TYPE (I/A/N)",1) : V0$=Q6$ : T=0 : IF Q6$="I"THEN 400 : IF Q6$="N"THEN 370 : IF Q6$="A"THEN 410 : GOSUB 9854 : GOTO 330 0370 GOSUB '248(1,0,8) 0375 GOSUB '243("ENTER THE DATA TYPE (E=EBCDIC,A=ASCII)",1) : IF Q6$="A"THEN 1000 : IF Q6$="E"THEN 400 : GOSUB 9854 : GOTO 375 0400 T=1 : IF V0$="N"THEN 1000 0410 IF O1$="2"THEN 445 : GOSUB 9420 0420 IF O1$>"3"THEN 430 0425 LOAD DC T"TPUT030A"12,9499 0430 IF O1$>"4"THEN 440 0435 LOAD DC T"TPUT040A"12,9499 0440 LOAD DC T"TPUT070A"12,9499 0445 L$(1),L$(2)=A2$ 0450 PRINT HEX(03);"LABEL INFORMATION ROUTINE / (ENTER VOLUME LABEL)" : L$="VOLUME LABEL " : GOSUB '248(1,0,7) : STR(L$(1),1,4)="VOL1" : GOSUB 1045 : PRINT HEX(0A0A0A0A); : GOSUB '206(1,1,4) 0485 GOSUB '243("ENTER THE VOLUME SERIAL NUMBER (REQUIRED)",6) : STR(L$(1),5,6)=Q6$ : GOSUB '206(1,5,10) : GOSUB 1425 0505 KEYIN Z$,515,515 : GOTO 505 0515 GOSUB '209(1) : IF T6=1THEN 445 0525 L$(3),L$(4)=A2$ : PRINT HEX(03);"LABEL INFORMATION ROUTINE / (ENTER HEADER LABEL 1)" : L$="HEADER LABEL 1" : STR(L$(3),1,4)="HDR1" : GOSUB 1045 : PRINT HEX(0A0A0A0A); : GOSUB '206(3,1,4) 0560 GOSUB '243("ENTER THE DATA SET IDENTIFIER (REQUIRED)",17) : STR(L$(3),5,17)=Q6$ : GOSUB '206(3,5,21) : STR(L$(3),22,6)=STR(L$(1),5,6) : STR(L$(3),28,8)="00010001" : PRINT HEX(0A0A0A0A); : GOSUB '206(3,22,35) 0595 GOSUB '245("ENTER THE GENERATION #",4,0) : CONVERT Q9TO STR(L$(3),36,4),(####) : PRINT HEX(0A); : GOSUB '206(3,36,39) : GOSUB '245("ENTER THE VERSION #",2,0) : CONVERT Q9TO Q6$,(##) : PRINT HEX(0A); : STR(L$(3),40,1)=STR(Q6$,1,1) 0635 STR(L$(4),1,1)=STR(Q6$,2,1) : GOSUB '206(3,40,40) : PRINT HEX(0A0A0A0A); : GOSUB '206(3,41,41) : GOSUB '245("ENTER THE CREATION DATE IN <YYDDD> FORMAT",5,0) : CONVERT Q9TO STR(L$(4),3,5),(#####) : PRINT HEX(0A); : GOSUB '206(3,43,47) 0675 GOSUB '245("ENTER THE EXPIRATION DATE IN <YYDDD> FORMAT (REQUIRED)",5,0) : CONVERT Q9TO STR(L$(4),9,5),(#####) : PRINT HEX(0A); : GOSUB '206(3,49,53) 0695 GOSUB '243("ENTER THE DATA SECURITY (REQUIRED)",1) : IF Q6$=HEX(33)THEN 725 : IF Q6$=HEX(30)THEN 725 : IF Q6$=HEX(31)THEN 725 : GOSUB 9854 : GOTO 695 0725 STR(L$(4),14,1)=Q6$ : GOSUB '206(3,54,54) : STR(L$(4),15,6)="000000" : PRINT HEX(0A0A0A0A); : GOSUB '206(3,55,60) : GOSUB 1425 0755 KEYIN Z$,765,765 : GOTO 755 0765 GOSUB '209(3) : IF T6=1THEN 525 0775 L$(5),L$(6)=A2$ : PRINT HEX(03);"LABEL INFORMATION ROUTINE / (ENTER HEADER LABEL 2)" : L$="HEADER LABEL 2" : STR(L$(5),1,5)="HDR2F" : GOSUB 1045 : PRINT HEX(0A0A0A0A); : GOSUB '206(5,1,5) 0810 GOSUB '245("ENTER THE BLOCK LENGTH (REQUIRED)",5,0) : CONVERT Q9TO STR(L$(5),6,5),(#####) : PRINT HEX(0A); : GOSUB '206(5,6,10) : GOSUB '245("ENTER THE RECORD LENGTH (REQUIRED)",5,0) : CONVERT Q9TO STR(L$(5),11,5),(#####) : PRINT HEX(0A); 0845 GOSUB '206(5,11,15) : STR(L$(5),16,2)="30" : PRINT HEX(0A0A0A0A); : GOSUB '206(5,16,17) : GOSUB '243("ENTER THE JOB/JOB STEP ID.",17) : STR(L$(5),18,17)=Q6$ : GOSUB '206(5,18,34) 0880 GOSUB '243("ENTER THE CONTROL CHARACTER (REQUIRED)",1) : IF Q6$="A"THEN 910 : IF Q6$="M"THEN 910 : IF Q6$=" "THEN 910 : GOSUB 9854 : GOTO 880 0910 STR(L$(5),37,1)=Q6$ : GOSUB '206(5,37,37) 0920 GOSUB '243("ENTER THE BLOCK ATTRIBUTE (REQUIRED)",1) : IF Q6$="B"THEN 955 : IF Q6$="S"THEN 955 : IF Q6$="R"THEN 955 : IF Q6$=" "THEN 955 : GOSUB 9854 : GOTO 920 0955 STR(L$(5),39,1)=Q6$ : GOSUB '206(5,39,39) : GOSUB 1425 0970 KEYIN Z$,980,980 : GOTO 970 0980 GOSUB '209(5) : IF T6=1THEN 775 : GOSUB 9420 0995 LOAD DC T"TPUT030A"12,9499 1000 GOSUB 9420 : IF O1$>"2"THEN 420 1040 LOAD DC T"TPUT030A"12,9499 1045 PRINT HEX(0A0A0A0A0A0A0A);TAB(25);L$ : PRINT TAB(8);" 0 1 2 3 4" : PRINT TAB(8);"-'----.----'----.----'----.----'----.----'-" : PRINT TAB(64); : PRINT TAB(64); 1070 PRINT TAB(8);"-.----'----.----'----.----'----.----'----.-" : PRINT TAB(8);" 4 5 6 7 8" : PRINT HEX(01); : RETURN 1090 DEFFN'206(Z0,Z8,Z9) : FOR I=Z8TO Z9 : J=I-40 : IF I>=41THEN 1120 : L9$(I)=STR(L$(Z0),I,1) : GOTO 1125 1120 L9$(I)=STR(L$(Z0+1),J,1) 1125 NEXT I : PRINT HEX(0A0A0A0A0A0A0A); : Z7=Z8 : IF Z8<=40THEN 1155 : Z7=Z8-40 : PRINT HEX(0A); 1155 FOR I=1TO Z7+9 : PRINT HEX(09); : NEXT I : FOR I=Z8TO Z9 : PRINT L9$(I); : NEXT I : PRINT HEX(01); : RETURN 1195 DEFFN'209(R1) : GOTO 1215 1205 KEYIN Z$,1215,1215 : GOTO 1205 1215 T6=0 : R9=R1 1225 IF Z$="1"THEN 1260 : IF Z$="3"THEN 1255 : IF Z$="2"THEN 1250 : PRINT HEX(010A0A0A0A0A0A0A);"RE-ENTER" : GOTO 1205 1250 T6=1 1255 RETURN 1260 GOSUB '248(1,0,7) 1265 GOSUB '245("ENTER THE STARTING BYTE LOCATION",2,0) : IF Q9>4THEN 1285 1275 GOSUB 9854 : GOTO 1265 1285 IF Q9>80THEN 1275 : B1=Q9 : GOSUB '245("ENTER THE ENDING BYTE LOCATION",2,0) : IF Q9>80THEN 1275 : IF Q9-B1+1>=1THEN 1320 : PRINT HEX(010A0A0A);"* ERROR ON STARTING-ENDING BYTES * / RE-ENTER " : GOTO 1265 1320 GOSUB '243("KEY IN THE NEW CHARACTER(S)",(Q9-B1)+1) : IF B1>40THEN 1360 : IF Q9+1>40THEN 1385 1335 STR(L$(R1),B1,Q9-B1+1)=STR(Q6$,1,Q9-B1+1) : GOSUB '206(R1,B1,Q9) : GOSUB 1425 1350 KEYIN Z$,1225,1225 : GOTO 1350 1360 B1=B1-40 : Q9=Q9-40 : R1=R1+1 : PRINT HEX(0A); : GOTO 1335 1385 STR(L$(R1),B1,40-B1+1)=STR(Q6$,1,40-B1+1) : STR(L$(R1+1),1,Q9-40)=STR(Q6$,40-B1+2,Q9-40) : GOSUB '206(R1,B1,40) : PRINT HEX(0A0A0A0A); : GOSUB '206(R1,41,Q9) 1410 GOSUB 1425 1415 KEYIN Z$,1225,1225 : GOTO 1415 1425 GOSUB '248(0,0,2) : PRINT "LABEL INFORMATION ROUTINE / (UPDATE LABEL) " : PRINT : PRINT " ''''''''''''''''''''''''''''''''''''''''' " : PRINT " . 1. KEY '1' TO UPDATE THE LABEL. ." 1450 PRINT " . 2. KEY '2' TO RE-ENTER THE LABEL. ." : PRINT " . 3. KEY '3' TO CONTINUE PROCESSING. ." : PRINT " ......................................... " : RETURN 9420 GOSUB '248(1,0,15) : PRINT " SEARCH & LOAD THE PROGRAM" : RETURN 9500 DEFFN'204(Z4) : IF T=0THEN 9508 : IF Z4=0THEN 9510 : $TRAN(C$(),T1$()) 9508 RETURN 9510 $TRAN(C$(),T$()) : RETURN 9512 DEFFN'31(Z9) : Z5=0 : IF Z9=21THEN 9615 : IF Z9=31THEN 9684 : IF Z9=22THEN 9675 : IF Z9=32THEN 9681 : IF Z9=12THEN 9606 : IF Z9=10THEN 9684 : IF Z9=11THEN 9684 9520 ON Z9GOTO 9526,9532,9536,9539,9544,9548,9552,9557,9603,9566,9572,9578,964 0,9669,9603 : IF Z9=31THEN 9620 : PRINT "SYSTEM ERROR //" : STOP 9526 $GIOBSR#1(44048607,B$) : Z5=1 : GOTO 9582 9532 $GIOBSR#1(44048607,B$) : GOTO 9582 9536 $GIOFSR#1(44088607,B$) : GOTO 9582 9539 $GIOBSF#1(44058607,B$) : W$=HEX(20) : AND (W$,STR(B$,7,1)) : IF W$=HEX(20)THEN 9582 : $GIOFSR#1(44088607,B$) : GOTO 9582 9544 $GIOFSF#1(44028607,B$) : GOTO 9582 9548 $GIOREW#1(44468607,B$) : GOTO 9582 9552 $GIOWGP#1(44078607,B$) : Z5=1 : GOTO 9582 9557 $GIOBSR#1(44048607,B$) : W$=HEX(20) : AND (W$,STR(B$,7,1)) : IF W$<>HEX(00)THEN 9582 : $GIOBSR#1(44048607,B$) : $GIOFSR#1(44088607,B$) : GOTO 9582 9566 $GIOWFM#1(44038607,B$) : Z5=1 : GOTO 9582 9572 IF L0>4096THEN 9604 : $GIOWRT#1(4429A20044018607,B$)C$()<1,L0> : Z5=1 : GOTO 9582 9578 $GIORED#1(44008607442AC220,B$)C$() 9582 W$=HEX(02) : AND (W$,STR(B$,7,1)) : IF W$=HEX(00)THEN 9594 : SELECT PRINT 005 : PRINT " * TAPE IS NOT READY *" : STOP 9594 IF Z5<>1THEN 9603 : W$=HEX(10) : AND (W$,STR(B$,7,1)) : IF W$=HEX(00)THEN 9602 : PRINT " * ATTEMPT TO WRITE ON PROTECTED TAPE *" 9602 RETURN 9603 W$=HEX(EF) : AND (STR(B$,7,1),W$) : RETURN 9604 PRINT " * BUFFER OVERFLOW ON WRITE *" : STOP 9606 GOSUB 9750 : GOSUB 9520 9609 W$=HEX(80) : AND (W$,STR(B$,7,1)) : IF W$=HEX(00)THEN 9624 : SELECT PRINT 005 : PRINT " * PERMANENT DATA ERROR ON READ *" : STOP 9615 GOSUB 9750 9616 $IF ON #1,9618 : GOTO 9616 9618 IF L0>4096THEN 9604 : $GIOLOOKAHEADWRITE#1(4429A2004401,B1$)C$()<1,L0> : RETURN 9620 $GIOFINISHWRITE#1(8607,B$) : Z5=1 : GOTO 9582 9624 W$=HEX(01) : AND (W$,STR(B$,8,1)) : IF W$=HEX(00)THEN 9636 : SELECT PRINT 005 : PRINT " * BUFFER OVERFLOW ON READ *" : STOP 9636 U1=U1+1 : W$=HEX(04) : AND (W$,STR(B$,7,1)) : IF W$<>HEX(00)THEN 9639 : RETURN 9639 STR(B$,9,2)=HEX(0001) : STR(C$(1),1,1)=HEX(13) : RETURN 9640 $GIOSTATUS#1(448B8607,B$) : W$=HEX(02) : AND (W$,STR(B$,7,1)) : IF W$=HEX(00)THEN 9652 : PRINT "* STATUS OF TAPE DRIVE = NOT READY *" : GOTO 9664 9652 PRINT "* STATUS OF TAPE DRIVE = READY *" : W$=HEX(10) : AND (W$,STR(B$,7,1)) : IF W$<>HEX(00)THEN 9663 : PRINT "* STATUS OF TAPE =NON-PROTECTED *" : GOTO 9664 9663 PRINT "* STATUS OF TAPE = PROTECTED *" 9664 INPUT " KEY 'C' TO CONTINUE, 'S' TO STOP ",Z$ : IF Z$<>"S"THEN 9667 : STOP 9667 RETURN 9669 $GIOMASREST#1(459C,B$) : RETURN 9675 GOSUB 9750 9676 $IF ON #1,9678 : GOTO 9676 9678 $GIOLOOKAHEAD#1(4400,B1$) : RETURN 9681 $GIOFINISHREAD#1(8607442AC220,B$)C$() : GOSUB 9582 : GOTO 9609 9684 Z6=0 : GOSUB 9750 : IF S9=0THEN 9704 : IF L0<>-9999THEN 9696 : L0=80 : GOTO 9704 9696 IF L0<=S9THEN 9702 : PRINT HEX(010A0A);" * BLOCK SIZE NOT EQUAL *" : STOP 9702 L0=S9 9704 GOSUB 9520 : W$=HEX(80) : AND (W$,STR(B$,7,1)) : IF W$=HEX(00)THEN 9734 : IF Z9=31THEN 9730 : IF Z6>=15THEN 9730 : GOSUB '31(1) : GOSUB '31(7) : Z6=Z6+1 : Z9=11 : GOTO 9704 9730 PRINT " * PERMANENT DATA ERROR ON WRITE *" : STOP 9734 W$=HEX(08) : AND (W$,STR(B$,7,1)) : IF W$=HEX(00)THEN 9744 : PRINT " // END OF TAPE MARK IS DETECTED, WARNING ON WRITE //" : INPUT Z1 9744 IF Z9=10THEN 9748 : U1=U1+1 9748 RETURN 9750 IF O$="O"THEN 9756 : PRINT " * FILE NOT OPEN *" : STOP 9756 RETURN 9758 Q6=3 : GOTO 9880 9762 DEFFN'254 : GOSUB '243("KEY RETURN(EXEC) TO RESUME",0) : W4$=Q6$ : GOSUB '248(0,0,4) : Q6$=W4$ : RETURN 9774 DEFFN'242(W0,Q6$) : IF W0<=0THEN 9912 : IF W0=1THEN 9782 : STR(Q6$,2)=STR(Q6$,1,W0-1) 9782 PRINT Q6$; : RETURN 9786 DEFFN'243(Q6$,Q0) : GOSUB 9860 9790 SELECT CO 205 : Q6$=" " : INPUT Q6$ : IF Q0=0THEN 9874 : IF LEN(Q6$)<=Q0THEN 9874 : GOSUB 9854 9802 DEFFN'244(Q0) : GOSUB 9870 : GOSUB 9864 : GOTO 9790 9810 DEFFN'245(Q6$,Q2,Q3) : Q0=ABS(Q2)+Q3+1 : GOSUB 9860 9816 GOSUB '242(ABS(Q2)+2,HEX(09)) : PRINT "/" : GOSUB 9870 : SELECT CO 205 : Q9,W0=-1E-99 : INPUT Q9 : IF W0=Q9THEN 9834 : IF Q9>=0THEN 9846 : IF Q2<=0THEN 9846 9834 GOSUB 9854 9836 DEFFN'246(Q2,Q3) : Q0=ABS(Q2)+Q3+1 : GOSUB 9870 : GOSUB 9864 : GOTO 9816 9846 IF ABS(Q9)>=10^ABS(Q2)THEN 9834 : W0=ABS(Q9*10^Q3) : IF INT(W0)<>W0THEN 9834 : GOTO 9758 9854 GOSUB 9758 : PRINT "RE-ENTER" : RETURN 9860 GOSUB 9912 : PRINT HEX(010A);STR(Q6$,1); 9864 GOSUB 9912 : GOSUB '242(Q0+2,"-") : PRINT TAB(64) 9870 PRINT HEX(010A0A) : RETURN 9874 PRINT HEX(0A);TAB(64) : GOTO 9912 9878 Q6=0 9880 Q7=0 : Q8=1 9884 DEFFN'248(Q6,Q7,Q8) : GOSUB 9912 : IF Q8<1THEN 9906 : GOSUB 9906 : SELECT PRINT 205 : Q6$=" " : PRINT STR(Q6$,Q7+1) : IF Q8<2THEN 9906 : FOR W0=2TO Q8 : PRINT HEX(0A);STR(Q6$,1) : NEXT W0 9906 PRINT HEX(01) : GOSUB '242(Q7,HEX(09)) : GOSUB '242(Q6,HEX(0A)) 9912 SELECT PRINT 005(64),CO 005 : RETURN