CP/M

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

/ CP/M / CPM_CDROM.iso / cpm / basic / prebas.lbr / PREBAS.BQS / PREBAS.BAS

Wrap

BASIC Source File | 1985-03-18 | 28.8 KB | 757 lines

10 '----------------------------------------------------------------- 20 ' PREBAS.BAS 30 ' 40 ' Copyright (c) 1985 by Greywolf 50 ' 60 ' Pre-processor for BASIC. Will add line numbers to a standard 70 ' ASCII file, and (optionally) resolve labels in that file. 80 ' Labels are identified by starting with the MARKER$ character, 90 ' (default is "@"). 100 ' 110 REVDATE$ = "22 JAN 1985" ' DATE OF LAST REVISION 120 '----------------------------------------------------------------- 130 ' 140 ESC$ = CHR$(27): QUOTES$ = CHR$(34): TAB$ = CHR$(9): BELL$ = CHR$(7) 150 CR$ = CHR$(13): LF$ = CHR$(10): NL$ = CR$ + LF$ 160 DEFINT A-Z: TRUE = -1: FALSE = 0: ABORT = FALSE: DEBUG = FALSE 170 MSDOS = FALSE ' True if we're running on a PC or clone. 180 OSEXEC = TRUE ' True if we're on an Osborne Exec. 190 ' (Or an Osborne 1) 200 IF OSEXEC = TRUE THEN CLS$ = CHR$(26) ' The clear screen string. 210 MARKER$ = "@" ' The label identifier 220 OPTION BASE 1 230 DIM LABTAB$(2,1000) ' THE SECOND IS THE NUMBER OF LABELS 240 ' WE CAN HANDLE 250 STARTNUM = 10: STEPSIZE = 10 260 ADDVECTS = TRUE ' Show the replaced labels as comments 270 ' at the end of the line. 280 COMBUF = &H80 ' CPM comand line buffer 290 COMPILE = TRUE ' Set TRUE if compiling this 300 INFEXT$ = "": OUTFEXT$ = ".BAS" ' Default file extents 310 HAVECL = FALSE ' At present we don't have a command line 320 CLERROR = FALSE 330 GOSUB 4340 ' @SIGNON 340 DOLABELS = TRUE: DOLINUMS = TRUE 350 KILLOLDOUT = FALSE 360 GOSUB 4440 ' See if we have a command line 370 IF CLERROR = TRUE THEN PRINT BELL$: SYSTEM 380 A$ = "Y" 390 WHILE A$ = "Y" 400 ABORT = FALSE 410 IF HAVECL = FALSE THEN GOSUB 620 ' GET THE FILE NAMES AND PARAMETERS 420 IF HAVECL = FALSE THEN GOSUB 4250 ' Clear screen. 430 IF ABORT = TRUE THEN GOTO 480 440 IF DOLABELS = FALSE THEN GOSUB 1770 ELSE GOSUB 2410: GOSUB 3050 ' TO @ADLNUMS ELSE TO @RESOLVE, @ADLABLN 450 PRINT 460 PRINT "PROCESSED " ((PRESNUM - STEPSIZE)/STEPSIZE) " LINES, NUMBERED FROM" STARTNUM " TO " (PRESNUM - STEPSIZE) 470 PRINT 480 CLOSE 490 IF HAVECL = TRUE THEN A$ = "N": GOTO 570 'If we entered from comline 500 ' we get out here. 510 PRINT:PRINT "DO YOU WANT TO NUMBER ANOTHER FILE (Y/N)? "; 520 GOSUB 4170 ' GET AN UPPER CASE KEY INTO A$ 530 PRINT A$ 540 IF A$ = "Y" THEN GOSUB 4250 ' @CLEARSCREEN 550 HAVECL = FALSE ' WE DONT HAVE A COMMAND LINE ANYMORE 560 KILLOLDOUT = FALSE 570 CLOSE 580 WEND 590 PRINT: PRINT "RETURNING YOU TO SYSTEM --" 600 PRINT " BEANNACHD LEIBH." 610 END 620 '--------------------------------------------------------------------- 630 ' @GETPARMS 640 ' Get the parameters from the user 650 ' 660 ' ENTRY: Nothing 670 ' EXIT: INFILE$, OUTFILE$,STARTNUM,STEP all set. 680 '--------------------------------------------------------------------- 690 KILLOLDOUT = FALSE 700 PRINT: PRINT "INPUT X TO EXIT, OR ESC TO ACCEPT THE DEFAULTS" 710 PRINT "(AFTER YOU HAVE GIVEN A FILENAME)" :PRINT 720 PRINT "WHAT IS THE NAME OF THE INFILE"; 730 IF INFILE$ <> "" THEN PRINT: PRINT " ( <CR> FOR " + INFILE$ + ")"; 740 PRINT "?:"; 750 GOSUB 4020 ' GET AN ECHOED UPPER CASE LINE 760 IF UPLINE$ = "X" THEN ABORT = TRUE:RETURN 770 GSPEC$ = UPLINE$ 780 GOSUB 6870 ' @GETSPEC 790 IF GOTSPEC$ = "" AND INFSPEC$ = "" THEN GOTO 720 ' IF WE DONT GOT ONE 800 IF GOTEXT$ <> "" THEN INFEXT$ = GOTEXT$ 810 IF GOTSPEC$ <> "" THEN INFSPEC$ = GOTSPEC$ 820 INFILE$ = INFSPEC$ + INFEXT$ 830 IF GOTSPEC$ <> "" THEN OUTFSPEC$ = GOTSPEC$: OUTFILE$ = OUTFSPEC$ + OUTFEXT$ 840 ON ERROR GOTO 1750 850 OPEN "I",#1,INFILE$ 860 ON ERROR GOTO 0 870 ' 880 ' WE HAVE AN INFILE -- GET THE OUTFILE 890 ' 900 IF OUTFILE$ = "" THEN OUTFSPEC$ = INFSPEC$: OUTFILE$ = OUTFSPEC$ + OUTFEXT$ 910 PRINT:PRINT:PRINT "WHAT IS THE NAME OF THE OUTPUT FILE"; 920 PRINT: PRINT "( <CR> FOR " + OUTFILE$ + ")"; 930 PRINT "?:"; 940 GOSUB 4020 ' GET UPPER CASE LINE 950 IF UPLINE$ = ESC$ THEN ABORT = FALSE: RETURN 960 IF UPLINE$ = "X" THEN ABORT = TRUE: RETURN 970 IF UPLINE$ = "" THEN GOTO 1020 980 GSPEC$ = UPLINE$: GOSUB 6870 ' @GETSPEC 990 IF GOTEXT$ <> "" THEN OUTFEXT$ = GOTEXT$ 1000 IF GOTSPEC$ <> "" THEN OUTFSPEC$ = GOTSPEC$ 1010 OUTFILE$ = OUTFSPEC$ + OUTFEXT$ 1020 IF OUTFILE$ = INFILE$ THEN GOTO 1130 ' IF THEY ARE THE SAME WE KNOW 1030 ' THE OUTFILE ALREADY EXISTS 1040 ON ERROR GOTO 1070 1050 OPEN "I",#2,OUTFILE$ ' JUST SEE IF ITS THERE 1060 GOTO 1090 ' WE ALREADY HAVE THE OUTFILE 1070 IF ERR <> 53 THEN ON ERROR GOTO 0: RESUME 1080 RESUME 1130 'IF THERE WAS AN ERROR THERE WAS NO OLD OUTFILE SO WERE OK 1090 PRINT OUTFILE$ " ALREADY EXISTS -- OVERWRITE (Y/N)? "; 1100 GOSUB 4170: PRINT A$ 1110 IF A$ = "Y" THEN KILLOLDOUT = TRUE ELSE CLOSE #2:OUTFILE$ = "": GOTO 910 1120 ' 1130 ON ERROR GOTO 0 1140 ' 1150 ' WE HAVE AN OUTFILE -- FIND OUT IF WE'VE TO NUMBER 1160 ' 1170 PRINT "DO YOU WANT TO ADD LINE NUMBERS? "; 1180 GOSUB 4170: PRINT A$ 1190 IF A$ = "X" THEN ABORT = TRUE : RETURN 1200 IF A$ = ESC$ THEN ABORT = FALSE: RETURN 1210 IF A$ = "N" THEN DOLINUMS = FALSE ELSE DOLINUMS = TRUE 1220 PRINT "DO YOU WANT TO RESOLVE LABELS? "; 1230 GOSUB 4170: PRINT A$ 1240 IF A$ = "X" THEN ABORT = TRUE : RETURN 1250 IF A$ = ESC$ THEN ABORT = FALSE: RETURN 1260 IF A$ = "N" THEN DOLABELS = FALSE ELSE DOLABELS = TRUE 1270 ' 1280 IF DOLABELS = FALSE THEN GOTO 1440 ' If we don't do labels 1290 ' we don't need a MARKER$ 1300 PRINT "WHAT IS THE MARKER$ CHARACTER (<CR> FOR " MARKER$ ")?: "; 1310 GOSUB 4170: PRINT A$ 1320 IF A$ = "X" THEN ABORT = TRUE:RETURN 1330 IF A$ => "A" AND A$ <= "Z" THEN PRINT "INVALID MARKER":GOTO 1300 1340 IF A$ = ESC$ THEN ABORT = FALSE:RETURN 1350 IF A$ => "#" THEN MARKER$ = A$ 1360 ' 1370 PRINT "ADD COMMENTS TO END OF LINES?" 1380 PRINT "(e.g. 'TO: @LABEL1, @LABEL2...'): "; 1390 GOSUB 4170: PRINT A$ 1400 IF A$ = "X" THEN ABORT = TRUE : RETURN 1410 IF A$ = ESC$ THEN ABORT = FALSE: RETURN 1420 IF A$ = "N" THEN ADDVECTS = FALSE ELSE ADDVECTS = TRUE 1430 ' 1440 IF DOLINUMS = TRUE OR DOLABELS = TRUE THEN GOTO 1550 ' GO GET START, STEP 1450 ' 1460 PRINT BELL$ "DO YOU WANT TO STRIP LINE NUMBERS FROM " INFILE$ "? " 1470 PRINT "(TYPE N TO CHANGE YOUR MIND, X TO CHANGE FILENAMES): "; 1480 GOSUB 4170: PRINT A$ 1490 IF A$ = "X" THEN ABORT = TRUE : RETURN 1500 IF A$ = ESC$ THEN ABORT = FALSE: RETURN 1510 IF A$ = "Y" THEN RETURN ELSE GOTO 1170 ' go ask again 1520 ' 1530 ' NOW -- GET A START NUMBER 1540 ' 1550 PRINT "WHAT IS THE START NUMBER (<CR> FOR" STARTNUM ")?:"; 1560 INPUT "",STARTNUM$ 1570 IF STARTNUM$ = "X" OR STARTNUM$ = "x" THEN ABORT = TRUE:RETURN 1580 IF STEPSIZE$ = ESC$ THEN ABORT = FALSE:RETURN 1590 IF STARTNUM$ <> "" THEN STARTNUM = VAL(STARTNUM$) 1600 IF STARTNUM < 1 THEN STARTNUM = 10 1610 ' 1620 ' WE HAVE STARTNUM -- GET STEP SIZE 1630 ' 1640 PRINT "ENTER THE STEP SIZE (<CR> FOR" STEPSIZE ")?:"; 1650 INPUT "",STEPSIZE$ 1660 IF STEPSIZE$ = "X" OR STEPSIZE$ = "x" THEN ABORT = TRUE:RETURN 1670 IF STEPSIZE$ <> "" THEN STEPSIZE = VAL(STEPSIZE$) 1680 IF STEPSIZE < 1 THEN STEPSIZE = 10 1690 ' 1700 ' WHEE -- WE HAVE THEM ALL 1710 ' 1720 RETURN 1730 ' 1740 ' 1750 IF ERR <> 53 THEN ON ERROR GOTO 0:RESUME ' IF ITS NOT "FILE NOT FOUND" 1760 PRINT "COULD NOT FIND " INFILE$: INFILE$ = "": CLOSE: RESUME 720 1770 '--------------------------------------------------------------------- 1780 ' @ADLNUM 1790 ' Add line numbers (start at STARTNUM increase by STEPSIZE) to 1800 ' INFILE$ then write it out to OUTFILE$. This routine is also entered 1810 ' if we just want to strip out line numbers (with DOLINUMS = FALSE) 1820 ' 1830 ' ENTRY: INFILE$ should be opened, DOLINUMS = FALSE or TRRUE 1840 ' EXIT: ADLNUMERR is TRUE or FALSE. 1850 '--------------------------------------------------------------------- 1860 ' 1870 PRINT:PRINT "WRITING " INFILE$ " TO " OUTFILE$ " WITH"; 1880 IF DOLINUMS = FALSE THEN PRINT " NO"; 1890 PRINT " LINE NUMBERS "; 1900 IF DOLINUMS = TRUE THEN PRINT STARTNUM "," STEPSIZE "."; 1910 PRINT 1920 PRESNUM = STARTNUM 1930 LNTEMP$ = OUTFSPEC$ + ".TMP" 1940 OPEN "O",#3,LNTEMP$ 1950 FIRSTFND = TRUE 1960 WHILE EOF(1) = FALSE 1970 IF DOLINUMS = TRUE THEN ADD$ = MID$(STR$(PRESNUM),2) + " " ELSE ADD$ = "" 1980 LINE INPUT #1,PRESLINE$ 1990 ONECHAR$ = LEFT$(PRESLINE$,1) ' HERE, WE GET RID OF EXISTING 2000 IF ONECHAR$ < "1" OR ONECHAR$ > "9" THEN GOTO 2100 ' LINE NUMBER 2010 WHILE ONECHAR$ => "0" AND ONECHAR$ <= "9" ' BUT NOT IF IT 2020 IF FIRSTFND = TRUE THEN GOSUB 2200: FIRSTFND = FALSE: IF A$ <> "Y" THEN CLOSE: RETURN ' @WARNING, there is already numbers 2030 PRESLINE$ = RIGHT$(PRESLINE$,(LEN(PRESLINE$)-1)) ' STARTS WITH 2040 ONECHAR$ = LEFT$(PRESLINE$,1) ' A ZERO (MIGHT 2050 WEND ' BE SBASIC LABEL) 2060 ' NOW GET RID OF ANY EXTRA SPACES 2070 ' 2080 IF ONECHAR$ = " " THEN PRESLINE$ =RIGHT$(PRESLINE$,(LEN(PRESLINE$)-1)): ONECHAR$ = LEFT$(PRESLINE$,1) 2090 IF ONECHAR$ = " " THEN PRESLINE$ =RIGHT$(PRESLINE$,(LEN(PRESLINE$)-1)): ONECHAR$ = LEFT$(PRESLINE$,1) 2100 PRESLINE$ = ADD$ + PRESLINE$ 2110 PRESNUM = PRESNUM + STEPSIZE 2120 PRINT #3,PRESLINE$ 2130 WEND 2140 CLOSE 2150 IF DOLINUMS = FALSE AND FIRSTFND = TRUE THEN PRINT BELL$: PRINT "COULD NOT FIND ANY LINE NUMBERS IN " INFILE$: KILL LNTEMP$: RETURN 2160 IF OUTFILE$ = INFILE$ THEN KILL INFILE$ 2170 IF KILLOLDOUT = TRUE THEN KILL OUTFILE$ 2180 NAME LNTEMP$ AS OUTFILE$ 2190 RETURN 2200 '---------------------------------------------------------------------- 2210 ' @WARNING 2220 ' Here we have found line numbers already in the file so 2230 ' warn user and find out if he wants to proceed. 2240 ' 2250 ' ENTRY: no parms. 2260 ' EXIT: A$ = "Y" if we are to proceed, else it = "X", ABORT is set or 2270 ' cleared. 2280 '------------------------------------------------------------------------- 2290 ' 2300 IF HAVECL = TRUE THEN A$ = "Y": PRINT "STRIPPING OUT OLD LINE NUMBERS": RETURN 2310 IF DOLINUMS = FALSE AND DOLABELS = FALSE THEN PRINT "HAVE FOUND LINE NUMBERS IN " INFILE$ NL$ "STRIPPING AND WRITING TO " OUTFILE$: A$ = "Y": RETURN 2320 PRINT BELL$: PRINT "WARNING -- numbered lines already in the file," 2330 PRINT INFILE$ ", starting at line number" PRESNUM 2340 PRINT "Do you wish to proceed (strip/overwrite old numbers) ?" 2350 PRINT "(Input 'Y' to proceed -- anything else will abort): "; 2360 GOSUB 4170 : PRINT A$ ' GET THE CHAR 2370 IF A$ <> "Y" THEN A$ = "X": ABORT = TRUE: CLOSE: KILL LNTEMP$: PRINT "PROCESS ABORTED" 2380 RETURN 2390 ' 2400 ' 2410 '---------------------------------------------------------------------- 2420 ' @RESOLVE 2430 ' 2440 ' Find all lines starting with a label (marked by MARKER 2450 ' [usually '@']). Set them up with their line numbers in LABTABLE$() 2460 ' ENTRY: INFILE$ is opened. 2470 ' EXIT: LABTABLE$ is set up, LABTABCNT has the number of labels. 2480 ' 2490 '----------------------------------------------------------------------- 2500 ' 2510 LABTABCNT = 1: PRESNUM = STARTNUM 2520 PRINT "PASS ONE: RESOLVING LABELS IN " INFILE$ " MARKED BY " MARKER$ 2530 WHILE EOF(1) = FALSE 2540 POSPTR = 1 2550 LINE INPUT #1,PRESLINE$ 2560 GOSUB 5380 ' TO @SPACES 2570 IF MID$(PRESLINE$,POSPTR,1) = MARKER$ THEN GOSUB 2660 ' TO @ADDLAB 2580 PRESNUM = PRESNUM + STEPSIZE 2590 WEND 2600 CLOSE #1 ' Now we just close and open to reset 2610 OPEN "I",#1,INFILE$ 2620 RETURN 2630 ' 2640 ' Ye Gods!!! That was simple! 2650 ' 2660 '------------------------------------------------------------------------ 2670 ' @ADDLAB 2680 ' Add a label and its line number to the LABTAB$(). Increment LABTABCNT 2690 '------------------------------------------------------------------------- 2700 GOSUB 2770 ' TO @GETWORD -- First we resolve the word. 2710 LABTAB$(1,LABTABCNT) = GOTWORD$ 2720 LABTAB$(2,LABTABCNT) = MID$(STR$(PRESNUM),2) 2730 LABTABCNT = LABTABCNT + 1 2740 RETURN 2750 ' 2760 ' 2770 '---------------------------------------------------------------------- 2780 ' @GETWORD 2790 ' Get the syntactic word at the location in PRESLINE$ pointed to by 2800 ' POSPTR, and return it (uppercase) in GOTWORD$.POSPTR is preserved. 2810 '------------------------------------------------------------------------ 2820 GETVAR = POSPTR 2830 GOTWORD$ = "" 2840 GPRESCHR$ = MID$(PRESLINE$,GETVAR,1) 2850 WHILE GETVAR <= LEN(PRESLINE$) 2860 IF GPRESCHR$ < "#" THEN GOTO 2960 ' TO @OUTLOOP 2870 IF GPRESCHR$ = CHR$(39) THEN GOTO 2960 ' TO @OUTLOOP 2880 IF GPRESCHR$ > "9" AND GPRESCHR$ < "?" THEN GOTO 2960 ' TO @OUTLOOP 2890 IF GPRESCHR$ = CHR$(96) THEN GOTO 2960 ' TO @OUTLOOP 2900 IF GPRESCHR$ > CHR$(126) THEN GOTO 2960 ' TO @OUTLOOP 2910 IF GPRESCHR$ => "a" AND GPRESCHR$ <= "z" THEN GPRESCHR$ = CHR$(ASC(GPRESCHR$) - 32) 2920 GOTWORD$ = GOTWORD$ + GPRESCHR$ 2930 GETVAR = GETVAR + 1 2940 GPRESCHR$ = MID$(PRESLINE$,GETVAR,1) 2950 GOTO 2980 ' TO @GLOOPEND 2960 '@OUTLOOP -- Force exit from loop 2970 GETVAR = LEN(PRESLINE$) + 1 2980 '@GLOOPEND 2990 WEND 3000 ' 3010 ' 3020 RETURN 3030 ' 3040 ' 3050 '--------------------------------------------------------------------- 3060 ' @ADLABLN 3070 ' Find and resolve all program jump LABELS, replacing them with 3080 ' line numbers (start at STARTNUM increase by STEPSIZE). Read 3090 ' INFILE$ then write it out to OUTFILE$. Optionally add numbers 3100 ' to all other lines (if DOLINUMS is true). 3110 ' 3120 ' ENTRY: INFILE$ should be opened. LABTAB$ should be set up. 3130 ' EXIT: ADLNUMERR is TRUE or FALSE. 3140 '--------------------------------------------------------------------- 3150 ' 3160 PRINT:PRINT "PASS TWO:" 3170 PRINT:PRINT "WRITING " INFILE$ " TO " OUTFILE$ " WITH"; 3180 IF DOLINUMS = FALSE THEN PRINT " NO"; 3190 PRINT " LINE NUMBERS "; 3200 PRINT STARTNUM "," STEPSIZE "." 3210 PRESNUM = STARTNUM 3220 PRINT "WITH LABEL RESOLUTION. -- MARKER = " MARKER$ 3230 PRINT "PLEASE WAIT" 3240 LNTEMP$ = OUTFSPEC$ + ".TMP" 3250 OPEN "O",#3,LNTEMP$ 3260 FIRSTFND = TRUE 3270 WHILE EOF(1) = FALSE 3280 ADD$ = MID$(STR$(PRESNUM),2) + " " ' GET RID OF LEADING BLANK IN STR$ FUNCT. 3290 LINE INPUT #1,PRESLINE$ 3300 POSPTR = 1 3310 GOSUB 5380 ' clear leading white space, and 3320 ONECHAR$ = MID$(PRESLINE$,POSPTR,1) ' see if we have a @LABEL 3330 IF ONECHAR$ = MARKER$ THEN ADD$ = ADD$ + "'": GOTO 3480 3340 ONECHAR$ = LEFT$(PRESLINE$,1) ' HERE, WE GET RID OF EXISTING 3350 IF ONECHAR$ < "1" OR ONECHAR$ > "9" THEN GOTO 3470 ' LINE NUMBER 3360 WHILE ONECHAR$ => "0" AND ONECHAR$ <= "9" ' BUT NOT IF IT 3370 IF FIRSTFND = TRUE THEN GOSUB 2290: FIRSTFND = FALSE: IF A$ <> "Y" THEN CLOSE: RETURN ' @WARNING, we already have line numbers 3380 ' 3390 PRESLINE$ = RIGHT$(PRESLINE$,(LEN(PRESLINE$)-1)) ' STARTS WITH 3400 ONECHAR$ = LEFT$(PRESLINE$,1) ' A ZERO (MIGHT 3410 WEND ' BE SBASIC LABEL) 3420 ' NOW GET RID OF ANY EXTRA SPACES 3430 ' 3440 IF ONECHAR$ = " " THEN PRESLINE$ =RIGHT$(PRESLINE$,(LEN(PRESLINE$)-1)): ONECHAR$ = LEFT$(PRESLINE$,1) 3450 IF ONECHAR$ = " " THEN PRESLINE$ =RIGHT$(PRESLINE$,(LEN(PRESLINE$)-1)): ONECHAR$ = LEFT$(PRESLINE$,1) 3460 ' AND ADD IN OUR OWN SPACE 3470 IF DOLINUMS = FALSE THEN ADD$ = "" ' We arive here only if we have no label 3480 PRESLINE$ = ADD$ + PRESLINE$ 3490 POSPTR = LEN(ADD$): IF POSPTR = 0 THEN POSPTR = 1 3500 GOSUB 3590 ' @FINDLAB *** Here we find the labels. *** 3510 PRESNUM = PRESNUM + STEPSIZE 3520 PRINT #3,PRESLINE$ 3530 WEND 3540 CLOSE 3550 IF OUTFILE$ = INFILE$ THEN KILL INFILE$ 3560 IF KILLOLDOUT = TRUE THEN KILL OUTFILE$ 3570 NAME LNTEMP$ AS OUTFILE$ 3580 RETURN 3590 '------------------------------------------------------------------- 3600 ' @FINDLAB 3610 ' FIND ANY LABEL REFERENCES IN PRESLINE$, RESOLVE THEM, AND REBUILD 3620 ' PRESLINE$. AT ALL TIMES POSPTR POINTS TO THE NEXT CHARACTER TO BE 3630 ' PICKED UP. 3640 '-------------------------------------------------------------------- 3650 ' 3660 FLOUTFLAG = FALSE 3670 LINEND$ = "": INQUOTE = FALSE: LEADSP = FALSE 3680 WHILE FLOUTFLAG = FALSE AND POSPTR <= LEN(PRESLINE$) 3690 PRESCHAR$ = MID$(PRESLINE$,POSPTR,1) 3700 IF PRESCHAR$ = QUOTES$ THEN IF INQUOTE = FALSE THEN INQUOTE = TRUE ELSE INQUOTE = FALSE 3710 IF INQUOTE = TRUE THEN GOTO 3760 3720 IF PRESCHAR$ = " " OR PRESCHAR$ = TAB$ THEN LEADSP = TRUE: GOTO 3760 3730 IF PRESCHAR$ = "'" THEN FLOUTFLAG = TRUE: GOTO 3770 ' TO @FLWEND 3740 IF LEADSP = TRUE AND PRESCHAR$ = MARKER$ THEN GOSUB 3810 ' TO @GOTALAB 3750 LEADSP = FALSE 3760 POSPTR = POSPTR + 1 3770 ' @FLWEND 3780 WEND 3790 IF ADDVECTS = TRUE THEN PRESLINE$ = PRESLINE$ + LINEND$ 3800 RETURN 3810 '------------------------------------------------------------------- 3820 ' @GOTALAB 3830 ' 3840 ' WE HAVE A LABEL SO PROCESS IT. 3850 '------------------------------------------------------------------ 3860 GOSUB 2770 ' Get a word. 3870 IF LEN(GOTWORD$) = 1 THEN RETURN ' we do not resolve a solo @ 3880 GTLN$ = "" 3890 FOR GTI = 1 TO LABTABCNT 3900 IF GOTWORD$ = LABTAB$(1,GTI) THEN GTLN$ = LABTAB$(2,GTI): GTI = LABTABCNT + 1 3910 NEXT GTI 3920 IF GTLN$ = "" THEN PRINT GOTWORD$ " AT LINE " PRESNUM " -- TARGET NOT FOUND": RETURN 3930 IF LINEND$ = "" THEN LINEND$ = " ' TO: " ELSE LINEND$ = LINEND$ + ", " 3940 LINEND$ = LINEND$ + GOTWORD$ 3950 GTEMP$ = LEFT$(PRESLINE$,POSPTR-1) 3960 RGT = LEN(PRESLINE$) - POSPTR - LEN(GOTWORD$) + 1 3970 PRESLINE$ = GTEMP$ + GTLN$ + RIGHT$(PRESLINE$,RGT) 3980 POSPTR = POSPTR + LEN(GOTWORD$) - 1 3990 RETURN 4000 ' 4010 ' 4020 '----------------------------------------------------------------- 4030 ' @LINEUP 4040 ' Get an upper case line from the user. 4050 ' 4060 ' Exit: UPLINE$ has the line 4070 '------------------------------------------------------------------- 4080 UPLINE$ = "": INPUT "", TEMP$ 4090 FOR LU = 1 TO LEN(TEMP$) 4100 ULC$ = MID$(TEMP$,LU,1) 4110 IF ULC$ => "a" AND ULC$ <= "z" THEN ULC$ = CHR$(ASC(ULC$) - 32) 4120 UPLINE$ = UPLINE$ + ULC$ 4130 NEXT LU 4140 RETURN 4150 ' 4160 ' 4170 '---------------------------------------- 4180 ' STROBE KEY -- TOUPPER 4190 ' 4200 A$ = "": WHILE A$ = "": A$=INKEY$: WEND 4210 IF A$ => "a" AND A$ <= "z" THEN A$ = CHR$(ASC(A$) - 32) 4220 RETURN 4230 ' 4240 ' 4250 '------------------------------------------------------------ 4260 ' @clearscreen (& home) 4270 ' The clear screen is machine dependant, so I isolate it 4280 ' in its own routine for easy changes. 4290 '---------------------------------------------------------- 4300 PRINT CLS$; 4310 RETURN 4320 ' 4330 ' 4340 '-------------------------------------------------------- 4350 ' @SIGNON 4360 '-------------------------------------------------------- 4370 GOSUB 4250 ' @CLEARSCREEN 4380 PRINT "PREBAS -- A pre-processor for BASIC" 4390 PRINT "Copyright (c) 1985 by Greywolf" 4400 PRINT "Last revised -- " REVDATE$ 4410 PRINT:PRINT:PRINT 4420 RETURN 4430 ' 4440 '------------------------------------------------------------------- 4450 ' @PARSECL 4460 ' 4470 ' Parse the command line for two filespecs, and optional 4480 ' parameters proceeded by "$". 4490 ' 4500 ' ENTRY: no parms 4510 ' EXIT: INFSPEC$, INFEXT$, INFILE$, OUTFSPEC$, OUTFEXT$, OUTFILE$, 4520 ' MARKER$ all filled if present. STARTNUM, STEPSIZE initialized. 4530 ' DOLINUMS, DOLABELS, ADDVECTS set or reset. (All on CL demands.) 4540 ' HAVECL, CLERROR set TRUE or FALSE. 4550 '--------------------------------------------------------------------- 4560 '@PARSECL 4570 ' 4580 IF MSDOS = TRUE THEN RETURN ' I DONT KNOW WHICH SEGMENT ITS 4590 ' GOING TO BE IN. 4600 IF COMPILE = FALSE THEN RETURN ' No comline under interpreter. 4610 PRESLINE$ = "" 4620 COMLEN = PEEK(COMBUF) ' Get the size 4630 IF COMLEN = 0 THEN RETURN 4640 POSPTR = COMBUF + 1 4650 FOR CLI = POSPTR TO POSPTR + COMLEN - 1 4660 PRESLINE$ = PRESLINE$ + CHR$(PEEK(CLI)) 4670 NEXT CLI 4680 ' 4690 '@PARSE3 4700 ' We have a comline, break it up 4710 ' 4720 PRFLAG = FALSE ' Kludge so I can still set KILLOLDOUT when we have $ 4730 ' following just one filename. 4740 POSPTR = 1 4750 GOSUB 5380 ' Clear initial white space TO: @SPACES 4760 IF POSPTR > COMLEN THEN RETURN 4770 '@REALINE ' We have a real command line! 4780 GOSUB 5540 ' So get the first word ' TO: @PWORD 4790 GSPEC$ = PARWORD$ 4800 GOSUB 6870 ' @GETSPEC 4810 IF GOTSPEC$ = "" THEN GOSUB 6760: CLERROR = TRUE: RETURN ' TO: @SYNERR 4820 ' 4830 ' WHOOPEE! We have an infile 4840 HAVECL = TRUE 4850 INFSPEC$ = GOTSPEC$ 4860 IF GOTEXT$ <> "" THEN INFEXT$ = GOTEXT$ 4870 INFILE$ = INFSPEC$ + INFEXT$ 4880 OUTFSPEC$ = GOTSPEC$: OUTFILE$ = OUTFSPEC$ + OUTFEXT$ 4890 ' 4900 ON ERROR GOTO 4940 4910 OPEN "I",#1,INFILE$ 4920 ON ERROR GOTO 0 ' We have our infile, so 4930 GOTO 4960 ' proceed. 4940 IF ERR <> 53 THEN ON ERROR GOTO 0: RESUME ' Not "file not found"? 4950 PRINT "COULD NOT FIND " INFILE$: CLERROR = TRUE: RETURN 4960 GOSUB 5380 ' TO: @SPACES 4970 IF POSPTR > COMLEN THEN GOTO 5150 ' Find out if there is already an outfile 4980 PCHAR$ = MID$(PRESLINE$,POSPTR,1) ' No? then do we have a "$" 4990 IF PCHAR$ = "$" THEN PRFLAG = TRUE: GOTO 5150 5000 ' 5010 ' WE HAVE ANOTHER FILESPEC 5020 ' 5030 GOSUB 5540 ' So get the next word ' TO: @PWORD 5040 GSPEC$ = PARWORD$ 5050 GOSUB 6870 ' @GETSPEC 5060 IF GOTSPEC$ = "" THEN GOSUB 6760: CLERROR = TRUE: RETURN ' TO: @SYNERR 5070 ' 5080 ' WHOOPEE! We have an outfile 5090 OUTFSPEC$ = GOTSPEC$ 5100 IF GOTEXT$ <> "" THEN OUTFEXT$ = GOTEXT$ 5110 OUTFILE$ = OUTFSPEC$ + OUTFEXT$ 5120 ' 5130 IF OUTFILE$ = INFILE$ THEN GOTO 5240 ' IF THEY ARE THE SAME WE KNOW 5140 ' THE OUTFILE ALREADY EXISTS 5150 ON ERROR GOTO 5180 5160 OPEN "I",#2,OUTFILE$ ' JUST SEE IF ITS THERE 5170 GOTO 5200 ' WE ALREADY HAVE THE OUTFILE 5180 IF ERR <> 53 THEN ON ERROR GOTO 0: RESUME 5190 RESUME 5220 'IF THERE WAS AN ERROR THERE WAS NO OLD OUTFILE SO WERE OK 5200 KILLOLDOUT = TRUE 5210 ' 5220 ON ERROR GOTO 0 5230 IF PRFLAG = TRUE THEN GOSUB 5730: RETURN ' TO: @PARAMS 5240 GOSUB 5380 ' TO: @SPACES 5250 IF POSPTR > COMLEN THEN RETURN ' Was there anything else on line 5260 PCHAR$ = MID$(PRESLINE$,POSPTR,1) ' Yes? then do we have a "$" 5270 IF PCHAR$ = "$" THEN GOSUB 5730: RETURN ' TO: @PARAMS 5280 ' 5290 ' 5300 ' 5310 '------------------------------------------------------------ 5320 ' @SPACES 5330 ' Clear spaces from PRESLINE$ at POSPTR 5340 ' 5350 ' ENTRY: POSPTR points to the next pos in PRESLINE$ 5360 ' EXIT: POSPTR points to the next non-white char, or is > LEN(PRESLINE$) 5370 '------------------------------------------------------------ 5380 '@SPACES 5390 SPCHAR$ = MID$(PRESLINE$,POSPTR,1) 5400 WHILE (SPCHAR$ = TAB$ OR SPCHAR$ = " ") AND POSPTR <= LEN(PRESLINE$) 5410 POSPTR = POSPTR + 1 5420 SPCHAR$ = MID$(PRESLINE$,POSPTR,1) 5430 WEND 5440 RETURN 5450 ' 5460 ' 5470 '------------------------------------------------------------ 5480 ' @PWORD 5490 ' Return the next word at POSPTR (in uppercase) 5500 ' ENTRY: POSPTR is next char. 5510 ' EXIT: POSPTR points to next white char or "$" or is > LEN(PRESLINE$) 5520 ' PARWORD$ contains the word. 5530 '------------------------------------------------------------ 5540 '@PWORD 5550 PARWORD$ = "" 5560 SPCHAR$ = MID$(PRESLINE$,POSPTR,1) 5570 WHILE SPCHAR$ <> TAB$ AND SPCHAR$ <> " " AND SPCHAR$ <> "$" AND POSPTR <= LEN(PRESLINE$) 5580 IF SPCHAR$ => "a" AND SPCHAR$ <= "z" THEN SPCHAR$ = CHR$(ASC(SPCHAR$) - 32) ' Covert to upper, so we don't get no funny filenames 5590 PARWORD$ = PARWORD$ + SPCHAR$ 5600 POSPTR = POSPTR + 1 5610 SPCHAR$ = MID$(PRESLINE$,POSPTR,1) 5620 WEND 5630 RETURN 5640 ' 5650 ' 5660 '------------------------------------------------------------ 5670 ' @PARAMS 5680 ' Get any CL parameters, using the CPM convention of $P1 P2... 5690 ' ENTRY: POSPTR points at a trailing "$" in PRESLINE$ 5700 ' EXIT: Any valid parm is set up. If there is a syntax error, 5710 ' we print a message and set CLERROR. 5720 '------------------------------------------------------------ 5730 '@PARAMS 5740 POSPTR = POSPTR + 1 ' Step over the $ 5750 GOSUB 5380 ' TO: @SPACES 5760 WHILE POSPTR <= COMLEN AND CLERROR = FALSE 5770 PLUSMIN$ = "?" 5780 '@GETPR 5790 C$ = MID$(PRESLINE$,POSPTR,1) 5800 IF C$ => "a" AND C$ <= "z" THEN C$ = CHR$(ASC(C$) - 32) 5810 IF C$ = "+" OR C$ = "-" THEN PLUSMIN$ = C$: POSPTR = POSPTR + 1: GOTO 5780 ' TO: @GETPR 5820 ' 5830 ' Here we look up what option is on the CL 5840 ' 5850 IF C$ = "L" THEN GOSUB 6040: GOTO 5930 ' TO: @PRLABS, @WEOK 5860 IF C$ = "S" THEN GOSUB 6300: GOTO 5930 ' TO: @PRSNUM, @WEOK 5870 IF C$ = "P" THEN GOSUB 6400: GOTO 5930 ' TO: @PRSTEP, @WEOK 5880 IF C$ = "M" THEN GOSUB 6500: GOTO 5930 ' TO: @PRMARK, @WEOK 5890 IF C$ = "N" THEN GOSUB 6170: GOTO 5930 ' TO: @PRNUMS, @WEOK 5900 IF C$ = "C" THEN GOSUB 6620: GOTO 5930 ' TO: @PRCOMS, @WEOK 5910 ' 5920 CLERROR = TRUE 5930 '@WEOK 5940 GOSUB 5380 ' TO: @SPACES 5950 WEND 5960 ' 5970 IF CLERROR= TRUE THEN GOSUB 6760 ' TO: @SYNERR 5980 ' 5990 RETURN 6000 ' 6010 '------------------------------------------------------------ 6020 ' @PRLABS 6030 ' Do we do labels? 6040 '@PRLABS 6050 POSPTR = POSPTR + 1 6060 GOSUB 5540 ' TO: @PWORD 6070 IF PARWORD$ <> "" THEN CLERROR = TRUE: RETURN 6080 IF PLUSMIN$ = "+" THEN DOLABELS = TRUE: RETURN 6090 IF PLUSMIN$ = "-" THEN DOLABELS = FALSE: RETURN 6100 CLERROR = TRUE 6110 RETURN 6120 ' 6130 ' 6140 '------------------------------------------------------------ 6150 ' @PRNUMS 6160 ' Do we do line numbering 6170 '@PRNUMS 6180 POSPTR = POSPTR + 1 6190 GOSUB 5540 ' TO: @PWORD 6200 IF PARWORD$ <> "" THEN CLERROR = TRUE: RETURN 6210 IF PLUSMIN$ = "+" THEN DOLINUMS = TRUE: RETURN 6220 IF PLUSMIN$ = "-" THEN DOLINUMS = FALSE: RETURN 6230 CLERROR = TRUE 6240 RETURN 6250 ' 6260 ' 6270 '------------------------------------------------------------ 6280 ' @PRSNUM 6290 ' What is the start number? 6300 '@PRSNUM 6310 POSPTR = POSPTR + 1 6320 GOSUB 5540 ' TO: @PWORD 6330 STARTNUM = VAL(PARWORD$) 6340 RETURN 6350 ' 6360 ' 6370 '------------------------------------------------------------ 6380 ' @PRSTEP 6390 ' What is the stepsize? 6400 '@PRSTEP 6410 POSPTR = POSPTR + 1 6420 GOSUB 5540 ' TO: @PWORD 6430 STEPSIZE = VAL(PARWORD$) 6440 RETURN 6450 ' 6460 ' 6470 '------------------------------------------------------------ 6480 ' @PRMARK 6490 ' What is the new MARKER$ (NO ERROR CHECKING) 6500 '@PRMARK 6510 POSPTR = POSPTR + 1 6520 GOSUB 5540 ' TO: @PWORD 6530 IF LEN(PARWORD$) <> 1 THEN CLERROR = TRUE: RETURN 6540 MARKER$ = PARWORD$ 6550 RETURN 6560 ' 6570 ' 6580 ' 6590 '------------------------------------------------------------ 6600 ' @PRCOMS 6610 ' Do we add vector comments to the end of lines? 6620 '@PRCOMS 6630 POSPTR = POSPTR + 1 6640 GOSUB 5540 ' TO: @PWORD 6650 IF PARWORD$ <> "" THEN CLERROR = TRUE: RETURN 6660 IF PLUSMIN$ = "+" THEN ADDVECTS = TRUE: RETURN 6670 IF PLUSMIN$ = "-" THEN ADDVECTS = FALSE: RETURN 6680 CLERROR = TRUE 6690 RETURN 6700 ' 6710 ' 6720 '------------------------------------------------------------ 6730 ' @SYNERR 6740 ' We have a command line syntax error -- tell user 6750 ' 6760 '@SYNERR 6770 PRINT 6780 PRINT "SYNTAX ERROR -- Proper syntax is:" 6790 PRINT "PREBAS INFILE[.EXT] [OUTFILE[.EXT]] " 6800 PRINT "[$[{+,-}L] [{+,-}N] [{+,-}C] [Mc] [Sxxx] [Pxxx]]" 6810 PRINT 6820 RETURN 6830 ' 6840 ' 6850 ' 6860 ' 6870 '------------------------------------------------------------ 6880 ' @GETSPEC 6890 ' 6900 ' Take the string in GSPEC$ and split it into a filespec, and 6910 ' a file extent (if present). Return in GOTSPEC$ and GOTEXT$ 6920 '------------------------------------------------------------- 6930 GOTSPEC$ = "": GOTEXT$ = "" 6940 GSPTR = 1 6950 GSCHAR$ = MID$(GSPEC$,GSPTR,1) 6960 WHILE GSPTR <= LEN(GSPEC$) AND GSCHAR$ <> "." 6970 GOTSPEC$ = GOTSPEC$ + GSCHAR$ 6980 GSPTR = GSPTR + 1 6990 GSCHAR$ = MID$(GSPEC$,GSPTR,1) 7000 WEND 7010 ' 7020 ' We have the fspec, see if theres a fext. 7030 ' 7040 IF GSCHAR$ <> "." THEN RETURN 7050 GOTEXT$ = "." 7060 FOR GSI = GSPTR + 1 TO GSPTR + 4 7070 GOTEXT$ = GOTEXT$ + MID$(GSPEC$,GSI,1) 7080 NEXT GSI 7090 ' 7100 RETURN 7110 ' 7120 CLERROR = TRUE: RETURN PTR + 4 7070 GOTEXT$ = GOTEXT$ + MID$(GSPEC$,GSI,1)