image of READY prompt

Wang2200.org

Listing of file='IDS2PUI4' on disk='vmedia/701-2724B.wvd.zip'

# Sector 902, program filename = 'IDS2PUI4'
1000 REM "IDS2PUI4" - INSTALL AN APPLICATION - MOD 3, BEGUN 01/18/82, TSCHETTE
     R
1010 DIM D1$2,D5$8,D6$8,D7$9,D8$1,D9$8,D5$(256)1,D6$(14)8,D7$(14)8,D8$(14)1,D9
     $(32)8
   : DEFFNA(X)=ABS(INT(-X/249))
   : IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : GOSUB 1730
   : IF H9=1AND P7=1THEN GOSUB 1840
   : GOSUB '74("IDS2fRF9",2)
   : IF H9=1THEN GOSUB '74("IDS2fRF8",2)
   : Y=1
   : IF P7=1AND C9=1THEN GOSUB 1850
1030 IF P7=2AND C9=1THEN GOSUB 1860
   : IF C9=1THEN GOSUB '74("IDS2fRF7",2)
   : IF C9=1AND P7=1THEN GOSUB '71(0,"IDS2fRF7",2,2)
   : Y=0
   : IF C6$=" "THEN GOSUB 1100
   : ELSE GOSUB '74(C6$,6)
1040 D6$="IDS2PUI5"
   : LOAD T#2,D6$1000,
   : ERRORJ4=ERR
   : IF J4=82THEN 1060
   : J2=-2
   : GOTO 1750
1060 P9=2
   : GOSUB 1830
   : GOTO 1040
1070 P9=0
   : D6$="IDS2PUIX"
1080 LOAD T#P9,D6$
   : ERRORJ4=ERR
   : IF J4<>82THEN 1090
   : P9=P9+1
   : IF P9=16THEN 1090
   : GOTO 1080
1090 PRINT HEX(03020400000E);"Unexpected error";J4
   : END
1100 GOSUB 1130
   : FOR P9=D5TO D6
   : IF P9>D5AND C9$(P9-1)<>C9$(P9-2)AND P7<3THEN GOSUB 1820
   : SELECT #P9<C9$(P9-1)>
   : DATA LOAD BA T#P9,(0)D9$()
   : I1=VAL(STR(D9$(),2))-1
   : FOR I=0TO I1
   : GOSUB 1150
   : DATA LOAD BA T#P9,(I)D9$()
   : FOR J=2TO 32STEP 2
   : IF VAL(D9$(J-1))<>16OR STR(D9$(J),,6)="IDS2wS"OR D9$(J)<C7$(1)OR D9$(J)>C
     7$(2)THEN 1110
   : GOSUB '72(D9$(J),P9)
1110 NEXT J,I
   : IF P7<>2THEN 1120
   : GOSUB 1810
   : IF POS("Yy"=D8$)>0THEN GOSUB 1820
   : ELSE P9=D6
1120 NEXT P9
   : RETURN
1130 IF C9$(2)=C9$(3)THEN 1140
   : D5=3
   : D6=4
   : IF C9$(3)<>C9$(4)THEN D6=5
   : RETURN
1140 D5,D6=4
   : IF C9$(3)<>C9$(4)THEN D6=5
   : RETURN
