image of READY prompt

Wang2200.org

Listing of file='DDA.LSUB' on disk='vmedia/701-2720C.wvd.zip'

# Sector 550, program filename = 'DDA.LSUB'
7169 %DDA.143, RELEASE X01, (AUG 03, 81) FIND RECORD KEY OCCURANCE
7173 DEFFN'143(N0$,M$,N3)
   : N3(4)=SGN(N3)
   : N3=ABS(N3)
   : MAT SEARCH"EQGTGELTLE",=M$TO N2$()STEP 2
   : IF N2$(1)>HEX(0000)THEN 7176
   : M=54
   : GOTO 7342
7176 J0$="E G H L M "
   : N2$=STR(J0$,VAL(N2$(1),2),1)
   : M=52
   : N1$()=ALL(00)
   : N2=0
   : N5=0
   : N3(6)=0
   : IF N1(9)=N3THEN GOTO 7183
   : DATA LOAD DA T#N0,(N(N3,3))N0(),N9$
   : ERRORM=ERR
   : GOTO 7342
7182 N1(9)=N3
7183 N3(5)=INT((N0(6)*249-2)/N0(5))
   : IF N0(2)=0THEN 7239
   : N3(2)=1
   : N3(3)=N0(2)
   : N5=N1(9+N3)
   : IF N5=0OR N5>N0(2)THEN 7188
   : MAT COPY N5$()<(N3-1)*N0(6)*249+1,N0(6)*249>TO N0$()<1,N0(6)*249>
   : GOTO 7191
7188 IF N3(3)-N3(2)=1AND N5=N3(2)THEN N3(2)=N3(2)+1
   : N5=N3(2)+INT((N3(3)-N3(2))/2)
   : % PRINTUSING "Point ####  Beg ####  End ####",N5;N3(2);N3(3)
7189 GOSUB '149(N(N3,3)+N0(1),N0(6),N5)
   : IF N3(3)-N3(2)=1THEN N3(2)=N3(3)
7191 MAT COPY N0$()<1,N0(5)>TO N1$(2)
   : IF STR(N1$(2),,N0(5)-6)<=STR(N0$,,N0(5)-6)THEN N3(2)=N5
   : IF STR(N1$(2),,N0(5)-6)>=STR(N0$,,N0(5)-6)THEN N3(3)=N5
   : MAT COPY N0$()<(N3(5)-1)*N0(5)+1,N0(5)>TO N1$(2)
   : IF STR(N1$(2),,N0(5)-6)>=STR(N0$,,N0(5)-6)THEN N3(3)=N5
   : IF STR(N1$(2),,N0(5)-6)<=STR(N0$,,N0(5)-6)THEN N3(2)=N5
7197 %IF N3(3)-N3(2)<>N2THEN 7199: N3(3)=N3(3)-1: GOTO 7200
7198 N2=N3(3)-N3(2)
   : IF N3(2)<N3(3)THEN 7188
   : ON POS("EGHLM"=N2$)GOSUB 7206,7212,7218,7223,7230
   : GOTO 7235
7206 GOSUB 7309
   : J8=VAL(N2$(1),2)
   : IF J8=0THEN 7210
   : GOSUB 7233
   : IF J9=1THEN 7210
   : GOSUB 7336
7210 RETURN
7212 GOSUB 7311
   : J6=0
   : M=75
7213 J6=J6+1
   : J8=VAL(N2$(J6),2)
   : IF J8=0THEN 7214
   : GOSUB 7233
   : IF J9=1THEN 7213
   : IF STR(N0$(),J8,1)=HEX(FF)THEN 7216
   : GOTO 7215
7214 N5=N5+1
   : GOSUB '149(N(N3,3)+N0(1),N0(6),N5)
   : IF STR(N0$(),,1)<>HEX(FF)THEN 7212
   : M=75
   : GOTO 7216
7215 GOSUB 7336
7216 RETURN
7218 GOSUB 7206
   : IF M<>0THEN GOSUB 7212
   : RETURN
7223 GOSUB 7313
7224 J6=0
   : IF N2$(1)=HEX(0000)THEN 7227
