├── bas ├── spacing.bas ├── ahl.bas ├── files.bas ├── sieve.bas ├── input.bas ├── letter.hpb ├── awari.bas ├── lunar.bas ├── matrix.bas ├── amazing.bas ├── amazin.dbas └── test.bas ├── doc ├── AUTHORS ├── pass-fail.txt ├── RetroBASIC build notes.md ├── TODO ├── retrobasic.1 ├── VERSIONS └── RetroBASIC design.md ├── git └── .gitignore ├── RetroBASIC.xcodeproj ├── project.xcworkspace │ ├── contents.xcworkspacedata │ ├── xcuserdata │ │ └── maury.xcuserdatad │ │ │ └── UserInterfaceState.xcuserstate │ └── xcshareddata │ │ ├── WorkspaceSettings.xcsettings │ │ └── IDEWorkspaceChecks.plist ├── xcuserdata │ └── maury.xcuserdatad │ │ └── xcdebugger │ │ └── Breakpoints_v2.xcbkptlist └── xcshareddata │ └── xcschemes │ ├── test.xcscheme │ ├── RetroBASIC.xcscheme │ ├── Amazing.xcscheme │ └── SST.xcscheme ├── makefile ├── src ├── stdhdr.h ├── errors.c ├── statistics.h ├── io.h ├── strng.h ├── strng.c ├── matrix.h ├── main.c ├── errors.h ├── parse.h ├── retrobasic.h ├── io.c ├── scan.l ├── list.h ├── list.c └── statistics.c └── README.md /bas/spacing.bas: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /doc/AUTHORS: -------------------------------------------------------------------------------- 1 | Maury Markowitz - maury.markowitz@gmail.com 2 | James Bowman - jamesb@excamera.com 3 | -------------------------------------------------------------------------------- /git/.gitignore: -------------------------------------------------------------------------------- 1 | RetroBASIC.xcodeproj/project.xcworkspace 2 | RetroBASIC.xcodeproj/xcshareddata 3 | RetroBASIC.xcodeproj/xcuserdata 4 | DerivedData/ 5 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/project.xcworkspace/contents.xcworkspacedata: -------------------------------------------------------------------------------- 1 | 2 | 4 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/project.xcworkspace/xcuserdata/maury.xcuserdatad/UserInterfaceState.xcuserstate: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maurymarkowitz/RetroBASIC/HEAD/RetroBASIC.xcodeproj/project.xcworkspace/xcuserdata/maury.xcuserdatad/UserInterfaceState.xcuserstate -------------------------------------------------------------------------------- /bas/ahl.bas: -------------------------------------------------------------------------------- 1 | 10 rem Ahl's simple benchmark 2 | 20 for n = 1 to 100: a = n 3 | 30 for i = 1 to 10 4 | 40 a = sqr(a): r = r + rnd(1) 5 | 50 next i 6 | 60 for i = 1 to 10 7 | 70 a = a^2: r = r + rnd(1) 8 | 80 next i 9 | 90 s = s + a: next n 10 | 100 print "Accuracy ";abs (1010-s/5) 11 | 110 print "Random ";abs (1000-r) 12 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/project.xcworkspace/xcshareddata/WorkspaceSettings.xcsettings: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | PreviewsEnabled 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /bas/files.bas: -------------------------------------------------------------------------------- 1 | 10 OPEN 1,"TEXTFILE.TXT","w" 2 | 20 PRINT #1,"Hello World!" 3 | 30 CLOSE #1 4 | 40 OPEN# 1,"TEXTFILE.TXT","r" 5 | 50 INPUT#1,A$ 6 | 60 PRINT A$ 7 | 70 CLOSE 1 8 | 110 OPEN#1,"TEXTFILE.TXT","r" 9 | 120 GET#1,A 10 | 130 PRINT A 11 | 140 IF EOF(1)=0 THEN 120 12 | 150 CLOSE#1 13 | 160 PRINT "end of file" 14 | 9999 END 15 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/project.xcworkspace/xcshareddata/IDEWorkspaceChecks.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IDEDidComputeMac32BitWarning 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /bas/sieve.bas: -------------------------------------------------------------------------------- 1 | 1 S = 8190 2 | 2 DIM F(8191) 3 | 3 PRINT "Only 1 iteration" 4 | 5 C = 0 5 | 6 FOR I = 0 TO S 6 | 7 F(I) = 1 7 | 8 NEXT I 8 | 9 FOR I = 0 TO S 9 | 10 IF F(I) = 0 THEN 18 10 | 11 P = I+I + 3 11 | 12 K = I + P 12 | 13 IF K > S THEN 17 13 | 14 F(K) = 0 14 | 15 K = K + P 15 | 16 GOTO 13 16 | 17 C = C + 1 17 | 18 NEXT I 18 | 19 PRINT C," PRIMES" 19 | -------------------------------------------------------------------------------- /bas/input.bas: -------------------------------------------------------------------------------- 1 | 5 REM various tests of INPUT statements 2 | 5 REM 3 | 10 PRINT "input single number with no prompt" 4 | 20 INPUT A 5 | 30 REM PRINT "input single number with a prompt" 6 | 40 REM INPUT "the prompt";A 7 | 50 PRINT "input three numbers with a single prompt" 8 | 60 INPUT "single prompt",A,B,C 9 | 65 PRINT A,B,C 10 | 70 PRINT "input three numbers with three prompts" 11 | 80 INPUT "A prompt",A,"B prompt",B,"C prompt",C 12 | 85 PRINT A,B,C 13 | 90 PRINT "input a number and a string" 14 | 100 INPUT "number",A,"string",A$ 15 | 110 PRINT A,A$ 16 | 120 PRINT "LINPUT test, enter weird things"; 17 | 130 LINPUT B$ 18 | 140 PRINT B$ 19 | -------------------------------------------------------------------------------- /doc/pass-fail.txt: -------------------------------------------------------------------------------- 1 | 3dplot = FAILS, on DEFFN 2 | 23matches = WORKS 3 | aceyducey = WORKS 4 | amazing = WORKS 5 | animal = SORT OF, some printing/input issues 6 | awari = WORKS 7 | bagels = WORKS 8 | banner = FAILS, problems with array bounds 9 | basketball = WORKS 10 | batnum = WORKS 11 | battle = WORKS 12 | blackjack = FAILS, on DEFFN 13 | bombardment = WORKS 14 | bombsaway = WORKS 15 | bounce = SORT OF, seems to have display issues? 16 | bowling = FAILS, problems with array bounds 17 | boxing = WORKS 18 | bug = FAILS, printsep at the front of the line 19 | bullfight = FAILS, on DEFFN 20 | bullseye = WORKS 21 | bunny = FAILS, problems with array bounds 22 | buzzword = WORKS -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | # 2 | # makefile for RetroBASIC 3 | # 4 | # 5 | # various setup 6 | LEX = flex 7 | LFLAGS = -lfl 8 | YAC = bison 9 | YFLAGS =-dtv 10 | CC = gcc -g 11 | CFLAGS = -DYYDEBUG=1 12 | CLIBS = -ly -ll 13 | 14 | rm=/bin/rm -f 15 | mv=/bin/mv -f 16 | 17 | # our program name 18 | TARGET = retrobasic 19 | 20 | # the final program has three inputs, the lex/yacc and the interpreter source 21 | $(TARGET): $(wildcard src/*.c) parse.tab.c lex.yy.c 22 | $(CC) -Isrc $^ -o $(TARGET) -lm 23 | 24 | # if the lex or .tab.h file is changed, run lex again 25 | lex.yy.c: src/scan.l parse.tab.h 26 | $(LEX) $(LEXFLAGS) $< 27 | 28 | # If the yacc file is changed, run yacc again. 29 | parse.tab.c parse.tab.h: src/parse.y 30 | $(YAC) $(YFLAGS) $< 31 | 32 | clean: 33 | $(rm) $(TARGET) $(TARGET).o 34 | $(rm) *.tab.h *.tab.c *.lex.c *.yy.c parse.output 35 | $(rm) -r *.dSYM 36 | 37 | all: retrobasic 38 | -------------------------------------------------------------------------------- /src/stdhdr.h: -------------------------------------------------------------------------------- 1 | /* Global imports for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | Based on gnbasic 5 | Copyright (C) 1998 James Bowman 6 | 7 | This file is part of RetroBASIC. 8 | 9 | RetroBASIC is free software; you can redistribute it and/or modify 10 | it under the terms of the GNU General Public License as published by 11 | the Free Software Foundation; either version 2, or (at your option) 12 | any later version. 13 | 14 | RetroBASIC is distributed in the hope that it will be useful, 15 | but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | GNU General Public License for more details. 18 | 19 | You should have received a copy of the GNU General Public License 20 | along with RetroBASIC; see the file COPYING. If not, write to 21 | the Free Software Foundation, 59 Temple Place - Suite 330, 22 | Boston, MA 02111-1307, USA. */ 23 | 24 | #ifndef __STDHDR_H__ 25 | #define __STDHDR_H__ 26 | 27 | #include 28 | #include 29 | #include 30 | #include 31 | 32 | #include // toupper and tolower FIXME: implement internally 33 | #include // used only while opening the program file, could be removed? 34 | #include // fmax, fabs, etc. 35 | #include // gives INT_MAX 36 | 37 | #include // used for TIME and DATE in main and stats 38 | 39 | #include "strng.h" // our replacement for GLib.String 40 | #include "list.h" // ... and GLib.List and .Tree 41 | 42 | #endif /* stdhdr_h */ 43 | -------------------------------------------------------------------------------- /src/errors.c: -------------------------------------------------------------------------------- 1 | // 2 | // errors.c 3 | // retrobasic 4 | // 5 | // Created by Maury Markowitz on 2024-11-17. 6 | // Copyright © 2024 Maury Markowitz. All rights reserved. 7 | // 8 | 9 | #include "errors.h" 10 | 11 | char *error_messages[] = { 12 | [ern_FILE_OPEN] = ers_FILE_OPEN, 13 | [ern_FILE_NOT_OPEN] = ers_FILE_NOT_OPEN, 14 | [ern_FILE_NOT_FOUND] = ers_FILE_NOT_FOUND, 15 | [ern_DEV_NOT_FOUND] = ers_DEV_NOT_FOUND, 16 | [ern_FILE_NOT_INPUT] = ers_FILE_NOT_INPUT, 17 | [ern_FILE_NOT_OUTPUT] = ers_FILE_NOT_OUTPUT, 18 | [ern_FILENAME_MISSING] = ers_FILENAME_MISSING, 19 | [ern_FILE_EXISTS] = ers_FILE_EXISTS, 20 | [ern_READY] = ers_READY, 21 | [ern_BREAK] = ers_BREAK, 22 | [ern_INPUT_EXTRA] = ers_INPUT_EXTRA, 23 | [ern_INPUT_REDO] = ers_INPUT_REDO, 24 | [ern_NEXT_NO_FOR] = ers_NEXT_NO_FOR, 25 | [ern_SYNTAX_ERROR] = ers_SYNTAX_ERROR, 26 | [ern_RET_NO_GOSUB] = ers_RET_NO_GOSUB, 27 | [ern_OUT_OF_DATA] = ers_OUT_OF_DATA, 28 | [ern_ILLEGAL_VALUE] = ers_ILLEGAL_VALUE, 29 | [ern_OVERFLOW] = ers_OVERFLOW, 30 | [ern_OUT_OF_MEMORY] = ers_OUT_OF_MEMORY, 31 | [ern_NO_SUCH_LINE] = ers_NO_SUCH_LINE, 32 | [ern_BAD_SUBSCRIPT] = ers_BAD_SUBSCRIPT, 33 | [ern_REDIM_ARRAY] = ers_REDIM_ARRAY, 34 | [ern_DIV_BY_ZERO] = ers_DIV_BY_ZERO, 35 | [ern_DIRECT_MODE] = ers_DIRECT_MODE, 36 | [ern_TYPE_MISMATCH] = ers_TYPE_MISMATCH, 37 | [ern_STRING_TO_LONG] = ers_STRING_TO_LONG, 38 | [ern_FORMULA_TOO_LONG] = ers_FORMULA_TOO_LONG, 39 | [ern_DEF_UNKNOWN] = ers_DEF_UNKNOWN, 40 | [ern_OUT_OF_STACK] = ers_OUT_OF_STACK, 41 | [ern_CANT_CONTINUE] = ers_CANT_CONTINUE, 42 | [ern_POP_NO_STACK] = ers_POP_NO_STACK, 43 | [ern_RES_NO_TRAP] = ers_RES_NO_TRAP 44 | }; 45 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/xcuserdata/maury.xcuserdatad/xcdebugger/Breakpoints_v2.xcbkptlist: -------------------------------------------------------------------------------- 1 | 2 | 6 | 7 | 9 | 21 | 22 | 23 | 25 | 37 | 38 | 39 | 40 | 41 | -------------------------------------------------------------------------------- /bas/letter.hpb: -------------------------------------------------------------------------------- 1 | 100 REM *** LETTER - A LETTER GUESSING GAME *** 2 | 110 REM *** COPYRIGHT PEOPLE'S COMPUTER COMPANY 3 | 120 REM *** P.O. BOX 310, MENLO PARK CA 94025 4 | 130 DIM A$(26),G$[26],L$[1] 5 | 140 LET A$="ABCDEFGHIJKLMNOPQRSTUVWXYZ" 6 | 150 REM *** PRINT INSTRUCTIONS ON HOW TO PLAY 7 | 160 PRINT "I WILL THINK OF A LETTER FROM A TO Z." 8 | 170 PRINT "TRY TO GUESS MY LETTER. AFTER EACH GUESS, I WILL" 9 | 180 PRINT "TELL YOU IF YOU GUESSED MY LETTER OR IF YOUR GUESS" 10 | 190 PRINT "IS TOO HIGH OR TOO LOW. THE LOWEST LETTER IS 'A'" 11 | 200 PRINT "AND THE HIGHEST LETTER IS 'Z'." 12 | 210 PRINT 13 | 220 PRINT "IF YOU WISH, THINK OF THE LETTERS FROM 'A'" 14 | 230 PRINT "TO 'Z' ARRANGED IN A TOTEM POLE WITH 'A' ON THE" 15 | 240 PRINT "BOTTOM AND 'Z' ON THE TOP. IF I TELL YOU TO TRY A" 16 | 250 PRINT "HIGHER LETTER, TRY ONE CLOSER TO THE TOP OF THE" 17 | 260 PRINT "TOTEM POLE. IF I TELL YOU TO TRY A LOWER LETTER, TRY" 18 | 270 PRINT "ONE CLOSER TO THE BOTTOM OF THE TOTEM POLE. ENJOY!!!" 19 | 280 REM *** COMPUTER 'THINKS' OF A LETTER 20 | 290 LET X=INT(26*RND(0))+1 21 | 300 LET L$=A$[X,X] 22 | 310 PRINT 23 | 320 PRINT "OK, I HAVE A LETTER. START GUESSING." 24 | 330 REM *** ASK FOR A GUESS 25 | 340 PRINT 26 | 350 PRINT "WHAT IS YOUR GUESS"; 27 | 360 INPUT G$ 28 | 370 REM *** IF GUESS IS NOT A LETTER, TRY AGAIN 29 | 380 FOR K =1 TO 26 30 | 390 IF G$=A$[K,K] THEN 440 31 | 400 NEXT K 32 | 410 PRINT "HEY!!! THAT'S NOT A SINGLE LETTER. PLAY FAIR, NOW!" 33 | 420 GOTO 340 34 | 430 REM *** COMPARE GUESS WITH COMPUTER'S LETTER 35 | 440 IF G$=L$ THEN 510 36 | 450 IF G$>L$ THEN 480 37 | 460 PRINT "TOO LOW. TRY A HIGHER LETTER." 38 | 470 GOTO 340 39 | 480 PRINT "TOO HIGH. TRY A LOWER LETTER." 40 | 490 GOTO 340 41 | 500 REM *** HUMAN HAS GUESSED THE COMPUTER'S LETTER 42 | 510 PRINT 43 | 520 PRINT "YOU GOT IT!!! LET'S PLAY AGAIN." 44 | 530 PRINT 45 | 540 GOTO 290 46 | 550 END 47 | -------------------------------------------------------------------------------- /bas/awari.bas: -------------------------------------------------------------------------------- 1 | 5 DATA0 2 | 10 DIMB(13),G(13),F(50):READN 3 | 15 FORI=0TON-1:READF(I):NEXTI 4 | 20 PRINT\PRINT "GAME OF *** AWARI ***"\E=0 5 | 25 FORI=0TO12:LETB(I)=3:NEXTI 6 | 30 LETC=0:LETF(N)=0:LETB(13)=0:LETB(6)=0 7 | 35 GOSUB500 8 | 40 PRINT"YOUR MOVE";:GOSUB110 9 | 45 IFE=0GOTO80 10 | 50 IFM=6THENGOSUB100 11 | 55 IFE=1GOTO80 12 | 60 PRINT "MY MOVE IS ";:GOSUB800 13 | 65 IFE=0GOTO80 14 | 70 IFM=6THENPRINT",";:GOSUB800 15 | 75 IFE=1GOTO35 16 | 80 PRINT:PRINT"GAME OVER" 17 | 85 LETD=B(6)-B(13):IF D<0 THEN PRINT "I WIN BY";-D;"POINTS":GOTO 20 18 | 90 LETN=N+1:IFD=0THENPRINT"DRAWN GAME":GOTO 20 19 | 95 PRINT"YOU WIN BY"D"POINTS":GOTO20 20 | 100 PRINT"AGAIN"; 21 | 110 INPUTM:IFM<7THENIFM>0THENLETM=M-1:GOTO130 22 | 120 PRINT"ILLEGAL MOVE":GOTO100 23 | 130 IFB(M)=0GOTO120 24 | 140 LETH=6:GOSUB200 25 | 150 GOTO500 26 | 200 LETK=M:GOSUB600 27 | 205 LETE=2:IFK>6THENLETK=K-7 28 | 210 LETC=C+1:IFC<9THENLETF(N)=F(N)+6+K 29 | 215 FORI=0TO5:IFB(I)<>0THEN230 30 | 220 NEXTI 31 | 225 RETURN 32 | 230 FORI=7TO12:IFB(I)<>0THENLETE=1:RETURN 33 | 235 GOTO220 34 | 500 PRINT:PRINT" "; 35 | 505 FORI=12TO7STEP-1:GOSUB580 36 | 510 NEXTI 37 | 515 PRINT:LETI=13:GOSUB580 38 | 520 PRINT," ";:PRINTB(6):PRINT " "; 39 | 525 FORI=0TO5:GOSUB580 40 | 530 NEXTI 41 | 535 PRINT:PRINT:RETURN 42 | 570 IFB(I)<>0THENPRINT" "; 43 | 580 PRINTB(I):RETURN 44 | 600 LETP=B(M):LETB(M)=0 45 | 605 FORP=PTO1STEP-1:LETM=M+1:IFM>13THENLETM=M-14 46 | 610 LETB(M)=B(M)+1:NEXTP 47 | 615 IFB(M)=1THENIFM<>6THENIFM<>13THENIFB(12-M)<>0GOTO625 48 | 620 RETURN 49 | 625 LETB(M)=B(M)+B(12-M)+1:LETB(M)=0:LETB(12-M)=0:RETURN 50 | 800 LETD=-99:LETH=13 51 | 805 FORI=0TO13:LETG(I)=B(I):NEXTI 52 | 810 FORJ=7TO12:IFB(J)=0THEN885 53 | 815 LETM=J:GOSUB600 54 | 820 FORI=0TO5:IFB(I)<>0GOTO845 55 | 825 LETL=B(I)+I:LETR=0 56 | 830 IFL>13THENLETL=L-14:LETR=1:GOTO830 57 | 835 IFB(L)=0THENIFL<>6THENIFL<>13THENLETR=B(12-L)+R 58 | 840 IFR>0THENLETG(J)=R 59 | 845 NEXTI 60 | 850 LETQ=G(13)-G(6)-Q:IFC>8GOTO875 61 | 855 LETK=J:IFK>6THENLETK=K-7 62 | 860 FORI=0TON-1:IFF(N)+6+K=INT(F(I)/(7-C))+1THENLETQ=Q-2 63 | 870 NEXTI 64 | 875 FORI=0TO13:LETB(I)=G(I):NEXTI 65 | 880 IFQ>=DTHENLETA=J:LETD=Q 66 | 885 NEXTJ 67 | 890 LETM=A:PRINTCHR$(42+M):GOTO200 68 | 900 FORI=0TON-1:PRINTF(I):NEXTI 69 | 999 END 70 | -------------------------------------------------------------------------------- /bas/lunar.bas: -------------------------------------------------------------------------------- 1 | 10 PRINT TAB(33);"LUNAR" 2 | 20 PRINT TAB(l5);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" 3 | 25 PRINT:PRINT:PRINT 4 | 30 PRINT "THIS IS A COMPUTER SIMULATION OF AN APOLLO LUNAR" 5 | 40 PRINT "LANDING CAPSULE.": PRINT: PRINT 6 | 50 PRINT "THE ON-BOARD COMPUTER HAS FAILED (IT WAS MADE BY" 7 | 60 PRINT "XEROX) SO YOU HAVE TO LAND THE CAPSULE MANUALLY." 8 | 70 PRINT: PRINT "SET BURN RATE OF RETRO ROCKETS TO ANY VALUE BETWEEN" 9 | 80 PRINT "0 (FREE FALL) AND 200 (MAXIMUM BURN) POUNDS PER SECOND." 10 | 90 PRINT "SET NEW BURN RATE EVERY 10 SECONDS.": PRINT 11 | 100 PRINT "CAPSULE WEIGHT 32,500 LBS; FUEL WEIGHT 16,500 LBS." 12 | 110 PRINT: PRINT: PRINT: PRINT "GOOD LUCK" 13 | 120 L=0 14 | 130 PRINT: PRINT "SEC","MI + FT","MPH","LB FUEL","BURN RATE":PRINT 15 | 140 A=120:V=1:M=33000:N=16500:G=1E-03:Z=1.8 16 | 150 PRINT L,INT(A);INT(5280*(A-INT(A))),3600*V,M-N,:INPUT K:T=10 17 | 160 IF M-N<1E-03 THEN 240 18 | 170 IF T<1E-03 THEN 150 19 | 180 S=T: IF M>=N+S*K THEN 200 20 | 190 S=(M-N)/K 21 | 200 GOSUB 420: IF I<=O THEN 340 22 | 210 IF V<=0 THEN 230 23 | 220 IF J<0 THEN 370 24 | 230 GOSUB 330: GOTO 160 25 | 240 PRINT "FUEL OUT AT";L;"SECONDS":S=(-V+SQR(V*V+2*A*G))/G 26 | 250 V=V+G*S: L=L+S 27 | 260 W=3600*V: PRINT "ON MOON AT";L;"SECONDS - IMPACT VELOCITY";W;"MPH" 28 | 274 IF W<=1.2 THEN PRINT "PERFECT LANDING!": GOTO 440 29 | 280 IF W<=10 THEN PRINT "GOOD LANDING (COULD RE BETTER)":GOTO 440 30 | 282 IF W>60 THEN 300 31 | 284 PRINT "CRAFT DAMAGE... YOU'RE STRANDED HERE UNTIL A RESCUE" 32 | 286 PRINT "PARTY ARRIVES. HOPE YOU HAVE ENOUGH OXYGEN!" 33 | 288 GOTO 440 34 | 300 PRINT "SORRY THERE WERE NO SURVIVORS. YOU BLEW IT!" 35 | 310 PRINT "IN FACT, YOU BLASTED A NEW LUNAR CRATER";W*.227;"FEET DEEP!" 36 | 320 GOTO 440 37 | 330 L=L+S: T=T-S: M=M-S*K: A=I: V=J: RETURN 38 | 340 IF S<5E-03 THEN 260 39 | 350 D=V+SQR(V*V+2*A*(G-Z*K/M)):S=2*A/D 40 | 360 GOSUB 420: GOSUB 330: GOTO 340 41 | 370 W=(1-M*G/(Z*K))/2: S=M*V/(Z*K*(W+SQR(W*W+V/Z)))+.05:GOSUB 420 42 | 380 IF I<=0 THEN 340 43 | 390 GOSUB 330: IF J>0 THEN 160 44 | 400 IF V>0 THEN 370 45 | 410 GOTO 160 46 | 420 Q=S*K/M: J=V+G*S+Z*(-Q-Q*Q/2-Q^3/3-Q^4/4-Q^5/5) 47 | 430 I=A-G*S*S/2-V*S+Z*S*(Q/2+Q^2/6+Q^3/12+Q^4/20+Q^5/30):RETURN 48 | 440 PRINT:PRINT:PRINT:INPUT "TRY AGAIN??";A:IF A>0 THEN GOTO 70 49 | -------------------------------------------------------------------------------- /doc/RetroBASIC build notes.md: -------------------------------------------------------------------------------- 1 | RetroBASIC build notes 2 | ====================== 3 | 4 | **Copyright © 2020 Maury Markowitz** 5 | 6 | [![GPL license](http://img.shields.io/badge/license-GPL-brightgreen.svg)](https://opensource.org/licenses/gpl-license) 7 | 8 | ## Introduction 9 | 10 | This document lists a number of known issues found when building on different platforms. 11 | 12 | ## makefile use 13 | 14 | RetroBASIC should build on any system with a working makefile system. It uses standard ANSI-C, lex and yacc, and has no external dependencies. A simple `make` should produce a runnable binary. If it does not, please file bug reports and/or pull requests. There may be a few warnings from the lex/yacc code but these will be addressed over over time. 15 | 16 | ## macOS 17 | 18 | An Xcode project is included that can be used to organize and build RetroBASIC. I find its Git integration useful. It includes two schemes, one that runs test.bas and the other sst.bas. sst is very useful for syntax checking as it uses almost every standard feature of BASIC. 19 | 20 | One annoyance is that Apple has redefined the yacc and lex commands to output their intermediary files to the `DerivedSources` directory, which makes it invisible to the other files in the build. As a result, if you make changes to `scan` or `parse`, you'll have to look in the `/obj/` directory for the y.tab.h and copy that back out to `/src/` as parse.h (or copypasta the code). The most obvious sign this has happened is errors like `Use of undeclared identifier 'TIME'; did you mean 'DIM'?`. 21 | 22 | It should be possible to fix this problem with a suitable custom build rule, but my attempts to make one have all failed. If someone can get this to work, please submit a pull request. 23 | 24 | ## Coding style 25 | 26 | RetroBASIC is written in a semi-canonical C format, as defined by the [Canonical C Style Guide](https://people.canonical.com/~msawicz/guides/c/cguide.html). There are two main differences: 27 | 28 | 1) single-line "blocks" are separated onto two lines to make them look more like multi-line blocks 29 | ``` 30 | while (condition) 31 | dosomething; 32 | ``` 33 | as opposed to: 34 | 35 | ``` 36 | while (condition) dosomething; 37 | ``` 38 | 2) multi-line blocks have the opening brace on the statement line, to make them look more like single-line blocks 39 | ``` 40 | while (condition) { 41 | dosomething; 42 | andsomethingelse; 43 | } 44 | ``` 45 | as opposed to: 46 | 47 | ``` 48 | while (condition) 49 | { 50 | dosomething; 51 | andsomethingelse; 52 | } 53 | ``` 54 | -------------------------------------------------------------------------------- /bas/matrix.bas: -------------------------------------------------------------------------------- 1 | 4 PRINT"testing read" 2 | 5 READ A$:printA$ 3 | 6 read B$:print B$ 4 | 9 DATA "1","2" 5 | 10 DIM A(5,5) 6 | 20 A(3,3)=10 7 | 30 PRINT"tight-printing 5x5 matrix containing one non-zero entry in 3,3" 8 | 40 MAT PRINT A; 9 | 50 PRINT"wide-printing 5x5 containing one non-zero entry in 3,3" 10 | 60 MAT PRINT A 11 | 70 PRINT"printing a 1-D array containing one non-zero entry in 2" 12 | 80 DIM Z(3) 13 | 85 Z(2)=5 14 | 90 MAT PRINT Z 15 | 95 PRINT"printing a (0,3) array" 16 | 96 DIM Y(0,3) 17 | 97 Y(0,2)=2 18 | 98 MAT PRINT Y 19 | 100 DIM B(3,3) 20 | 110 PRINT"input a 3x3" 21 | 120 MAT INPUT B 22 | 130 PRINT"printing input" 23 | 140 MAT PRINT B 24 | 145 PRINT "number input "NUM 25 | 200 DIM C(2,5) 26 | 210 PRINT"READing and PRINTing 2x5" 27 | 220 MAT READ C 28 | 240 MAT PRINT C 29 | 300 PRINT"IDNing 3x3" 30 | 310 MAT B=IDN 31 | 320 MAT PRINT B 32 | 400 print"ZERing 3x3" 33 | 410 MAT B=ZER 34 | 420 MAT PRINT B 35 | 500 PRINT"CONing 3x3" 36 | 510 MAT B=CON 37 | 520 MAT PRINT B 38 | 600 PRINT"CONing a (1x)6" 39 | 610 DIM E(6) 40 | 620 MAT E=CON 41 | 630 MAT PRINT E 42 | 700 PRINT "DIMD(6,6), IDN(3,3)" 43 | 710 DIM D(6,6) 44 | 720 MAT D=IDN(3,3) 45 | 730 MAT PRINT D 46 | 800 PRINT "Copy that to F(2,2)" 47 | 810 DIM F(10,10) 48 | 820 MAT F=D(2,2) 49 | 830 MAT PRINT F 50 | 900 PRINT "B is currently" 51 | 905 MAT PRINT B 52 | 910 PRINT "add B to B and put into D" 53 | 915 MAT D=B+B 54 | 920 MAT PRINT D 55 | 925 PRINT "sub B back out of D again" 56 | 930 MAT D=D-B 57 | 935 MAT PRINT D 58 | 1000 PRINT"multiply B by 5 into D" 59 | 1010 MAT D=(5)*B 60 | 1020 MAT PRINT D 61 | 2000 REM 62 | 2010 PRINT"multiply B by 2" 63 | 2020 MAT B=(2)*B 64 | 2030 MAT PRINT B 65 | 2040 PRINT"multiply D by B" 66 | 2050 MAT D=D*B 67 | 2060 MAT PRINT D 68 | 3000 DIM M(3,4),N(4,2),R(3,2) 69 | 3010 PRINT"reading M" 70 | 3020 MAT READ M 71 | 3030 MAT PRINT M 72 | 3040 PRINT"reading N" 73 | 3050 MAT READ N 74 | 3060 MAT PRINT N 75 | 3070 PRINT"multiply M*N into R" 76 | 3080 MAT R=M*N 77 | 3090 MAT PRINT R 78 | 4000 PRINT"read S" 79 | 4005 DIM S(3,2),J(5,5) 80 | 4010 MAT READ S 81 | 4015 MAT PRINT S 82 | 4017 PRINT"transposing S" 83 | 4020 MAT J=TRN(S) 84 | 4030 MAT PRINT J 85 | 4100 PRINT"read S$" 86 | 4110 DIM S$(2,2),T$(2,2) 87 | 4120 MAT READ S$ 88 | 4130 MAT PRINT S$ 89 | 4140 PRINT"transposing S$" 90 | 4150 MAT T$=TRN(S$) 91 | 4160 MAT PRINT T$ 92 | 5000 PRINT "fill R with 7.5" 93 | 5010 MAT R=(7.5) 94 | 5020 MAT PRINT R 95 | 5030 PRINT "fill S$ with 'hello'" 96 | 5040 MAT S$=("hello") 97 | 5050 MAT PRINT S$ 98 | 5100 PRINT"zer S$" 99 | 5110 MAT S$=ZER 100 | 5120 MAT PRINT S$ 101 | 5500 PRINT "read IN" 102 | 5510 DIM IN(3,3), OU(3,3) 103 | 5520 MAT READ IN 104 | 5530 MAT PRINT IN 105 | 5540 PRINT "invert IN to OU" 106 | 5550 MAT OU=INV(IN) 107 | 5560 MAT PRINT OU 108 | 5570 PRINT "the det was "det 109 | 10000 DATA 1.5,2.5,3,4,5,6,7,8,9,10 110 | 10010 DATA 5,2,0,10 111 | 10030 DATA 3,5,2,5 112 | 10040 DATA 20,0,0,0 113 | 10050 DATA 1.50, 0.20 114 | 10060 DATA 2.80, 0.40 115 | 10070 DATA 5.00,1.00 116 | 10080 DATA 2.00,0.50 117 | 10090 DATA 4.2,-3.8,15.6,8.7,0,-4 118 | 10100 DATA "one",two2:DATA three,"four" 119 | 10110 DATA 15,10,5,12,24,8,6,0,36 120 | 19999 END 121 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/xcshareddata/xcschemes/test.xcscheme: -------------------------------------------------------------------------------- 1 | 2 | 5 | 8 | 9 | 15 | 21 | 22 | 23 | 24 | 25 | 30 | 31 | 32 | 33 | 43 | 45 | 51 | 52 | 53 | 54 | 57 | 58 | 59 | 60 | 66 | 68 | 74 | 75 | 76 | 77 | 79 | 80 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/xcshareddata/xcschemes/RetroBASIC.xcscheme: -------------------------------------------------------------------------------- 1 | 2 | 5 | 8 | 9 | 15 | 21 | 22 | 23 | 24 | 25 | 30 | 31 | 32 | 33 | 43 | 45 | 51 | 52 | 53 | 54 | 57 | 58 | 59 | 60 | 66 | 68 | 74 | 75 | 76 | 77 | 79 | 80 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/xcshareddata/xcschemes/Amazing.xcscheme: -------------------------------------------------------------------------------- 1 | 2 | 5 | 8 | 9 | 15 | 21 | 22 | 23 | 24 | 25 | 30 | 31 | 32 | 33 | 44 | 46 | 52 | 53 | 54 | 55 | 58 | 59 | 60 | 61 | 67 | 69 | 75 | 76 | 77 | 78 | 80 | 81 | 84 | 85 | 86 | -------------------------------------------------------------------------------- /RetroBASIC.xcodeproj/xcshareddata/xcschemes/SST.xcscheme: -------------------------------------------------------------------------------- 1 | 2 | 5 | 8 | 9 | 15 | 21 | 22 | 23 | 24 | 25 | 30 | 31 | 32 | 33 | 44 | 46 | 52 | 53 | 54 | 55 | 58 | 59 | 60 | 61 | 67 | 69 | 75 | 76 | 77 | 78 | 80 | 81 | 84 | 85 | 86 | -------------------------------------------------------------------------------- /bas/amazing.bas: -------------------------------------------------------------------------------- 1 | 10 PRINT TAB(28);"AMAZING PROGRAM" 2 | 20 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" 3 | 30 PRINT:PRINT:PRINT:PRINT 4 | 100 INPUT "WHAT ARE YOUR WIDTH AND LENGTH";H,V 5 | 102 IF H<>1 AND V<>1 THEN 110 6 | 104 PRINT "MEANINGLESS DIMENSIONS. TRY AGAIN.":GOTO 100 7 | 110 DIM W(H,V),V(H,V) 8 | 120 PRINT 9 | 130 PRINT 10 | 140 PRINT 11 | 150 PRINT 12 | 160 Q=0:Z=0:X=INT(RND(1)*H+1) 13 | 165 FOR I=1 TO H 14 | 170 IF I=X THEN 173 15 | 171 PRINT ".--";:GOTO 180 16 | 173 PRINT ". "; 17 | 180 NEXT I 18 | 190 PRINT "." 19 | 195 C=1:W(X,1)=C:C=C+1 20 | 200 R=X:S=1:GOTO 260 21 | 210 IF R<>H THEN 240 22 | 215 IF S<>V THEN 230 23 | 220 R=1:S=1:GOTO 250 24 | 230 R=1:S=S+1:GOTO 250 25 | 240 R=R+1 26 | 250 IF W(R,S)=0 THEN 210 27 | 260 IF R-1=0 THEN 530 28 | 265 IF W(R-1,S)<>0 THEN 530 29 | 270 IF S-1=0 THEN 390 30 | 280 IF W(R,S-1)<>0 THEN 390 31 | 290 IF R=H THEN 330 32 | 300 IF W(R+1,S)<>0 THEN 330 33 | 310 X=INT(RND(1)*3+1) 34 | 320 ON X GOTO 790,820,860 35 | 330 IF S<>V THEN 340 36 | 334 IF Z=1 THEN 370 37 | 338 Q=1:GOTO 350 38 | 340 IF W(R,S+1)<>0 THEN 370 39 | 350 X=INT(RND(1)*3+1) 40 | 360 ON X GOTO 790,820,910 41 | 370 X=INT(RND(1)*2+1) 42 | 380 ON X GOTO 790,820 43 | 390 IF R=H THEN 470 44 | 400 IF W(R+1,S)<>0 THEN 470 45 | 405 IF S<>V THEN 420 46 | 410 IF Z=1 THEN 450 47 | 415 Q=1:GOTO 430 48 | 420 IF W(R,S+1)<>0 THEN 450 49 | 430 X=INT(RND(1)*3+1) 50 | 440 ON X GOTO 790,860,910 51 | 450 X=INT(RND(1)*2+1) 52 | 460 ON X GOTO 790,860 53 | 470 IF S<>V THEN 490 54 | 480 IF Z=1 THEN 520 55 | 485 Q=1:GOTO 500 56 | 490 IF W(R,S+1)<>0 THEN 520 57 | 500 X=INT(RND(1)*2+1) 58 | 510 ON X GOTO 790,910 59 | 520 GOTO 790 60 | 530 IF S-1=0 THEN 670 61 | 540 IF W(R,S-1)<>0 THEN 670 62 | 545 IF R=H THEN 610 63 | 547 IF W(R+1,S)<>0 THEN 610 64 | 550 IF S<>V THEN 560 65 | 552 IF Z=1 THEN 590 66 | 554 Q=1:GOTO 570 67 | 560 IF W(R,S+1)<>0 THEN 590 68 | 570 X=INT(RND(1)*3+1) 69 | 580 ON X GOTO 820,860,910 70 | 590 X=INT(RND(1)*2+1) 71 | 600 ON X GOTO 820,860 72 | 610 IF S<>V THEN 630 73 | 620 IF Z=1 THEN 660 74 | 625 Q=1:GOTO 640 75 | 630 IF W(R,S+1)<>0 THEN 660 76 | 640 X=INT(RND(1)*2+1) 77 | 650 ON X GOTO 820,910 78 | 660 GOTO 820 79 | 670 IF R=H THEN 740 80 | 680 IF W(R+1,S)<>0 THEN 740 81 | 685 IF S<>V THEN 700 82 | 690 IF Z=1 THEN 730 83 | 695 Q=1:GOTO 710 84 | 700 IF W(R,S+1)<>0 THEN 730 85 | 710 X=INT(RND(1)*2+1) 86 | 720 ON X GOTO 860,910 87 | 730 GOTO 860 88 | 740 IF S<>V THEN 760 89 | 750 IF Z=1 THEN 780 90 | 755 Q=1:GOTO 770 91 | 760 IF W(R,S+1)<>0 THEN 780 92 | 770 GOTO 910 93 | 780 GOTO 1000 94 | 790 W(R-1,S)=C 95 | 800 C=C+1:V(R-1,S)=2:R=R-1 96 | 810 IF C=H*V+1 THEN 1010 97 | 815 Q=0:GOTO 260 98 | 820 W(R,S-1)=C 99 | 830 C=C+1 100 | 840 V(R,S-1)=1:S=S-1:IF C=H*V+1 THEN 1010 101 | 850 Q=0:GOTO 260 102 | 860 W(R+1,S)=C 103 | 870 C=C+1:IF V(R,S)=0 THEN 880 104 | 875 V(R,S)=3:GOTO 890 105 | 880 V(R,S)=2 106 | 890 R=R+1 107 | 900 IF C=H*V+1 THEN 1010 108 | 905 GOTO 530 109 | 910 IF Q=1 THEN 960 110 | 920 W(R,S+1)=C:C=C+1:IF V(R,S)=0 THEN 940 111 | 930 V(R,S)=3:GOTO 950 112 | 940 V(R,S)=1 113 | 950 S=S+1:IF C=H*V+1 THEN 1010 114 | 955 GOTO 260 115 | 960 Z=1 116 | 970 IF V(R,S)=0 THEN 980 117 | 975 V(R,S)=3:Q=0:GOTO 1000 118 | 980 V(R,S)=1:Q=0:R=1:S=1:GOTO 250 119 | 1000 GOTO 210 120 | 1010 IF Z=1 THEN 1015 121 | 1011 X=INT(RND(1)*H+1) 122 | 1012 IF V(X,V)=0 THEN 1014 123 | 1013 V(X,V)=3: GOTO 1015 124 | 1014 V(X,V)=1 125 | 1015 FOR J=1 TO V 126 | 1016 PRINT "I"; 127 | 1017 FOR I=1 TO H 128 | 1018 IF V(I,J)<2 THEN 1030 129 | 1020 PRINT " "; 130 | 1021 GOTO 1040 131 | 1030 PRINT " I"; 132 | 1040 NEXT I 133 | 1041 PRINT 134 | 1043 FOR I=1 TO H 135 | 1045 IF V(I,J)=0 THEN 1060 136 | 1050 IF V(I,J)=2 THEN 1060 137 | 1051 PRINT ": "; 138 | 1052 GOTO 1070 139 | 1060 PRINT ":--"; 140 | 1070 NEXT I 141 | 1071 PRINT "." 142 | 1072 NEXT J 143 | 1073 END 144 | -------------------------------------------------------------------------------- /src/statistics.h: -------------------------------------------------------------------------------- 1 | /* Statistics (header) for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #ifndef __STATISTICS_H__ 22 | #define __STATISTICS_H__ 23 | 24 | #include "stdhdr.h" 25 | #include "retrobasic.h" 26 | 27 | /** 28 | * @file statistics.h 29 | * @author Maury Markowitz 30 | * @brief Code for collecting and printing program statistics 31 | * 32 | * This file contains a number of counters that are updated while the 33 | * BASIC source code is being parsed, and a single function that prints 34 | * the results to the console or a file. 35 | * 36 | * The statistics include the number of lines and the distribution of 37 | * line numbers, numeric and string constants, the number of loops, 38 | * and other commonly found constructs. 39 | * 40 | * The output format is different when sent to the console or a file, 41 | * the later is in comma-separated-values format for easy parsing. 42 | * 43 | * This file also includes basic timers for calculating the CPU time 44 | * and user time for the program run. 45 | */ 46 | 47 | /* additional externs used for the static analyzer, used in parse.y */ 48 | extern clock_t start_ticks, end_ticks; // start and end ticks, for calculating CPU time 49 | extern struct timeval start_time, end_time; // start and end clock, for total run time 50 | 51 | extern int variables_total; 52 | extern int variables_default; 53 | extern int variables_int; 54 | extern int variables_float; 55 | extern int variables_double; 56 | extern int variables_string; 57 | extern int numeric_constants_total; 58 | extern int numeric_constants_float; 59 | extern int numeric_constants_zero; 60 | extern int numeric_constants_one; 61 | extern int numeric_constants_minus_one; 62 | extern int numeric_constants_one_digit; 63 | extern int numeric_constants_two_digit; 64 | extern int numeric_constants_three_digit; 65 | extern int numeric_constants_four_digit; 66 | extern int numeric_constants_five_digit; 67 | extern int numeric_constants_big; 68 | extern int numeric_constants_one_byte; 69 | extern int numeric_constants_two_byte; 70 | extern int numeric_constants_four_byte; 71 | extern int string_constants_total; 72 | extern int string_constants_zero; 73 | extern int string_constants_one_byte; 74 | extern int string_constants_big; 75 | extern int string_constants_max; 76 | extern int linenum_constants_total; 77 | extern int linenum_forwards; 78 | extern int linenum_backwards; 79 | extern int linenum_same_line; 80 | extern int linenum_goto_totals; 81 | extern int linenum_then_goto_totals; 82 | extern int linenum_gosub_totals; 83 | extern int linenum_on_totals; 84 | extern int for_loops_total; 85 | extern int for_loops_step_1; 86 | extern int increments; 87 | extern int decrements; 88 | extern int compare_equals_zero; 89 | extern int compare_equals_one; 90 | extern int compare_equals_other; 91 | extern int compare_not_equals_zero; 92 | extern int compare_not_equals_one; 93 | extern int compare_not_equals_other; 94 | extern int assign_zero; 95 | extern int assign_one; 96 | extern int assign_other; 97 | 98 | /* only one function here */ 99 | void print_statistics(void); 100 | 101 | #endif /* statistics_h */ 102 | -------------------------------------------------------------------------------- /bas/amazin.dbas: -------------------------------------------------------------------------------- 1 | 100 RANDOMIZE 2 | 110 DIM W(25,103),V(25,103) 3 | 120 PRINT "WHAT ARE YOUR WIDTH AND LENGTH?" 4 | 121 INPUT H,V 5 | 122 PRINT 6 | 130 IF H<>1 THEN 150 7 | 131 IF V<>1 THEN 150 8 | 132 PRINT "MEANINGLESS DIMENSIONS, TRY AGAIN" 9 | 140 PRINT 10 | 141 GOTO 120 11 | 150 PRINT 12 | 151 PRINT 13 | 160 LET Q=0 14 | 161 LET Z=0 15 | 162 LET X=INT(RND(0)*H+1) 16 | 163 FOR I=1 TO H 17 | 170 IF I=X THEN 173 18 | 171 PRINT ":--"; 19 | 172 GOTO 180 20 | 173 PRINT ": "; 21 | 180 NEXT I 22 | 190 PRINT ":" 23 | 191 LET C=1 24 | 192 LET W(X,1)=C 25 | 193 LET C=C+1 26 | 200 LET R=X 27 | 201 LET S=1 28 | 202 GOTO 260 29 | 210 IF R<>H THEN 240 30 | 211 IF S<>V THEN 230 31 | 220 LET R=1 32 | 221 LET S=1 33 | 222 GOTO 250 34 | 230 LET R=1 35 | 231 LET S=S+1 36 | 232 GOTO 250 37 | 240 LET R=R+1 38 | 250 IF W(R,S)=0 THEN 210 39 | 260 IF R-1=0 THEN 530 40 | 261 IF W(R-1,S)<>0 THEN 530 41 | 270 IF S-1=0 THEN 390 42 | 280 IF W(R,S-1)<>0 THEN 390 43 | 290 IF R=H THEN 330 44 | 300 IF W(R+1,S)<>0 THEN 330 45 | 310 LET X=INT(RND(0)*3+1) 46 | 320 IF X=1 THEN 790 47 | 321 IF X=2 THEN 820 48 | 323 IF X=3 THEN 860 49 | 330 IF S<>V THEN 340 50 | 331 IF Z=1 THEN 370 51 | 332 LET Q=1 52 | 333 GOTO 350 53 | 340 IF W(R,S+1)<>0 THEN 370 54 | 350 LET X=INT(RND(0)*3+1) 55 | 360 IF X=1 THEN 790 56 | 361 IF X=2 THEN 820 57 | 362 IF X=3 THEN 910 58 | 370 LET X=INT(RND(0)*2+1) 59 | 380 IF X=1 THEN 790 60 | 381 IF X=2 THEN 820 61 | 390 IF R=H THEN 470 62 | 400 IF W(R+1,S)<>0 THEN 470 63 | 401 IF S<>V THEN 420 64 | 410 IF Z=1 THEN 450 65 | 411 LET Q=1 66 | 412 GOTO 430 67 | 420 IF W(R,S+1)<>0 THEN 450 68 | 430 LET X=INT(RND(0)*3+1) 69 | 440 IF X=1 THEN 790 70 | 441 IF X=2 THEN 860 71 | 442 IF X=3 THEN 910 72 | 450 LET X=INT(RND(0)*2+1) 73 | 460 IF X=1 THEN 790 74 | 461 IF X=2 THEN 860 75 | 470 IF S<>V THEN 490 76 | 480 IF Z=1 THEN 520 77 | 481 LET Q=1 78 | 482 GOTO 500 79 | 490 IF W(R,S+1)<>0 THEN 520 80 | 500 LET X=INT(RND(0)*2+1) 81 | 510 IF X=1 THEN 790 82 | 511 IF X=2 THEN 910 83 | 520 GOTO 790 84 | 530 IF S-1=0 THEN 670 85 | 540 IF W(R,S-1)<>0 THEN 670 86 | 541 IF R=H THEN 610 87 | 542 IF W(R+1,S)<>0 THEN 610 88 | 550 IF S<>V THEN 560 89 | 551 IF Z=1 THEN 590 90 | 552 LET Q=1 91 | 553 GOTO 570 92 | 560 IF W(R,S+1)<>0 THEN 590 93 | 570 LET X=INT(RND(0)*3+1) 94 | 580 IF X=1 THEN 820 95 | 581 IF X=2 THEN 860 96 | 582 IF X=3 THEN 910 97 | 590 LET X=INT(RND(0)*2+1) 98 | 600 IF X=1 THEN 820 99 | 601 IF X=2 THEN 860 100 | 610 IF S<>V THEN 630 101 | 620 IF Z=1 THEN 660 102 | 621 LET Q=1 103 | 622 GOTO 640 104 | 630 IF W(R,S+1)<>0 THEN 660 105 | 640 LET X=INT(RND(0)*2+1) 106 | 650 IF X=1 THEN 820 107 | 651 IF X=2 THEN 910 108 | 660 GOTO 820 109 | 670 IF R=H THEN 740 110 | 680 IF W(R+1,S)<>0 THEN 740 111 | 681 IF S<>V THEN 700 112 | 690 IF Z=1 THEN 730 113 | 691 LET Q=1 114 | 692 GOTO 830 115 | 700 IF W(R,S+1)<>0 THEN 730 116 | 710 LET X=INT(RND(0)*2+1) 117 | 720 IF X=1 THEN 860 118 | 721 IF X=2 THEN 910 119 | 730 GOTO 860 120 | 740 IF S<>V THEN 760 121 | 750 IF Z=1 THEN 780 122 | 751 LET Q=1 123 | 752 GOTO 770 124 | 760 IF W(R,S+1)<>0 THEN 780 125 | 770 GOTO 910 126 | 780 GOTO 1000 127 | 790 LET W(R-1,S)=C 128 | 800 LET C=C+1 129 | 801 LET V(R-1,S)=2 130 | 802 LET R=R-1 131 | 810 IF C=H*V+1 THEN 1010 132 | 811 LET Q=0 133 | 812 GOTO 260 134 | 820 LET W(R,S-1)=C 135 | 830 LET C=C+1 136 | 840 LET V(R,S-1)=1 137 | 841 LET S=S-1 138 | 842 IF C=H*V+1 THEN 1010 139 | 850 LET Q=0 140 | 851 GOTO 260 141 | 860 LET W(R+1,S)=C 142 | 870 LET C=C+1 143 | 871 IF V(R,S)=0 THEN 880 144 | 872 LET V(R,S)=3 145 | 873 GOTO 890 146 | 880 LET V(R,S)=2 147 | 890 LET R=R+1 148 | 900 IF C=H*V+1 THEN 1010 149 | 902 GOTO 530 150 | 910 IF Q=1 THEN 960 151 | 920 LET W(R,S+1)=C 152 | 921 LET C=C+1 153 | 922 IF V(R,S)=0 THEN 940 154 | 930 LET V(R,S)=3 155 | 931 GOTO 950 156 | 940 LET V(R,S)=1 157 | 950 LET S=S+1 158 | 951 IF C=H*V+1 THEN 1010 159 | 952 GOTO 260 160 | 960 LET Z=1 161 | 970 IF V(R,S)=0 THEN 980 162 | 971 LET V(R,S)=3 163 | 972 LET Q=0 164 | 973 GOTO 1000 165 | 980 LET V(R,S)=1 166 | 981 LET Q=0 167 | 982 LET R=1 168 | 990 LET S=1 169 | 991 GOTO 250 170 | 1000 GOTO 210 171 | 1010 FOR J=1 TO V 172 | 1011 PRINT "I"; 173 | 1012 FOR I=1 TO H 174 | 1013 IF V(I,J)<2 THEN 1030 175 | 1020 PRINT " "; 176 | 1021 GOTO 1040 177 | 1030 PRINT " I"; 178 | 1040 NEXT I 179 | 1041 PRINT 180 | 1043 FOR I=1 TO H 181 | 1045 IF V(I,J)=0 THEN 1060 182 | 1050 IF V(I,J)=2 THEN 1060 183 | 1051 PRINT ": "; 184 | 1052 GOTO 1070 185 | 1060 PRINT ":--"; 186 | 1070 NEXT I 187 | 1071 PRINT ":" 188 | 1072 NEXT J 189 | 1073 END 190 | -------------------------------------------------------------------------------- /src/io.h: -------------------------------------------------------------------------------- 1 | /* io (header) for RetroBASIC 2 | Copyright (C) 2024 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #ifndef __IO_H__ 22 | #define __IO_H__ 23 | 24 | #include "stdhdr.h" 25 | 26 | #if _WIN32 27 | #include 28 | #else 29 | #include 30 | #endif 31 | 32 | #include 33 | 34 | /** 35 | * @file io.h 36 | * @author Maury Markowitz 37 | * @date 31 December 2024 38 | * @brief Input/output and file handling routines. 39 | * 40 | */ 41 | 42 | /** 43 | * Returns the file handle for a previously opened channel/file number. 44 | * 45 | * @param channel, the channel number. 46 | * @return the file/stream pointer, or NULL if the channel is not open. 47 | * 48 | */ 49 | FILE* handle_for_channel(int channel); 50 | 51 | /** 52 | * Returns the path/file for a given channel/file number. 53 | * 54 | * @param channel, the channel number. 55 | * @return the path/file name, or NULL if the channel is not open. 56 | * 57 | */ 58 | char* path_for_channel(int channel); 59 | 60 | /** 61 | * Returns whether the selected channel is readable. 62 | * 63 | * @param channel, the channel number. 64 | * @return true if the file exists and can be read, false otherwise. 65 | * 66 | */ 67 | bool channel_is_readable(int channel); 68 | 69 | /** 70 | * Returns whether the selected channel is writable. 71 | * 72 | * @param channel, the channel number. 73 | * @return true if the file exists and can be written, false otherwise. 74 | * 75 | */ 76 | bool channel_is_writable(int channel); 77 | 78 | /** 79 | * Opens a new or existing file, checking that the path and name are valid. 80 | * 81 | * The modes are "r" for reading, "w" for writing, "a" for appending, and 82 | * "n" for a new writable file. 83 | * 84 | * When opening for "w"riting, if the file already exists it will clear it 85 | * out and the file will consist only of new data. When opened with "n"ew, 86 | * it demands that the file not already exist, and will return a FILE EXISTS 87 | * error if it does. It is otherwise the same as "w". 88 | * 89 | * "r"eading and "a"ppending demands that the file already exist, and will 90 | * raise a FILE NOT FOUND if it doesn't. 91 | * 92 | * @param channel, the channel number, from basic. 93 | * @param name, the file name, optionally including a path, to open. 94 | * @param mode, the unix-like access mode, n. 95 | * @return true if the file was opened successfully, false otherwise 96 | * 97 | */ 98 | bool open_file(const int channel, const char *name, const char *mode); 99 | 100 | /** 101 | * Closes an existing file channel. 102 | * 103 | * @param channel, the channel number. 104 | * @return true if the file was opened successfully, false otherwise 105 | * 106 | */ 107 | bool close_file(const int channel); 108 | 109 | /** 110 | * Closes all open files and resets the file number map. 111 | */ 112 | void close_all_files(void); 113 | 114 | /** 115 | * Creates an empty file at the provided path. This is primarily used in 116 | * dialects like Apple Business BASIC that can only write to an existing 117 | * file. 118 | * 119 | * @param name, the file name, optionally including a path, to create. 120 | * 121 | */ 122 | bool create_file(const char *file); 123 | 124 | /** 125 | * Deletes the file if it is not open and the user has permission. 126 | * 127 | * @param name, the file name, optionally including a path, to delete. 128 | * 129 | */ 130 | bool delete_file(const char *file); 131 | 132 | /** 133 | * Waits for a single character. Used for GET. 134 | * 135 | * @param fd, the file descriptor, typically STDIN_FILENO. 136 | * @return the keycode, NULL if an error occurred. 137 | */ 138 | int getbyte(void); 139 | 140 | /** 141 | * Gets a single keystroke, or null if no key is pressed. Used for INKEY$. 142 | * 143 | * @param fd, the file descriptor, typically STDIN_FILENO. 144 | * @return the keycode, NULL if no key is pressed or an error occurred. 145 | * 146 | * See: https://stackoverflow.com/questions/1798511/how-to-avoid-pressing-enter-with-getchar-for-reading-a-single-character-only 147 | */ 148 | int getkey(void); 149 | 150 | #endif /* io_h */ 151 | -------------------------------------------------------------------------------- /src/strng.h: -------------------------------------------------------------------------------- 1 | /* strng (header) for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #ifndef __STR_H__ 22 | #define __STR_H__ 23 | 24 | #include "stdhdr.h" 25 | 26 | /** 27 | * @file strng.h 28 | * @author Maury Markowitz 29 | * @date 8 August 2022 30 | * @brief Various utilities for strings based on GLib's gstring. 31 | * 32 | * The types and functions in this library are intended to closely mirror the API of the 33 | * GLib GString library. gnbasic was written using GLib to avoid recreating the wheel for 34 | * common functionality. Unfortunately, using GLib on anything other than bog-standard 35 | * Unix is annoying. 36 | * 37 | * It also includes a replacement for strndup, which is POSIX and not available in windows. 38 | * 39 | */ 40 | 41 | // this should be more than large enough for programs of the era, 42 | // but some like Atari will use large strings for data storage 43 | #define MAX_STRING_LEN 256 44 | 45 | /** 46 | * callocs a new string and copies the optional @p string into it. 47 | * 48 | * @param string The string to to copy from, or NULL. 49 | */ 50 | char* str_new(char *string); 51 | 52 | /** 53 | * mallocs a new string and copies in the contents of @p string, up to @p no_of_chars. 54 | * Replaces strndup, as this is only available in POSIX and thus doesn't exist 55 | * on Windows. 56 | * 57 | * @param string The string to copy. 58 | * @param no_of_chars Number of characters to copy. 59 | * @return The copied string. 60 | */ 61 | char* str_copy(const char *string, size_t no_of_chars); 62 | 63 | /** 64 | * @brief Escapes out C bits like \n. 65 | * 66 | * @param string The string to clean. 67 | * @return The cleaned string. 68 | */ 69 | char* str_escape(const char *string); 70 | 71 | /** 72 | * Converts a string to lower-case. 73 | * 74 | * @param string The string to convert. 75 | * @return The converted string. 76 | */ 77 | char* str_tolower(char *string); 78 | 79 | /** 80 | * Converts a string to upper-case. 81 | * 82 | * @param string The string to convert. 83 | * @return The converted string. 84 | */ 85 | char* str_toupper(char *string); 86 | 87 | /** 88 | * Deletes characters from a string starting at @p starting_pos and running for @p no_of_chars. 89 | * 90 | * @param string The string to delete from. 91 | * @param starting_pos Starting location to delete from. 92 | * @param no_of_chars Number of characters to delete. 93 | * @return The resulting string. 94 | * 95 | * @note If starting_pos > strlen(string) nothing is deleted. 96 | */ 97 | char* str_erase(char *string, size_t starting_pos, size_t no_of_chars); 98 | 99 | /** 100 | * Deletes @p no_of_chars characters at the end a string. 101 | * 102 | * @param string The string to delete from. 103 | * @param no_of_chars How many to delete. 104 | * @return The resulting string. 105 | * 106 | * @note If @p starting_pos > strlen(string) nothing is deleted. 107 | */ 108 | char* str_truncate(char *string, size_t no_of_chars); 109 | 110 | /** 111 | * Deletes @p no_of_chars characters at the front of a string. 112 | * 113 | * @param string The string to delete from. 114 | * @param no_of_chars How many to delete. 115 | * @return The resulting string. 116 | * 117 | * @note If @p no_of_chars > strlen(string) nothing is deleted. 118 | */ 119 | char* str_fruncate(char *string, size_t no_of_chars); 120 | 121 | /** 122 | * Appends @p new_string to the end of @p orig_string and returns resulting @p orig_string. 123 | * 124 | * @param orig_string The string to append onto. 125 | * @param new_string The string to append. 126 | * @return The resulting string. 127 | */ 128 | char* str_append(char *orig_string, char *new_string); 129 | 130 | /** 131 | * Deletes any leading or trailing whitespace from @p orig_string. 132 | * 133 | * @param orig_string The string to trim. 134 | * @return The resulting string. 135 | */ 136 | char* str_trim(char *orig_string); 137 | 138 | /** 139 | * Deletes leading or trailing double-quotes from @p orig_string. 140 | * 141 | * @param orig_string The string to trim. 142 | * @return The resulting string. 143 | */ 144 | char* str_unquote(char *orig_string); 145 | 146 | #endif /* string_h */ 147 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | RetroBASIC 2 | ========= 3 | 4 | **Copyright © 2020 Maury Markowitz** 5 | 6 | [![GPL license](http://img.shields.io/badge/license-GPL-brightgreen.svg)](https://opensource.org/licenses/gpl-license) 7 | 8 | ## Contents 9 | 10 | * [Introduction](#introduction) 11 | * [Running RetroBASIC](#running-retrobasic) 12 | * [Building RetroBASIC](#building-retrobasic) 13 | * [Missing features and Erata](#missing-features-and-erata) 14 | 15 | ## Introduction 16 | 17 | RetroBASIC is an interpreter for programs written using 1970s/80s variations of BASIC. It is patterned mostly on MS-BASIC as seen on Commodore machines and Apple II (and many others). It also includes the alternate string manipulation methods from Dartmouth BASIC v4 and HP Timeshared BASIC, the latter of which was widely used in early microcomputer interpreters. The ultimate goal is to support almost any dialect from the era, including Dartmouth BASIC, Tiny BASIC (including Palo Alto), MS-BASIC (Altair, Commodore, etc.), HP Timeshared BASIC (Northstar, Apple, Atari, Sinclair, etc.) and others. 18 | 19 | RetroBASIC can redirect the output from `PRINT` statements and `INPUT` prompts to a file, and read the responses to `INPUT` statements from a file. This can be used to provide the same input to a program multiple times, and then the output can be `diff`ed to look for changes. This is aided by setting the random seed value, which can be done on the command line to avoid editing the original BASIC code. 20 | 21 | RetroBASIC also includes a simple static analyzer that (optionally) prints statistics for the program after it completes. This includes the length of the program and its line number range, the number and types of variables used, and similar details. The original impetus for RetroBASIC was to collect statistics on common programs to provide hints to the retrocomputing field, where new BASICs continue to be developed. 22 | 23 | RetroBASIC is based on gnbasic by James Bowman. 24 | 25 | ## Running RetroBASIC 26 | 27 | RetroBASIC is meant to be used with an existing program source file, not interactively. To run it, use a command similar to this example, replacing the "program.bas" with the name of the text file containing the BASIC program you wish to run: 28 | 29 | ```./retrobasic program.bas``` 30 | 31 | It will accept any text file as input and report (cryptic) errors if it cannot properly parse it. If parsing succeeds, the program (normally) begins running immediately. 32 | 33 | Command-line options include: 34 | 35 | `--help`, `-h`: print usage notes 36 | `--version`, `-v`: print version info 37 | `--upper-case`, `-u`: force input to upper-case, basically like using caps lock 38 | `--array-base`, `-a`: set base index for arrays, normally 1 but some dialects use 0 39 | `--trace`, `-t`: turn on line number tracing 40 | `--tabs`: set the number of spaces for comma-separated items, defaults to 10 41 | `--goto-next`, `-g`: if a branch is to a non-existent line, should it go to the next line or return an error? 42 | `--random`, `-r`: seed the random number generator 43 | `--slicing`, `-s`: enable string slicing like HP, Integer, Atari, etc. 44 | `--output-file`, `-o`: redirect PRINT to the named file 45 | `--input-file`, `-i`: redirect INPUT from the named file, one INPUT value per line 46 | `--no_run`, `-n`: do not run the BASIC program, simply read and parse it and then exit 47 | `--print_statistics`, `-p`: send a selection of statistics to the console 48 | `--write_statistics`, `-w`: write the statistics to the named file in a machine readable format 49 | 50 | If you wish to use RetroBASIC to simply check syntax or collect statistics, use the `-n` and `-p` switches. 51 | 52 | Short options with no parameters can be ganged, for instance, `-unp`. 53 | 54 | ## Building RetroBASIC 55 | 56 | The RetroBASIC interpreter is written for lex/yacc/c and is normally compiled with flex/bison. It has no external dependancies, although cygwin is required for compiling on Windows. A makefile is included that should run on almost any Unix-like system, including macOS. In your terminal, navigate to the RetroBASIC folder you downloaded and extracted, and: 57 | 58 | ```make all``` 59 | 60 | An Xcode project is also included, which is the primary building method during testing. It has one drawback (currently), the bison build rule in Xcode does not properly build `parse.h` into the `src` folder, but follows yacc-like rules and builds `y.tab.h` file in the `../DerivedSources` folder. If you make changes to `parse.y`, be sure to copy the new `y.tab.h` to `/src/parse.h` for those changes to be visible. 61 | 62 | If anyone would like to contribute a VS.net project, it would be greatly appreciated. 63 | 64 | ## Missing features and Errata 65 | 66 | A complete list is maintained in the TODO file, but here are some important limitations: 67 | 68 | * Variable names are currently limited to two characters, which is needed to support "crunched" statements without spaces in MS style. 69 | * The system does not support "immediate mode" (command line) input. It is not supposed to, but could potentially do so. 70 | * LIST, LOAD and SAVE are currently not implemented, in keeping with the use-case. 71 | -------------------------------------------------------------------------------- /doc/TODO: -------------------------------------------------------------------------------- 1 | RetroBASIC TODO/BUGS/ERRATA list 2 | 3 | MS = MS BASIC, 6502 40-bit version 4 | CB = Commodore's MS BASIC 5 | HP = HP Time-Shared BASIC 6 | AB = Atari BASIC 7 | IB = Integer BASIC (aka Apple BASIC) 8 | GW = GW-BASIC 9 | WB = Wang BASIC 10 | PA = Palo Alto Tiny BASIC 11 | BP - DEC BASIC-PLUS 12 | 13 | - CLK should insert colons? 14 | 15 | - BP (and HP?) allows multiple assignments with equals, A=B=C=10 - so does Tiny, BP also allows A,B,C=0 16 | 17 | - add CHAIN, LOAD and RUN (and APPEND?) 18 | - and COMMON 19 | 20 | - CMD/OUTPUT# to redirect to a file 21 | 22 | - add clear_variables and change CLEAR 23 | 24 | - if OPTION BASE 1, should matrix commands work differently? 25 | 26 | - word wrap at a given column 27 | 28 | - add REDIM? 29 | 30 | - ON BREAK GOTO from NewBrain and similar statements from others? 31 | 32 | - MAT INPUT should allow multi-input on a single line 33 | 34 | - OPTION VERSION from ByWater might be useful 35 | 36 | - IMAGE (etc) for PRINT USING with HP specifiers, and colon for image for other dialects 37 | 38 | - GW BASIC string formatters in PRINT USING, but number formats work 39 | 40 | - PA allows # to define field widths in PRINT, so PRINT A,#3,B,C will print B and C in 3-character widths. All expressions following the format use that format until reset by another # or another PRINT 41 | 42 | - add parameter checking to functions, currently most of them don't check that they were passed a string/number 43 | 44 | - WHILE...WEND, LOOP...UNTIL, but so many variations... 45 | 46 | - test and error on incorrect nesting of FOR loops, which we currently ignore 47 | 48 | - add longer variable names 49 | 50 | - DEFINT/SNG/DBL/STR does not support the "range" syntax, DEFINT A-F. only comma lists work, DEFINT A,B 51 | 52 | - needs command-line switch for ANSI, controls tab stops and many errors 53 | 54 | - ELSE would be relatively easy to add, at least the single-line variety 55 | 56 | - support AB's DEG and RAD modes? WB also had gradians; SELECT G, Commodore 3.5 has similar? 57 | 58 | - PA and BP allow single or double quotes around strings 59 | 60 | - PA prints a colon after INPUTs, not ?, and prints the variable name if no prompt is given. So "INPUT A" prints "A:", while INPUT "TYPE A NUMBER"A prints "TYPE A NUMBER:" 61 | 62 | - LPOS, LPRINT, etc. from AB, GW and others 63 | 64 | - CINT CSNG CDBL are not implemented 65 | 66 | - IF..LET, another alternative format for IF 67 | 68 | - ERASE, clears variables (IBM Advanced BASIC) 69 | 70 | Debatable: 71 | 72 | - @(x,y) and POS(x,y) which work similar to TAB but position vertically as well 73 | 74 | - Add & FROM BP and EduSystem BASIC as short form for print, if it is first char in statement? And maybe ; and nothing but a leading quote? 75 | 76 | - DELETE file... but also DELETE lines? UNSAVE on DEC 77 | 78 | - SDS BASIC allows semicolons as the short form for PRINT. This could be supported as it can only be the first statement, otherwise it's a normal semi 79 | 80 | - add CLK from Univac 81 | 82 | - EXCHANGE/SWAP that swaps the values of two variables, seems almost useless - USED FOR SORTING 83 | 84 | - EQ, GT, GE and similar alternatives to =, >, >= etc. 85 | 86 | - option base 1 should return error on accessing 0 87 | 88 | - Dartmouth style FOR loops, exit on 1 TO 0 89 | 90 | - BASIC-PLUS uses WAIT to limit the amount of time INPUT will wait, other dialects have similar variations 91 | 92 | - SUB$ from Apple Business BASIC substitutes one string into another. EG, SUB$("Hello!", "**", 2) produces H**lo! 93 | 94 | - add TEN function, alias for HEX found in Apple Business BASIC? 95 | 96 | - UK BASICs generally use LN for LOG and LOG for CLOG. Add a switch for this? 97 | 98 | - WB uses CONVERT for ASC, which steps on HPs CONVERT. This could be supported by looking at the parameter type. 99 | 100 | - cotan etc? 101 | 102 | - CODE from Sinclair and CH from Atom, basically the same as ASC. 103 | 104 | - backslash for statement separators seen in Multics and BASIC-PLUS. The later requires spaces on either side. Easy to convert to colons, although the formatting in BASIC-PLUS documentation is nice. 105 | 106 | - option for INT to be trunc instead of floor? it's this way in early Dartmouth and a few later versions like Benton Harbour, but very rare. 107 | 108 | - add Wang style AND function, AND(string, hex mask), masks string and returns it. 109 | 110 | - SUSPEND from DG and BASIC75, identical to DEC SLEEP 111 | 112 | - WAIT from BASIC-PLUS, and/or ENTER from BASIC75, and similar features from others. 113 | 114 | Will not be done: 115 | 116 | - it would not be difficult to allow any variable to hold a string, but in most dialects that is an error. 117 | 118 | - EduSystem 25 BASIC has a weird LINPUT that is just "longer string INPUT", and does not work like LINPUT in BP or others 119 | 120 | - STORE and RECALL from Applesoft, which writes and reads all the values in an array to cassette. 121 | 122 | - RESTORE* and RESTORE$ from Dartmouth, which reset the numeric vs. string DATA pointers. 123 | 124 | - WB allows RESTORE to use an ordinal position in the list, as opposed to a line number. There appears to be no easy way to distinguish this. 125 | 126 | - IP and FP, aliases for FIX and FRAC, too easily overlap with variable names. 127 | 128 | - EXAM and FETCH aliases to PEEK from North Star and Opus and similar. No point, this returns 0 anyway. 129 | 130 | - NUM, which is Digital Group's version of VAL, or NUM$ which is the same as STR$. overlaps with INPUT's NUM function 131 | 132 | - NODATA statement from BASIC-PLUS. This is simply an ON ERROR that traps the no-more-data error. You can do this with a normal TRAP. 133 | -------------------------------------------------------------------------------- /src/strng.c: -------------------------------------------------------------------------------- 1 | /* strng (implementation) for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #include "strng.h" 22 | 23 | /* makes a new string and copies in chars */ 24 | char* str_new(char *string) 25 | { 26 | char *newstr = malloc((MAX_STRING_LEN + 1) * sizeof(char)); 27 | 28 | if (newstr == NULL) { 29 | fprintf(stderr, "Malloc in str_new failed."); 30 | exit(EXIT_FAILURE); 31 | } 32 | 33 | if (strlen(string) > 0) 34 | strcpy(newstr, string); 35 | else 36 | newstr[0] = '\0'; 37 | 38 | return newstr; 39 | } 40 | 41 | /* copies one string to another, replaces strndup */ 42 | char* str_copy(const char *string, size_t no_of_chars) 43 | { 44 | size_t len = 0; 45 | while (len < no_of_chars && string[len]) 46 | len++; 47 | 48 | char *new_str = malloc(len + 1); 49 | if (new_str) { 50 | memcpy(new_str, string, len); 51 | new_str[len] = 0; 52 | } 53 | 54 | return new_str; 55 | } 56 | 57 | /* escapes C-string sequences like \n */ 58 | char* str_escape(const char *string) 59 | { 60 | const char *p; 61 | char *dest; 62 | char *q; 63 | 64 | if (!string) 65 | return NULL; 66 | 67 | p = (char *)string; 68 | /* Each source byte needs maximally four destination chars (\777) */ 69 | q = dest = malloc(strlen(string) * 4 + 1); 70 | 71 | while (*p) { 72 | switch (*p) 73 | { 74 | case '\b': 75 | *q++ = '\\'; 76 | *q++ = 'b'; 77 | break; 78 | case '\f': 79 | *q++ = '\\'; 80 | *q++ = 'f'; 81 | break; 82 | case '\n': 83 | *q++ = '\\'; 84 | *q++ = 'n'; 85 | break; 86 | case '\r': 87 | *q++ = '\\'; 88 | *q++ = 'r'; 89 | break; 90 | case '\t': 91 | *q++ = '\\'; 92 | *q++ = 't'; 93 | break; 94 | case '\v': 95 | *q++ = '\\'; 96 | *q++ = 'v'; 97 | break; 98 | case '\\': 99 | *q++ = '\\'; 100 | *q++ = '\\'; 101 | break; 102 | case '"': 103 | *q++ = '\\'; 104 | *q++ = '"'; 105 | break; 106 | default: 107 | *q++ = *p; 108 | break; 109 | } 110 | p++; 111 | } 112 | *q = 0; 113 | return dest; 114 | } 115 | 116 | /* convert a string to lower case */ 117 | char* str_tolower(char *string) 118 | { 119 | for(char *p=string; *p; p++) 120 | *p = tolower(*p); 121 | return string; 122 | } 123 | 124 | /* convert a string to upper case */ 125 | char* str_toupper(char* string) 126 | { 127 | for(char *p=string; *p; p++) 128 | *p = toupper(*p); 129 | return string; 130 | } 131 | 132 | /* removes a number of characters from a string starting at a given position */ 133 | char* str_erase(char *string, size_t starting_pos, size_t no_of_chars) 134 | { 135 | size_t len = strlen(string); 136 | 137 | size_t sp = starting_pos; 138 | if (sp >= len) sp = len; 139 | 140 | size_t ep = starting_pos + no_of_chars - 1; 141 | if (ep >= len) ep = len; 142 | 143 | size_t no = ep - sp + 1; 144 | 145 | memmove(string, string + sp, no); // doesn't copy the null! 146 | string[no] = '\0'; 147 | 148 | return string; 149 | } 150 | 151 | /* remove a number of characters from the end of a string */ 152 | char* str_truncate(char *string, size_t no_of_chars) 153 | { 154 | size_t len = strlen(string); 155 | 156 | size_t no = no_of_chars; 157 | if (no > len) no = 0; 158 | 159 | string[len - no] = '\0'; // cheater's method, no -1 in thie case 160 | 161 | return string; 162 | } 163 | 164 | /* remove a number of characters from the front of a string */ 165 | char* str_fruncate(char *string, size_t no_of_chars) 166 | { 167 | size_t len = strlen(string); 168 | 169 | size_t no = no_of_chars; 170 | if (no > len) no = 0; 171 | 172 | memmove(string, string + no, len - no); 173 | string[len - no] = '\0'; 174 | 175 | return string; 176 | } 177 | 178 | /* append one string to another */ 179 | char* str_append(char *orig_string, char *new_chars) 180 | { 181 | // this exists only to match the API from GLib, which is used to return a string into str_new 182 | return strcat(orig_string, new_chars); 183 | } 184 | 185 | /* remove leading and trailing whitespace */ 186 | char* str_trim(char *orig_string) 187 | { 188 | size_t len = strlen(orig_string); 189 | size_t p = 0, q = len - 1; 190 | 191 | while (isspace(orig_string[p])) 192 | p++; 193 | 194 | while (isspace(orig_string[q])) 195 | q--; 196 | 197 | size_t after_len = q + 1 - p; 198 | 199 | memmove(orig_string, orig_string + p, after_len); 200 | orig_string[after_len] = '\0'; 201 | 202 | return orig_string; 203 | } 204 | 205 | /* remove leading and trailing quotes */ 206 | char* str_unquote(char *orig_string) 207 | { 208 | size_t len = strlen(orig_string); 209 | size_t p = 0, q = len - 1; 210 | 211 | if (orig_string[p] == '"') 212 | p++; 213 | 214 | if (orig_string[q] == '"') 215 | q--; 216 | 217 | size_t after_len = q + 1 - p; 218 | 219 | memmove(orig_string, orig_string + p, after_len); 220 | orig_string[after_len] = '\0'; 221 | 222 | return orig_string; 223 | } 224 | -------------------------------------------------------------------------------- /src/matrix.h: -------------------------------------------------------------------------------- 1 | /* matrix (header) for RetroBASIC 2 | Copyright (C) 2024 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | /** 22 | * @file matrix.h 23 | * @author Maury Markowitz 24 | * @date 11 May 2024 25 | * 26 | * @title Dartmouth-style matrix functions 27 | * @brief Basic matrix math and various work methods for MAT statements 28 | * 29 | * This code includes a number of work methods for common matrix math like 30 | * multiplication or transposing. The key difference between these methods and 31 | * the many stock ones found on the 'net is that these work on 1..n as opposed 32 | * to a normal C array which is 0..n-1. This matches the way Dartmouth BASIC 33 | * organizes its arrays. Items are allowed in the 0 indexes, but are ignored 34 | * in this code, which, like Dartmouth, can result in odd output when not 35 | * expected if the matrix changes dimensions as a side-effect of the calc. 36 | * 37 | * These are not general purpose routines and are not expected to be used with 38 | * other programs, unlike list or strng. This code needs to know about 39 | * statement_t which requires it to import retrobasic.h, and will report errors 40 | * and cause execution to stop if one is encountered. 41 | * 42 | */ 43 | 44 | #ifndef __MATRIX_H__ 45 | #define __MATRIX_H__ 46 | 47 | #include "retrobasic.h" 48 | 49 | /** 50 | * Used for REDIM and similar instructions that have to resize an array 51 | * or matrix to a specified size. Most of the matrix functions will 52 | * call this even if the size is the same before and after. 53 | * 54 | * @param destination_ref The array to resize. 55 | * @param x the X dimension, must be > 0. 56 | * @param y the Y dimension. Optional, if not being used, set to -1 for clarity. 57 | * @return true if the resize worked, false otherwise. 58 | */ 59 | bool redim_matrix_to_size(variable_reference_t *destination_ref, int x, int y); 60 | 61 | /** 62 | * Fills the destination matrix with a given double value. 63 | * Used for ZER and CON and numeric expression assignments. 64 | * 65 | * @param statement the statement containing the fill operation. 66 | * @param fill_value the numeric value to fill it with. This 67 | * function checks to make sure the array is numeric and will 68 | * report an error if it is not. 69 | */ 70 | void matrix_fill_num(statement_t *statement, double fill_value); 71 | 72 | /** 73 | * Fills the destination matrix with a given string value. 74 | * Used for string expression assignments. This function checks 75 | * to make sure the array is a string and will report an error 76 | * if it is not. 77 | * 78 | * @param statement the statement containing the fill operation. 79 | * @param fill_value the string value to fill it with. 80 | */ 81 | void matrix_fill_str(statement_t *statement, char *fill_value); 82 | 83 | /** 84 | * Makes the destination matrix into an identity matrix. The matrix has 85 | * to be numeric, and square. 86 | * 87 | * @param statement the statement containing the fill operation. 88 | */ 89 | void matrix_identity(statement_t *statement); 90 | 91 | /** 92 | * Copies the values in the source matrix to the destination matrix. 93 | * 94 | * @param size the actual dimensions of the source array. 95 | * @param destination the destination matrix the values will be copied into. 96 | * @param source the source matrix. 97 | */ 98 | void matrix_copy(statement_t *statement); 99 | 100 | /** 101 | * Adds the values in one array to the values already in another. 102 | * 103 | * @param size the actual dimensions of the resulting array. 104 | * @param matrix the destination matrix. 105 | * @param addend the source matrix the addition values will be taken from. 106 | */ 107 | void matrix_add(statement_t *statement); 108 | 109 | /** 110 | * Subtracts the values in one array from the values already in another. 111 | * 112 | * @param size the actual dimensions of the resulting array. 113 | * @param matrix the destination matrix. 114 | * @param subtrahend the source matrix the subtraction values will be taken from. 115 | */ 116 | void matrix_sub(statement_t *statement); 117 | 118 | /** 119 | * Multiplies the values in one array by the values in another. 120 | * 121 | * @param size the actual dimensions of the resulting array. 122 | * @param matrix the destination matrix. 123 | * @param multiplier the source matrix the multiplier values will be taken from. 124 | */ 125 | void matrix_mul(statement_t *statement); 126 | 127 | /** 128 | * Multiplies the values in a matrix by a double value. 129 | * 130 | * @param size the actual dimensions of the resulting array. 131 | * @param matrix the destination matrix. 132 | */ 133 | void matrix_mul_const(statement_t *statement); 134 | 135 | /** 136 | * Transposes a matrix. 137 | * 138 | * @param size the actual dimensions of the resulting array. 139 | * @param matrix the destination matrix. 140 | */ 141 | void matrix_transpose(statement_t *statement); 142 | 143 | /** 144 | * Inverts a matrix. 145 | * 146 | * Unlike the other functions in this library, inverting an array is almost always then used to 147 | * modify the original array, so when this function is used the original will generally need 148 | * to be left in the original form. 149 | * 150 | * Additionally, this function can fail, so it returns an integer value. 151 | * 152 | * @param statement the statement containing the matrix to invert. 153 | * @return determinant, used to indicate if the operation was successful. 154 | */ 155 | double matrix_invert(statement_t *statement); 156 | 157 | #endif /* matrix_h */ 158 | -------------------------------------------------------------------------------- /doc/retrobasic.1: -------------------------------------------------------------------------------- 1 | .\" Copyright 2022 by Maury Markowitz 2 | .\" 3 | .\" You may distribute under the terms of the GNU General Public 4 | .\" License V.2 as specified in the LICENSE file that comes with 5 | .\" the RetroBASIC distribution. 6 | 7 | .TH RETROBASIC 1 "11 February 2025" v2.1.2 "RetroBASIC" 8 | .LO 1 9 | 10 | .SH NAME 11 | .B retrobasic 12 | \- run old BASIC programs 13 | 14 | .SH SYNOPSIS 15 | .B retrobasic 16 | .RB [ \-ghnpstuv ] 17 | .RB [ \-a 1|0] 18 | .RB [ \-r 19 | .IR num ] 20 | .RB [ \-o 21 | .IR file ] 22 | .RB [ \-i 23 | .IR file ] 24 | .RB [ \-w 25 | .IR file ] 26 | .I filename 27 | 28 | .SH DESCRIPTION 29 | .B RetroBASIC 30 | is an interpreter designed to run programs from most 1970s and early 1980s BASIC dialects. It most closely follows DEC/Microsoft conventions, but includes a number of features from other popular systems like Dartmouth, HP, Apple, Atari and Sinclair. BASIC programs must be in text format, not tokenized. 31 | 32 | .SH OPTIONS 33 | .TP 34 | .B \-h, \--help 35 | Print a help message and exit. 36 | .TP 37 | .B \-v, \--version 38 | Print version info and exit. 39 | .TP 40 | .B \-u, \--upper-case 41 | Convert all input to upper-case, like using caps lock. 42 | .TP 43 | .BR \-a [1|0], 44 | .BR \--array-base =[1/0] 45 | Set the base index for arrays, normally 0 but some dialects use 1. 46 | .TP 47 | .BI \-t, 48 | .BI \--trace, 49 | Turns on line number tracing. Similar to the TRACE ON seen in some dialects. 50 | .TP 51 | .BI \--tabs num, 52 | Sets the number of spaces for comma-separated items, defaults to 10 based on the Commodore PET. 53 | .TP 54 | .B \-g, 55 | .B \--goto-next 56 | Branches to a non-existent lines will continue on the next line, instead of raising an error. 57 | .TP 58 | .BI -r num 59 | .BI --random num 60 | Seed the random number generator, passing 0 causes it to randomize. 61 | .TP 62 | .B \-s, 63 | .B \--slicing 64 | Enable string slicing like HP, Integer, Atari, etc. Turning this on makes arrays of strings inaccessible. 65 | .TP 66 | .BI \-o filename, 67 | .BI \--output-file filename 68 | Redirect PRINT statement output to the named file. 69 | .TP 70 | .BI \-i filename, 71 | .BI \--input-file filename 72 | Redirect INPUT statements to read from the named file, one INPUT value per line. 73 | .TP 74 | .B \-n, 75 | .B \--no-run 76 | Do not run the BASIC program, simply parse it and exit. 77 | .TP 78 | .B \-p, 79 | .B \--print-statistics 80 | Print a selection of statistics to the console. 81 | .TP 82 | .BI \-w filename, 83 | .BI \--write-statistics filename 84 | Write the statistics to the named file in an alternative, system-readable format. 85 | 86 | .SH GENERAL DESIGN 87 | .B RetroBASIC 88 | is intended to run programs from a variety of 1970s and early 1980s BASIC dialects without any changes to the original code. Although there were a numerous additions and customizations across the many varied platforms, most dialects still followed the pattern set by 1964's Dartmouth BASIC and are generally compatible. Whenever two dialect's customizations do interfere, 89 | .B RetroBASIC 90 | always chooses the version that is closer to Microsoft BASIC as described in the introduction of 91 | .I "BASIC Computer Games" . 92 | 93 | The original purpose of the system was to collect statistics on common BASIC programs like 94 | .I Super Star Trek. 95 | The statistics are collected during the parsing stage and can be printed out using the 96 | .B \-p 97 | option, or written to a named file with 98 | .B \-w 99 | .I filename. 100 | If the statistics are all that is needed, add the 101 | .B \-n 102 | option, which parses the program and then immediately exits without running the program. 103 | 104 | .B RetroBASIC 105 | may also be used for regression testing using the 106 | .BR -r , -i and -o 107 | options. The first seeds the random number generator to a given value so that subsequent runs will create the same series of events, the next reads inputs from a file recording previous interactive inputs, and the final one writes all output to another file. Diff'ing the resulting output from different versions of a program can be used to find changes. 108 | 109 | .SH STRING HANDLING 110 | One area where BASIC dialects vary widely is their support for string manipulation. The original Dartmouth versions did not include string variables or functions, and new dialects ofted added their own string features. 111 | 112 | Over time, three general families emerged. The first was Dartmouth's 113 | .B CHANGE 114 | command, which converted a string into an numeric array of ASCII values. HP's Time-Sharing BASIC also included a similar feature, 115 | .B CONVERT 116 | , but also added a FORTRAN-like syntax of array slicing, 117 | .BR A(1,5) . 118 | The final entry was DEC's string functions from BASIC-PLUS, including the now well-known 119 | .BR MID$ , 120 | .BR LEFT$ and 121 | .BR RIGHT$ . 122 | 123 | .B RetroBASIC 124 | attempts to support all three of these variations. This presents a problem; HP's slicing syntax looks identical to an array access in the other dialects. Following the general rule to default to MS-like behaviour, 125 | .B RetroBASIC 126 | normally interprets such syntax as an array access. 127 | 128 | To support the many BASICs that were patterned on the HP style, notably Apple BASIC (better known today as Integer BASIC), Atari and Sinclair, the 129 | .B -s 130 | option can be used. Turning this on tells 131 | .B RetroBASIC 132 | to interpret all such syntax as a slice, not an array access. If you are running programs from HP-style sources, like 133 | .I What to Do After you Hit Return 134 | , use this option and the code should run without complaint. 135 | 136 | There are additional variations to consider. HP allowed either parens or square brackets for array accesses or slicing. In practice, it seems the only use of square brackets is to denote slicing, although the opposite is not true and parens are used both for slicing and arrays. As no other interpreter allows this syntax, square brackets in code are interpreted as slicing. Another variation is the style introduced in the ANSI Full BASIC standard, which used a colon, 137 | .BR A(1:5) , 138 | which is distinct and can always be interpreted as a slice. This allows the use of arrays and slicing in the same command: 139 | .BR A(1,2)(1:2) \. 140 | This syntax can be used without invoking the 141 | .B\-s 142 | option, although it does not appear to have ever been used in surviving code. 143 | 144 | .SH EXAMPLES 145 | 146 | .B retrobasic -u sst.bas 147 | \- play a game of Super Star Trek with caps lock turned on. 148 | 149 | .B retrobasic -np amaze.bas 150 | \- parse Amazing Maze, print statistics about the program structure, and exit. 151 | 152 | .SH AUTHORS 153 | 154 | Maury Markowitz is the original author of RetroBASIC. It is based on gnbasic by James Bowman. 155 | -------------------------------------------------------------------------------- /doc/VERSIONS: -------------------------------------------------------------------------------- 1 | RetroBASIC version history 2 | 3 | Version 1.0 - initial release, 2020 4 | 5 | - basic functionality needed to run all games in BASIC Computer Games 6 | - limited to the syntax and features of early MS BASICS like Commodore BASIC 1.x 7 | - user defined functions do not substitute parameter values, they calculate 8 | based on the value of the same named global variable (**bug**) 9 | 10 | Version 1.1 - 2 June 2022 11 | 12 | - added support for ANSI and HP style string slicing 13 | - user defined functions correctly use local variables and expressions 14 | - refactored code into a more canonical C form 15 | 16 | Version 1.2 - 19 July 2022 17 | 18 | - removed GString and replaced them with normal C char-based strings 19 | 20 | Version 1.3 - 18 August 2022 21 | 22 | - removed GList, GTree and the GLib library itself 23 | - added UCASE and LCASE 24 | - added CHANGE command from Dartmouth v4, which required... 25 | - arrays/matrices now have an index 0 no matter the value of OPTION BASE. 26 | this is because the length of the string is placed in index 0. 27 | a 1-based system that accesses 0 will no longer cause an error but 28 | this should not occur in known-good code 29 | - added several changes to allow building using the makefile (thanks SK!) 30 | 31 | Version 1.4 - 2 September 2022 32 | 33 | - removing POSIX and GNU calls to make it more compatible with MSVC 34 | 35 | Version 1.5 - 22 October 2022 36 | 37 | - using stdbool instead of rolling my own boolean enum 38 | - added CLR, the MS analog of CLEAR 39 | - added TIME, TIME$, and the ability to reset the clock 40 | - added unDIMed variables, all subscripts now have a minimum dimension of 11 (0 to 10) 41 | 42 | Version 1.6 - 31 December 2022 43 | 44 | - added code to check real DIM limits even if defaulted to 11 45 | 46 | Version 1.6.2 - 2 January 2023 47 | 48 | - added SEG and SUBSTR, aliases for MID found in PDP-8 and others 49 | 50 | Version 1.6.3 - 2 January 2023 51 | 52 | - fix SEG, which uses start and end positions, not a length 53 | 54 | Version 1.7.0 - 30 May 2023 55 | 56 | - initial support for string slicing dialects like HP and Atari, use -s flag 57 | - added missing comparison operators for strings, <, >, <=, >= 58 | 59 | Version 1.7.2 - 16 July 2023 60 | 61 | - added statistic for average number of digits in a line number 62 | 63 | Version 1.8.0 - 3 October 2023 64 | 65 | - added array-slicing for string assignments - LET A$(4:5)="B" 66 | - refactored some of the code to support that, added slice_limits and variable_storage funcs 67 | - renamed variable_t to variable_value_t for clarity 68 | - added HEX, OCT, BIN, HEX$, OCT$, BIN$ 69 | - fixed bug in STRING$ when passing ASCII numbers 70 | 71 | Version 1.8.1 - 2 November 2023 72 | 73 | - added amazing.bas, which led to... 74 | - refactored setup of arrays so that you can pass in variables - DIM A(X,Y) 75 | 76 | Version 1.8.2 - 7 November 2023 77 | 78 | - add UBOUND and LBOUND (mostly for testing purposes) 79 | - added PAUSE statement, used to wait for input or pause for a given time 80 | - added hex, oct and bin constants, for instance, &FFFF, or 0b10101010 81 | 82 | Version 1.8.3 - 9 November 2023 83 | 84 | - added LABEL statement, which allows branches to named lines 85 | - fixed a problem setting up array sizes at runtime that caused amazing to fail at 2x2 86 | 87 | Version 1.8.4 - 15 November 2023 88 | 89 | - merged FOR and GOSUB stacks so that a RETURN correctly pops off any local FORs 90 | - added POP for manual stack pops 91 | - fixed an error in octal constants that caused SST to fail to parse 92 | 93 | Version 1.8.5 - 16 November 2023 94 | 95 | - added floor() during the calculation of array indexes, the lack of which caused 96 | SST to fail when entering directions >8 but <9. 97 | 98 | Version 1.8.6 - 23 November 2023 99 | 100 | - fix problem in array initialization that was causing amazing.bas to fail 101 | 102 | Version 1.8.7 - 10 December 2023 103 | 104 | - add INSTR string function, and the INDEX alias 105 | 106 | Version 1.8.8 - 12 December 2023 107 | 108 | - first draft of a reference manual 109 | - added ACS ASN, TAN, COSH/CSH, SINH/SNH, TANH/THN functions 110 | - add INKEY$ function 111 | - added PI pseudo-function/variable 112 | - added MOD operator 113 | - added XOR operator 114 | - added ROUND function, 1-arity rounds to integer, 2-arity rounds to a given decimal point 115 | - properly implemented CLR/CLEAR to clear variables 116 | - implemented CLS for clear screen 117 | - properly cast calculated values to the underlying type, single/double/integer, on assignment 118 | - added case where string constant is "closed" by a newline, instead of a quote 119 | 120 | Version 1.8.9 - 23 December 2023 121 | 122 | - added Sinclair-style slicing, A$(1 TO 5) 123 | 124 | Version 1.9.0 - 1 January 2024 125 | 126 | - switched order of parameters in STRING$, can't find any dialects with string first 127 | - added LN, the version of LOG seen in many UK dialects like Sinclair and BBC 128 | - reset the DATA pointer on CLEAR 129 | - reset the runtime stack on CLEAR 130 | 131 | Version 1.9.1 - 13 February 2024 132 | 133 | - added DIV operator, for integer division. 7 DIV 3 returns 2 134 | - negative parameter values in RND() now perform a RANDOMIZE, as is the case in MS BASICs 135 | - added Integer BASIC's variation on TAB, which is a statement, not a pseudo-function 136 | - fix minor issue in RND that caused issues in SST 137 | 138 | Version 2.0.0 - 8 December 2024 139 | 140 | Major update. See the reference manual for details on the many changes. 141 | 142 | - added -t/--trace option to turn on line tracing, which means -t is no longer short for --tabs 143 | - added MAT matrix statements and functions from Dartmouth BASIC V4 with additions from IBM 5100 and others 144 | - added error handling in the form of TRAP, ON ERROR and RESUME statements, and ERR and ERL functions 145 | - added GET and PUT, which read or print a single character 146 | - INPUT properly handles multiple variables on a single line, no need to press between them 147 | - DATA statements now allow unquoted strings and properly handle whitespace 148 | - GO SUB and GO TO are now working properly 149 | - fixed PRINT to get rid of the `(null)` that appeared in some cases 150 | - added dummy version of ADR, returns 0 151 | - added DISPOSE, the Commodore version of POP (from late model machines) 152 | - added EQV and IMP logical operators, seen in IBM and some other versions 153 | - added RETURN with a line number, seen in MSX. equivalent to doing a POP and then GOTO 154 | - fixed MOD and DIV operators 155 | - added MOD and DIV *functions* 156 | - added MAX and MIN as both functions and operators 157 | - added ASCII, DEC's version of ASC 158 | - added SLEEP, DEC's version of PAUSE 159 | - ON properly falls to next statement after the ON if the index is greater than number of items (instead of error) 160 | - NEW properly clears the runtime stack for RETURN and NEXT 161 | - slicing now checks against DIMmed bounds in non-ANSI dialects 162 | - added RANDOMIZE TIMER from GW 163 | 164 | Version 2.0.1 - 12 December 2024 165 | 166 | Fixing major problems with the GitHub repo. Some very minor changes as well. 167 | 168 | Version 2.0.2 - 31 December 2024 169 | 170 | - added NUM, which returns the number of items entered in MAT INPUT, and in RetroBASIC, normal INPUT as well 171 | - MAT INPUT now works with both string and number arrays 172 | - fixed issue in MAT INPUT which raised an error if the input was empty 173 | - separated out input/output routines for file handling, for code clarity 174 | 175 | Version 2.1.0 - 14 January 2025 176 | 177 | Added basic file support, based mostly on Commodore BASIC but folding in options from Atari and Apple's Business BASIC. 178 | 179 | - added OPEN/OPEN#/CLOSE/CLOSE# 180 | - added PRINT#/INPUT#/PUT#/GET# 181 | - NUM works with INPUT# 182 | 183 | Version 2.1.1 - 16 January 2025 184 | 185 | - added EOF function for working with files 186 | - correctly check for read/write status on the file when reading and writing 187 | - added FILE EXISTS error, returned when attempt to open an existing file for writing (as opposed to NOT FOUND) 188 | 189 | Version 2.1.2 - 16 September 2025 190 | 191 | - added a new statistic that determines if a decimal number can be exactly represented in binary 192 | -------------------------------------------------------------------------------- /src/main.c: -------------------------------------------------------------------------------- 1 | /* Main for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #include 22 | #include // used for getpid 23 | 24 | #include "retrobasic.h" 25 | #include "statistics.h" 26 | #include "parse.h" 27 | 28 | /* simple version info for --version command line option */ 29 | static void print_version(void) 30 | { 31 | puts("RetroBASIC 2.1.2"); 32 | } 33 | 34 | /* usage short form, just a list of the switches */ 35 | static void print_usage(char *argv[]) 36 | { 37 | printf("Usage: %s [-hvsngut] [-a number] [-r seed] [-p | -w stats_file] [-o output_file] [-i input_file] FILE\n", argv[0]); 38 | } 39 | 40 | /* full usage notes, both for the user and for documenting the code below */ 41 | static void print_help(char *argv[]) 42 | { 43 | printf("Usage: retrobasic [-hvsngut] [-a number] [-tabs spaces] [-r seed] [-p | -w stats_file] [-o output_file] [-i input_file] FILE\n"); 44 | puts("\nOptions:"); 45 | puts(" -h, --help: print this description"); 46 | puts(" -v, --version: print version info"); 47 | puts(" -u, --upper-case: convert all input to upper case"); 48 | puts(" -a, --array-base: minimum array index, normally 1"); 49 | puts(" -s, --slicing: turn on string slicing (turning off string arrays)"); 50 | puts(" -n, --no-run: don't run the program after parsing"); 51 | puts(" -g, --goto-next: if a branch target doesn't exist, go to the next line"); 52 | puts(" -t, --trace: turn on line number tracing"); 53 | puts(" --tabs: set the number of spaces for comma-separated items"); 54 | puts(" -r, --random: seed the random number generator"); 55 | puts(" -p, --print-stats: when the program exits, print statistics"); 56 | puts(" -w, --write-stats: on exit, write statistics to a file"); 57 | puts(" -o, --output-file: redirect PRINT and PUT to the named file"); 58 | puts(" -i, --input-file: redirect INPUT and GET from the named file"); 59 | } 60 | 61 | static struct option program_options[] = 62 | { 63 | {"help", no_argument, NULL, 'h'}, 64 | {"version", no_argument, NULL, 'v'}, 65 | {"upper-case", no_argument, NULL, 'u'}, 66 | {"array-base", required_argument, NULL, 'a'}, 67 | {"trace", no_argument, NULL, 't'}, 68 | {"tabs", required_argument, NULL, 500}, 69 | {"random", optional_argument, NULL, 'r'}, 70 | {"slicing", no_argument, NULL, 's'}, 71 | {"goto-next", no_argument, NULL, 'g'}, 72 | {"input-file", required_argument, NULL, 'i'}, 73 | {"output-file", required_argument, NULL, 'o'}, 74 | {"print-stats", no_argument, NULL, 'p'}, 75 | {"write-stats", required_argument, NULL, 'w'}, 76 | {"no-run", no_argument, NULL, 'n'}, 77 | {0, 0, 0, 0} 78 | }; 79 | 80 | void parse_options(int argc, char *argv[]) 81 | { 82 | int option_index = 0; 83 | int printed_help = false; 84 | 85 | // one annoyance with getopt is that if you define a switch with an optional_argument, 86 | // it will always eat the next entry, if there is one, as its parameter. So, for instance: 87 | // 88 | // ./retrobasic -r sst.bas 89 | // 90 | // will return "sst.bas" as the parameter for -r, and eat the input. So for any optional 91 | // parameter switches, be sure to test the input is what you expect, and if not, back 92 | // up optind one space so it can be used by the next loop. see -r for an example 93 | char *test; 94 | 95 | while (1) { 96 | // eat an option and exit if we're done 97 | int c = getopt_long(argc, argv, "hvuta:r:i:o:w:spn", program_options, &option_index); // should match the items above, but with flag-setters excluded 98 | if (c == -1) break; 99 | 100 | switch (c) { 101 | case 0: 102 | // flag-setting options return 0 - these are s, p and n 103 | if (program_options[option_index].flag != 0) 104 | break; 105 | 106 | case 'h': 107 | print_help(argv); 108 | printed_help = true; 109 | break; 110 | 111 | case 'v': 112 | print_version(); 113 | printed_help = true; 114 | break; 115 | 116 | case 'u': 117 | upper_case = true; 118 | break; 119 | 120 | case 't': 121 | trace_lines = true; 122 | break; 123 | 124 | case 'g': 125 | goto_next_highest = true; 126 | break; 127 | 128 | case 'n': 129 | run_program = false; 130 | break; 131 | 132 | case 's': 133 | string_slicing = true; 134 | break; 135 | 136 | case 'p': 137 | print_stats = true; 138 | break; 139 | 140 | case 'a': 141 | array_base = (int)strtol(optarg, 0, 10); 142 | break; 143 | 144 | case 500: 145 | tab_columns = (int)strtol(optarg, 0, 10); 146 | break; 147 | 148 | case 'i': 149 | input_file = optarg; 150 | break; 151 | 152 | case 'o': 153 | print_file = optarg; 154 | break; 155 | 156 | case 'w': 157 | write_stats = 1; 158 | stats_file = optarg; 159 | break; 160 | 161 | case 'r': 162 | test = optarg; 163 | random_seed = (int)strtol(optarg, &test, 10); 164 | 165 | // now see if we actually read anything, we might have been handed the 166 | // next switch or option rather than a number. if so, use zero as the 167 | // seed and back up the optind so it can read it correctly 168 | if (test == optarg) 169 | optind--; 170 | 171 | break; 172 | 173 | default: 174 | abort(); 175 | } 176 | } // while 177 | 178 | // now see if there's a filename 179 | if (optind <= argc && argc > 1) 180 | source_file = argv[argc - 1]; 181 | else 182 | // not always a failure, we might have just been asked for usage 183 | if (printed_help) 184 | exit(EXIT_SUCCESS); 185 | else { 186 | print_usage(argv); 187 | exit(EXIT_FAILURE); 188 | } 189 | } 190 | 191 | int main(int argc, char *argv[]) 192 | { 193 | extern int yyparse(void); 194 | extern FILE *yyin; 195 | 196 | // turn this on to add verbose debugging 197 | #if YYDEBUG 198 | yydebug = 1; 199 | #endif 200 | #define YYDEBUG 1 201 | 202 | // parse the options and make sure we got a filename somewhere 203 | parse_options(argc, argv); 204 | 205 | // call the interpreter's setup to create the state needed to parse the file 206 | interpreter_setup(); 207 | 208 | // open the file and see if it exists 209 | if (strlen(source_file) == 0) { 210 | fprintf(stderr, "No filename provided.\n"); 211 | exit(EXIT_FAILURE); 212 | } 213 | yyin = fopen(source_file, "r"); 214 | if (yyin == NULL) { 215 | if (errno == ENOENT) { 216 | fprintf(stderr, "File not found or invalid filename provided.\n"); 217 | exit(EXIT_FAILURE); 218 | } else { 219 | fprintf(stderr, "Error %i when opening file '%s'.\n", errno, source_file); 220 | exit(EXIT_FAILURE); 221 | } 222 | } 223 | // if we were able to open the file, parse it 224 | yyparse(); 225 | 226 | // prepare the code for running 227 | interpreter_post_parse(); 228 | 229 | // seed the random with the provided number or randomize it 230 | if (random_seed > -1) 231 | srand(random_seed); 232 | else 233 | srand((unsigned int)time(NULL) | (getpid() << 8)); 234 | 235 | // now call rand to prime the pump, see: 236 | // https://stackoverflow.com/questions/76367489/srand-rand-slowly-changing-starting-value/76367884#76367884 237 | (void)rand(); 238 | (void)rand(); 239 | 240 | // and go! 241 | if (run_program) 242 | interpreter_run(); 243 | 244 | // we're done, print/write desired stats 245 | if (print_stats || write_stats) 246 | print_statistics(); 247 | 248 | // and exit 249 | exit(EXIT_SUCCESS); 250 | } 251 | -------------------------------------------------------------------------------- /src/errors.h: -------------------------------------------------------------------------------- 1 | /* Errors (header) for RetroBASIC 2 | Copyright (C) 2024 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #ifndef __ERRORS_H__ 22 | #define __ERRORS_H__ 23 | 24 | /** 25 | * @file errors.h 26 | * @author Maury Markowitz 27 | * @date 1 April 2024 28 | * @brief Definitions of standard BASIC error numbers and messages 29 | * 30 | * The numbers are mostly taken from Commodore BASIC B, and will provide 31 | * some level of compatibility. A number of these are not used by RetroBASIC, 32 | * like STRING TOO LONG, which simply can't occur. The numbers for these 33 | * unused codes are defined for completeness, but the corresponding message 34 | * text is not defined and there is no entry in the mapping array. 35 | * 36 | * A small number of codes have beed added or re-purposed. For example, 37 | * code 11 was previously BAD DISK, but is now FILE EXISTS, which can 38 | * occur when someone attempts to OPEN a file for writing that already 39 | * exists (they should open it for appending in that case). Codes 42 40 | * and 44 are new entries, as this functionality did not exist in MS. 41 | * 42 | */ 43 | 44 | #define ern_NO_ERROR 0 // no error 45 | 46 | #define ern_TOO_MANY_FILES 1 // attempt to OPEN a file with too many already OPEN 47 | #define ern_FILE_OPEN 2 // attempt to OPEN a file that's already OPEN 48 | #define ern_FILE_NOT_OPEN 3 // attempt to use a file that's not OPEN 49 | #define ern_FILE_NOT_FOUND 4 // attempt to OPEN a non-existent file 50 | #define ern_DEV_NOT_FOUND 5 // attempt to OPEN a non-existent device. in RetroBASIC this is used for non-existent paths 51 | #define ern_FILE_NOT_INPUT 6 // attempt to INPUT/GET from a file opened for writing 52 | #define ern_FILE_NOT_OUTPUT 7 // attempt to PRINT/PUT to a file opened for reading 53 | #define ern_FILENAME_MISSING 8 // attempt to OPEN a file with no filename 54 | #define ern_BAD_DEVICE_NUM 9 // attempt to OPEN a device that is invalid. unused in RetroBASIC, it uses ern_DEV_NOT_FOUND instead 55 | #define ern_ARE_YOU_SURE 10 // causes "are you sure" message before writing. unused in RetroBASIC 56 | #define ern_FILE_EXISTS 11 // originally ern_BAD_DISK, repurposed as exiting file 57 | 58 | #define ern_READY 12 // no error but paused in ready state 59 | #define ern_IN 13 // not an error, this points to the string " IN " used during error reporting. unused in RetroBASIC 60 | #define ern_BREAK 14 // the user has pressed the BREAK key 61 | #define ern_INPUT_EXTRA 15 // too many items in the input line, extras ignored 62 | #define ern_INPUT_REDO 16 // input contains character data for a numeric variable 63 | #define ern_LAST_NUMBER 17 // not an error, returns last number parsed. unused in RetroBASIC 64 | #define ern_MORE 18 // not an error, this points to the string "MORE". unused in RetroBASIC 65 | #define ern_POWER_ON_MSG 19 // not an error, prints a startup message. unused in RetroBASIC 66 | #define ern_NEXT_NO_FOR 20 // NEXT without a FOR on the stack 67 | #define ern_SYNTAX_ERROR 21 // any syntax error 68 | #define ern_RET_NO_GOSUB 22 // RETURN without a GOSUB on the stack 69 | #define ern_OUT_OF_DATA 23 // READ with no remaining data 70 | #define ern_ILLEGAL_VALUE 24 // any parameter out-of-range, like a MID with a start parameter outside the string 71 | #define ern_OVERFLOW 25 // result of calculation is out-of-range. unused in RetroBASIC 72 | #define ern_OUT_OF_MEMORY 26 // unused in RetroBASIC 73 | #define ern_NO_SUCH_LINE 27 // branch to a non-existing line, aka UNDEFINED STATEMENT 74 | #define ern_BAD_SUBSCRIPT 28 // array access outside DIMed range 75 | #define ern_REDIM_ARRAY 29 // DIM being called on an already DIMed variable 76 | #define ern_DIV_BY_ZERO 30 // any division by zero, including integer division 77 | #define ern_DIRECT_MODE 31 // INPUT/GET cannot be used in direct mode. unused in RetroBASIC 78 | #define ern_TYPE_MISMATCH 32 // number provided to string operation or vice versa 79 | #define ern_STRING_TO_LONG 33 // unused in RetroBASIC 80 | #define ern_FILE_DATA 34 // attempt to read a number from a file but got a non-number. unused in RetroBASIC, returns 32 instead 81 | #define ern_FORMULA_TOO_LONG 35 // unused in RetroBASIC 82 | // no definition for 36 can be found 83 | #define ern_DEF_UNKNOWN 37 // call to user-defined function that doesn't exist 84 | #define ern_LOAD_ERROR 38 // program failed to load from cassette. unused in RetroBASIC 85 | #define ern_VERIFY_ERROR 39 // program failed to verify on saving to cassette. unused in RetroBASIC 86 | #define ern_OUT_OF_STACK 40 // unused in RetroBASIC 87 | #define ern_CANT_CONTINUE 41 // RetroBASIC does not support CONTinue 88 | #define ern_POP_NO_STACK 42 // a POP/EXIT/DISPOSE was called with nothing on the stack 89 | #define ern_OUT_OF_TEXT 43 // loading a file larger than 64. unused in RetroBASIC 90 | #define ern_RES_NO_TRAP 44 // a RESUME was encountered with no corresponding TRAP 91 | 92 | #define ers_TOO_MANY_FILES "TOO MANY FILES" 93 | #define ers_FILE_OPEN "FILE OPEN" 94 | #define ers_FILE_NOT_OPEN "FILE NOT OPEN" 95 | #define ers_FILE_NOT_FOUND "FILE NOT FOUND" 96 | #define ers_DEV_NOT_FOUND "DEVICE NOT PRESENT" 97 | #define ers_FILE_NOT_INPUT "NOT INPUT FILE" 98 | #define ers_FILE_NOT_OUTPUT "NOT OUTPUT FILE" 99 | #define ers_FILENAME_MISSING "MISSING FILENAME" 100 | #define ers_BAD_DEVICE_NUM "ILLEGAL DEVICE NUMBER" 101 | #define ers_FILE_EXISTS "FILE EXISTS" 102 | #define ers_READY "READY" 103 | #define ers_BREAK "BREAK" 104 | #define ers_INPUT_EXTRA "EXTRA IGNORED" 105 | #define ers_INPUT_REDO "REDO FROM START" 106 | #define ers_NEXT_NO_FOR "NEXT WITHOUT FOR" 107 | #define ers_SYNTAX_ERROR "SYNTAX" 108 | #define ers_RET_NO_GOSUB "RETURN WITHOUT GOSUB" 109 | #define ers_OUT_OF_DATA "OUT OF DATA" 110 | #define ers_ILLEGAL_VALUE "ILLEGAL QUANTITY" 111 | #define ers_OVERFLOW "OVERFLOW" 112 | #define ers_OUT_OF_MEMORY "OUT OF MEMORY" 113 | #define ers_NO_SUCH_LINE "UNDEFINED STATEMENT" 114 | #define ers_BAD_SUBSCRIPT "BAD SUBSCRIPT" 115 | #define ers_REDIM_ARRAY "REDIM'D ARRAY" 116 | #define ers_DIV_BY_ZERO "DIVISION BY ZERO" 117 | #define ers_DIRECT_MODE "ILLEGAL DIRECT" 118 | #define ers_TYPE_MISMATCH "TYPE MISMATCH" 119 | #define ers_STRING_TO_LONG "STRING TOO LONG" 120 | #define ers_FORMULA_TOO_LONG "FORMULA TOO COMPLEX" 121 | #define ers_DEF_UNKNOWN "UNDEFINED FUNCTION" 122 | #define ers_OUT_OF_STACK "OUT OF STACK" 123 | #define ers_CANT_CONTINUE "UNABLE TO RESUME" 124 | #define ers_POP_NO_STACK "POP WITHOUT STACK" 125 | #define ers_RES_NO_TRAP "RESUME WITHOUT TRAP" 126 | 127 | /** 128 | * Maps error numbers to messages. 129 | * 130 | */ 131 | extern char *error_messages[]; 132 | 133 | /** 134 | * Handles runtime errors. 135 | * 136 | * If trap_line is set to 0, there is no error handling turned on, in which 137 | * icase it simply reports the error and exits. If trap_line is +ve, it does 138 | * not report the error and instead branches to the trap. 139 | * 140 | * If there is no trap and the error is going to be reported, it will always 141 | * report the error string and the line where it occurred. If @p message is 142 | * not empty, it will be printed in parens at the end. 143 | * 144 | * @param errnum error number, see errors.h for a list 145 | * @param message optional message string for extra information 146 | */ 147 | void handle_error(const int errnum, const char *message); 148 | 149 | /** 150 | * Handles runtime warnings. 151 | * 152 | * Similar to handle_error, but does not trigger a trap, and does not exit the 153 | * program. Examples include REDO FROM START and EXTRA IGNORED. 154 | * 155 | * @param errnum error number, see errors.h for a list 156 | * @param message optional message string for extra information 157 | */ 158 | void handle_warning(const int errnum, const char *message); 159 | 160 | #endif /* errors_h */ 161 | -------------------------------------------------------------------------------- /src/parse.h: -------------------------------------------------------------------------------- 1 | /* A Bison parser, made by GNU Bison 2.3. */ 2 | 3 | /* Skeleton interface for Bison's Yacc-like parsers in C 4 | 5 | Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 6 | Free Software Foundation, Inc. 7 | 8 | This program is free software; you can redistribute it and/or modify 9 | it under the terms of the GNU General Public License as published by 10 | the Free Software Foundation; either version 2, or (at your option) 11 | any later version. 12 | 13 | This program is distributed in the hope that it will be useful, 14 | but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | GNU General Public License for more details. 17 | 18 | You should have received a copy of the GNU General Public License 19 | along with this program; if not, write to the Free Software 20 | Foundation, Inc., 51 Franklin Street, Fifth Floor, 21 | Boston, MA 02110-1301, USA. */ 22 | 23 | /* As a special exception, you may create a larger work that contains 24 | part or all of the Bison parser skeleton and distribute that work 25 | under terms of your choice, so long as that work isn't itself a 26 | parser generator using the skeleton or a modified version thereof 27 | as a parser skeleton. Alternatively, if you modify or redistribute 28 | the parser skeleton itself, you may (at your option) remove this 29 | special exception, which will cause the skeleton and the resulting 30 | Bison output files to be licensed under the GNU General Public 31 | License without this special exception. 32 | 33 | This special exception was added by the Free Software Foundation in 34 | version 2.2 of Bison. */ 35 | 36 | /* Tokens. */ 37 | #ifndef YYTOKENTYPE 38 | # define YYTOKENTYPE 39 | /* Put the tokens into the symbol table, so that GDB and other debuggers 40 | know about them. */ 41 | enum yytokentype { 42 | STRING = 258, 43 | NUMBER = 259, 44 | DOUBLE = 260, 45 | SINGLE = 261, 46 | INTEGER = 262, 47 | VARIABLE_NAME = 263, 48 | FUNCTION_NAME = 264, 49 | HEX_STR = 265, 50 | OCT_STR = 266, 51 | BIN_STR = 267, 52 | REM = 268, 53 | QUOTEREM = 269, 54 | BANGREM = 270, 55 | BYE = 271, 56 | CLEAR = 272, 57 | CLR = 273, 58 | DATA = 274, 59 | DEF = 275, 60 | DIM = 276, 61 | END = 277, 62 | EXIT = 278, 63 | FOR = 279, 64 | GET = 280, 65 | GOSUB = 281, 66 | GOTO = 282, 67 | IF = 283, 68 | INPUT = 284, 69 | INPUT_LINE = 285, 70 | LET = 286, 71 | LIST = 287, 72 | NEXT = 288, 73 | NEW = 289, 74 | OF = 290, 75 | ON = 291, 76 | PRINT = 292, 77 | PUT = 293, 78 | READ = 294, 79 | RETURN = 295, 80 | RUN = 296, 81 | STEP = 297, 82 | STOP = 298, 83 | THEN = 299, 84 | TO = 300, 85 | USING = 301, 86 | WAIT = 302, 87 | OPEN = 303, 88 | CLOSE = 304, 89 | STATUS = 305, 90 | PRINT_FILE = 306, 91 | INPUT_FILE = 307, 92 | GET_FILE = 308, 93 | PUT_FILE = 309, 94 | _EOF = 310, 95 | CALL = 311, 96 | CLS = 312, 97 | CMD = 313, 98 | OPTION = 314, 99 | BASE = 315, 100 | PEEK = 316, 101 | POKE = 317, 102 | POP = 318, 103 | RANDOMIZE = 319, 104 | SYS = 320, 105 | VARLIST = 321, 106 | PAUSE = 322, 107 | SLEEP = 323, 108 | RESTORE = 324, 109 | ABS = 325, 110 | SGN = 326, 111 | CLOG = 327, 112 | EXP = 328, 113 | LOG = 329, 114 | SQR = 330, 115 | PI = 331, 116 | RND = 332, 117 | INT = 333, 118 | FIX = 334, 119 | FRAC = 335, 120 | ROUND = 336, 121 | CINT = 337, 122 | CSNG = 338, 123 | CDBL = 339, 124 | MOD = 340, 125 | MOD_INT = 341, 126 | DIV = 342, 127 | MAX = 343, 128 | MIN = 344, 129 | COS = 345, 130 | SIN = 346, 131 | ATN = 347, 132 | ACS = 348, 133 | ASN = 349, 134 | TAN = 350, 135 | COSH = 351, 136 | SINH = 352, 137 | TANH = 353, 138 | ASC = 354, 139 | LEFT = 355, 140 | MID = 356, 141 | RIGHT = 357, 142 | LEN = 358, 143 | STR = 359, 144 | VAL = 360, 145 | CHR = 361, 146 | SEG = 362, 147 | SUBSTR = 363, 148 | INSTR = 364, 149 | INKEY = 365, 150 | AND = 366, 151 | OR = 367, 152 | NOT = 368, 153 | XOR = 369, 154 | EQV = 370, 155 | IMP = 371, 156 | CMP_LE = 372, 157 | CMP_GE = 373, 158 | CMP_NE = 374, 159 | HASH = 375, 160 | ADR = 376, 161 | FRE = 377, 162 | SPC = 378, 163 | TAB = 379, 164 | POS = 380, 165 | USR = 381, 166 | LIN = 382, 167 | TRAP = 383, 168 | RESUME = 384, 169 | ERROR = 385, 170 | RAISE = 386, 171 | ERR = 387, 172 | EL = 388, 173 | ER = 389, 174 | DEFSTR = 390, 175 | DEFINT = 391, 176 | DEFSNG = 392, 177 | DEFDBL = 393, 178 | CHANGE = 394, 179 | CONVERT = 395, 180 | UCASE = 396, 181 | LCASE = 397, 182 | STRNG = 398, 183 | TIME = 399, 184 | TIME_STR = 400, 185 | HEX = 401, 186 | OCT = 402, 187 | BIN = 403, 188 | HEXSTR = 404, 189 | OCTSTR = 405, 190 | BINSTR = 406, 191 | UBOUND = 407, 192 | LBOUND = 408, 193 | LABEL = 409, 194 | MAT = 410, 195 | MATPRINT = 411, 196 | MATINPUT = 412, 197 | MATREAD = 413, 198 | MATGET = 414, 199 | MATPUT = 415, 200 | MATZER = 416, 201 | MATNUL = 417, 202 | MATCON = 418, 203 | MATIDN = 419, 204 | MATTRN = 420, 205 | MATINV = 421, 206 | MATDET = 422, 207 | MATADD = 423, 208 | MATSUB = 424, 209 | MATMUL = 425, 210 | MATSCA = 426, 211 | MATFIL = 427, 212 | NUM = 428 213 | }; 214 | #endif 215 | /* Tokens. */ 216 | #define STRING 258 217 | #define NUMBER 259 218 | #define DOUBLE 260 219 | #define SINGLE 261 220 | #define INTEGER 262 221 | #define VARIABLE_NAME 263 222 | #define FUNCTION_NAME 264 223 | #define HEX_STR 265 224 | #define OCT_STR 266 225 | #define BIN_STR 267 226 | #define REM 268 227 | #define QUOTEREM 269 228 | #define BANGREM 270 229 | #define BYE 271 230 | #define CLEAR 272 231 | #define CLR 273 232 | #define DATA 274 233 | #define DEF 275 234 | #define DIM 276 235 | #define END 277 236 | #define EXIT 278 237 | #define FOR 279 238 | #define GET 280 239 | #define GOSUB 281 240 | #define GOTO 282 241 | #define IF 283 242 | #define INPUT 284 243 | #define INPUT_LINE 285 244 | #define LET 286 245 | #define LIST 287 246 | #define NEXT 288 247 | #define NEW 289 248 | #define OF 290 249 | #define ON 291 250 | #define PRINT 292 251 | #define PUT 293 252 | #define READ 294 253 | #define RETURN 295 254 | #define RUN 296 255 | #define STEP 297 256 | #define STOP 298 257 | #define THEN 299 258 | #define TO 300 259 | #define USING 301 260 | #define WAIT 302 261 | #define OPEN 303 262 | #define CLOSE 304 263 | #define STATUS 305 264 | #define PRINT_FILE 306 265 | #define INPUT_FILE 307 266 | #define GET_FILE 308 267 | #define PUT_FILE 309 268 | #define _EOF 310 269 | #define CALL 311 270 | #define CLS 312 271 | #define CMD 313 272 | #define OPTION 314 273 | #define BASE 315 274 | #define PEEK 316 275 | #define POKE 317 276 | #define POP 318 277 | #define RANDOMIZE 319 278 | #define SYS 320 279 | #define VARLIST 321 280 | #define PAUSE 322 281 | #define SLEEP 323 282 | #define RESTORE 324 283 | #define ABS 325 284 | #define SGN 326 285 | #define CLOG 327 286 | #define EXP 328 287 | #define LOG 329 288 | #define SQR 330 289 | #define PI 331 290 | #define RND 332 291 | #define INT 333 292 | #define FIX 334 293 | #define FRAC 335 294 | #define ROUND 336 295 | #define CINT 337 296 | #define CSNG 338 297 | #define CDBL 339 298 | #define MOD 340 299 | #define MOD_INT 341 300 | #define DIV 342 301 | #define MAX 343 302 | #define MIN 344 303 | #define COS 345 304 | #define SIN 346 305 | #define ATN 347 306 | #define ACS 348 307 | #define ASN 349 308 | #define TAN 350 309 | #define COSH 351 310 | #define SINH 352 311 | #define TANH 353 312 | #define ASC 354 313 | #define LEFT 355 314 | #define MID 356 315 | #define RIGHT 357 316 | #define LEN 358 317 | #define STR 359 318 | #define VAL 360 319 | #define CHR 361 320 | #define SEG 362 321 | #define SUBSTR 363 322 | #define INSTR 364 323 | #define INKEY 365 324 | #define AND 366 325 | #define OR 367 326 | #define NOT 368 327 | #define XOR 369 328 | #define EQV 370 329 | #define IMP 371 330 | #define CMP_LE 372 331 | #define CMP_GE 373 332 | #define CMP_NE 374 333 | #define HASH 375 334 | #define ADR 376 335 | #define FRE 377 336 | #define SPC 378 337 | #define TAB 379 338 | #define POS 380 339 | #define USR 381 340 | #define LIN 382 341 | #define TRAP 383 342 | #define RESUME 384 343 | #define ERROR 385 344 | #define RAISE 386 345 | #define ERR 387 346 | #define EL 388 347 | #define ER 389 348 | #define DEFSTR 390 349 | #define DEFINT 391 350 | #define DEFSNG 392 351 | #define DEFDBL 393 352 | #define CHANGE 394 353 | #define CONVERT 395 354 | #define UCASE 396 355 | #define LCASE 397 356 | #define STRNG 398 357 | #define TIME 399 358 | #define TIME_STR 400 359 | #define HEX 401 360 | #define OCT 402 361 | #define BIN 403 362 | #define HEXSTR 404 363 | #define OCTSTR 405 364 | #define BINSTR 406 365 | #define UBOUND 407 366 | #define LBOUND 408 367 | #define LABEL 409 368 | #define MAT 410 369 | #define MATPRINT 411 370 | #define MATINPUT 412 371 | #define MATREAD 413 372 | #define MATGET 414 373 | #define MATPUT 415 374 | #define MATZER 416 375 | #define MATNUL 417 376 | #define MATCON 418 377 | #define MATIDN 419 378 | #define MATTRN 420 379 | #define MATINV 421 380 | #define MATDET 422 381 | #define MATADD 423 382 | #define MATSUB 424 383 | #define MATMUL 425 384 | #define MATSCA 426 385 | #define MATFIL 427 386 | #define NUM 428 387 | 388 | 389 | 390 | 391 | #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED 392 | typedef union YYSTYPE 393 | #line 80 "/Volumes/Bigger/Users/maury/Desktop/RetroBASIC/src/parse.y" 394 | { 395 | double d; 396 | int i; 397 | char *s; 398 | list_t *l; 399 | statement_t *statement; 400 | expression_t *expression; 401 | variable_reference_t *variable; 402 | } 403 | /* Line 1529 of yacc.c. */ 404 | #line 405 "/Volumes/Bigger/Users/maury/Desktop/RetroBASIC/DerivedData/RetroBASIC/Build/Intermediates.noindex/RetroBASIC.build/Debug/retrobasic.build/DerivedSources/y.tab.h" 405 | YYSTYPE; 406 | # define yystype YYSTYPE /* obsolescent; will be withdrawn */ 407 | # define YYSTYPE_IS_DECLARED 1 408 | # define YYSTYPE_IS_TRIVIAL 1 409 | #endif 410 | 411 | extern YYSTYPE yylval; 412 | 413 | -------------------------------------------------------------------------------- /bas/test.bas: -------------------------------------------------------------------------------- 1 | 1 REM lots of little tests 2 | 2 REM 3 | 3 RANDOMIZE TIMER 4 | 5 REM print some random numbers 5 | 6 REM 6 | 7 PRINT"Some rnds with RANDOMIZE 1" 7 | 8 RANDOMIZE 1:FOR I=1 TO 10:PRINT RND(0):NEXT I 8 | 9 REM 9 | 10 REM calling DEFINT and then listing vars 10 | 11 REM 11 | 20 DEFINT X,Y 12 | 25 PRINT "printing var list" 13 | 30 VARLIST 14 | 33 REM 15 | 34 REM hex, oct, bin constants 16 | 35 REM 17 | 36 PRINT "hex &FF, should print 255: ";&FF 18 | 37 PRINT "hex 0hFF, should print 255: ";0hFF 19 | 38 PRINT "oct 0o77, should print 63: ";0o77 20 | 39 PRINT "bin 0b10101010, should print 170: ";0b10101010 21 | 40 GOSUB te 22 | 44 REM 23 | 45 REM simple loop 24 | 46 REM 25 | 50 FOR I=1 TO 3 26 | 60 PRINT "loop with NEXT I"I 27 | 70 NEXT I 28 | 74 REM 29 | 75 REM simple loop with no variable in NEXT 30 | 76 REM 31 | 80 FOR I=1 TO 3 32 | 90 PRINT "loop with NEXT (no I)"I 33 | 100 NEXT 34 | 104 REM 35 | 105 REM print a long number that should display as E format 36 | 106 REM 37 | 110 A=9999999999 38 | 120 PRINT "printing A=9999999999, this should print 1E+10: "A 39 | 124 REM 40 | 125 REM some variations on the comment formats 41 | 126 REM 42 | 130 ' quote comment 43 | 140 ! bang comment 44 | 144 REM 45 | 145 REM trying remarks at the end of the lines 46 | 146 REM 47 | 150 PRINT"this line has a trailing bang comment"!comment 48 | 160 PRINT"this line has a trailing quote comment"'comment 49 | 170 PRINT"this line has a trailing REM comment":REM comment 50 | 184 REM 51 | 185 REM making a 2x2 array and then printing it out 52 | 186 REM 53 | 200 DIM A(2,2) 54 | 210 A(1,1)=1:A(1,2)=2:A(2,1)=3:A(2,2)=4 55 | 220 PRINT"Array 1 to 4: "A(1,1),A(1,2),A(2,1),A(2,2) 56 | 300 REM 57 | 305 REM test fix, int, round, etc 58 | 310 REM 59 | 315 PRINT "PI should return 3.14... "PI 60 | 320 PRINT "INT(4.5) should return 4 "INT(4.5) 61 | 325 PRINT "INT(-4.5) should return -5 "INT(-4.5) 62 | 330 PRINT "FIX(-4.5) should return -4 "FIX(-4.5) 63 | 335 PRINT "FRAC(-4.5) should return -0.5 "FRAC(-4.5) 64 | 340 PRINT "ROUND(1.2345) should return 1 "ROUND(1.2345) 65 | 345 PRINT "ROUND(1.2345,3) should return 1.235 "ROUND(1.2345,3) 66 | 350 PRINT "7.5 MOD 2.5 should return 0 ";7.5 MOD 2.5 67 | 355 PRINT "7.5 MOD 3.5 should return 0.5 ";7.5 MOD 3.5 68 | 360 PRINT "MOD(7.5,3.5) should return 0.5 ";MOD(7.5,3.5) 69 | 365 PRINT "7 DIV 2 should return 3 ";7 DIV 2 70 | 370 PRINT "DIV(7,2) should return 3 ";DIV(7,2) 71 | 494 REM 72 | 495 REM make a simple function that returns itself 73 | 496 REM 74 | 500 DEF FNA(X)=X 75 | 520 print "Calling function A with const 20, should return 20: "FNA(20) 76 | 525 print "Setting variable X to 10" 77 | 530 X=10 78 | 540 print "Calling function A with var X=10, should return 10: "FNA(X) 79 | 550 print "After calling function, X is"X 80 | 594 REM 81 | 595 REM make a function with some actual math 82 | 596 REM 83 | 600 DEF FNB(X)=X+5 84 | 620 print "Calling function B with 20 const, should return 25: "FNB(20) 85 | 630 print "Value of X after B is "X 86 | 694 REM 87 | 695 REM not sure why this is here 88 | 696 REM 89 | 700 PRINT:PRINT:PRINT:PRINT"three blank lines above" 90 | 1094 REM 91 | 1095 REM do some string manipulation using string functions 92 | 1096 REM 93 | 1099 PRINT "string manipulation on HELLO WORLD" 94 | 1100 A$="HELLO WORLD" 95 | 1200 PRINT A$, "len="len(A$) 96 | 1300 PRINT "left 5, should produce HELLO: "LEFT$(A$,5) 97 | 1400 PRINT "right 5, should produce WORLD: "right$(A$,5) 98 | 1500 PRINT "mid 5, should produce O WORLD: "mid$(A$,5) 99 | 1600 PRINT "mid 4,5, should produce LO WO: "mid$(A$,4,5) 100 | 1610 PRINT "mid 20,5, should produce nothing: "mid$(A$,20,5) 101 | 1620 PRINT "right 100, should produce HELLO WORLD: "right$(A$,100) 102 | 1630 PRINT "left 100, should produce HELLO WORLD: "left$(A$,100) 103 | 1640 PRINT "mid 100,100 should produce nothing: "mid$(A$,100,100) 104 | 1640 PRINT "mid 5,100 should produce O WORLD: "mid$(A$,5,100) 105 | 1650 PRINT "seg 4,5, should produce LO: "seg$(A$,4,5) 106 | 1660 PRINT "substr 4,5, should produce LO WO: "substr$(A$,4,5) 107 | 1660 PRINT "substring 4,5, should produce LO WO: "substring$(A$,4,5) 108 | 1700 REM 109 | 1710 REM do some string manipulation using ANSI slices 110 | 1720 REM 111 | 1730 PRINT "string slicing on HELLO WORLD" 112 | 1740 PRINT A$, "len="len(A$) 113 | 1750 PRINT "(1:5), should produce HELLO: "A$(1:5) 114 | 1760 PRINT "(4:5), should produce LO: "A$(4:5) 115 | 1760 PRINT "(4 TO 5), should produce LO: "A$(4 TO 5) 116 | 1770 REM 117 | 1771 REM assign string into a slice 118 | 1772 REM 119 | 1780 A$="HELLO WORLD" 120 | 1790 A$(1:4)="GOOD" 121 | 1791 PRINT "assigned into a slice, should produce GOODO WORLD: "A$ 122 | 1800 REM 123 | 1801 REM concats 124 | 1802 REM 125 | 1810 PRINT "concat with plus, should produce HELLO WORLD: ";"HELLO" + " " + "WORLD" 126 | 1820 PRINT "concat with amp, should produce HELLO WORLD: ";"HELLO" & " " & "WORLD" 127 | 1830 PRINT "multi-concat, should produce 1 2 3 4: ";"1" & " " & "2" & " " & "3" & " " & "4" 128 | 1840 REM 129 | 1841 REM test upper and lower conversions 130 | 1842 REM 131 | 1850 PRINT"HelLO to upper, should produce HELLO: ";UCASE$("HelLO") 132 | 1860 PRINT"WORld to lower, should produce world: ";LCASE$("WORld") 133 | 1870 REM 134 | 1871 REM try CHANGING strings to nums and back 135 | 1872 REM 136 | 1880 DIM B(50) 137 | 1881 PRINT "changing hello to ASCII, should produce 5 104 101 108 108 111: "; 138 | 1882 B$="hello" 139 | 1883 CONVERT B$ TO B 140 | 1884 FOR J=0 TO B(0):PRINT B(J),:NEXT J:PRINT 141 | 1885 REM the line above only works on strings because CHANGE puts the length in (0) 142 | 1890 PRINT "changing from ASCII back to string, should produce hello: "; 143 | 1891 CHANGE B TO B$ 144 | 1892 PRINT B$ 145 | 1900 REM 146 | 1901 REM some new string commands 147 | 1002 REM 148 | 1910 PRINT "using SPACE$, should print three spaces and HELLO: ";SPACE$(3);"HELLO" 149 | 1920 PRINT "using STRING$, should print HELLO three times: ";STRING$(3,"HELLO") 150 | 1922 X$="HELLO" 151 | 1925 PRINT "using STRING$ with variable, should print HELLO three times: ";STRING$(3,X$) 152 | 1930 PRINT "using STRING$ with ASCII value, should print three X's: ";STRING$(3,88) 153 | 1940 PRINT "using INSTR to find ELL in HELLO, should print 2: ";INSTR("HELLO","ELL") 154 | 1950 PRINT "using INSTR to find JEL in HELLO, should print 0: ";INSTR("HELLO","JEL") 155 | 1960 PRINT "using INSTR to find ELL in HELLO starting at 2, should print 0: ";INSTR("HELLO","JEL",2) 156 | 1970 PRINT "using POS to find ELL in HELLO, should print 2: ";POS("HELLO","ELL") 157 | 1980 PRINT "using INDEX to find ELL in HELLO, should print 2: ";INDEX("HELLO","ELL") 158 | 1985 PRINT "using POS with single parameter, should print cursor position: ";POS(0) 159 | 1985 PRINT "using POS with no parameter, should print cursor position: ";POS(0) 160 | 2000 REM 161 | 2001 REM bin/oct/hex conversions 162 | 2002 REM 163 | 2010 PRINT "Convert hex FFFE to number, should print 65534: ";HEX("FFFE") 164 | 2020 PRINT "Convert oct 7654 to number, should print 4012: ";OCT("7654") 165 | 2030 PRINT "Convert bin 101010 to number, should print 42: ";BIN("101010") 166 | 2040 PRINT "Convert 5432 to hex, should print 1538: ";HEX$(5432) 167 | 2050 PRINT "Convert 4321 to oct, should print 10341: ";OCT$(4321) 168 | 2060 PRINT "Convert 55 to bin, should print 110111: ";BIN$(55) 169 | 2294 REM 170 | 2295 REM make sure B and B() are different 171 | 2296 REM 172 | 2300 B=10 173 | 2400 PRINT "B, should be 10: ",B,"B(1), should be 104: ",B(1) 174 | 2500 REM 175 | 2501 REM test J vs. J(0) vs. J(1) on non-DIMed variables 176 | 2502 REM 177 | 2510 L=5:L(1)=10 178 | 2515 PRINT "L should be 5 "J 179 | 2520 PRINT "L(1) should be 10 "L(1) 180 | 2525 PRINT "L(0) should be 0 "L(0) 181 | 2530 DIM K(5) 182 | 2535 PRINT "K(5) should be 0 "K(5) 183 | 2540 PRINT "K(6) should cause error: "K(6) 184 | 2600 REM 185 | 2610 REM test that a small DIMmed array correctly errors on index > 10 186 | 2620 REM 187 | 2630 L(3)=3 188 | 2640 DIM L(5) 189 | 2650 PRINT "L(3) should be 3: "L(3) 190 | 2670 PRINT "L(6) should cause error: "L(6) 191 | 3000 REM 192 | 3010 REM time functions 193 | 3020 REM 194 | 3030 PRINT "jiffies so far: ";TIME 195 | 3040 PRINT "time so far: ";TIME$ 196 | 3050 PRINT "resetting time to 001000, 10 minutes, 36000 jiffies" 197 | 3060 TIME$="001000" 198 | 3070 PRINT "time now: ";TIME$ 199 | 3994 REM 200 | 3995 REM various prints and inputs with different separators 201 | 3996 REM 202 | 3998 LET A=2 203 | 4000 PRINT "A=2, A*10=";A*10 204 | 4100 REM 205 | 4110 REM testing inkey 206 | 4120 REM 207 | 4130 PRINT"test inkey, waiting for keypress, X to exit" 208 | 4140 I$=INKEY$ 209 | 4150 IF I$<>"" THEN PRINT "you pressed '";I$;"'" 210 | 4160 IF I$<>"X" THEN 4140 211 | 4400 input "an input prompt with comma, enter a number (1 to 3)",A 212 | 4700 input "an input prompt with semi, enter a number";B 213 | 4900 print "a is "A" b is "B 214 | 4901 REM 215 | 4902 REM use the value of A for a GOTO..OF 216 | 4903 REM 217 | 4910 GO SUB A OF 4920,4930,4940 218 | 4915 GOTO 4960 219 | 4920 PRINT"A was 1":RETURN 220 | 4930 PRINT"A was 2":RETURN 221 | 4940 PRINT"A was 3":RETURN 222 | 4950 REM 223 | 4955 REM input with three variables 224 | 4956 REM 225 | 4960 PRINT "input with a,b,c":INPUT A,B,C 226 | 4965 PRINT "inputs were: " A,B,C 227 | 4994 REM 228 | 4995 REM using the values just input, do ON GOTO 229 | 4996 REM 230 | 4997 PRINT "using ON with value A="A 231 | 5000 ON A GOTO 5010,5020,5030 232 | 5010 PRINT "A WAS 1":GOTO 5100 233 | 5020 PRINT "A WAS 2":GOTO 5100 234 | 5030 PRINT "A WAS 3":GOTO 5100 235 | 5097 REM 236 | 5098 REM TEST UBOUND AND LBOUND 237 | 5099 REM 238 | 5100 H=5:V=4 239 | 5110 DIM X(H,V) 240 | 5120 PRINT "X is 5 by 4, UBOUND should print 5: "UBOUND(X) 241 | 5130 PRINT "X is 5 by 4, UBOUND 2 should print 4: "UBOUND(X,2) 242 | 5200 REM 243 | 5201 REM test pausing 244 | 5202 REM 245 | 5210 PRINT "jiffies so far: ";TIME 246 | 5220 PRINT "pausing for 2 seconds" 247 | 5230 PAUSE 2*60 248 | 5240 PRINT "after pause: ";TIME 249 | 5300 REM 250 | 5301 REM testing exit from a loop 251 | 5302 REM 252 | 5310 PRINT "running loop 1..4 on index R, exiting when 2" 253 | 5320 FOR R=1 TO 4 254 | 5330 IF R=2 THEN EXIT 255 | 5340 NEXT 256 | 5350 PRINT "R is now: "R 257 | 6000 REM 258 | 6005 REM test CLEAR 259 | 6010 REM 260 | 6015 PRINT"testing CLEAR, R is currently "R 261 | 6020 CLEAR 262 | 6025 PRINT"after CLEARing, R is "R 263 | 6100 REM 264 | 6110 REM test ON ERROR syntax 265 | 6120 REM 266 | 6130 TRAP 6160 267 | 6140 PAUSE 120 268 | 6150 RAISE 21:PRINT " ... CONTINUED" 269 | 6155 STOP 270 | 6160 REM TRAP CATCH-UP ROUTINE 271 | 6170 PRINT ERN; ERR$(ERN()) " ERROR IN LINE" ERL() "!" 272 | 6180 RESUME NEXT 273 | 8100 REM 274 | 8101 REM test label'ed gosub 275 | 8102 REM 276 | 8110 LABEL te 277 | 8120 PRINT "successfully GOSUBed to label which had line number: "te 278 | 8130 RETURN 279 | 9000 END 280 | -------------------------------------------------------------------------------- /src/retrobasic.h: -------------------------------------------------------------------------------- 1 | /* Interpreter (header) for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | Based on gnbasic 5 | Copyright (C) 1998 James Bowman 6 | 7 | This file is part of RetroBASIC. 8 | 9 | RetroBASIC is free software; you can redistribute it and/or modify 10 | it under the terms of the GNU General Public License as published by 11 | the Free Software Foundation; either version 2, or (at your option) 12 | any later version. 13 | 14 | RetroBASIC is distributed in the hope that it will be useful, 15 | but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | GNU General Public License for more details. 18 | 19 | You should have received a copy of the GNU General Public License 20 | along with RetroBASIC; see the file COPYING. If not, write to 21 | the Free Software Foundation, 59 Temple Place - Suite 330, 22 | Boston, MA 02111-1307, USA. */ 23 | 24 | #ifndef __RETROBASIC_H__ 25 | #define __RETROBASIC_H__ 26 | 27 | #include "stdhdr.h" 28 | 29 | /** 30 | * @file retrobasic.h 31 | * @author Maury Markowitz 32 | * @brief Core interpreter code 33 | * 34 | * This is the core of the RetroBASIC interpreter. It performs all of the 35 | * underlying BASIC functionality including parsing the original file using 36 | * lex/yacc, cleaning up the resulting tokenized code, and then running it. 37 | */ 38 | 39 | /** retrobasic allows line numbers up to FF */ 40 | #define MAX_LINE_NUMBER 65535 41 | 42 | /** defines the maximum length of an input/print */ 43 | #define MAX_INPUT_LENGTH 132 44 | 45 | /** various internal state variables used for I/O and other tasks */ 46 | extern bool run_program; // default to running the program, not just parsing it 47 | extern bool print_stats; // when the program finishes running, should we print statistics? 48 | extern bool write_stats; // ... or write them to a file? 49 | 50 | extern int tab_columns; // based on PET BASIC, which is a good enough target 51 | extern bool trace_lines; 52 | extern bool upper_case; // force INPUT to upper case 53 | extern int array_base; // lower bound of arrays, can also be set to 0 with OPTION BASE 54 | extern bool string_slicing; // are references like A$(1,1) referring to an array entry or doing slicing? 55 | extern bool goto_next_highest; // if a branch targets a non-existent line, should we go to the next line? 56 | extern bool ansi_on_boundaries; // if the value for an ON statement <1 or >num entries, should it continue, or error? 57 | extern bool ansi_tab_behaviour; // if a TAB < current column, ANSI inserts a CR, MS does not 58 | extern int random_seed; // reset with RANDOMIZE, if -1 then auto-seeds 59 | 60 | extern char *source_file; 61 | extern char *input_file; 62 | extern char *print_file; 63 | extern char *stats_file; 64 | 65 | extern double determinant; 66 | 67 | /** variable **references** 68 | * variable_reference_t is used to record a reference to a variable in the code, 69 | * not it's value. So this might be A or A$ or A(1,2). The actual value is held 70 | * in a variable_value_t in the variable_values list of the interpreter_state. 71 | */ 72 | typedef struct { 73 | char *name; 74 | list_t *subscripts; // subscripts, list of expressions 75 | list_t *slicing; // up to two expressions holding string slicing limits 76 | } variable_reference_t; 77 | 78 | /** either_t is used within variable_value_t for the actual data */ 79 | /* note, it seems we could simply use value_t for these, this saves four bytes */ 80 | typedef union { 81 | char *string; 82 | double number; 83 | } either_t; 84 | 85 | /* value_t is used to store (and process) the results of an evaluation */ 86 | typedef struct { 87 | int type; /* NUMBER, STRING */ 88 | char *string; 89 | double number; 90 | } value_t; 91 | 92 | /** variable_storage_t holds the *value* of a variable in memory */ 93 | typedef struct { 94 | int type; // NUMBER, STRING 95 | list_t *actual_dimensions; // actual dimensions, even if auto-DIMmed 96 | list_t *dimed_dimensions; // subscript definitions, if any (from a DIM) 97 | either_t *value; // actual value(s), malloced 98 | either_t *array; // actual value(s), malloced 99 | } variable_storage_t; 100 | 101 | /** expression types */ 102 | typedef enum { 103 | number, string, variable, op, fn 104 | } expression_type_t; 105 | 106 | /** expression_struct holds the structure of a single expression in BASIC */ 107 | typedef struct expression_struct { 108 | expression_type_t type; 109 | union { 110 | double number; // if it's a constant 111 | char *string; // or a string constant 112 | variable_reference_t *variable; // also used for user-defined function names and parameters 113 | struct { 114 | int arity; 115 | int opcode; 116 | struct expression_struct *p[3]; // arity can be up to 3 in BASIC 117 | } op; 118 | } parms; 119 | } expression_t; 120 | 121 | /** printitem_t holds a print list, which are different from other lists in 122 | * BASIC because they have three possible separators, nulls, commas and semis. 123 | * most just use the comma. 124 | */ 125 | typedef struct { 126 | expression_t *expression; 127 | int separator; /* ';' ',' or 0 */ 128 | } printitem_t; 129 | 130 | /** every statement in the program gets a statement_t entry. the most 131 | * basic forms are simply a type, which contains the token value. Other 132 | * statements can store additional parameters in the params union. 133 | */ 134 | typedef struct statement_struct { 135 | int type; // the enum for this is in parse.h 136 | union { 137 | struct { 138 | variable_reference_t *generic_variable; 139 | expression_t *generic_parameter, *generic_parameter2, *generic_parameter3; 140 | } generic; 141 | struct { 142 | variable_reference_t *var1; 143 | variable_reference_t *var2; 144 | } change; 145 | list_t *data; // list of values for data statements 146 | struct { 147 | variable_reference_t *signature; 148 | expression_t *formula; 149 | } def; 150 | struct { 151 | list_t *vars; 152 | int type; 153 | } deftype; // used in DEFINT etc. 154 | list_t *dim; // list of variable definitions 155 | struct { 156 | variable_reference_t *variable; 157 | expression_t *begin, *end, *step; 158 | } _for; 159 | expression_t *gosub; 160 | expression_t *_goto; 161 | struct { 162 | expression_t *condition; 163 | list_t *then_expression; 164 | int then_linenumber; // implicit goto case 165 | } _if; 166 | list_t *input; 167 | struct { 168 | variable_reference_t *variable; 169 | int linenumber; 170 | } label; 171 | struct { 172 | variable_reference_t *variable; 173 | expression_t *expression; 174 | } let; 175 | struct { 176 | variable_reference_t *variable; // the variable on the LHS 177 | variable_reference_t *variable2; // ... and RHS 178 | variable_reference_t *variable3; // ... and other RHS 179 | expression_t *expression; // used in multiplication 180 | } mat; 181 | struct { 182 | int type; /* GOTO or GOSUB */ 183 | expression_t *expression; 184 | list_t *numbers; 185 | } on; 186 | list_t *next; 187 | struct { 188 | expression_t *channel; 189 | expression_t *format; 190 | list_t *item_list; 191 | } print; 192 | list_t *read; 193 | char *rem; 194 | // struct { 195 | // list_t *numbers; 196 | // } _sys; 197 | } parms; 198 | } statement_t; 199 | 200 | /* runtime stacks */ 201 | /* used for tracking GOSUB, FOR/NEXT, etc. It is not clear that there needs to 202 | be two separate types here, as this might making popping a FOR from an early 203 | RETURN more difficult? 204 | */ 205 | typedef enum { 206 | for_entry, gosub_entry 207 | } stack_entry_type_e; 208 | 209 | typedef struct { 210 | stack_entry_type_e type; 211 | union { 212 | struct { 213 | list_t *head, *tail; 214 | variable_reference_t *index_variable; 215 | double begin, end, step; 216 | } _for; 217 | struct { 218 | list_t *returnpoint; 219 | } gosub; 220 | }; 221 | } stack_entry_t; 222 | 223 | /* this is the main state for the interpreter, largely consisting of the lines of 224 | code, a pointer to the first line for easy lookup, a pointer to the current 225 | statement, a list of variables and their values, and the runtime stack for 226 | GOSUB and FOR/NEXT. Other bits include the list of user functions, TRAP lines 227 | and the current error code, the cursor column, etc. */ 228 | typedef struct { 229 | list_t *lines[MAX_LINE_NUMBER]; // the lines in the program, stored as an array of statement lists 230 | int first_line; // index of the first line in the lines array, often 10 231 | list_t *current_statement; // currently executing statement 232 | list_t *next_statement; // next statement to run, might change for GOTO and such 233 | list_t *current_data_statement; // current 'DATA' statement 234 | list_t *current_data_element; // current 'DATA' expression within current_data_statement 235 | list_t *variable_values; // name/value pairs used to store variable values 236 | list_t *functions; // name/expression pairs for user-defined functions 237 | list_t *runtime_stack; // stack of FOR and GOSUB statements 238 | int error_num; // the last error, 0 if no error or reset 239 | int error_line; // line number where an error occurred, -1 for none 240 | list_t *error_statement; // statement where the error occurred, so RESUME can continue properly 241 | int trap_line; // line to TRAP or ON ERROR to, -1 for none 242 | int cursor_column; // current column of the output cursor 243 | int running_state; // is the program running (1), paused/stopped (0), or setting up a function (-1) 244 | } interpreterstate_t; 245 | 246 | /* and here's the link to an instance of interpreterstate_t defined in the c side */ 247 | extern interpreterstate_t interpreter_state; 248 | 249 | /* the only piece of the interpreter the parser needs to know about is the variable table */ 250 | void insert_variable(const variable_reference_t *variable); 251 | 252 | /* these are needed in the matrix functions */ 253 | int variable_type(const variable_reference_t *variable); 254 | value_t evaluate_expression(const expression_t *expression); 255 | 256 | /* called by main to set up the interpreter state */ 257 | void interpreter_setup(void); 258 | 259 | /* perform post-parse setup */ 260 | void interpreter_post_parse(void); 261 | 262 | /* the interpreter entry point */ 263 | void interpreter_run(void); 264 | 265 | #endif 266 | -------------------------------------------------------------------------------- /src/io.c: -------------------------------------------------------------------------------- 1 | /* io (implementation) for RetroBASIC 2 | Copyright (C) 2024 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #include "io.h" 22 | 23 | #include "errors.h" // we do error reporting in this module 24 | #include // various unix file utilities 25 | 26 | #ifdef WIN32 27 | #include 28 | #define F_OK 0 29 | #define access _access 30 | #endif 31 | 32 | #define MAX_OPEN_FILES 16 //!< the maximum number of files that can be open at once 33 | #define MAX_FILE_NUM 256 //!< the maximum file handle number 34 | FILE* file_handle_map[MAX_FILE_NUM]; //!< maps the file numbers to C handles 35 | char file_name_map[MAX_FILE_NUM][PATH_MAX]; //!< maps the file numbers to C handles 36 | 37 | /* 38 | * Returns the file pointer for a given channel. 39 | */ 40 | FILE* handle_for_channel(int channel) 41 | { 42 | if (channel < 0 || channel >= MAX_FILE_NUM) { 43 | handle_error(ern_BAD_SUBSCRIPT, "Attempt to use a file channel that is outside the allowed range"); 44 | return NULL; 45 | } 46 | return file_handle_map[channel]; 47 | } 48 | 49 | /* 50 | * Returns the path/file name for a given channel. 51 | */ 52 | char* path_for_channel(int channel) 53 | { 54 | if (channel < 1 || channel >= MAX_FILE_NUM) { 55 | handle_error(ern_BAD_SUBSCRIPT, "Attempt to use a file channel that is outside the allowed range"); 56 | return NULL; 57 | } 58 | return file_name_map[channel]; 59 | } 60 | 61 | /* 62 | * Returns whether the file can be read or written, a private method for the following public functions. 63 | */ 64 | bool test_channel(int channel, int how) 65 | { 66 | if (channel < 1 || channel >= MAX_FILE_NUM) { 67 | handle_error(ern_BAD_SUBSCRIPT, "Attempt to use a file channel that is outside the allowed range"); 68 | return false; 69 | } 70 | 71 | // test that we can get to that file, which should never fail because we tested it on open 72 | char *path = path_for_channel(channel); 73 | char temp_path[PATH_MAX]; 74 | if (realpath(path, temp_path) == NULL) 75 | return false; 76 | 77 | // now test it 78 | if (access(temp_path, how) == 0) 79 | return true; 80 | else 81 | return false; 82 | } 83 | 84 | /* 85 | * Returns if the file is readable for a given channel. 86 | */ 87 | bool channel_is_readable(int channel) 88 | { 89 | return test_channel(channel, R_OK); 90 | } 91 | 92 | /* 93 | * Returns if the file is writable for a given channel. 94 | */ 95 | bool channel_is_writable(int channel) 96 | { 97 | return test_channel(channel, W_OK); 98 | } 99 | 100 | /* 101 | * Tests whether a file or directory exists. 102 | */ 103 | int exists(const char *path) 104 | { 105 | struct stat buffer; 106 | return (stat(path, &buffer) == 0); 107 | } 108 | 109 | /* 110 | * Extracts the path from the filename, if it exists, 111 | * and expands it to the full path. 112 | */ 113 | bool extract_path(const char *input, char *path, char *file) { 114 | char temp_path[PATH_MAX]; 115 | const char *last_slash = strrchr(input, '/'); 116 | 117 | if (last_slash) { 118 | strncpy(temp_path, input, last_slash - input); 119 | temp_path[last_slash - input] = '\0'; // null-terminate 120 | strcpy(file, last_slash + 1); // copy the rest of the name into file 121 | } else { 122 | strcpy(temp_path, "."); // use the current directory 123 | strcpy(file, input); // the input is just the file name 124 | } 125 | 126 | // resolve the absolute path 127 | if (realpath(temp_path, path) == NULL) 128 | return false; 129 | else 130 | return true; 131 | } 132 | /* 133 | * Closes any open files and resets the file list to empty. 134 | */ 135 | void close_all_files(void) 136 | { 137 | for (int i = 0; i < MAX_FILE_NUM; i++) { 138 | if (file_handle_map[i] != 0) { 139 | fclose(file_handle_map[i]); 140 | file_handle_map[i] = 0; 141 | file_name_map[i][0] = '\0'; 142 | } 143 | } 144 | } 145 | 146 | /* 147 | * Tests that the path and name are valid, and attempts to 148 | * open the file. If it is successfully opened, it is recorded 149 | * in the file_handle_map and the number of open files is ++ed. 150 | */ 151 | bool open_file(const int channel, const char *name, const char *mode) 152 | { 153 | // see if this channel is already being used 154 | if (file_handle_map[channel] != 0) { 155 | handle_error(ern_FILE_OPEN, "Attempt to open a file in a channel that is already open"); 156 | return false; 157 | } 158 | 159 | // don't allow too many files to be open 160 | int num_open = 0; 161 | for (int i = 0; i < MAX_FILE_NUM; i++) { 162 | if (file_handle_map[i] != 0) 163 | num_open++; 164 | } 165 | if (num_open >= MAX_OPEN_FILES) { 166 | handle_error(ern_TOO_MANY_FILES, "Attempt to open a file with too many files already open"); 167 | return false; 168 | } 169 | 170 | // pull the name apart 171 | char path[PATH_MAX], file[PATH_MAX]; 172 | extract_path(name, path, file); 173 | 174 | // see if there is a path, if so, see if it exists 175 | // - it is OK to have no path, this means to use the working directory 176 | if (strlen(path) > 0) { 177 | if (!exists(path)) { 178 | handle_error(ern_DEV_NOT_FOUND, "Attempt to open a file with an invalid path"); 179 | return false; 180 | } 181 | } 182 | 183 | // and check the file as well 184 | if (strlen(file) == 0) { 185 | handle_error(ern_FILENAME_MISSING, "Attempt to open a file with no file name"); 186 | return false; 187 | } 188 | 189 | // if all of that is valid, check the file list to see if it's open 190 | for (int i = 0; i < MAX_FILE_NUM; i++) { 191 | if (strcmp(file_name_map[i], file) == 0) { 192 | handle_error(ern_FILE_OPEN, "Attempt to open a file that is already open"); 193 | return false; 194 | } 195 | } 196 | 197 | // force the mode to lower, which Unix demands 198 | char lmode[2]; 199 | lmode[0] = tolower(mode[0]); 200 | lmode[1] = '\0'; 201 | 202 | // if the mode is "r"ead or "a"ppent, the file needs to exist already 203 | if (lmode[0] == 'r' || lmode[0] == 'a') { 204 | if (!exists(name)) { 205 | handle_error(ern_FILE_NOT_FOUND, "Attempt to open a file for read or append but it does not exist"); 206 | return false; 207 | } 208 | } 209 | 210 | // if the mode is "n"ew, the file *cannot* already exist 211 | if (lmode[0] == 'n' && exists(name)) { 212 | handle_error(ern_FILE_EXISTS, "Attempt to open a file for write but it already exists"); 213 | return false; 214 | } 215 | 216 | // "n"ew is the same as "w"rite from C's perspective 217 | if (lmode[0] == 'n') 218 | lmode[0] = 'w'; 219 | 220 | // all the inputs are valid, try to open the file 221 | FILE* fp = fopen(name, lmode); 222 | if (fp == NULL) { 223 | handle_error(ern_FILE_OPEN, "Attempt to open a file failed for unknown reason"); 224 | return false; 225 | } 226 | 227 | // is it now open, so record it 228 | file_handle_map[channel] = fp; 229 | strcpy(file_name_map[channel], name); 230 | 231 | return true; 232 | } 233 | 234 | /* 235 | * Tests that the channel is open, errors otherwise. 236 | */ 237 | bool close_file(const int channel) 238 | { 239 | FILE* fp = file_handle_map[channel]; 240 | if (fp == 0) { 241 | handle_error(ern_FILE_NOT_OPEN, "Attempt to close a file that is not open"); 242 | return false; 243 | } 244 | 245 | // it is open, so flush it, close it, and forget it 246 | fflush(fp); 247 | int c = fclose(fp); 248 | if (c == EOF) { 249 | handle_error(ern_FILE_NOT_OPEN, "Attempt to close a file that is not open"); 250 | return false; 251 | } 252 | 253 | file_handle_map[channel] = 0; 254 | file_name_map[channel][0] = '\0'; 255 | return true; 256 | } 257 | 258 | /* 259 | * Tests that the file is not open and then attempts to create it. 260 | */ 261 | bool create_file(const char *file) 262 | { 263 | // see if the file is open 264 | for (int i = 0; i < MAX_FILE_NUM; i++) { 265 | if (strcmp(file_name_map[i], file) == 0) { 266 | handle_error(ern_FILE_OPEN, "Attempt to create a file that is open"); 267 | return false; 268 | } 269 | } 270 | 271 | // see if it exists 272 | if (access(file, F_OK) == 0) { 273 | handle_error(ern_FILE_NOT_FOUND, "Attempt to create file failed because it already exists"); 274 | return false; 275 | } 276 | 277 | // create it if we can 278 | FILE* fp = fopen("textFile.txt" ,"a"); 279 | if (fp == NULL) { 280 | handle_error(ern_FILE_NOT_FOUND, "Attempt to create file failed for unknown reason"); 281 | return false; 282 | } 283 | 284 | fclose(fp); 285 | return true; 286 | } 287 | 288 | /* 289 | * Tests that the file is not open and then attempts to delete it. 290 | */ 291 | bool delete_file(const char *file) 292 | { 293 | // see if the file is open 294 | for (int i = 0; i < MAX_FILE_NUM; i++) { 295 | if (strcmp(file_name_map[i], file) == 0) { 296 | handle_error(ern_FILE_OPEN, "Attempt to delete a file that is open"); 297 | return false; 298 | } 299 | } 300 | 301 | // see if it exists 302 | if (access(file, F_OK) == 0) { 303 | handle_error(ern_FILE_NOT_FOUND, "Attempt to delete file failed because the file doesn't exist"); 304 | return false; 305 | } 306 | 307 | // delete it if we can 308 | if (remove(file) != 0) { 309 | handle_error(ern_FILE_NOT_FOUND, "Attempt to delete file failed for unknown reason"); 310 | return false; 311 | } 312 | 313 | return true; 314 | } 315 | 316 | /* 317 | * Waits for a single character. Used for GET. 318 | */ 319 | int getbyte(void) 320 | { 321 | int ch; 322 | struct termios old_attrs, new_attrs; 323 | tcgetattr(STDIN_FILENO, &old_attrs); 324 | new_attrs = old_attrs; 325 | new_attrs.c_lflag &= ~(ICANON | ECHO); 326 | tcsetattr(STDIN_FILENO, TCSANOW, &new_attrs); 327 | system("stty -echo"); //shell out to kill echo 328 | ch = getchar(); 329 | system("stty echo"); 330 | tcsetattr(STDIN_FILENO, TCSANOW, &old_attrs); 331 | return ch; 332 | } 333 | 334 | /* 335 | * Gets a single keystroke, or null if no key is pressed. Used for INKEY$. 336 | */ 337 | int getkey(void) 338 | { 339 | #if _WIN32 340 | if (kbhit) { 341 | return getch(); 342 | } else { 343 | return 0; 344 | } 345 | #else 346 | int ch; 347 | unsigned char buf[1]; 348 | struct termios old_attrs, new_attrs; 349 | tcgetattr(STDIN_FILENO, &old_attrs); 350 | new_attrs = old_attrs; 351 | cfmakeraw(&new_attrs); 352 | new_attrs.c_cc[VMIN] = 0; 353 | new_attrs.c_cc[VTIME] = 0; 354 | new_attrs.c_lflag &= ~(ICANON | ECHO); 355 | // newt.c_cc[VMIN] = 0; 356 | tcsetattr(STDIN_FILENO, TCSANOW, &new_attrs); 357 | ch = (int)read(STDIN_FILENO, buf, 1); 358 | if (ch > 0) 359 | ch = buf[0]; 360 | tcsetattr(STDIN_FILENO, TCSANOW, &old_attrs); 361 | return ch; 362 | #endif 363 | } 364 | -------------------------------------------------------------------------------- /src/scan.l: -------------------------------------------------------------------------------- 1 | %{ 2 | /* Lexical analyser for RetroBASIC 3 | Copyright (C) 2020 Maury Markowitz 4 | 5 | Based on gnbasic 6 | Copyright (C) 1998 James Bowman 7 | 8 | This file is part of RetroBASIC. 9 | 10 | RetroBASIC is free software; you can redistribute it and/or modify 11 | it under the terms of the GNU General Public License as published by 12 | the Free Software Foundation; either version 2, or (at your option) 13 | any later version. 14 | 15 | RetroBASIC is distributed in the hope that it will be useful, 16 | but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | GNU General Public License for more details. 19 | 20 | You should have received a copy of the GNU General Public License 21 | along with RetroBASIC; see the file COPYING. If not, write to 22 | the Free Software Foundation, 59 Temple Place - Suite 330, 23 | Boston, MA 02111-1307, USA. */ 24 | 25 | /** 26 | * @file scan.l 27 | * @author Maury Markowitz 28 | * @brief lex/flex scanner 29 | * 30 | */ 31 | 32 | #include "retrobasic.h" 33 | #include "strng.h" 34 | #include "parse.h" 35 | 36 | %} 37 | 38 | %option noyywrap 39 | %option caseless 40 | %option yylineno 41 | //%option nodefault 42 | 43 | %x DATA_STATEMENT 44 | 45 | %% 46 | 47 | /* end of file */ 48 | "\032" { 49 | yyterminate(); 50 | } 51 | <> { 52 | yyterminate(); 53 | } 54 | 55 | /* statements */ 56 | /* REM statements are odd because they consist of a token and a line of text, but 57 | the rest of the line is part of the statement. If you want to keep the REM part as 58 | a separate token, this is the simplest solution. See: 59 | https://stackoverflow.com/questions/59117309/rest-of-line-in-bison/59122569#59122569 60 | */ 61 | REM.* { yylval.s = str_new(str_copy(yytext + 3, yyleng - 3)); return REM; } 62 | '.* { yylval.s = str_new(str_copy(yytext + 1, yyleng - 1)); return QUOTEREM; } // short form in MS 63 | !.* { yylval.s = str_new(str_copy(yytext + 1, yyleng - 1)); return BANGREM; } // later MS allow bang as well 64 | BYE { return BYE; } // also SYSTEM and GOODBYE 65 | CLEAR { return CLEAR; } 66 | CLR { return CLEAR; } // synonyms 67 | DEF { return DEF; } 68 | DATA { BEGIN(DATA_STATEMENT); return DATA; } 69 | DIM { return DIM; } 70 | END { return END; } 71 | FOR { return FOR; } 72 | GO" "?SUB { return GOSUB; } 73 | GO" "?TO { return GOTO; } 74 | IF { return IF; } 75 | INPUT { return INPUT; } 76 | LINPUT { return INPUT_LINE; } 77 | LINE" "?INPUT { return INPUT_LINE; } 78 | INPUT" "?LINE { return INPUT_LINE; } 79 | LET { return LET; } 80 | NEXT { return NEXT; } 81 | NEW { return NEW; } // also CLEAR (sometimes with options), ERASE and SCRATCH 82 | OF { return OF; } 83 | ON { return ON; } 84 | POKE { return POKE; } 85 | PRINT { return PRINT; } 86 | READ { return READ; } 87 | RESTORE { return RESTORE; } 88 | RETURN { return RETURN; } 89 | RUN { return RUN; } 90 | STEP { return STEP; } 91 | STOP { return STOP; } 92 | THEN { return THEN; } 93 | TO { return TO; } 94 | 95 | /* extended statements found in some versions*/ 96 | CALL { return CALL; } // used to call system functions in TI-99 and some other BASICs 97 | CLS { return CLS; } // clear screen, do not confuse with CLR or CLEAR 98 | CMD { return CMD; } // redirects output of PRINT to another device 99 | EXEC { return CALL; } // 100 | GET { return GET; } 101 | PUT { return PUT; } 102 | OPTION { return OPTION; } 103 | BASE { return BASE; } 104 | RANDOMIZE { return RANDOMIZE; } 105 | TIMER { return RANDOMIZE; } // this returns the RANDOMIZE token instead of making a new one 106 | SYS { return SYS; } // same as CALL 107 | SYSTEM { return SYS; } // same as CALL 108 | USING { return USING; } 109 | VARLIST { return VARLIST; } 110 | PAUSE { return PAUSE; } 111 | POP { return POP; } 112 | DISPOSE { return POP; } // same as POP 113 | EXIT { return EXIT; } // slightly different than pop 114 | RESUME { return RESUME; } 115 | TRAP { return TRAP; } 116 | ERROR { return ERROR; } 117 | ERR { return ERROR; } 118 | RAISE { return RAISE; } 119 | 120 | /* math functions */ 121 | ABS { return ABS; } 122 | ACS { return ACS; } 123 | ASN { return ASN; } 124 | ATN { return ATN; } 125 | COS { return COS; } 126 | COSH { return COSH; } 127 | CLOG { return CLOG; } // CLG on Honeywell Series 60 128 | CSH { return COSH; } 129 | EXP { return EXP; } 130 | FIX { return FIX; } 131 | FRAC { return FRAC; } 132 | INT { return INT; } 133 | LN { return LOG; } 134 | LOG { return LOG; } 135 | PI { return PI; } 136 | SIN { return SIN; } 137 | SINH { return SINH; } 138 | SGN { return SGN; } 139 | SQR { return SQR; } 140 | SNH { return SINH; } 141 | ROUND { return ROUND; } 142 | RND { return RND; } 143 | TAN { return TAN; } 144 | TANH { return TANH; } 145 | TNH { return TANH; } 146 | VAL { return VAL; } 147 | 148 | /* string-related functions */ 149 | ASC { return ASC; } // CODE on Sinclair due to being non-ASCII, CH on Atom (no parens) 150 | ASCII { return ASC; } // DEC version of ASC 151 | CHR\$ { return CHR; } // CHR (SOL and SWTP), CHAR (MAX-BASIC), CHAR$ (Micropolis) 152 | LEFT\$ { return LEFT; } 153 | RIGHT\$ { return RIGHT; } 154 | MID\$ { return MID; } 155 | LEN { return LEN; } 156 | STR\$ { return STR; } // also NUM$ in some dialects 157 | INSTR { return INSTR; } // also INDEX and POS 158 | INDEX { return INSTR; } // also FIND and other variations 159 | /* aliases for MID found in some versions */ 160 | SEG\$ { return MID; } 161 | SUBSTR\$ { return MID; } 162 | SUBSTRING\$ { return MID; } 163 | /* aliases for MID found in some versions */ 164 | INKEY\$ { return INKEY; } 165 | 166 | /* system functions */ 167 | ADR { return ADR; } 168 | FRE { return FRE; } 169 | TAB { return TAB; } // also a statement in Integer BASIC 170 | SPC { return SPC; } 171 | SPA { return SPC; } // from HP, same as SPC 172 | PEEK { return PEEK; } // also EXAM (North Star) and FETCH (Digital Group Opus) 173 | POS { return POS; } // COUNT in Atom 174 | USR { return USR; } 175 | LIN { return LIN; } 176 | ERL { return EL; } 177 | ERN { return ER; } 178 | ERR\$ { return ERR; } 179 | 180 | /* various operators and punctuation */ 181 | [:,;()\[\]\^=+\-*/\<\>\&] { return yytext[0]; } 182 | MOD { return MOD; } 183 | DIV { return DIV; } 184 | MAX { return MAX; } 185 | MIN { return MIN; } 186 | 187 | /* alternate form for power */ 188 | "**" { return '^'; } // FIXME: we should have a separate token for this? 189 | 190 | /* binary operators */ 191 | AND { return AND; } 192 | OR { return OR; } 193 | NOT { return NOT; } 194 | XOR { return XOR; } 195 | EQV { return EQV; } 196 | IMP { return IMP; } 197 | 198 | /* comparison operators */ 199 | \<= { return CMP_LE; } 200 | =\< { return CMP_LE; } 201 | \>= { return CMP_GE; } 202 | =\> { return CMP_GE; } 203 | \<\> { return CMP_NE; } 204 | \>\< { return CMP_NE; } 205 | # { return HASH; } // use a separate token here to preserve it in LIST 206 | 207 | /* defs added in Extended BASIC */ 208 | /* FIXME: these are actually easy to do, simply run them as DIMs so they get entered into the var list */ 209 | DEFSTR { return DEFSTR; } 210 | DEFINT { return DEFINT; } 211 | DEFSNG { return DEFSNG; } 212 | DEFDBL { return DEFDBL; } 213 | 214 | /* other string commands and functions */ 215 | CHANGE { return CHANGE; } 216 | CONVERT { return CONVERT; } 217 | UCASE\$ { return UCASE; } 218 | LCASE\$ { return LCASE; } 219 | SPACE\$ { return SPC; } // returns n spaces as a value, which is how our SPC works anyway 220 | STRING\$ { return STRNG; } // returns n copies of a given string 221 | REPEAT\$ { return STRNG; } // alternate form of STRING 222 | 223 | /* commodore-style TIME and TIME$ */ 224 | TIME\$ { return TIME_STR; } 225 | TIME { return TIME; } 226 | /* and their alternate short forms */ 227 | TI\$ { return TIME_STR; } 228 | TI { return TIME; } 229 | CLK\$ { return TIME_STR; } // from BASIC-PLUS, Univac System 9 has CLK(x) where x is numeric 230 | 231 | /* HEX, OCT and BIN conversions */ 232 | BIN { return BIN; } 233 | BIN\$ { return BINSTR; } 234 | HEX { return HEX; } 235 | HEX\$ { return HEXSTR; } 236 | OCT { return OCT; } 237 | OCT\$ { return OCTSTR; } 238 | 239 | /* array utilities */ 240 | UBOUND { return UBOUND; } 241 | LBOUND { return LBOUND; } 242 | 243 | /* line labels, procedures, etc. */ 244 | LABEL { return LABEL; } 245 | 246 | /* file handling */ 247 | OPEN { return OPEN; } 248 | CLOSE { return CLOSE; } 249 | STATUS { return STATUS; } 250 | EOF { return _EOF; } 251 | 252 | /* matrix commands and functions */ 253 | MAT { return MAT; } // assignments 254 | ZER { return MATZER; } // all-0 matrix 255 | NUL\$ { return MATNUL; } // all empty string matrix 256 | CON { return MATCON; } // all-1 matrix 257 | IDN { return MATIDN; } // identity matrix 258 | INV { return MATINV; } // invert 259 | TRN { return MATTRN; } // transpose 260 | DET { return MATDET; } // determinant 261 | 262 | NUM { return NUM; } // number of items type in a single INPUT, or VAL in Digital Group 263 | 264 | /* hex, oct and bin strings encoding numbers */ 265 | \&[0-9a-fA-F]+ { 266 | yylval.d = (double)strtol(yytext + 1, NULL, 16); 267 | return NUMBER; 268 | } 269 | 0[x|h|X|H][0-9a-fA-F]+ { 270 | yylval.d = (double)strtol(yytext + 2, NULL, 16); 271 | return NUMBER; 272 | } 273 | 0[o|O][0-7]+ { 274 | yylval.d = (double)strtol(yytext + 2, NULL, 8); 275 | return NUMBER; 276 | } 277 | 0[b|B][0-1]+ { 278 | yylval.d = (double)strtol(yytext + 2, NULL, 2); 279 | return NUMBER; 280 | } 281 | 282 | /* other numeric constants and line numbers */ 283 | [0-9]*[0-9.][0-9]*([Ee][-+]?[0-9]+)? { 284 | yylval.d = strtod(yytext, NULL); 285 | return NUMBER; 286 | } 287 | 288 | /* user defined functions */ 289 | "FN"[A-Za-z@][A-Za-z0-9_]?[\$%\!#]? { 290 | yylval.s = str_new(yytext); 291 | return FUNCTION_NAME; 292 | } 293 | 294 | /* variable references */ 295 | /* currently set to allow only one or two chars plus an optional type indicator 296 | replace the ? with a * for multi-char variables */ 297 | [A-Za-z@][A-Za-z0-9_]?[\$%\!#]? { 298 | yylval.s = str_new(yytext); 299 | return VARIABLE_NAME; 300 | } 301 | 302 | /* string constants */ 303 | \"[^"^\n]*[\"\n] { 304 | yytext[strlen(yytext) - 1] = '\0'; 305 | yylval.s = str_new(yytext + 1); 306 | return STRING; 307 | } 308 | 309 | /* preserve line ends */ 310 | [\n] { BEGIN(INITIAL); return '\n'; } 311 | 312 | /* eat other whitespace */ 313 | [ \t\r\l] { } 314 | 315 | /* DATA statements convert everything to a string */ 316 | { 317 | [^,:\n]* { 318 | // eat any leading and trailing whitespace 319 | yytext = str_trim(yytext); 320 | 321 | // and quotes 322 | yytext = str_unquote(yytext); 323 | 324 | yylval.s = str_new(yytext); 325 | return STRING; 326 | } 327 | 328 | [,] { return ','; } // triggers the exprlist syntax 329 | 330 | /* colons or line-ends end the data statement and reset the state */ 331 | [:] { BEGIN(INITIAL); return ':'; } 332 | [\n] { BEGIN(INITIAL); return '\n'; } 333 | } 334 | 335 | . printf("Bad input character '%s' at line %d\n", yytext, yylineno); 336 | 337 | %% 338 | -------------------------------------------------------------------------------- /src/list.h: -------------------------------------------------------------------------------- 1 | /* list (header) for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | /** 22 | * @file list.h 23 | * @author Maury Markowitz 24 | * @date 17 July 2022 25 | * 26 | * @title Doubly-linked lists 27 | * @brief A simple linked-list implementation and various work methods 28 | * 29 | * This code implements a doubly-linked list and various common functionality like 30 | * inserting and deleting items from the list, counting the number of items (length), 31 | * and so forth. 32 | * 33 | * The list consists of a linked series of "nodes", which are also the basic struct of 34 | * the list itself. Lists and the nodes are synonymous. A minimal valid list consists 35 | * of a single node. The empty list is NULL, not a single empty node. 36 | * 37 | * The list normally contains data via a void* pointer which the user has to allocate 38 | * as appropriate. They may also be used to store integers by casting them to void* 39 | * using the macros INT_TO_POINTER and POINTER_TO_INT. 40 | * 41 | * When traversing the list, the functions below will always check to see if the passed 42 | * node is at the start (or end) of the list and rewind to the front (or forward to the 43 | * end) as needed. This means all of these functions can be called by passing in any 44 | * valid node. In practice, however, code calling these functions would generally keep 45 | * a handle to the start of the list. This is eased by accepting the returned value from 46 | * the functions, which is normally the start of the resulting list. For instance, if 47 | * you call lst_remove_key and the item to be removed is at the front of the list, 48 | * the function will return the second item, as it is now the front after removal. 49 | * 50 | * The types and functions in this library are intended to closely mirror the API of the 51 | * GLib library. gnbasic was written using GLib to avoid recreating the wheel for common 52 | * functionality. However, installing GLib on anything other than generic *nix platforms 53 | * turned out to be more annoying that writing the code to perform these relatively 54 | * simple tasks. Over time, the API began to diverge to make certain calls more obvious. 55 | * A good example is lst_first_node, formerly lst_first, as it is not clear in the API 56 | * that this returned a node, as opposed to the data in that node, and it was possible 57 | * to cast the returned value to a void* without warning. 58 | * 59 | * gnbasic also used GTree to store sorted lists, notably for variable values. This is 60 | * instead implemented here as a list through the addition of the (optional) char* "key" 61 | * field and using lst_insert_sorted. The resulting list can then be used in a hash-like 62 | * fashion to find named items, or simply as a sorted list, ignoring the keys. More 63 | * complex keys and/or sorting based on the data itself is not currently supported. 64 | * 65 | */ 66 | 67 | #ifndef __LST_H__ 68 | #define __LST_H__ 69 | 70 | #include "stdint.h" 71 | #include "stdhdr.h" 72 | 73 | /** 74 | * List structure 75 | */ 76 | typedef struct _list { 77 | void *data; 78 | char *key; 79 | struct _list *next; 80 | struct _list *prev; 81 | } list_t; 82 | 83 | /** 84 | * Returns the previous node. 85 | * 86 | * @param list a node in the list to traverse. 87 | * @return the previous node. 88 | */ 89 | #define lst_previous(list) ((list) ? (((list_t *)(list))->prev) : NULL) 90 | 91 | /** Returns the next node. 92 | * 93 | * @param list a node in the list to traverse. 94 | * @return the next node. 95 | */ 96 | #define lst_next(list) ((list) ? (((list_t *)(list))->next) : NULL) 97 | 98 | /** Stores an (int) in the data field in place of a pointer. 99 | * 100 | * @param value the int value to store in a node. 101 | */ 102 | #define INT_TO_POINTER(value) ((void*)(intptr_t)(value)) 103 | 104 | /** Retrieves an (int) from the data field. 105 | * 106 | * @param data the data field of a node. 107 | */ 108 | #define POINTER_TO_INT(data) ((int)(intptr_t)(data)) 109 | 110 | /** 111 | * Removes all nodes from a list. It is up to the user to free the items within. 112 | */ 113 | void lst_free(list_t *List); 114 | 115 | /** 116 | * Removes all nodes from a list and the user data within. Needs to be used 117 | * with caution, if the lists have been copied, reversed or concated, bad 118 | * things will happen. 119 | */ 120 | void lst_free_everything(list_t *list); 121 | 122 | /** 123 | * @brief Copies items in @p list to a new list. 124 | * 125 | * @param list The list to copy. 126 | * @return The resulting new list. 127 | * 128 | * lst_copy makes a shallow copy of the original list, creating new nodes 129 | * but not duplicating the original user data. This means that freeing objects 130 | * from either list will cause the other to contain invalid pointers. It is up 131 | * to the user to manage the malloc/free of the underlying data. 132 | */ 133 | list_t* lst_copy(list_t *list); 134 | 135 | /** 136 | * Concatenates two lists. 137 | * 138 | * @param first_list the list to insert into 139 | * @param second_list the list to add to the end of the first 140 | * @return resulting longer @p first_list 141 | */ 142 | list_t* lst_concat(list_t *first_list, list_t *second_list); 143 | 144 | /** 145 | * @brief Returns the number of items in @p list. 146 | * 147 | * @param list The list to count. 148 | * @return The length of the list. 149 | */ 150 | int lst_length(list_t *list); 151 | 152 | /** 153 | * Returns the first node. 154 | * 155 | * @param list the list to search 156 | * @return the first item in the list or NULL if it was empty 157 | */ 158 | list_t* lst_first_node(list_t *list); 159 | 160 | /** 161 | * Returns the last node. 162 | * 163 | * @param list the list to search 164 | * @return the last item in the list or NULL if it was empty 165 | */ 166 | list_t* lst_last_node(list_t *list); 167 | 168 | /** 169 | * Returns the list node for a given @p data item (pointer). 170 | * 171 | * @param list the list to search 172 | * @param data the pointer to the data to find 173 | * @return the node for the item, or NULL if it was empty or not found 174 | */ 175 | list_t* lst_node_with_data(list_t *list, void* data); 176 | 177 | /** 178 | * Returns the node at a given @p index. 179 | * 180 | * @param list the list to search 181 | * @param index the number of the item to return 182 | * @return the node at the given index, or NULL if it was empty or past the end 183 | */ 184 | list_t* lst_node_at(list_t *list, int index); 185 | 186 | /** 187 | * Returns the data for the node at a given @p index. 188 | * 189 | * @param list the list to search 190 | * @param index the number of the item to return 191 | * @return the node at the given index, or NULL if it was empty or past the end 192 | */ 193 | void* lst_data_at(list_t *list, int index); 194 | 195 | /** 196 | * Returns the node with the given @p key. 197 | * 198 | * @param list the list to search 199 | * @param key the number of the item to return 200 | * @return the node with a given key, or NULL if it was empty or not found 201 | */ 202 | list_t* lst_node_with_key(list_t *list, const char *key); 203 | 204 | /** 205 | * Returns the data for the node with the given @p key. 206 | * 207 | * @param list the list to search 208 | * @param key the number of the item to return 209 | * @return the node with a given key, or NULL if it was empty or not found 210 | */ 211 | void* lst_data_with_key(list_t *list, const char *key); 212 | 213 | /** 214 | * @brief Returns the index of @p node in @p list. 215 | * 216 | * @param list The list to search. 217 | * @param node The list node to search for. 218 | * @return The index of the item or NULL if it is not found. 219 | */ 220 | int lst_index_of_node(list_t *list, list_t *node); 221 | 222 | /** 223 | * @brief Returns the index of the node holding @p data in @p list. 224 | * 225 | * @param list The list to search. 226 | * @param data The item to search for. 227 | * @return The index of the item or NULL if it is not found. 228 | */ 229 | int lst_index_of_data(list_t *list, void *data); 230 | 231 | /** 232 | * Calls a user function on each value in the list. 233 | * 234 | * @param list the list to use 235 | * @param function a function pointer to call 236 | * @param result a pointer to any data the function might return 237 | * @return the original list 238 | */ 239 | list_t* lst_foreach(list_t *list, void (*function)(void *key, void *data, void *user_data), void *user_data); 240 | 241 | /** 242 | * Appends a value to the end of the List. 243 | * 244 | * @param list the list to append onto 245 | * @param data pointer to the object to store in the list 246 | * @return @p data if it was inserted, NULL otherwise 247 | */ 248 | list_t* lst_append(list_t *list, void *data); 249 | 250 | /** 251 | * Prepends a value at the front of the List. 252 | * 253 | * @param list the list to prepend onto 254 | * @param data pointer to the object to store in the list 255 | * @return @p data if it was inserted, NULL otherwise 256 | */ 257 | list_t* lst_prepend(list_t *list, void *data); 258 | 259 | /** 260 | * Inserts a value at a given index location in a List. 261 | * 262 | * @p index zero means "front of list" while any negative value inserts 263 | * at the end. An empty list will always be inserted at the start regardless 264 | * of the value. 265 | * 266 | * @param list the list to insert into 267 | * @param data pointer to the object to store in the list or NULL if it failed 268 | * @param index the location to insert at 269 | * @return pointer to @p data if it was inserted, NULL otherwise 270 | */ 271 | list_t* lst_insert_at_index(list_t *list, void *data, int index); 272 | 273 | /** 274 | * Inserts a value at the correct sorted location given a string key. 275 | * 276 | * @param list the list to insert into 277 | * @param key a string to use to position the object in the list 278 | * @param data pointer to the object to store in the list or NULL if it failed 279 | * @return pointer to @p data if it was inserted, NULL otherwise 280 | */ 281 | list_t* lst_insert_with_key_sorted(list_t *list, void *data, char *key); 282 | 283 | /** 284 | * @brief Removes @p data from @p list and returns resulting @p list. 285 | * 286 | * @param list The list to remove from. 287 | * @param data A pointer to user data to be removed. 288 | * @return A pointer to user data. 289 | */ 290 | list_t* lst_remove_node_with_data(list_t *list, void *data); 291 | 292 | /** 293 | * Removes and frees the node at the given index. The user data is returned and *not* freed. 294 | * 295 | * @param list the list to insert into 296 | * @param index the location to insert at 297 | * @return the resulting list 298 | */ 299 | void* lst_remove_node_at_index(list_t *list, int index); 300 | 301 | /** 302 | * Removes and frees the node with the given key. The user data is returned and *not* freed. 303 | * 304 | * @param list the list to insert into 305 | * @param key the key to search for 306 | * @return the resulting list 307 | */ 308 | void* lst_remove_node_with_key(list_t *list, char *key); 309 | 310 | /** 311 | * Adds the value to the front of the list (alias for prepend). 312 | * 313 | * @param list the list to insert into 314 | * @param data the data to push 315 | * @return pointer to @p data if it was pushed, NULL otherwise 316 | */ 317 | list_t* lst_push(list_t *list, void *data); 318 | 319 | /** 320 | * Removes and frees the first node in the list, returning the associated data. 321 | */ 322 | void* lst_pop(list_t *list); 323 | 324 | #endif /* list_h */ 325 | -------------------------------------------------------------------------------- /doc/RetroBASIC design.md: -------------------------------------------------------------------------------- 1 | RetroBASIC design notes 2 | ======================= 3 | 4 | **Copyright © 2020 Maury Markowitz** 5 | 6 | [![GPL license](http://img.shields.io/badge/license-GPL-brightgreen.svg)](https://opensource.org/licenses/gpl-license) 7 | 8 | ## Introduction 9 | 10 | This document explains some of the design goals, coding decisions and style selections used in RetroBASIC. 11 | 12 | ## Feature creep at its finest 13 | 14 | RetroBASIC started in 2020 as a project to collect statistics from classic BASIC programs in an effort to find ways to improve the notoriously slow Atari BASIC. The goal was to find changes that would offer the most significant improvements for the least amount of changes to the original code. For this I needed useful statistics on what sorts of things programs of the era actually did. 15 | 16 | Initially this led to some regex-like work in Python, but it quickly became clear that the complexity of the code was daunting. For instance, one of the statistics that I wanted to collect was the number and distribution of numeric constants in a typical program. These took up lots of memory in Atari BASIC and I felt that there were possible savings here. But it was also important to know the difference between constants and line numbers, like in GOTOs, and the distribution of each. When one considers all of the places constants appear - in formulas, array indexes, line numbers, etc. - separating out the cases became annoying. 17 | 18 | So I decided the best solution was to use an actual BASIC interpreter and collect statistics from the tokenized code. Desiring a solution that would run on practically any system with a minimum of external software, I went with lex/yacc, as it has existed for decades and is available everywhere. While it is no longer as widely used as it once was, there's lots of example code out there and still a lot of experience available to help on the 'net. 19 | 20 | Poking about led to an existing yacc-based, GPL-licensed BASIC, gnbasic by James Bowman. The only version I could find, version 0.0.1, was released in 2001. I was able to get it up and running on both the Mac and PC (using Cygwin). It proved to have a number of bugs, some quite subtle like the way it handled a "failed" IF statement, but I was able to track these down and do some serious code cleanup at the same time. After that, it was a matter of fleshing out missing features and adding a selection of statistics output. 21 | 22 | gnbasic made use of the excellent GLib code to provide some common string handling functions and support for lists and trees. Normally I would have loved to let someone else handle these bits of code. But using GLib on anything other than "real Unix" turned out to be more annoying than I would have imagined; on the Mac, for instance, the library was found in different locations depending on the processor model. I eventually decided to rewrite those tiny bits of the GLib code that were being used, producing the str\_ and lst\_ library functions. 23 | 24 | Once the system was up and running, it was expanded with features from non-MS BASIC dialects. This allows it to run unmodified code from a variety of early BASICs that would otherwise require inter-dialect conversion. 25 | 26 | ## The three BASIC families 27 | 28 | Today we think of "classic BASIC" as synonymous with MS BASIC, which was the standard on tens of millions of home computers. But as I read manuals from other platforms, three distinct families of BASIC became obvious and it turns out MS was a late-comer to the party. RetroBASIC's purpose to run early programs in MS-style was expanded to include those variations wherever possible. 29 | 30 | ### Dartmouth 31 | 32 | The original BASIC is Dartmouth BASIC, released in 1964. Almost everything you can think of comes from this version, with the exception of string handling. That's because the original version only allowed string *constants*, in things like `PRINT "Hello, World!"` and such. There were no string *variables*, like `PRINT A$`, and no way to manipulate the string constants. 33 | 34 | Dartmouth released a series of updates to the original version. String variables appeared in the fourth version, in 1968, which introduced the dollar-sign string indicator. This also added a single way to manipulate string data, the `CHANGE` command, which converted a string into an array of ASCII values or vice versa. So, for instance, to concatenate two strings you would first use `CHANGE A$ TO D` and `CHANGE B$ TO E`, then loop over E and copy the values one by one into D, assuming the array D is long enough, and then finally `CHANGE D TO C$`. Yikes! 35 | 36 | Dartmouth was developed on a mainframe and they chose to implement the language as a compiler. Compilers generally require a fair amount of temporary memory, which smaller computers didn't have. Smaller machines normally used an interpreter, developed from scratch. So while versions of the Dartmouth code were found on almost all mainframes by 1970, it saw little use outside that market. Even large minis generally didn't use the Dartmouth dialect. 37 | 38 | ### HP 39 | 40 | At almost the same time that Dartmouth v4 appeared, Hewlett-Packard introduced the HP2000, a minicomputer whose primary language was BASIC. Their variation had string support using the FORTRAN-like concept of "array slicing". For instance, to extract the first five characters of a string, one would `A$ = B$(1,5)`, or to concatenate two strings, `A$(10) = B$`, which means that everything from character 10 on should be replaced by the contents of B$. This provided almost all of the needed functionality using a single syntax, which also has performance advantages (more on this below). 41 | 42 | But you can also see a problem: they used the same syntax as an array access, so there was no way to define arrays of strings. What's particularity odd about this is that HP offered an alternative syntax using square brackets, `A$[10] = B$`. Had they simply specified brackets for string slicing and parens for array access, then something like `A$(1)[1,5]` would be possible. But... they didn't. 43 | 44 | Largely lost to history today, the HP2000s were *extremely* influential. That's because for the low-low price of about $50,000 (a little under half a million in 2022), one could build out a system that would run up to 16 users on a single rack-mount machine. For a time, until the first all-in-one microcomputers appeared in the later 1970s, the HP dialect was by far the most popular and there and books filled with HP code. When other companies entered the mini space, like Data General, they were most familiar with the HP version and generally copied it. For a time, HP BASIC *was* BASIC, and BASIC was *the* language of the future. 45 | 46 | ### DEC 47 | 48 | And then there's Digital. DEC was slow to the BASIC game because they were pushing their own language, FOCAL. 49 | 50 | At the same time that Dartmouth was creating BASIC, a team at SRI was creating JOSS. BASIC and JOSS are very similar in concept and implementation. FOCAL is a very cut-down version of JOSS that was small enough to run on the PDP-8. The result is almost identical to early versions of BASIC, lacking string variables and other features introduced in later versions, but otherwise differing mostly in the names of the keywords. 51 | 52 | At DEC, David Ahl was tired of seeing people ignore their PDP-8 in favor of the HP2000 because DEC had FOCAL and HP had BASIC. Management was locked deep in not-invented-here syndrome, and wouldn't consider BASIC. So Ahl went out and hired someone to write BASIC for the PDP-8. All interest in FOCAL immediately evaporated. He helped this process along by personally porting over many of the popular FOCAL programs to BASIC, like Lunar Lander and Hamurabi. The PDP-8 had only 4k of memory, so it was a simple dialect, but still useable for most early programs. 53 | 54 | But then DEC released the PDP-10, and shortly after, the PDP-11. DEC had been working with Tymshare on operating systems for the PDP-10, and Tymshare had their own SUPER BASIC which set the pattern for DEC's own BASIC-PLUS. The most notable difference in Tymshare's implementation was their set of string functions, `MID`, `LEFT`, `RIGHT` and so forth. I have no idea why they went this route when the HP pattern was already widespread, and I suspect the people that know are no longer around. But here we are, only a couple of years into the history of BASIC, and there is yet another solution to the same string problem. 55 | 56 | There is a real drawback to DEC's solution. Consider the code `A$="HELLO WORLD":PRINT LEFT$(A$,5);:PRINT " ";:PRINT RIGHT$(A$,5)`. This code produces three separate strings on the heap because the string functions return new strings. In contrast, A$="HELLO WORLD":PRINT A$(1,5);:PRINT " ";:PRINT A$(6) in the HP dialect results in only one string on the heap because slices are simply pointers into the existing string. The HP concept is generally more memory efficient and faster because it's not always creating new objects. 57 | 58 | ### What does all this have to do with anything? 59 | 60 | So along comes 1975 and the Altair 8800. Within a year there are dozens of microcomputer kits on the market, and every single one uses BASIC as a primary language. Dartmouth was a compiler that ran on mainframes, so that was going nowhere. Most of the people that got a micro had worked with a BASIC interpreter on a DEC or HP machine. When they created their versions of BASIC, they did so based on whatever version they knew. 61 | 62 | When Gates, Allen and Davidoff began writing their BASIC for the Altair, they did so on the PDP-10, and naturally the result looks a lot like DEC's BASIC-PLUS. In contrast, when Woz wrote Apple BASIC while working a day job at HP, it naturally ended up looking like HP BASIC. For a time, 1975 through about late 1978, the two dialects were equally common and there are dozens of examples of both being used on various platforms. 63 | 64 | Things started changing in late 1977; over a period of about six months, the Apple II, TRS-80 and Commodore PET were released. Commodore licensed MS's new 6502 version as its dialect, and Apple shipped their Applesoft version as an loadable program before including it in the ROM as the standard BASIC in the II+. From that point on, the HP dialect starts to disappear. It was used as the basis for Atari BASIC in 1979, and Sinclair and other UK-based systems shortly after that, but even as early as 1980 anything that didn't use MS-style strings was considered non-standard. 65 | 66 | ### RetroBASICs solution 67 | 68 | RetroBASIC aims to run any early BASIC program without modification. There is the important caveat that the program cannot not make use of platform-specific extensions or invoke code using CALL or PEEKs and POKEs. But such was the case for most early programs when BASIC was a primary language on many different platforms and users exchanging programs wrote them to be as portable as possible. In most cases, it was only the string handling and a few more subtle differences that had to be ported. 69 | 70 | There are many additional keywords and features found in one dialect or another. Some of these are incompatible with each other. For instance, Commodore BASIC for the (unreleased) C65 included a CHANGE command used for doing find and replace in a program text, which is incompatible with the Dartmouth CHANGE command. HP had its own version of CHANGE, (the better-named) CONVERT, but Wang BASIC had an entirely different CONVERT function. When such issues arose, RetroBASIC selected the "most standard" version, the one that would result in the most programs working properly without conversion. 71 | 72 | As a result, RetroBASIC is essentially a superset of MS BASIC with the following features: 73 | 74 | 1) MS-style string handling for concatenation, both + and &, and string functions like `MID$` 75 | 2) Dartmouth style `CHANGE A$ TO A` and `CHANGE A TO A$`, along with HP's `CONVERT` synonym 76 | 3) HP-style string slicing, including defaulting to considering [] separate from () allowing string arrays 77 | 4) HP-style `GOTO..ON` and `GOSUB..ON` variations of MS's `ON..GOTO` and `ON..GOSUB` 78 | 5) `IF..GOTO` and `IF..GOSUB` (no THEN) found in some dialects 79 | 6) Many additional functions and a few additional statements, like MAX and MIN, TAN, etc. 80 | 81 | ## Random notes 82 | 83 | Later versions of MS, and those that followed its pattern, allow FOR loops to be terminated in one of three ways. `NEXT I` closes the current loop and returns "NEXT WITHOUT FOR" if the current loop isn't I. `NEXT` closes any open loop, including multiple open loops. Finally, `NEXT I,J` closes the loops opened with I or J. This last case is weird, the order doesn't matter, `NEXT J,I` does the same thing. If the code `FOR I=` and then `FOR J=`, `NEXT I,J` will work properly. 84 | -------------------------------------------------------------------------------- /src/list.c: -------------------------------------------------------------------------------- 1 | /* list (implementation) for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #include "list.h" 22 | 23 | /* 24 | * Creates an empty list node. Private method. 25 | */ 26 | list_t* _lst_alloc(void); 27 | list_t* _lst_alloc(void) { 28 | list_t *node = (list_t *)malloc(sizeof(list_t)); 29 | if (node == NULL) 30 | return NULL; 31 | 32 | node->data = NULL; 33 | node->key = NULL; 34 | node->next = NULL; 35 | node->prev = NULL; 36 | 37 | return node; 38 | } 39 | 40 | /* 41 | * Removes and frees the list itself. The user has to free the items within first! 42 | */ 43 | void lst_free(list_t *list) 44 | { 45 | if (list == NULL) 46 | return; 47 | 48 | list_t *this = lst_first_node(list); 49 | list_t* next; 50 | while (this) { 51 | next = this->next; 52 | free(this); 53 | this = next; 54 | } 55 | } 56 | 57 | /* 58 | * Removes and frees the entire list and the user data within. 59 | */ 60 | void lst_free_everything(list_t *list) 61 | { 62 | if (list == NULL) 63 | return; 64 | 65 | list_t* tail = list; 66 | if (tail->next != NULL) 67 | tail = lst_last_node(list); 68 | 69 | while (tail->prev != NULL) { 70 | list_t* temp = tail; 71 | tail = tail->prev; 72 | if (temp->data != NULL) 73 | free(temp->data); 74 | if (temp->key != NULL) 75 | free(temp->key); 76 | free(temp); 77 | } 78 | // and then delete the remaining node 79 | if (tail->data != NULL) 80 | free(tail->data); 81 | if (tail->key != NULL) 82 | free(tail->key); 83 | tail->next = NULL; 84 | free(tail); 85 | // TODO: at this point the original list still has one invalid node in it, and will thus say length 1 86 | } 87 | 88 | /* 89 | * Returns the length of the list. 90 | */ 91 | int lst_length(list_t *list) 92 | { 93 | int length = 0; 94 | 95 | list_t *head = lst_first_node(list); 96 | while (head != NULL) { 97 | length++; 98 | head = head->next; 99 | } 100 | 101 | return length; 102 | } 103 | 104 | /* 105 | * Returns the first node. 106 | */ 107 | list_t* lst_first_node(list_t *list) 108 | { 109 | if (list == NULL) 110 | return list; 111 | 112 | // walk backwards until we get a NULL prev 113 | list_t *node = list; 114 | while (node->prev != NULL) 115 | node = node->prev; 116 | 117 | return node; 118 | } 119 | 120 | /* 121 | * Returns the last node. 122 | */ 123 | list_t* lst_last_node(list_t *list) 124 | { 125 | if (list == NULL) 126 | return list; 127 | 128 | // walk forward until we get a NULL next 129 | list_t *node = list; 130 | while (node->next != NULL) 131 | node = node->next; 132 | 133 | return node; 134 | } 135 | 136 | /* 137 | * Returns the node for a given data item. 138 | */ 139 | list_t* lst_node_with_data(list_t *list, void* data) 140 | { 141 | if (list == NULL) 142 | return list; 143 | 144 | list_t* node = lst_first_node(list); 145 | if (node == NULL) 146 | return NULL; 147 | 148 | while (node->data != data && node->next != NULL) 149 | node = node->next; 150 | 151 | // only return it if its in the list, if we hit the end return null 152 | if (node->data == data) 153 | return node; 154 | else 155 | return NULL; 156 | } 157 | 158 | /* 159 | * Returns the data at a given index. 160 | */ 161 | void* lst_data_at(list_t *list, int index) 162 | { 163 | list_t *node = lst_node_at(list, index); 164 | if (node == NULL) 165 | return NULL; 166 | else 167 | return node->data; 168 | } 169 | 170 | /* 171 | * Returns the node at a given index. 172 | */ 173 | list_t* lst_node_at(list_t *list, int index) 174 | { 175 | if (list == NULL) 176 | return list; 177 | 178 | list_t* node = list; 179 | if (node->prev != NULL) 180 | node = lst_first_node(list); 181 | 182 | int i = 0; 183 | while (node->next != NULL && i < index) { 184 | node = node->next; 185 | i++; 186 | } 187 | 188 | // only return it if its in the list, if we hit the end return null 189 | if (i == index) 190 | return node; 191 | else 192 | return NULL; 193 | } 194 | /* 195 | * Returns the node with a given key. 196 | */ 197 | list_t* lst_node_with_key(list_t *list, const char *key) 198 | { 199 | if (list == NULL) 200 | return list; 201 | 202 | list_t* node = lst_first_node(list); 203 | while (node != NULL && node->key != NULL && strcmp(key, node->key) != 0) 204 | node = node->next; 205 | 206 | return node; 207 | } 208 | 209 | /* 210 | * Returns the data in the node with a given key. 211 | */ 212 | void* lst_data_with_key(list_t *list, const char *key) 213 | { 214 | if (list == NULL) 215 | return list; 216 | 217 | list_t* node = lst_first_node(list); 218 | while (node != NULL && node->key != NULL && strcmp(key, node->key) != 0) 219 | node = node->next; 220 | 221 | if (node && node->data) 222 | return node->data; 223 | else 224 | return NULL; 225 | } 226 | 227 | /* 228 | * Returns the index of a node or -1 if it's not found. Curries line below. 229 | */ 230 | int lst_index_of_node(list_t *list, list_t *node) 231 | { 232 | return lst_index_of_data(list, node->data); 233 | } 234 | 235 | /* 236 | * Returns the index of an item (pointer) or -1 if it's not found. 237 | */ 238 | int lst_index_of_data(list_t *list, void *data) 239 | { 240 | if (list == NULL) 241 | return -1; 242 | 243 | list_t* node = list; 244 | if (node->prev != NULL) 245 | node = lst_first_node(list); 246 | 247 | int pos = 0; 248 | while ((node->data != data) && (node->next != NULL)) { 249 | node = node->next; 250 | pos++; 251 | } 252 | 253 | // only return it if its in the list, if we hit the end return null 254 | if (node->data == data) 255 | return pos; 256 | else 257 | return -1; 258 | } 259 | 260 | /* 261 | * Adds a value at the end of the given list. 262 | */ 263 | list_t* lst_append(list_t* list, void *data) 264 | { 265 | // always going to produce at least one new node 266 | list_t *new_list; 267 | new_list = _lst_alloc(); 268 | new_list->data = data; 269 | 270 | // now add it to the end of there were other items already 271 | list_t *last_existing; 272 | if (list != NULL) { 273 | last_existing = list; 274 | if (last_existing->next != NULL) 275 | last_existing = lst_last_node(list); 276 | 277 | last_existing->next = new_list; 278 | new_list->prev = last_existing; 279 | 280 | return list; 281 | } 282 | else { 283 | new_list->prev = NULL; 284 | return new_list; 285 | } 286 | } 287 | 288 | /* 289 | * Adds a value at the begining of the given list. 290 | */ 291 | list_t* lst_prepend(list_t* list, void *data) 292 | { 293 | list_t *new_node; 294 | 295 | new_node = _lst_alloc(); 296 | new_node->data = data; 297 | new_node->next = list; 298 | 299 | if (list != NULL) { 300 | new_node->prev = list->prev; 301 | if (list->prev) 302 | list->prev->next = new_node; 303 | list->prev = new_node; 304 | } 305 | else 306 | new_node->prev = NULL; 307 | 308 | return new_node; 309 | } 310 | 311 | /* 312 | * Inserts the data at the given index. 313 | */ 314 | list_t* lst_insert_at_index(list_t *list, void *data, int index) 315 | { 316 | list_t *new_node; 317 | list_t *tmp_node; 318 | 319 | // if we insert before the start, that means the end, zero is the start. 320 | if (index < 0) 321 | return lst_append(list, data); 322 | else if (index == 0) 323 | return lst_prepend(list, data); 324 | 325 | tmp_node = lst_node_at(list, index); 326 | if (tmp_node == NULL) 327 | return lst_append(list, data); 328 | 329 | new_node = _lst_alloc(); 330 | new_node->data = data; 331 | new_node->prev = tmp_node->prev; 332 | new_node->prev->next = new_node; 333 | new_node->next = tmp_node; 334 | new_node->prev = new_node; 335 | 336 | return list; 337 | } 338 | 339 | /* 340 | * Uses the "key" string to find the proper location to insert new data. 341 | */ 342 | list_t* lst_insert_with_key_sorted(list_t *list, void *data, char *key) 343 | { 344 | // try to build a new node and fail out otherwise 345 | list_t *new_node = _lst_alloc(); 346 | if (new_node == NULL) 347 | return NULL; 348 | 349 | new_node->data = data; 350 | new_node->key = key; 351 | 352 | // if the list is empty then we are the list 353 | if (list == NULL) 354 | return new_node; 355 | 356 | // get the head of the list and roll forward until we find the right location 357 | list_t *node_after = lst_first_node(list); 358 | while (node_after != NULL && node_after->key != NULL && strcmp(key, node_after->key) > 0) 359 | node_after = node_after->next; 360 | 361 | // get the previous node too, which may not exist if we're at the start or end 362 | list_t *node_before = NULL; 363 | if (node_after != NULL) 364 | node_before = node_after->prev; 365 | else 366 | node_before = lst_last_node(list); 367 | 368 | // and link it in 369 | if (node_after != NULL) { 370 | node_after->prev = new_node; 371 | new_node->next = node_after; 372 | } 373 | if (node_before != NULL) { 374 | node_before->next = new_node; 375 | new_node->prev = node_before; 376 | } 377 | 378 | return new_node; 379 | } 380 | 381 | /* 382 | * Copies a list into a new list and returns the new one. 383 | */ 384 | list_t* lst_copy(list_t *list) 385 | { 386 | list_t *new_node = NULL; 387 | 388 | // anything to copy? 389 | if (list == NULL) 390 | return NULL; 391 | 392 | // check that we're at the head, or move there 393 | if (list->prev != NULL) 394 | list = lst_first_node(list); 395 | 396 | // got memory? 397 | list_t *new_list = _lst_alloc(); 398 | if (new_list == NULL) 399 | return NULL; 400 | new_list->data = list->data; 401 | 402 | // do the copy 403 | while (list->next != NULL) { 404 | new_node = _lst_alloc(); 405 | new_node->data = list->data; 406 | new_node->key = list->key; 407 | lst_append(new_list, new_node); 408 | list = list->next; 409 | } 410 | 411 | return new_list; 412 | } 413 | 414 | /* 415 | * Concats two lists 416 | */ 417 | list_t* lst_concat(list_t *first_list, list_t *second_list) 418 | { 419 | list_t *tail = lst_last_node(first_list); 420 | list_t *head = lst_first_node(second_list); 421 | if (tail != NULL) { 422 | tail->next = head; 423 | } 424 | if (head != NULL) { 425 | head->prev = tail; 426 | } 427 | return first_list; 428 | } 429 | 430 | /* 431 | * Removes and frees the node pointing to a given @p data 432 | */ 433 | list_t* lst_remove_node(list_t *list, list_t* node) 434 | { 435 | return lst_remove_node_with_data(list, node); 436 | } 437 | 438 | /* 439 | * Removes and frees the node pointing to a given @p data 440 | */ 441 | list_t* lst_remove_node_with_data(list_t *list, void* data) 442 | { 443 | // get the existing node for that item 444 | list_t* current_node = lst_node_with_data(list, data); 445 | if (current_node == NULL) 446 | return list; 447 | 448 | // get the previous and next nodes, either of which may be null 449 | list_t* prev_node = current_node->prev; 450 | list_t* next_node = current_node->next; 451 | 452 | // link the list back together 453 | if (prev_node != NULL) 454 | prev_node->next = next_node; // which may be null, which is fine 455 | if (next_node != NULL) 456 | next_node->prev = prev_node; 457 | 458 | free(current_node); 459 | 460 | if (prev_node == NULL && next_node == NULL) 461 | return NULL; 462 | else 463 | return list; 464 | } 465 | 466 | /* 467 | * Removes and frees the node at the given index and returns the pointer to the associated data 468 | */ 469 | void* lst_remove_node_at_index(list_t *list, int index) 470 | { 471 | // get the existing item at that index and fail out if it doesn't exist 472 | list_t* current_node = lst_node_at(list, index); 473 | if (current_node == NULL) 474 | return NULL; 475 | 476 | // get the previous and next nodes, either of which may be null 477 | list_t* prev_node = current_node->prev; 478 | list_t* next_node = current_node->next; 479 | 480 | // link the list back together 481 | if (prev_node != NULL) 482 | prev_node->next = next_node; // which may be null, which is fine 483 | if (next_node != NULL) 484 | next_node->prev = prev_node; 485 | 486 | void *data = current_node->data; 487 | free(current_node); 488 | return data; 489 | } 490 | 491 | /* 492 | * Removes and frees the node with the given key and returns the pointer to the associated data 493 | */ 494 | void* lst_remove_node_with_key(list_t *list, char *key) 495 | { 496 | // get the existing item at that index and fail out if it doesn't exist 497 | list_t* current_node = lst_node_with_key(list, key); 498 | if (current_node == NULL) 499 | return NULL; 500 | 501 | // get the previous and next nodes, either of which may be null 502 | list_t* prev_node = current_node->prev; 503 | list_t* next_node = current_node->next; 504 | 505 | // link the list back together 506 | if (prev_node != NULL) 507 | prev_node->next = next_node; // which may be null, which is fine 508 | if (next_node != NULL) 509 | next_node->prev = prev_node; 510 | 511 | void *data = current_node->data; 512 | free(current_node); 513 | return data; 514 | } 515 | 516 | /* 517 | * Calls the provided function on each of the elements in the list. 518 | */ 519 | list_t* lst_foreach(list_t *list, void (*function)(void *key, void *data, void *user_data), void *user_data) 520 | { 521 | list_t *next = lst_first_node(list); 522 | while (next) { 523 | (*function)(next->key, next->data, user_data); 524 | next = next->next; 525 | } 526 | return list; 527 | } 528 | 529 | /* 530 | * Alias for prepend, for API purposes 531 | */ 532 | list_t* lst_push(list_t *list, void *data) 533 | { 534 | return lst_prepend(list, data); 535 | } 536 | 537 | /* 538 | * Alias for remove_at(0), for API purposes 539 | */ 540 | void* lst_pop(list_t *list) 541 | { 542 | return lst_remove_node_at_index(list, 0); 543 | } 544 | -------------------------------------------------------------------------------- /src/statistics.c: -------------------------------------------------------------------------------- 1 | /* Statistics for RetroBASIC 2 | Copyright (C) 2020 Maury Markowitz 3 | 4 | This file is part of RetroBASIC. 5 | 6 | RetroBASIC is free software; you can redistribute it and/or modify 7 | it under the terms of the GNU General Public License as published by 8 | the Free Software Foundation; either version 2, or (at your option) 9 | any later version. 10 | 11 | RetroBASIC is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | GNU General Public License for more details. 15 | 16 | You should have received a copy of the GNU General Public License 17 | along with RetroBASIC; see the file COPYING. If not, write to 18 | the Free Software Foundation, 59 Temple Place - Suite 330, 19 | Boston, MA 02111-1307, USA. */ 20 | 21 | #include "statistics.h" 22 | 23 | #include "parse.h" 24 | 25 | /* declarations of the externs from the header */ 26 | int variables_total = 0; 27 | int variables_default = 0; 28 | int variables_int = 0; 29 | int variables_float = 0; 30 | int variables_double = 0; 31 | int variables_string = 0; 32 | int numeric_constants_total = 0; 33 | int numeric_constants_float = 0; 34 | int numeric_constants_zero = 0; 35 | int numeric_constants_one = 0; 36 | int numeric_constants_minus_one = 0; 37 | int numeric_constants_one_digit = 0; 38 | int numeric_constants_two_digit = 0; 39 | int numeric_constants_three_digit = 0; 40 | int numeric_constants_four_digit = 0; 41 | int numeric_constants_five_digit = 0; 42 | int numeric_constants_one_byte = 0; 43 | int numeric_constants_two_byte = 0; 44 | int numeric_constants_four_byte = 0; 45 | int numeric_constants_big = 0; 46 | 47 | int string_constants_total = 0; 48 | int string_constants_zero = 0; 49 | int string_constants_one_byte = 0; 50 | int string_constants_big = 0; 51 | int string_constants_max = 0; 52 | int linenum_constants_total = 0; 53 | int linenum_forwards = 0; 54 | int linenum_backwards = 0; 55 | int linenum_same_line = 0; 56 | int linenum_goto_totals = 0; 57 | int linenum_then_goto_totals = 0; 58 | int linenum_gosub_totals = 0; 59 | int linenum_on_totals = 0; 60 | int for_loops_total = 0; 61 | int for_loops_step_1 = 0; 62 | int for_loops_all_constant = 0; 63 | int increments = 0; 64 | int decrements = 0; 65 | int compare_equals_zero = 0; 66 | int compare_equals_one = 0; 67 | int compare_equals_other = 0; 68 | int compare_not_equals_zero = 0; 69 | int compare_not_equals_one = 0; 70 | int compare_not_equals_other = 0; 71 | int assign_zero = 0; 72 | int assign_one = 0; 73 | int assign_other = 0; 74 | 75 | /* methods used while list walking */ 76 | static void is_string(void *key, void *value, void *user_data) 77 | { 78 | variable_storage_t *data = (variable_storage_t *)value; 79 | int *tot = (int *)user_data; 80 | if (data->type == STRING) *tot += 1; 81 | } 82 | static void is_single(void *key, void *value, void *user_data) 83 | { 84 | variable_storage_t *data = (variable_storage_t *)value; 85 | int *tot = (int* )user_data; 86 | if (data->type == SINGLE) *tot += 1; 87 | } 88 | static void is_double(void *key, void *value, void *user_data) 89 | { 90 | variable_storage_t *data = (variable_storage_t *)value; 91 | int *tot = (int *)user_data; 92 | if (data->type == DOUBLE) *tot += 1; 93 | } 94 | static void is_integer(void *key, void *value, void *user_data) 95 | { 96 | variable_storage_t *data = (variable_storage_t *)value; 97 | int *tot = (int *)user_data; 98 | if (data->type == INTEGER) *tot += 1; 99 | } 100 | 101 | /** 102 | * Prints out the statistics to the console if the global print_stats 103 | * is turned on, and to a file if write_stats is turned on. 104 | * 105 | */ 106 | void print_statistics(void) 107 | { 108 | int lines_total = 0, line_min = MAX_LINE_NUMBER + 1, line_max = -1; 109 | double linenum_1_digit = 0.0, linenum_2_digit = 0.0, linenum_3_digit = 0.0, linenum_4_digit = 0.0, linenum_5_digit = 0.0; 110 | double linenum_tot_digits = 0.0; 111 | double linenum_ave_digits = 0; 112 | 113 | // start with line number stats 114 | // just look for any entry in the arra with a non-empty statement list 115 | for(int i = 0; i < MAX_LINE_NUMBER; i++) { 116 | if (interpreter_state.lines[i] != NULL) { 117 | lines_total++; 118 | if (i < line_min) line_min = i; 119 | if (i > line_max) line_max = i; 120 | 121 | switch(i) { 122 | case 0 ... 9 : linenum_1_digit++; linenum_tot_digits = linenum_tot_digits + 1; break; 123 | case 10 ... 99 : linenum_2_digit++; linenum_tot_digits = linenum_tot_digits + 2; break; 124 | case 100 ... 999 : linenum_3_digit++; linenum_tot_digits = linenum_tot_digits + 3; break; 125 | case 1000 ... 9999 : linenum_4_digit++; linenum_tot_digits = linenum_tot_digits + 4; break; 126 | case 10000 ... 99999 : linenum_5_digit++; linenum_tot_digits = linenum_tot_digits + 5; break; 127 | } 128 | } 129 | } 130 | 131 | // exit if there's no program 132 | if (lines_total == 0) { 133 | printf("\nNO PROGRAM TO EXAMINE\n\n"); 134 | return; 135 | } 136 | 137 | // average number of digits in a line number 138 | linenum_ave_digits = ( 139 | (linenum_1_digit * 1) + (linenum_2_digit * 2) + (linenum_3_digit * 3) + (linenum_4_digit * 4) + (linenum_5_digit * 5) 140 | ) / lines_total; 141 | 142 | 143 | // since the statements are run together as one long list, it's 144 | // easy to print out the total number, but not so easy to print 145 | // out the number per line. so this code checks each node to see 146 | // if the ->next is the first item on the next line 147 | int stmts_max = 0, diff = 0, next_num; 148 | list_t *next_line; 149 | list_t *start = interpreter_state.lines[interpreter_state.first_line]; 150 | 151 | for (int i = interpreter_state.first_line; i < MAX_LINE_NUMBER - 1; i++) { 152 | // get the next line's statements, and continue if its empty 153 | list_t *this_line = interpreter_state.lines[i]; 154 | if (interpreter_state.lines[i] == NULL) 155 | continue; 156 | 157 | // now find the next non-empty line 158 | next_num = i + 1; // note to me: no, you can't i++ here! 159 | while ((next_num < MAX_LINE_NUMBER) && (interpreter_state.lines[next_num] == NULL)) 160 | next_num++; 161 | 162 | // if we ran off the end of the list, exit 163 | if (next_num > MAX_LINE_NUMBER - 1) 164 | break; 165 | 166 | // otherwise we found the next line 167 | next_line = interpreter_state.lines[next_num]; 168 | 169 | // now count the number of statements between them 170 | diff = lst_index_of_node(start, next_line) - lst_index_of_node(start, this_line); 171 | if (diff > stmts_max) 172 | stmts_max = diff; 173 | } 174 | 175 | // variables 176 | int num_total = lst_length(interpreter_state.variable_values); 177 | 178 | int num_int = 0, num_sng = 0, num_dbl = 0, num_str = 0; 179 | lst_foreach(interpreter_state.variable_values, is_integer, &num_int); 180 | lst_foreach(interpreter_state.variable_values, is_single, &num_int); 181 | lst_foreach(interpreter_state.variable_values, is_double, &num_int); 182 | lst_foreach(interpreter_state.variable_values, is_string, &num_str); 183 | 184 | // output to screen if selected 185 | if (print_stats) { 186 | printf("\nRUN TIME: %g\n", (double)(end_time.tv_usec - start_time.tv_usec) / 1000000 + (double)(end_time.tv_sec - start_time.tv_sec)); 187 | printf("CPU TIME: %g\n", ((double) (end_ticks - start_ticks)) / CLOCKS_PER_SEC); 188 | 189 | printf("\nLINE NUMBERS\n\n"); 190 | printf(" total: %i\n", lines_total); 191 | printf(" first: %i\n", line_min); 192 | printf(" last: %i\n", line_max); 193 | printf(" digits: %2.2f\n", linenum_ave_digits); 194 | 195 | printf("\nSTATEMENTS\n\n"); 196 | printf(" total: %i\n", lst_length(interpreter_state.lines[line_min])); 197 | printf("average: %2.2f\n", (double)lst_length(interpreter_state.lines[line_min])/(double)lines_total); 198 | printf(" max: %i\n", stmts_max); 199 | 200 | printf("\nVARIABLES\n\n"); 201 | printf(" total: %i\n",num_total); 202 | printf(" string: %i\n",num_str); 203 | printf(" (nums): %i\n",num_total-num_str-num_int-num_sng-num_dbl); 204 | printf(" ints: %i\n",num_int); 205 | printf("singles: %i\n",num_sng); 206 | printf("doubles: %i\n",num_dbl); 207 | 208 | printf("\nNUMERIC CONSTANTS\n\n"); 209 | printf(" total: %i\n",numeric_constants_total); 210 | printf("non-int: %i\n",numeric_constants_float); 211 | printf(" int: %i\n",numeric_constants_total - numeric_constants_float); 212 | printf(" zeros: %i\n",numeric_constants_zero); 213 | printf(" ones: %i\n",numeric_constants_one); 214 | printf(" -ones: %i\n",numeric_constants_minus_one); 215 | printf("1 digit: %i\n",numeric_constants_one_digit); 216 | printf("2 digit: %i\n",numeric_constants_two_digit); 217 | printf("3 digit: %i\n",numeric_constants_three_digit); 218 | printf("4 digit: %i\n",numeric_constants_four_digit); 219 | printf("5 digit: %i\n",numeric_constants_five_digit); 220 | printf(" bigger: %i\n",numeric_constants_big); 221 | printf(" 1 byte: %i\n",numeric_constants_one_byte); 222 | printf(" 2 byte: %i\n",numeric_constants_two_byte); 223 | printf(" 4 byte: %i\n",numeric_constants_four_byte); 224 | 225 | printf("\nSTRING CONSTANTS\n\n"); 226 | printf(" total: %i\n",string_constants_total); 227 | printf("0 chars: %i\n",string_constants_zero); 228 | printf(" 1 char: %i\n",string_constants_one_byte); 229 | printf("biggest: %i\n",string_constants_max); 230 | 231 | printf("\nBRANCHES\n\n"); 232 | printf(" total: %i\n",linenum_constants_total); 233 | printf(" gosubs: %i\n",linenum_gosub_totals); 234 | printf(" gotos: %i\n",linenum_goto_totals); 235 | printf(" thens: %i\n",linenum_then_goto_totals); 236 | printf("forward: %i\n",linenum_forwards); 237 | printf("bckward: %i\n",linenum_backwards); 238 | printf("same ln: %i\n",linenum_same_line); 239 | printf(" ons: %i\n",linenum_on_totals); 240 | 241 | printf("\nOTHER BITS\n\n"); 242 | printf(" asgn 0: %i\n",assign_zero); 243 | printf(" asgn 1: %i\n",assign_one); 244 | printf(" asgn x: %i\n",assign_other); 245 | printf(" FORs: %i\n",for_loops_total); 246 | printf(" step 1: %i\n",for_loops_step_1); 247 | printf(" incs: %i\n",increments); 248 | printf(" decs: %i\n",decrements); 249 | 250 | printf("\nLOGICAL\n\n"); 251 | printf(" = 0: %i\n",compare_equals_zero); 252 | printf(" != 0: %i\n",compare_not_equals_zero); 253 | printf(" = 1: %i\n",compare_equals_one); 254 | printf(" != 1: %i\n",compare_not_equals_one); 255 | printf(" = x: %i\n",compare_equals_other); 256 | printf(" != x: %i\n",compare_not_equals_other); 257 | } 258 | /* and/or the file if selected */ 259 | if (write_stats) { 260 | //check that the file name is reasonable, and then try to open it 261 | FILE* fp = fopen(stats_file, "w+"); 262 | if (!fp) 263 | return; 264 | 265 | double tu = (double)(end_time.tv_usec - start_time.tv_usec); 266 | double ts = (double)(end_time.tv_sec - start_time.tv_sec); 267 | fprintf(fp, "RUN TIME,%g\n", tu / 1000000 + ts); 268 | fprintf(fp, "CPU TIME,%g\n", ((double) (end_ticks - start_ticks)) / CLOCKS_PER_SEC); 269 | 270 | fprintf(fp, "LINE NUMBERS,total,%i\n", lines_total); 271 | fprintf(fp, "LINE NUMBERS,first,%i\n", line_min); 272 | fprintf(fp, "LINE NUMBERS,last,%i\n", line_max); 273 | fprintf(fp, "LINE NUMBERS,average digits,%2.2f\n", linenum_ave_digits); 274 | 275 | fprintf(fp, "STATEMENTS,total,%i\n", lst_length(interpreter_state.lines[line_min])); 276 | fprintf(fp, "STATEMENTS,average,%g\n", (double)lst_length(interpreter_state.lines[line_min])/(double)lines_total); 277 | fprintf(fp, "STATEMENTS,max/ln,%i\n", stmts_max); 278 | 279 | fprintf(fp, "VARIABLES,total,%i\n",num_total); 280 | fprintf(fp, "VARIABLES,string,%i\n",num_str); 281 | fprintf(fp, "VARIABLES,default,%i\n",num_total-num_str-num_int-num_sng-num_dbl); 282 | fprintf(fp, "VARIABLES,ints,%i\n",num_int); 283 | fprintf(fp, "VARIABLES,singles,%i\n",num_sng); 284 | fprintf(fp, "VARIABLES,doubles,%i\n",num_dbl); 285 | 286 | fprintf(fp, "NUMERIC CONSTANTS,total,%i\n",numeric_constants_total); 287 | fprintf(fp, "NUMERIC CONSTANTS,non-int,%i\n",numeric_constants_float); 288 | fprintf(fp, "NUMERIC CONSTANTS,int,%i\n",numeric_constants_total - numeric_constants_float); 289 | fprintf(fp, "NUMERIC CONSTANTS,zeros,%i\n",numeric_constants_zero); 290 | fprintf(fp, "NUMERIC CONSTANTS,ones,%i\n",numeric_constants_one); 291 | fprintf(fp, "NUMERIC CONSTANTS,-ones,%i\n",numeric_constants_minus_one); 292 | fprintf(fp, "NUMERIC CONSTANTS,1 digit,%i\n",numeric_constants_one_digit); 293 | fprintf(fp, "NUMERIC CONSTANTS,2 digit,%i\n",numeric_constants_two_digit); 294 | fprintf(fp, "NUMERIC CONSTANTS,3 digit,%i\n",numeric_constants_three_digit); 295 | fprintf(fp, "NUMERIC CONSTANTS,4 digit,%i\n",numeric_constants_four_digit); 296 | fprintf(fp, "NUMERIC CONSTANTS,5 digit,%i\n",numeric_constants_five_digit); 297 | fprintf(fp, "NUMERIC CONSTANTS,bigger,%i\n",numeric_constants_big); 298 | fprintf(fp, "NUMERIC CONSTANTS,1 byte,%i\n",numeric_constants_one_byte); 299 | fprintf(fp, "NUMERIC CONSTANTS,2 byte,%i\n",numeric_constants_two_byte); 300 | fprintf(fp, "NUMERIC CONSTANTS,4 byte,%i\n",numeric_constants_four_byte); 301 | 302 | fprintf(fp, "STRING CONSTANTS,total,%i\n",string_constants_total); 303 | fprintf(fp, "STRING CONSTANTS,0 chars,%i\n",string_constants_zero); 304 | fprintf(fp, "STRING CONSTANTS,1 char,%i\n",string_constants_one_byte); 305 | fprintf(fp, "STRING CONSTANTS,biggest,%i\n",string_constants_max); 306 | 307 | fprintf(fp, "BRANCHES,total,%i\n",linenum_constants_total); 308 | fprintf(fp, "BRANCHES,gosubs,%i\n",linenum_gosub_totals); 309 | fprintf(fp, "BRANCHES,gotos,%i\n",linenum_goto_totals); 310 | fprintf(fp, "BRANCHES,thens,%i\n",linenum_then_goto_totals); 311 | fprintf(fp, "BRANCHES,forward,%i\n",linenum_forwards); 312 | fprintf(fp, "BRANCHES,backward,%i\n",linenum_backwards); 313 | fprintf(fp, "BRANCHES,same line,%i\n",linenum_same_line); 314 | fprintf(fp, "BRANCHES,ons,%i\n",linenum_on_totals); 315 | 316 | fprintf(fp, "OTHER,assign 0,%i\n",assign_zero); 317 | fprintf(fp, "OTHER,assign 1,%i\n",assign_one); 318 | fprintf(fp, "OTHER,assign other,%i\n",assign_other); 319 | fprintf(fp, "OTHER,FORs,%i\n",for_loops_total); 320 | fprintf(fp, "OTHER,FORs step 1,%i\n",for_loops_step_1); 321 | fprintf(fp, "OTHER,incs,%i\n",increments); 322 | fprintf(fp, "OTHER,decs,%i\n",decrements); 323 | fprintf(fp, "OTHER,logical=0,%i\n",compare_equals_zero); 324 | fprintf(fp, "OTHER,logical!=0,%i\n",compare_not_equals_zero); 325 | fprintf(fp, "OTHER,logical=1,%i\n",compare_equals_one); 326 | fprintf(fp, "OTHER,logical!=1,%i\n",compare_not_equals_one); 327 | fprintf(fp, "OTHER,logical=x,%i\n",compare_equals_other); 328 | fprintf(fp, "OTHER,logical!=x,%i\n",compare_not_equals_other); 329 | 330 | fclose(fp); 331 | } 332 | } 333 | 334 | --------------------------------------------------------------------------------