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