7225 J6=J6+1
   : IF N2$(J6+1)>HEX(0000)THEN 7225
   : J8=VAL(N2$(J6),2)
   : GOSUB 7233
   : IF J9=0THEN 7226
   : N2$(J6)=HEX(0000)
   : GOTO 7224
7226 GOSUB 7336
   : GOTO 7228
7227 N5=N5-1
   : IF N5<1THEN 7228
   : GOSUB '149(N(N3,3)+N0(1),N0(6),N5)
   : GOTO 7223
7228 RETURN
7230 GOSUB 7206
   : IF M<>0THEN GOSUB 7223
   : RETURN
7233 IF STR(N0$(),J8+N0(5)-3,2)=HEX(FFFF)THEN J9=1
   : ELSE J9=0
   : RETURN
7235 IF M>0AND M<>52AND M<>75THEN 7342
   : IF M=0AND POS("EHM"=N2$)>0AND STR(N0$,,N0(5)-6)=STR(N1$(1),,N0(5)-6)THEN
     7342
7239 IF N0(4)=0THEN 7342
   : %PRINT HEX(020400020E);"..ENTER ANNEX AREA..";HEX(0F);
7240 IF M<>0THEN 7241
   : IF POS("LM"=N2$)>0THEN 7242
   : IF STR(N1$(1),N0(5)-5,2)>HEX(0000)THEN 7243
   : ELSE GOTO 7342
7241 IF POS("GH"=N2$)=0THEN 7242
   : N1$(1)=ALL(FF)
   : M=75
   : GOTO 7243
7242 IF M=0THEN 7243
   : IF POS("LM"=N2$)=0THEN 7243
   : N1$(1)=ALL(00)
   : M=52
   : GOTO 7243
7243 N1(8)=0
   : MAT SEARCHN3$(),=STR(N0$,,2)TO N2$()STEP 4
   : I2=VAL(N2$(1),2)
   : IF I2>0THEN 7246
   : GOSUB '149(N(N3,3)+1,1,1)
   : MAT COPY N0$()TO N3$()
   : MAT SEARCHN3$(),=STR(N0$,,2)TO N2$()STEP 4
   : I2=VAL(N2$(1),2)
   : %PRINT HEX(0E);"PREFIX STACK LOADED";
7246 IF I2=0THEN 7342
   : N5=VAL(STR(N3$(),I2+2),2)
7248 GOSUB '149(N(N3,3)+N0(1),N0(6),N5)
   : IF N1(3)=0THEN GOTO 7250
   : ELSE M=N1(3)
   : GOTO 7342
7250 ON POS("EGHLM"=N2$)GOTO 7253,7259,7268,7282,7291
7253 GOSUB 7309
   : N6=0
7254 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7257
   : GOSUB 7233
   : IF J9=1THEN 7254
   : N2=1
   : GOSUB 7336
7257 GOTO 7305
7259 GOSUB 7311
   : N6=0
7261 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7266
   : GOSUB 7233
   : IF J9=1THEN 7261
   : GOSUB 7322
   : GOTO 7261
7266 GOTO 7305
7268 GOSUB 7309
   : N6=0
7269 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7273
   : GOSUB 7233
   : IF J9=1THEN 7269
   : GOSUB 7336
   : GOTO 7280
7273 GOSUB 7311
   : N6=0
7275 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7280
   : GOSUB 7233
   : IF J9=1THEN 7275
   : GOSUB 7322
   : GOTO 7275
7280 GOTO 7305
7282 GOSUB 7313
   : N6=0
7284 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7289
   : GOSUB 7233
   : IF J9=1THEN 7284
   : GOSUB 7329
   : GOTO 7284
7289 GOTO 7305
7291 GOSUB 7309
   : N6=0
7292 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7296
   : GOSUB 7233
   : IF J9=1THEN 7292
   : GOSUB 7336
   : GOTO 7305
7296 GOSUB 7313
   : N6=0
7298 N6=N6+1
   : J8=VAL(N2$(N6),2)
   : IF J8=0THEN 7305
   : GOSUB 7233
   : IF J9=1THEN 7298
   : GOSUB 7329
   : GOTO 7298
7305 IF N1(8)=1THEN 7342
   : I0=VAL(STR(N0$(),N0(6)*249-1),2)
   : IF I0=0THEN 7342
   : N5=I0
   : GOTO 7248
