Listing of file='IDS2PP27' on disk='vmedia/701-2724B.wvd.zip'
# Sector 729, program filename = 'IDS2PP27'
1000 REM "IDS2PP27" - Release 2.1 - PROGRAM GENERATOR - READ A RECORD
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: E4$()=" "
: IF E$(107)="0"THEN 2100
: IF E$(107)<>"1"AND E$(107)<>"2"AND E$(110)<>"1"AND E$(110)<>"2"THEN 2000
: Y=1
: FOR I=0TO 4
: E6$=E$(I*39+131)
: IF E6$=" "THEN 1990
: IF E6$="C"THEN 1200
: F5$=STR(E$(),I*39+132)
: GOSUB 3310
: E4$()=HEX(9A)&"'43"&E8$
1075 F9$=STR(E$(),I*39+168)
: IF VAL(F9$)=32THEN F9$=STR(F9$,2)
: E8$="F$()"
: ON YGOTO 1090
: Q=Y
: GOSUB 3330
: $TRAN(E8$,HEX(2C28203A))R
1090 IF Y>1THEN E4$()=E4$()&HEX(D3)&"F$()"
: E4$()=E4$()&E8$&HEX(3D)
: IF E6$="F"THEN F0$=HEX(D3)&"E4$(),,"&F9$&"):"
: E4$()=E4$()&F0$
: CONVERT F9$TO Q
: Y=Y+Q
: GOTO 1980
1200 E$=STR(E$(),I*39+132,36)
: CONVERT STR(E$(),I*39+168,2)TO Q
: F0$=HEX(22)&STR(E$,,MIN(LEN(E$),Q))&HEX(223A)
: GOTO 1075
1980 IF STR(E4$(),,1)=" "THEN E4$()=STR(E4$(),2)
: STR(F$(),FNZ(Z))=E4$()
: E4$()=" "
1990 NEXT I
2000 IF E$(111)="N"THEN STR(F$(),FNZ(Z))="F6$(14)="&HEX(224E223A)
: IF E$(107)>"1"OR E$(110)>"1"THEN GOSUB 3220
: IF E$(110)=" "THEN 2050
: Q=VAL(E$(108))-47
: GOSUB 3330
: STR(F$(),FNZ(Z))=HEX(9F)&"F6$"&STR(E8$,,POS(E8$=")"))&HEX(3D22)&E$(109)&H
EX(22B1)
2050 GOSUB '71(E$(107))
: STR(F$(),FNZ(Z))=E$
: IF E$(110)=" "THEN 2080
: GOSUB '71(E$(110))
: STR(F$(),FNZ(Z)-1)=HEX(BAF2)&E$
2080 IF E$(129)=" "THEN 2100
: Q=VAL(E$(129))-47
: GOSUB 3330
: STR(E8$,POS(E8$=":"))="="&HEX(22)&E$(130)&HEX(22)
: E$=HEX(9F)&"Q<>0"&HEX(B1)&"F6$"&E8$
: $TRAN(E8$,"YNNY")R
: E$=E$&HEX(BAF2)&"F6$"&E8$&":"
: STR(F$(),FNZ(Z))=E$
2100 IF STR(E$(),113,8)=" "OR POS(J8$=45)>0THEN 3000
: F5$=STR(E$(),113)
: GOSUB 3310
: IF E$(107)="0"THEN E$=HEX(9A)&"'45"
: ELSE E$=HEX(9F)&"Q=0"&HEX(B1)&"F$()="&HEX(2220223A9A)&"'45"
2130 IF Q>261AND Q<269THEN 2135
: IF Q<>250THEN 2140
: IF F5$>"FILE # 0"AND F5$<"FILE # 8"THEN F5$=STR(C8$,8*(VAL(STR(F5$,8))-48
)+1)
: MAT SEARCHC8$,=STR(F5$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN 2140
: Q=261+(VAL(F9$,2)-1)/8
: GOSUB 3330
: GOTO 2140
2135 STR(E$,LEN(E$)-3)=" "
: CONVERT Q-260TO F9$,(#)
: E$=E$&HEX(9F)&"Q<>0"&HEX(B1D3)&"E$(),E("&F9$&"),E0("&F9$&"))=F$():"
: GOTO 2200
2140 E7$,F5$=STR(E$(),99)
: IF F5$>"FILE # 0"AND F5$<"FILE # 8"THEN F5$=STR(C8$,8*(VAL(STR(F5$,8))-48
)+1)
: E$=E$&STR(E8$,,POS(E8$=")")-1)&","
: IF E7$<>STR(E$(),121,8)THEN 2150
: E$=E$&"F$()):"
: GOTO 2200
2150 OR (F5$,20)
: GOSUB '39(F5$,5)
: MAT REDIM E2$(6)83
: DATA LOAD DA T#P,(A)E2$()
: IF STR(E2$(),10,1)<"5"THEN 2160
: F5$=STR(E2$(),82)
: GOTO 2150
2160 MAT REDIM E2$(24)83
: DATA LOAD DA T#P,(A+8)E2$()
: MAT SEARCHE2$(),=STR(E$(),121,8)TO F9$STEP 8
: F0$=HEX(D3)&"F$(),"
: IF F9$>HEX(0000)THEN 2170
: F0$=HEX(222022293A)
: GOTO 2190
2170 DATA LOAD DA T#P,(A)E2$()
: Q=INT(VAL(F9$,2)/8)*6+499
: P=INT(VAL(STR(E2$(),Q),2)/16)
: L=VAL(STR(E2$(),Q+2))
: Q=P
: MAT REDIM E2$(250)9
: GOSUB 3330
: F0$=F0$&STR(E8$,2)
: Q=L
: GOSUB 3330
: STR(F0$,LEN(F0$)-1)=","&STR(E8$,2)
: STR(F0$,POS(F0$=":"))="):"
2190 E$=E$&F0$
: GOSUB '33(C8$)
2200 STR(F$(),FNZ(Z))=E$
3000 IF POS("RB"=STR(R3$(1),6,1))>0AND E$(107)>"0"THEN F$()=F$()&HEX(9A)&"'71:
"
: $TRAN(F$()<,LEN(F$())>,HEX(1A3A))R
: LOAD DA T#2,(D$(29))1000,
3020 STOP "LOAD P/F'S"
3040 DEFFN'71(E6$)
: CONVERT E6$TO J1
: F5$=STR(E$(),99)
: GOSUB 3310
: IF F3$>"261"AND F3$<"269"THEN J5$="E9$("&STR(F3$,3)&")"
: ELSE J5$=HEX(22)&F5$&HEX(22)
: D8$=F3$
: F5$=STR(E$(),121)
: GOSUB 3310
: E$=HEX(9A)&"' ("&J5$
: IF D8$=F3$THEN E6$=STR(F3$,3)
: ELSE E6$="0"
: IF D8$<>F3$AND E$(112)="U"THEN E6$="."
3090 IF E6$="."THEN E8$=".5"
: ELSE E8$=E6$
: IF E6$="0"OR E6$="."THEN 3110
: IF E$(112)="I"THEN E8$="-E("
: ELSE E8$="E("
: E8$=E8$&E6$&")"
: J8$=E8$
3110 ON J1GOSUB 3140,3150,3160,3170,3180,3190,3200
: STR(E$,3,2)=F9$
: E$=E$&F0$&E8$&"):"
: RETURN
3140 F9$="41"
: F0$=",F$(),"
: RETURN
3150 F9$="61"
: F0$=",F$(),"
: RETURN
3160 F9$="62"
: F0$=",1,"
: RETURN
3170 F9$="62"
: F0$=",0,"
: RETURN
3180 F9$="67"
: F0$=","
: RETURN
3190 F9$="68"
: F0$=",1,"
: RETURN
3200 F9$="68"
: F0$=",0,"
: RETURN
3220 STR(F$(),FNZ(Z)-1)=HEX(1A9F)&"F6$(17)<"&HEX(225E22B1A5405041525422)&"IDS2
SUBM"&HEX(22BA)
: F$()=F$()&"E6$=F6$(54)"&HEX(8AD2303229BA)
: F$()=F$()&"F6$(54)=F6$(54)"&HEX(8BD2303229BA9F)&"E6$="&HEX(D2)&"00)"
: F$()=F$()&HEX(B1A15423322C22)&"IDS2SUB8"&HEX(22FF38002CFF3979B3FFC0C4BA)
: RETURN
3270 STOP #
: PRINT HEX(06020402000E);AT(23,16);"Compiling BASIC program - Now processi
ng sector";E4-E3+1;
: RETURN
3290 STOP "END IT"
3300 DEFFNZ(Z)=LEN(F$())+1
3310 Q=250
: MAT SEARCHE3$(),=STR(F5$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN IF VER(F5$,"@TSTFLD#")=8THEN F9$=BIN(VAL(STR(F5$,8))
*8+1619,2)
: IF F5$="@SYSBUF0"THEN Q=269
3320 IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)
: MAT SEARCHC8$,=STR(F5$,,8)TO F9$
: IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)+260
: IF F5$>"FILE # 0"AND F5$<"FILE # 8"THEN Q=VAL(STR(F5$,8))+213
3330 E8$=" "
: $PACK(F=HEX(1006))E8$FROMQ
: STR(E8$,,1)="("
: F3$=STR(E8$,2)
: STR(E8$,LEN(E8$)+1)="):"
: X=0
: IF Q<250THEN IF VAL(STR(E2$(Q),6))<64THEN X=1
: RETURN
3340 E$=STR(E$(),I*56+J*28+110,16)
: F0$=HEX(22)&E$&HEX(22)
: IF NUM(E$)>LEN(E$)THEN X=1
: ELSE X=0
: IF X=1THEN CONVERT E$TO Q
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PP27"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"