CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / preprss.lbr / BSLP.BZS / BSLP.BAS

Wrap

BASIC Source File | 1993-10-25 | 15.6 KB | 519 lines

100 DATA proc... 101 DATA prog... 102 DATA when... 103 DATA unless. 104 DATA repeat. 105 DATA loop... 106 DATA switch. 107 DATA case... 108 DATA else... 109 DATA break.. 110 DATA endp... 111 DATA pend... 112 DATA endw... 113 DATA endu... 114 DATA until.. 115 DATA endl... 116 DATA endc... 117 PROC.% = 1 118 PROG.% = 2 119 WHEN.% = 3 120 UNLESS.% = 4 121 REPEAT.% = 5 122 LOOP.% = 6 123 SWITCH.% = 7 124 CASE.% = 8 125 ELSE.% = 9 126 BREAK.% = 10 127 ENDP.% = 11 128 PEND.% = 12 129 ENDW.% = 13 130 ENDU.% = 14 131 UNTIL.% = 15 132 ENDL.% = 16 133 ENDC.% = 17 134 DATA 11,12,13,14,15,16,17,17,13,17 135 DOT$ = "." 136 DOTS$ = "...." 137 SKIP$ = " " 138 SKIP1$ = " '" 139 OEXT$ = ".BAS" 140 IEXT$ = ".P" 141 EEXT$ = ".E" 142 INCL$ = ".INC" 143 TM$ = " ,=" 144 T.FILE$ = "BSLP.$$$" 145 T.FILE% = 1 146 E.FILE% = 2 147 I.FILE% = 3 148 O.FILE% = 3 149 ERRORS% = 0 150 KERR% = 1 151 LEVELS% = 0 152 PUSH% = 0 153 NUM% = 0 154 STACK.% = 0 155 NKEY% = 17 156 INCS% = 1 157 INC% = 0 158 FILE% = 2 159 BASIC$ = "restore.resume.return.goto.gosub" 160 DIM CLOSING%(10) ' For error messages. 161 DIM INC$(50) ' Include file stack. 162 DIM STACK$(500) 163 DIM STACK%(500) 164 DIM NUM.%(500) 165 DIM KEYWORD.%(99,2) 166 DIM XN.%(99) 167 DIM LOOPS%(99) 168 DIM SWITCH$(10) ' For the left operand of SWITCH. 169 DIM KEYWORD$(22) ' For error messages. 170 FOR I%=1 TO NKEY%:READ BUF$:TABLE$=TABLE$+BUF$:KEYWORD$(I%)=BUF$:NEXT I% 171 FOR I%=1 TO 10:READ CLOSING%(I%):NEXT I% 172 PRINT "BSLP V1.1B (C) BENDORF ASSOCIATES, 1984-85" 173 PRINT:GOSUB 566 174 IF NOT(GOOD%) GOTO 177 175 GOSUB 181 176 GOTO 179 177 IF NOT(I.FILE$<>"") GOTO 179 178 PRINT"CANNOT OPEN ";I.FILE$ 179 END 180 'BEGIN 181 GOSUB 194 182 CLOSE 183 IF NOT(ERRORS%=0) GOTO 186 184 KILL E.FILE$:GOSUB 463:CLOSE:KILL T.FILE$ 185 GOTO 188 186 KILL T.FILE$:PRINT E.FILE$;" PRODUCED WITH ";STR$(ERRORS%);" ERROR(S)." 187 END 188 IF NOT(ERRORS%>0) GOTO 191 189 KILL O.FILE$:PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)." 190 GOTO 192 191 PRINT"<";O.FILE$;"> DONE!" 192 RETURN 193 'PASS_1 194 OPEN"O",T.FILE%,T.FILE$:OPEN"O",E.FILE%,E.FILE$:GOSUB 290:INC$(INCS%)=I.FILE$ 195 INC%=INC%+1:FILE%=FILE%+1:FILE$=INC$(INC%):OPEN"I",FILE%,FILE$ 196 GOSUB 201:GOSUB 275 197 IF NOT(FILE%=2) GOTO 196 198 IF NOT(INC%=INCS%) GOTO 195 199 RETURN 200 'INPUT-SOURCE 201 LINE INPUT #FILE%,BUF$ 202 IF NOT(LEN(BUF$)>2) GOTO 226 203 XLINE$=BUF$:GOSUB 232 204 IF(LEN(BUF$)=0) GOTO 225 205 INDEX%=0:GOSUB 550 206 IF NOT(RIGHT$(TEXT$,1)=":") GOTO 210 207 IF(LEN(SBUFF$)>0)THEN GOSUB 266 208 FLAG%=2:LEVEL$=LEFT$(TEXT$,LEN(TEXT$)-1):COMMENT$=SKIP1$+LEVEL$:GOSUB 435 209 GOTO 225 210 L$=LEFT$(TEXT$,1):KEYWORD%=0 211 IF(LEN(TEXT$)<4 OR LEN(TEXT$)>6) GOTO 213 212 C.$=TEXT$:GOSUB 606:KEYS$=C.$+DOTS$:KEYWORD%=INSTR(1,TABLE$,LEFT$(KEYS$,7)):KEYWORD%=(KEYWORD%+6)\7 213 IF NOT(KEYWORD%>0) GOTO 217 214 IF(LEN(SBUFF$)>0)THEN GOSUB 266 215 GOSUB 269 216 GOTO 225 217 IF NOT(L$="-") GOTO 220 218 GOSUB 588 219 GOTO 225 220 IF NOT(L$="+") GOTO 224 221 IF(LEN(SBUFF$)>0)THEN GOSUB 266 222 GOSUB 581 223 GOTO 225 224 GOSUB 251 225 NERR%=NERR%+1:PRINT #E.FILE%,STR$(NERR%);SKIP$;XLINE$ 226 IF NOT(EOF(FILE%)) GOTO 201 227 CLOSE #FILE%:FILE%=FILE%-1 228 IF(SBUFF$="") GOTO 230 229 BUF$="":CFLAG%=0:GOSUB 251 230 RETURN 231 'STRIP 232 Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10)) 233 WHILE (Z1% OR Z2%) 234 IF Z1% THEN MID$(BUF$,Z1%,1)=" " 235 IF Z2% THEN MID$(BUF$,Z2%,1)=" " 236 Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10)):WEND 237 Z1%=1:WHILE (MID$(BUF$,Z1%,1)=" " AND Z1%<LEN(BUF$)):Z1%=Z1%+1:WEND 238 Z2%=LEN(BUF$):WHILE (MID$(BUF$,Z2%,1)=" " AND Z2%>1):Z2%=Z2%-1:WEND 239 IF NOT(Z2%<Z1%) GOTO 242 240 BUF$="" 241 GOTO 245 242 BUF$=MID$(BUF$,Z1%,Z2%-Z1%+1) 243 IF NOT(LEN(BUF$)>0) GOTO 245 244 IF(LEFT$(BUF$,1)="'" OR LEFT$(BUF$,3)="REM" OR BUF$=STRING$(LEN(BUF$),32))THEN BUF$="" 245 LN.%=LEN(BUF$):CFLAG%=0 246 IF(LN.%=0) GOTO 249 247 CFLAG%=(RIGHT$(BUF$,1)="|") 248 IF(CFLAG%)THEN BUF$=LEFT$(BUF$,LN.%-1):LN.%=LEN(BUF$) 249 RETURN 250 'OUT_PUT 251 IF NOT(CFLAG%=0) GOTO 259 252 IF NOT(LEN(SBUFF$)>0) GOTO 257 253 IF NOT(LEN(SBUFF$+BUF$)<=250) GOTO 256 254 BUF$=SBUFF$+BUF$:SBUFF$="" 255 GOTO 257 256 GOSUB 266 257 PBUF$=BUF$:FLAG%=3:GOSUB 435 258 GOTO 263 259 IF NOT(LEN(SBUFF$+BUF$)<=200) GOTO 262 260 SBUFF$=SBUFF$+BUF$+":" 261 GOTO 263 262 GOSUB 266:PBUF$=BUF$:GOSUB 435 263 BUF$="" 264 RETURN 265 'DUMP 266 PBUF$=LEFT$(SBUFF$,LEN(SBUFF$)-1):FLAG%=3:GOSUB 435:SBUFF$="":CFLAG%=0 267 RETURN 268 'KEYWORDS 269 KERR%=NERR%+1 270 ON KEYWORD% GOTO 302,319,328,354,364,364 271 ON KEYWORD%-6 GOTO 405,411,331,421,309,322,343 272 ON KEYWORD%-13 GOTO 357,371,381,428 273 RETURN 274 'POP_ERRORS 275 KER%=KERR%:KWDS%=KEYWORD%:GOSUB 293 276 WHILE KEYWORD%>0 277 GOSUB 282 278 WEND 279 GOSUB 290:KEYWORD%=KWDS%:KERR%=KER% 280 RETURN 281 'RESOLVE-ERRORS 282 IF(KEYWORD%<11)THEN KEYWORD%=CLOSING%(KEYWORD%) 283 EBUF$=KEYWORD$(KEYWORD%):GOSUB 603 284 IF NOT(KEYWORD%=ENDW.% OR KEYWORD%=ENDU.% OR KEYWORD%=ENDC.%) GOTO 287 285 IF(KEYWORD%=ENDC.%)THEN GOSUB 293 286 GOSUB 293 287 GOSUB 293 288 RETURN 289 'PUSH 290 PUSH%=PUSH%+1:KEYWORD.%(PUSH%,0)=KEYWORD%:KEYWORD.%(PUSH%,1)=KERR%:KEYWORD.%(PUSH%,2)=LEVEL% 291 RETURN 292 'POP 293 IF NOT(PUSH%>0) GOTO 296 294 KEYWORD%=KEYWORD.%(PUSH%,0):KERR%=KEYWORD.%(PUSH%,1):LEVEL%=KEYWORD.%(PUSH%,2):PUSH%=PUSH%-1 295 GOTO 297 296 LEVEL%=-1:KEYWORD%=-1 297 RETURN 298 'LEVEL 299 LEVELS%=LEVELS%+1:LEVEL%=LEVELS%:TK%=LEVEL%:GOSUB 290 300 RETURN 301 '_PROC 302 GOSUB 275:GOSUB 290:GOSUB 550 303 IF NOT(LEN(TEXT$)>0) GOTO 306 304 COMMENT$=SKIP1$+TEXT$:LPROC$=TEXT$:FLAG%=2:LEVEL$=TEXT$:GOSUB 435 305 GOTO 307 306 EBUF$="procedure name":GOSUB 603 307 RETURN 308 '_ENDP 309 GOSUB 293 310 WHILE KEYWORD%<>PROC.% AND KEYWORD%>0 311 GOSUB 282 312 WEND 313 IF NOT(KEYWORD%=PROC.%) GOTO 316 314 FLAG%=3:PBUF$="RETURN":GOSUB 435 315 GOTO 317 316 EBUF$=KEYWORD$(PROC.%):GOSUB 603 317 RETURN 318 '_PROG 319 PROG..%=1 320 RETURN 321 '_PEND 322 IF NOT(PROG..%=1) GOTO 325 323 FLAG%=3:PBUF$="END":GOSUB 435 324 GOTO 326 325 EBUF$=KEYWORD$(PROG.%):GOSUB 603 326 RETURN 327 '_WHEN 328 GOSUB 299:GOSUB 299:FLAG%=1:GOSUB 435 329 RETURN 330 '_ELSE 331 GOSUB 293 332 IF NOT(KEYWORD%=WHEN.%) GOTO 340 333 F.%=LEVEL%:GOSUB 293:T.%=LEVEL%:TK%=T.%:FLAG%=4:PBUF$="GOTO ":GOSUB 435:XN%=XN%+1:XN.%(XN%)=F.%:GOSUB 550:C.$=TEXT$:GOSUB 606 334 IF NOT(C.$="when" OR C.$="unless") GOTO 337 335 GOSUB 299:F.%=LEVEL%:FLAG%=ABS(C.$="when"):GOSUB 435:GOSUB 293 336 GOTO 338 337 F.%=0 338 KEYWORD%=WHEN.%:LEVEL%=T.%:GOSUB 290:LEVEL%=F.%:GOSUB 290 339 GOTO 341 340 GOSUB 290:EBUF$=KEYWORD$(WHEN.%):GOSUB 603 341 RETURN 342 '_ENDW 343 GOSUB 293 344 IF NOT(KEYWORD%=WHEN.%) GOTO 347 345 F.%=LEVEL%:GOSUB 293:T.%=LEVEL%:GOSUB 350 346 GOTO 348 347 GOSUB 290:EBUF$=KEYWORD$(WHEN.%):GOSUB 603 348 RETURN 349 'POPOFF 350 IF(F.%>0)THEN XN%=XN%+1:XN.%(XN%)=F.% 351 IF(T.%>0)THEN XN%=XN%+1:XN.%(XN%)=T.% 352 RETURN 353 '_UNLESS 354 GOSUB 299:GOSUB 299:FLAG%=0:GOSUB 435 355 RETURN 356 '_ENDU 357 GOSUB 293 358 IF NOT(KEYWORD%=UNLESS.%) GOTO 361 359 F.%=LEVEL%:GOSUB 293:T.%=LEVEL%:GOSUB 350 360 GOTO 362 361 GOSUB 290:EBUF$=KEYWORD$(UNLESS.%):GOSUB 603 362 RETURN 363 '_REPEAT 364 GOSUB 550:C.$=TEXT$:GOSUB 606:LOOP%=LOOP%+1:GOSUB 299:XN%=XN%+1:XN.%(XN%)=LEVEL% 365 IF NOT(C.$<>"when" AND C.$<>"unless") GOTO 368 366 LOOPS%(LOOP%)=LEVEL% 367 GOTO 369 368 LOOPS%(LOOP%)=LEVEL%*-1:GOSUB 293:LEVEL%=LEVEL%*-1:GOSUB 290:GOSUB 299:FLAG%=ABS(C.$="when"):GOSUB 435 369 RETURN 370 '_UNTIL 371 IF NOT(LOOP%>0) GOTO 378 372 GOSUB 293 373 IF NOT(KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%) GOTO 376 374 LOOP%=LOOP%-1:TK%=LOOPS%(LOOP%+1):FLAG%=1:GOSUB 435 375 GOTO 377 376 GOSUB 290:EBUF$=KEYWORD$(REPEAT.%):GOSUB 603 377 GOTO 379 378 EBUF$=KEYWORD$(REPEAT.%):GOSUB 603 379 RETURN 380 '_ENDL 381 IF NOT(LOOP%>0) GOTO 402 382 GOSUB 293 383 IF NOT(KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%) GOTO 400 384 GOSUB 550:C.$=TEXT$:GOSUB 606:LOOP%=LOOP%-1 385 IF NOT(LOOPS%(LOOP%+1)>0) GOTO 392 386 TK%=LOOPS%(LOOP%+1) 387 IF NOT(C.$="when" OR C.$="unless") GOTO 390 388 FLAG%=ABS(C.$="when"):GOSUB 435 389 GOTO 391 390 EBUF$=KEYWORD$(WHEN.%):GOSUB 603 391 GOTO 399 392 TK%=LOOPS%(LOOP%+1)*-1 393 IF NOT(C.$="when" OR C.$="unless") GOTO 396 394 FLAG%=ABS(C.$="when") 395 GOTO 397 396 FLAG%=4:PBUF$="GOTO " 397 GOSUB 435 398 F.%=LEVEL%:GOSUB 293:T.%=LEVEL%:GOSUB 350 399 GOTO 401 400 GOSUB 290:EBUF$=KEYWORD$(LOOP.%):GOSUB 603 401 GOTO 403 402 EBUF$=KEYWORD$(LOOP.%):GOSUB 603 403 RETURN 404 '_SWITCH 405 IF NOT(C.LN.%>0) GOTO 408 406 GOSUB 299:GOSUB 299:GOSUB 299:SWITCH$(SWITCH%+1)=COND$:SWITCH%=SWITCH%+1 407 GOTO 409 408 EBUF$="operand":GOSUB 603 409 RETURN 410 '_CASE 411 GOSUB 293 412 IF NOT(KEYWORD%=SWITCH.% AND SWITCH%>0) GOTO 418 413 IF NOT(C.LN.%>0) GOTO 416 414 XN%=XN%+1:XN.%(XN%)=LEVEL%:GOSUB 299:FLAG%=4:PBUF$="IF("+SWITCH$(SWITCH%)+"<>"+COND$+") GOTO ":GOSUB 435 415 GOTO 417 416 EBUF$="operand":GOSUB 603 417 GOTO 419 418 GOSUB 290:EBUF$=KEYWORD$(SWITCH.%):GOSUB 603 419 RETURN 420 '_BREAK 421 GOSUB 293 422 IF NOT(KEYWORD%=SWITCH.%) GOTO 425 423 F.%=LEVEL%:GOSUB 293:T.%=LEVEL%:TK%=T.%:FLAG%=4:PBUF$="GOTO ":GOSUB 435:KEYWORD%=SWITCH.%:LEVEL%=T.%:GOSUB 290:LEVEL%=F.%:GOSUB 290 424 GOTO 426 425 GOSUB 290:EBUF$=KEYWORD$(SWITCH.%):GOSUB 603 426 RETURN 427 '_ENDC 428 GOSUB 293 429 IF NOT(KEYWORD%=SWITCH.%) GOTO 432 430 F.%=LEVEL%:GOSUB 293:T.%=LEVEL%:GOSUB 293:GOSUB 350:SWITCH%=SWITCH%-1 431 GOTO 433 432 GOSUB 290:EBUF$=KEYWORD$(SWITCH.%):GOSUB 603 433 RETURN 434 'OUT_LINE 435 IF NOT(FLAG%<2 AND C.LN.%=0) GOTO 438 436 EBUF$="condition":GOSUB 603 437 GOTO 453 438 NUM%=NUM%+1:OFFSET%=1 439 IF(FLAG%<2 OR FLAG%>3)THEN LEVEL$=STR$(TK%):MID$(LEVEL$,1,1)="@" 440 IF(FLAG%<>0) GOTO 443 441 PBUF$="IF("+COND$+") GOTO "+LEVEL$ 442 GOTO 451 443 IF(FLAG%<>1) GOTO 446 444 PBUF$="IF NOT("+COND$+") GOTO "+LEVEL$ 445 GOTO 451 446 IF(FLAG%<>2) GOTO 449 447 GOSUB 459 448 GOTO 451 449 IF(FLAG%<>4) GOTO 451 450 PBUF$=PBUF$+LEVEL$ 451 PRINT #T.FILE%,RIGHT$(STR$(NUM%),LEN(STR$(NUM%))-1);SKIP$;PBUF$;COMMENT$ 452 IF(XN%>0 AND FLAG%<>2)THEN GOSUB 456 453 COMMENT$="":PBUF$="":LEVEL$="" 454 RETURN 455 'STORE_IT 456 OFFSET%=0:FOR I%=1 TO XN%:LEVEL$=STR$(XN.%(I%)):MID$(LEVEL$,1,1)="@":GOSUB 459:NEXT I%:XN%=0 457 RETURN 458 'STACK_IT 459 STACK.%=STACK.%+1:STACK%(STACK.%)=NUM%+OFFSET%:STACK$(STACK.%)=LEVEL$:IF(COMPIL%)THEN NUM.%(STACK.%)=NUM%+OFFSET% 460 OFFSET%=0 461 RETURN 462 'PASS_2 463 GOSUB 534:OFFSET%=2:OPEN"I",T.FILE%,T.FILE$:OPEN"O",O.FILE%,O.FILE$ 464 LINE INPUT #T.FILE%,BUF$:GOSUB 468 465 IF NOT(EOF(T.FILE%)) GOTO 464 466 RETURN 467 'PROCESS_1 468 INDEX%=0:ONFLAG%=0:LN.%=LEN(BUF$):GOSUB 550:IF(COMPIL%)THEN GOSUB 477 469 WHILE FIRST%<=LEN(BUF$) 470 IF(LEN(TEXT$)>7 OR LEN(TEXT$)<2 OR VAL(TEXT$)>0) GOTO 472 471 GOSUB 491 472 GOSUB 550 473 WEND 474 PRINT #O.FILE%,BUF$ 475 RETURN 476 'COMPIL 477 TEXT%=VAL(TEXT$):HIGH%=STACK.%+1:LOW%=0 478 IF(TEXT%<NUM.%(1) OR TEXT%>NUM.%(STACK.%)) GOTO 488 479 WHILE((HIGH%-LOW%)>1):I%=(HIGH%+LOW%)\2 480 IF NOT(NUM.%(I%)=TEXT%) GOTO 483 481 TEXT%=-1:LOW%=HIGH% 482 GOTO 487 483 IF NOT(NUM.%(I%)<TEXT%) GOTO 486 484 LOW%=I% 485 GOTO 487 486 HIGH%=I% 487 WEND 488 IF(TEXT%>0)THEN BUF$=SPACE$(LEN(TEXT$)+1)+COND$ 489 RETURN 490 'FIND_IT 491 C.$=TEXT$:GOSUB 606 492 IF NOT(C.$="on") GOTO 495 493 ONFLAG%=-1 494 GOTO 502 495 IF NOT(LEN(C.$)>3) GOTO 502 496 IF(INSTR(BASIC$,C.$)=0 OR COLN%) GOTO 502 497 GOSUB 550:I$=LEFT$(TEXT$,1) 498 IF(I$="@" OR LEN(TEXT$)<>4) GOTO 500 499 C.$=TEXT$:GOSUB 606:IF(C.$="else")THEN RETURN 500 IF(I$="0" AND ONFLAG%) GOTO 502 501 IF(ONFLAG%)THEN GOSUB 504 ELSE GOSUB 512 502 RETURN 503 'ON_FLAG 504 OFFSET%=1 505 WHILE(FIRST%<=LEN(BUF$)) 506 IF(TEXT$<>"")THEN GOSUB 512 507 GOSUB 550 508 WEND 509 OFFSET%=2 510 RETURN 511 'SEARCH 512 HIGH%=STACK.%+1:LOW%=0:FIND%=-1 513 WHILE((HIGH%-LOW%)>1):I%=(HIGH%+LOW%)\2 514 IF NOT(STACK$(I%)=TEXT$) GOTO 517 515 FIND%=STACK%(I%):LOW%=HIGH% 516 GOTO 521 517 IF NOT(STACK$(I%)<TEXT$) GOTO 520 518 LOW%=I% 519 GOTO 521 520 HIGH%=I% 521 WEND 522 IF NOT(FIND%>0) GOTO 525 523 GOSUB 529 524 GOTO 527 525 IF NOT(TEXT$<>"") GOTO 527 526 ERRORS%=ERRORS%+1:PRINT"MISSING LABEL (";TEXT$;")" 527 RETURN 528 'STUFF_IT 529 NUM$=STR$(FIND%):SP$="":L$=LEFT$(BUF$,FIRST%-OFFSET%) 530 IF(LEFT$(COND$,1)<>" " AND LEFT$(COND$,1)<>":" AND ONFLAG%=0)THEN SP$=" " 531 BUF$=L$+NUM$+SP$+COND$:INDEX%=LEN(L$)+LEN(NUM$):LN.%=LEN(BUF$) 532 RETURN 533 'SORT 534 PT.%=STACK.%:WHILE (PT.%>0):PT.%=PT.%\2 535 IF NOT(PT.%>0) GOTO 547 536 JT.%=1:KT.%=STACK.%-PT.%:WHILE (JT.%<=KT.%):LT.%=JT.%:CT.%=LT.%+PT.% 537 WHILE (LT.%>0 AND STACK$(LT.%)>=STACK$(CT.%)) 538 SWAP STACK$(LT.%),STACK$(CT.%):SWAP STACK%(LT.%),STACK%(CT.%) 539 CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0)) 540 WEND 541 IF NOT(COMPIL%) GOTO 546 542 LT.%=JT.%:CT.%=LT.%+PT.% 543 WHILE (LT.%>0 AND NUM.%(LT.%)>=NUM.%(CT.%)) 544 SWAP NUM.%(LT.%),NUM.%(CT.%):CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0)) 545 WEND 546 JT.%=JT.%+1:WEND 547 WEND 548 RETURN 549 'PARSER 550 C.LN.%=0:I.%=0:COLN%=0:II%=32:TEXT%=0:COND$="":TRM$=TM$+CHR$(58*ABS(INDEX%>0)) 551 WHILE(INSTR(TRM$,CHR$(II%))>0):INDEX%=INDEX%+1:IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7 552 WEND:FIRST%=INDEX% 553 WHILE(II%<>32 AND II%<>7) 554 IF NOT(INSTR(TRM$,CHR$(II%))>0 AND TEXT%=0) GOTO 557 555 COLN%=(CHR$(II%)=":"):I.%=1:II%=32 556 GOTO 562 557 IF NOT(II%=34 OR II%=40 OR II%=41) GOTO 560 558 IF(II%=34)THEN INDEX%=INSTR(INDEX%+1,BUF$,CHR$(34)) 559 IF(II%=40)THEN TEXT%=TEXT%+1 ELSE IF(II%=41)THEN TEXT%=TEXT%-1 560 INDEX%=INDEX%+1:IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7 561 IF(II%=32 AND TEXT%<>0) GOTO 560 562 WEND 563 TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%):IF(LEN(BUF$)>INDEX%)THEN COND$=RIGHT$(BUF$,(LEN(BUF$)-INDEX%)+I.%):C.LN.%=LEN(COND$) 564 RETURN 565 'FILENAMES 566 LINE INPUT"INPUT FILE [.P]:",I.FILE$ 567 IF(I.FILE$="") GOTO 579 568 COMPIL%=(INSTR(I.FILE$,"/")>0) 569 IF(COMPIL%)THEN I.FILE$=LEFT$(I.FILE$,LEN(I.FILE$)-1) 570 IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$ 571 LK.$=I.FILE$:LK.%=I.FILE%:GOSUB 614:I.FILE%=LK.%:GOOD%=(I.FILE%<>FALSE%) 572 IF(GOOD%=FALSE%) GOTO 579 573 I%=INSTR(1,I.FILE$,DOT$) 574 IF(I%=0)THEN I%=LEN(I.FILE$)+1 575 E.FILE$=LEFT$(I.FILE$,I%-1):LINE INPUT"OUTPUT FILE [.BAS]:",O.FILE$ 576 IF(O.FILE$="")THEN O.FILE$=E.FILE$ 577 IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$ 578 IF(INSTR(E.FILE$,DOT$)=0)THEN E.FILE$=E.FILE$+EEXT$ 579 RETURN 580 'INCLUDES 581 GOSUB 599 582 IF NOT(FILE.%>0) GOTO 585 583 OPEN"I",FILE.%,FILE$:FILE%=FILE.% 584 GOTO 586 585 EBUF$="include "+FILE$:GOSUB 603 586 RETURN 587 'SUBROUTINE 588 GOSUB 599 589 IF NOT(FILE.%>0) GOTO 596 590 TEXT%=0 591 WHILE(TEXT%<INCS%) 592 TEXT%=TEXT%+1:IF(FILE$=INC$(TEXT%))THEN TEXT%=INCS%+1 593 WEND 594 IF(TEXT%=INCS%)THEN INCS%=INCS%+1:INC$(INCS%)=FILE$ 595 GOTO 597 596 EBUF$="include "+FILE$:GOSUB 603 597 RETURN 598 'FILES 599 FILE$=RIGHT$(TEXT$,LEN(TEXT$)-1):IF(INSTR(FILE$,DOT$)=0)THEN FILE$=FILE$+INCL$ 600 FILE.%=FILE%+1:LK.$=FILE$:LK.%=FILE.%:GOSUB 614:FILE.%=LK.% 601 RETURN 602 'ERRORS 603 ERRORS%=ERRORS%+1:EBUF$="ERR#"+STR$(ERRORS%)+" MISSING ("+EBUF$+") PROC <"+LPROC$+">":EBUF$=EBUF$+" AT"+STR$(KERR%):PRINT EBUF$:PRINT #E.FILE%,EBUF$ 604 RETURN 605 '_Fold 606 F.0%=1 607 WHILE(F.0%<=LEN(C.$)) 608 F.2%=ASC(MID$(C.$,F.0%,1)) 609 F.2%=F.2%+(32*ABS(F.2%>64 AND F.2%<91)) 610 MID$(C.$,F.0%,1)=CHR$(F.2%):F.0%=F.0%+1 611 WEND 612 RETURN 613 '_Lookup 614 OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.% 615 IF(L.K!<1)THEN LK.%=0:KILL LK.$ 616 RETURN D 612 R