image of READY prompt

Wang2200.org

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

# Sector 808, program filename = 'IDS2PU18'
1000 REM - IDS2PU18 - Data Record Dump Part 2 - Open Application Files
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : COM D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,D1$(254)1,D0$3,D0$(249)1,D1$55,D2$32,D3
     $8
   : DIM D8$8,D7$8,D6$3
   : D0=VAL(STR(E2$(),1600),2)
   : D1=VAL(STR(E2$(),1602),2)
   : D2=VAL(STR(E2$(),1604),2)
   : D3=VAL(STR(E2$(),1606),2)
   : D1$()=STR(E2$(),1000)
   : D3$=F2$
   : D2$=F0$
   : MAT REDIM E3$(9)83
1130 A=(R0-#PART)/16+1
   : F5$="IDS2fsxx"
   : IF A>0THEN CONVERT ATO STR(F5$,7,2),(##)
   : DATA LOAD DC OPEN T#2,F5$
   : DATA LOAD DC #2,E3$()
   : E$=STR(E3$(),#PART*45-17,45)
   : F5$=STR(E2$(),2,8)
   : J2=0
   : J3=J2+1
   : CONVERT STR(E2$(),217,1)TO J1
   : STR(E2$(),251,3)=STR(E2$(),105)
   : FOR J9=1TO J1
   : J2=J2+1
   : D6$=STR(E2$(),248+3*J9,3)
   : MAT SEARCHE$,=D6$TO F9$STEP 3
1260 IF F9$>HEX(0000)THEN 1290
1270 E$="Essential disk address "&D6$&" missing from IDEAS2 device table."
   : GOTO 1850
1290 P=(VAL(F9$,2)+2)/3
   : LIMITS T#P,F5$,A,B,C,J
   : IF J=2THEN 1350
   : E$="Volume    of file "&F5$&" missing from "&D6$&"! Please CANCEL."
   : CONVERT J9TO STR(E$,8,1),(#)
   : GOTO 1850
1350 E1$(J2)=STR(F5$,,8)&BIN(P)&BIN(J3,2)&STR(E2$(),403,1)&STR(E2$(),405,42)&B
     IN(A,2)
   : IF J2>1THEN 1460
   : UNPACK(####)STR(E1$(J2),13,2)TO J
   : STR(E1$(J2),13,2)=BIN(J,2)
   : J=(C-2)/VAL(STR(E1$(J2),43),2)
   : STR(E1$(J2),46,2)=BIN(J,2)
   : J=J-VAL(STR(E1$(J2),45))
   : A=VAL(STR(E1$(J2),50))
   : B=VAL(STR(E1$(J2),51))
1440 STR(E1$(J2),19,2)=BIN(MIN(J*B/A,VAL(STR(E1$(J2),48),2)),2)
   : GOTO 1530
1460 STR(E1$(J2),12,1)=HEX(00)
   : F9$=BIN((C-2)/VAL(STR(E1$(J2),43),2),2)
   : J=VAL(F9$,2)
   : A=VAL(STR(E1$(J2),50))
   : B=VAL(STR(E1$(J2),51))
   : STR(E1$(J2),45,5)=HEX(00)&STR(F9$,,2)&BIN(J*B/A,2)
   : STR(E1$(J2),19,2)=STR(E1$(J2),48)
1530 NEXT J9
   : MAT COPY E2$()<,498>TO E2$()<499,>
   : FOR J9=0TO 15
   : D7$=STR(E2$(),773+8*J9)
   : IF D7$=" "THEN 1800
   : J2=J2+1
   : D8$=D7$OR ALL(20)
   : LIMITS T#5,D8$,A,J,J,J
   : IF J=2THEN 1650
   : E$="Alt control file "&D7$&" doesn't exist."
   : GOTO 1850
1650 MAT REDIM E2$(6)83
   : DATA LOAD DA T#5,(A)E2$()
   : MAT REDIM E2$(12)83
   : D6$=STR(E2$(),105,3)
   : MAT SEARCHE$,=D6$TO F9$STEP 3
   : IF F9$>HEX(0000)THEN 1720
   : GOTO 1270
1720 P=(VAL(F9$,2)+2)/3
   : LIMITS T#P,D7$,A,J,J,J
   : IF J=2THEN 1770
   : E$="Alt file "&D7$&" missing from "&D6$&"! Please CANCEL."
   : GOTO 1850
1770 E1$(J2)=STR(D7$,,8)&BIN(P)&BIN(J3,2)&STR(E2$(),403,1)&STR(E2$(),405,42)&B
     IN(A,2)
   : STR(E1$(J2),13,2)=STR(E1$(VAL(STR(E1$(J2),10),2)),13)
   : GOTO 1810
1800 J9=15
1810 NEXT J9
   : IF F6$(17)<"^"THEN LOAD T#2,"IDS2PU19"1000,
   : E3$()="IDS2LOCLIDS2SUB1IDS2SUB2IDS2SUB3IDS2SUB3IDS2SUB4IDS2SUB5IDS2SUB6ID
     S2SUB7IDS2SUB8IDS2SUB9IDS2PU19"
   : LOAD T#2,<12>E3$()
1850 J9=15
   : NEXT J9
   : PRINT AT(23,0);HEX(0E);E$;AT(0,0)
1880 KEYIN E6$
   : IF E6$<>HEX(1F)THEN 1880
   : COM CLEAR Y
   : E8=2075
   : E9=2250
   : G=500
   : H=2
   : E=21
   : X=LEN(STR(R3$()))-9
   : MAT COPY -R3$()<1,X>TO -R3$()<10,X>
   : STR(R3$(),,9)="IDS2P002"
   : F6$(17)=" "
   : E$="IDS2P001IDS2P004"
   : LOAD T#2,<2>E$
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PU18"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"