image of READY prompt

Wang2200.org

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