7309 MAT SEARCHN0$()<1,N3(5)*N0(5)>,=STR(N0$,,N0(5)-6)TO N2$()STEP N0(5)
   : RETURN
7311 MAT SEARCHN0$()<1,N3(5)*N0(5)>,>STR(N0$,,N0(5)-6)TO N2$()STEP N0(5)
   : RETURN
7313 MAT SEARCHN0$()<1,N3(5)*N0(5)>,<STR(N0$,,N0(5)-6)TO N2$()STEP N0(5)
   : RETURN
7315 MAT COPY N0$()<1,N0(6)*249>TO N5$()<(N3-1)*N0(6)*249+1,N0(6)*249>
   : N(N3,1)=N5
   : N(N3,2)=J8
   : N1(9+N3)=N5
   : M=0
   : RETURN
7322 MAT COPY N0$()<J8,N0(5)>TO N1$(2)
   : IF STR(N1$(2),,N0(5)-6)>=STR(N1$(1),,N0(5)-6)THEN 7326
   : IF STR(N1$(2),,N0(5)-6)=STR(N0$,,N0(5)-6)THEN 7326
   : GOSUB 7336
   : N1(8)=0
   : N2=1
7326 RETURN
7329 MAT COPY N0$()<J8,N0(5)>TO N1$(2)
   : IF STR(N1$(2),,N0(5)-6)<=STR(N1$(1),,N0(5)-6)THEN 7333
   : IF STR(N1$(2),,N0(5)-6)=STR(N0$,,N0(5)-6)THEN 7333
   : GOSUB 7336
   : N1(8)=0
   : N2=1
7333 RETURN
7336 IF N3(4)=1THEN GOSUB 7315
   : N3(6)=N5
   : N3(7)=J8
   : MAT COPY N0$()<J8,N0(5)>TO N1$(1)
   : N1(8)=1
   : M=0
   : RETURN
7342 IF M=0AND N3(4)=1THEN MAT COPY N1$(1)<,N0(5)-6>TO N0$
   : RETURN
7364 %DDA.148, RELEASE X01, (AUG 3, 81) WRITE PHYSICAL BLOCK
7368 DEFFN'148(J3,J4,J5)
   : MAT REDIM N0$(3*J4)83
   : DATA SAVE DA T#N0,(J3+(J5-1)*J4)N0$()
   : ERRORN1(3)=ERR
7371 MAT REDIM N0$(6)83
   : RETURN
7376 %DDA.149, RELEASE X01, (AUG 3, 81) READ PHYSICAL BLOCK
7380 DEFFN'149(J3,J4,J5)
   : %PRINT HEX(020402000E);"(..DISK ACCESS..)";HEX(0F);
7382 MAT REDIM N0$(3*J4)83
   : DATA LOAD DA T#N0,(J3+(J5-1)*J4)N0$()
   : ERRORN1(3)=ERR
7383 MAT REDIM N0$(6)83
   : RETURN
7388 %DDA.144, RELEASE X01, (AUG 3, 81) READ A RECORD
7392 DEFFN'144(N3)
   : M=0
   : IF N(N3,1)=0OR N(N3,2)=0THEN M=61
   : IF N(N3,3)=0THEN M=78
   : IF M>0THEN 7408
   : N1$()=ALL(00)
   : M=62
   : MAT COPY N5$()<(N3-1)*(249*N0(6))+N(N3,2),N0(5)>TO N1$(2)
   : N1(6)=VAL(STR(N1$(2),N0(5)-3),2)
   : N1(5)=VAL(STR(N1$(2),N0(5)-1),2)
   : IF N1(5)=0OR N1(6)=0THEN 7408
   : GOSUB '149(N(N3,3)+N0(7),N0(10),N1(6))
7403 IF N1(3)=0THEN GOTO 7404
   : ELSE M=N1(3)
   : GOTO 7408
7404 N1(2)=VAL(STR(N0$(),N1(5)),2)
   : IF N1(2)=0THEN 7408
   : MAT COPY N0$()<N1(5)+2,N1(2)>TO K8$()
   : M=0
7408 RETURN