IMD 1.16: 29/05/2007 12:30:00 FOGCPM.034 --FOGCPM034CURVEFITBAS CURVEFITBAS`-04-00 86 CURVEXXYTXT !"#$%&'()*+,-.CURVEXXYTXT/012-CPM034 DOCCURVECPMXRF3456789:;<=>?@ABCURVECPMXRF`CDEFGHIJKLMNNBR DOC(OPQRSNBR-MBASTXTTUVWXYZ[\]^_`abcNBR-MBASTXTdefghijklmnopqrsNBR-MBASTXTtuvNBR124 ASCZwxyz{|}~NBR124 BAS0NBR124 NUM5NBR124 SYMNBR13 ASC^NBR13 BAS.NBR13 NUM4NBR13 SYMThis is the disk name. 1 REM CURFIT16.BAS 12/25/85 chgd 20055, 20067, 20068, 14570, 35015, 15102, 35016,20041,3590,3584,4507 2 REM READS ASCII OR BASIC OR SUPERCALC .PRN FILES, DELETES NULL LINES 5 DEFDBL A,B,C,S,R,X,Y,Z 6 DIM EQ$(25):GOSUB 55000 7 CL$=CHR$(26) 33 PRINT CL$ 55 DIM X1$(100),Y1$(100),X$(100),Y$(100),X(100),Y(100),R(65),RR(25) 56 DIM RC(25),A(25),B(25),C(25) 57 XQ=0 110 FOR I=1 TO 100: X$(I)="END":Y$(I)="END":NEXT I:PRINT CL$:IF XQ=1 THEN 1000 120 PRINT CL$:PRINT TAB(15);"==================================================" 130 PRINT TAB(15);"| CURVE-FITTING BY Thomas S. Cox Version 2.04|" 131 PRINT TAB(15);"| (C) 1985 December 25, 1985 Revision |" 132 PRINT TAB(15);"| MBASIC (C) Microsoft required for this Pgm. |" 133 PRINT TAB(15);"|________________________________________________|" 134 PRINT TAB(15);"| Your Choices are: |" 140 PRINT TAB(15);"| 1. ENTER NEW DATA |" 150 PRINT TAB(15);"| 2. ADD DATA POINTS TO PREVIOUS DATA |" 160 PRINT TAB(15);"| 3. DELETE OR CHANGE DATA POINTS |" 170 PRINT TAB(15);"| 4. CALCULATE EQUATION COEFFICIENTS |" 180 PRINT TAB(15);"| 5. PREDICT VALUE OF Y, GIVEN X |" 190 PRINT TAB(15);"| 6. STORE RAW DATA (X AND Y POINTS) TO DISK|" 200 PRINT TAB(15);"| 7. LOAD RAW DATA FROM DISK |" 210 PRINT TAB(15);"| 8. EXIT FROM PROGRAM (TO BASIC) |" 220 PRINT TAB(15);"| 9. LIST X AND Y DATA POINTS ENTERED |" 230 PRINT TAB(15);"| 10. LIST SUMS AND SUMS OF SQUARES |" 240 PRINT TAB(15);"| 11 LIST EQUATIONS FITTED (SCREEN ONLY) |" 250 PRINT TAB(15);"| 12. PRINT EQUATION COEFFICIENTS A, B, C |" 270 PRINT TAB(15);"| ENTER NUMBER (1-12) OF YOUR CHOICE |" 275 PRINT TAB(15);"|*** NOTE: PLEASE LIMIT X & Y <= +/- 10,000 ***|" 280 PRINT TAB(15);"|================================================|" 283 PRINT " " 284 LP=0 285 PRINT TAB(15);:INPUT XQ 287 IF XQ<1 OR XQ>12 GOTO 120 290 ON XQ GOTO 110,2000,3000,4000,4990,6030,7030,8000,9005,40025,10000,4040 1000 PRINT CL$: PRINT "DATA ENTRY ROUTINE": PRINT " " 1002 INPUT "List DATA on printer (Y or N)";Q1$ 1003 GOSUB 50000 1010 PRINT "Enter (S)top for X or Y to terminate data entry." 1020 M=1 1030 FOR J=M TO 100 1040 PRINT "X( ";J;" )= ";:INPUT X$(J) 1050 IF LEFT$(X$(J),1)="S" OR LEFT$(X$(J),1)="s" GOTO 1500 1060 PRINT "Y( ";J;" )= ";:INPUT Y$(J) 1070 IF LEFT$(Y$(J),1)="S" OR LEFT$(Y$(J),1)="s" GOTO 1500 1075 IF LP=1 THEN LPRINT"X( ";J;" )= ";X$(J);TAB(40);"Y( ";J;" )= ";Y$(J) 1080 NEXT J 1090 PRINT"Sorry, no more room for data":GOTO 130 1500 X$(J)="END":Y$(J)="END":PRINT"(S)top encountered. More Data (Y or N).";:INPUT A$ 1510 IF A$ <> "Y" OR A$ <> "y" THEN GOTO 4620 1520 GOTO 1040 2000 PRINT CL$:PRINT"DATA ADDITION ROUTINE":PRINT" " 2005 PRINT"To end data entry, please enter 'S' or 's' for X or Y entry" 2010 FOR M=1 TO 100 2020 IF X$(M)="END" OR Y$(M)="END" THEN PRINT "Next Data Point will be number ";M:GOTO 1030 2030 NEXT M 2040 PRINT "No Room for Additional data: Sorry. ":GOTO 130 3000 PRINT CL$: PRINT "Data Deletion or Change Routine" 3010 INPUT "Do you wish to see the data previously entered (Y or N)";A$ 3020 IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN Q7=1:GOSUB 9005 3030 INPUT"Point number to change ";Q 3040 PRINT"The current values are ";"X( ";Q;")= ";X$(Q),"Y( ";Q;")= ";Y$(Q) 3060 INPUT "(D)elete, (C)hange or (Q)uit (D/C/Q)";A$ 3065 IF LEFT$(A$,1)="Q" OR LEFT$(A$,1)="q" GOTO 120 3070 IF LEFT$(A$,1)="D" OR LEFT$(A$,1)="d" THEN X$(Q)="DEL":Y$(Q)="DEL":GOTO 3400 3080 IF LEFT$(A$,1)="C" OR LEFT$(A$,1)="c" THEN PRINT "X( ";Q;" )= ";:INPUT X$(Q) 3090 PRINT "Y( ";Q;" )= ";:INPUT Y$(Q) 3400 INPUT "More changes (Y or N)";A1$ 3410 IF LEFT$(A1$,1)="Y" OR LEFT$(A1$,1)="y" GOTO 3030 3430 REM * Rearrange Data for Deletions * 3470 K1=1 3480 FOR I= 1 TO 100 3490 X1$(I)=X$(I): Y1$(I)=Y$(I): NEXT I 3540 FOR I= 1 TO 100 3545 IF X1$(I)="DEL" THEN 3580 3550 GOSUB 3587 3570 IF X1$(I)="END" THEN X$(K1)="END":Y$(K1)="END": GOTO 3582 3580 NEXT I 3582 FOR I= 1 TO 100: IF X$(I)="END" OR LEFT$(X$(I),1)="S" OR LEFT$(X$(I),1)="s" GOTO 3584 3583 NEXT I 3584 PRINT "There are now "; I-1;" VALID data points. ":FOR I=1 TO 500:NEXT I:GOTO 3590 3587 X$(K1)=X1$(I): Y$(K1)=Y1$(I): K1=K1+1: RETURN 3590 Q7=0:IF QA=1 THEN QA=0:GOTO 20045 3591 IF DE=1 THEN DE=0: GOTO 7090 3600 INPUT "LIST NEW DATA SET (Y/N) ";A2$ 3610 IF A2$="Y" OR A2$= "y" GOTO 9005 ELSE 120 4000 PRINT CL$: PRINT "CALCULATING" 4020 GOTO 20000 4040 PRINT CL$:IF X$(1)="END" OR Y$(1)="END" THEN PRINT "NO DATA ENTERED!": PRINT CHR$(7): FOR I=1 TO 1000: NEXT I: GOTO 120 4220 MX=0 4230 FOR I=1 TO 25 4240 IF RC(I)>MX THEN 4250 4245 GOTO 4260 4250 MX=RC(I):MQ=I 4260 NEXT I 4265 IF R2=1 THEN R2=0 :RETURN 4500 PRINT CHR$(7):A1$="###":A2$="#.####^^^^":A3$="##.####":A0$="###.####" 4501 INPUT "Output coefficients to printer (Y or N)";Q1$ 4502 PRINT CL$:GOSUB 50000 4503 A4$="EQ# COEF A COEF B COEF C R^2 R^2 C EQUATION" 4505 INPUT"Print A, B, and R^2 to SCREEN (ALL DIGITS) First? {Y}es or {N}o ";A$:IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN 35000 4507 PRINT CL$:INPUT"View Coefficients (A, B, C, R, R^2, EQn) {Y}es or {N}o ";AS$:IF LEFT$(A$,1)="N" OR LEFT$(A$,1)="n" THEN 4572 4510 PRINT CL$:PRINT A4$ 4515 LC=0 4520 FOR I= 1 TO 22 4521 IF A(I)=0 AND B(I)=0 THEN 4532 4530 PRINT USING A1$;I;:PRINT" ";:PRINT USING A2$;A(I);:PRINT" ";:PRINT USING A2$;B(I);:PRINT" ";:PRINT USING A2$;C(I);:PRINT" ";:PRINT USING A3$;RR(I);:PRINT USING A0$;RC(I);:PRINT" ";:PRINT EQ$(I):LC=LC+1 4532 NEXT I 4535 IF LP=1 THEN 4560 4536 IF LC<=19 THEN 4560 4540 PRINT"To see the remaining Coefficients, ";:GOSUB 64000 4550 PRINT A4$ 4560 FOR I= 23 TO 25 4561 IF A(I)=0 AND B(I)=0 THEN 4571 4570 PRINT USING A1$;I;:PRINT" ";:PRINT USING A2$;A(I);:PRINT" ";:PRINT USING A2$;B(I);:PRINT" ";:PRINT USING A2$;C(I);:PRINT" ";:PRINT USING A3$;RR(I);:PRINT USING A0$;RC(I);:PRINT" ";:PRINT EQ$(I) 4571 NEXT I 4572 IF LP<>1 THEN 4580 4573 IF LP=1 THEN LPRINT A4$ 4574 FOR I=1 TO 25 4575 IF A(I)=0 AND B(I)=0 THEN 4578 4576 IF LP=1 THEN LPRINT USING A1$;I;:LPRINT" ";:LPRINT USING A2$;A(I);:LPRINT" ";:LPRINT USING A2$;B(I);:LPRINT" ";:LPRINT USING A2$;C(I);:LPRINT" ";:LPRINT USING A3$;RR(I);:LPRINT USING A0$;RC(I);:LPRINT" ";:LPRINT EQ$(I) 4578 NEXT I 4580 R2=1: GOSUB 4220 4600 PRINT "Based on RC(), best fit was # ";MQ 4605 IF LP=1 THEN LPRINT"BASED ON RC( )--BEST FIT WAS # ";MQ 4610 INPUT "PRESS to Continue";A$ 4620 IF LP=1 THEN LPRINT CHR$(12) 4630 GOTO 120 4990 PRINT CL$: AZ$="" 5000 K=0:L=0:IF AZ$="S" THEN PRINT "All data entered":GOSUB 64000 5002 PRINT CL$: PRINT "Predicted value of Y, given X":K=1 5003 INPUT "Quit and return to main menu or Predict (Q or P)";AZ$ 5004 PRINT CL$:IF L=1 AND LP=1 THEN LPRINT CHR$(12) 5005 IF LEFT$(AZ$,1)="q" OR LEFT$(AZ$,1)="Q" THEN 120 5006 INPUT "Output results to printer (Y or N) ";Q1$ 5007 GOSUB 50000 5010 INPUT "Starting value for X";SX 5020 INPUT "Ending value for X";EX 5030 INPUT "Step value for X";ST 5040 INPUT "Equation number for prediction (1-25)";EQ 5050 IF EQ<1 OR EQ>25 GOTO 120 5051 IF A(EQ)=0 AND B(EQ)=0 THEN PRINT"THE EQUATION ";EQ$(EQ);" IS NOT DEFINED FOR THIS DATA SET.":PRINT"RETURNING TO MAIN MENU":FOR M=1 TO 2000:NEXT M:GOTO 120 5052 PRINT "PREDICTIONS ARE FOR EQUATION ";TAB(40);EQ$(EQ) 5053 IF LP=1 THEN LPRINT"PREDICTIONS FOR EQUATION ";EQ$(EQ):LPRINT" " 5060 K=1:ON EQ GOTO 5100,5110,5120,5130,5140,5150,5160,5170,5180,5190,5200,5210,5220,5230,5240,5250,5260,5270,5280,5290,5300,5310,5320,5330,5340,5350 5100 FOR Q=SX TO EX STEP ST:Y=A(1)+B(1)*Q:GOSUB 5500:NEXT Q:GOTO 5003 5110 FOR Q=SX TO EX STEP ST:Y=B(2)*Q:GOSUB 5500:NEXT Q:GOTO 5003 5120 FOR Q=SX TO EX STEP ST:Y=1/(A(3)+B(3)*Q):GOSUB 5500:NEXT Q:GOTO 5003 5130 FOR Q=SX TO EX STEP ST:Y=A(4)+B(4)*Q+C(4)/Q:GOSUB 5500:NEXT Q:GOTO 5003 5140 FOR Q=SX TO EX STEP ST:Y=A(5)+B(5)/Q:GOSUB 5500:NEXT Q:GOTO 5003 5150 FOR Q=SX TO EX STEP ST:Y=Q/(A(6)*Q+B(6)):GOSUB 5500:NEXT Q:GOTO 5003 5160 FOR Q=SX TO EX STEP ST:Y=A(7)+B(7)/Q+C(7)/(Q*Q):GOSUB 5500:NEXT Q:GOTO 5003 5170 FOR Q=SX TO EX STEP ST:Y=A(8)+B(8)*Q+C(8)*Q*Q:GOSUB 5500:NEXT Q:GOTO 5003 5180 FOR Q=SX TO EX STEP ST:Y=A(9)*Q+B(9)*Q*Q:GOSUB 5500:NEXT Q:GOTO 5003 5190 FOR Q=SX TO EX STEP ST:Y=A(10)*Q^B(10):GOSUB 5500:NEXT Q:GOTO 5003 5200 FOR Q=SX TO EX STEP ST:Y=A(11)*B(11)^Q:GOSUB 5500:NEXT Q:GOTO 5003 5210 FOR Q=SX TO EX STEP ST:Y=A(12)*B(12)^(1/Q):GOSUB 5500:NEXT Q:GOTO 5003 5220 FOR Q=SX TO EX STEP ST:Y=A(13)*Q^(B(13)*Q):GOSUB 5500:NEXT Q:GOTO 5003 5230 FOR Q=SX TO EX STEP ST:Y=A(14)*Q^(B(14)/Q):GOSUB 5500:NEXT Q:GOTO 5003 5240 FOR Q=SX TO EX STEP ST:Y=A(15)*EXP(B(15)*Q):GOSUB 5500:NEXT Q:GOTO 5003 5250 FOR Q=SX TO EX STEP ST:Y=A(16)*EXP(B(16)/Q):GOSUB 5500:NEXT Q:GOTO 5003 5260 FOR Q=SX TO EX STEP ST:Y=A(17)+B(17)*LOG(Q):GOSUB 5500:NEXT Q:GOTO 5003 5270 FOR Q=SX TO EX STEP ST:Y=1/(A(18)+B(18)*LOG(Q)):GOSUB 5500:NEXT Q:GOTO 5003 5280 FOR Q=SX TO EX STEP ST:Y=A(19)*B(19)^Q*Q^C(19):GOSUB 5500:NEXT Q:GOTO 5003 5290 FOR Q=SX TO EX STEP ST:Y=A(20)*B(20)^(1/Q)*Q^C(20):GOSUB 5500:NEXT Q:GOTO 5003 5300 FOR Q=SX TO EX STEP ST:Y=A(21)*EXP((Q-B(21))/2):GOSUB 5500:NEXT Q:GOTO 5003 5310 FOR Q=SX TO EX STEP ST:Y=A(22)*EXP((LOG(Q)-B(22))^2/C(22)):GOSUB 5500:NEXT Q:GOTO 5003 5320 FOR Q=SX TO EX STEP ST:Y=A(23)*Q^B(23)*(1-Q)^C(23):GOSUB 5500:NEXT Q:GOTO 5003 5330 FOR Q=SX TO EX STEP ST:Y=A(24)*(Q/B(24))^C*EXP(Q/B(24)):GOSUB 5500:NEXT Q:GOTO 5003 5340 FOR Q=SX TO EX STEP ST:Y=1/(A(25)*(Q+B(25))^2+C(25)):GOSUB 5500:NEXT Q:GOTO 5003 5350 REM * END OF Y PREDICTIONS * 5500 REM * 5502 L=1 5505 IF LP=1 THEN LPRINT"If X= ";Q,"Then Y= ";Y 5510 PRINT"IF X= ";Q,"THEN Y= ";Y:K=K+1 5511 IF LP=1 THEN 5515 5512 IF INT(K/22)=K/22 THEN GOSUB 64000 5515 IF LP=1 AND (INT(K/60)=(K/60)) THEN LPRINT CHR$(12) 5520 RETURN 6000 REM * STORE DATA * 6030 PRINT CL$:PRINT "This routine will store RAW DATA on Disk" 6035 ON ERROR GOTO 63000 6040 INPUT "File Name for Data Storage ";A4$ 6050 OPEN "O",1,A4$ 6060 FOR I=1 TO 100 6065 IF X$(I)="END" OR Y$(I)="END" THEN CLOSE 1:GOTO 6080 6070 PRINT #1,X$(I):PRINT #1,Y$(I):NEXT I:CLOSE 1 6080 PRINT "Data stored to disk with File Name ";A4$ 6090 GOSUB 64000 6100 GOTO 120 7000 REM * LOAD DATA FROM DISK * 7030 PRINT CL$:PRINT"This routine will load DATA from Disk" 7035 ON ERROR GOTO 61000 7040 INPUT "File Name for Data ";A4$ 7050 OPEN "I",1,A4$ 7060 FOR I=1 TO 100 7065 IF EOF(1) THEN PRINT"ALL DATA LOADED":K=I:FOR J=K TO 100:X$(J)="END":Y$(J)="END":NEXT J:GOTO 7075 7070 INPUT #1,X$(I) 7071 IF INSTR(2,X$(I)," ")<>0 THEN 7200 7073 INPUT #1,Y$(I):NEXT I 7075 CLOSE 1 7080 PRINT "Data loaded from file ";A4$ 7082 FOR I=1 TO 100:IF X$(I)="" THEN X$(I)="DEL":Y$(I)="DEL" 7083 IF X$(I)="END" THEN IF X$(1)<>"DEL" THEN 7090 ELSE DE=1:GOTO 3430 7084 NEXT I:DE=1:GOTO 3430 7090 GOSUB 64000 7100 GOTO 120 7200 CLOSE 1:OPEN "I",1,A4$ 7210 FOR I=1 TO 100 7220 IF EOF(1) THEN PRINT"ALL DATA LOADED":K=I:FOR J=K TO 100:X$(J)="END":Y$(J)="END":NEXT J:GOTO 7275 7230 INPUT #1,DUMM$ 7240 PM=INSTR(2,DUMM$," "):X$(I)=LEFT$(DUMM$,PM):Y$(I)=RIGHT$(DUMM$,LEN(DUMM$)-PM):NEXT I 7275 GOTO 7075 8000 PRINT CL$:PRINT"PROGRAM TERMINATED" 8010 INPUT "Before exiting, Save Data (Y or N)";A$ 8020 IF LEFT$(A$,1)="N" OR LEFT$(A$,1)="n" THEN END 8030 GOTO 6030 9000 REM * LIST RAW DATA * 9005 PRINT CL$:PRINT "LIST OF DATA ENTERED" 9006 INPUT "List Data on Printer (Y or N)";Q1$ 9007 GOSUB 50000 9008 IF LP=1 THEN LPRINT"LISTING OF DATA":LPRINT" " 9010 FOR I=1 TO 100 9020 IF X$(I)="END" OR Y$(I)="END" GOTO 9095 9060 PRINT "X( ";I;" )= ";X$(I);TAB(32);"Y( ";I;" )= ";Y$(I) 9065 IF LP=1 THEN LPRINT"X( ";I;" )= ";X$(I);TAB(32);"Y( ";I;" )= ";Y$(I) 9066 IF LP=1 AND (INT(I/60)=(I/60)) THEN LPRINT CHR$(12) 9067 IF LP=1 THEN 9074 ELSE 9070 9070 IF INT(I/22)=(I/22) THEN GOSUB 9080 9074 NEXT I:IF LP=1 THEN LPRINT CHR$(12) 9076 GOTO 9095 9080 PRINT "For more Data ";:GOSUB 64000:RETURN 9095 PRINT"All data listed. ";:GOSUB 64000 9096 IF LP=1 THEN LPRINT CHR$(12) 9100 IF Q7=1 THEN Q7=0:RETURN 9110 GOTO 120 10000 PRINT CL$:FOR I=1 TO 25 10002 PRINT"EQ(";I;") = ";EQ$(I);TAB(40);:I=I+1:IF I>25 THEN PRINT" ":PRINT" ":GOTO 10230 10004 PRINT"EQ(";I;") = ";EQ$(I):NEXT I 10230 GOSUB 64000 10460 IF R1=1 THEN RETURN ELSE 120 12000 FOR I=1 TO 25:A(I)=0:B(I)=0:C(I)=0:RR(I)=0:RC(I)=0:NEXT I 12001 C1=(R(16)*R(16)):C2=(R(30)*R(30)):C3=(R(21)-1):C4=(R(21)-2):C5=(R(21)-3):C6=(R(18)*R(18)) 12005 REM 1 STRAIGHT LINE 12007 ON ERROR GOTO 0 12010 A(1)=(R(17)*R(18)-R(16)*R(20))/(R(17)*R(21)-C1) 12020 B(1)=(R(20)*R(21)-R(16)*R(18))/(R(17)*R(21)-C1) 12030 RR(1)=(A(1)*R(18)+B(1)*R(20)-C6/R(21))/(R(19)-C6/R(21)) 12040 RC(1)=1-(((1-RR(1))*C3)/C4) 12050 C(1)=0 12060 REM 2 STRAIGHT LINE THROUGH ORIGIN 12070 A(2)=0: B(2)=R(20)/R(17): RR(2)=0: RC(2)=0: C(2)=0 12140 REM 3 RECIPROCAL OF STRAIGHT LINE 12150 A(3)=(R(17)*R(24)-R(16)*R(34))/(R(17)*R(21)-C1) 12160 B(3)=(R(21)*R(34)-R(16)*R(24))/(R(17)*R(21)-C1) 12170 RR(3)=(A(3)*R(24)+B(3)*R(34)-((R(24)*R(24))/R(21)))/(R(25)-(R(24)*R(24))/R(21)) 12180 RC(3)=1-(((1-RR(3))*C3)/C4) 12190 C(3)=0 12200 REM 4 COMBINED LINEAR AND RECIPROCAL  12220 S1=R(17)*R(21)-C1 12230 S2=R(21)*R(35)-R(18)*R(22) 12240 S3=(R(21)*R(21))-R(16)*R(22) 12250 S4=R(20)*R(21)-R(16)*R(18) 12260 S5=R(21)*R(23)-(R(22)*R(22)) 12270 C(4)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 12280 B(4)=(S4-S3*C(4))/S1 12290 A(4)=(R(18)-B(4)*R(16)-C(4)*R(22))/R(21) 12300 RR(4)=(A(4)*R(18)+B(4)*R(20)+C(4)*R(35)-C6/R(21))/(R(19)-C6/R(21)) 12310 RC(4)=1-(((1-RR(4))*C3)/C5) 12320 REM 5 HYPERBOLA 12330 S1=R(21)*R(23)-(R(22)*R(22)) 12340 A(5)=(R(18)*R(23)-R(22)*R(35))/S1 12360 B(5)=(R(21)*R(35)-R(18)*R(22))/S1 12370 RR(5)=(A(5)*R(18)+B(5)*R(35)-C6/R(21))/(R(19)-C6/R(21)) 12380 RC(5)=1-(((1-RR(5))*C3)/C4) 12390 C(5)=0 12400 REM 6 RECIPROCAL OF A HYPERBOLA 12420 S1=R(21)*R(23)-(R(22)*R(22)) 12430 A(6)=(R(23)*R(24)-R(22)*R(26))/S1 12440 B(6)=(R(21)*R(26)-R(22)*R(24))/S1 12450 RR(6)=(A(6)*R(24)+B(6)*R(26)-(R(24)*R(24))/R(21))/(R(25)-(R(24)*R(24))/R(21)) 12460 RC(6)=1-(((1-RR(6))*C3)/C4) 12462 C(6)=0 12470 REM 7 SECOND ORDER HYPERBOLA 12490 S1=R(21)*R(23)-(R(22)*R(22)) 12500 S2=R(21)*R(38)-R(18)*R(23) 12510 S3=R(21)*R(41)-R(22)*R(23) 12520 S4=R(21)*R(35)-R(18)*R(22) 12530 S5=R(21)*R(44)-(R(23)*R(23)) 12535 IF (S1*S5-S3*S3)=0 THEN 12620 12540 C(7)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 12550 B(7)=(S4-S3*C(7))/S1 12560 A(7)=(R(18)-C(7)*R(23)-B(7)*R(22))/R(21) 12570 RR(7)=(A(7)*R(18)+B(7)*R(35)+C(7)*R(38)-C6/R(21))/(R(19)-C6/R(21)) 12580 RC(7)=1-(((1-RR(7))*C3)/C5) 12590 REM 8 PARABOLA 12620 S1=R(17)*R(21)-C1 12630 S2=R(21)*R(36)-R(17)*R(18) 12640 S3=R(21)*R(40)-R(16)*R(17) 12650 S4=R(20)*R(21)-R(16)*R(18) 12660 S5=R(21)*R(43)-(R(17)*R(17)) 12670 C(8)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 12680 B(8)=(S4-S3*C(8))/S1 12690 A(8)=(R(18)-C(8)*R(17)-B(8)*R(16))/R(21) 12700 RR(8)=(A(8)*R(18)+B(8)*R(20)+C(8)*R(36)-C6/R(21))/(R(19)-C6/R(21)) 12710 RC(8)=1-(((1-RR(8))*C3)/C5) 12720 REM 9 PARABOLA THROUGH ORIGIN 12750 S1=R(17)*R(43)-(R(40)*R(40)) 12760 A(9)=(R(20)*R(43)-R(36)*R(40))/S1 12770 B(9)=(R(17)*R(36)-R(20)*R(40))/S1 12780 C(9)=0: RR(9)=0: RC(9)=0 12810 REM 10 POWER 12820 IF NX=1 OR NY=1 THEN 13000 12840 S1=R(21)*R(29)-(R(28)*R(28)) 12850 S3=(R(29)*R(30)-R(28)*R(32))/S1 12860 Z=((R(29)*R(30)-R(28)*R(32))/S1):GOSUB 60080:A(10)=Z2 12870 B(10)=(R(21)*R(32)-R(28)*R(30))/S1 12875 RR(10)=(S3*R(30)+B(10)*R(32)-C2/R(21))/(R(31)-C2/R(21)) 12890 RC(10)=1-(((1-RR(10))*C3)/C4) 12895 C(10)=0 13000 REM 11 MODIFIED POWER 13010 IF NY=1 THEN 13110 13020 S1=R(17)*R(21)-C1 13030 S2=(R(17)*R(30)-R(16)*R(46))/S1 13040 S3=(R(21)*R(46)-R(16)*R(30))/S1 13060 Z=S2:GOSUB 60080:A(11)=Z2 13070 Z=S3:GOSUB 60080:B(11)=Z2 13080 RR(11)=(S2*R(30)+S3*R(46)-C2/R(21))/(R(31)-C2/R(21)) 13090 RC(11)=1-(((1-RR(11))*C3)/C4) 13100 C(11)=0 13110 REM 12 ROOT * 13120 IF NY=1 THEN 13210 13140 S1=R(23)*R(21)-(R(22)*R(22)) 13150 S2=(R(23)*R(30)-R(22)*R(47))/S1 13160 S3=(R(21)*R(47)-R(22)*R(30))/S1 13170 Z=S2:GOSUB 60080:A(12)=Z2 13180 Z=S2:GOSUB 60080:B(12)=Z2 13190 RR(12)=(S2*R(30)+S3*R(47)-C2/R(21))/(R(31)-C2/R(21)) 13200 RC(12)=1-(((1-RR(12))*C3)/C4):C(12)=0 13210 REM 13 SUPER GEOMETRIC 13220 IF NX=1 OR NY=1 THEN 13400 13240 S1=R(21)*R(49)-(R(48)*R(48)) 13250 S2=(R(30)*R(49)-R(48)*R(50))/S1 13260 Z=S2:GOSUB 60080:A(13)=Z2 13270 B(13)=(R(21)*R(50)-R(30)*R(48))/S1 13280 RR(13)=(S2*R(30)+B(13)*R(50)-C2/R(21))/(R(31)-C2/R(21)) 13290 RC(13)=1-(((1-RR(13))*C3)/C4) 13295 C(13)=0 13300 REM 14 MODIFIED GEOMETRIC 13330 S1=R(21)*R(53)-(R(63)*R(63)) 13340 S2=(R(30)*R(53)-R(63)*R(58))/S1 13350 Z=S2:GOSUB 60080:A(14)=Z2 13360 B(14)=(R(21)*R(58)-R(30)*R(63))/S1 13370 RR(14)=(S2*R(30)+B(14)*R(58)-C2/R(21))/(R(31)-C2/R(21)) 13380 RC(14)=1-(((1-RR(14))*C3)/C4) 13390 C(14)=0 13400 REM 15 EXPONENTIAL * 13420 IF NY=1 THEN 13600 13430 S1=R(17)*R(21)-C1 13440 S2=(R(17)*R(30)-R(16)*R(46))/S1 13450 Z=S2:GOSUB 60080:A(15)=Z2 13460 B(15)=(R(21)*R(46)-R(16)*R(30))/S1 13470 RR(15)=(S2*R(30)+R(46)*B(15)-C2/R(21))/(R(31)-C2/R(21)) 13480 RC(15)=1-(((1-RR(15))*C3)/C4) 13490 C(15)=0 13500 REM 16 MODIFIED EXPONENTIAL 13530 S1=R(23)*R(21)-(R(22)*R(22)) 13540 S2=(R(23)*R(30)-R(22)*R(47))/S1 13550 Z=S2:GOSUB 60080:A(16)=Z2 13560 B(16)=(R(21)*R(47)-R(22)*R(30))/S1 13570 RR(16)=(S2*R(30)+B(16)*R(47)-C2/R(21))/(R(31)-C2/R(21)) 13580 RC(16)=1-(((1-RR(16))*C3)/C4):C(16)=0 13600 REM 17 LOGARITHMIC 13620 IF NX=1 THEN 14000 13630 S1=R(21)*R(29)-(R(28)*R(28)) 13640 A(17)=(R(18)*R(29)-R(28)*R(51))/S1 13650 B(17)=(R(21)*R(51)-R(18)*R(28))/S1 13660 RR(17)=(A(17)*R(18)+B(17)*R(51)-C6/R(21))/(R(19)-C6/R(21)) 13670 C(17)=0: RC(17)=1-(((1-RR(17))*C3)/C4) 13680 REM 18 RECIPROCAL OF LOGARITHMIC 13710 S1=R(21)*R(29)-(R(28)*R(28)) 13720 A(18)=(R(24)*R(29)-R(28)*R(52))/S1 13730 B(18)=(R(21)*R(52)-R(24)*R(28))/S1 13740 RR(18)=(A(18)*R(24)+B(18)*R(52)-(R(24)*R(24))/R(21))/(R(25)-(R(24)*R(24))/R(21)) 13750 C(18)=0:RC(18)=1-(((1-RR(18))*C3)/C4) 14000 REM 19 HOERL FUNCTION 14020 IF NX=1 OR NY=1 THEN 14300 14030 S1=R(17)*R(21)-C1 14040 S2=R(21)*R(32)-R(28)*R(30) 14050 S3=R(21)*R(48)-R(16)*R(28) 14060 S4=R(21)*R(46)-R(16)*R(30) 14070 S5=R(21)*R(29)-(R(28)*R(28)) 14080 C(19)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 14090 S6=(S4-S3*C(19))/S1 14100 S7=(R(30)-C(19)*R(28)-S6*R(16))/R(21) 14110 Z=S6:GOSUB 60080:B(19)=Z2 14120 Z=S7:GOSUB 60080:A(19)=Z2 14130 RR(19)=(S7*R(30)+S6*R(46)+C(19)*R(32)-C2/R(21))/(R(31)-C2/R(21)) 14140 RC(19)=1-(((1-RR(19))*C3)/C5) 14150 REM 20 MODIFIED HOERL FUNCTION 14180 S1=R(21)*R(23)-(R(22)*R(22)) 14190 S2=R(21)*R(32)-R(28)*R(30) 14200 S3=R(21)*R(45)-R(22)*R(28) 14210 S4=R(21)*R(47)-R(22)*R(30) 14220 S5=R(21)*R(29)-(R(28)*R(28)) 14230 C(20)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 14240 S6=(S4-S3*C(20))/S1 14250 S7=(R(30)-C(20)*R(28)-S6*R(22))/R(21) 14255 IF S6>87 OR S7>87 THEN 14310 14260 Z=S7:GOSUB 60080:A(20)=Z2 14270 Z=S6:GOSUB 60080:B(20)=Z2 14280 RR(20)=(S7*R(30)+S6*R(47)+C(20)*R(32)-C2/R(21))/(R(31)-C2/R(21)) 14290 RC(20)=1-(((1-RR(20))*C3)/C5) 14300 REM 21 NORMAL DISTRIBUTION 14310 IF NY=1 THEN 14460 14330 S1=R(17)*R(21)-C1 14340 S2=R(21)*R(54)-R(17)*R(30) 14350 S3=R(21)*R(40)-R(16)*R(17) 14360 S4=R(21)*R(46)-R(16)*R(30) 14370 S5=R(21)*R(43)-(R(17)*R(17)) 14380 S6=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 14390 S7=(S4-S3*S6)/S1 14400 S8=(R(30)-S7*R(16)-S6*R(17))/R(21) 14410 Z=(S8-((S7*S7)/(4*S6))):GOSUB 60080:A(21)=Z2 14420 B(21)=-S7/(2*S6) 14430 C(21)=1/S6 14440 RR(21)=(S8*R(30)+S7*R(46)+S6*R(54)-C2/R(21))/(R(31)-C2/R(21)) 14450 RC(21)=1-(((1-RR(21))*C3)/C5) 14460 REM 22 LOG NORMAL DISTRIBUTION 14470 IF NX=1 OR NY=1 THEN 14620 14490 S1=R(21)*R(29)-(R(28)*R(28)) 14500 S2=R(21)*R(57)-R(29)*R(30) 14510 S3=R(21)*R(55)-R(28)*R(29) 14520 S4=R(21)*R(32)-R(28)*R(30) 14530 S5=R(21)*R(56)-(R(29)*R(29)) 14540 S6=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 14550 S7=(S4-S3*S6)/S1 14560 S8=(R(30)-S7*R(28)-S6*R(29))/R(21) 14570 Z=(S8-(S7*S7)/(4*S6)):IF Z>85 THEN 14620 ELSE GOSUB 60080:A(22)=Z2 14580 B(22)=-S7/(2*S6) 14590 C(22)=1/S6 14600 RR(22)=(S8*R(30)+S7*R(32)+S6*R(57)-C2/R(21))/(R(31)-C2/R(21)) 14610 RC(22)=1-(((1-RR(22))*C3)/C5) 14620 REM 23 BETA DISTRIBUTION 14645 IF Q9=1 THEN GOTO 14790 14650 S1=R(21)*R(29)-(R(28)*R(28)) 14660 S2=R(21)*R(62)-R(30)*R(59) 14670 S3=R(21)*R(61)-R(28)*R(59) 14680 S4=R(21)*R(32)-R(28)*R(30) 14690 S5=R(21)*R(60)-(R(59)*R(59)) 14700 C(23)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 14710 B(23)=(S4-S3*C(23))/S1 14720 S6=(R(30)-B(23)*R(28)-C(23)*R(59))/R(21) 14730 Z=S6:GOSUB 60080:A(23)=Z2 14740 RR(23)=(S6*R(30)+B(23)*R(32)+C(23)*R(62)-C2/R(21))/(R(31)-C2/R(21)) 14750 RC(23)=1-(((1-RR(23))*C3)/C5) 14760 REM 24 GAMMA DISTRIBUTION 14765 IF NX=1 OR NY=1 THEN 14960 14790 S1=R(17)*R(21)-C1 14800 S2=R(21)*R(32)-R(28)*R(30) 14810 S3=R(21)*R(48)-R(16)*R(28) 14820 S4=R(21)*R(46)-R(16)*R(30) 14830 S5=R(21)*R(29)-(R(28)*R(28)) 14840 C(24)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 14850 S6=(S4-S3*C(24))/S1 14860 S7=(R(30)-S6*R(16)-C(24)*R(28))/R(21) 14870 B(24)=1/S6 14875 IF S6<=0 THEN B(24)=0:GOTO 14920 14880 Z=1/S6:GOSUB 60000:Z7=Z2:Z=(S7+C(24)*Z7):GOSUB 60080:A(24)=Z2 14890 RR(24)=(S7*R(30)+S6*R(46)+C(24)*R(32)-C2/R(21))/(R(31)-C2/R(21)) 14895 RC(24)=1-(((1-RR(24))*C3)/C5) 14920 REM 25 CAUCHY DISTRIBUTION 14960 S1=R(17)*R(21)-C1 14970 S2=R(21)*R(37)-R(17)*R(24) 14980 S3=R(21)*R(40)-R(16)*R(17) 14990 S4=R(21)*R(34)-R(16)*R(24) 15000 S5=R(21)*R(43)-(R(17)*R(17)) 15010 A(25)=(S1*S2-S3*S4)/(S1*S5-(S3*S3)) 15020 S6=(S4-S3*A(25))/S1 15030 S7=(R(24)-S6*R(16)-A(25)*R(17))/R(21) 15040 B(25)=(S6/(2*A(25))) 15050 C(25)=S7-((S6*S6)/(4*A(25))) 15060 RR(25)=(S7*R(24)+S6*R(34)+A(25)*R(37)-(R(24)*R(24))/R(21))/(R(25)-(R(24)*R(24))/R(21)) 15070 RC(25)=1-(((1-RR(25))*C3)/C5) 15090 PRINT"COEFFICIENTS NOW CALCULATED " 15100 FOR I=1 TO 25 15102 IF RR(I)<0 OR RR(I)>1.0001 THEN A(I)=0:B(I)=0:C(I)=0:RR(I)=0:RC(I)=0 15104 NEXT I 15110 GOTO 4040 20000 REM * CALCULATE SUMS AND SUMS OF SQUARES * 20010 NX=0:NY=0 20040 FOR I=16 TO 65: R(I)=0: NEXT I 20041 Q9=0:QA=1:GOTO 3430 20045 FOR I=1 TO 100 20046 PRINT CL$:PRINT"PROCESSING DATA POINT # "; I 20047 IF X$(1)="END" OR Y$(1)="END" THEN PRINT "NO DATA HAS BEEN ENTERED":PRINT"RETURNING TO MAIN MENU":FOR I=1 TO 1000:NEXT I:GOTO 120 20055 IF X$(I)= "END" OR Y$(I)="END" OR X$(I)="DEL" OR Y$(I)="DEL" GOTO 30000 20060 X(I)=CDBL(VAL(X$(I))):Y(I)=CDBL(VAL(Y$(I))) 20065 IF X(I)<0 THEN NX=1 20066 IF Y(I)<0 THEN NY=1 20067 IF X(I)=0 THEN X(I)=.0001 20068 IF Y(I)=0 THEN Y(I)=.0001 20070 R(16)=R(16)+X(I) 20072 IF NX<>1 THEN Z=X(I):GOSUB 60000:Z7=Z2 20074 IF NY<>1 THEN Z=Y(I):GOSUB 60000:Z8=Z2 20080 R(17)=R(17)+X(I)*X(I) 20090 R(18)=R(18)+Y(I) 20100 R(19)=R(19)+Y(I)*Y(I) 20110 R(20)=R(20)+X(I)*Y(I) 20120 R(21)=I 20130 R(22)=R(22)+(1/X(I)) 20140 R(23)=R(23)+(1/(X(I)*X(I))) 20150 R(24)=R(24)+(1/(Y(I))) 20160 R(25)=R(25)+(1/(Y(I)*Y(I))) 20170 R(26)=R(26)+(1/(Y(I)*X(I))) 20180 R(27)=I 20190 IF NX<>1 THEN R(28)=R(28)+Z7 20200 IF NX<>1 THEN R(29)=R(29)+(Z7)*(Z7) 20210 IF NY <>1 THEN R(30)=R(30)+(Z8) 20220 IF NY<>1 THEN R(31)=R(31)+(Z8)*(Z8) 20230 IF NX<>1 AND NY<>1 THEN R(32)=R(32)+(Z7)*(Z8) 20240 R(33)=I 20250 R(34)=R(34)+(X(I)/Y(I)) 20260 R(35)=R(35)+(Y(I)/X(I)) 20270 R(36)=R(36)+((X(I)*X(I)))*Y(I) 20280 R(37)=R(37)+((X(I)*X(I)))/Y(I) 20290 R(38)=R(38)+(Y(I)/(X(I)*X(I))) 20300 R(39)=R(39)+X(I)*(Y(I)*Y(I)) 20310 R(40)=R(40)+(X(I)*X(I)*X(I)) 20320 R(41)=R(41)+1/((X(I)*X(I)*X(I))) 20330 R(42)=R(42)+(Y(I)*Y(I)*Y(I)) 20340 R(43)=R(43)+(X(I)*X(I)*X(I)*X(I)) 20350 R(44)=R(44)+1/((X(I)*X(I)*X(I)*X(I))) 20360 IF NX<>1 THEN R(45)=R(45)+Z7/X(I) 20370 IF NY<>1 THEN R(46)=R(46)+X(I)*Z8 20380 IF NY<>1 THEN R(47)=R(47)+Z8/X(I) 20390 IF NX<>1 THEN R(48)=R(48)+X(I)*Z7 20400 IF NX<>1 THEN R(49)=R(49)+(X(I)*Z7)*(X(I)*Z7) 20410 IF NX<>1 AND NY<>1 THEN R(50)=R(50)+X(I)*Z7*Z8 20420 IF NX<>1 THEN R(51)=R(51)+Y(I)*Z7 20430 IF NX<>1 THEN R(52)=R(52)+Z7/Y(I) 20440 IF NX<>1 THEN R(53)=R(53)+((Z7/X(I)))*((Z7/X(I))) 20450 IF NY<>1 THEN R(54)=R(54)+(X(I)*X(I))*Z8 20460 IF NX<>1 THEN R(55)=R(55)+((Z7*Z7*Z7)) 20470 IF NX<>1 THEN R(56)=R(56)+((Z7*Z7*Z7*Z7)) 20480 IF NX<>1 AND NY<>1 THEN R(57)=R(57)+((Z7*Z7))*Z8 20490 IF NX<>1 AND NY<>1 THEN R(58)=R(58)+(Z8*Z7)/X(I) 20500 IF X(I)>=1 THEN Q9=1: GOTO 20540 20501 IF Q9=1 GOTO 20540 20502 IF X(I)<=0 THEN 20550 20505 Z=1-X(I):GOSUB 60000:R(59)=R(59)+Z2 20510 R(60)=R(60)+Z2*Z2 20520 R(61)=R(61)+Z7*Z2 20530 IF NY<>1 THEN R(62)=R(62)+Z8*Z2 20540 IF NX<>1 THEN R(63)=R(63)+(Z7)/X(I) 20550 NEXT I 20600 NX=0:NY=0 30000 REM * END OF SUMMATION LOOP * 30030 PRINT CL$: PRINT"CALCULATING COEFFICIENTS": GOTO 12000 35000 PRINT CL$:PRINT"EQ #";TAB(9);"COEFFICIENT A";TAB(34);"COEFFICIENT B";TAB(63)"CORRECTED R^2" 35010 FOR I=1 TO 25 35015 PRINT I;TAB(5);A(I);TAB(29);B(I);TAB(58);RC(I) 35016 IF I=22 THEN GOSUB 64000 35018 NEXT I 35020 GOSUB 64000:GOTO 4507 40000 REM * LIST REGISTER CONTENTS R16-R63 * 40010 PRINT CL$ 40025 PRINT CL$:PRINT"REGISTER CONTENTS:":PRINT" ":PRINT"REG#";TAB(10);"REGISTER ";TAB(34);"REGISTER +1";TAB(58);"REGISTER +2":FOR I=16 TO 63 STEP 3 40095 PRINT I;TAB(5);R(I);TAB(29);R(I+1);TAB(54);R(I+2) 40100 NEXT I 40120 GOSUB 64000 40122 INPUT"OUTPUT TO PRINTER (Y)ES OR (N)O ";A$ 40124 IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN 40126 ELSE GOTO 120 40126 FOR I=16 TO 63 STEP 2 40127 LPRINT "R(";I;")= ";R(I);TAB(40);"R(";I+1;")= ";R(I+1) 40128 NEXT I 40129 LPRINT CHR$(12):GOTO 120 50000 IF LEFT$(Q1$,1)="Y" OR LEFT$(Q1$,1)="y" THEN LP=1 ELSE LP=0 50010 RETURN 55000 EQ$(1)="Y=A+B*X":EQ$(2)="Y=B*X":EQ$(3)="Y=1/(A+B*X)":EQ$(4)="Y=A+B*X+C/X":EQ$(5)="Y=A+B/X":EQ$(6)="Y=X/(A*X+B)" 55010 EQ$(7)="Y=A+B/X+C/X*X":EQ$(8)="Y=A+B*X+C*X*X":EQ$(9)="Y=A*X+B*X*X":EQ$(10)="Y=A*X^B":EQ$(11)="Y=A*B^X" 55020 EQ$(12)="Y=B^(1/X)":EQ$(13)="Y=A*X^(B*X)":EQ$(14)="Y=A*X^(B/X)":EQ$(15)="Y=A*e^(B*X)":EQ$(16)="Y=A*e^(B/X)" 55030 EQ$(17)="Y=A+B*lnX":EQ$(18)="Y=1/(A+B*lnX)":EQ$(19)="Y=A*B^X*X^C":EQ$(20)="Y=A*B^(1/X)*X^C" 55040 EQ$(21)="Y=A*e^((X-B)/2)":EQ$(22)="Y=A*e^((lnX-B)^2/C)":EQ$(23)="Y=A*X^B*(1-X)^C":EQ$(24)="Y=A*(X/B)^C*e^(x/b)" 55050 EQ$(25)="Y=1/(A*(X+B)^2+C)":RETURN 60000 Z2=LOG(Z):I0=0:I2=SGN(Z2):IF I2<0 THEN Z=1/Z 60010 IF Z<1.065 THEN 60030 60020 GOSUB 60270:Z=Z3:I0=I0+1:GOTO 60010 60030 Z=(Z-1)/(Z+1):Z2=Z*Z:Z3=Z 60040 I3=9:GOSUB 60310:Z=Z+Z 60050 IF I0=0 THEN 60070 60060 FOR I4=1 TO I0:Z=Z+Z:NEXT 60070 Z2=Z*I2:RETURN 60080 Z2=EXP(ABS(Z)):I0=0 60090 IF Z*Z<.004 THEN 60110 60100 Z=Z/2:I0=I0+1:GOTO 60090 60110 Z2=1:FOR I2=8 TO 1 STEP -1:Z2=Z2*Z/I2+1:NEXT 60120 IF I0=0 THEN 60140 60130 FOR I4=1 TO I0:Z2=Z2*Z2:NEXT 60140 RETURN 60150 I0=0:I1=0:I2=SGN(Z) 60160 Z=ABS(Z):IF Z>1 THEN Z=1/Z:I1=1 60170 IF Z<.077 THEN 60200 60180 Z2=Z:Z=Z*Z+1:GOSUB 60270:Z=Z2/(Z3+1) 60190 I0=I0+1:GOTO 60170 60200 Z3=Z:I3=-11:GOSUB 60310 60210 IF I0=0 THEN 60230 60220 FOR I4=1 TO I0:Z=Z+Z:NEXT 60230 Z2=Z 60240 IF I1=1 THEN Z2=Z9-Z2 60250 Z2=Z2*I2 60260 RETURN 60270 Z3=SQR(Z):Z3=(Z3+Z/Z3)/2:Z3=(Z3+Z/Z3)/2:RETURN 60280 IF Z9 <>0 THEN RETURN 60290 Z4=Z:Z=1:GOSUB 60150:Z9=Z2+Z2:Z=Z4:RETURN 60300 ' *** POWER EXPANSION *** 60310 Z2=Z*Z:FOR I4=3 TO ABS(I3) STEP 2:Z3=SGN(I3)*Z3*Z2 60320 Z=Z+Z3/I4:NEXT:RETURN 61000 IF (ERR=53 OR ERR=64) AND ERL=7050 THEN PRINT "UNABLE TO FIND OR ILLEGAL FILE NAME ";A4$:INPUT "PRESS TO CONTINUE";A$:RESUME 120 63000 IF ERR=64 AND ERL=6050 THEN PRINT" THE FILE NAME ";A4$;" IS NOT A VALID FILE NAME":GOSUB 64000:RESUME 120 64000 INPUT "Please press to CONTINUE";A$:RETURN  FILE NAME ";A4$;" IS NOT A VALID FILE NAME":GOSUB 64000:RESUME 120 64000 INPUT "Please press 1 THEN Z=1/Z:I1=1 60170 IF Z<.077 THEN 60200 60180 Z2=Z:Z=Z*Z+1:GOSUB 60270:Z=Z2/(Z3+1) 60190 I0=I0+1:GOTO 60170 60200 Z3=Z:I3=-11:GOSUB 60310 60210 IF I0=0 THEN 60230 60220 FOR I4=1 TO I0:Z=Z+Z:NEXT 60230 Z2=Z 60240 IF I1=1 THEN Z2=Z9-Z2 60250 Z2=Z2*I2 60260 RETURN 60270 Z3=SQR(Z):Z3=(Z3+Z/Z3)/2:Z3=(Z3+Z/Z3)/2:RETURN 60280 IF Z9 <>0 THEN RETURN 60290 Z4=Z:Z=1:GOSUB 60150:Z9=Z2+Z2:Z=Z4:RETURN 60300 ' *** POWER EXPANSION *** 60310 Z2=Z*Z:FOR I4=3 TO ABS(I3) STEP 2:Z3=SGN(I3)*Z3*Z2 60320 Z=Z+Z3/I4:NEXT:RETURN 61000 IF (ERR=53 OR ERR=64) AND ERL=7050 THEN PRINT "UNABLE TO FIND OR ILLEGAL FILE NAME ";A4$:INPUT "PRESS TO CONTINUE";A$:RESUME 120 63000 IF ERR=64 AND ERL=6050 THEN PRINT" THE FILE NAME ";A4$;" IS NOT A VALID FILE NAME":GOSUB 64000:RESUME 120 64000 INPUT "Please press to CONTINUE". The OBASIC version has not been updated. It remains the August 1985 version. Will consider updating as far as possible if there are sufficient requests to do so. Since OBASIC is generally considered obsolete, MBASIC version will be the CP/M version that is updated from here on out. I intend for the OBASIC version to remain static in its current version. The only real advantage of the OBASIC version is that it requires less space in memory because OBASIC is a shorter program than MBASIC. When using option 8 of the compiled IBM version, exit is to operating system rather than to BASIC. When using data from a LOTUS 1-2-3 .PRN file, make sure that the file is created using the "AS-DISPLAYED" option. ================================================================= REVISION 2.04 December 6, 1985. Changed lines  20067 and 20068 to have X=0.0001 and Y=0.0001 if zero is input for X or Y. This prevents an Overflow situation and allows the compiled IBM version to operate correctly. ==================== End (As of 12/06/85) ======================== o operate correctly. ==================== End (As of 12/06/85) ====== here on out. I intend for the OBASIC version to remain static in its current version. The only real advantage of the OBASIC version is that it requires less space in memory because OBASIC is a shorter program than MBASIC. When using option 8 of the compiled IBM version, exit is to operating system rather than to BASIC. When using data from a LOTUS 1-2-3 .PRN file, make sure that the file is created using the "AS-DISPLAYED" option. ================================================================= REVISION 2.04 December 6, 1985. Changed lines  PAGE NO. 1 A:CURVECPM.BAS DATE : 11-30-1985 VARIABLE USED IN LINE(S) : -------------------------------------------------------------------------------- A$ 1500 1510 3010 3020 3060 3065 3070 3080 4505 4507 4610 8010 8020 40122 40124 61000 64000 A() 56 4521 4530 4561 4570 4575 4576 5051 5100 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 12000 12010 12030 12070 12150 12170 12290 12300 12340 12370 12430 12450 12560 12570 12690 12700 12760  12860 13060 13170 13260 13350 13450 13550 13640 13660 13720 13740 14120 14260 14410 14570 14730 14880 15010 15020 15030 15040 15050 15060 15102 35015 A0$ 4500 4530 4570 4576 A1$ 3400 3410 4500 4530 4570 4576 A2$ 3600 3610 4500 4530 4570 4576 -------------------------------------------------------------------------------- A3$ 4500 4530 4570 4576 A4$ 4503 4510 4550 4573 6040 6050 6080 7040 7050 7080 7200 61000 63000 AZ$ 4990 5000 5003 5005 B 5 B() 56 4521 4530 4561 4570 4575 4576 5051 5100 5110 5120 5130 5140 5150 5160  5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 12000 12020 12030 12070 12160 12170 12280 12290 12300 12360 12370 12440 12450 12550 12560 12570 12680 12690 12700 12770 12870 12875 13070 13180 13270 13280 13360 13370 13460 13470 13560 13570 13650 13660 13730 13740 14110 14270 14420 14580 14710 14720 14740 14870 14875 15040 15102 35015 C 5 5330 -------------------------------------------------------------------------------- C() 56 4530 4570 4576 5130 5160 5170 5280 5290 5310 5320 5340 12000 12050  12070 12190 12270 12280 12290 12300 12390 12462 12540 12550 12560 12570 12670 12680 12690 12700 12780 12895 13100 13200 13295 13390 13490 13580 13670 13750 14080 14090 14100 14130 14230 14240 14250 14280 14430 14590 14700 14710 14720 14740 14840 14850 14860 14880 14890 15050 15102 PAGE NO. 2 A:CURVECPM.BAS DATE : 11-30-1985 VARIABLE USED IN LINE(S) : -------------------------------------------------------------------------------- C1 12001 12010 12020 12150 12160 12220 12620 13020 13430 14030 14330 14790 14960 C2 12001 12875 13080 13190 13280 13370 13470  13570 14130 14280 14440 14600 14740 14890 C3 12001 12040 12180 12310 12380 12460 12580 12710 12890 13090 13200 13290 13380 13480 13580 13670 13750 14140 14290 14450 14610 14750 14895 15070 C4 12001 12040 12180 12380 12460 12890 13090 13200 13290 13380 13480 13580 13670 13750 C5 12001 12310 12580 12710 14140 14290 14450 14610 14750 14895 15070 C6 12001 12030 12300 12370 12570 12700 13660 -------------------------------------------------------------------------------- CL$ 7 33 110 120 1000 2000 3000 4000 4040 4502 4510 4990 5002 5004 6030 7030 8000 9005 10000 20046 30030 35000 40010 40025 DBLA 5 DE 3591 7083 7084 DUMM$ 7230 7240 E 20067 20068 EQ 5040 5050 5051 5052 5053 5060 -------------------------------------------------------------------------------- EQ$() 6 4530 4570 4576 5051 5052 5053 10002 10004 55000 55010 55020 55030 55040 55050 EX 5020 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 I 110 3480 3490 3540 3545 3570 3580 3582 3583 3584 3587 4040 4230 4240  4250 4260 4520 4521 4530 4532 4560 4561 4570 4571 4574 4575 4576 4578 6060 6070 7060 7065 7070 7071 7073 7082 7083 7084 7210 7220 7240 9010 9020 9060 9065 9066 9070 9074 10000 10002 10004 12000 15100 15102 15104 20040 20045 20046 20047 20055 20060 20065 20066 20067 20068 20070 20072 20074 20080 20090 20100 20110 20120 20130 20140 20150 20160 20170 20180 20240 20250 20260 20270 20280 20290 20300 20310 20320 20330 20340 20350 20360 20370 20380 20390 20400 20410 20420 20430 20440 20450 20490 20500 20502 20505 PAGE NO. 3 A:CURVECPM.BAS DATE : 11-30-1985 VARIABLE USED IN LINE(S) : -------------------------------------------------------------------------------- 20540 20550 35010 35015 35018 40025 40095 40100 40126 40127 40128 I0 60000 60020 60050 60060 60080 60100 60120 60130 60150 60190 60210 60220 I1 60150 60160 60240 I2 60000 60070 60110 60150 60250 I3 60040 60200 60310 I4 60060 60130 60220 60310 60320 -------------------------------------------------------------------------------- J 1030 1040 1050 1060 1070 1075 1080 1500 7065 7220 K 5000 5002 5060 5510 5512 5515 7065  7220 K1 3470 3570 3587 L 5000 5004 5502 LC 4515 4530 4536 LP 284 1075 4535 4572 4573 4576 4605 4620 5004 5053 5505 5511 5515 9008 9065 9066 9067 9074 9096 50000 -------------------------------------------------------------------------------- M 1020 1030 2010 2020 2030 5051 MQ 4250 4600 4605 MX 4220 4240 4250 NX 12820 13220 13620 14020 14470 14765 20010 20065 20072 20190 20200 20230 20360 20390 20400 20410 20420 20430 20440 20460 20470 20480 20490 20540 20600 NY 12820 13010 13120 13220 13420 14020 14310 14470 14765 20010 20066 20074 20210 20220 20230 20370 20380 20410 20450 20480 20490 20530 20600 PM 7240 -------------------------------------------------------------------------------- Q 3030 3040 3070 3080 3090 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 5505 5510 Q1$ 1002 4501 5006 9006 50000 Q7 3020 3590 9100 Q9 14645 20041 20500 20501 R 5 R() 55 12001 12010 12020 12030 12070 12150 12160 12170 12220 12230 12240 12250 12260 12290 12300 12330 12340 12360 12370 12420 12430 12440 12450 12490 12500 12510 12520 PAGE NO. 4 A:CURVECPM.BAS DATE : 11-30-1985 VARIABLE USED IN LINE(S) : -------------------------------------------------------------------------------- 12530 12560 12570 12620 12630 12640 12650 12660 12690 12700 12750 12760 12770 12840 12850 12860 12870 12875 13020 13030 13040 13080 13140 13150 13160 13190 13240 13250 13270 13280 13330 13340 13360 13370 13430 13440 13460 13470 13530 13540 13560 13570 13630 13640 13650 13660 13710 13720 13730 13740 14030 14040 14050 14060 14070 14100  14130 14180 14190 14200 14210 14220 14250 14280 14330 14340 14350 14360 14370 14400 14440 14490 14500 14510 14520 14530 14560 14600 14650 14660 14670 14680 14690 14720 14740 14790 14800 14810 14820 14830 14860 14890 14960 14970 14980 14990 15000 15030 15060 20040 20070 20080 20090 20100 20110 20120 20130 20140 20150 20160 20170 20180 20190 20200 20210 20220 20230 20240 20250 20260 20270 20280 20290 20300 20310 20320 20330 20340 20350 20360 20370 20380 20390 20400 20410 20420 20430 20440 20450 20460 20470 20480 20490 20505 20510 20520 20530 20540 40095 40127 R1 10460 R2 4265 4580 RC() 56 4240 4250 4530 4570 4576 12000 12040 12070 12180 12310 12380 12460 12580 12710 12780 12890 13090 13200 13290 13380 13480 13580 13670 13750 14140 14290 14450 14610 14750 14895 15070 15102 35015 RR() 55 4530 4570 4576 12000 12030 12040 12070 12170 12180 12300 12310 12370 12380 12450 12460 12570 12580 12700 12710 12780 12875 12890 13080 13090 13190 13200 13280 13290 13370 13380 13470 13480 13570 13580 13660 13670 13740 13750 14130 14140 14280 14290 14440  14450 14600 14610 14740 14750 14890 14895 15060 15070 15102 S 5 -------------------------------------------------------------------------------- S1 12220 12270 12280 12330 12340 12360 12420 12430 12440 12490 12535 12540 12550 12620 12670 12680 12750 12760 12770 12840 12850 12860 12870 13020 13030 13040 13140 13150 13160 13240 13250 13270 13330 13340 13360 13430 13440 13460 13530 13540 13560 13630 13640 13650 13710 13720 13730 14030 14080 PAGE NO. 5 A:CURVECPM.BAS DATE : 11-30-1985 VARIABLE USED IN LINE(S) : --------------------------------------------------------------------------------  14090 14180 14230 14240 14330 14380 14390 14490 14540 14550 14650 14700 14710 14790 14840 14850 14960 15010 15020 S2 12230 12270 12500 12540 12630 12670 13030 13060 13080 13150 13170 13180 13190 13250 13260 13280 13340 13350 13370 13440 13450 13470 13540 13550 13570 14040 14080 14190 14230 14340 14380 14500 14540 14660 14700 14800 14840 14970 15010 S3 12240 12270 12280 12510 12535 12540 12550 12640 12670 12680 12850 12875 13040 13070 13080 13160 13190 14050 14080 14090 14200 14230 14240 14350 14380 14390 14510 14540 14550 14670 14700 14710 14810 14840 14850 14980 15010 15020 S4 12250 12270 12280 12520 12540 12550 12650 12670 12680 14060 14080 14090 14210 14230 14240 14360 14380 14390 14520 14540 14550 14680 14700 14710 14820 14840 14850 14990 15010 15020 S5 12260 12270 12530 12535 12540 12660 12670 14070 14080 14220 14230 14370 14380 14530 14540 14690 14700 14830 14840 15000 15010 S6 14090 14100 14110 14130 14240 14250 14255 14270 14280 14380 14390 14400 14410 14420 14430 14440 14540 14550 14560 14570 14580 14590 14600 14720 14730 14740 14850 14860  14870 14875 14880 14890 15020 15030 15040 15050 15060 -------------------------------------------------------------------------------- S7 14100 14120 14130 14250 14255 14260 14280 14390 14400 14410 14420 14440 14550 14560 14570 14580 14600 14860 14880 14890 15030 15050 15060 S8 14400 14410 14440 14560 14570 14600 ST 5030 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 SX 5010 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240  5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 X 5 X$() 55 110 1040 1050 1075 1500 2020 3040 3070 3080 3490 3570 3582 3587 PAGE NO. 6 A:CURVECPM.BAS DATE : 11-30-1985 VARIABLE USED IN LINE(S) : -------------------------------------------------------------------------------- 4040 6070 7065 7070 7071 7082 7083 7220 7240 9020 9060 9065 20047 20055 20060 X() 55 20060 20065 20067 20070 20072 20080 20110 20130 20140 20170 20250 20260 20270 20280 20290 20300 20310 20320 20340 20350 20360 20370 20380 20390 20400  20410 20440 20450 20490 20500 20502 20505 20540 X1$() 55 3490 3545 3570 3587 XQ 57 110 285 287 290 Y 5 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 5505 5510 Y$() 55 110 1060 1070 1075 1500 2020 3040 3070 3090 3490 3570 3587 4040 6070 7065 7073 7082 7220 7240 9020 9060 9065 20047 20055 20060 -------------------------------------------------------------------------------- Y() 55 20060 20066 20068 20074 20090 20100 20110  20150 20160 20170 20250 20260 20270 20280 20290 20300 20330 20420 20430 Y1$() 55 3490 3587 Z 5 12860 13060 13070 13170 13180 13260 13350 13450 13550 14110 14120 14260 14270 14410 14570 14730 14880 20072 20074 20505 60000 60010 60020 60030 60040 60060 60070 60080 60090 60100 60110 60150 60160 60170 60180 60200 60220 60230 60270 60290 60310 60320 Z2 12860 13060 13070 13170 13180 13260 13350 13450 13550 14110 14120 14260 14270 14410 14570 14730 14880 20072 20074 20505 20510 20520 20530 60000 60030 60070 60080 60110 60130 60180 60230 60240 60250 60290 60310 Z3 60020 60030 60180 60200 60270 60310 60320 Z4 60290 -------------------------------------------------------------------------------- Z7 14880 20072 20190 20200 20230 20360 20390 20400 20410 20420 20430 20440 20460 20470 20480 20490 20520 20540 Z8 20074 20210 20220 20230 20370 20380 20410 20450 20480 20490 20530 Z9 60240 60280 60290 PAGE NO. 7 A:CURVECPM.BAS DATE : 11-30-1985 LINE NO. CALLED IN LINE(S) : -------------------------------------------------------------------------------- 0 12007 110 290 120 287 3065 3610 4040 4630 5005 5050  5051 6100 7100 9110 10460 20047 40124 40129 61000 63000 130 1090 2040 1000 110 -------------------------------------------------------------------------------- 1030 2020 1040 1520 1500 1050 1070 2000 290 3000 290 3030 3410 -------------------------------------------------------------------------------- 3400 3070 3430 7083 7084 3580 3545 3582 3570 3584 3582 3587 3550 -------------------------------------------------------------------------------- 3590 3584 4000 290 4040 290 15110 4220 4580 4250 4240 4260 4245 -------------------------------------------------------------------------------- 4507 35020 4532  4521 4560 4535 4536 4571 4561 4572 4507 4578 4575 -------------------------------------------------------------------------------- 4580 4572 4620 1510 4990 290 5003 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270 5280 5290 5300 5310 5320 5330 5340 5100 5060 5110 5060 -------------------------------------------------------------------------------- 5120 5060 PAGE NO. 8 A:CURVECPM.BAS DATE : 11-30-1985 LINE NO. CALLED IN LINE(S) : -------------------------------------------------------------------------------- 5130 5060 5140  5060 5150 5060 5160 5060 5170 5060 5180 5060 -------------------------------------------------------------------------------- 5190 5060 5200 5060 5210 5060 5220 5060 5230 5060 5240 5060 -------------------------------------------------------------------------------- 5250 5060 5260 5060 5270 5060 5280 5060 5290 5060 5300 5060 -------------------------------------------------------------------------------- 5310 5060 5320 5060 5330 5060 5340 5060 5350 5060 5500 5100 5110 5120 5130 5140 5150 5160 5170 5180 5190 5200 5210 5220 5230 5240 5250 5260 5270  5280 5290 5300 5310 5320 5330 5340 -------------------------------------------------------------------------------- 5515 5511 6030 290 8030 7030 290 7075 7065 7275 7090 3591 7083 7200 7071 -------------------------------------------------------------------------------- 7275 7220 8000 290 9005 290 3020 3610 9070 9067 9074 9067 9080 9070 -------------------------------------------------------------------------------- 9095 9020 9076 PAGE NO. 9 A:CURVECPM.BAS DATE : 11-30-1985 LINE NO. CALLED IN LINE(S) : -------------------------------------------------------------------------------- 10000 290 10230 10002 12000  30030 12620 12535 13000 12820 13110 13010 -------------------------------------------------------------------------------- 13210 13120 13400 13220 13600 13420 14000 13620 14300 14020 14310 14255 -------------------------------------------------------------------------------- 14460 14310 14620 14470 14790 14645 14920 14875 14960 14765 20000 4020 -------------------------------------------------------------------------------- 20540 20500 20501 20550 20502 30000 20055 35000 4505 40025 290 40126 40124 -------------------------------------------------------------------------------- 50000 1003 4502 5007 9007 55000 6 60000 14880 20072 20074 20505 60010 60020 60030 60010 60070 60050 -------------------------------------------------------------------------------- 60080 12860 13060 13070 13170 13180 13260 13350 13450 13550 14110 14120 14260 14270 14410 14570 14730 14880 60090 60100 60110 60090 60140 60120 60150 60290 60170 60190 -------------------------------------------------------------------------------- 60200 60170 60230 60210 PAGE NO. 10 A:CURVECPM.BAS DATE : 11-30-1985 LINE NO. CALLED IN LINE(S) : -------------------------------------------------------------------------------- 60270 60020 60180 60310 60040 60200 61000 7035 63000 6035 64000  4540 5000 5512 6090 7090 9080 9095 10230 35020 40120 63000 ******************************************************************************** PROGRAM CONTAINED 620 LINES. 1811 REFERENCES WERE GENERATED. ******************************************************************************** 0 LINES. 1811 REFERENCES WERE GE 60020 60180 60310 60040 60200 61000 7035 63000 6035 64000  NBR.BAS Documentation A Simple MBASIC Preprocessor by Brian Dugle Copyrigh 198 - Thes program ma b use an trade b anyon a lon a i i fo non-commercia use. Thi documentatio cover tw program supplie fo th FO library NBR124.BA an NBR13.BAS I general NB i preprocesso tha convert a un- numbere ASCII fil int on numbere suitabl fo us wit th MicroSof BASIC-8 (r Versio 5.2 Interprete (a supplie wit th Osborn 1 i m case) Versio 1.2 work i memor an i slightl faster versio 1. read th fil twice 10 line a time an ca conver muc longe files I eac case th '.BAS versio o th progra i th resul o runnin th '.ASC versio throug itself loadin th '.NUM fil int MBASIC an SAVEin it Th .AS fil ca b viewe wit TYP o WordStar th .BA fil ca b loade int MBASI an LISTe o LLISTed Th .NU fil i ASCI an ha lin numbers s eithe wil wor wit it. Versio 1.2 i newe tha 1. an illustrate bette progra practice think recommen tha yo compar th .AS versio an th .BA o .NU versio t se wha th progra doe an ho t us it Essentially yo mus writ a MBASI progra followin al th interpreter' rule excep fo lin numbers Al GOT an GOSU target mus b label tha begi wit '[ an en wit ']' Th squar bracke characte i no use i MBASI an make convenien semaphor fo indicatin th presenc o label Th labe definitio (wher th GOTO an GOSUB go mus star i colum 1 n leadin space ar allowed Versio 1.2 make th valu o th labe th followin lin whil 1. use th remar lin itsel a th destination NB canno handl an lin number i th file none! Remark ad lo t th documentatio o programmer' product bu the jus tak u spac i runnin program Therefore NB delete comment fro th numbere fil i produces a lon a the star wit th apostroph character Remark mad with the 'REM' keyword remain in the output file. Whitespac suc a blan line ma ofte b use t visuall separat block o code makin i easie t connec th part tha ar workin together NB delete blan line becaus MBASI canno handl the excep a comments Indenting however i maintaine s tha yo ca stil rea th outpu fil o scree o LLISTing. Th .AS fil (source shoul b prepare wit WordSta o anothe edito tha allow continuin line wit linefee (^P^J) i yo desir t writ you program wit "structured style Se th not i NBR124.AS tha explain thi i mor detail I yo d no min lot o lin number and/o lon 'IF statemen lines the quic littl edito suc a VD wil wor ver nicely. hav no don extensiv testin o thes program beyon confirmin tha the wil operat o themselves hav trie t tra som errors other ar specificall no trappe an ar lef fo MBASI t fla fo yo (particularl line to long) I som cases yo ma fin i necessar t PRIN som o th variable i us t determin th exac locatio o th proble i th sourc file I versio 1.24 fo instance th referenc t th sourc lin numbe i no availabl o th secon pass. Mos o th progra documentation o th "ho i works variety i i th progra listing trie t kee mos o th eas stuf t chang nea th front Fo instance yo coul mak th progra delet "REM line instea o "' line b definin RMK a "REM" Not tha thi woul b case- sensitive Anothe eas on woul b changin th labe star cod t "@ instea o "[" CL i th onl termina cod used chang i t th clea scree cod fo you termina i i i no a Osborn o Kaypro STARTNU an INC decid wha th firs lin numbe i an ho fa apar the are Finally TBLS i th siz o th array o label an CODES i th numbe o progra line tha versio 1.2 ca handle. O m O-1 NBR1 processe itsel i 2:2 whil NBR12 take 2:07 ha t chang CODES t 17 i NBR12 lin 130 an th memor displa showe tha lo o tim wa spen i garbag collection NBR12 processe itsel i 1:3 whil NBR1 take 1:51 I bot cases th onl differenc i th outpu file wa th targe lin number pointe t th labe remar lin whe processe b versio 1. an the pointe t th nex lin whe processe b version 1.24, as expected. Pleas fee fre t writ o cal m i yo hav an problem o suggestion fo th NB program M addres shoul b goo throug 1986 anyway bu i still depends on Uncle Sam for a few more years! Brian C Dugle 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036 11 Nov 85 nbr-mbas.txt <-- filename of this file (other files are for the library) Brian C Dugle <-- author 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036 Okay to release address and phone *** Note t editor *** Al carriag retur symbol ar ' i th text d searc an replac t pu i th typesetter' code Contro character fo illustratio i th tex us circumfle o care (shift-6 followe b th capita letter Pleas leav codin line a formatte (i possible an prin thos section i fixe pitc (monospace?) Searc fo "^N.. t fin comment i th fil fo yo t ai i startin an endin monospace Thes comment shoul b delete (a shoul thes notes befor sendin t th printer. Question Ar yo plannin t pu ou an mor specifi guidanc o formattin o article contributed I so I' interested. .. *** Actual Article Starts Here *** A Simple MBASIC Preprocessor by Brian Dugle Severa month ago wrot a articl fo th FOGHOR abou usin WordSta fo writin MBASI program (Vo IV N 11 Au 1985) I i mentione tha automati numberin fo BASI progra wa m nex subject Well i yo hav bee waitin fo it her i is Thi articl wil describ BASI progra whic read a un-numbere sourc fil an write numbere fil fro it Thi woul b prett trivia i ther wer n 'GOTOs an n 'GOSUBs (eithe ver unlikel o no ver usefu fo programmin i BASIC!) bu w wil handl conversio o name label t lin number a well Further w won' pas o an remar line sinc progra documentatio wil remai i th origina un- numbere listing. First wh MBASIC On reaso i tha MBASI program ar eas t wor with The ca b debugge interactivel (o eve "hacke together") an the ar on o th mor portabl kind o program around A a illustratio o MBASIC' portability recentl wrot circl drawin progra fo a offic a wor tha ha th sam printe a d a home Ther wa on differenc though thei compute i a IB PC an min i a Osborne MBASI o th Ozz an BASI o th P bot com fro th sam hom (MicroSoft an too advantag o tha fact wa no doin scree graphic (obviousl machin dependent) an ther wer coupl o difference (lik clearin th screen) bu 9 percen o th progra ra th sam o bot machines ( eve too i i o dis courtes o Uniform!) S muc fo portability Th othe thin fin ver usefu wit MBASI i bein abl t ad 'STOP statemen fo debuggin i a havin trouble Whe th brea messag appears ca easil investigat value o variable b 'PRINTing the i immediat mod t fin ou wha i causin th problem Then i ther i n proble a tha point ca 'CONTinue'. BASI leave lo t b desire i term o structuring Th nee fo lin number everywher i absolutel pain Yo ma b askin wh haven' switche t CBASI then--wel hav don som wor wit i too bu i i quit differen fro MBASI and i m opinion almos th wors o bot world fo th casua progammer CBASI i no interactive; eac tim chang i mad yo hav t recompile And hav ha som problem i gettin thing t wor th wa though the should Someon wit mor rigorou approac woul undoubtedl avoi mos o thes problems. S wha i m answer thin tha thos o yo BASI devotee wh d no wan t bu cop o TURB an lear Pasca shoul rea on BASI wil neve b a clea lookin a th mai bloc o Pasca program an NB (th progra w ar abou t write mus b ru separatel o th fil jus lik compilin CBASI program bu th advantage o writin larg progra withou lin number mak i worthwhile. Th firs ste i t buil you progra fro th to down No tha sound lik I' spoutin th origina programmer' buzz- word bu believ th to dow approac i fundamenta requiremen fo gettin workin progra tha doe wha yo wan done To dow mean sketchin pla fo doin th jo i regula ol English then wit mor detai a eac level explainin eac ste o th plan Whil yo ar a it wh no d you sketchin wit WordSta i (non-document mode? I help t thin bi i term o logica statement i sketchin ou you plan Som ke word tha describ decision tha mus b mad an action tha mus b take i gettin fro star t en wil b ver helpful bu wit th magi o WordStar al thing ca b changed Onc yo hav th proble an it solutio describe a th genera level yo ca the g t th en o th fil an star describin th detai leve procedure tha wer state i phras o tw a first. Th onl proble wit thi i tha yo hav don al thi writing bu yo can' us an o i becaus ther aren' an lin number i there Wel han i there becaus th poin o thi articl i t us thi techniqu t writ progra tha solve th problem Th followin i sketc o pseud cod outlin o progra whic wil numbe th line o progra an conver label t lin number fo us. initialize variables open program file pass one initialize the line counter while not eof read a line if it is blank or just a remark, don't count it otherwise, save the line in an array if the line begins with a label, add the label and its line number to a list increment line number end while close program file pass two open output file reset line number to start for each line saved if it is a label line, make it a remark and print it otherwise add a line number at the beginning if it has a remark on the end, ignore that part look for labels in the line i found loo u i th lis an replac wit th appropriate line number keep looking at the line until there are no more labels add the line to the output file increment line number end while close output file print a list of the labels end I doesn' loo to muc lik MBASI yet bu i ha possibilities An i wil allo u t writ futur program wit WordStar muc bette ide tha th ol MBASI lin editor I doe no tak muc imaginatio o effor t translat th sketc abov into: ..start monospace, delete this line! Listing of NBR.ASC 'NBR is a MicroSoft BASIC-80 (r) basic program that adds line ' numbers to a file 'labels of the form "[label]" are converted to the appropriate ' line number ver$ = "1.24, 10 Nov 85" REM copyright 1985 by Brian Dugle 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036 REM This program may be used by any individual for non-commercial purposes; it may not be sold alone or as part of a group of "public domain" programs 'NOTE!! ' lines that end with a colon must be terminated with a linefeed ' (^P^J in WordStar) to continue on the next physical line-- ' this also applies to 'if' statements continued on multiple ' lines, ie, end physical lines that continue on the next line ' with a LINEFEED, not a RETURN... ' Lines continued in this manner are still limited to a total ' of 255 chars (including LFs, TABs, etc), this program does ' not check for this error, it crashes!! 'define constants for variable type, size of arrays... defint a-z: tblsz = 50: codesz = 150: dim lblname$ (tblsz), lblval (tblsz), progline$ (codesz) 'functions - boolean def fnisodd (n) = ( (n and 1) = 1 ) def fniseven (n) = ( (n and 1) = 0 ) def fniswhitespace (c) = ( instr (whitespace$, c) > 0 ) def fnisremline (l$) = ( left$ (l$, 1) = rmk$ ) def fnisblankline (l$) = ( len (l$) = 0 ) def fnislabelline (l$) = ( left$ (l$, 1) = lblstcode$ ) ' other functions... def fnlnum (n) = n * incr + startnum 'logical values and ascii constants false = 0: true = not false: blank$ = chr$ (32): tab$ = chr$ (9): lf$ = chr$ (10): cr$ = chr$ (13): quote$ = chr$ (34): cl$ = chr$ (26) 'program parameters and initialized variables startnum = 100: incr = 10: infile = 1: outfile = 2 rmk$ = "'": lblstcode$ = "[": lblendcode$ = "]": maxlblnum = 0: whitespace$ = blank$ + tab$ '___________________________________________________main program print cl$: print "nbr.bas vers "; ver$; " (c) Brian Dugle" [get filename] input "Enter the program name: ", progname$ upr$ = progname$: gosub [make upper]: progname$ = upr$: infilname$ = progname$ + ".ASC": outfilname$ = progname$ + ".NUM": symfilname$ = progname$ + ".SYM" '............................................pass one pass = 1 on error goto [open error] open "I", infile, infilname$ 'ln keeps track of lines in output ".NUM" file, sourceln counts input file lines for use in error messages ln = 0: sourceln = 1: print "Free memory ="; fre (0) while not eof (infile) and (ln <= codesz) ' ...keep user up to date on progress... print cr$;: print using "pass 1, source line ### mem = #####"; sourceln; fre (0); '...get a line and check if it should be kept for output line input # infile, progline$ (ln): if fnisremline (progline$ (ln)) or fnisblankline (progline$ (ln)) then [next pass1 line] '...if the line is not a remark and is not blank, then check to see if the line starts with a label, if so then add to list of labels... 'Note! remarks made with REM will stay in the file... lblptr = instr (progline$ (ln), lblstcode$): if lblptr = 1 then gosub [eval label] ln = ln + 1 [next pass1 line] 'Note! arriving at this label directly skips incrementing line number but source line is incr'd sourceln = sourceln + 1 wend lastln = ln - 1 'possible error, codesz terminated input--if so tell user if not eof (infile) and ln >= codesz then print "Source file too big, ran out of romm at"; ln; "lines": print "Change the variable 'codesz' and try again...": end close infile '............................................pass two pass = 2 open "O", outfile, outfilname$ for ln = 0 to lastln ' progress check... print cr$;: print using "pass 2, prog line ##### mem = #####"; fnlnum (ln); fre (0); 'reformat line 'if line is a label location, only action required is to make it a remark, skip everything else if fnislabelline ( progline$ (ln) ) then progline$ (ln) = str$ (fnlnum (ln)) + tab$ + "' " + progline$ (ln): goto [print line] 'add the line number to progline$ (ln) and add tabs following linefeeds to maintain indenting progline$ (ln) = str$ (fnlnum (ln)) + tab$ + progline$ (ln): lfpos = instr (progline$ (ln), lf$): while lfpos <> 0: c$ = mid$ (progline$ (ln), lfpos+1, 1): if c$ = cr$ then lfpos = lfpos + 1 progline$ (ln) = left$ (progline$ (ln), lfpos) + tab$ + mid$ (progline$ (ln), lfpos+1): lfpos = instr (lfpos+1, progline$ (ln), lf$): wend 'set quote positions 'search progline$ (ln) for quotes (chr$(34)), save position of each quote char in quotepos$ 'positions are one byte values saved in a string variable qpos = instr (progline$ (ln), quote$): quotepos$ = "" while qpos <> 0: quotepos$ = quotepos$ + chr$ (qpos): qpos = instr (qpos+1, progline$ (ln), quote$): wend if fnisodd (len (quotepos$)) then errmsg$ = "Quotes not paired": gosub [print errmsg] else quotepos$ = quotepos$ + chr$ (255) 'delete trailing remarks in progline$ (ln) start by finding first rmk$ that is not in a quoted string and return its position in remptr remptr = instr (progline$ (ln), rmk$): while remptr > 0: ptr = remptr:  gosub [check ptr in quotes]: if ptrinquotes then remptr = instr (remptr+1, progline$ (ln), rmk$) wend 'if remptr is found, then delete trailing remark and whitespace from end of line if remptr > 0 then progline$ (ln) = left$ (progline$ (ln), remptr - 1): p = len (progline$ (ln)): while fniswhitespace ( mid$ (progline$ (ln), p, 1) ): p = p - 1: wend: progline$ (ln) = left$ (progline$ (ln), p) 'search for labels, convert to line numbers, insert in line and print to output file numlbls = 0: lblptr = instr (progline$ (ln), lblstcode$): while lblptr > 0: ptr = lblptr: gosub [check ptr in quotes]: if not ptrinquotes then gosub [save label num] lblptr = instr (lblptr+1, progline$ (ln), lblstcode$): wend: gosub [insert label nums] [print line] 'print the current line and then delete it to make more workspace print # outfile, progline$ (ln): progline$ (ln) = "" next ln '............................................finish up close outfile 'put the symbol table in a disk file that can be LISTed from MBASIC... open "O", outfile, symfilname$: print # outfile, "1 'Label listing of: " + progname$ + ".BAS": for i = 0 to maxlblnum-1: print # outfile, str$ (lblval (i)); " '[" + lblname$ (i) + "]": next close: print: end '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [make upper] 'pass a string to the routine in upr$ 'routine checks each char and, if lower case, converts it to ' upper case 'result returned in upr$ for c = 1 to len (upr$): cupr$ = mid$ (upr$, c, 1) ' ...if cupr$ is lower case, convert it and insert into upr$... if (cupr$ >= "a") and (cupr$ <= "z") then cupr$ = chr$ ( asc (cupr$) - 32 ): upr$ = left$ (upr$, c-1) + cupr$ + mid$ (upr$, c+1) next c return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [open error] 'error on attempt to open input file if err = 53 then print "Error, file: " infilname$ " not found, check spelling": resume [get filename] else on error goto 0 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [eval label] 'pass 1--extract a label from a line when lblptr = 1, ie, ' line starts with a label 'if it is not already in the list, add it to the list gosub [get label]: if lblerr then errmsg$ = "Incorrect label format": gosub [print errmsg]: goto [end eval label] gosub [match label]: if inlist then gosub [lbl dbl def] else gosub [add to list] [end eval label] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [lbl dbl def] 'error, found label already in list during pass one errmsg$ = "Label '[" + lbl$ + "]' is redefined in line" + str$ (ln) + ", value is" + str$ (lblval (n)): gosub [print errmsg]: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [add to list] 'pass one--add a new label to the list 'make label value the next line, remark line will not be the ' target of the goto or gosub lblname$ (maxlblnum) = lbl$: lblval (maxlblnum) = fnlnum (ln + 1): maxlblnum = maxlblnum + 1: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [check ptr in quotes] 'remark and label identifiers are not significant when in ' quoted strings 'this routine checks ptr to see if it is within a quoted string 'uses quotepos$ 'returns boolean ptrinquotes if ptr > 255 then errmsg$ = "Pointer value too high, " + str$ (ptr): gosub [print errmsg]: stop qnum = 1: qpos = asc (quotepos$) '...ASC function returns ascii code of first char in a string... while ptr > qpos: qnum = qnum + 1: qpos = asc (mid$ (quotepos$, qnum, 1)): wend ptrinquotes = fniseven (qnum) return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [save label num] 'pass two--change a label to its value 'arrive here with "lblptr" pointing to start of a label in ' "progline$ (ln)" 'find label in list and save value & position to replace or 'print error: undefined label gosub [get label]: if lblerr then errmsg$ = "Incorrect label format at pos" + str$ (lblptr): gosub [print errmsg]: goto [end save label num] gosub [match label]: if not inlist then errmsg$ = "Undefined label '[" + lbl$ + "]'": gosub [print errmsg]: goto [end save label num] 'found a good label, save position & value, bump counter labelpos (numlbls) = lblptr: labelval (numlbls) = lblval (n): numlbls = numlbls + 1 [end save label num] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [insert label nums] 'numlbls is the number of labels found in this line 'they must be replaced from the far end first so that the position ' of each insertion does not change 'array labelval () holds the label value to insert 'array labelpos () holds the pointer, where to insert it ' both arrays are set to 10 subscripts by default... for lp = numlbls-1 to 0 step -1 endlblptr = instr (labelpos (lp), progline$ (ln), lblendcode$): progline$ (ln) = left$ (progline$ (ln), (labelpos (lp) - 1)) + str$ ( labelval (lp) ) + mid$ (progline$ (ln), endlblptr + 1) next lp return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [get label] 'call with lblptr pointing to lblstcode$ in progline$ (ln) 'return with label name in lbl$, error in lblerr, lblptr not ' changed endlblptr = instr (lblptr, progline$ (ln), lblendcode$): lblerr = (endlblptr = 0): if not lblerr then lbl$ = mid$ ( progline$ (ln), (lblptr + 1), (endlblptr - lblptr -1) ) else lbl$ = "" return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [match label] 'find label in label list, return result in boolean "inlist" ' if in list, return subscript in "n" inlist = false: n = -1: while (n < maxlblnum) and not inlist: n = n + 1: inlist = (lbl$ = lblname$ (n)): wend: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [print errmsg] 'message passed in "errmsg$" 'prints to screen and outfile if pass = 1 then print: print "Error: "; errmsg$ else if pass = 2 then print # outfile, errmsg$ return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ..back to normal type setting Dependin o ho tha listin wa treate b th typesetters yo shoul hav som ide o wha hav bee talkin about I too severa step t g fro th firs sketc outlin t th listin above bu th abilit t chang thing globally searc throughou th listing etc wa ke t makin i muc easier Wit n lin numbers majo structura change suc a movin al th subroutine t th beginnin (wher MBASI i repute t fin the faster ar eas t d wit bloc mov i WordStar The (fo thi example jus ad 'got [start] a th beginnin an labe '[start] wher th initializatio no begins an ru i throug NB again. Ther ma b somethin naggin i th bac o you mind-- lik ho d w ge ther th firs time perhaps I' gla yo asked Th ke t pullin yoursel u b you bootstrap i thi cas i th little-use PI [N2 parameter Digita Researc reall though o everythin here N add lin number t th fron o eac lin o file Fro there i i manua operatio t ru throug th listin (i WordSta non-documen mode onc mor t eliminat al blan line an globall search- and-replac eac labe wit it lin number Althoug i take longer sugges no usin th "withou asking optio (n o thi one Tha wa yo ca leav th labe wher i belong a th beginnin o eac routine. Th step fo thi proces ar reasonabl i yo remembe yo n longe hav t d thi onc yo ge th NB progra running I thi progra i adde t th FO library the yo ma no eve hav t d i a all Bu wil describ wha di anyway First us PI t ad th lin numbers: A>pip nbr.num=nbr.asc[n2] No fo slightl stick part I yo hav type thi progra listin i faithfully yo undoubtedl pu colon a th en o man o th lines Thes multipl physica line ar t b treate a singl logica lin b th MBASI interpreter T continu on logica lin o th nex physica line th physica lin mus en wit ^P^ whe i WordStar o ^ alon i MBASIC' ow editor Yo wil se tha WordSta indicate line terminate b linefee wit "J i th statu colum o th righ sid o you scree a describe i th Au 8 article. Thes line shoul b terminate wit linefee fo MBASIC bu no fo PIP' N mode PI wil conside the al separat lines T ge aroun this jus ra throug th fil an eliminate th extraneou lin number adde b PI whil wa replacin th label wit thei numbers Optionally yo coul leav al multipl statement o on physica lin o jus leav ou th colons Th fewe lin number yo have th faste th progra wil run s compoun statement ar goo idea withi reason (An besides i i onl fo thi on tim anyway...) Thi work fin unti yo ge t som o thos I THE ELS statements--MBASI use th <-- search for lf-cr REPLACE WITH? ^P^J<-- replace with just lf OPTIONS? gn^S <-- here is the ^S I was talking about ..back to normal Withou th ^ yo woul probabl no wan t bother th searc an replac take LON TIME Wit th displa updat turne of an th whol proga alread i memor i i almos instantaneous On thing normall i yo follo searc o search-and-replac sequenc wit ^Qp WordSta take yo bac t th poin fro whic th comman wa issued--i doe no wor wit th ^ optio becaus th las characte type (th ^S i locate a th en o th fil a fa a WordSta i concerned I yo d wan t retur t you star point us ^ a th speed-u characte instea o ^S Whe th search-and-replac operatio ends yo wil b a th en o th fil wit ^ (quic commands actio pending Jus hi th 'P ke fo retur t you previou locatio i th file! Finally bi abou filenam convention use i th program arbitraril decide tha th origina un-numbere fil shoul b .ASC th produc o NBR.BA woul b .NUM an th symbo listin woul b .SYM Onc i i finall debugged yo shoul LOA th .NU fil wit MBASI an SAV i a tokenize file tha i SAV i withou th ",A option Th tokenize fil load muc mor quickl tha a asci file I yo simpl 'SAV "PROGNAME" thi las time MBASI wil ad th '.BAS fo you. Tha jus abou bring m t th en o thi article Thi progra coul mak us o som enhancements an encourag yo t experimen an tak i fro here I th interes o simplicity lef thi versio o th progra prett basic bu on obviou additio woul b t ad wa t handl file to bi t fi i memory di thi wit versio 1. an a sendin i alon fo th library Anothe usefu modificatio woul b a explici "continu lin code tha woul allo writin th sourc wit VDO smal fas edito availabl fro th FO librar (min i versio 2A think) us i fo man things bu fin th lac o tru search-and-replac an bloc mov function somewha limiting Eve better i woul b nic t hav th progra compiled d no ow BASCOM s canno hel there bu I' thinkin abou writin i i TURB t mak i quick Yo ma not th displa o memor remainin i th progra progres lines-- use i t tes variou scheme t mak th interprete progra ru faste an lef i i fo you amazement. Thi wa bi chunk don' kno i ou kin edito ha an roo left bu a goin t ad th produc o th progra liste abov next s yo ca se th result Th progra doe wor o itself tha ha bee mos o m testin o i a thi time M addres an phon numbe ar i th listin i yo fin an bug o hav an individua questions. ..start monospace (if you have any room left) Listing of NBR.BAS 100 VER$ = "1.24, 10 Nov 85" 110 REM copyright 1985 by Brian Dugle 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036 120 REM This program may be used by any individual for non-commercial purposes; it may not be sold alone or as part of a group of "public domain" programs 130 DEFINT A-Z: TBLSZ = 50: CODESZ = 150: DIM LBLNAME$ (TBLSZ), LBLVAL (TBLSZ), PROGLINE$ (CODESZ) 140 DEF FNISODD (N) = ( (N AND 1) = 1 ) 150 DEF FNISEVEN (N) = ( (N AND 1) = 0 ) 160 DEF FNISWHITESPACE (C) = ( INSTR (WHITESPACE$, C) > 0 ) 170 DEF FNISREMLINE (L$) = ( LEFT$ (L$, 1) = RMK$ ) 180 DEF FNISBLANKLINE (L$) = ( LEN (L$) = 0 ) 190 DEF FNISLABELLINE (L$) = ( LEFT$ (L$, 1) = LBLSTCODE$ ) 200 DEF FNLNUM (N) = N * INCR + STARTNUM 210 FALSE = 0: TRUE = NOT FALSE: BLANK$ = CHR$ (32): TAB$ = CHR$ (9): LF$ = CHR$ (10): CR$ = CHR$ (13): QUOTE$ = CHR$ (34): CL$ = CHR$ (26) 220 STARTNUM = 100: INCR = 10: INFILE = 1: OUTFILE = 2 230 RMK$ = "'": LBLSTCODE$ = "[": LBLENDCODE$ = "]": MAXLBLNUM = 0: WHITESPACE$ = BLANK$ + TAB$ 240 PRINT CL$: PRINT "nbr.bas vers "; VER$; " (c) Brian Dugle" 250 ' [get filename] 260 INPUT "Enter the program name: ", PROGNAME$ 270 UPR$ = PROGNAME$: GOSUB 650: PROGNAME$ = UPR$: INFILNAME$ = PROGNAME$ + ".ASC": OUTFILNAME$ = PROGNAME$ + ".NUM": SYMFILNAME$ = PROGNAME$ + ".SYM" 280 PASS = 1 290 ON ERROR GOTO 700 300 OPEN "I", INFILE, INFILNAME$ 310 LN = 0: SOURCELN = 1: PRINT "Free memory ="; FRE (0) 320 WHILE NOT EOF (INFILE) AND (LN <= CODESZ) 330 PRINT CR$;: PRINT USING "pass 1, source line ### mem = #####"; SOURCELN; FRE (0); 340 LINE INPUT # INFILE, PROGLINE$ (LN): IF FNISREMLINE (PROGLINE$ (LN)) OR FNISBLANKLINE (PROGLINE$ (LN)) THEN 380 350 LBLPTR = INSTR (PROGLINE$ (LN), LBLSTCODE$): IF LBLPTR = 1 THEN GOSUB 720 360 LN = LN + 1 370 ' [next pass1 line] 380 SOURCELN = SOURCELN + 1 390 WEND 400 LASTLN = LN - 1 410 IF NOT EOF (INFILE) AND LN >= CODESZ THEN PRINT "Source file too big, ran out of romm at"; LN; "lines": PRINT "Change the variable 'codesz' and try again...": END 420 CLOSE INFILE 430 PASS = 2 440 OPEN "O", OUTFILE, OUTFILNAME$ 450 FOR LN = 0 TO LASTLN 460 PRINT CR$;: PRINT USING "pass 2, prog line ##### mem = #####"; FNLNUM (LN); FRE (0); 470 IF FNISLABELLINE ( PROGLINE$ (LN) ) THEN PROGLINE$ (LN) = STR$ (FNLNUM (LN)) + TAB$ + "' " + PROGLINE$ (LN): GOTO 590 480 PROGLINE$ (LN) = STR$ (FNLNUM (LN)) + TAB$ + PROGLINE$ (LN): LFPOS = INSTR (PROGLINE$ (LN), LF$): WHILE LFPOS <> 0: C$ = MID$ (PROGLINE$ (LN), LFPOS+1, 1): IF C$ = CR$ THEN LFPOS = LFPOS + 1 490 PROGLINE$ (LN) = LEFT$ (PROGLINE$ (LN), LFPOS) + TAB$ + MID$ (PROGLINE$ (LN), LFPOS+1): LFPOS = INSTR (LFPOS+1, PROGLINE$ (LN), LF$): WEND 500 QPOS = INSTR (PROGLINE$ (LN), QUOTE$): QUOTEPOS$ = "" 510 WHILE QPOS <> 0: QUOTEPOS$ = QUOTEPOS$ + CHR$ (QPOS): QPOS = INSTR (QPOS+1, PROGLINE$ (LN), QUOTE$): WEND 520 IF FNISODD (LEN (QUOTEPOS$)) THEN ERRMSG$ = "Quotes not paired": GOSUB 1030 ELSE QUOTEPOS$ = QUOTEPOS$ + CHR$ (255) 530 REMPTR = INSTR (PROGLINE$ (LN), RMK$): WHILE REMPTR > 0: PTR = REMPTR: GOSUB 810: IF PTRINQUOTES THEN REMPTR = INSTR (REMPTR+1, PROGLINE$ (LN), RMK$) 540 WEND 550 IF REMPTR > 0 THEN PROGLINE$ (LN) = LEFT$ (PROGLINE$ (LN), REMPTR - 1): P = LEN (PROGLINE$ (LN)): WHILE FNISWHITESPACE ( MID$ (PROGLINE$ (LN), P, 1) ): P = P - 1: WEND: PROGLINE$ (LN) = LEFT$ (PROGLINE$ (LN), P) 560 NUMLBLS = 0: LBLPTR = INSTR (PROGLINE$ (LN), LBLSTCODE$): WHILE LBLPTR > 0: PTR = LBLPTR: GOSUB 810: IF NOT PTRINQUOTES THEN GOSUB 870 570 LBLPTR = INSTR (LBLPTR+1, PROGLINE$ (LN), LBLSTCODE$): WEND: GOSUB 930 580 ' [print line] 590 PRINT # OUTFILE, PROGLINE$ (LN): PROGLINE$ (LN) = "" 600 NEXT LN 610 CLOSE OUTFILE 620 OPEN "O", OUTFILE, SYMFILNAME$: PRINT # OUTFILE, "1 'Label listing of: " + PROGNAME$ + ".BAS": FOR I = 0 TO MAXLBLNUM-1: PRINT # OUTFILE, STR$ (LBLVAL (I)); " '[" + LBLNAME$ (I) + "]": NEXT 630 CLOSE: PRINT: END 640 ' [make upper] 650 FOR C = 1 TO LEN (UPR$): CUPR$ = MID$ (UPR$, C, 1) 660 IF (CUPR$ >= "a") AND (CUPR$ <= "z") THEN CUPR$ = CHR$ ( ASC (CUPR$) - 32 ): UPR$ = LEFT$ (UPR$, C-1) + CUPR$ + MID$ (UPR$, C+1) 670 NEXT C 680 RETURN 690 ' [open error] 700 IF ERR = 53 THEN PRINT "Error, file: " INFILNAME$ " not found, check spelling": RESUME 260 ELSE ON ERROR GOTO 0 710 ' [eval label] 720 GOSUB 980: IF LBLERR THEN ERRMSG$ = "Incorrect label format": GOSUB 1030: GOTO 750 730 GOSUB 1010: IF INLIST THEN GOSUB 770 ELSE GOSUB 790 740 ' [end eval label] 750 RETURN 760 ' [lbl dbl def] 770 ERRMSG$ = "Label '[" + LBL$ + "]' is redefined in line" + STR$ (LN) + ", value is" + STR$ (LBLVAL (N)): GOSUB 1030: RETURN 780 ' [add to list] 790 LBLNAME$ (MAXLBLNUM) = LBL$: LBLVAL (MAXLBLNUM) = FNLNUM (LN + 1): MAXLBLNUM = MAXLBLNUM + 1: RETURN 800 ' [check ptr in quotes] 810 IF PTR > 255 THEN ERRMSG$ = "Pointer value too high, " + STR$ (PTR): GOSUB 1030: STOP 820 QNUM = 1: QPOS = ASC (QUOTEPOS$) 830 WHILE PTR > QPOS: QNUM = QNUM + 1: QPOS = ASC (MID$ (QUOTEPOS$, QNUM, 1)): WEND 840 PTRINQUOTES = FNISEVEN (QNUM) 850 RETURN 860 ' [save label num] 870 GOSUB 980: IF LBLERR THEN ERRMSG$ = "Incorrect label format at pos" + STR$ (LBLPTR): GOSUB 1030: GOTO 910 880 GOSUB 1010: IF NOT INLIST THEN ERRMSG$ = "Undefined label '[" + LBL$ + "]'": GOSUB 1030: GOTO 910 890 LABELPOS (NUMLBLS) = LBLPTR: LABELVAL (NUMLBLS) = LBLVAL (N): NUMLBLS = NUMLBLS + 1 900 ' [end save label num] 910 RETURN 920 ' [insert label nums] 930 FOR LP = NUMLBLS-1 TO 0 STEP -1 940 ENDLBLPTR = INSTR (LABELPOS (LP), PROGLINE$ (LN), LBLENDCODE$): PROGLINE$ (LN) = LEFT$ (PROGLINE$ (LN), (LABELPOS (LP) - 1)) + STR$ ( LABELVAL (LP) ) + MID$ (PROGLINE$ (LN), ENDLBLPTR + 1) 950 NEXT LP 960 RETURN 970 ' [get label] 980 ENDLBLPTR = INSTR (LBLPTR, PROGLINE$ (LN), LBLENDCODE$): LBLERR = (ENDLBLPTR = 0): IF NOT LBLERR THEN LBL$ = MID$ ( PROGLINE$ (LN), (LBLPTR + 1), (ENDLBLPTR - LBLPTR -1) ) ELSE LBL$ = "" 990 RETURN 1000 ' [match label] 1010 INLIST = FALSE: N = -1: WHILE (N < MAXLBLNUM) AND NOT INLIST: N = N + 1: INLIST = (LBL$ = LBLNAME$ (N)): WEND: RETURN 1020 ' [print errmsg] 1030 IF PASS = 1 THEN PRINT: PRINT "Error: "; ERRMSG$ ELSE IF PASS = 2 THEN PRINT # OUTFILE, ERRMSG$ 1040 RETURN ..back to normal for a couple lines Listing of NBR.SYM (Not tha sinc eac lin o thi fil i numbered yo ca LOAD it LIS it an LLIS i fro MBASIC I doe no RU ver wel though...) ..start monospace, last comment line 1 'Label listing of: NBR124.BAS 260 '[get filename] 380 '[next pass1 line] 590 '[print line] 650 '[make upper]  700 '[open error] 720 '[eval label] 750 '[end eval label] 770 '[lbl dbl def] 790 '[add to list] 810 '[check ptr in quotes] 870 '[save label num] 910 '[end save label num] 930 '[insert label nums] 980 '[get label] 1010 '[match label] 1030 '[print errmsg] AND NOT INLIST: N = N + 1: INLIST = (LBL$ = LBLNAME$ (N)): WEND: RETURN 1020 ' [print errmsg] 1030 IF PASS = 1 THEN PRINT: PRINT "Error: "; ERRMSG$ ELSE IF PASS = 2 THEN PRINT # OUTFILE, ERRMSG$ 1040 RETURN ..back to normal for a couple lines Listing of NBR.SYM (Not tha sinc eac lin o thi fil i numbered yo ca LOAD it LIS it an LLIS i fro MBASIC I doe no RU ver wel though...) ..start monospace, last comment line 1 'Label listing of: NBR124.BAS 260 '[get filename] 380 '[next pass1 line] 590 '[print line] 650 '[make upper] 'NBR is a MicroSoft BASIC-80 (r) basic program that adds line ' numbers to a file 'labels of the form "[label]" are converted to the appropriate ' line number ver$ = "1.24, 10 Nov 85" REM copyright 1985 by Brian Dugle 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036 REM This program may be used by any individual for non-commercial purposes; it may not be sold alone or as part of a group of "public domain" programs 'NOTE!! ' lines that end with a colon must be terminated with a linefeed ' (^P^J in WordStar) to continue on the next physical line-- ' this also applies to 'if' statements continued on multiple ' lines, ie, end physical lines that continue on the next line ' with a LINEFEED, not a RETURN... ' Lines continued in this manner are still limited to a total ' of 255 chars (including LFs, TABs, etc), this program does ' not check for this error, it crashes!! 'define constants for variable type, size of arrays... defint a-z: tblsz = 50: codesz = 150: dim lblname$ (tblsz), lblval (tblsz), progline$ (codesz) 'functions - boolean def fnisodd (n) = ( (n and 1) = 1 ) def fniseven (n) = ( (n and 1) = 0 ) def fniswhitespace (c) = ( instr (whitespace$, c) > 0 ) def fnisremline (l$) = ( left$ (l$, 1) = rmk$ ) def fnisblankline (l$) = ( len (l$) = 0 ) def fnislabelline (l$) = ( left$ (l$, 1) = lblstcode$ ) ' other functions... def fnlnum (n) = n * incr + startnum 'logical values and ascii constants false = 0: true = not false: blank$ = chr$ (32): tab$ = chr$ (9): lf$ = chr$ (10): cr$ = chr$ (13): quote$ = chr$ (34): cl$ = chr$ (26) 'program parameters and initialized variables startnum = 100: incr = 10: infile = 1: outfile = 2 rmk$ = "'": lblstcode$ = "[": lblendcode$ = "]": maxlblnum = 0: whitespace$ = blank$ + tab$ '___________________________________________________main program print cl$: print "nbr.bas vers "; ver$; " (c) Brian Dugle" [get filename] input "Enter the program name: ", progname$ upr$ = progname$: gosub [make upper]: progname$ = upr$: infilname$ = progname$ + ".ASC": outfilname$ = progname$ + ".NUM": symfilname$ = progname$ + ".SYM" '............................................pass one pass = 1 on error goto [open error] open "I", infile, infilname$ 'ln keeps track of lines in output ".NUM" file, sourceln counts input file lines for use in error messages ln = 0: sourceln = 1: print "Free memory ="; fre (0) while not eof (infile) and (ln <= codesz) ' ...keep user up to date on progress... print cr$;: print using "pass 1, source line ### mem = #####"; sourceln; fre (0); '...get a line and check if it should be kept for output line input # infile, progline$ (ln): if fnisremline (progline$ (ln)) or fnisblankline (progline$ (ln)) then [next pass1 line] '...if the line is not a remark and is not blank, then check to see if the line starts with a label, if so then add to list of labels... 'Note! remarks made with REM will stay in the file... lblptr = instr (progline$ (ln), lblstcode$): if lblptr = 1 then gosub [eval label] ln = ln + 1 [next pass1 line] 'Note! arriving at this label directly skips incrementing line number but source line is incr'd sourceln = sourceln + 1 wend lastln = ln - 1 'possible error, codesz terminated input--if so tell user if not eof (infile) and ln >= codesz then print "Source file too big, ran out of romm at"; ln; "lines": print "Change the variable 'codesz' and try again...": end close infile '............................................pass two pass = 2 open "O", outfile, outfilname$ for ln = 0 to lastln ' progress check... print cr$;: print using "pass 2, prog line ##### mem = #####"; fnlnum (ln); fre (0); 'reformat line 'if line is a label location, only action required is to make it a remark, skip everything else if fnislabelline ( progline$ (ln) ) then progline$ (ln) = str$ (fnlnum (ln)) + tab$ + "' " + progline$ (ln): goto [print line] 'add the line number to progline$ (ln) and add tabs following linefeeds to maintain indenting progline$ (ln) = str$ (fnlnum (ln)) + tab$ + progline$ (ln): lfpos = instr (progline$ (ln), lf$): while lfpos <> 0: c$ = mid$ (progline$ (ln), lfpos+1, 1): if c$ = cr$ then lfpos = lfpos + 1 progline$ (ln) = left$ (progline$ (ln), lfpos) + tab$ + mid$ (progline$ (ln), lfpos+1): lfpos = instr (lfpos+1, progline$ (ln), lf$): wend 'set quote positions 'search progline$ (ln) for quotes (chr$(34)), save position of each quote char in quotepos$ 'positions are one byte values saved in a string variable qpos = instr (progline$ (ln), quote$): quotepos$ = "" while qpos <> 0: quotepos$ = quotepos$ + chr$ (qpos): qpos = instr (qpos+1, progline$ (ln), quote$): wend if fnisodd (len (quotepos$)) then errmsg$ = "Quotes not paired": gosub [print errmsg] else quotepos$ = quotepos$ + chr$ (255) 'delete trailing remarks in progline$ (ln) start by finding first rmk$ that is not in a quoted string and return its position in remptr remptr = instr (progline$ (ln), rmk$): while remptr > 0: ptr = remptr: gosub [check ptr in quotes]: if ptrinquotes then remptr = instr (remptr+1, progline$ (ln), rmk$) wend 'if remptr is found, then delete trailing remark and whitespace from end of line if remptr > 0 then progline$ (ln) = left$ (progline$ (ln), remptr - 1): p = len (progline$ (ln)): while fniswhitespace ( mid$ (progline$ (ln), p, 1) ): p = p - 1: wend: progline$ (ln) = left$ (progline$ (ln), p) 'search for labels, convert to line numbers, insert in line and print to output file numlbls = 0: lblptr = instr (progline$ (ln), lblstcode$): while lblptr > 0: ptr = lblptr: gosub [check ptr in quotes]: if not ptrinquotes then gosub [save label num] lblptr = instr (lblptr+1, progline$ (ln), lblstcode$): wend: gosub [insert label nums] [print line] 'print the current line and then delete it to make more workspace print # outfile, progline$ (ln): progline$ (ln) = "" next ln '............................................finish up close outfile 'put the symbol table in a disk file that can be LISTed from MBASIC... open "O", outfile, symfilname$: print # outfile, "1 'Label listing of: " + progname$ + ".BAS": for i = 0 to maxlblnum-1: print # outfile, str$ (lblval (i)); " '[" + lblname$ (i) + "]": next close: print: end '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [make upper] 'pass a string to the routine in upr$ 'routine checks each char and, if lower case, converts it to ' upper case 'result returned in upr$ for c = 1 to len (upr$): cupr$ = mid$ (upr$, c, 1) ' ...if cupr$ is lower case, convert it and insert into upr$... if (cupr$ >= "a") and (cupr$ <= "z") then cupr$ = chr$ ( asc (cupr$) - 32 ): upr$ = left$ (upr$, c-1) + cupr$ + mid$ (upr$, c+1) next c return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [open error] 'error on attempt to open input file if err = 53 then print "Error, file: " infilname$ " not found, check spelling": resume [get filename] else on error goto 0 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [eval label] 'pass 1--extract a label from a line when lblptr = 1, ie, ' line starts with a label 'if it is not already in the list, add it to the list gosub [get label]: if lblerr then errmsg$ = "Incorrect label format": gosub [print errmsg]: goto [end eval label] gosub [match label]: if inlist then gosub [lbl dbl def] else gosub [add to list] [end eval label] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [lbl dbl def] 'error, found label already in list during pass one errmsg$ = "Label '[" + lbl$ + "]' is redefined in line" + str$ (ln) + ", value is" + str$ (lblval (n)): gosub [print errmsg]: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [add to list] 'pass one--add a new label to the list 'make label value the next line, remark line will not be the ' target of the goto or gosub lblname$ (maxlblnum) = lbl$: lblval (maxlblnum) = fnlnum (ln + 1): maxlblnum = maxlblnum + 1: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [check ptr in quotes] 'remark and label identifiers are not significant when in ' quoted strings 'this routine checks ptr to see if it is within a quoted string 'uses quotepos$ 'returns boolean ptrinquotes if ptr > 255 then errmsg$ = "Pointer value too high, " + str$ (ptr): gosub [print errmsg]: stop qnum = 1: qpos = asc (quotepos$) '...ASC function returns ascii code of first char in a string... while ptr > qpos: qnum = qnum + 1: qpos = asc (mid$ (quotepos$, qnum, 1)): wend ptrinquotes = fniseven (qnum) return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [save label num] 'pass two--change a label to its value 'arrive here with "lblptr" pointing to start of a label in ' "progline$ (ln)"  'find label in list and save value & position to replace or 'print error: undefined label gosub [get label]: if lblerr then errmsg$ = "Incorrect label format at pos" + str$ (lblptr): gosub [print errmsg]: goto [end save label num] gosub [match label]: if not inlist then errmsg$ = "Undefined label '[" + lbl$ + "]'": gosub [print errmsg]: goto [end save label num] 'found a good label, save position & value, bump counter labelpos (numlbls) = lblptr: labelval (numlbls) = lblval (n): numlbls = numlbls + 1 [end save label num] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [insert label nums] 'numlbls is the number of labels found in this line 'they must be replaced from the far end first so that the position ' of each insertion does not change 'array labelval () holds the label value to insert 'array labelpos () holds the pointer, where to insert it ' both arrays are set to 10 subscripts by default... for lp = numlbls-1 to 0 step -1 endlblptr = instr (labelpos (lp), progline$ (ln), lblendcode$): progline$ (ln) = left$ (progline$ (ln), (labelpos (lp) - 1)) + str$ ( labelval (lp) ) + mid$ (progline$ (ln), endlblptr + 1) next lp return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [get label] 'call with lblptr pointing to lblstcode$ in progline$ (ln) 'return with label name in lbl$, error in lblerr, lblptr not ' changed endlblptr = instr (lblptr, progline$ (ln), lblendcode$): lblerr = (endlblptr = 0): if not lblerr then lbl$ = mid$ ( progline$ (ln), (lblptr + 1), (endlblptr - lblptr -1) ) else lbl$ = "" return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [match label] 'find label in label list, return result in boolean "inlist" ' if in list, return subscript in "n" inlist = false: n = -1: while (n < maxlblnum) and not inlist: n = n + 1: inlist = (lbl$ = lblname$ (n)): wend: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [print errmsg] 'message passed in "errmsg$" 'prints to screen and outfile if pass = 1 then print: print "Error: "; errmsg$ else if pass = 2 then print # outfile, errmsg$ return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~ [get label] 'call with lblptr pointing to lblstcode$ in progline$ (ln) 'return with label name in lbl$, error in lblerr, lblptr not ' changed endlblptr = instr (lblptr, progline$ (ln), lblendcode$): lblerr = (endlblptr = 0): if not lblerr then lbl$ = mid$ ( progline$ (ln), (lblptr + 1), (endlblptr - lblptr -1) ) else lbl$ = "" return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [match label] 'find label in label list, return result in boolean "inlist" ' if in list, return subscript in "n" inlist = false: n = -1: while (n < maxlblnum) and not inlist: n = n + 1: inlist = (lbl$ = lblname$ (n)): wend: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [print era daESC$ (): ESC$;"L,528,504";CR$;ESC$;"B,6": b "NBR124": !bd VER$ "1.24, 10 Nov 85"bn copyright 1985 by Brian Dugle 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036'cx This program may be used by any individual for non-commercial purposes; it may not be sold alone or as part of a group of "public domain" programsc AZ: TBLSZ 2: CODESZ : LBLNAME$ (TBLSZ), LBLVAL (TBLSZ), PROGLINE$ (CODESZ)c ISODD (N) ( (N )  )c ISEVEN (N) ( (N )  )d ISWHITESPACE (C) ( (WHITESPACE$, C)  )4d ISREMLINE (L$) ( (L$, ) RMK$ )_d ISBLANKLINE (L$) ( (L$)  )d ISLABELLINE (L$) ( (L$, ) LBLSTCODE$ )d LNUM (N) N INCR STARTNUMDe FALSE : TRUE FALSE: BLANK$ ( ): TAB$ (): LF$ ( ): CR$ ( ): QUOTE$ ("): CL$ ()e STARTNUM d: INCR  : INFILE : OUTFILE e RMK$ "'": LBLSTCODE$ "[": LBLENDCODE$ "]": MAXLBLNUM : WHITESPACE$ BLANK$ TAB$f CL$: "nbr.bas vers "; VER$; " (c) Brian Dugle"6f : [get filename]cf "Enter the program name: ", PROGNAME$g UPR$ PROGNAME$: : PROGNAME$ UPR$: INFILNAME$ PROGNAME$ ".ASC": OUTFILNAME$ PROGNAME$ ".NUM": SYMFILNAME$ PROGNAME$ ".SYM"g PASS g" =g, "I", INFILE, INFILNAME$tg6 LN : SOURCELN : "Free memory ="; ()g@ (INFILE) (LN CODESZ)gJ CR$;: "pass 1, source line ### mem = #####"; SOURCELN; ();chT # INFILE, PROGLINE$ (LN): ISREMLINE (PROGLINE$ (LN)) ISBLANKLINE (PROGLINE$ (LN)) |h^ LBLPTR (PROGLINE$ (LN), LBLSTCODE$): LBLPTR  hh LN LN hr : [next pass1 line]h| SOURCELN SOURCELN h i LASTLN LN i (INFILE) LN CODESZ "Source file too big, ran out of romm at"; LN; "lines": "Change the variable 'codesz' and try again...": i INFILEi PASS i "O", OUTFILE, OUTFILNAME$j LN  LASTLNSj CR$;: "pass 2, prog line ##### mem = #####"; LNUM (LN); ();j ISLABELLINE ( PROGLINE$ (LN) ) PROGLINE$ (LN) (LNUM (LN)) TAB$ "' " PROGLINE$ (LN): Nk PROGLINE$ (LN) (LNUM (LN)) TAB$ PROGLINE$ (LN): LFPOS (PROGLINE$ (LN), LF$): LFPOS : C$ (PROGLINE$ (LN), LFPOS, ): C$ CR$ LFPOS LFPOS -l PROGLINE$ (LN) (PROGLINE$ (LN), LFPOS) TAB$ (PROGLINE$ (LN), LFPOS): LFPOS (LFPOS, PROGLINE$ (LN), LF$): gl QPOS (PROGLINE$ (LN), QUOTE$): QUOTEPOS$ ""l QPOS : QUOTEPOS$ QUOTEPOS$ (QPOS): QPOS (QPOS, PROGLINE$ (LN), QUOTE$): Im ISODD ( (QUOTEPOS$)) ERRMSG$ "Quotes not paired":  : QUOTEPOS$ QUOTEPOS$ ()m REMPTR (PROGLINE$ (LN), RMK$): REMPTR : PTR REMPTR: *: PTRINQUOTES REMPTR (REMPTR, PROGLINE$ (LN), RMK$)m n& REMPTR  PROGLINE$ (LN) (PROGLINE$ (LN), REMPTR ): P (PROGLINE$ (LN)): ISWHITESPACE ( (PROGLINE$ (LN), P, ) ): P P : : PROGLINE$ (LN) (PROGLINE$ (LN), P)Lo0 NUMLBLS : LBLPTR (PROGLINE$ (LN), LBLSTCODE$): LBLPTR : PTR LBLPTR: *: PTRINQUOTES fo: LBLPTR (LBLPTR, PROGLINE$ (LN), LBLSTCODE$): : oD : [print line]oN # OUTFILE, PROGLINE$ (LN): PROGLINE$ (LN) ""oX LNob OUTFILEpl "O", OUTFILE, SYMFILNAME$: # OUTFILE, "1 'Label listing of: " PROGNAME$ ".BAS": I  MAXLBLNUM: # OUTFILE, (LBLVAL (I)); " '[" LBLNAME$ (I) "]": pv : : p : [make upper]q C  (UPR$): CUPR$ (UPR$, C, )q (CUPR$ "a") (CUPR$ "z") CUPR$ ( (CUPR$)  ): UPR$ (UPR$, C) CUPR$ (UPR$, C)q Cq q : [open error]r 5 "Error, file: " INFILNAME$ " not found, check spelling":  : 1r : [eval label]r : LBLERR ERRMSG$ "Incorrect label format": : r : INLIST  : r : [end eval label]r r : [lbl dbl def]bs ERRMSG$ "Label '[" LBL$ "]' is redefined in line" (LN) ", value is" (LBLVAL (N)): : ys  : [add to list]s LBLNAME$ (MAXLBLNUM) LBL$: LBLVAL (MAXLBLNUM) LNUM (LN ): MAXLBLNUM MAXLBLNUM : s  : [check ptr in quotes]Rt* PTR  ERRMSG$ "Pointer value too high, " (PTR): : xt4 QNUM : QPOS (QUOTEPOS$)t> PTR QPOS: QNUM QNUM : QPOS ( (QUOTEPOS$, QNUM, )): tH PTRINQUOTES ISEVEN (QNUM)tR u\ : [save label num]suf : LBLERR ERRMSG$ "Incorrect label format at pos" (LBLPTR): : up : INLIST ERRMSG$ "Undefined label '[" LBL$ "]'": : /vz LABELPOS (NUMLBLS) LBLPTR: LABELVAL (NUMLBLS) LBLVAL (N): NUMLBLS NUMLBLS Mv : [end save label num]Tv qv : [insert label nums]v LP NUMLBLS  Uw ENDLBLPTR (LABELPOS (LP), PROGLINE$ (LN), LBLENDCODE$): PROGLINE$ (LN) (PROGLINE$ (LN), (LABELPOS (LP) )) ( LABELVAL (LP) ) (PROGLINE$ (LN), ENDLBLPTR )_w LPfw {w : [get label]>x ENDLBLPTR (LBLPTR, PROGLINE$ (LN), LBLENDCODE$): LBLERR (ENDLBLPTR ): LBLERR LBL$ ( PROGLINE$ (LN), (LBLPTR ), (ENDLBLPTR LBLPTR ) ) : LBL$ ""Ex \x : [match label]x INLIST FALSE: N : (N MAXLBLNUM) INLIST: N N : INLIST (LBL$ LBLNAME$ (N)): : x : [print errmsg]>y PASS  : "Error: "; ERRMSG$ : PASS  # OUTFILE, ERRMSG$Ey  : x : [print errmsg]>y PASS  : "Error: "; ERRMSG$ : PASS  # O 100 ver$ = "1.24, 10 Nov 85" 110 REM copyright 1985 by Brian Dugle 6002 Carrindale Ct Burke, VA 22015 (703) 569-3036 120 REM This program may be used by any individual for non-commercial purposes; it may not be sold alone or as part of a group of "public domain" programs 130 defint a-z: tblsz = 50: codesz = 150: dim lblname$ (tblsz), lblval (tblsz), progline$ (codesz) 140 def fnisodd (n) = ( (n and 1) = 1 ) 150 def fniseven (n) = ( (n and 1) = 0 ) 160 def fniswhitespace (c) = ( instr (whitespace$, c) > 0 ) 170 def fnisremline (l$) = ( left$ (l$, 1) = rmk$ ) 180 def fnisblankline (l$) = ( len (l$) = 0 ) 190 def fnislabelline (l$) = ( left$ (l$, 1) = lblstcode$ ) 200 def fnlnum (n) = n * incr + startnum 210 false = 0: true = not false: blank$ = chr$ (32): tab$ = chr$ (9): lf$ = chr$ (10): cr$ = chr$ (13): quote$ = chr$ (34): cl$ = chr$ (26) 220 startnum = 100: incr = 10: infile = 1: outfile = 2 230 rmk$ = "'": lblstcode$ = "[": lblendcode$ = "]": maxlblnum = 0: whitespace$ = blank$ + tab$ 240 print cl$: print "nbr.bas vers "; ver$; " (c) Brian Dugle" 250 ' [get filename] 260 input "Enter the program name: ", progname$ 270 upr$ = progname$: gosub 650: progname$ = upr$: infilname$ = progname$ + ".ASC": outfilname$ = progname$ + ".NUM": symfilname$ = progname$ + ".SYM" 280 pass = 1 290 on error goto 700 300 open "I", infile, infilname$ 310 ln = 0: sourceln = 1: print "Free memory ="; fre (0) 320 while not eof (infile) and (ln <= codesz) 330 print cr$;: print using "pass 1, source line ### mem = #####"; sourceln; fre (0); 340 line input # infile, progline$ (ln): if fnisremline (progline$ (ln)) or fnisblankline (progline$ (ln)) then 380 350 lblptr = instr (progline$ (ln), lblstcode$): if lblptr = 1 then gosub 720 360 ln = ln + 1 370 ' [next pass1 line] 380 sourceln = sourceln + 1 390 wend 400 lastln = ln - 1 410 if not eof (infile) and ln >= codesz then print "Source file too big, ran out of romm at"; ln; "lines": print "Change the variable 'codesz' and try again...": end 420 close infile 430 pass = 2 440 open "O", outfile, outfilname$ 450 for ln = 0 to lastln 460 print cr$;: print using "pass 2, prog line ##### mem = #####"; fnlnum (ln); fre (0); 470 if fnislabelline ( progline$ (ln) ) then progline$ (ln) = str$ (fnlnum (ln)) + tab$ + "' " + progline$ (ln): goto 590 480 progline$ (ln) = str$ (fnlnum (ln)) + tab$ + progline$ (ln): lfpos = instr (progline$ (ln), lf$): while lfpos <> 0: c$ = mid$ (progline$ (ln), lfpos+1, 1): if c$ = cr$ then lfpos = lfpos + 1 490 progline$ (ln) = left$ (progline$ (ln), lfpos) + tab$ + mid$ (progline$ (ln), lfpos+1): lfpos = instr (lfpos+1, progline$ (ln), lf$): wend 500 qpos = instr (progline$ (ln), quote$): quotepos$ = "" 510 while qpos <> 0: quotepos$ = quotepos$ + chr$ (qpos): qpos = instr (qpos+1, progline$ (ln), quote$): wend 520 if fnisodd (len (quotepos$)) then errmsg$ = "Quotes not paired": gosub 1030 else quotepos$ = quotepos$ + chr$ (255) 530 remptr = instr (progline$ (ln), rmk$): while remptr > 0: ptr = remptr: gosub 810: if ptrinquotes then remptr = instr (remptr+1, progline$ (ln), rmk$) 540 wend 550 if remptr > 0 then progline$ (ln) = left$ (progline$ (ln), remptr - 1): p = len (progline$ (ln)): while fniswhitespace ( mid$ (progline$ (ln), p, 1) ): p = p - 1: wend: progline$ (ln) = left$ (progline$ (ln), p) 560 numlbls = 0: lblptr = instr (progline$ (ln), lblstcode$): while lblptr > 0: ptr = lblptr: gosub 810: if not ptrinquotes then gosub 870 570 lblptr = instr (lblptr+1, progline$ (ln), lblstcode$): wend: gosub 930 580 ' [print line] 590 print # outfile, progline$ (ln): progline$ (ln) = "" 600 next ln 610 close outfile 620 open "O", outfile, symfilname$: print # outfile, "1 'Label listing of: " + progname$ + ".BAS": for i = 0 to maxlblnum-1:  print # outfile, str$ (lblval (i)); " '[" + lblname$ (i) + "]": next 630 close: print: end 640 ' [make upper] 650 for c = 1 to len (upr$): cupr$ = mid$ (upr$, c, 1) 660 if (cupr$ >= "a") and (cupr$ <= "z") then cupr$ = chr$ ( asc (cupr$) - 32 ): upr$ = left$ (upr$, c-1) + cupr$ + mid$ (upr$, c+1) 670 next c 680 return 690 ' [open error] 700 if err = 53 then print "Error, file: " infilname$ " not found, check spelling": resume 260 else on error goto 0 710 ' [eval label] 720 gosub 980: if lblerr then errmsg$ = "Incorrect label format": gosub 1030: goto 750 730 gosub 1010: if inlist then gosub 770 else gosub 790 740 ' [end eval label] 750 return 760 ' [lbl dbl def] 770 errmsg$ = "Label '[" + lbl$ + "]' is redefined in line" + str$ (ln) + ", value is" + str$ (lblval (n)): gosub 1030: return 780 ' [add to list] 790 lblname$ (maxlblnum) = lbl$: lblval (maxlblnum) = fnlnum (ln + 1): maxlblnum = maxlblnum + 1: return 800 ' [check ptr in quotes] 810 if ptr > 255 then errmsg$ = "Pointer value too high, " + str$ (ptr): gosub 1030: stop 820 qnum = 1: qpos = asc (quotepos$) 830 while ptr > qpos: qnum = qnum + 1: qpos = asc (mid$ (quotepos$, qnum, 1)): wend 840 ptrinquotes = fniseven (qnum) 850 return 860 ' [save label num] 870 gosub 980: if lblerr then errmsg$ = "Incorrect label format at pos" + str$ (lblptr): gosub 1030: goto 910 880 gosub 1010: if not inlist then errmsg$ = "Undefined label '[" + lbl$ + "]'": gosub 1030: goto 910 890 labelpos (numlbls) = lblptr: labelval (numlbls) = lblval (n): numlbls = numlbls + 1 900 ' [end save label num] 910 return 920 ' [insert label nums] 930 for lp = numlbls-1 to 0 step -1 940 endlblptr = instr (labelpos (lp), progline$ (ln), lblendcode$): progline$ (ln) = left$ (progline$ (ln), (labelpos (lp) - 1)) + str$ ( labelval (lp) ) + mid$ (progline$ (ln), endlblptr + 1) 950 next lp 960 return 970 ' [get label] 980 endlblptr = instr (lblptr, progline$ (ln), lblendcode$): lblerr = (endlblptr = 0): if not lblerr then lbl$ = mid$ ( progline$ (ln), (lblptr + 1), (endlblptr - lblptr -1) ) else lbl$ = "" 990 return 1000 ' [match label] 1010 inlist = false: n = -1: while (n < maxlblnum) and not inlist: n = n + 1: inlist = (lbl$ = lblname$ (n)): wend: return 1020 ' [print errmsg] 1030 if pass = 1 then print: print "Error: "; errmsg$ else if pass = 2 then print # outfile, errmsg$ 1040 return ] 1030 if pass = 1 then print: print "Error: "; errmsg$ else if pass = 2 then print # outfile, errmsg$ 1040 numlbls + 1 900 ' [end save label num] 910 return 920 ' [insert label nums] 930 for lp = numlbls-1 to 0 step -1 940 endlblptr = instr (labelpos (lp), progline$ (ln), lblendcode$): progline$ (ln) = left$ (progline$ (ln), (labelpos (lp) - 1)) + str$ ( labelval (lp) ) + mid$ (progline$ (ln), endlblptr + 1) 950 next lp 960 return 970 ' [get label] 980 e1 'Label listing of: NBR124.BAS 260 '[get filename] 380 '[next pass1 line] 590 '[print line] 650 '[make upper] 700 '[open error] 720 '[eval label] 750 '[end eval label] 770 '[lbl dbl def] 790 '[add to list] 810 '[check ptr in quotes] 870 '[save label num] 910 '[end save label num] 930 '[insert label nums] 980 '[get label] 1010 '[match label] 1030 '[print errmsg] l num] 910 '[end save label num] 930 '[insert label nums] 980 '[get label] 1010 '[match label] 1030 '[ 'nbr is a microsoft (r) basic program that adds line numbers to a file 'labels of the form "[label]" are converted to the appropriate line number 'NOTE!! ' lines that end with a colon must be terminated with a linefeed ' (^P^J in WordStar) to continue on the next physical line-- ' this also applies to 'if' statements continued on multiple ' lines, ie, end physical lines that continue on the next line ' with a LINEFEED, not a RETURN... ' Lines continued in this manner are still limited to a total ' of 255 chars (including LFs, TABs, etc), this program does ' not check for this error, it crashes!! vers$ = "vers 1.3, 23 Jun 85 " + "copyright (c) 1985 by Brian Dugle" 'This program may be used by any individual for non-commercial purposes 'it may not be sold alone or as part of a group of "public domain" 'programs ' 1.3 Changed progline$ to array for quicker disk processing ' and defined all variables to default to integer ' 23 Jun 85 BCD ' 1.2 Added pass & line number heartbeat ' 20 Jun 85 BCD goto [start] '~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutines ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [eval label] 'extract a label from a line when lblptr = 1, ie, line starts with a label 'if it is not already in the list, add it to the list gosub [get label] if lblerr then errmsg$ = "Incorrect label format": gosub [print errmsg]: goto [end eval label] gosub [match label] if inlist then gosub [lbl dbl def] else gosub [add to list] [end eval label] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [reformat line] 'progline$ (n) from infile is not a remark, so add the line number ' and tabs following linefeeds to maintain indenting 'if progline$ (n) is a label, make it a remark to remain in file... if left$ (progline$ (n), 1) = lblstcode$ then progline$ (n) = "' " + progline$ (n) progline$ (n) = str$ (linenum) + tab$ + progline$ (n) lfpos = instr (progline$ (n), lf$) while lfpos <> 0 ' what is the char following the lf? c$ = mid$ (progline$ (n), lfpos+1, 1) ' did MBasic add a cr after the lf? if so, must bump ptr... if c$ = cr$ then lfpos = lfpos + 1 ' a lf in the line means logical line continues on another physical ' line, so add a tab to make indenting line up correctly progline$ (n) = left$ (progline$ (n), lfpos) + tab$ + mid$ (progline$ (n), lfpos+1) ' now look for any more linefeed chars lfpos = instr (lfpos+1, progline$ (n), lf$) wend return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [set quote positions] 'searches progline$ (n) for quotes (chr$(34)), saves position of ' each quote char in quotepos$ 'positions are one byte values saved in a string variable qpos = instr (progline$ (n), quote$): quotepos$ = "" while qpos <> 0 quotepos$ = quotepos$ + chr$ (qpos): qpos = instr (qpos+1, progline$ (n), quote$) wend quotepos$ = quotepos$ + chr$ (255) numquotechars = len (quotepos$) - 1: oddoreven = numquotechars: gosub [check odd]: if isodd then errmsg$ = "Quotes not paired": gosub [print errmsg] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [set rem ptr] 'routine finds the first rmk$ in progline$ (n) that is not in a quoted string ' returns its position in remptr remptr = instr (progline$ (n), rmk$) 'repeat... [next rem ptr] ptr = remptr: gosub [check ptr in quotes] if ptrinquotes then remptr = instr (remptr+1, progline$ (n), rmk$): goto [next rem ptr] '...until remptr not in quotes if remptr = 0 then remptr = 255 return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [check ptr in quotes] 'remark and label identifiers are not significant when in quoted strings 'this routine checks ptr to see if it is within a quoted string ' uses quotepos$ ' returns boolean ptrinquotes if ptr > 255 then errmsg$ = "Pointer value too high, " + str$ (ptr): gosub [print errmsg]: stop qnum = 1: qpos = asc (quotepos$) while ptr > qpos qnum = qnum + 1: qpos = asc (mid$ (quotepos$, qnum, 1)) wend oddoreven = qnum: gosub [check odd] ptrinquotes = iseven return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [check odd] 'integer passed in oddoreven is evaluated 'boolean results returned in isodd and iseven isodd = (oddoreven and 1) = 1: iseven = not isodd: return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [insert label num] 'pass two--change a label to its value 'arrive here with lblptr pointing to start of a label in progline$ (n) ' find label in list and replace with value or ' print error: undefined label gosub [get label] if lblerr then errmsg$ = "Incorrect label format at pos" + str$ (lblptr): gosub [print errmsg]: goto [end insert label num] gosub [match label] if not inlist then errmsg$ = "Undefined label '[" + lbl$ + "]'": gosub [print errmsg]: goto [end insert label num] 'endl!blptr set by [get label] above... progline$ (n) = left$ (progline$ (n), lblptr - 1) + str$ (lblval (nlbl)) + mid$ (progline$ (n), endlblptr + 1) [end insert label num] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [get label] 'call with lblptr pointing to lblstcode$ in progline$ (n) 'return with label name in lbl$, error in lblerr, lblptr not changed ' and endlblptr at position of lblendcode$... endlblptr = instr (lblptr, progline$ (n), lblendcode$) lblerr = (endlblptr = 0) if not lblerr then lbl$ = mid$ (progline$ (n), (lblptr + 1), (endlblptr - lblptr -1)) else lbl$ = "" return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [match label] 'find label in label list, return result in boolean "inlist" ' if in list, return subscript in "nlbl" inlist = false: nlbl = -1 while (nlbl < maxlblnum) and not inlist nlbl = nlbl + 1 inlist = (lbl$ = lblname$ (nlbl)) wend return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [make upper] 'pass a string to this routine in upr$ 'routine checks each char and, if lower case, converts it to upper case 'result returned in upr$ for c = 1 to len (upr$) cupr$ = mid$ (upr$, c, 1) if (cupr$ < "a") or (cupr$ > "z") then goto [next char] ' ...cupr$ is lower case, convert it and insert into upr$... cupr$ = chr$ ( asc (cupr$) - 32 ) upr$ = left$ (upr$, c-1) + cupr$ + mid$ (upr$, c+1) [next char] next c return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [open error] 'error on attempt to open input file if err = 53 then print "Error, file: " infile$ " not found, check spelling": resume [get filename] else on error goto 0 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [lbl dbl def] 'error, found label already in list during pass one errmsg$ = "Label '[" + lbl$ + "]' is redefined in line" + str$ (linenum) + ", value is" + str$ (lblval (n)) gosub [print errmsg] return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [add to list] 'pass one--add a new label to the list lblname$ (maxlblnum) = lbl$ lblval (maxlblnum) = linenum maxlblnum = maxlblnum + 1 return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [print errmsg] 'message passed in "errmsg$" 'prints to screen and outfile print "Error in source line" + sourceln: print errmsg$ if pass = 2 then print # outfile, errmsg$ return '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ [start] defint a-z tblsz = 50: nmax = 99 dim lblname$ (tblsz), lblval (tblsz), progline$ (nmax) 'logical values and ascii constants false = 0: true = not false: tab$ = chr$ (9): lf$ = chr$ (10): cr$ = chr$ (13): quote$ = chr$ (34) 'terminal constant - clear screen cl$ = chr$ (26) 'program parameters and initialized variables startnum = 100: incr = 10: infile = 1: outfile = 2 rmk$ = "'": lblstcode$ = "[": lblendcode$ = "]": maxlblnum = 0 '_______________________________________________________main program print cl$ print vers$ [get filename] 'the source code file must have the extension ".ASC" 'the program will write a ".NUM" file and a ".SYM" file ' the ".NUM" file is a numbered file in ascii format ' LOAD the "prog.NUM" file and SAVE "prog" to create a "prog.BAS" file ' the ".SYM" file can be LOADed and LISTed but consists only of ' a listing of the labels and their line numbers input "Enter the program name: ", progname$ upr$ = progname$: gosub [make upper]: progname$ = upr$: infile$ = progname$ + ".ASC": outfile$ = progname$ + ".NUM": symfile$ = progname$ + ".SYM" '............................................pass one pass = 1 on error goto [open error] open "I", infile, infile$ linenum = startnum: nbase = 0 [next block] 'get up to nmax+1 lines from infile ' n is used to count lines in the array progline$ (n) ' linenum holds the line number used in the numbered file output ' sourceln holds the line number from the source file n = 0 while not eof (infile) and n <= nmax line input # infile, progline$ (n): n = n + 1 wend lastn = n - 1 'process the lines looking for labels for n = 0 to lastn sourceln = nbase + n + 1 print "pass"; pass; " line"; sourceln; cr$; lineisrem = (left$ (progline$ (n), 1) = rmk$): if lineisrem then [next pass1 line] if len (progline$ (n)) = 0 then [next pass1 line] ' ...if the line is not a remark and is not blank, check to see ' if it starts with a label... lblptr = instr (progline$ (n), lblstcode$): if lblptr = 1 then gosub [eval label] linenum = linenum + incr [next pass1 line] next n if not eof (infile) then nbase = nbase + nmax + 1: goto [next block] close infile 'check if entire program is still in memory... proginmem = (nbase = 0) '............................................pass two pass = 2 if n"ot proginmem then open "I", infile, infile$ open "O", outfile, outfile$ linenum = startnum: nbase = 0 [next block pass 2] 'process each line substituting linenum for labels and write to outfile n = 0 while not eof (infile) and n <= nmax line input # infile, progline$ (n): n = n + 1 wend lastn = n - 1 for n = 0 to lastn sourceln = nbase + n + 1: print "pass"; pass; " line"; sourceln; " "; cr$; ' ...skip all work if progline$ (n) is a remark... lineisrem = (left$ (progline$ (n), 1) = rmk$): if lineisrem then [next pass2 line] ' ...check if blank line... if len (progline$ (n)) = 0 then [next pass2 line] ' ...not a remark or a blank line, set up for output... gosub [reformat line] gosub [set quote positions] gosub [set rem ptr] lblptr = instr (progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 while lblptr < remptr ptr = lblptr: gosub [check ptr in quotes] if not ptrinquotes then gosub [insert label num] lblptr = instr (lblptr+1, progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 wend print # outfile, progline$ (n) linenum = linenum + incr [next pass2 line] next n if not proginmem then nbase = nbase + nmax + 1: if not eof (infile) then [next block pass 2] if not proginmem then close infile close outfile print '............................................finish up 'put the symbol table in a disk file that can be LISTed from MBasic... open "O", outfile, symfile$ print # outfile, "1 'Label listing of: " + progname$ + ".BAS" for i = 0 to maxlblnum-1 print # outfile, str$ (lblval (i)), "'[" + lblname$ (i) + "]" next close end ns] gosub [set rem ptr] lblptr = instr (progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 while lblptr < remptr ptr = lblptr: gosub [check ptr in quotes] if not ptrinquotes then gosub [insert label num] lblptr = instr (ad VERS$ "vers 1.3, 23 Jun 85 " "copyright (c) 1985 by Brian Dugle" bn !bx : [eval label]-b vb LBLERR ERRMSG$ "Incorrect label format": : b b INLIST f : b : [end eval label]b b : [reformat line]5c (PROGLINE$ (N), ) LBLSTCODE$ PROGLINE$ (N) "' " PROGLINE$ (N)nc PROGLINE$ (N) (LINENUM) TAB$ PROGLINE$ (N)c LFPOS (PROGLINE$ (N), LF$)c LFPOS c C$ (PROGLINE$ (N), LFPOS, )c C$ CR$ LFPOS LFPOS Xd PROGLINE$ (N) (PROGLINE$ (N), LFPOS) TAB$ (PROGLINE$ (N), LFPOS)d LFPOS (LFPOS, PROGLINE$ (N), LF$)d d" d, : [set quote positions]d6 QPOS (PROGLINE$ (N), QUOTE$): QUOTEPOS$ ""d@ QPOS PeJ QUOTEPOS$ QUOTEPOS$ (QPOS): QPOS (QPOS, PROGLINE$ (N), QUOTE$)WeT |e^ QUOTEPOS$ QUOTEPOS$ ()eh NUMQUOTECHARS (QUOTEPOS$) : ODDOREVEN NUMQUOTECHARS: : ISODD ERRMSG$ "Quotes not paired": fr f| : [set rem ptr]Cf REMPTR (PROGLINE$ (N), RMK$)[f : [next rem ptr]xf PTR REMPTR: f PTRINQUOTES REMPTR (REMPTR, PROGLINE$ (N), RMK$): f REMPTR  REMPTR f g : [check ptr in quotes]cg PTR  ERRMSG$ "Pointer value too high, " (PTR): : g QNUM : QPOS (QUOTEPOS$)g PTR QPOSg QNUM QNUM : QPOS ( (QUOTEPOS$, QNUM, ))g g ODDOREVEN QNUM: h PTRINQUOTES ISEVEN h 5h : [check odd]mh& ISODD (ODDOREVEN ) : ISEVEN ISODD: h0 : [insert label num]h: hD LBLERR ERRMSG$ "Incorrect label format at pos" (LBLPTR): : lhN TiX INLIST ERRMSG$ "Undefined label '[" LBL$ "]'": : lib PROGLINE$ (N) (PROGLINE$ (N), LBLPTR ) (LBLVAL (NLBL)) (PROGLINE$ (N), ENDLBLPTR )il : [end insert label num]iv j : [get label]>j ENDLBLPTR (LBLPTR, PROGLINE$ (N), LBLENDCODE$)\j LBLERR (ENDLBLPTR )j LBLERR LBL$ (PROGLINE$ (N), (LBLPTR ), (ENDLBLPTR LBLPTR )) : LBL$ ""j j : [match label]j INLIST FALSE: NLBL %k (NLBL MAXLBLNUM) INLIST;k NLBL NLBL ck INLIST (LBL$ LBLNAME$ (NLBL))jk qk k : [make upper]k C  (UPR$)k  CUPR$ (UPR$, C, )k (CUPR$ "a") (CUPR$ "z") 4l  CUPR$ ( (CUPR$)  )Jl* UPR$ (UPR$, C) CUPR$ (UPR$, C)_l4 : [next char]hl> ColH lR : [open error]l\ 5 "Error, file: " INFILE$ " not found, check spelling": L : mf : [lbl dbl def]pmp ERRMSG$ "Label '[" LBL$ "]' is redefined in line" (LINENUM) ", value is" (LBLVAL (N))|mz m m : [add to list]m LBLNAME$ (MAXLB#LNUM) LBL$m LBLVAL (MAXLBLNUM) LINENUMm MAXLBLNUM MAXLBLNUM n n : [print errmsg]Pn "Error in source line" SOURCELN: ERRMSG$yn PASS  # OUTFILE, ERRMSG$n n : [start]n AZn TBLSZ 2: NMAX cn LBLNAME$ (TBLSZ), LBLVAL (TBLSZ), PROGLINE$ (NMAX)Vo FALSE : TRUE FALSE: TAB$ (): LF$ ( ): CR$ ( ): QUOTE$ (")io CL$ ()o$ STARTNUM d: INCR  : INFILE : OUTFILE o. RMK$ "'": LBLSTCODE$ "[": LBLENDCODE$ "]": MAXLBLNUM o8 CL$pB VERS$pL : [get filename]IpV "Enter the program name: ", PROGNAME$p` UPR$ PROGNAME$: : PROGNAME$ UPR$: INFILE$ PROGNAME$ ".ASC": OUTFILE$ PROGNAME$ ".NUM": SYMFILE$ PROGNAME$ ".SYM"pj PASS pt Rq~ "I", INFILE, INFILE$;q LINENUM STARTNUM: NBASE Qq : [next block]\q N ~q (INFILE) N NMAXq # INFILE, PROGLINE$ (N): N N q q LASTN N q N  LASTNq SOURCELN NBASE N )r "pass"; PASS; " line"; SOURCELN; CR$;pr LINEISREM ( (PROGLINE$ (N), ) RMK$): LINEISREM r (PROGLINE$ (N))  r LBLPTR (PROGLINE$ (N), LBLSTCODE$): LBLPTR  xr  LINENUM LINENUM INCRs : [next pass1 line]s N[s( (INFILE) NBASE NBASE NMAX : is2 INFILEs< PROGINMEM (NBASE )sF PASS sP PROGINMEM "I", INFILE, INFILE$sZ "O", OUTFILE, OUTFILE$td LINENUM STARTNUM: NBASE "tn : [next block pass 2]-tx N Ot (INFILE) N NMAX~t # INFILE, PROGLINE$ (N): N N t t LASTN N t N  LASTNt SOURCELN NBASE N : "pass"; PASS; " line"; SOURCELN; " "; CR$;Fu LINEISREM ( (PROGLINE$ (N), ) RMK$): LINEISREM @lu (PROGLINE$ (N))  @yu u ,u |u LBLPTR (PROGLINE$ (N), LBLSTCODE$): LBLPTR  LBLPTR u LBLPTR REMPTRv PTR LBLPTR: 7v PTRINQUOTES 0v LBLPTR (LBLPTR, PROGLINE$ (N), LBLSTCODE$): LBLPTR  LBLPTR v" v, # OUTFILE, PROGLINE$ (N)v6 LINENUM LINENUM INCRv@ : [next pass2 line]vJ NDwT PROGINMEM NBASE NBASE NMAX : (INFILE) nbw^ PROGINMEM INFILEqwh OUTFILExwr w| "O", OUTFILE, SYMFILE$w # OUTFILE, "1 'Label listing of: " PROGNAME$ ".BAS"w I  MAXLBLNUM1x # OUTFILE, (LBLVAL (I)), "'[" LBLNAME$ (I) "]"8x ?x Fx NAME$ ".BAS"w I  MAXLBLNUM1x # OUTFILE, (LBLVAL (I)), "'[" LBLNAME$ (I) "t SOURCELN NBASE N : "pass"; PASS; " line"; SOURCELN; " "; CR$;Fu LINEISREM ( (PROGLINE$ (N), ) RMK$): LINEISREM @lu (PROGLINE$ (N))  @yu u ,u |u LBLPTR (PROGLINE$ 100 vers$ = "vers 1.3, 23 Jun 85 " + "copyright (c) 1985 by Brian Dugle" 110 goto 1000 120 ' [eval label] 130 gosub 640 140 if lblerr then errmsg$ = "Incorrect label format": gosub 960: goto 170 150 gosub 690 160 if inlist then gosub 870 else gosub 910 170 ' [end eval label] 180 return 190 ' [reformat line] 200 if left$ (progline$ (n), 1) = lblstcode$ then progline$ (n) = "' " + progline$ (n) 210 progline$ (n) = str$ (linenum) + tab$ + progline$ (n) 220 lfpos = instr (progline$ (n), lf$) 230 while lfpos <> 0 240 c$ = mid$ (progline$ (n), lfpos+1, 1) 250 if c$ = cr$ then lfpos = lfpos + 1 260 progline$ (n) = left$ (progline$ (n), lfpos) + tab$ + mid$ (progline$ (n), lfpos+1) 270 lfpos = instr (lfpos+1, progline$ (n), lf$) 280 wend 290 return 300 ' [set quote positions] 310 qpos = instr (progline$ (n), quote$): quotepos$ = "" 320 while qpos <> 0 330 quotepos$ = quotepos$ + chr$ (qpos): qpos = instr (qpos+1, progline$ (n), quote$) 340 wend 350 quotepos$ = quotepos$ + chr$ (255) 360 numquotechars = len (quotepos$) - 1: oddoreven = numquotechars: gosub 540: if isodd then errmsg$ = "Quotes not paired": gosub 960 370 return 380 ' [set rem ptr] 390 remptr = instr (progline$ (n), rmk$) 400 ' [next rem ptr] 410 ptr = remptr: gosub 450 420 if ptrinquotes then remptr = instr (remptr+1, progline$ (n), rmk$): goto 400 430 if remptr = 0 then remptr = 255 440 return 450 ' [check ptr in quotes] 460 if ptr > 255 then errmsg$ = "Pointer value too high, " + str$ (ptr): gosub 960: stop 470 qnum = 1: qpos = asc (quotepos$) 480 while ptr > qpos 490 qnum = qnum + 1: qpos = asc (mid$ (quotepos$, qnum, 1)) 500 wend 510 oddoreven = qnum: gosub 540 520 ptrinquotes = iseven 530 return 540 ' [check odd] 550 isodd = (oddoreven and 1) = 1: iseven = not isodd: return 560 ' [insert label num] 570 gosub 640 580 if lblerr then errmsg$ = "Incorrect label format at $pos" + str$ (lblptr): gosub 960: goto 620 590 gosub 690 600 if not inlist then errmsg$ = "Undefined label '[" + lbl$ + "]'": gosub 960: goto 620 610 progline$ (n) = left$ (progline$ (n), lblptr - 1) + str$ (lblval (nlbl)) + mid$ (progline$ (n), endlblptr + 1) 620 ' [end insert label num] 630 return 640 ' [get label] 650 endlblptr = instr (lblptr, progline$ (n), lblendcode$) 660 lblerr = (endlblptr = 0) 670 if not lblerr then lbl$ = mid$ (progline$ (n), (lblptr + 1), (endlblptr - lblptr -1)) else lbl$ = "" 680 return 690 ' [match label] 700 inlist = false: nlbl = -1 710 while (nlbl < maxlblnum) and not inlist 720 nlbl = nlbl + 1 730 inlist = (lbl$ = lblname$ (nlbl)) 740 wend 750 return 760 ' [make upper] 770 for c = 1 to len (upr$) 780 cupr$ = mid$ (upr$, c, 1) 790 if (cupr$ < "a") or (cupr$ > "z") then goto 820 800 cupr$ = chr$ ( asc (cupr$) - 32 ) 810 upr$ = left$ (upr$, c-1) + cupr$ + mid$ (upr$, c+1) 820 ' [next char]  830 next c 840 return 850 ' [open error] 860 if err = 53 then print "Error, file: " infile$ " not found, check spelling": resume 1100 else on error goto 0 870 ' [lbl dbl def] 880 errmsg$ = "Label '[" + lbl$ + "]' is redefined in line" + str$ (linenum) + ", value is" + str$ (lblval (n)) 890 gosub 960 900 return 910 ' [add to list] 920 lblname$ (maxlblnum) = lbl$ 930 lblval (maxlblnum) = linenum 940 maxlblnum = maxlblnum + 1 950 return 960 ' [print errmsg] 970 print "Error in source line" + sourceln: print errmsg$ 980 if pass = 2 then print # outfile, errmsg$ 990 return 1000 ' [start] 1010 defint a-z 1020 tblsz = 50: nmax = 99 1030 dim lblname$ (tblsz), lblval (tblsz), progline$ (nmax) 1040 false = 0: true = not false: tab$ = chr$ (9): lf$ = chr$ (10): cr$ = chr$ (13): quote$ = chr$ (34) 1050 cl$ = chr$ (26) 1060 startnum = 100: incr = 10: infile = 1: outfile = 2 1070 rmk$ = "'": lblstcode$ = "[": lblendcode$ = "]": maxlblnum = 0 1080 print cl$ 1090 print vers$ 1100 ' [get filename] 1110 input "Enter the program name: ", progname$ 1120 upr$ = progname$: gosub 760: progname$ = upr$: infile$ = progname$ + ".ASC": outfile$ = progname$ + ".NUM": symfile$ = progname$ + ".SYM" 1130 pass = 1 1140 on error goto 850 1150 open "I", infile, infile$ 1160 linenum = startnum: nbase = 0 1170 ' [next block] 1180 n = 0 1190 while not eof (infile) and n <= nmax 1200 line input # infile, progline$ (n): n = n + 1 1210 wend 1220 lastn = n - 1 1230 for n = 0 to lastn 1240 sourceln = nbase + n + 1 1250 print "pass"; pass; " line"; sourceln; cr$; 1260 lineisrem = (left$ (progline$ (n), 1) = rmk$): if lineisrem then 1300 1270 if len (progline$ (n)) = 0 then 1300 1280 lblptr = instr (progline$ (n), lblstcode$): if lblptr = 1 then gosub 120 1290 linenum = linenum + incr 1300 ' [next pass1 line] 1310 next n 1320 if not eof (infile) then nbase = nbase + nmax + 1: goto 1170 1330 close infile 1340 proginmem = (nbase = 0) 1350 pass = 2 1360 if not proginmem then open "I", infile, infile$ 1370 open "O", outfile, outfile$ 1380 linenum = startnum: nbase = 0 1390 ' [next block pass 2] 1400 n = 0 1410 while not eof (infile) and n <= nmax 1420 line input # infile, progline$ (n): n = n + 1 1430 wend 1440 lastn = n - 1 1450 for n = 0 to lastn 1460 sourceln = nbase + n + 1: print "pass"; pass; " line"; sourceln; " "; cr$; 1470 lineisrem = (left$ (progline$ (n), 1) = rmk$): if lineisrem then 1600 1480 if len (progline$ (n)) = 0 then 1600 1490 gosub 190 1500 gosub 300 1510 gosub 380 1520 lblptr = instr (progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 1530 while lblptr < remptr 1540 ptr = lblptr: gosub 450 1550 if not ptrinquotes then gosub 560 1560 lblptr = instr (lblptr+1, progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 1570 wend 1580 print # outfile, progline$ (n) 1590 linenum = linenum + incr 1600 ' [next pass2 line] 1610 next n 1620 if not proginmem then nbase = nbase + nmax + 1: if not eof (infile) then 1390 1630 if not proginmem then close infile 1640 close outfile 1650 print 1660 open "O", outfile, symfile$ 1670 print # outfile, "1 'Label listing of: " + progname$ + ".BAS" 1680 for i = 0 to maxlblnum-1 1690 print # outfile, str$ (lblval (i)), "'[" + lblname$ (i) + "]" 1700 next 1710 close 1720 end  = 0 to maxlblnum-1 1690 print # outfi$ (n), 1) = rmk$): if lineisrem then 1600 1480 if len (progline$ (n)) = 0 then 1600 1490 gosub 190 1500 gosub 300 1510 gosub 380 1520 lblptr = instr (progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 1530 while lblptr < remptr 1540 ptr = lblptr: gosub 450 1550 if not ptrinquotes then gosub 560 1560 lblptr = instr (lblptr+1, progline$ (n), lblstcode$): if lblptr = 0 then lblptr = 255 1570 wend 1580 print # outfile, progline$ (n) 1590 linenum %1 'Label listing of: NBR13.BAS 120 '[eval label] 170 '[end eval label] 190 '[reformat line] 300 '[set quote positions] 380 '[set rem ptr] 400 '[next rem ptr] 450 '[check ptr in quotes] 540 '[check odd] 560 '[insert label num] 620 '[end insert label num] 640 '[get label] 690 '[match label] 760 '[make upper] 820 '[next char] 850 '[open error] 870 '[lbl dbl def] 910 '[add to list] 960 '[print errmsg] 1000 '[start] 1100 '[get filename] 1170 '[next block] 1300 '[next pass1 line] 1390 '[next block pass 2] 1600 '[next pass2 line]  '[next block] 1300 '[next pass1 line] 1390 '[next block pass 2] 1600  This is the release date of the disk. NBR13 BAS NBR13 NUM NBR13 SYM NBR13 .ASC F0 B8 12032 94 NBR13 .BAS 77 F3 5888 46 NBR13 .NUM F2 44 6656 52 NBR13 .SYM 90 B7 896 7  Fog Library Disk FOG-CPM.034 Copyright (1986) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. MBasic programs and utilities. Filename Description -04-00 .86 This is the release date of the disk. -CPM034 .DOC This is the description of the disk contents. CURVEFIT.BAS AE6A 28K [Curvefit 1 of 3] Fits values of X and Y to 25 different equations. Uses comma- delimited, Lotus, or SuperCalc .PRN files. Includes a cross- reference of the labels but requires MBasic or modification to suit your Basic. CURVEXXY.TXT 9CA3 20K [Curvefit 2 of 3] CURVECPM.XRF 2D43 28K [Curvefit 3 of 3] NBR .DOC 9284 5K [NBR 1 of 10] An MBasic preprocessor (discussed in the April, 1986 FOGHORN) This offers a method of preparing MBasic programs with a text editor or word processor with line numbering occurring after the program is written. Includes examples but requires MBasic NBR-MBAS.TXT C639 35K [NBR 2 of 10] NBR124 .ASC 75A4 12K [NBR 3 of 10] NBR124 .BAS 2110 6K [NBR 4 of 10] NBR124 .NUM 73D9 7K [NBR 5 of 10] NBR124 .SYM 9A12 1K [NBR 6 of 10] NBR13 .ASC F0B8 12K [NBR 7 of 10] NBR13 .BAS 77F3 6K [NBR 8 of 10] NBR13 .NUM F244 7K [NBR 9 of 10] NBR13 .SYM 90B7 1K [NBR 10 of 10] SET ALTE TO SELE A STOR diskf-"-"-SUBST(dfile,5,3)-"&mdiskno"-".DOC" TO malt SET ALTE TO &malt SET ALTE ON DO WHILE diskno="&mdiskno".AND. .NOT. EOF() IF diskno="000" IF dfile="FOG-DOS" ? " &'