1150 E$="Now processing disk index sector number     of    , on platter "&C9$(
     P9-1)
   : CONVERT I+1TO STR(E$,41,3),(###)
   : CONVERT I1+1TO STR(E$,48,3),(###)
   : GOTO 1500
1170 DEFFN'74(D5$,J3)
1180 DATA LOAD DC OPEN T#J3,D5$
   : ERRORJ4=ERR
   : IF J4<>82THEN 1220
   : GOSUB 1760
   : GOTO 1180
1190 IF P7=2AND Y=2AND P6<>1THEN GOSUB 1770
   : IF P7=2AND Y<2AND P6<>2THEN GOSUB 1770
   : DATA LOAD DC #J3,STR(D6$(),1),STR(D7$(),1),STR(D8$(),1)
   : ERRORJ4=ERR
   : IF J4<>89AND J4<>88THEN 1220
   : GOSUB 1760
   : GOTO 1190
1200 IF END THEN RETURN
   : FOR J=1TO 14
   : IF D6$(J)=" "THEN 1210
   : IF Y=1AND D6$(J)="IDS2f005"THEN 1210
   : GOSUB '72(D6$(J),J3)
1210 NEXT J
   : GOTO 1190
1220 E$="Reference file "&D5$&" missing from slot"
   : CONVERT J3TO STR(E$,35+LEN(D5$),1),(#)
   : GOSUB 1880
   : END
1240 DEFFN'71(D8,D6$,J1,J2)
   : IF J1=6AND C7$=C9$(J2+3)THEN RETURN
   : IF J1<>6AND C9$(J1-1)=C9$(J2+3)THEN RETURN
   : IF J1=6THEN SELECT #14<C7$>
   : ELSE SELECT #14<C9$(J1-1)>
   : SELECT #15<C9$(J2+3)>
   : IF D8=1THEN GOSUB 1510
   : IF D8=6THEN GOSUB 1520
   : IF D8<>1AND P7=1AND P6=1AND Y<2THEN GOSUB 1850
   : IF D8=0AND P7=1AND P6<>1AND Y<>1AND J1<>6THEN GOSUB 1840
   : IF D8=1AND P7=1AND P6<>1AND Y<>1THEN GOSUB 1840
1260 GOSUB 1430
   : IF D4=0THEN 1320
   : IF C8=3THEN 1280
   : IF C8=1THEN 1270
   : D8$=" "
   : IF H9<>1OR C9<>1OR Y=0THEN GOSUB 1470
   : IF D8$="N"OR D8$="n"THEN RETURN
1270 SCRATCH T#15,D6$
   : ON D8-2GOSUB 1380,,1400
   : IF D2-D1+1<C3THEN 1300
   : IF ABS(D4)=1THEN 1290
   : DATA SAVE DC OPEN T#15,(D6$)D6$
   : GOTO 1420
1280 PRINT HEX(06);AT(23,0,);"Processing file ";D6$;
   : RETURN
1290 SAVE T#15,()D6$1000,1000
   : GOTO 1420
1300 D9$=DSC HEX(80808080)
   : CONVERT STR(D9$,5,4)TO J5
   : J5=J5+1
   : CONVERT J5TO STR(D9$,5,4),(####)
   : STR(D9$,5,4)=OR HEX(80808080)
   : SAVE T#15,(D6$)D9$1000,1000
   : ERRORJ4=ERR
   : IF J4=83THEN 1300
   : GOTO 1740
1310 SCRATCH T#15,D9$
1320 IF D8>5OR C4=1THEN 1410
   : ON D8GOTO 1330,1350,1370,1350,1390
1330 MOVE T#14,D6$TO T#15,
   : ERRORJ4=ERR
   : GOSUB 1740
   : GOTO 1260
1340 D7$="copying"
   : GOSUB 1490
   : GOSUB 1430
   : GOTO 1440
1350 DATA SAVE DC OPEN T#15,(C3)D6$
   : ERRORJ4=ERR
   : GOSUB 1740
   : GOTO 1260
1360 GOTO 1420
   : GOTO 1360
1370 GOSUB 1380
   : GOTO 1350
1380 J6=VAL(D5$(138))
   : J7=VAL(D5$(139))
   : C3=10+FNA(9*J6)+FNA(8*J6)+FNA(4*J7)
   : RETURN
1390 GOSUB 1400
   : GOTO 1350
1400 J6=VAL(D5$(153))
   : CONVERT STR(D5$(),160,3)TO J7
   : CONVERT STR(D5$(),158,2)TO J8
   : DATA LOAD BA T#14,(C1+3)D5$()
   : CONVERT STR(D5$(),81,3)TO J9
   : C3=6+MAX(1,FNA(9*J6))+MAX(1,FNA(8*J6))+MAX(1,FNA(9*J7))+ABS(INT(-J8/(INT(
     256/(J9+5)))))
   : RETURN
1410 SAVE T#15,(C3-3)D6$1000,1000
   : ERRORJ4=ERR
   : GOSUB 1740
   : GOTO 1410
1420 GOSUB 1430
   : D7$="copying"
   : GOSUB 1490
   : COPY T#14,(C1,C1+C3-2)TO T#15,(D1)
   : D5$()=BIN(32+96*(C4-1))&BIN(C3,2)&ALL(00)
   : DATA SAVE BA T#15,(D1+C3-1)D5$()
   : IF D8=1THEN GOSUB 1430
   : GOTO 1440
1430 LIMITS T#15,D6$,D1,D2,D3,D4
   : RETURN
1440 IF C7=2THEN GOSUB 1450
   : RETURN
1450 C3=C3+(1-SGN(C3-1))*(C2-C1)
   : FOR D9=ABS(C4-2)TO C3-C4-1
   : DATA LOAD BA T#14,(C1+D9)STR(E$(),,256)
   : DATA LOAD BA T#15,(D1+D9)D5$()
   : IF STR(E$(),,256)<>D5$()THEN 1460
   : NEXT D9
   : D7$="verifying"
   : GOSUB 1490
   : RETURN
1460 D9=1E9
   : NEXT D9
   : E$="File "&HEX(22)&D6$&HEX(22)&" does not verify. Key EXEC to continue."
   : GOSUB 1880
   : KEYIN D8$
   : GOTO 1480
1470 E$="Do you want to overwrite "&HEX(22)&D6$&HEX(22)&" on platter "&C9$(J2+
     3)&" (Y/N) ?"
   : GOSUB 1880
   : KEYIN D8$
   : IF POS("YyNn"=D8$)=0THEN 1470
1480 PRINT AT(23,0,);
   : RETURN
1490 E$="Now "&D7$&" file number    : "&HEX(22)&D6$&HEX(22)&" from"
   : IF J1=6THEN E$=E$&" "&C7$
   : ELSE E$=E$&" "&C9$(J1-1)
   : E$=E$&" to"&" "&C9$(J2+3)
   : IF D7$="copying"THEN C5=C5+1
   : CONVERT C5TO STR(E$,LEN(D7$)+18,3),(###)
1500 GOSUB '63(STR(E$,,16),STR(E$,17)," ")
   : RETURN
1510 LIMITS T#14,D6$,D1,D2,D3,D4
   : DATA LOAD BA T#14,(D1)D5$()
   : IF D5$(13)>HEX(34)THEN RETURN
   : IF P8=0THEN E6$()=" "
   : MAT SEARCHE6$(),=STR(D5$(),5,8)TO D1$STEP 8
   : IF D1$>HEX(0000)THEN RETURN
   : P8=P8+1
   : IF P8>60THEN RETURN
   : STR(E6$(),P8*8-7,8)=STR(D5$(),5)
   : RETURN
1520 IF H8=0THEN D4$()=" "
   : MAT SEARCHD4$(),=D6$TO D1$STEP 8
   : IF D1$>HEX(0000)THEN RETURN
   : H8=H8+1
   : IF H8>32THEN RETURN
   : STR(D4$(),H8*8-7,8)=D6$
   : RETURN
1540 DEFFN'72(D6$,P9)
1550 LIMITS T#P9,D6$,C1,C2,C3,C4
   : IF C4<0THEN RETURN
   : IF F=1AND C4=0THEN 1580
   : IF C4=0THEN 1590
   : DATA LOAD BA T#P9,(C1)D5$()
   : ON POS("\E3\F3\E1\F2\D2\E2\C2"=D5$(4))GOTO 1600,1610,1620,1630,1640,1630,
     1640
1560 IF P9=2THEN 1690
   : DATA LOAD BA T#P9,(C1+1)D5$()
   : IF D5$(6)="\E9"THEN 1650
   : ON POS("\F0\F2\E2"=D5$(138))GOTO 1670,1680,1680
   : IF STR(D5$(),2,16)=HEX(FF1000D3452428292C30303031293D22)AND STR(D5$(),18,
     8)=D6$THEN 1660
   : IF P9<>6THEN RETURN
   : GOSUB '71(0,D6$,6,2)
1570 F5$=D6$OR ALL(20)
   : IF F5$=D6$THEN RETURN
   : D6$=F5$
   : F=1
   : GOTO 1550
1580 F=0
   : RETURN
1590 GOSUB 1830
   : GOTO 1550
1600 D8=1
   : GOSUB '76(57)
   : IF D8=0THEN RETURN
   : GOSUB '71(1,D6$,P9,5)
   : RETURN
1610 D8=2
   : GOSUB '76(45)
   : IF D8=0THEN RETURN
   : D7=3
   : IF P9=2THEN D7=2
   : GOSUB '71(2,D6$,P9,D7)
   : RETURN
1620 D8=3
   : GOSUB '76(42)
   : IF D8=0THEN RETURN
   : D7=3
   : IF P9=2THEN D7=2
   : GOSUB '71(3,D6$,P9,D7)
   : RETURN
1630 D8=4
   : GOSUB '76(65)
   : IF D8=0THEN RETURN
   : GOSUB '71(4,D6$,P9,3)
   : RETURN
1640 D8=5
   : GOSUB '76(62)
   : IF D8=0THEN RETURN
   : GOSUB '71(5,D6$,P9,3)
   : IF P9=6THEN 1570
   : RETURN
1650 D8=6
   : DATA LOAD BA T#P9,(C1+2)D5$()
   : GOSUB '76(60)
   : IF D8=0THEN RETURN
   : GOSUB '71(6,D6$,P9,4)
   : RETURN
1660 D8=7
   : DATA LOAD BA T#P9,(C1+6)D5$()
   : GOSUB '76(187)
   : IF D8=0THEN RETURN
   : GOSUB '71(7,D6$,P9,4)
   : RETURN
1670 D8=8
   : GOSUB '76(80)
   : IF D8=0THEN RETURN
   : GOSUB '71(8,D6$,P9,4)
   : RETURN
1680 D8=9
   : GOSUB '76(80)
   : IF D8=0THEN RETURN
   : GOSUB '71(9,D6$,P9,4)
   : IF P9=6THEN 1570
   : RETURN
1690 IF C4=1THEN 1700
   : GOSUB '71(0,D6$,P9,2)
   : RETURN
1700 GOSUB '71(10,D6$,P9,2)
   : RETURN
1710 DEFFN'76(C6)
   : IF C6$<>" "OR P9=2THEN RETURN
   : IF C8$(1)<>" "AND D5$(C6)<>C8$(1)THEN 1720
   : IF C8$(2)<>" "AND STR(D5$(),C6+1,3)<>C8$(2)THEN 1720
   : IF C8$(3)<>" "AND STR(D5$(),C6+4,4)<>C8$(3)THEN 1720
   : RETURN
1720 D8=0
   : RETURN
1730 IF C7$<>" "THEN SELECT #6<C7$>
   : P3=1
   : C5,F,H8,P6,P8=0
   : Y=2
   : D9$="\CA\D5\CE\CB\B0\B0\B0\B0"
   : RETURN
1740 IF J4=81OR J4=86THEN 1780
   : IF J4=85THEN 1800
   : IF J4=90OR J4=91THEN 1870
1750 E$="Unexpected error (  ) on disk "&C9$(J2+3)
   : CONVERT J4TO STR(E$,19,2),(##)
   : GOSUB 1880
   : END
1760 E$="Mount diskette containing reference file "&HEX(22)&D5$&HEX(22)&" and
     EXEC, or CANCEL"
   : IF Y=2THEN P6=1
   : ELSE P6=2
   : GOTO 1790
1770 IF Y=2THEN P6=1
   : IF Y<2THEN P6=2
   : E$="Mount source diskette containing "&HEX(22)&D5$&HEX(22)&" and/or press
      EXEC."
   : GOTO 1790
1780 E$="Output diskette at "&C9$(J2+3)&" is full. Mount another & press EXEC,
      or CANCEL"
1790 GOSUB 1880
   : KEYIN D8$
   : IF D8$=HEX(1F)THEN 1070
   : GOTO 1480
1800 E$="Index of diskette "&C9$(J2+3)&" is full. Mount another & press EXEC,
     or CANCEL"
   : GOTO 1790
1810 D8$=" "
   : E$="Do you have any more diskettes to process (Y/N) ?"
   : GOSUB 1880
   : KEYIN D8$
   : IF POS("YyNn"=D8$)=0THEN 1810
   : GOTO 1480
1820 P9=D6-1
   : E$="If you need to mount another diskette at "&C9$(P9)&" then do so now &
      press EXEC"
   : GOTO 1790
1830 E$="Mount diskette containing "&HEX(22)&D6$&HEX(22)&" at "
   : IF P9=6THEN E$=E$&" "&C7$
   : ELSE E$=E$&" "&C9$(P9-1)
   : E$=E$&" and press EXEC"
   : GOTO 1790
1840 E$="Is the destination platter for system & control files mounted?  Press
      EXEC."
   : P6=1
   : GOTO 1790
1850 E$="If you are making SSSD dsktts you must now mount a "&HEX(22)&"non-sys
     tem"&HEX(22)&" one. Press EXEC"
   : P6=2
   : GOTO 1790
1860 E$="If you made SSSD diskettes you must mount a source "&HEX(22)&"non-sys
     tem"&HEX(22)&" one. Press EXEC"
   : P6=2
   : GOTO 1790
1870 E$="Disk "&C9$(J2+3)&" is down with error Ixx. Get disk up & press EXEC,
     or CANCEL"
   : CONVERT J4TO STR(E$,30,2),(##)
   : GOTO 1790
1880 GOSUB '63(STR(E$,,16),STR(E$,17),"!")
   : RETURN