CPCWiki forum

General Category => Programming => Topic started by: AMSDOS on 10:14, 01 April 20

Title: TBAS - writing a little computer language
Post by: AMSDOS on 10:14, 01 April 20

I came across some early BASIC (Tiny BASIC) that was published in early Dr Dobbs from the mid-70s, which was coded to run on a 4k machine with TTY output and coded in 8080 Assembly. The 8080 Assembly translates to Z80, but I don't know much about those machines, so I thought I'd write my own funny language in BASIC that's a couple of statements just to see what's involved in writing a language and is translated into Machine Code.


The Language is merely a Command Prompt ':-' with no ability to edit, no line numbers, variables or functions and only 3 Commands available along with "RUN"/"run" which executes the M/C, the commands are:-


* CLS - Clears Screen,
* LOCATE x,y - Just like Locomotive BASIC except it only allows numerical values (no variables yet).
* PRINT " " - the language searches for the quotations with can either be a character or string, if a string is used, a Text Output at &8000 is used, otherwise the accumulator holds the single character value before using TXT_OUTPUT. Unlike Locomotive BASIC PRINT, this PRINT needs LOCATE to place the text, no carriage return is used here.


There's no saving or loading of code and no error checking either, had some ideas how to correct lines if mistakes happen, though nothing like BASIC's EDIT command. Only 1 Command is allow at the prompt too, so no colons with further statements.


Despite the restrictions, apart from the command prompt, the code is quite involved, searching for Keywords and then looking up values specified for LOCATE and PRINT assigns Printed Strings to Memory is Strings are used or single character routine if a character is used, checks had to be done to determine length for that too. Since the code can be exited to Locomotive BASIC, running it again with delete any previous M/C stored, though to SAVE any M/C, I have setup &4000 to hold the main routine with the Print String routine stored at &8000..&8010 and Strings stored at &9000.


As well as the Source, I also made a bit of an example screenshot of code and DSK image attached too.




100 DEFINT a-z:MEMORY &3FFF:GOSUB 1100:addr=&4000:stadlo=&90:stadhi=&0
110 LINE INPUT":-";c$
120 GOSUB 2000
130 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
140 IF a$="RUN" THEN d=FRE(""):CALL &4000
150 IF a$="LOCATE" THEN GOSUB 2100:a$="26"+HEX$((x),2)+"2E"+HEX$((y),2)+"CD75BB":GOSUB 1000
160 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
170 GOTO 110
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE addr,VAL("&"+MID$(a$,b,2))
1020   addr=addr+1
1030 NEXT b
1040 IF PEEK(addr)=0 THEN POKE addr,&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 addr=&4000
1110 WHILE PEEK(addr)<>0 OR PEEK(addr+1)<>0
1120   POKE addr,0
1130   addr=addr+1
1140 WEND
1150 RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1:d$=c$
2010 WHILE (MID$(d$,a,1)<>CHR$(32)) AND (a<>LEN(c$)+1)
2020   a$=a$+UPPER$(MID$(d$,a,1))
2030   a=a+1
2040 WEND
2050 RETURN
2099 ' Search parameters for values
2100 a$="":a1=a
2110 x=0:s=1
2120 WHILE (MID$(d$,a,1)<>CHR$(44))
2130   x=VAL(MID$(d$,a1,s))
2140   s=s+1
2150   a=a+1
2160 WEND:a=a+1
2170 y=0:s=1:a1=a
2180 WHILE (a<>LEN(c$)+1)
2190   y=VAL(MID$(d$,a1,s))
2200   s=s+1
2210   a=a+1
2220 WEND
2230 RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:ststlo=stadlo:ststhi=stadhi
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2355  stradr=UNT(stadlo*256+stadhi)
2360  POKE UNT(stadlo*256+stadhi),ASC(MID$(c$,p,1))
2370  stadhi=stadhi+1:IF stadhi MOD 256=0 THEN stadhi=0:stadlo=stadlo+1
2375  p=p+1
2380 WEND:POKE UNT(stadlo*256+stadhi)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF ((stadlo*256+stadhi)>(ststlo*256+ststhi)+2) THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 a$="3E"+HEX$(ASC(MID$(c$,8,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2421 WHILE PEEK(&8000)=0
2422   a$="7ECD5ABB23A720F8C9"
2430   WHILE p1<=LEN(a$)
2440     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2445     p=p+1:p1=p1+2
2450   WEND
2455 WEND
2460 a$="21"+HEX$((ststhi),2)+HEX$((ststlo),2)+"CD0080"
2470 RETURN
Title: Re: TBAS - not the language to use.
Post by: Gryzor on 10:38, 01 April 20
Start a competition? :D
Title: Re: TBAS - not the language to use.
Post by: AMSDOS on 11:20, 01 April 20
It did occur to me about writing something to rival other BASICs, though they seem to have had a few years head start.

Plan B, to write a language which sort of reflects Z80 machine code, which maybe interesting.
Title: Re: TBAS - not the language to use.
Post by: Gryzor on 14:26, 01 April 20
Actually this is a great April Fool's :D
Title: Re: TBAS - improving the paramater passing.
Post by: AMSDOS on 11:56, 02 April 20
I made some improvements with the paramaters routine, though at the moment have only done tests while searching past the keyword which now works regardless of the number of comma's used and it stores them in a place where I used to see a lot of those Cheat Mode pokes being poked and can be obtained later when utilising the data.

The advantange here is it would work for a number of commands utilising commas like SYMBOL, DATA, INK, LOCATE, MOVE, DRAW, etc and I wouldn't need to write a specific bit of code to handle a specific command that would result in a larger programme.

Line 100 is a test line, it can be changed to read another command statement with a = the start position of the values in this case 10.


100 d$="LOCATE 10,10":a=8:GOSUB 2100:END
2100 a$="":a1=a
2110 c=1:s=1
2115 WHILE a<=LEN(d$)+1
2120   WHILE (MID$(d$,a,1)<>CHR$(44)) AND (a<LEN(d$)+1)
2130     POKE &BDFF+c,VAL(MID$(d$,a1,s))
2140     s=s+1
2150     a=a+1
2160   WEND
2164   a=a+1:s=1:a1=a
2165   c=c+1
2166 WEND
2167 RETURN
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:55, 07 April 20
I made some more updates of this little language, the 2nd version of the language modifies important variables which store key memory areas and stores them into memory instead. No new Keywords were added, though I wanted to alter the original code which needed a bit of garbadge handling and once Keywords were converted into M/C and memory all the variables (except Address areas) could be cleared.




100 DEFINT a-z:MEMORY &3FFF
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
130 GOSUB 1100
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN GOSUB 2100:a$="26"+HEX$(PEEK(&BE00),2)+"2E"+HEX$(PEEK(&BE01),2)+"CD75BB":GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 CLEAR: ' PRINT FRE("")
210 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 WHILE PEEK(PEEK(&BE81)*256+PEEK(&BE80))<>0 OR PEEK(PEEK(&BE81)*256+PEEK(&BE80)+1)<>0
1110   POKE PEEK(&BE81)*256+PEEK(&BE80),0
1120   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1130 WEND
1140 POKE &BE80,0:POKE &BE81,&40
1150 RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 WHILE (MID$(c$,a,1)<>CHR$(32)) AND (a<>LEN(c$)+1)
2020   a$=a$+UPPER$(MID$(c$,a,1))
2030   a=a+1
2040 WEND
2050 RETURN
2099 ' Search parameters for values
2100 a$="":a1=a
2110 c=1:s=1
2120 WHILE a<=LEN(c$)+1
2130   WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<LEN(c$)+1)
2140     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2150     s=s+1
2160     a=a+1
2170   WEND
2180   a=a+1:s=1:a1=a
2190   c=c+1
2200 WEND
2210 RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 a$="3E"+HEX$(ASC(MID$(c$,8,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN




In that version I was playing around with the Control Characters to Change Screen Mode, Inks, Paper and Window though the PRINT statement and Saved the Code by obtaining Memory Dump of the Code TBAS produces.




100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=9:GOSUB 200
120 RESTORE 1090:addr=&8000:n=1:GOSUB 200
130 RESTORE 1100:addr=&9000:n=7:GOSUB 200
140 CALL &4000
150 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC26012E01CD75BB210090CD0080
1010 DATA 26012E01CD75BB210E90CD008026012E
1020 DATA 02CD75BB211990CD008026012E03CD75
1030 DATA BB212490CD008026012E04CD75BB212F
1040 DATA 90CD008026012E05CD75BB213A90CD00
1050 DATA 8026012E06CD75BB214590CD00802601
1060 DATA 2E07CD75BB215090CD008026012E08CD
1070 DATA 75BB215B90CD008026012E01CD75BB21
1080 DATA 6690CD0080C900000000000000000000
1090 DATA 7ECD5ABB23A720F8C900000000000000
1100 DATA 04301A050E050E0E371C315A5A002A2A
1110 DATA 2A2A2A2A2A2A2A2A002A202020202020
1120 DATA 20202A002A20205442415320202A002A
1130 DATA 20202030342020202A002A2020415052
1140 DATA 494C202A002A20203230323020202A00
1150 DATA 2A20202020202020202A002A2A2A2A2A
1160 DATA 2A2A2A2A2A000E301A01190119000000



In the latest version "3", I introduced new keyword LET to introduce Byte Size variables to the language and modify LOCATE to accept those variables as well as numerical values.
A bit of coding/debugging was required depending on what was placed for the LOCATE which reflects on what M/C Bytes needed to be used.
I applied a simple approach to the variable used here, which looks more like an array. The LET routine expects to find a variable called b(num) or i(num), though at the moment I have only implemented b(num) which handles byte values (0 to 255). The <num> can hold a range of 0..255, these variables are located at &A000..&A0FF.


I need to do some tidying up of this latest version, in many places I'm using MID$() to do search like operations, which maybe better handled with INSTR() to automatically find what is where and return where things are placed, which would be quicker than setting up an Loop to and search for certain symbols and reduce size of the code.




100 MODE 2:DEFINT a-z:MEMORY &3FFF
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
130 GOSUB 1100
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 CLEAR
220 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 WHILE PEEK(PEEK(&BE81)*256+PEEK(&BE80))<>0 OR PEEK(PEEK(&BE81)*256+PEEK(&BE80)+1)<>0
1110   POKE PEEK(&BE81)*256+PEEK(&BE80),0
1120   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1130 WEND
1140 POKE &BE80,0:POKE &BE81,&40
1150 RETURN
1159 ' Check Locate Routine
1160 IF t=4 THEN a$="26"+HEX$(PEEK(&BE00),2)+"2E"+HEX$(PEEK(&BE01),2)+"CD75BB":RETURN
1170 IF t=10 THEN a$="26"+HEX$(PEEK(&BE00),2)+"3A"+HEX$(PEEK(&BE86)+n(2),2)+HEX$(PEEK(&BE87),2)+"6FCD75BB":RETURN
1180 IF t=6 THEN a$="3A"+HEX$(PEEK(&BE86)+n(1),2)+HEX$(PEEK(&BE87),2)+"672E"+HEX$(PEEK(&BE01),2)+"CD75BB":RETURN
1190 IF t=12 THEN a$="3A"+HEX$(PEEK(&BE86)+n(1),2)+HEX$(PEEK(&BE87),2)+"673A"+HEX$(PEEK(&BE86)+n(2),2)+HEX$(PEEK(&BE87),2)+"6FCD75BB":RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1:d$=c$
2010 WHILE (MID$(d$,a,1)<>CHR$(32)) AND (a<>LEN(c$)+1)
2020   a$=a$+UPPER$(MID$(d$,a,1))
2030   a=a+1
2040 WEND
2050 RETURN
2099 ' Search parameters for values
2100 a$="":a=a+1:a1=a:c=1
2101 WHILE ASC(MID$(d$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(d$)
2130     WHILE (MID$(d$,a,1)<>CHR$(44)) AND (a<>LEN(d$)+1)
2140       POKE &BDFF+c,VAL(MID$(d$,a1,s))
2150       s=s+1
2160       a=a+1
2170     WEND
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(d$)) THEN IF ASC(MID$(d$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(d$) THEN t=t-4:RETURN
2202 WEND
2203 WHILE MID$(d$,a,1)<>"("
2204   a=a+1
2205 WEND
2206 a=a+1:a1=a:s=1
2207 WHILE MID$(d$,a,1)<>")"   
2208   n=VAL(MID$(d$,a1,s))
2209   s=s+1:a=a+1
2210 WEND
2211 n(c)=n:a=a+1:c=c+1:IF MID$(d$,a,1)="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 a$="3E"+HEX$(ASC(MID$(c$,8,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 d$=c$
2610 WHILE LOWER$(MID$(d$,a,1))<>"b" AND LOWER$(MID$(d$,a,1))<>"i"
2620   a=a+1
2630 WEND
2640 d$=MID$(d$,a,1):IF d$="i" THEN GOTO 2820
2650 a=a+2: ' move ptr to number position
2660 a1=a:s=1  ' a1 = start position of number and s = size
2670 WHILE MID$(c$,a,1)<>")"
2680   n=VAL(MID$(c$,a1,s))
2690   s=s+1:a=a+1
2700 WEND
2710 WHILE MID$(c$,a,1)<>"="
2720   a=a+1
2730 WEND
2740 a=a+1
2741 ' at this point string value is looking for a number,
2742 ' but this could change to deal in searching for ('+') or ('-') signs.
2750 a1=a:s=1
2760 WHILE a<>LEN(c$)+1
2770   n2=VAL(MID$(c$,a1,s))
2780   s=s+1:a=a+1
2790 WEND
2800 a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2810 RETURN
2820 LOCATE 1,1:PRINT"Not Implemented Yet!":RETURN



Title: Re: TBAS - writing a little computer language
Post by: zhulien on 03:05, 12 April 20
i was thinking the other day why there are so many cool devices but no easy way to program them - and they are all incompatible.  For example, Sega Megadrive, Sega Dreamcast, XBox 360, Amstrad CPC, MSX, PCs etc...  wouldn't it be cool if there was a small BASIC OS that was compatible across all devices?   Perhaps you can start that.  Universal BASIC...
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:43, 12 April 20
Quote from: zhulien on 03:05, 12 April 20i was thinking the other day why there are so many cool devices but no easy way to program them - and they are all incompatible.  For example, Sega Megadrive, Sega Dreamcast, XBox 360, Amstrad CPC, MSX, PCs etc...  wouldn't it be cool if there was a small BASIC OS that was compatible across all devices?   Perhaps you can start that.  Universal BASIC...



I thought a small project like this would work nicely with Marco Vieth's CPC BASIC (https://benchmarko.github.io/CPCBasic/cpcbasic.html?example=1st). It would need a few adjustments to change how the code output is obtained, code can be POKEd & PEEKed in it, but not executed, however a Console box has been defined which allows PRINTed output to be Copied from there, though you're talking about a Small BASIC system over a number of systems.
I think the early Tiny BASIC is a good model, for it's compacted size and early Dr Dobb's Journals are available, hopefully it can create a resurgence of Tiny BASIC.


The project here creates a small BASIC like Language, which functions more like a Terminal by taking BASIC like statements and converting to Z80 Machine Code. Much of the code is probably compatable with 8080 with the exception of the Firmware, though once a BASIC like statement has been entered, it's cleared from memory to allow more space.


The extra build I made today has extended the language to 5k in size. I reduced it's size yesterday by altering some BASIC routines so that they now function in Assembly, 16bit numbers were incorporated into it, though so far I can only assign fixed values, so this appears to be the next thing to work on.


Today I added support for an upcounting loop in the form of FOR b(x)=NUM to NUM2, to get some Loops happening. At this point, it's only looking for Constant Numbers, though I allowed support for Nested Loops.  As well as FOR, is a NEXT b(x) which is very import to close off it, otherwise the computer will crash because a PUSH is initiated when FOR is used and if NEXT b(x) isn't used, no POP will ever be found. Apart from that other code can be inserted, I wrote into the code where Addresses needed to Jump back to and if they exceed -126 bytes, "JMP NZ," is used instead, though I haven't written code large enough to test as yet.  :o


Below is the source:



100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF00)<>221 THEN LOAD"droutine.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 CLEAR
240 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &AFE4
1150 RETURN
1159 ' Check Locate Routine
1160 CALL &AF00,n(1),n(2),t
1170 a=&AFAB:a$=""
1180 WHILE PEEK(a)<>0 OR PEEK(a+1)<>0
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   n2=VAL(MID$(c$,a1,s))
1260   s=s+1:a=a+1
1270 WEND
1280 RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 WHILE (MID$(c$,a,1)<>CHR$(32)) AND (a<>LEN(c$)+1)
2020   a$=a$+UPPER$(MID$(c$,a,1))
2030   a=a+1
2040 WEND
2050 RETURN
2099 ' Search parameters for values
2100 a$="":a=a+1:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       POKE &BDFF+c,VAL(MID$(c$,a1,s))
2150       s=s+1
2160       a=a+1
2170     WEND
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2203 a=INSTR(a,c$,"(")
2206 a=a+1:a1=a:s=1
2207 WHILE MID$(c$,a,1)<>")"   
2208   n=VAL(MID$(c$,a1,s))
2209   s=s+1:a=a+1
2210 WEND
2211 n(c)=n:a=a+1:c=c+1:IF MID$(c$,a,1)="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 p1=INSTR(c$,CHR$(34))+1
2411 a$="3E"+HEX$(ASC(MID$(c$,p1,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 IF INSTR(c$,"b") THEN a=INSTR(c$,"b") ELSE IF INSTR(c$,"i") THEN a=INSTR(c$,"i")
2610 d$=MID$(c$,a,1):IF d$="i" THEN GOTO 2780
2620 GOSUB 2900
2690 ' at this point string value is looking for a number,
2700 ' but this could change to deal in searching for ('+') or ('-') signs.
2710 GOSUB 1230
2760 a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2780 GOSUB 2900
2840 IF MID$(c$,a,1)="&" THEN h=1:a=a+1
2850 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2860 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2870 a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2899 ' Search variable position
2900 a=a+2: ' move ptr to number position
2910 a1=a:s=1  ' a1 = start position of number and s = size
2920 WHILE MID$(c$,a,1)<>")"
2930   n=VAL(MID$(c$,a1,s))
2940   s=s+1:a=a+1
2950 WEND
2960 a=INSTR(c$,"=")+1
2970 RETURN
2999 ' FOR Loop
3000 a$="":a=INSTR(c$," ")+1:IF MID$(c$,a,1)="b" THEN GOSUB 2900:GOSUB 2710:a$=a$+"47"
3010 a=a+1:a=INSTR(a,c$," ")+1:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 POKE &BF00,PEEK(&BF00)+1:POKE &BEFF+(PEEK(&BF00)*2),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*2),PEEK(&BE81)
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":a=INSTR(c$," ")+1:IF MID$(c$,a,1)="b" THEN GOSUB 2900
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C"+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF)*2,2)+HEX$(PEEK(&BF00)*2,2):GOSUB 1000:GOSUB 3120
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 POKE &BEFF+PEEK(&BF00)*2,0:POKE &BF00+PEEK(&BF00)*2,0:POKE &BF00,PEEK(&BF00)-1:RETURN


Update: Assembly routines used by main program to select which section of code to use from LOCATE as well as code to Clear any present M/C when running TBAS:


org &af00


ld a,(ix+00)
cp 4
jr z,isfour
cp 6
jr z,issix
cp 10
jr z,isten
cp 12
jr z,istwelve
ret
.isfour
ld de,fourdat
ld hl,store
ld b,9
call poke
ld a,(&be00)
ld (store+1),a
ld a,(&be01)
ld (store+3),a
ret


.issix
ld de,sixdat
ld hl,store
ld b,11
call poke
ld b,(ix+04)
ld a,(&be86)
.csn
inc a
djnz csn
ld (store+1),a
ld a,(&be87)
ld (store+2),a
ld a,(&be01)
ld (store+5),a
ret


.isten
ld de,tendat
ld hl,store
ld b,11
call poke
ld a,(&be00)
ld (store+1),a
ld b,(ix+02)
ld a,(&be86)
.ctn
inc a
djnz ctn
ld (store+3),a
ld a,(&be87)
ld (store+4),a
ret


.istwelve
ld de,twelvedat
ld hl,store
ld b,13
call poke
ld b,(ix+04)
ld a,(&be86)
.ctwn1
inc a
djnz ctwn1
ld (store+1),a
ld a,(&be87)
ld (store+2),a
ld b,(ix+02)
ld a,(&be86)
.ctwn2
inc a
djnz ctwn2
ld (store+5),a
ld a,(&be87)
ld (store+6),a
ret


.poke
ld a,(de)
ld (hl),a
inc hl
inc de
djnz poke
ret


.store
defb 0,0,0,0,0,0,0,0,0,0,0,0,0


.fourdat
defb &26,&00,&2E,&00,&CD,&75,&BB,&00,&00
.sixdat
defb &3A,&00,&00,&67,&2E,&00,&CD,&75,&BB,&00,&00
.tendat
defb &26,&00,&3A,&00,&00,&6F,&CD,&75,&BB,&00,&00
.twelvedat
defb &3A,&00,&00,&67,&3A,&00,&00,&6F,&CD,&75,&BB,&00,&00


.clearprg
ld hl,&4000
ld bc,&667b
.delprg
ld a,0
ld (hl),a
inc hl
dec bc
ld a,b
or c
jr nz,delprg
ret




This code can be assembled in Winapes Assembler and saved.

Example of a Nested Loop:



100 ' TBAS - Nested Loop Example
110 MEMORY &3FFF:DEFINT l,n,p
120 RESTORE 1000:addr=&4000:n=5:GOSUB 200
130 RESTORE 1050:addr=&9000:n=1:GOSUB 200
140 CALL &4000
150 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC3E0A3201A0470E15C53E053200
1010 DATA A0470E1AC53A00A0673A01A06FCD75BB
1020 DATA 3E2ACD5ABBC13A00A03C3200A04779B8
1030 DATA 20E2C13A01A03C3201A04779B820CC26
1040 DATA 012E01CD75BBC9000000000000000000
1050 DATA 2A000000000000000000000000000000
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 14:35, 14 April 20
I am keen to see this project evolve as it is a topic I love a lot.


I like BASIC, but I also like JavaScript - from a syntax point of view.  What I have thought of often, is what language problem is worth solving... 1. a way to code reasonably optimized software fast, but in a language I like (BASIC or JS)?  2. a way to be portable across multiple platforms?  Lately I have been thinking about CHIP-8 and wondering whether an extended version of this would be worth while and fast enough on something like CPC? Or, should a BASIC (or a JavaScript) compiler generate native code or byte code?  If byte code, then there is no reason you cannot easily code a single BASIC program that fills your entire 512kb extension RAM - but if native code it starts getting messy and difficult. Then there is multitasking which I like... is it worth adapting BBC BASIC for example to run multiple copies concurrently with CTRL+<1 to 0) to switch between 10 instances?  they can have almost 64kb RAM each and they really don't even need to know they are co-existing... but... I am not a fan of BBC BASIC.  I like locomotive BASIC not because it's the best, but I grew up with it.  I like Visual BASIC more - and I have already coded the self-compiling parser for it... if anyone wants to finish the code generation, more than happy to pass it on.  I did before try to find a paid developer to finish it - and sadly, no-one was interested in finishing it for money at the time... So, if I chose JavaScript (subset) - the idea for that was that a development environment or program can run within a web browser, but could cross compile to native Z80.  I have a POC of this partly working (a few bugs too) as shown in the other thread.


For TBAS... have you considered making a modern BASIC that is somewhat locomotive BASIC-like, but with some additional features to help optimize code generation?  (eg: for a = 1 to 3: blah: next a   could have an unroll option, for a = 1 to 3 unroll: blah: next a which could generate 'blah blah blah' without the loop?  Some type of linked list handling? (I can give you Z80 code for linked lists if you like).  There was a great article about how the author of Turbo Pascal coded Turbo Pascal for Z80 - and it is surprisingly good and fast.


Beyond the actual language - TBAS?  or whichever it is... I'd like to see it evolve into a fuller development environment - not only a basic line editor, but also debugging tools (consider using my VDU POC for debugging info on other monitors?), the ability to trace or snapshot entire memory dumps at points in time?  These could be easily built in as additional commands - such as... DEBUG = true (at the start of the app), if debug is true later, then maybe a DUMP command could dump memory into a bank - for a = 1 to 3: blah: dump a: next a.   After code is dumped live while running, 512kb gives 8 complete 64kb memory dumps - but if you are talking specific program ram, do you allow total 64kb dumps?  or is it limited to 16kb?  Maybe the BASIC can have a command at the top, ROMMABLE = true to ensure that all variables are allocated outside of the code space.


Have you defined the TBAS language yet?  Do you want to allow named functions and recursion?  Do you allow multiple datatypes?  Automatic casting?  Should the language be as minimal as possible?


Another note, you can make the code almost 100% portable across all Z80 systems too if you make a mini API to go with it. Like a small BIOS, then your code will generate and call the API only for hardware interaction - or even some useful subroutines.  So layering it in at least 3 layers might be a good thing for you - layer 1, BIOS layer.  layer 2, useful utils layer (maths routines, linked lists etc) which can call layer 1 if needed.  layer 3 which is the compiled code logic that gets bolted into the others and can call either layer 1 or layer 2.  Your code doesn't need to ever know where it is loaded in memory if you use a register to know the entry-point of the API too, so it can be totally relocatable.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:45, 15 April 20
I'm looking at languages like Tiny BASIC (https://en.wikipedia.org/wiki/Tiny_BASIC) in particular Palo Alto, though I'm coming up with other ideas which solve certain problems in Assembly.
The variables are defined as 'b' for byte or 'i' for integer with a number following that to point a place in memory. Bytes are defined at &A000 and Integers at &A100, which gives the user 256 Bytes or 128 Integers.
I also gave Strings a Spot in Memory at &9000 and somewhere around there I'm thinking of setting up a place to Store DATA. The DATA won't be like how Locomotive BASIC sets up data with Loops and instead POKEs to memory, I was thinking about making it possible to adjust where DATA goes and there's also the problem of trying not to overlap DATA with other variable DATA.

The next step for this language would seem to be applying some IF THEN ELSE conditioning.
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 14:10, 15 April 20
Check out post fix or reverse polish notation.  Google the shunting algorithm which allows you to easily convert standard notation to reverse polish so you can evaluate expressions. You can look at my js logic that does it if you like but it's not perfect.   Once you have expressions then you can expand on assignments, parameters and... if then else to operate with expressions.  However expression evaluation is slow due to stack usage usually so finer control with simpler options can benefit on an 8bit computer such as a simplified switch or optimised if then else when they have a single variable it can become a simple table of jumps or comparisons against accumulator.  Eg... if <expression> then could be flexible when needed but perhaps  if <variable> is <value> then... could compile to a simple ld a,l or h jp nz...


If you use 2 passes and construct your labels carefully then a 2nd pass will complete the conversion to binary with constructs such as...  if not <expression>goto condition_1_end. Blah blah then condition_1_end:   this is how jscompile works so we never need to know down the track what the label should be.  There are similar methods for for loops while loops switch etc



Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:41, 18 April 20
I made some further improvements to the code and made some comments along the way.


I'm a bit confused though am trying to hopefully improve by explaining the routines and why I made them.






999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN





This bit of code handles all the coding of the main programme, at the end of bit of coding &C9 - RET is used, however when a new bit of code is fed through the LINE INPUT, that is shifted.




1159 ' Check Locate Routine
1160 CALL &AF00,n(1),n(2),t
1170 a=&AFAB:a$=""
1180 WHILE PEEK(a)<>0 OR PEEK(a+1)<>0
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN



This is one area at the moment which needs improvement, at the moment it's fine for LOCATE to determine if statements like 'locate b(0),10'/'locate 10,b(0)'/'locate b(0),b(1)'/'locate 10,10' are used and as such results from variables are stored into the accumulator 'A' before either going into 'H' or 'L' registers, though there doesn't seem to be much in the firmware that uses 'H' or 'L' as bytes. The other main one seems to be SCR FILL BOX, that also includes 'D' and 'E' as well as 'A' for the Encoded byte, though is not helpful here. The other one is TXT GET CURSOR, though that's a Function, which I haven't got to yet.




1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN



This one's used to gather the values found in the string stream like the '34' from 'let b(0)=34' or the '2' and '10' from a 'for b(1)=2 to 10', so it should be useful for other routines I'm hoping.



1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN



I made improvements in this routine, which results in less string mess occupying memory below HIMEM, earlier I had problems if commands like 'cls' had no space in it and then other statements had things after it like 'locate 1,1', so I can test to see if INSTR equals 0 to only return the string LENgth to s.



2099 ' Search parameters for values
2100 a$="":a=instr(c$," ")+1:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 IF MID$(c$,a,1)="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN



This bit of code is meant to sort out the arguments from the 'locate' command and I introduced variable 't' to return a different value depending on if 'b(0),10'/'10,b(0)'/'b(0),b(1)'/'10,5' were used for example. Earlier I had a bit of code which resembled another bit of code and I was able to remove that and use the routine which now follows it (unlike earlier) at 2220.



2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1  ' move ptr to number position
2221 a1=a:s=1  ' a1 = start position of number and s = size
2222 WHILE MID$(c$,a,1)<>")"
2223   s=s+1:a=a+1
2224 WEND
2225 n=VAL(MID$(c$,a1,s))
2226 RETURN



This bit of code handles the number in the brackets, so when b(0) is n = 0 and so on, so when numbers are assigned 'n' is added with the variable pointer number at &A000 to produce a range of &A000..&A0FF. It looks similar to my earlier routine for extracting numbers, though it's searching for the brackets, I guess it could be tigher since 'a = the first position of the number' and 's could equal the position where the bracket closes -1', which would make the loop there redundant.



2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF INSTR(c$,"b") THEN a=INSTR(c$,"b") ELSE IF INSTR(c$,"i") THEN a=INSTR(c$,"i")
2610 d$=MID$(c$,a,1):IF d$="i" THEN GOTO 2780


' If Byte...


2620 GOSUB 2220:a=INSTR(c$,"=")+1 ' Get position of byte & search for position after "="
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1 ' If "+" is found use Increment routine
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1 ' If "-" is found use Decrement routine
2710 GOSUB 1230 ' obtain value or use for Increment/Decrement routine
2720 IF s1=1 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3C":NEXT l ' inc a
2730 IF s1=2 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3D":NEXT l ' dec a
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ' close off with new value
2760 IF s1=0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ' otherwise assign value to variable
2770 RETURN


' If Integer...


2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN ' address into hl
2780 GOSUB 2220:a=INSTR(c$,"=")+1 ' Get position of Integer & obtain new positon following "="
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1 ' IF "+" or "-" is found s1=1
2800 IF MID$(c$,a,1)="&" THEN h=1:a=a+1 ' IF hexidecimal number is used h=1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4) ' n$ contains slightly different values depending on if hexidecimal or decimal numebers are used.
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2) ' which is stored as low & high bytes.
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2) ' use this routine if "+" or "-" are used.
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2) ' otherwise assign new value to variable.
2880 RETURN



This is what I came up with when 'let' is used, which is used to assign a value to a variable, or to increment/decrement the value of a variable. It accepts 'let b(0)=10'/'let b(0)=+1','let b(0)=-1' for bytes, likewise for Integer types 'let i(0)=256' or for numbers larger than 32767 the '&' can be used for 'let i(0)=&c000'. A safeguard is in place so the number in the brackets is multiplied by 2 to prevent overwriting, so 'let i(0)'/'let i(1)'/'let i(2)' can be used. Integers can also now be Incremented and Decremented, though in this situation I've used the Assembly 'ADD hl,de' to both deal in the Adding and Subtracting with Subtracting obviously modifying '-1' to become '&ffff' and add it that way.



2999 ' FOR Loop
3000 a$="":a=INSTR(c$," ")+1:IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=INSTR(c$,"=")+1:GOSUB 2710:a$=a$+"47"
3010 a=a+1:a=INSTR(a,c$," ")+1:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 POKE &BF00,PEEK(&BF00)+1:POKE &BEFF+(PEEK(&BF00)*2),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*2),PEEK(&BE81)
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":a=INSTR(c$," ")+1:IF MID$(c$,a,1)="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C"+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF)*2,2)+HEX$(PEEK(&BF00)*2,2):GOSUB 1000:GOSUB 3120
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 POKE &BEFF+PEEK(&BF00)*2,0:POKE &BF00+PEEK(&BF00)*2,0:POKE &BF00,PEEK(&BF00)-1:RETURN



When I wrote this FOR..NEXT routine, I had to think about where the Loop Starts, and gather the address information and store some place and then I had to ask myself what if it's a Nested Loop, so I created a counting system in memory so the CLEAR wouldn't destroy it, which assigns the address to memory with the counting system being incremented/decremented when NEXT is found and when NEXT is found a whole series of code needs to be POKEd to Memory, so if the Address is within the current -126 bytes of where the FOR loop was declared, 'jr nz,xxxx' can be used, which involves subtracting the current address with the recorded address I made in memory. At this stage though it only allows Byte sized loops. :o


But here's the full code:



100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF00)<>221 THEN LOAD"droutine.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 CLEAR
240 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &AFE4
1150 RETURN
1159 ' Check Locate Routine
1160 CALL &AF00,n(1),n(2),t
1170 a=&AFAB:a$=""
1180 WHILE PEEK(a)<>0 OR PEEK(a+1)<>0
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for values
2100 a$="":a=instr(c$," ")+1:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 IF MID$(c$,a,1)="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1  ' move ptr to number position
2221 a1=a:s=1  ' a1 = start position of number and s = size
2222 WHILE MID$(c$,a,1)<>")"
2223   s=s+1:a=a+1
2224 WEND
2225 n=VAL(MID$(c$,a1,s))
2226 RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 p1=INSTR(c$,CHR$(34))+1
2411 a$="3E"+HEX$(ASC(MID$(c$,p1,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF INSTR(c$,"b") THEN a=INSTR(c$,"b") ELSE IF INSTR(c$,"i") THEN a=INSTR(c$,"i")
2610 d$=MID$(c$,a,1):IF d$="i" THEN GOTO 2780
2620 GOSUB 2220:a=INSTR(c$,"=")+1
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2710 GOSUB 1230
2720 IF s1=1 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3C":NEXT l
2730 IF s1=2 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3D":NEXT l
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2760 IF s1=0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2780 GOSUB 2220:a=INSTR(c$,"=")+1
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 IF MID$(c$,a,1)="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2999 ' FOR Loop
3000 a$="":a=INSTR(c$," ")+1:IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=INSTR(c$,"=")+1:GOSUB 2710:a$=a$+"47"
3010 a=a+1:a=INSTR(a,c$," ")+1:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 POKE &BF00,PEEK(&BF00)+1:POKE &BEFF+(PEEK(&BF00)*2),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*2),PEEK(&BE81)
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":a=INSTR(c$," ")+1:IF MID$(c$,a,1)="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C"+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF)*2,2)+HEX$(PEEK(&BF00)*2,2):GOSUB 1000:GOSUB 3120
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 POKE &BEFF+PEEK(&BF00)*2,0:POKE &BF00+PEEK(&BF00)*2,0:POKE &BF00,PEEK(&BF00)-1:RETURN


Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 08:12, 03 May 20

A bit of tweaking here and there of reoccurring instructions has resulted in them being placed Line 1900..1902 and today I added Line 1903..1906.
Because the FOR..NEXT loop routine involves a jump as well as the newly added IF..ENDIF statement, an address has to be stored, for the FOR..NEXT loop, the Jump is backwards, though for the IF..ENDIF the jump is carried forwards. I've added another assembly routine, so what happens there is when an IF is detected, an address is stored, this is where the jump or jump relative statement occurs. Statements can then be entered, which are carried out if the IF statement is true and then it needs to be closed with ENDIF. When ENDIF is used, code that was typed in previously needs to be moved in memory, it needs to determine if the code block is larger than 129 bytes and to reserve either 2 or 3 bytes if the code block exceeds 129 bytes. Line 1903..1905 sort out where the code is, where is has to go and the length, it temporarily needs moved forward and moved back depending on that 2 or 3 bytes and either JR NZ, or JP NZ, is coded. I did a little tidying up today to delete the remaining code by moving two nops onto itself.


The other week I did a little update to 'LET' statements in preparation for the IF statement after realising I could only add constant values and I couldn't add a byte variable with another byte variable. So now a statement like 'let b(0)=+b(1)' are acceptable, which would be the equivalent of 'let b=b+c' in BASIC. Having the other variable in play allows it to be changed, in my example below I have a letter 'O' bouncing side to side as a result of the IF statement changing 'b(1)' between 1 & 255 for forwards and backwards. The IF statement only handles Simple Byte expressions where 'IF b(0)=<value> ...', THEN can be used, but is not checked, though I made a little update of the FOR loop to check for 'TO ', once 'IF b(0)=<value>' is entered press <ENTER> and proceed to enter the code and close that section of code with 'ENDIF'. If no ENDIF is used, the Jump won't occur and the language will assume your entering the longest set of instructions. Not as disasterous as not closing a FOR Loop with NEXT, though won't be operating correctly.
I made a further test today to see what would happen if my code segment exceeded 129 bytes and discovered the incorrect address was being used to jump which I was able to quickly sort out following the bytes I had to grab in a sense I was grabbing bytes by following my FOR..NEXT routine, though reaslised I was jumping Forwards instead of Backwards.


Last week after adding the FOR..NEXT loop, I played with the idea of using PRINT to setup Screen Mode, Screen Inks and to create an image using numbers as a String Set. To make it work I added PEN <col> to point to the Data, which was an opportunity to expand on the Assembly routine used when dealing with LOCATE. Simply assigning 't' with a different value to return a different value from the parameter passing routine I've been able to sort out what section of code to use should 'PEN <num>, PEN b(x) or PEN i(x)' be used.


Code Samples (using for loops and variables):



cls
let b(0)=1
let b(1)=2
for b(2)=1 to 40
locate b(0),10
print " "
locate b(1),10
print "*"
let b(0)=+1
let b(1)=+1
next b(2)





cls
for b(0)=1 to 80
locate b(0),1
print "*"
locate b(0),25
print "*"
next b(0)
for b(0)=2 to 24
locate 1,b(0)
print "*"
locate 80,b(0)
print "*"
next b(0)
locate 10,10




cls
let b(0)=34
let b(1)=35
for b(2)=1 TO 20
locate b(1),10
print " "
locate b(0),10
print "*"
let b(0)=-1
let b(1)=-1
next b(2)


Code Sample (incrementing byte variable with 2nd variable in LET):


cls
let b(0)=5
let b(1)=10
locate b(0),b(1)
print "*"
let b(1)=+b(0)
for b(2)=1 to 3
locate b(1),10
print "*"
let b(1)=+b(0)
next b(2)
locate 1,1



Code Sample (bouncing 'O' side to side):


cls
let b(0)=40
let b(1)=1
locate b(0),10
print "O"
let b(2)=40
let b(3)=1
for b(4)=1 to 254
let b(0)=+b(1)
if b(0)=80
let b(1)=255
endif
locate b(2),10
print " "
let b(2)=+b(3)
if b(2)=80
let b(3)=255
endif
if b(0)=1
let b(1)=1
endif
if b(2)=1
let b(3)=1
endif
locate b(0),10
print "O"
next b(4)
locate 1,1


Code Sample (test Long Jump, change it so b(0)="another number" and jump is carried out):


cls
let b(0)=20
if b(0)=20
locate 1,1
print "*"
locate 3,1
print "*"
locate 5,1
print "*"
locate 8,1
print "*"
locate 11,1
print "*"
locate 2,2
print "*"
locate 4,2
print "*"
locate 6,2
print "*"
locate 9,2
print "*"
locate 12,2
print "*"
locate 1,3
print "*"
locate 3,3
print "*"
locate 5,3
print "*"
locate 7,3
print "*"
locate 10,3
print "*"
endif
locate 1,10



Code generated:

:laugh:  I'm still grabbing hexadecimal dumps from the Winape Pause screen (better than nothing I guess), which produces a standard Machine Code loader, unfortunately I couldn't post source code of the image I created because I'm still using Control Codes to setup INKs, Screen Mode through the PRINT statement, the files are in the included tbas programme disc in the open thread as mentioned earlier, but have included here if you prefer to COPY/PASTE.



100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=11:GOSUB 200
120 CALL &4000
130 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC3E283200A03E013201A03A00A0
1010 DATA 672E0ACD75BB3E4FCD5ABB3E283202A0
1020 DATA 3E013203A03E013204A0470EFFC53A01
1030 DATA A0473A00A0803200A03A00A0FE502005
1040 DATA 3EFF3201A03A02A0672E0ACD75BB3E20
1050 DATA CD5ABB3A03A0473A02A0803202A03A02
1060 DATA A0FE5020053EFF3203A03A00A0FE0120
1070 DATA 053E013201A03A02A0FE0120053E0132
1080 DATA 03A03A00A0672E0ACD75BB3E4FCD5ABB
1090 DATA C13A04A03C3204A04779B8209026012E
1100 DATA 01CD75BBC90000000000000000000000

* Bouncing Ball Output




100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=13:GOSUB 200
120 CALL &4000
130 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC3E143200A03A00A0FE14C2C440
1010 DATA 26012E01CD75BB3E2ACD5ABB26032E01
1020 DATA CD75BB3E2ACD5ABB26052E01CD75BB3E
1030 DATA 2ACD5ABB26082E01CD75BB3E2ACD5ABB
1040 DATA 260B2E01CD75BB3E2ACD5ABB26022E02
1050 DATA CD75BB3E2ACD5ABB26042E02CD75BB3E
1060 DATA 2ACD5ABB26062E02CD75BB3E2ACD5ABB
1070 DATA 26092E02CD75BB3E2ACD5ABB260C2E02
1080 DATA CD75BB3E2ACD5ABB26012E03CD75BB3E
1090 DATA 2ACD5ABB26032E03CD75BB3E2ACD5ABB
1100 DATA 26052E03CD75BB3E2ACD5ABB26072E03
1110 DATA CD75BB3E2ACD5ABB260A2E03CD75BB3E
1120 DATA 2ACD5ABB26012E0ACD75BBC900000000

* Long Jump Output




100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=7:GOSUB 200
120 CALL &4000
130 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC3E013200A0470E51C53A00A067
1010 DATA 2E01CD75BB3E2ACD5ABB3A00A0672E19
1020 DATA CD75BB3E2ACD5ABBC13A00A03C3200A0
1030 DATA 4779B820D63E023200A0470E19C52601
1040 DATA 3A00A06FCD75BB3E2ACD5ABB26503A00
1050 DATA A06FCD75BB3E2ACD5ABBC13A00A03C32
1060 DATA 00A04779B820D6260A2E0ACD75BBC900

* Nested Loop Example 2 Output


100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=18:GOSUB 200
120 RESTORE 1180:addr=&8000:n=1:GOSUB 200
130 RESTORE 1190:addr=&9000:n=29:GOSUB 200
140 CALL &4000
150 CALL &BB18:END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA 26012E01CD75BB3E00CD90BB210090CD
1010 DATA 00803E013203A0212B902200A1212B90
1020 DATA CD0080213C90CD0080214D90CD008021
1030 DATA 5E90CD0080216F90CD0080218090CD00
1040 DATA 80219190CD008021A290CD008021B390
1050 DATA CD008021C490CD008021D590CD008021
1060 DATA E690CD008021F790CD0080210891CD00
1070 DATA 80211991CD0080212A91CD0080213B91
1080 DATA CD0080214C91CD0080215D91CD008021
1090 DATA 6E91CD0080217F91CD0080219091CD00
1100 DATA 8021A191CD008021B291CD0080CD14BC
1110 DATA 3E013201A0470E19C53E023200A0470E
1120 DATA 12C53A00A0673A01A06FCD75BB2A00A1
1130 DATA 7ECD90BB3E40CD5ABB2A00A111010019
1140 DATA 2200A1C13A00A03C3200A04779B820D1
1150 DATA 2A00A1110100192200A1C13A01A03C32
1160 DATA 01A04779B820B126012E19CD75BB3A03
1170 DATA A0CD90BBC90000000000000000000000
1180 DATA 7ECD5ABB23A720F8C900000000000000
1190 DATA 04301C3040401C3152521C3243431C33
1200 DATA 4B4B1C3442421C355A5A1C3646461C37
1210 DATA 4F4F1C384C4C1C394A4A003030303030
1220 DATA 30303030303030303030300030303030
1230 DATA 30303030303030303030303000303030
1240 DATA 30303030303030303030303030003030
1250 DATA 30303030303030303030303030300038
1260 DATA 38383838383838303030303030303000
1270 DATA 38393939393939383030303030303030
1280 DATA 00383939393939393830303030303030
1290 DATA 30003839393939393938303030303030
1300 DATA 30300030303030303030303030303030
1310 DATA 30303000303030303030303030303030
1320 DATA 30303030003030303030303030303030
1330 DATA 30303030300030303030303030303030
1340 DATA 30303030303000303030303030303030
1350 DATA 30343030303030003030303030313030
1360 DATA 30333333303030300030303636363635
1370 DATA 30303737373730303000303030323031
1380 DATA 30303735353635373030003030303230
1390 DATA 30303037353535373030300030303434
1400 DATA 34343430303333333030303000303030
1410 DATA 33333330303036303630303030003030
1420 DATA 30303030303030363030363030300038
1430 DATA 38383838383838383838383838383800
1440 DATA 38393939393939383839393939393938
1450 DATA 00383939393939393838393939393939
1460 DATA 38003839393939393938383939393939
1470 DATA 39380040000000000000000000000000

* Avatar Image Output


Latest Version of the Language:




100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF10)<>221 THEN LOAD"rtine2.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:a$=a$+"CD90BB":GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 CLEAR
270 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &B050
1150 RETURN
1159 ' Check Locate Routine
1160 CALL &AF10,n(1),n(2),t
1170 a=&AF00:a$=""
1180 WHILE PEEK(a)<>255 OR PEEK(a+1)<>255
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))+3
1906 RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1 ' if string ptr has reached 255 characters, place to the next byte block, otherwise continue along path.
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 p1=INSTR(c$,CHR$(34))+1
2411 a$="3E"+HEX$(ASC(MID$(c$,p1,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFF+(PEEK(&BF00)*2),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*2),PEEK(&BE81):RETURN
2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*2,0:POKE &BF00+PEEK(&BF00)*2,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOTO 2780
2620 GOSUB 2220:GOSUB 1900
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2650 GOSUB 1902:IF e$="b" THEN s1=3:n2=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2660 IF s1=3 THEN a$=a$+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2710 GOSUB 1230
2720 IF s1=1 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3C":NEXT l
2730 IF s1=2 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3D":NEXT l
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2760 IF s1=0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2999 ' FOR Loop
3000 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710:a$=a$+"47"
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 GOSUB 2530
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C"+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF)*2,2)+HEX$(PEEK(&BF00)*2,2):GOSUB 1000:GOSUB 3120
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 GOSUB 2550:RETURN
3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 1230
3510 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"FE"+HEX$(n2,2):GOSUB 1000
3520 GOSUB 2530:RETURN
3699 ' ENDIF
3700 a$=""
3710 IF (PEEK(&BE81)*256+PEEK(&BE80))-(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903:CALL &B060,s,d,l:CALL &B060,d,s+jb,l
3730 CALL &B060,d+1,d+2,l
3740 IF jb=3 THEN a$="C2"+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2):GOSUB 3770
3750 IF jb=2 THEN a$="20"+HEX$(PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))),2):GOSUB 3770
3760 GOSUB 2550:RETURN
3770 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN               


Screenshots:
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:50, 18 May 20
Latest version file '9.bas' now has a working WHILE loop, i also improved the syntax so the correct Flag are used depending on if '=' or '<>' for not equals are used and if a WHILE loop block is too large JP is used instead of JR. Other tests are carried out if a string block is empty using 'and a' and if a string is found 'cp' holds the value for it.


WHILE at this stage only tests for Keypresses, it's been setup so 'k' represents keypress and can have '=' or '<>' followed by inverted commas. The only one I haven't tested is WHILE k<>"", WEND, which normally operates as a CLEAR INPUT in Locomotive BASIC, though I haven't setup any Key Input Routine (besides this one for WHILE), to notice any Keyboard Buffer Rubbish.


Only other addition I made to this edition is a 'fly' command, this is the 'frame' flyback command found in BASIC 1.1,  to smooth the movement of the Bouncing 'O' in the latest example.


Latest Version (The latest DSK & Programme Image Disc is in the opening thread):


100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF10)<>221 THEN LOAD"rtine2.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:a$=a$+"CD90BB":GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 IF a$="WHILE" THEN GOSUB 4000
270 IF a$="WEND" THEN GOSUB 4200
280 IF a$="FLY" THEN a$="CD19BD":GOSUB 1000
290 CLEAR
300 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &B050
1150 RETURN
1151 ' Move Code for Jump Routines and then clean up code
1152 CALL &B060,s,d,l
1153 CALL &B060,d,s+jb,l
1154 CALL &B060,d+1,d+2,l
1155 RETURN
1159 ' Check Locate Routine
1160 CALL &AF10,n(1),n(2),t
1170 a=&AF00:a$=""
1180 WHILE PEEK(a)<>255 OR PEEK(a+1)<>255
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))+3
1906 RETURN
1907 a=INSTR(c$,CHR$(34))+1:RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN
2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1 ' if string ptr has reached 255 characters, place to the next byte block, otherwise continue along path.
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN
2409 ' If Character is found use this routine
2410 p1=INSTR(c$,CHR$(34))+1
2411 a$="3E"+HEX$(ASC(MID$(c$,p1,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFF+(PEEK(&BF00)*2),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*2),PEEK(&BE81):RETURN
2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*2,0:POKE &BF00+PEEK(&BF00)*2,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOTO 2780
2620 GOSUB 2220:GOSUB 1900
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2650 GOSUB 1902:IF e$="b" THEN s1=3:n2=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2660 IF s1=3 THEN a$=a$+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2710 GOSUB 1230
2720 IF s1=1 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3C":NEXT l
2730 IF s1=2 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3D":NEXT l
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2760 IF s1=0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2999 ' FOR Loop
3000 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710:a$=a$+"47"
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 GOSUB 2530
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF)*2,2)+HEX$(PEEK(&BF00)*2,2):GOSUB 1000:GOSUB 3120
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 GOSUB 2550:RETURN
3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 1230
3510 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"FE"+HEX$(n2,2):GOSUB 1000
3520 GOSUB 2530:RETURN
3699 ' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN a$="C2"+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2):GOSUB 3770
3750 IF jb=2 AND ss=0 THEN a$="20"+HEX$(PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))),2):GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3770 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN
3999 ' WHILE
4000 a$="":GOSUB 1901
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:a$="CD09BB"
4020 IF MID$(c$,a+1,1)="=" THEN a$=a$+"A7":POKE &AF0E,&20:POKE &AF0F,&C2
4021 IF MID$(c$,a+1,2)="<>" THEN GOSUB 1907:a$=a$+"FE"+HEX$(ASC(MID$(c$,a,1)),2):POKE &AF0E,&28:POKE &AF0F,&CA
4030 GOSUB 1000:GOSUB 2530:RETURN
4199 ' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 4220:RETURN
4210 a$="C3"+HEX$(PEEK(&BEFF+(PEEK(&BF00)-1)*2),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*2),2):GOSUB 1000
4211 jb=3:ss=1:a$=HEX$(PEEK(&AF0F),2)+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2)
4212 GOSUB 3710:GOSUB 3770:GOSUB 2550:GOSUB 2550:RETURN
4220 a$="18":GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*2)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*2)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
4241 jb=2:ss=1:a$=HEX$(PEEK(&AF0E),2)+HEX$(PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*2))*256+PEEK(&BEFF+(PEEK(&BF00)*2))),2)
4250 GOSUB 3710:GOSUB 3770:GOSUB 2550:GOSUB 2550:RETURN



Source Code Examples (1. Exit on anykey, 2. Exit on space, 3. Bouncing 'O'):



cls
WHILE k=""
PRINT "*"
WEND






cls
WHILE k<>" "
PRINT "!"
wend


cls
locate 1,1
let b(0)=1
let b(1)=10
locate b(0),b(1)
print "O"
let b(2)=1
let b(3)=1
let b(4)=1
let b(5)=10
let b(6)=1
let b(7)=1
while k=""
let b(0)=+b(2)
if b(0)=80
let b(2)=255
endif
let b(1)=+b(6)
if b(1)=25
let b(6)=255
endif
locate b(3),b(5)
print " "
let b(3)=+b(4)
if b(3)=80
let b(4)=255
endif
let b(5)=+b(7)
if b(5)=25
let b(7)=255
endif
if b(0)=1
let b(2)=1
endif
if b(3)=1
let b(4)=1
endif
if b(1)=1
let b(6)=1
endif
if b(5)=1
let b(7)=1
endif
locate b(0),b(1)
print "O"
fly
fly
wend
locate 1,1
[size=78%]


Output Source (Bouncing 'O'):

[/size]


100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=17:GOSUB 200
120 CALL &4000
130 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC26012E01CD75BB3E013200A03E
1010 DATA 0A3201A03A00A0673A01A06FCD75BB3E
1020 DATA 4FCD5ABB3E013202A03E013203A03E01
1030 DATA 3204A03E0A3205A03E013206A03E0132
1040 DATA 07A0CD09BBA7C2FE403A02A0473A00A0
1050 DATA 803200A03A00A0FE5020053EFF3202A0
1060 DATA 3A06A0473A01A0803201A03A01A0FE19
1070 DATA 20053EFF3206A03A03A0673A05A06FCD
1080 DATA 75BB3E20CD5ABB3A04A0473A03A08032
1090 DATA 03A03A03A0FE5020053EFF3204A03A07
1100 DATA A0473A05A0803205A03A05A0FE192005
1110 DATA 3EFF3207A03A00A0FE0120053E013202
1120 DATA A03A03A0FE0120053E013204A03A01A0
1130 DATA FE0120053E013206A03A05A0FE012005
1140 DATA 3E013207A03A00A0673A01A06FCD75BB
1150 DATA 3E4FCD5ABBCD19BDCD19BDC342402601
1160 DATA 2E01CD75BBC900000000000000000000
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:32, 24 May 20
I had an idea at some stage of creating a larger version of this language by using the Data Formatted Disk for storing the source code.  It comes from an Amstrad Action series article I recall called 'Assembly Line', which documents information about Reading and Writing to Tracks and Sectors of the Disc (see attached).


Each sectors holds 200 bytes (0..&1ff), on a Data Disc Sectors are arranged from &C1 to &C9. Tracks range from 0..39 and with the numbering it seems for each incremented track &1000 and added. From the perspective of this Language (main code beginning at &4000) it would seem track 4 is a good starting point, along with any routines which begin at &8000 to begin at track 8 & track 9 for any string data.


I did some tests of using the Data Disk to Store and Retrieve the Data using the following routines below which worked on a small little 'Hello' example by storing it as DATA on the Data disk.




   org &b075
   
   ld e,1      ;; drive b
   ld d,(ix+00)   ;; track no 0..39
   ld c,(ix+02)    ;; sector &c1..&c9
   ld l,(ix+04)
   ld h,(ix+05)   ;; address of buffer


   rst 3
   dw secwrt
   ret
.secwrt
   defw &c64e,&07





   org &af00
   
   ld e,1      ;; drive b
   ld d,(ix+00)   ;; track no 0..39
   ld c,(ix+02)    ;; sector &c1..&c9
   ld l,(ix+04)
   ld h,(ix+05)   ;; address of buffer


   rst 3
   dw secred
   ret
.secred
   defw &c666,&07





If it works, I could possibly use this kind of language to code the data to a dsk image with a 200 byte buffer assigned to memory, it wouldn't be possible to run the code, though would allow more space to code other routines.
The main problem I see are the Jump blocks from the FOR..NEXT, IF..ENDIF & WHILE..WEND routines, which carry out a Jump, FOR..NEXT only carries out a backward Jump, though the others Jump Forwards and for WHILE..WEND it too has a Backward Jump. Information is already obtained where those jumps need to jump to, which I have correctly carried out. If code needed to be inserted from another sector/track, it would have to be loaded, move the appropriate area to insert the Jump (more likely a JP <address>) and save that track\sector, along with following filled in code blocks and returning any current code block to go back to the buffer. With that, I thought the Screen Memory area could be used to store that code during the loading/moving/saving and return back to a clear screen, alternatively use the upper 64k region, though it's all just ideas.
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 14:02, 25 May 20
Sounds like you want to implement paging or a virtual memory scheme which can be a good thing depending how you use it.  With the advent of fast storage and lots of ram expansions for cpc, perhaps you can find better way to utilise them?  I think the idea for direct sector writing etc still might have a place if it works with m4 dsk files? It means you can make your programs single self-contained files... but you can do it better without sector reading and writing and just normal files with such fast mass storage systems.


Still great to see the ideas.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 12:01, 27 May 20
Quote from: zhulien on 14:02, 25 May 20Sounds like you want to implement paging or a virtual memory scheme which can be a good thing depending how you use it.  With the advent of fast storage and lots of ram expansions for cpc, perhaps you can find better way to utilise them?  I think the idea for direct sector writing etc still might have a place if it works with m4 dsk files? It means you can make your programs single self-contained files... but you can do it better without sector reading and writing and just normal files with such fast mass storage systems.Still great to see the ideas.



I guess there's a number of possibilities, for example developing for 10-Liners which occupy a small space, code maybe be able to reside at &5000, &6000 or even &7000 perhaps without interfering with Variables, Machine with a Firmware instruction slipped in at the end of it would more bytes than a Tokenised BASIC Keyword that the Interpreter takes and converts to those bytes. The main attaction there being able to run the code while coding.


But with the file idea or using the dsk to store code, was debating about if it would be easier to incorporate it at this early phase or make something later.


Also had thoughts about using Assembly routine to poke the main code to memory to replace the one at 1000.1050, all the BASIC stuff can simply be passed to it and there shouldn't be any problem incrementing that address as opposed to line 1020.


I done some more work today, improved in some places, more conditions can now be used (=, < & >) in IF statements, the odd 'cp &00' was still getting through, so some checking of numbers is done, so now 'cp &xx' is only used if value isn't 0 and 'and a' is done instead. 'ld a,0' are still getting though, so I need to 'xor a' in my LET subroutine.
The other day I added simple keypress routine 'k(<key no>)', so with the WHILE loop and this, characters can be moved around the screen. I had to change some calculations in my code to accomodate a 3rd byte, so now it represents the condition found followed by the jump address. I had to alter some of those values today after deciding the conditions found would work better from some ON <cond> GOSUB subroutines.


Wanted to do some more tests before releasing source code, though with the addition of the extra conditions, I can stop things if I try and move something.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:40, 01 June 20
Lastest version File "12.BAS" of the language (attached in the open thread) includes the use of less than, greater than conditions, byte variables can now be used with WHILE..WEND to exit when conditions becomes true.
IF statements were also worked on, since my last version I've added a keyboard handler called 'k' to carry on test on keys by their number and more recently I can now check a Byte vsriable with another Byte variable.
Once those things were in place I was able to write a simple Bat & Ball Game using this language, here is the source code, note at the start the Control Code in the 'print' statement to change Screen Mode, I've added a couple of others for Screen Inks & Border, which is included in the Output version. After a few goes of Bouncing that Ball around (using Up/Down Arrow Keys), the game will Pause when your 3 Lives are used up, just press Space to exit (in the output version I have a GOTO, so it doesn't have to load the MC DATA again). The gaps in the code I put there because I was cheating by pasting an entire thing in Winapes Paste, which started having problems of not pasting code correctly. Small chunks were fine, maybe happening because my new language is starting to lag in BASIC. :(


Also in the Opening Thread I've slipped in a Comand Line Manual of this Language.




cls
locate 1,1
print "[ctrl]+[d]+[0]"
let b(0)=3
let b(1)=10
let b(2)=10
let b(3)=10
let b(4)=11
let b(5)=1
let b(6)=1


pen 4
locate 1,1
for b(7)=1 to 20
print "@"
next b(7)
for b(7)=2 to 24
locate 20,b(7)
print "@"
next b(7)
locate 1,25
for b(7)=1 to 20
print "@"
next b(7)


locate b(1),b(2)
print "O"
locate 1,b(3)
print "|"
locate 1,b(4)
print "|"
while b(0)>1
pen 4


if k(0)
if b(3)>3
locate 1,b(4)
print " "
let b(3)=-1
let b(4)=-1
locate 1,b(3)
print "|"
locate 1,b(4)
print "|"
endif
endif


if k(2)
if b(3)<23
locate 1,b(3)
print " "
let b(3)=+1
let b(4)=+1
locate 1,b(3)
print "|"
locate 1,b(4)
print "|"
endif
endif


locate b(1),b(2)
print " "
let b(1)=+b(5)


if b(1)>19
let b(5)=255
endif
let b(2)=+b(6)
pen 3
locate b(1),b(2)
print "O"


for b(7)=1 to 3
fly
next b(7)


if b(1)=2
if b(2)=b(3)
let b(5)=1
endif
if b(2)=b(4)
let b(5)=1
endif
endif


if b(2)>24
let b(6)=255
endif
if b(2)<3
let b(6)=1
endif


if b(1)=1
let b(0)=-1
locate b(1),b(2)
print " "
let b(1)=10
let b(5)=1
endif
wend
while k<>" "
wend


pen 1





Other Examples:




cls
let b(0)=10
while b(0)>1
locate b(0),1
print "*"
let b(0)=-1
wend





cls
let b(0)=1
while b(0)<10
locate b(0),1
print "*"
let b(0)=+1
wend



cls
let b(0)=1
let b(1)=0
while b(1)=1
locate b(0),1
print "*"
let b(0)=+1
if b(0)=25
let b(1)=1
endif
wend



cls
let b(0)=10
let b(1)=1
if b(0)<b(1)
let b(0)=+1
locate b(0),b(1)
print "*"
endif





cls
let b(0)=1
let b(1)=10
if b(0)>b(1)
let b(1)=+5
locate b(1),b(0)
print "*"
endif





cls
let b(0)=1
let b(1)=1
if b(0)=b(1)
let b(0)=+5
locate b(0),b(1)
print "*"
endif




cls
let b(0)=1
let b(1)=1
for b(2)=1 to 25
for b(3)=1 to 80
if b(1)<10
if b(0)<25
locate b(0),b(1)
print "*"
endif
endif
if b(1)>10
locate b(0),b(1)
print "!"
endif
if b(0)>25
locate b(0),b(1)
print "!"
endif
let b(0)=+1
next b(3)
let b(0)=1
let b(1)=+1
next b(2)
while k=""
wend
locate 1,1





cls
let b(0)=40
let b(1)=10
let b(2)=40
let b(3)=10
locate b(0),b(1)
print "*"
while k<>" "
if k(8)
if b(0)>2
locate b(2),b(3)
print " "
let b(0)=-1
let b(2)=-1
locate b(0),b(1)
print "*"
endif
endif
if k(1)
if b(0)<80
locate b(2),b(3)
print " "
let b(0)=+1
let b(2)=+1
locate b(0),b(1)
print "*"
endif
endif
if k(0)
if b(1)>2
locate b(2),b(3)
print " "
let b(1)=-1
let b(3)=-1
locate b(0),b(1)
print "*"
endif
endif
if k(2)
if b(1)<25
locate b(2),b(3)
print " "
let b(1)=+1
let b(3)=+1
locate b(0),b(1)
print "*"
endif
endif
fly
wend
locate 1,1







cls
locate 1,1
for b(0)=1 to 25
for b(1)=1 to 80
locate b(1),b(0)
print "*"
next b(1)
next b(0)
while k=""
wend
cls



Output (Bat & Ball Game):



100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=36:GOSUB 200
120 RESTORE 1360:addr=&8000:n=1:GOSUB 200
130 RESTORE 1370:addr=&9000:n=1:GOSUB 200
140 CALL &4000
150 GOTO 140
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC26012E01CD75BB210090CD0080
1010 DATA 3E033200A03E0A3201A03E0A3202A03E
1020 DATA 0A3203A03E0B3204A03E013205A03E01
1030 DATA 3206A03E04CD90BB26012E01CD75BB3E
1040 DATA 013207A0470E15C53E40CD5ABBC13A07
1050 DATA A03C3207A04779B820ED3E023207A047
1060 DATA 0E19C526143A07A06FCD75BB3E40CD5A
1070 DATA BBC13A07A03C3207A04779B820E42601
1080 DATA 2E19CD75BB3E013207A0470E15C53E40
1090 DATA CD5ABBC13A07A03C3207A04779B820ED
1100 DATA 3A01A0673A02A06FCD75BB3E4FCD5ABB
1110 DATA 26013A03A06FCD75BB3E7CCD5ABB2601
1120 DATA 3A04A06FCD75BB3E7CCD5ABB3A00A0FE
1130 DATA 01DA2D423E04CD90BB3E00CD1EBB283F
1140 DATA 3A03A0FE03383826013A04A06FCD75BB
1150 DATA 3E20CD5ABB3A03A03D3203A03A04A03D
1160 DATA 3204A026013A03A06FCD75BB3E7CCD5A
1170 DATA BB26013A04A06FCD75BB3E7CCD5ABB3E
1180 DATA 02CD1EBB283F3A03A0FE17303826013A
1190 DATA 03A06FCD75BB3E20CD5ABB3A03A03C32
1200 DATA 03A03A04A03C3204A026013A03A06FCD
1210 DATA 75BB3E7CCD5ABB26013A04A06FCD75BB
1220 DATA 3E7CCD5ABB3A01A0673A02A06FCD75BB
1230 DATA 3E20CD5ABB3A05A0473A01A0803201A0
1240 DATA 3A01A0FE1338053EFF3205A03A06A047
1250 DATA 3A02A0803202A03E03CD90BB3A01A067
1260 DATA 3A02A06FCD75BB3E4FCD5ABB3E013207
1270 DATA A0470E04C5CD19BDC13A07A03C3207A0
1280 DATA 4779B820EF3A01A0FE02201E3A03A047
1290 DATA 3A02A0B820053E013205A03A04A0473A
1300 DATA 02A0B820053E013205A03A02A0FE1838
1310 DATA 053EFF3206A03A02A0FE0330053E0132
1320 DATA 06A03A01A0FE0120213A00A03D3200A0
1330 DATA 3A01A0673A02A06FCD75BB3E20CD5ABB
1340 DATA 3E0A3201A03E013205A0C3CC40CD09BB
1350 DATA FE20280218F73E01CD90BBC900000000
1360 DATA 7ECD5ABB23A720F8C900000000000000
1370 DATA 04301C304B4B1D303000000000000000
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:04, 07 June 20

Latest version allows the testing of pixels though the LET command with b(n) holding the pixel colour found. Unlike Locomotive BASIC TEST, the function is simply called 't(xpos,ypos)', with xpos and/or ypos either being an integer variable 'i(n)' or number.


I made some improvements from the last version, one of my while..wend code samples was producing something which was wrong, which had to do with what values were being checked when '=' was found and if a jump should take place.
Also, if while k<>""..wend is used, a looping routine is used to clear the buffer that way.
The if routine was altered again in an attempt to kinda clear up the code, but not use WHILE..WEND which is slightly slower, in the process I found additional code following on my second WHILE..WEND routine to check if 'k' is being used, which is now removed.
Some improvement in the LET routine now, so if a byte variable equals 0, 'xor a' is used instead of 'ld a,0'


At the moment the only messy code is the LET routine because it does so much, and will get larger when a random number routine is added to it.




Latest version:

100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF10)<>221 THEN LOAD"rtine2.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:a$=a$+"CD90BB":GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 IF a$="WHILE" THEN GOSUB 4000
270 IF a$="WEND" THEN GOSUB 4200
280 IF a$="FLY" THEN a$="CD19BD":GOSUB 1000
290 CLEAR
300 GOTO 140


999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN


1099 ' Delete any old routines if found
1100 CALL &B050
1150 RETURN


1151 ' Move Code for Jump Routines and then clean up code
1152 CALL &B060,s,d,l
1153 CALL &B060,d,s+jb,l
1154 CALL &B060,d+1,d+2,l
1155 RETURN


1159 ' Check Locate Routine
1160 CALL &AF10,n(1),n(2),t
1170 a=&AF00:a$=""
1180 WHILE PEEK(a)<>255 OR PEEK(a+1)<>255
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN


1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN


1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))+3
1906 RETURN
1907 a=INSTR(c$,CHR$(34))+1:RETURN
1908 a=instr(c$,"(")+1:RETURN
1909 a=instr(c$,")")+1:RETURN


1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN


2099 ' Search parameters for values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN


2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN


2299 ' Search PRINT strings and store to memory.
2300 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$)
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1 ' if string ptr has reached 255 characters, place to the next byte block, otherwise continue along path.
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN


2399 ' Check if Character or String
2400 IF PEEK(&BE83)*256+PEEK(&BE82)>PEEK(&BE85)*256+PEEK(&BE84)+2 THEN GOSUB 2420:RETURN ELSE IF LEN(c$)>5 AND LEN(c$)<=9 THEN GOSUB 2410:RETURN ELSE RETURN


2409 ' If Character is found use this routine
2410 p1=INSTR(c$,CHR$(34))+1
2411 a$="3E"+HEX$(ASC(MID$(c$,p1,1)),2)+"CD5ABB":RETURN


2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(&8000)=0
2440   a$="7ECD5ABB23A720F8C9"
2450   WHILE p1<=LEN(a$)
2460     POKE &7FFF+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN


2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFE+(PEEK(&BF00)*3),k
2531 POKE &BEFF+(PEEK(&BF00)*3),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*3),PEEK(&BE81):RETURN


2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*3,0:POKE &BEFE+(PEEK(&BF00)*3),0
2551 POKE &BF00+PEEK(&BF00)*3,0:POKE &BF00,PEEK(&BF00)-1:RETURN


2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOTO 2780
2620 GOSUB 2220:GOSUB 1900
2621 IF INSTR(c$,"t") THEN n2=n:c=0:GOTO 2881
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2650 GOSUB 1902:IF e$="b" THEN s1=3:n2=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2660 IF s1=3 THEN a$=a$+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2710 GOSUB 1230
2720 IF s1=1 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3C":NEXT l
2730 IF s1=2 THEN GOSUB 2771:FOR l=1 TO n2:a$=a$+"3D":NEXT l
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2760 IF s1=0 THEN IF n2<>0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE a$="AF32"+hex$(peek(&be86)+n,2)+hex$(peek(&be87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN


2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN


' test routine
2881 GOSUB 1908
2882 IF MID$(c$,a,1)="i" THEN GOSUB 2220:a$=a$+"2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2) ELSE s1=2:GOSUB 2800:a$=a$+"21"+hi$+lo$
2883 IF c=0 THEN a$=a$+"EB"
2884 a=a+1:IF MID$(c$,a,1)="," THEN c=c+1:a=a+1:GOTO 2882
2885 a$=a$+"CDF0BB32"+HEX$(PEEK(&be86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN


2999 ' FOR Loop
3000 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710:a$=a$+"47"
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 GOSUB 2530
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN


3049 ' NEXT
3050 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF+(PEEK(&BF00)*3)),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)*3)),2):GOSUB 1000:GOSUB 3130
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 GOSUB 2550:RETURN


3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902
3501 IF e$="b" THEN GOSUB 3502:GOSUB 2530:RETURN ELSE IF e$="k" THEN GOSUB 3511:GOSUB 2530:RETURN
3502 GOSUB 2220
3503 a=a+1
3504 GOSUB 1902
3505 IF e$="=" THEN a=a+1:k=1 ELSE IF e$="<" THEN a=a+1:k=3 ELSE IF e$=">" THEN a=a+1:k=4
3506 IF MID$(c$,a,1)<>"b" THEN GOSUB 1230:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE GOSUB 3528:f=1
3507 IF n2<>0 AND f=0 THEN a$=a$+"FE"+HEX$(n2,2):GOSUB 1000 ELSE IF n2=0 AND f=0 THEN a$=a$+"A7":GOSUB 1000
3508 RETURN


' key test routine
3511 GOSUB 2220
3512 a$="3E"+HEX$(n,2)+"CD1EBB"
3513 GOSUB 1000
3514 k=2
3517 RETURN
3528 n3=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"47"
3529 a$=a$+"3A"+HEX$(PEEK(&BE86)+n3,2)+HEX$(PEEK(&BE87),2)+"B8"
3530 GOSUB 1000:RETURN


3699 ' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN GOSUB 3762
3750 IF jb=2 AND ss=0 THEN GOSUB 1905:l=l-3:GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3762 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3764,3765,3766,3767
3763 a$=a$+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2):GOSUB 3779:RETURN
3764 a$="C2":RETURN
3765 a$="CA":RETURN
3766 a$="D2":RETURN
3767 a$="DA":RETURN
3770 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3772,3773,3774,3775
3771 a$=a$+HEX$(l,2):GOSUB 3779:RETURN
3772 a$="20":RETURN
3773 a$="28":RETURN
3774 a$="30":RETURN
3775 a$="38":RETURN
3779 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN


3999 ' WHILE
4000 a$="":GOSUB 1901
4001 IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=a+1:GOSUB 2530:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):GOSUB 4031
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:a$="CD09BB"
4020 IF MID$(c$,a+1,1)="=" THEN a$=a$+"A7":POKE &AF0E,&20:POKE &AF0F,&C2
4021 IF MID$(c$,a+1,2)="<>" THEN IF MID$(c$,a+3,2)<>CHR$(34)+CHR$(34) THEN GOSUB 1907:a$=a$+"FE"+HEX$(ASC(MID$(c$,a,1)),2):POKE &AF0E,&28:POKE &AF0F,&CA ELSE a$=a$+"A7":POKE &AF0E,&28:POKE &AF0F,&CA
4030 GOSUB 1000:GOSUB 2530:RETURN


' check byte variable conditions
4031 IF MID$(c$,a,1)="<" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&30:POKE &AF0F,&D2
4032 IF MID$(c$,a,1)=">" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&38:POKE &AF0F,&DA
4033 IF MID$(c$,a,1)="=" THEN a=a+1:GOSUB 1230:GOSUB 4035:POKE &AF0E,&20:POKE &AF0F,&C2
4034 RETURN
4035 IF n2=0 THEN a$=a$+"A7" ELSE a$=a$+"FE"+HEX$(n2,2):RETURN


4199 ' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 4220:RETURN
4210 a$="C3"+HEX$(PEEK(&BEFF+(PEEK(&BF00)-1)*3),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3),2):GOSUB 1000
4211 jb=3:ss=1:a$=HEX$(PEEK(&AF0F),2)+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2)
4212 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN
4220 a$="18":GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*3)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
4241 jb=2:ss=1:GOSUB 1905:l=l-3:a$=HEX$(PEEK(&AF0E),2)+HEX$(l,2)
4250 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN



With the addition of testing pixel colour, the simple platform example I made a couple of years back can be created (minus the sprites or redefined graphics).



cls
locate 1,1
print "[ctrl]+[d][0]
       [ctrl]+["]"][@][@]
       [ctrl]+[\][0][C][C]
       [ctrl]+[\][1][Z][Z]
       [ctrl]+[\][3][R][R]"
let b(1)=3
while b(1)<10
for b(0)=1 to 20
pen 1
locate b(0),b(1)
print "@"
next b(0)
let b(1)=+3
wend


locate 5,3
print " "
locate 17,6
print " "
let b(0)=1
let b(1)=1
let b(2)=0


let i(0)=4
let i(1)=382
locate b(0),b(1)
pen 3
print "*"


while b(2)=0
let b(3)=t(i(0),i(1))
if b(3)=0
locate b(0),b(1)
print " "
let b(1)=+1
let i(1)=-16
locate b(0),b(1)
print "*"
endif


if k(8)
if b(0)>2
if b(3)=1
locate b(0),b(1)
print " "
let b(0)=-1
let i(0)=-32
locate b(0),b(1)
print "*"
endif
endif
endif


if k(1)
if b(0)<20
if b(3)=1
locate b(0),b(1)
print " "
let b(0)=+1
let i(0)=+32
locate b(0),b(1)
print "*"
endif
endif
endif


for b(4)=1 to 2
fly
next b(4)


if b(1)=8
if b(0)=20
let b(2)=1
endif
endif
wend


while k<>""
wend
locate 1,10
pen 1



And the Output source code for it:


100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=28:GOSUB 200
120 RESTORE 1280:addr=&8000:n=1:GOSUB 200
130 RESTORE 1290:addr=&9000:n=3:GOSUB 200
140 CALL &4000
150 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC26012E01CD75BB210090CD0080
1010 DATA 3E033201A03A01A0FE0A30363E013200
1020 DATA A0470E15C53E01CD90BB3A00A0673A01
1030 DATA A06FCD75BB3E40CD5ABBC13A00A03C32
1040 DATA 00A04779B820DD3A01A03C3C3C3201A0
1050 DATA 18C326052E03CD75BB3E20CD5ABB2611
1060 DATA 2E06CD75BB3E20CD5ABB3E013200A03E
1070 DATA 013201A0AF3202A02104002200A1217E
1080 DATA 012202A13A00A0673A01A06FCD75BB3E
1090 DATA 03CD90BB3E2ACD5ABB3A02A0A7C29F41
1100 DATA 2A00A1EB2A02A1CDF0BB3203A03A03A0
1110 DATA A720313A00A0673A01A06FCD75BB3E20
1120 DATA CD5ABB3A01A03C3201A02A02A111F0FF
1130 DATA 192202A13A00A0673A01A06FCD75BB3E
1140 DATA 2ACD5ABB3E08CD1EBB283F3A00A0FE02
1150 DATA 38383A03A0FE0120313A00A0673A01A0
1160 DATA 6FCD75BB3E20CD5ABB3A00A03D3200A0
1170 DATA 2A00A111E0FF192200A13A00A0673A01
1180 DATA A06FCD75BB3E2ACD5ABB3E01CD1EBB28
1190 DATA 3F3A00A0FE1430383A03A0FE0120313A
1200 DATA 00A0673A01A06FCD75BB3E20CD5ABB3A
1210 DATA 00A03C3200A02A00A1112000192200A1
1220 DATA 3A00A0673A01A06FCD75BB3E2ACD5ABB
1230 DATA 3E013204A0470E03C5CD19BDC13A04A0
1240 DATA 3C3204A04779B820EF3A01A0FE08200C
1250 DATA 3A00A0FE1420053E013202A0C39940CD
1260 DATA 09BBA7280218F826012E0ACD75BB3E01
1270 DATA CD90BBC9000000000000000000000000
1280 DATA 7ECD5ABB23A720F8C900000000000000
1290 DATA 04301D40401C3043431C315A5A1C3352
1300 DATA 52004000200020002A0020002A002000
1310 DATA 2A0020002A0000000000000000000000
Title: Re: TBAS - writing a little computer language
Post by: funkheld on 12:50, 03 July 20


can you convert the data code into asm-source?


so you can't see if it's well or badly programmed.  8)


and which compiler was used.  8)


greeting





1000 DATA CD14BC26012E01CD75BB210090CD0080
1010 DATA 3E033201A03A01A0FE0A30363E013200
1020 DATA A0470E15C53E01CD90BB3A00A0673A01
1030 DATA A06FCD75BB3E40CD5ABBC13A00A03C32
1040 DATA 00A04779B820DD3A01A03C3C3C3201A0
1050 DATA 18C326052E03CD75BB3E20CD5ABB2611
1060 DATA 2E06CD75BB3E20CD5ABB3E013200A03E
1070 DATA 013201A0AF3202A02104002200A1217E
1080 DATA 012202A13A00A0673A01A06FCD75BB3E
1090 DATA 03CD90BB3E2ACD5ABB3A02A0A7C29F41
1100 DATA 2A00A1EB2A02A1CDF0BB3203A03A03A0
1110 DATA A720313A00A0673A01A06FCD75BB3E20
1120 DATA CD5ABB3A01A03C3201A02A02A111F0FF
1130 DATA 192202A13A00A0673A01A06FCD75BB3E
1140 DATA 2ACD5ABB3E08CD1EBB283F3A00A0FE02
1150 DATA 38383A03A0FE0120313A00A0673A01A0
1160 DATA 6FCD75BB3E20CD5ABB3A00A03D3200A0
1170 DATA 2A00A111E0FF192200A13A00A0673A01
1180 DATA A06FCD75BB3E2ACD5ABB3E01CD1EBB28
1190 DATA 3F3A00A0FE1430383A03A0FE0120313A
1200 DATA 00A0673A01A06FCD75BB3E20CD5ABB3A
1210 DATA 00A03C3200A02A00A1112000192200A1
1220 DATA 3A00A0673A01A06FCD75BB3E2ACD5ABB
1230 DATA 3E013204A0470E03C5CD19BDC13A04A0
1240 DATA 3C3204A04779B820EF3A01A0FE08200C
1250 DATA 3A00A0FE1420053E013202A0C39940CD
1260 DATA 09BBA7280218F826012E0ACD75BB3E01
1270 DATA CD90BBC9000000000000000000000000
1280 DATA 7ECD5ABB23A720F8C900000000000000
1290 DATA 04301D40401C3043431C315A5A1C3352
1300 DATA 52004000200020002A0020002A002000
1310 DATA 2A0020002A0000000000000000000000
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 04:29, 04 July 20


Quote from: funkheld on 12:50, 03 July 20

can you convert the data code into asm-source?


so you can't see if it's well or badly programmed.  8) 

Due to the small nature of the language I've coded, it's easy to convert to assembly, though the main function of the language is to take BASIC-like statements and convert to Machine Code and have the code Running in it's own little Environment and hopefully develop for small scale code.


Coding from a high-level language to Machine Code will always real bits of assembly that can be improved, the main one I can see is when locate b(0),b(1) is used. In that case the accumulator has to load contents of b(0) or b(1) and place into it's respected h or l register, instead of:


ld hl,(value address)


to place the contents straight into. I think the problem I had there was if other statements with constant values are used like 'locate b(0),10' or 'locate 5,b(1)' were being evaluated. I used a bit of assembly to assess the possibilities, so maybe I can improve code if 'locate b(0),b(1)' were used for example.


In other parts of the language I've been able to improve code when certain things are used, such as let b(3)=0 which can be improved from 'ld a,0 , ld (&a003),a' to 'xor a , ld (&a003),a'. Since the last release string management has been improved, so now only strings 2 characters or more are stored, in the string handling area, so all those single characters won't be stored in the string handling area (as shown in the assembly or machine code output).

Quote
and which compiler was used.  8)


greeting



It's been written in Locomotive BASIC, though the Assembly parts were written with the Winape Assembler, which is compatable with the MAXAM Assembler.


The Machine Code output comes from the Winape Debugger along with the Assembly Code below, I've modified labels and the print routine and string data, so it doesn't reside at &8000 or &9000, which leaves the code occupying under &200 bytes.



org &4000


call &bc14 ;; cls


ld h,&01
ld l,&01
call &bb75 ;; locate 1,1


ld hl,strdat
call print


ld a,&03
ld (&a001),a ;; let b(1)=3
.setupscr ;; while b(1)<10
ld a,(&a001)
cp &0a
jr nc,exit1 ;; jump when b(1)>10


ld a,&01
ld (&a000),a ;; for b(0)=1
ld b,a
ld c,&15 ;; to 21
.fl1 ;; for loop while b(0)<21
push bc ;; preserve loop contents


ld a,&01
call &bb90 ;; pen 1


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&40
call &bb5a ;; print "@"


pop bc ;; restore loop contents


ld a,(&a000) ;; b(0)
inc a
ld (&a000),a ;; b(0)=b(0)+1


ld b,a ;; new position of b(0)
ld a,c ;; 21 is stored in accumulator
cp b ;; and check with contents of b(0)
jr nz,fl1 ;; exit if reached, else jump back


ld a,(&a001)
inc a
inc a
inc a
ld (&a001),a ;; let b(1)=+3
;; this is the ypos position


jr setupscr ;; wend
.exit1 ;; jump here if b(1)>10


ld h,&05
ld l,&03
call &bb75 ;; locate 5,3


ld a,&20
call &bb5a ;; print " " place hole in platform


ld h,&11
ld l,&06
call &bb75 ;; locate 17,6


ld a,&20
call &bb5a ;; print " " place 2nd hole...


ld a,&01
ld (&a000),a ;; let b(0)=1


ld a,&01
ld (&a001),a ;; let b(1)=1


xor a
ld (&a002),a ;; let b(2)=0


ld hl,&0004
ld (&a100),hl ;; let i(0)=4


ld hl,&017e
ld (&a102),hl ;; let i(1)=382


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&03
call &bb90 ;; pen 3


ld a,&2a
call &bb5a ;; print "*"


.mainloop ;; while b(2)=0
ld a,(&a002) ;; b(2)
and a ;; =0
jp nz,nexbit ;; jump if b(2)<>0


ld hl,(&a100)
ex de,hl
ld hl,(&a102)
call &bbf0
ld (&a003),a
ld a,(&a003) ;; let b(3)=t(i(0),i(1))
;; test(i(0),i(1)) and return
;; result to b(3).


and a
jr nz,tstf1 ;; if b(3)=0


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&20
call &bb5a ;; print " "


ld a,(&a001)
inc a
ld (&a001),a ;; let b(1)=+1


ld hl,(&a102)
ld de,&fff0
add hl,de
ld (&a102),hl ;; let i(1)=-16


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&2a
call &bb5a ;; print "*"


.tstf1 ;; endif, jump here if test false
ld a,&08
call &bb1e ;; if k(8) - test keyboard input left cursor
jr z,knf1 ;; jump if not found


ld a,(&a000)
cp &02
jr c,knf1 ;; if b(0)>2
;; prevent moving character offscreen


ld a,(&a003)
cp &01
jr nz,knf1 ;; if b(3)=1


;; a jump is made here if a part of the platform is found,
;; to prevent character from erasing it.

;; In BASIC it would look like a:
;; if inkey(8)=0 then if x>2 then if test(x,y)=0 then ...
;; though from assembly things are reversed, to execute the
;; following code when jumps are not done.


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&20
call &bb5a ;; print " "


ld a,(&a000)
dec a
ld (&a000),a ;; let b(0)=-1


ld hl,(&a100)
ld de,&ffe0
add hl,de
ld (&a100),hl ;; let i(0)=-32


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&2a
call &bb5a ;; print "*"


.knf1 ;; endif


ld a,&01
call &bb1e
jr z,knf2 ;; if k(1)


ld a,(&a000)
cp &14
jr nc,knf2 ;; if b(0)<20


ld a,(&a003)
cp &01
jr nz,knf2 ;; if b(3)=1


ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&20
call &bb5a ;; print " "


ld a,(&a000)
inc a
ld (&a000),a ;; let b(0)=+1


ld hl,(&a100)
ld de,&0020
add hl,de
ld (&a100),hl ;; let i(0)=+32

ld a,(&a000)
ld h,a
ld a,(&a001)
ld l,a
call &bb75 ;; locate b(0),b(1)


ld a,&2a
call &bb5a ;; print "*"


.knf2 ;; endif


ld a,&01
ld (&a004),a
ld b,a
ld c,&03 ;; for b(4)=1 to 3
.fl2 ;; loop
push bc


call &bd19 ;; fly - frame flyback


pop bc


ld a,(&a004)
inc a
ld (&a004),a ;; b(4)=b(4)+1


ld b,a
ld a,c
cp b ;; does b(4)=3 ?
jr nz,fl2 ;; jump if not reached


ld a,(&a001)
cp &08
jr nz,no ;; if b(1)=8


ld a,(&a000)
cp &14
jr nz,no ;; if b(0)=20


ld a,&01
ld (&a002),a ;; let b(2)=1


;; so when my character reaches the bottom platform on the right hand
;; side of screen, b(2) equals 1 and cause my while loop from earlier
;; to exit, back to the tbas environment.


.no ;; jump here if not found
jp mainloop
.nexbit


call &bb09
and a
jr z,fnd ;; while k<>"" - flush keyboard handler
jr nexbit
.fnd


ld h,&01
ld l,&0a
call &bb75 ;; locate 1,10


ld a,&01
call &bb90 ;; pen 1
ret


.print
ld a,(hl)
call &bb5a
inc hl
and a
jr nz,print
ret


.strdat


defb &04,&30,&1d,&40,&40,&1c,&30,&43
defb &43,&1c,&31,&5a,&5a,&1c,&33,&52
defb &52,&00,&40,&00,&20,&00,&20,&00
defb &2a,&00,&20,&00,&2a,&00,&20,&00
defb &2a,&00,&20,&00,&2a,&00,&00,&00
defb &00,&00,&00,&00,&00,&00,&00,&00


Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 08:24, 05 July 20
An update of the latest version of this language can be found in the opening thread.


An improvement was made in the string section, so a single character isn't stored now where lengthy strings are stored.


Two more functions are now available through the LET command:-


* m(<num,b(num)> - to handle mod operations, which can either be a number of a byte variable with number assigned to it.
* r(<num)<+num> - to handle simple byte numbers between 0..255, optionally a second number can be added if random nunbers of a certain range are given.


MOD and Random Number Demostration (begins with the mod, press any key for the random number demo):


cls
let b(0)=1
let b(1)=1
let b(2)=0
while k=""
let b(0)=+1
let b(2)=+1
let b(2)=m(5)
if b(2)=0
locate b(0),b(1)
print "*"
endif
if b(0)=79
let b(0)=1
let b(1)=+1
endif
if b(1)=26
let b(1)=1
endif
wend
cls
for b(3)=1 to 80
let b(0)=r(40)+1
let b(1)=r(20)+1
locate b(0),b(1)
print "*"
next b(3)



Output Demo of code above:


100 MEMORY &3FFF:DEFINT l,n,p
110 RESTORE 1000:addr=&4000:n=11:GOSUB 200
120 RESTORE 1110:addr=&8000:n=3:GOSUB 200
130 CALL &4000
140 END
200 FOR l=1 TO n
210   READ a$
220   FOR p=1 TO 31 STEP 2
230     POKE addr,VAL("&"+MID$(a$,p,2))
240     addr=addr+1
250   NEXT p
260 NEXT l
270 RETURN
1000 DATA CD14BC3E013200A03E013201A0AF3202
1010 DATA A0CD09BBA720533A00A03C3200A03A02
1020 DATA A03C3202A03A02A00605CD1C803202A0
1030 DATA 3A02A0A720103A00A0673A01A06FCD75
1040 DATA BB3E2ACD5ABB3A00A0FE4F200C3E0132
1050 DATA 00A03A01A03C3201A03A01A0FE192008
1060 DATA 3E013201A0CD14BC18A7CD14BC3E0132
1070 DATA 03A0470E51C5CD0C800628CD1C803C32
1080 DATA 00A0CD0C800614CD1C803C3201A03A00
1090 DATA A0673A01A06FCD75BB3E2ACD5ABBC13A
1100 DATA 03A03C3203A04779B820CAC900000000
1110 DATA 0000000000000000008428002A0980ED
1120 DATA 5F575F19AD87AC6F220980C99030FD80
1130 DATA C9000000000000000000000000000000
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:18, 12 July 20
A little update today and now the language can print the extended character set by allowing PRINT to print the value from a Byte Variable.



100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF10)<>221 THEN LOAD"rtine2.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-";c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:a$=a$+"CD90BB":GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 IF a$="WHILE" THEN GOSUB 4000
270 IF a$="WEND" THEN GOSUB 4200
280 IF a$="FLY" THEN a$="CD19BD":GOSUB 1000
290 CLEAR
300 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &B050
1150 RETURN
1151 ' Move Code for Jump Routines and then clean up code
1152 CALL &B060,s,d,l
1153 CALL &B060,d,s+jb,l
1154 CALL &B060,d+1,d+2,l
1155 RETURN
1159 ' Check Locate Routine
1160 CALL &AF10,n(1),n(2),t
1170 a=&AF00:a$=""
1180 WHILE PEEK(a)<>255 OR PEEK(a+1)<>255
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))+3
1906 RETURN
1907 a=INSTR(c$,CHR$(34))+1:RETURN
1908 a=INSTR(a,c$,"(")+1:RETURN
1909 a=INSTR(a,c$,")")+1:RETURN
1910 a=INSTR(c$,","):RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for 8bit values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN
2299 ' Search PRINT variables or strings and store to memory.
2300 GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"CD5ABB":sk=1:RETURN
2309 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$):RETURN
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1 ' if string ptr has reached 255 characters, place to the next byte block, otherwise continue along path.
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String and Skip if a variable.
2400 IF sk=1 THEN RETURN ELSE IF p<8 THEN RETURN ELSE IF p+1=d THEN GOSUB 2410:RETURN ELSE GOSUB 2350:adr=&7FFF:sl=1:GOSUB 2420:RETURN
2409 ' If Character is found use this routine
2410 GOSUB 1907
2411 a$="3E"+HEX$(ASC(MID$(c$,a,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(adr+1)=0
2440   ON sl GOSUB 2511,2512
2450   WHILE p1<=LEN(a$)
2460     POKE adr+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2511 a$="7ECD5ABB23A720F8C9":RETURN
2512 a$="2A0980ED5F575F19AD87AC6F220980C99030FD80C9":RETURN
2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFE+(PEEK(&BF00)*3),k
2531 POKE &BEFF+(PEEK(&BF00)*3),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*3),PEEK(&BE81):RETURN
2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*3,0:POKE &BEFE+(PEEK(&BF00)*3),0
2551 POKE &BF00+PEEK(&BF00)*3,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOSUB 2780:RETURN
2620 GOSUB 2220:GOSUB 1900
2621 IF MID$(c$,a,1)="t" THEN n2=n:GOSUB 2881:RETURN
2622 IF MID$(c$,a,1)="r" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 2220:a$="CD0C8006"+HEX$(n,2)+"CD1C80":n=n2
2623 IF MID$(c$,a,1)="m" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 1908:sl=3
2624 IF sl=3 THEN IF MID$(c$,a,1)="b" THEN GOSUB 2220:GOSUB 2886:RETURN ELSE n=n2:GOSUB 1230:GOSUB 2887:RETURN
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2641 IF sl=2 THEN GOTO 2710
2650 GOSUB 1902:IF e$="b" THEN s1=3:n2=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2660 IF s1=3 THEN a$=a$+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2710 GOSUB 1230
2720 IF s1=1 THEN IF sl=0 THEN GOSUB 2771:b$="3C":GOSUB 2772 ELSE IF s1=1 THEN IF sl=2 THEN b$="3C":GOSUB 2772
2730 IF s1=2 THEN IF sl=0 THEN GOSUB 2771:b$="3D":GOSUB 2772 ELSE IF s1=2 THEN IF sl=2 THEN b$="3D":GOSUB 2772
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2741 IF sl=2 THEN RETURN
2760 IF s1=0 THEN IF n2<>0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE a$="AF32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2772 FOR l=1 TO n2
2773   a$=a$+b$
2774 NEXT l:RETURN
2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2881 GOSUB 1908
2882 IF MID$(c$,a,1)="i" THEN GOSUB 2220:a$=a$+"2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2) ELSE s1=2:GOSUB 2800:a$=a$+"21"+hi$+lo$
2883 IF c=0 THEN a$=a$+"EB"
2884 a=a+1:IF MID$(c$,a,1)="," THEN c=c+1:a=a+1:GOTO 2882
2885 a$=a$+"CDF0BB32"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2886 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"CD1C8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2887 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"06"+HEX$(n2,2)+"CD1C8032"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2999 ' FOR Loop
3000 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710:a$=a$+"47"
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 GOSUB 2530
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF+(PEEK(&BF00)*3)),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)*3)),2):GOSUB 1000:GOSUB 3130
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 GOSUB 2550:RETURN
3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902
3501 IF e$="b" THEN GOSUB 3502:GOSUB 2530:RETURN ELSE IF e$="k" THEN GOSUB 3511:GOSUB 2530:RETURN
3502 GOSUB 2220
3503 a=a+1
3504 GOSUB 1902
3505 IF e$="=" THEN a=a+1:k=1 ELSE IF e$="<" THEN a=a+1:k=3 ELSE IF e$=">" THEN a=a+1:k=4
3506 IF MID$(c$,a,1)<>"b" THEN GOSUB 1230:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE GOSUB 3528:f=1
3507 IF n2<>0 AND f=0 THEN a$=a$+"FE"+HEX$(n2,2):GOSUB 1000 ELSE IF n2=0 AND f=0 THEN a$=a$+"A7":GOSUB 1000
3508 RETURN
3511 GOSUB 2220
3512 a$="3E"+HEX$(n,2)+"CD1EBB"
3513 GOSUB 1000
3514 k=2
3517 RETURN
3528 n3=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"47"
3529 a$=a$+"3A"+HEX$(PEEK(&BE86)+n3,2)+HEX$(PEEK(&BE87),2)+"B8"
3530 GOSUB 1000:RETURN
3699 ' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN GOSUB 3762
3750 IF jb=2 AND ss=0 THEN GOSUB 1905:l=l-3:GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3762 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3764,3765,3766,3767
3763 a$=a$+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2):GOSUB 3779:RETURN
3764 a$="C2":RETURN
3765 a$="CA":RETURN
3766 a$="D2":RETURN
3767 a$="DA":RETURN
3770 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3772,3773,3774,3775
3771 a$=a$+HEX$(l,2):GOSUB 3779:RETURN
3772 a$="20":RETURN
3773 a$="28":RETURN
3774 a$="30":RETURN
3775 a$="38":RETURN
3779 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN
3999 ' WHILE
4000 a$="":GOSUB 1901
4001 IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=a+1:GOSUB 2530:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):GOSUB 4031
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:a$="CD09BB"
4020 IF MID$(c$,a+1,1)="=" THEN a$=a$+"A7":POKE &AF0E,&20:POKE &AF0F,&C2
4021 IF MID$(c$,a+1,2)="<>" THEN IF MID$(c$,a+3,2)<>CHR$(34)+CHR$(34) THEN GOSUB 1907:a$=a$+"FE"+HEX$(ASC(MID$(c$,a,1)),2):POKE &AF0E,&28:POKE &AF0F,&CA ELSE a$=a$+"A7":POKE &AF0E,&28:POKE &AF0F,&CA
4030 GOSUB 1000:GOSUB 2530:RETURN
4031 IF MID$(c$,a,1)="<" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&30:POKE &AF0F,&D2
4032 IF MID$(c$,a,1)=">" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&38:POKE &AF0F,&DA
4033 IF MID$(c$,a,1)="=" THEN a=a+1:GOSUB 1230:GOSUB 4035:POKE &AF0E,&20:POKE &AF0F,&C2
4034 RETURN
4035 IF n2=0 THEN a$=a$+"A7":RETURN ELSE a$=a$+"FE"+HEX$(n2,2):RETURN
4199 ' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 4220:RETURN
4210 a$="C3"+HEX$(PEEK(&BEFF+(PEEK(&BF00)-1)*3),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3),2):GOSUB 1000
4211 jb=3:ss=1:a$=HEX$(PEEK(&AF0F),2)+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2)
4212 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN
4220 a$="18":GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*3)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
4241 jb=2:ss=1:GOSUB 1905:l=l-3:a$=HEX$(PEEK(&AF0E),2)+HEX$(l,2)
4250 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN



The only tricky thing with it is if it's in a FOR loop, I noticed the Assembly Loop routine exit when the value specified following 'TO' finishes the Loop, though in this language I rectified this earlier to add 1 to the value specified, the problem then becomes if that value is 255, add 1 to that and it's zero, which is why the following code appears the way it does:



cls
locate 1,1
for b(0)=32 TO 254
print b(0)
next b(0)
let b(0)=255
print b(0)
locate 1,10
print "!"



Assembly generated:



org &4000


call &bc14 ;; cls
ld h,&01
ld l,&01
call &bb75 ;; locate 1,1
ld a,&20
ld (&a000),a
ld b,a
ld c,&ff ;; for b(0)=32 to 255
.fl1 ;; for loop
push bc ;; preserve counter
ld a,(&a000)
call &bb5a ;; print b(0)
pop bc ;; restore counter
ld a,(&a000)
inc a
ld (&a000),a ;; b(0)=b(0)+1
ld b,a
ld a,c
cp b ;; counter reached
jr nz,fl1 ;; jump if not else exit
ld a,&ff
ld (&a000),a ;; let b(0)=255
ld a,(&a000)
call &bb5a ;; print b(0)
ld h,&01
ld l,&0a
call &bb75 ;; locate 1,10
ld a,&21
call &bb5a ;; print "!"
ret ;; return to tbas



@funkheld (https://www.cpcwiki.eu/forum/index.php?action=profile;u=354) - I'm happy if you've found a language to suit your needs, this one I'm writing to understand Language coding and produce small tight Assembly which can be executed while in Memory. I don't code large Commercial like Games as this List Suggests (https://www.cpc-power.com/index.php?page=staff&lenom=Out%20Bush) and only have simple ideas for games. Like the games, this language is a simple one, it's got no error handling, though some of the ideas I got while coding Jacks Bubble Island (https://www.cpc-power.com/index.php?page=detail&num=17032), such that the use of Address Pointers to preserve important variables are used here, so once code is translated into Machine Code, String variables can be cleared, which is one of the things that seperates this language from other BASIC Compiled Languages written in Locomotive BASIC. Commands are immediately converted to Machine Code, which is the pause time experienced when ENTER/RETURN is pressed, at the moment only single commands can be used, at some stage I hope to implement a colon ':' to make more BASIC like and allow to enter multiple commands along a line. The code generated is very good, there's no Library smacked on top for the main programme to search for, so for instance if you don't use PRINT "<STRING>" routine, it's not added, PRINTing a Single Character won't add one either and now even single Characters won't be added to the String Area, in other areas Assembly has been optimised for when variables equal zero and even if certain WHILE conditions are used as well, so I think I've done quite well optimizing that into this small language.

Title: Re: TBAS - writing a little computer language
Post by: ervin on 05:16, 13 July 20
This is *very* cool.
However I'm having some trouble figuring out how to run it, and have a play with your language.
What do I need to do?
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:04, 13 July 20
Quote from: ervin on 05:16, 13 July 20
This is *very* cool.
However I'm having some trouble figuring out how to run it, and have a play with your language.
What do I need to do?


Sorry, I keep updating the opening post with the dsk image (https://www.cpcwiki.eu/forum/programming/tbas-not-the-language-to-use/?action=dlattach;attach=31906) & Commands PDF file (https://www.cpcwiki.eu/forum/programming/tbas-not-the-language-to-use/?action=dlattach;attach=31905).


The BASIC language needs rtine2.bin (which is in the dsk image), but unfortunately the Assembly source is on my other computer and I keep forgetting to upload that as I've made some changes since rolling out routines.bin.


The DSK Image should load correctly (I hope), and the language is ready for input when :-[] appears. I use Notepad to type in the code because it's not very forgiving if mistakes are made. The only severe one I know of is if a FOR loop isn't closed with it's corresponding NEXT, because PUSH BC/POP BC is used to restore Loop Number Counter, though it would be possible to generate an Infinite Loop with WHILE and there's no way to return to a BASIC Language with that. I haven't added any save or load, the Winape Debugger Window has been my lifeline when grabbing the Assembly or Machine Code dump.

Title: Re: TBAS - writing a little computer language
Post by: ervin on 11:12, 13 July 20
Cool, thanks!
Title: Re: TBAS - writing a little computer language
Post by: ervin on 13:41, 13 July 20
Alrighty, I've had a go with it, and I'm afraid I get an error when I run 15.BAS from "tbas 12072020.dsk".
I get "Unexpected RETURN in 1150".

Really looking forward to trying this out though - it's a fascinating project.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:49, 14 July 20
Quote from: ervin on 13:41, 13 July 20
Alrighty, I've had a go with it, and I'm afraid I get an error when I run 15.BAS from "tbas 12072020.dsk".
I get "Unexpected RETURN in 1150".

Really looking forward to trying this out though - it's a fascinating project.


It appears to be a problem from my Machine Code routines.  ???


On the 464 it's totally acceptable as 00 bytes are used until &B08B, but the 6128 appears to have some stuff starting at &B06F.


This is a bit of a trouble spot I believe where Stack Pointers puts stuff, though I always recall an AA50 Type-In called 128k Memory Swapper using &AF00 area and storing quite a bit of DATA there. Otherwise, it would be good to have a Detailed Memory guide, so I could use some common safe areas on all the machines. I have the firmware guide, but I don't recall it outlining safe regions to store routines, though such a guide would be a big help.

EDIT: Correction, the Firmware guide by Bob Taylor and Thomas Defoe, has the detailed summary of addresses for 6128 & 464 and what's stored there. The area I used &AF00 is used for WHILE, FOR & GOSUB Stack, which begins at &AE70 on the 6128 and &AE8C on the 464, is &1FF in size, which results in that area used ceasing at &B06F on 664/6128 and &808B on 464. Unfortunately, the other area I'm using at &B0D0 to handle the code shifting the firmware guide doesn't tell me what it is. On 664/6128 it starts at &B0A5 is &5B bytes in size, and &B0C7 on 464 and is &39 bytes in size, which is meant to consist of &FF, though Winape has it as &00. I'm guessing it's something relating to BASIC, but I don't know what. The other higher end areas I'm using at &BE00 is &40 bytes of &FF on all systems and &BE80 being &80 bytes of &FF though the area maybe used as part of the Machine Stack, which begins at &BFFF.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 02:00, 15 July 20
Okay, have updated new DSK image (https://www.cpcwiki.eu/forum/programming/tbas-not-the-language-to-use/?action=dlattach;attach=31917) to opening thread, fingers crossed it works, have tried on 6128, 664 & 464 and haven't found any problems. I had to save 2 BINary files just so I wasn't saving Internal Machine Handling Stuff and dumping from the 6128 to the 464 and so, though the main offender in this case was the routine I used to move code around for when I'm handling Loops and IF statements, located initially at &B060 it was poking stuff past &B06E, I moved it to &B0D0 which appears to be Free Area on all CPCs - but as I said earlier, it doesn't feel like solid ground and I hope there's no hidden surprises I don't know about!  :o


Latest Source Code:



100 MODE 2:DEFINT a-z:MEMORY &3FFF
101 IF PEEK(&AF10)<>221 THEN LOAD"rtine2.bin":LOAD"rtine3.bin"
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-",c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:a$=a$+"CD90BB":GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 IF a$="WHILE" THEN GOSUB 4000
270 IF a$="WEND" THEN GOSUB 4200
280 IF a$="FLY" THEN a$="CD19BD":GOSUB 1000
290 CLEAR
300 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &B050
1150 RETURN
1151 ' Move Code for Jump Routines and then clean up code
1152 CALL &B0D0,s,d,l
1153 CALL &B0D0,d,s+jb,l
1154 CALL &B0D0,d+1,d+2,l
1155 RETURN
1159 ' Check Locate Routine
1160 CALL &AF10,n(1),n(2),t
1170 a=&AF00:a$=""
1180 WHILE PEEK(a)<>255 OR PEEK(a+1)<>255
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))+3
1906 RETURN
1907 a=INSTR(c$,CHR$(34))+1:RETURN
1908 a=INSTR(a,c$,"(")+1:RETURN
1909 a=INSTR(a,c$,")")+1:RETURN
1910 a=INSTR(c$,","):RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for 8bit values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN
2299 ' Search PRINT strings and store to memory.
2300 GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"CD5ABB":sk=1:RETURN
2309 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$):RETURN
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1 ' if string ptr has reached 255 characters, place to the next byte block, otherwise continue along path.
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF sk=1 THEN RETURN ELSE IF p<8 THEN RETURN ELSE IF p+1=d THEN GOSUB 2410:RETURN ELSE GOSUB 2350:adr=&7FFF:sl=1:GOSUB 2420:RETURN
2409 ' If Character is found use this routine
2410 GOSUB 1907
2411 a$="3E"+HEX$(ASC(MID$(c$,a,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(adr+1)=0
2440   ON sl GOSUB 2511,2512
2450   WHILE p1<=LEN(a$)
2460     POKE adr+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2511 a$="7ECD5ABB23A720F8C9":RETURN
2512 a$="2A0980ED5F575F19AD87AC6F220980C99030FD80C9":RETURN
2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFE+(PEEK(&BF00)*3),k
2531 POKE &BEFF+(PEEK(&BF00)*3),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*3),PEEK(&BE81):RETURN
2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*3,0:POKE &BEFE+(PEEK(&BF00)*3),0
2551 POKE &BF00+PEEK(&BF00)*3,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOSUB 2780:RETURN
2620 GOSUB 2220:GOSUB 1900
2621 IF MID$(c$,a,1)="t" THEN n2=n:GOSUB 2881:RETURN
2622 IF MID$(c$,a,1)="r" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 2220:a$="CD0C8006"+HEX$(n,2)+"CD1C80":n=n2
2623 IF MID$(c$,a,1)="m" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 1908:sl=3
2624 IF sl=3 THEN IF MID$(c$,a,1)="b" THEN GOSUB 2220:GOSUB 2886:RETURN ELSE n=n2:GOSUB 1230:GOSUB 2887:RETURN
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2641 IF sl=2 THEN GOTO 2710
2650 GOSUB 1902:IF e$="b" THEN s1=3:n2=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2660 IF s1=3 THEN a$=a$+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2710 GOSUB 1230
2720 IF s1=1 THEN IF sl=0 THEN GOSUB 2771:b$="3C":GOSUB 2772 ELSE IF s1=1 THEN IF sl=2 THEN b$="3C":GOSUB 2772
2730 IF s1=2 THEN IF sl=0 THEN GOSUB 2771:b$="3D":GOSUB 2772 ELSE IF s1=2 THEN IF sl=2 THEN b$="3D":GOSUB 2772
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2741 IF sl=2 THEN RETURN
2760 IF s1=0 THEN IF n2<>0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE a$="AF32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2772 FOR l=1 TO n2
2773   a$=a$+b$
2774 NEXT l:RETURN
2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2881 GOSUB 1908
2882 IF MID$(c$,a,1)="i" THEN GOSUB 2220:a$=a$+"2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2) ELSE s1=2:GOSUB 2800:a$=a$+"21"+hi$+lo$
2883 IF c=0 THEN a$=a$+"EB"
2884 a=a+1:IF MID$(c$,a,1)="," THEN c=c+1:a=a+1:GOTO 2882
2885 a$=a$+"CDF0BB32"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2886 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"CD1C8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2887 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"06"+HEX$(n2,2)+"CD1C8032"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2999 ' FOR Loop
3000 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710:a$=a$+"47"
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 GOSUB 2530
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF+(PEEK(&BF00)*3)),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)*3)),2):GOSUB 1000:GOSUB 3130
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 GOSUB 2550:RETURN
3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902
3501 IF e$="b" THEN GOSUB 3502:GOSUB 2530:RETURN ELSE IF e$="k" THEN GOSUB 3511:GOSUB 2530:RETURN
3502 GOSUB 2220
3503 a=a+1
3504 GOSUB 1902
3505 IF e$="=" THEN a=a+1:k=1 ELSE IF e$="<" THEN a=a+1:k=3 ELSE IF e$=">" THEN a=a+1:k=4
3506 IF MID$(c$,a,1)<>"b" THEN GOSUB 1230:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE GOSUB 3528:f=1
3507 IF n2<>0 AND f=0 THEN a$=a$+"FE"+HEX$(n2,2):GOSUB 1000 ELSE IF n2=0 AND f=0 THEN a$=a$+"A7":GOSUB 1000
3508 RETURN
3511 GOSUB 2220
3512 a$="3E"+HEX$(n,2)+"CD1EBB"
3513 GOSUB 1000
3514 k=2
3517 RETURN
3528 n3=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"47"
3529 a$=a$+"3A"+HEX$(PEEK(&BE86)+n3,2)+HEX$(PEEK(&BE87),2)+"B8"
3530 GOSUB 1000:RETURN
3699 ' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN GOSUB 3762
3750 IF jb=2 AND ss=0 THEN GOSUB 1905:l=l-3:GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3762 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3764,3765,3766,3767
3763 a$=a$+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2):GOSUB 3779:RETURN
3764 a$="C2":RETURN
3765 a$="CA":RETURN
3766 a$="D2":RETURN
3767 a$="DA":RETURN
3770 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3772,3773,3774,3775
3771 a$=a$+HEX$(l,2):GOSUB 3779:RETURN
3772 a$="20":RETURN
3773 a$="28":RETURN
3774 a$="30":RETURN
3775 a$="38":RETURN
3779 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN
3999 ' WHILE
4000 a$="":GOSUB 1901
4001 IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=a+1:GOSUB 2530:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):GOSUB 4031
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:a$="CD09BB"
4020 IF MID$(c$,a+1,1)="=" THEN a$=a$+"A7":POKE &AF0E,&20:POKE &AF0F,&C2
4021 IF MID$(c$,a+1,2)="<>" THEN IF MID$(c$,a+3,2)<>CHR$(34)+CHR$(34) THEN GOSUB 1907:a$=a$+"FE"+HEX$(ASC(MID$(c$,a,1)),2):POKE &AF0E,&28:POKE &AF0F,&CA ELSE a$=a$+"A7":POKE &AF0E,&28:POKE &AF0F,&CA
4030 GOSUB 1000:GOSUB 2530:RETURN
4031 IF MID$(c$,a,1)="<" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&30:POKE &AF0F,&D2
4032 IF MID$(c$,a,1)=">" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&38:POKE &AF0F,&DA
4033 IF MID$(c$,a,1)="=" THEN a=a+1:GOSUB 1230:GOSUB 4035:POKE &AF0E,&20:POKE &AF0F,&C2
4034 RETURN
4035 IF n2=0 THEN a$=a$+"A7":RETURN ELSE a$=a$+"FE"+HEX$(n2,2):RETURN
4199 ' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 4220:RETURN
4210 a$="C3"+HEX$(PEEK(&BEFF+(PEEK(&BF00)-1)*3),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3),2):GOSUB 1000
4211 jb=3:ss=1:a$=HEX$(PEEK(&AF0F),2)+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2)
4212 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN
4220 a$="18":GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*3)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
4241 jb=2:ss=1:GOSUB 1905:l=l-3:a$=HEX$(PEEK(&AF0E),2)+HEX$(l,2)
4250 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN



And Assembly Routines:



org &af00


.store
defb 0,0,0,0,0,0,0,0,0,0,0,0,0
defb 0,0,0


org &af10


ld a,(ix+00)
cp 4
jr z,isfour
cp 6
jr z,issix
cp 8
jr z,iseght
cp 10
jr z,isten
cp 12
jr z,istwelve
cp 14
jr z,fourteen
cp 15
jp z,fifteen
ret
.isfour
ld de,fourdat
ld hl,store
ld b,9
call poke
call p1
ld a,(&be01)
ld (store+3),a
ret


.issix
ld de,sixdat ;; de = six data
ld hl,store ;; hl = location of store
ld b,11 ;; number of times to loop
call poke ;; poke there
call sbr1
ld a,(&be01) ;; and a low numerical from &be01
ld (store+5),a ;; is stored at store+5
ret


.iseght
ld hl,store
ld a,&3e
ld (hl),a
call p1
ld hl,&ffff
ld (store+2),hl
ret


.isten
ld de,tendat
ld hl,store
ld b,11
call poke
call p1
ld b,(ix+02)
call caln
ld (store+3),a
ld a,(&be87)
ld (store+4),a
ret


.istwelve
ld de,twelvedat
ld hl,store
ld b,13
call poke
call sbr1
ld b,(ix+02)
call caln
ld (store+5),a
ld a,(&be87)
ld (store+6),a
ret


.fourteen
ld hl,store
ld a,&2a
ld (hl),a
ld b,(ix+04)
call calin
ld (store+1),a
ld a,(&be89)
ld (store+2),a
ld a,&7e
ld (store+3),a
ld hl,&ffff
ld (store+4),hl
ret


.fifteen
ld hl,store
ld a,&3a
ld (hl),a
call sbr1
ld hl,&ffff
ld (store+3),hl
ret


.caln
ld a,(&be86) ;; value of variable ptr &00..&a0
.nloop
inc a ;; increment based on numberal position
djnz nloop ;; loop until reached
ret


.calin
ld a,(&be88) ;; value of integer variable ptr &00..&a1
.niloop
inc a
inc a ;; increment twice to return correct position
djnz niloop ;; until b=0
ret


.poke
ld a,(de)
ld (hl),a
inc hl
inc de
djnz poke
ret


.sbr1
ld b,(ix+04) ;; b = n(1) position
call caln
call p2
ret


.p1 ld a,(&be00)
ld (store+1),a
ret


.p2 ld (store+1),a ;; store this at store+1
ld a,(&be87) ;; along with the
ld (store+2),a ;; high byte.
ret


.fourdat
defb &26,&00,&2E,&00,&CD,&75,&BB,&ff,&ff
.sixdat
defb &3A,&00,&00,&67,&2E,&00,&CD,&75,&BB,&ff,&ff
.tendat
defb &26,&00,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff
.twelvedat
defb &3A,&00,&00,&67,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff


org &b050
.clearprg
ld hl,&4000
ld bc,&667b
.delprg
ld a,0
ld (hl),a
inc hl
dec bc
ld a,b
or c
jr nz,delprg
ret


org &b0d0

ld c,(ix+00)
ld b,(ix+01)
ld e,(ix+02)
ld d,(ix+03)
ld l,(ix+04)
ld h,(ix+05)
ldir
ret
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:53, 16 July 20
I wrote this little example because I think it maybe time to move my assembly routines to the extra 64k bank. The idea would be to have a main hub around &af00 to bank to that extra ram, call the routine and then return back to normal ram. I wasn't sure if I could call to &af00 with an extra parameter and then the routine in extra ram would take that parameter and process accordingly, though it seems to be working. The only other trick is to poke (in BASIC) the appropriate routine before calling &af00, at the moment I'm only using 3 routines, two of those will need to stay in the main ram because they handle the main code areas, which needs to be done in bank &c0, so just 1 routine to handle the return of appropriate mc bytes could be located in the extra ram, though it seems to be the most extensive code. In this example I've setup a MODE routine and INK routine in extra memory.


The only thing I don't understand in this assembly code is the write direct command, the 3rd parameter takes the code to bank area &c7, though the other 2 parameters I've stated disable Lower ROM then Upper ROM, though if I had 0 followed by another number, there's no change, so I'm just assuming either is fine:


org &af00


;; use poke &af06,0 to access mode & poke &af06,7
;; to access ink in second 64k.


ld bc,&7fc7
out (c),c
call &4000
ld bc,&7fc0
out (c),c
ret


org &4000
write direct -1,-1,&c7


.mode
ld a,(ix+00)
call &bc0e
ret


.ink
ld c,(ix+00)
ld b,c
ld a,(ix+02)
call &bc32
ret
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:57, 19 July 20

The main update in this release was relocating the assembly routines to the extra 64k, though I also finally updated 'let', so one byte variable can be stored to another byte variable:



let b(0)=25
let b(1)=b(0)
locate b(0),b(1)
print "*"
locate 1,1



On the new DSK (tbas 128 - 19072020.zip) in the opening thread (https://www.cpcwiki.eu/forum/programming/tbas-not-the-language-to-use/?action=dlattach;attach=31951), I've removed the routines and now load them from a new file (disc.bas), which checks to make sure 128k is installed, though 2 routine files still exist, 2 which loads stuff around &af00 which cannot be located within the 2nd 64k and 3 which is loaded to bank area &c7 and the routine now located at &af10 handles the banking switch and call of those routines:



100 MODE 2:DEFINT a-z:MEMORY &3FFF
110 POKE &BE80,0:POKE &BE81,&40 ' Address Ptr
120 POKE &BE82,0:POKE &BE83,&90 ' String Ptr
121 POKE &BE86,0:POKE &BE87,&A0 ' Variable Ptr
122 POKE &BE88,0:POKE &BE89,&A1 ' Integer Variable Ptr
123 POKE &BF00,0 ' Jump Counter
130 GOSUB 1100:GOSUB 1040
140 LINE INPUT":-",c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN a$="CD14BC":GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:a$=a$+"CD90BB":GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 IF a$="WHILE" THEN GOSUB 4000
270 IF a$="WEND" THEN GOSUB 4200
280 IF a$="FLY" THEN a$="CD19BD":GOSUB 1000
290 CLEAR
300 GOTO 140
999 ' Poke Main Code to Memory
1000 FOR b=1 TO LEN(a$) STEP 2
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),VAL("&"+MID$(a$,b,2))
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1030 NEXT b
1040 IF PEEK(PEEK(&BE81)*256+PEEK(&BE80))=0 THEN POKE PEEK(&BE81)*256+PEEK(&BE80),&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 CALL &AF1E
1150 RETURN
1151 ' Move Code for Jump Routines and then clean up code
1152 CALL &AF2E,s,d,l
1153 CALL &AF2E,d,s+jb,l
1154 CALL &AF2E,d+1,d+2,l
1155 RETURN
1159 ' Check Locate Routine
1160 CALL &AF10,n(1),n(2),t
1170 a=&AF00:a$=""
1180 WHILE PEEK(a)<>255 OR PEEK(a+1)<>255
1190   a$=a$+HEX$(PEEK(a),2)
1200   a=a+1
1210 WEND
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))+3
1906 RETURN
1907 a=INSTR(c$,CHR$(34))+1:RETURN
1908 a=INSTR(a,c$,"(")+1:RETURN
1909 a=INSTR(a,c$,")")+1:RETURN
1910 a=INSTR(c$,","):RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for 8bit values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN
2299 ' Search PRINT strings and store to memory.
2300 GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"CD5ABB":sk=1:RETURN
2309 a$="":a=1:POKE &BE84,PEEK(&BE82):POKE &BE85,PEEK(&BE83) ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$):RETURN
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1 ' if string ptr has reached 255 characters, place to the next byte block, otherwise continue along path.
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF sk=1 THEN RETURN ELSE IF p<8 THEN RETURN ELSE IF p+1=d THEN GOSUB 2410:RETURN ELSE GOSUB 2350:adr=&7FFF:sl=1:GOSUB 2420:RETURN
2409 ' If Character is found use this routine
2410 GOSUB 1907
2411 a$="3E"+HEX$(ASC(MID$(c$,a,1)),2)+"CD5ABB":RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(adr+1)=0
2440   ON sl GOSUB 2511,2512
2450   WHILE p1<=LEN(a$)
2460     POKE adr+p,VAL("&"+MID$(a$,p1,2))
2470     p=p+1:p1=p1+2
2480   WEND
2490 WEND
2500 a$="21"+HEX$(PEEK(&BE84),2)+HEX$(PEEK(&BE85),2)+"CD0080"
2510 RETURN
2511 a$="7ECD5ABB23A720F8C9":RETURN
2512 a$="2A0980ED5F575F19AD87AC6F220980C99030FD80C9":RETURN
2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFE+(PEEK(&BF00)*3),k
2531 POKE &BEFF+(PEEK(&BF00)*3),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*3),PEEK(&BE81):RETURN
2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*3,0:POKE &BEFE+(PEEK(&BF00)*3),0
2551 POKE &BF00+PEEK(&BF00)*3,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOSUB 2780:RETURN
2620 GOSUB 2220:GOSUB 1900
2621 IF MID$(c$,a,1)="t" THEN n2=n:GOSUB 2881:RETURN
2622 IF MID$(c$,a,1)="r" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 2220:a$="CD0C8006"+HEX$(n,2)+"CD1C80":n=n2
2623 IF MID$(c$,a,1)="m" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 1908:sl=3
2624 IF sl=3 THEN IF MID$(c$,a,1)="b" THEN GOSUB 2220:GOSUB 2886:RETURN ELSE n=n2:GOSUB 1230:GOSUB 2887:RETURN
2625 IF MID$(c$,a,1)="b" THEN n2=n:GOSUB 2220:a$="3A"+hex$(PEEK(&BE86)+n,2)+hex$(peek(&be87),2)+"32"+hex$(peek(&be86)+n2,2)+hex$(peek(&be87),2):RETURN
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2641 IF sl=2 THEN GOTO 2710
2650 GOSUB 1902:IF e$="b" THEN s1=3:n2=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2660 IF s1=3 THEN a$=a$+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2710 GOSUB 1230
2720 IF s1=1 THEN IF sl=0 THEN GOSUB 2771:b$="3C":GOSUB 2772 ELSE IF s1=1 THEN IF sl=2 THEN b$="3C":GOSUB 2772
2730 IF s1=2 THEN IF sl=0 THEN GOSUB 2771:b$="3D":GOSUB 2772 ELSE IF s1=2 THEN IF sl=2 THEN b$="3D":GOSUB 2772
2740 IF s1=1 OR s1=2 THEN a$=a$+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2741 IF sl=2 THEN RETURN
2760 IF s1=0 THEN IF n2<>0 THEN a$="3E"+HEX$(n2,2)+"32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE a$="AF32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)
2770 RETURN
2771 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2772 FOR l=1 TO n2
2773   a$=a$+b$
2774 NEXT l:RETURN
2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo$=MID$(n$,1,2):hi$=MID$(n$,3,2)
2830 IF s1=1 THEN a$="2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)+"11"+hi$+lo$+"1922"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2870 IF s1=0 THEN a$="21"+hi$+lo$+"22"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2)
2880 RETURN
2881 GOSUB 1908
2882 IF MID$(c$,a,1)="i" THEN GOSUB 2220:a$=a$+"2A"+HEX$(PEEK(&BE88)+(n*2),2)+HEX$(PEEK(&BE89),2) ELSE s1=2:GOSUB 2800:a$=a$+"21"+hi$+lo$
2883 IF c=0 THEN a$=a$+"EB"
2884 a=a+1:IF MID$(c$,a,1)="," THEN c=c+1:a=a+1:GOTO 2882
2885 a$=a$+"CDF0BB32"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2886 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"CD1C8032"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2):RETURN
2887 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"06"+HEX$(n2,2)+"CD1C8032"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
2999 ' FOR Loop
3000 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710:a$=a$+"47"
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:a$=a$+"0E"+HEX$(n2+1,2):GOSUB 1000
3020 GOSUB 2530
3030 a$="":a$="C5":GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 a$="":GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 a$="C13A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"3C32"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"4779B8":GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 a$="C2"+HEX$(PEEK(&BEFF+(PEEK(&BF00)*3)),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)*3)),2):GOSUB 1000:GOSUB 3130
3090 RETURN
3100 a$="20":GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
3130 GOSUB 2550:RETURN
3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902
3501 IF e$="b" THEN GOSUB 3502:GOSUB 2530:RETURN ELSE IF e$="k" THEN GOSUB 3511:GOSUB 2530:RETURN
3502 GOSUB 2220
3503 a=a+1
3504 GOSUB 1902
3505 IF e$="=" THEN a=a+1:k=1 ELSE IF e$="<" THEN a=a+1:k=3 ELSE IF e$=">" THEN a=a+1:k=4
3506 IF MID$(c$,a,1)<>"b" THEN GOSUB 1230:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2) ELSE GOSUB 3528:f=1
3507 IF n2<>0 AND f=0 THEN a$=a$+"FE"+HEX$(n2,2):GOSUB 1000 ELSE IF n2=0 AND f=0 THEN a$=a$+"A7":GOSUB 1000
3508 RETURN
3511 GOSUB 2220
3512 a$="3E"+HEX$(n,2)+"CD1EBB"
3513 GOSUB 1000
3514 k=2
3517 RETURN
3528 n3=n:GOSUB 2220:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"47"
3529 a$=a$+"3A"+HEX$(PEEK(&BE86)+n3,2)+HEX$(PEEK(&BE87),2)+"B8"
3530 GOSUB 1000:RETURN
3699 ' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN GOSUB 3762
3750 IF jb=2 AND ss=0 THEN GOSUB 1905:l=l-3:GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3762 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3764,3765,3766,3767
3763 a$=a$+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2):GOSUB 3779:RETURN
3764 a$="C2":RETURN
3765 a$="CA":RETURN
3766 a$="D2":RETURN
3767 a$="DA":RETURN
3770 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3772,3773,3774,3775
3771 a$=a$+HEX$(l,2):GOSUB 3779:RETURN
3772 a$="20":RETURN
3773 a$="28":RETURN
3774 a$="30":RETURN
3775 a$="38":RETURN
3779 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN
3999 ' WHILE
4000 a$="":GOSUB 1901
4001 IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=a+1:GOSUB 2530:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):GOSUB 4031
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:a$="CD09BB"
4020 IF MID$(c$,a+1,1)="=" THEN a$=a$+"A7":POKE &AF0E,&20:POKE &AF0F,&C2
4021 IF MID$(c$,a+1,2)="<>" THEN IF MID$(c$,a+3,2)<>CHR$(34)+CHR$(34) THEN GOSUB 1907:a$=a$+"FE"+HEX$(ASC(MID$(c$,a,1)),2):POKE &AF0E,&28:POKE &AF0F,&CA ELSE a$=a$+"A7":POKE &AF0E,&28:POKE &AF0F,&CA
4030 GOSUB 1000:GOSUB 2530:RETURN
4031 IF MID$(c$,a,1)="<" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&30:POKE &AF0F,&D2
4032 IF MID$(c$,a,1)=">" THEN a=a+1:GOSUB 1230:a$=a$+"FE"+HEX$(n2,2):POKE &AF0E,&38:POKE &AF0F,&DA
4033 IF MID$(c$,a,1)="=" THEN a=a+1:GOSUB 1230:GOSUB 4035:POKE &AF0E,&20:POKE &AF0F,&C2
4034 RETURN
4035 IF n2=0 THEN a$=a$+"A7":RETURN ELSE a$=a$+"FE"+HEX$(n2,2):RETURN
4199 ' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 4220:RETURN
4210 a$="C3"+HEX$(PEEK(&BEFF+(PEEK(&BF00)-1)*3),2)+HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3),2):GOSUB 1000
4211 jb=3:ss=1:a$=HEX$(PEEK(&AF0F),2)+HEX$(PEEK(&BE80)+jb,2)+HEX$(PEEK(&BE81),2)
4212 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN
4220 a$="18":GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*3)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
4241 jb=2:ss=1:GOSUB 1905:l=l-3:a$=HEX$(PEEK(&AF0E),2)+HEX$(l,2)
4250 GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN



Assembly Routines:



   org &af00


.store
   defb 0,0,0,0,0,0,0,0,0,0,0,0,0
   defb 0,0,0


   org &af10


   ld bc,&7fc7
   out (c),c
   call &4000
   ld bc,&7fc0
   out (c),c
   ret


.clearprg
   ld hl,&4000
   ld bc,&667b
.delprg
   ld a,0
   ld (hl),a
   inc hl
   dec bc
   ld a,b
   or c
   jr nz,delprg
   ret


.movecode
   ld c,(ix+00)
   ld b,(ix+01)
   ld e,(ix+02)
   ld d,(ix+03)
   ld l,(ix+04)
   ld h,(ix+05)
   ldir
   ret


   org &4000
   write direct -1,-1,&c7


   ld a,(ix+00)
   cp 4
   jr z,isfour
   cp 6
   jr z,issix
   cp 8
   jr z,iseght
   cp 10
   jr z,isten
   cp 12
   jr z,istwelve
   cp 14
   jr z,fourteen
   cp 15
   jp z,fifteen
   ret
.isfour
   ld de,fourdat
   ld hl,store
   ld b,9
   call poke
   call p1
   ld a,(&be01)
   ld (store+3),a
   ret


.issix
   ld de,sixdat      ;; de = six data
   ld hl,store      ;; hl = location of store
   ld b,11         ;; number of times to loop
   call poke      ;; poke there
   call sbr1
   ld a,(&be01)      ;; and a low numerical from &be01
   ld (store+5),a      ;; is stored at store+5
   ret


.iseght
   ld hl,store
   ld a,&3e
   ld (hl),a
   call p1
   ld hl,&ffff
   ld (store+2),hl
   ret


.isten   
   ld de,tendat
   ld hl,store
   ld b,11
   call poke
   call p1
   ld b,(ix+02)
   call caln
   ld (store+3),a
   ld a,(&be87)
   ld (store+4),a
   ret


.istwelve
   ld de,twelvedat
   ld hl,store
   ld b,13
   call poke
   call sbr1
   ld b,(ix+02)
   call caln
   ld (store+5),a
   ld a,(&be87)
   ld (store+6),a
   ret


.fourteen
   ld hl,store
   ld a,&2a
   ld (hl),a
   ld b,(ix+04)
   call calin
   ld (store+1),a
   ld a,(&be89)
   ld (store+2),a
   ld a,&7e
   ld (store+3),a
   ld hl,&ffff
   ld (store+4),hl
   ret


.fifteen
   ld hl,store
   ld a,&3a
   ld (hl),a
   call sbr1
   ld hl,&ffff
   ld (store+3),hl
   ret


.caln
   ld a,(&be86)   ;; value of variable ptr &00..&a0
.nloop
   inc a      ;; increment based on numberal position
   djnz nloop   ;; loop until reached
   ret


.calin
   ld a,(&be88)   ;; value of integer variable ptr &00..&a1
.niloop
   inc a
   inc a      ;; increment twice to return correct position
   djnz niloop   ;; until b=0
   ret


.poke
   ld a,(de)
   ld (hl),a
   inc hl
   inc de
   djnz poke
   ret


.sbr1
   ld b,(ix+04)      ;; b = n(1) position
   call caln
   call p2
   ret


.p1   ld a,(&be00)
   ld (store+1),a
   ret


.p2   ld (store+1),a   ;; store this at store+1
   ld a,(&be87)   ;; along with the
   ld (store+2),a   ;; high byte.
   ret


.fourdat
   defb &26,&00,&2E,&00,&CD,&75,&BB,&ff,&ff
.sixdat
   defb &3A,&00,&00,&67,&2E,&00,&CD,&75,&BB,&ff,&ff
.tendat
   defb &26,&00,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff
.twelvedat
   defb &3A,&00,&00,&67,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff



Update: At this stage it looks like the next lot of updates I need to do should be to the WHILE..WEND routine. It works as a singular loop, though if it should become a Nested Loop, more areas need to accomodate the JR or JMP code bytes, with a memory pointer to locate the correct JR or JMP instruction, which seems tricky and have to play with that to see how that works. The Byte variable which WHILE uses only currently supports Numbers, though would like to compare with another variable.

Title: Re: TBAS - writing a little computer language
Post by: zhulien on 12:52, 23 July 20
the easiest way i have found to do loops and nestings is with a nestcount that forever increases for new nest usage, but decreases for closing of nestings.Here is an example of 3 loops.  First a nested loop, then a 3rd loop that is not nested:

function main()
{
    while (1)
    {
        while (2)
        {
            doSomething();
        }
    }
   
    while (3)
    {
        doSomething2();
    }
}

becomes:

main: ; source line 1
   call main_constructor ; source line 1
   ret ; source line 1

main_constructor: ; source line 1
main_1_s: ; source line 3

   ld hl, 1 ; source line 3
   push hl ; source line 3

   pop hl ; source line 3
   ld a,h ; source line 3
   or l ; source line 3
   jp z, main_1_e ; source line 3
main_2_s: ; source line 5

   ld hl, 2 ; source line 5
   push hl ; source line 5

   pop hl ; source line 5
   ld a,h ; source line 5
   or l ; source line 5
   jp z, main_2_e ; source line 5
   ; TODO CALL, constructor_call,             doSomething(); ; source line 7
   jp main_2_s ; source line 8

main_2_e: ; source line 8
   jp main_1_s ; source line 9

main_1_e: ; source line 9
main_3_s: ; source line 11

   ld hl, 3 ; source line 11
   push hl ; source line 11

   pop hl ; source line 11
   ld a,h ; source line 11
   or l ; source line 11
   jp z, main_3_e ; source line 11
   ; TODO CALL, constructor_call,         doSomething2(); ; source line 13
   jp main_3_s ; source line 14

main_3_e: ; source line 14
   ret ; source line 15
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:05, 24 July 20
Quote from: zhulien on 12:52, 23 July 20
the easiest way i have found to do loops and nestings is with a nestcount that forever increases for new nest usage, but decreases for closing of nestings.


That's what I had in mind and have already implemented the same thing for storing and removing the Jump Addresses (Lines 2530 to 2551). Was hoping I could use that, with variables pointing to where they need to go, though the Jump Address routines has to handle 4 bytes instead of 3, so looks like it'll need it's own set of pokes.



Quote
Here is an example of 3 loops.  First a nested loop, then a 3rd loop that is not nested:

function main()
{
    while (1)
    {
        while (2)
        {
            doSomething();
        }
    }
   
    while (3)
    {
        doSomething2();
    }
}

becomes:

main: ; source line 1
   call main_constructor ; source line 1
   ret ; source line 1

main_constructor: ; source line 1
main_1_s: ; source line 3

   ld hl, 1 ; source line 3
   push hl ; source line 3

   pop hl ; source line 3
   ld a,h ; source line 3
   or l ; source line 3
   jp z, main_1_e ; source line 3
main_2_s: ; source line 5

   ld hl, 2 ; source line 5
   push hl ; source line 5

   pop hl ; source line 5
   ld a,h ; source line 5
   or l ; source line 5
   jp z, main_2_e ; source line 5
   ; TODO CALL, constructor_call,             doSomething(); ; source line 7
   jp main_2_s ; source line 8

main_2_e: ; source line 8
   jp main_1_s ; source line 9

main_1_e: ; source line 9
main_3_s: ; source line 11

   ld hl, 3 ; source line 11
   push hl ; source line 11

   pop hl ; source line 11
   ld a,h ; source line 11
   or l ; source line 11
   jp z, main_3_e ; source line 11
   ; TODO CALL, constructor_call,         doSomething2(); ; source line 13
   jp main_3_s ; source line 14

main_3_e: ; source line 14
   ret ; source line 15


Yes, I wrote my own little version in Locomotive BASIC, which had me thinking of how variables could range in size, which created this nested Loop task I need to address in my WHILE..WEND loop setup. The FOR..NEXT Loops work fine as Nested Loops though.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 12:15, 25 July 20

I've only updated below the changes I've made to the prevous, so now it's possible to have nested WHILE Loops and I have also updated WHILE so a check between a Byte Variable is now possible with another Byte Variable.


According to the Firmware Guide the area around &A770 is Unused and holds &25 bytes, so I gathered that would be sufficent.


In the examples I made, the 1st tests to see what happens when the Inner Loop is a Large Loop, I soon realized that when Direct Addresses are being used, I had to use &A770 and multiply that by 3 (Line 4213), which worked fine until the Jump was trying to go to &0410 instead of &4100, which I had to rectify with Line 4213, to correctly produce a 16bit number and store as hi$ & lo$. The example itself is just some Blinking Stars, I threw in some FOR loops with Frame Flybacks, which works. The only test I didn't do was a Main Loop with 2 seperate WHILE loops, but I think that would work?


The 2nd example is a version of what I posted above in the screenshot, which tests with 2nd Byte variable with the 1st, which gradulately increases in size.

Update:I've updated the opening thread with a new version of tbas 128 (26-July-2020) (https://www.cpcwiki.eu/forum/programming/tbas-not-the-language-to-use/?action=dlattach;attach=32005), after finding some problems and the Machine Code Jumps weren't going where they were supposed to when the Long Jumps were used, and this of course extended into the IF..ENDIF routine. The routines aren't exciting to look at and they were created to test the Long Jumps from within an Inner Loop and when a large amount of code was put into the IF..ENDIF. Handling the Long Jumps I should of realized the best way of handling was to convert back into a 16bit number, calculate the offsets based on the value at &A770 * 3 and use HEX$ to convert back into String Format, and extract the hi and lo bytes from MID$, which I have made the code a regular routines (Line 1911). The only surprise I got when I thought about there being trouble if a Long Jump were used in the IF..ENDIF statement was the need increment &A770, GOSUB 1911 to get the right address and decrement, which was what GOSUB 2532 and GOSUB 2552 were used on line 3763.



1911 n$=HEX$((PEEK(&BE81)*256)+(PEEK(&BE80)+PEEK(&A770)*3),4):lo$=MID$(n$,1,2):hi$=MID$(n$,3,2):RETURN

' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFE+(PEEK(&BF00)*3),k
2531 POKE &BEFF+(PEEK(&BF00)*3),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*3),PEEK(&BE81):RETURN
2532 POKE &A770,PEEK(&A770)+1:POKE &A76E+(PEEK(&A770)*2+1),j1:POKE &A76E+(PEEK(&A770)*2+2),j2:RETURN

' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*3,0:POKE &BEFE+(PEEK(&BF00)*3),0
2551 POKE &BF00+PEEK(&BF00)*3,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2552 POKE &A76E+(PEEK(&A770)*2+2),0:POKE &A76E+(PEEK(&A770)*2+1),0:POKE &A770,PEEK(&A770)-1:RETURN

' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>129 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN GOSUB 3762
3750 IF jb=2 AND ss=0 THEN GOSUB 1905:l=l-3:GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3762 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3764,3765,3766,3767
3763 GOSUB 2532:GOSUB 1911:GOSUB 2552:a$=a$+hi$+lo$:GOSUB 3779:RETURN
3764 a$="C2":RETURN
3765 a$="CA":RETURN
3766 a$="D2":RETURN
3767 a$="DA":RETURN
3770 ON PEEK(&BEFE+PEEK(&BF00)*3) GOSUB 3772,3773,3774,3775
3771 a$=a$+HEX$(l,2):GOSUB 3779:RETURN
3772 a$="20":RETURN
3773 a$="28":RETURN
3774 a$="30":RETURN
3775 a$="38":RETURN
3779 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))+a,VAL("&"+MID$(a$,a*2+1,2))
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:RETURN

' WHILE
4000 a$="":GOSUB 1901
4001 IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=a+1:GOSUB 2530:a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):GOSUB 4031
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:a$="CD09BB"
4020 IF MID$(c$,a+1,1)="=" THEN a$=a$+"A7":j1=&20:j2=&C2
4021 IF MID$(c$,a+1,2)="<>" THEN IF MID$(c$,a+3,2)<>CHR$(34)+CHR$(34) THEN GOSUB 1907:a$=a$+"FE"+HEX$(ASC(MID$(c$,a,1)),2):j1=&28:j2=&CA ELSE a$=a$+"A7":j1=&28:j2=&CA
4030 GOSUB 2532:GOSUB 1000:GOSUB 2530:RETURN

' Check if byte variable if less than, greater than or equal to.
4031 IF MID$(c$,a,1)="<" THEN a=a+1:j1=&30:j2=&D2:GOSUB 4036
4032 IF MID$(c$,a,1)=">" THEN a=a+1:j1=&38:j2=&DA:GOSUB 4036
4033 IF MID$(c$,a,1)="=" THEN a=a+1:j1=&20:j2=&C2:GOSUB 4036
4034 RETURN
4035 IF n2=0 THEN GOSUB 4038:a$=a$+"A7":RETURN ELSE GOSUB 4038:a$=a$+"FE"+HEX$(n2,2):RETURN

' Check if Byte variable (4036) or Number (4037)
4036 IF MID$(c$,a,1)="b" THEN n2=n:GOSUB 2220:GOSUB 4039:RETURN
4037 GOSUB 1230:GOSUB 4035:RETURN
4038 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2):RETURN
4039 a$="3A"+HEX$(PEEK(&BE86)+n,2)+HEX$(PEEK(&BE87),2)+"473A"+HEX$(PEEK(&BE86)+n2,2)+HEX$(PEEK(&BE87),2)+"B8":RETURN

' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-123 THEN GOSUB 4220:RETURN

' Long Jumps
4210 a$="C3":GOSUB 4214:a$=a$+hi$+lo$:GOSUB 1000
4211 ss=1:jb=3:a$=HEX$(PEEK(&A76E+PEEK(&A770)*2+2),2):GOSUB 1911:a$=a$+hi$+lo$
4212 GOSUB 2552:GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN
4214 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+(PEEK(&BEFF+(PEEK(&BF00)-1)*3)+(PEEK(&A770)-1)*3),4):lo$=MID$(n$,1,2):hi$=MID$(n$,3,2):RETURN


' Short Jumps
4220 a$="18":GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*3)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi$=MID$(n$,3,2):a$=hi$:GOSUB 1000
4241 jb=2:ss=1:GOSUB 1905:l=l-3:a$=HEX$(PEEK(&A76E+PEEK(&A770)*2+1),2)+HEX$(l,2)
4250 GOSUB 2552:GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN



Examples:

Some Blinking Stars:


cls
let b(0)=3
let b(1)=1
while b(0)>1
while b(1)<10


locate 1,1
print "*"
locate 3,1
print "*"


locate 5,1
print "*"
locate 8,1
print "*"


locate 1,1
print " "
locate 3,1
print " "
locate 5,1
print " "


locate 8,1
print " "
locate 6,2
print "*"


locate 9,2
print "*"
locate 13,2
print "*"


locate 17,2
print "*"
locate 6,2
print " "
locate 9,2
print " "


locate 13,2
print " "
locate 17,2
print " "
let b(1)=+1


for b(2)=1 to 2
fly
next b(2)


wend


let b(1)=1
let b(0)=-1
wend



Testing 2nd variable:



cls
let b(0)=3
let b(1)=10
let b(2)=3
let b(3)=1
while b(2)>1
while b(0)<b(1)
locate b(0),b(3)
print "*"
let b(0)=+3
wend
let b(1)=+3
let b(0)=3
let b(3)=+1
let b(2)=-1
wend
locate 1,1



Some More Nested Loops, 1 Main Loop, followed by one Long Loop and one Short Loop:



cls
let b(0)=1
let b(1)=10
let b(2)=3
locate 1,1
let b(3)=1
let b(4)=1
while b(2)>1
while b(0)<10
locate b(3),b(4)
print "*"
let b(3)=+1
let b(0)=+1
locate b(3),b(4)
print "@"
let b(3)=+1
locate b(3),b(4)
print "#"
let b(3)=+1
locate b(3),b(4)
print "'"
let b(3)=+1
for b(5)=1 to 2
fly
next b(5)
wend
let b(0)=1
while b(1)<20
locate b(3),b(4)
print "!"
let b(1)=+1
let b(3)=+1
wend
let b(1)=15
let b(4)=+1
let b(3)=1
let b(2)=-1
wend
locate 1,10



Testing Nested Loops with an Long IF..ENDIF statement, example uses Keypress to Run 3 Tests and then Exits:



cls
let b(0)=3
let b(3)=1
locate 1,1
while b(0)>1
while k=""
if b(3)<20
print "*"
print "@"
print "#"
print "'"
print "-"
print "!"
print "$"
print "%"
print "^"
print "&"
print "("
print ")"
print "{"
print "}"
print "0"
print "1"
print "2"
print "3"
print "4"
print "5"
print "6"
print "7"
print "8"
print "9"
print "a"
print "b"
print "c"
print "d"
print "e"
print "f"
endif
let b(3)=+1
for b(5)=1 to 2
fly
next b(5)
wend
let b(1)=10
let b(2)=13
print b(1)
print b(2)
let b(3)=1
let b(0)=-1
wend
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 15:14, 26 July 20
Here's a challenge...


Do you think it could make totally relocatable code?  I couple of ideas I have for this...


No function entry points are absolute, they are all relative and indexed from a table that is kept somewhere.  There is no hardcoded entry point for anything, perhaps IY contains the entry point of your 'system' that is dynamic upon load of the software.  Of course to call the system, you make a function such as:


call system
blah
...
system: push iy; ret  ; this will of course just call what was in iy, but... upon return will go to blah above


all jumps created as jr, all calls as an indirection to the relative offset with the value added to iy before calling in a dynamic way above.


will the code be fast? not really but it will be quite flexible.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 11:06, 27 July 20
I'm not following what you're suggesting:

* I think it would be quite useful for the programme to have a 2nd set of Address Ptr instructions to Offset the Main Address Ptr, setup on Line 110. Though Code would no longer be executable, it would have to be saved and loaded where it was meant to be placed, I'm leaving this possibility open for things like Subroutines.

* The other main possibility I'm thinking of using is to utilise the extra 64k, and store the main programme @ address &4000
in bank &C4, it would free up the main area of the computer - allowing more space for the language (~11Kb in size). Code could still be executed.

* The problem with "jr" to write relocatable code is extra "jr" involved to link to another "jr" 128 or -124 bytes away. The while..wend for instance applies a forward "jr" or "jp" and then "jr" or "jp" to return back to the loop. If a "jr" has to return back to another connecting "jr", then the code inbetween would have to forward "jr" to get over the backward "jr", plus I would need to work out the number of bytes forwards and backwards to automatically generate those "jr". That just sounds like nuts to me and difficult to implement when coding, would be easy to do from an assembly perspective to have "jr" move to the next label.

* The only other thing which could be changed are how the PRINT "string", Random Number and MOD routines are stored in memory. At the moment the Language puts them in the same place regardless of if their used or not, so for example when I use the MOD routine an area of blank bytes at &8000 is present for when the PRINT "String" routine is used. All those things are Relocatable, though depending on what I add to it next may depend on if I should keep that in place or have some flexability.
Title: Re: TBAS - writing a little computer language
Post by: andycadley on 12:42, 27 July 20
Z80 (and most 8 bit CPU languages) isn't particularly well suited to writing fully relocatable code. It just lacks too much in terms of addressing modes. It can be done, but it's not pleasant and if you want the code to perform well you're probably going to need an assembler than can generate relocation tables so that you can write code normally and then fix it up on loading rather than trying to have the whole thing work wherever it is loaded.


Not a job for the faint hearted.
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 20:58, 28 July 20
Quote from: AMSDOS on 11:06, 27 July 20
I'm not following what you're suggesting:

* The other main possibility I'm thinking of using is to utilise the extra 64k, and store the main programme @ address &4000
in bank &C4, it would free up the main area of the computer - allowing more space for the language (~11Kb in size). Code could still be executed.



Perhaps you could add a new command such as:


10 RSX "BLAH", 100
20 RSX "BLAH2", 200
30 END
100 PRINT "BLAH"
110 RETURN
200 PRINT "BLAH2"
210 RETURN


Which could then create create an RSX that lets you execute line 100 from the RSX.  The RSX could be in normal memory or banked memory depending how you want to build it.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:25, 29 July 20

Latest version 29072020 (https://www.cpcwiki.eu/forum/programming/tbas-not-the-language-to-use/?action=dlattach;attach=32012), corrects similiar problems I found earlier with WHILE..WEND, IF..ENDIF, so FOR..NEXT now correctly adjusts address offsets if Nested Loops come into play and Long Jumps are needed.


This is the output from the example I made from Todays example, which consisted of a WHILE, FOR - followed by a lot of PRINT " " statements a second short FOR..NEXT routine before closing the other main FOR..NEXT routine and the WHILE. Disassembling it to Assembler and was simple enough to name the labels for each Loop as well as Relocating the Code.




org &1000


call &bc14


ld h,&01
ld l,&01
call &bb75
.while
call &bb09
and a
jp nz,end


ld a,&01
ld (&a000),a
ld b,a
ld c,&03
.for1
push bc


ld a,&2a
call &bb5a
ld a,&40
call &bb5a
ld a,&23
call &bb5a
ld a,&27
call &bb5a
ld a,&2d
call &bb5a
ld a,&21
call &bb5a
ld a,&24
call &bb5a
ld a,&25
call &bb5a
ld a,&5e
call &bb5a
ld a,&26
call &bb5a
ld a,&28
call &bb5a
ld a,&29
call &bb5a
ld a,&7b
call &bb5a
ld a,&7d
call &bb5a
ld a,&30
call &bb5a
ld a,&31
call &bb5a
ld a,&32
call &bb5a
ld a,&33
call &bb5a
ld a,&34
call &bb5a
ld a,&35
call &bb5a
ld a,&36
call &bb5a
ld a,&37
call &bb5a
ld a,&38
call &bb5a
ld a,&39
call &bb5a
ld a,&61
call &bb5a
ld a,&62
call &bb5a
ld a,&63
call &bb5a
ld a,&64
call &bb5a
ld a,&65
call &bb5a
ld a,&66
call &bb5a
ld a,&01


ld (&a001),a
ld b,a
ld c,&03
.for2
push bc


call &bd19


pop bc
ld a,(&a001)
inc a
ld (&a001),a
ld b,a
ld a,c
cp b
jr nz,for2


pop bc
ld a,(&a000)
inc a
ld (&a000),a
ld b,a
ld a,c
cp b
jp nz,for1


jp while


.end
ret




Quote from: zhulien on 20:58, 28 July 20

Perhaps you could add a new command such as:


10 RSX "BLAH", 100
20 RSX "BLAH2", 200
30 END
100 PRINT "BLAH"
110 RETURN
200 PRINT "BLAH2"
210 RETURN


Which could then create create an RSX that lets you execute line 100 from the RSX.  The RSX could be in normal memory or banked memory depending how you want to build it.


Have a few headaches regarding subroutines, it could be somewhere else in Memory, but that would put it away from the Main Code and I keep asking myself how much Memory is enough in relation to how many Bytes would a BASIC 10-Liner use. For BASIC 10-Liners everything is tokenised, which makes each line shorter than it's MC equivalent. So I don't know if it would be better to introduce the colon ':' and then type everything to as close to it's 255 character limit?


I played around with some RSXs from Banked Memory, they only work while that Bank Memory is active I discovered. I also wrote a MC POKE routine, though discovered for that to Work, I had to use BASIC POKE to POKE string Bytes somewhere in memory, though I also know I can switch to Bank Memory and use BASIC POKE to POKE bytes, so it seems I'll be sticking with  that.


Adding Subroutines, was thinking of adding a point '.<num>' system, '.' to indicate I wish to add a subroutine, with a number to label which one, an address could then be assigned to it and when something like 'RETURN' is found, the address for a new subroutine can be +1 of that 'C9' byte, I'm not sure where to assign that Address system for the Subroutine, perhaps in Banked Memory?
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 15:41, 29 July 20
Extra memory usage from BASIC is really best the following ways.


1. set himem to &3fff and keep BASIC to very small code snippets (remember you can use chain merge and chain) to make large programs fit there and then use &4000 and up for data and/or machine code and RSXs.


2. set himem to anything, but use RSXs to store things 'behind' where the BASIC program sits.  This is good where you want to use the extra memory for lots of data but access it exclusively via the RSXs.  Examples can be database records (like my Alyssa Database), but can also be things like Sprites, Tile Maps etc for making BASIC / RSX hybrid games.


Because you are writing a BASIC compiler of a sort, you actually have the full memory as a possibility.  Allowing your program to generate RSXs is not only useful for memory-based RSXs but also for anyone who might want to make a ROM using your BASIC compiler.  That ROM in turn can be used by BASIC if they are utility RSXs, or maybe it's just a full application or game that someone wants in ROM.

Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 01:24, 03 August 20
So, I wasn't sure if you were suggesting that I should be making a ROM, and stick my Machine Code Routines in it instead of having in extra 64k of RAM.


I made a simple ROM a couple of years ago:
https://www.cpcwiki.eu/forum/programming/assembling-to-rom-in-winape/msg153779/#msg153779 (https://www.cpcwiki.eu/forum/programming/assembling-to-rom-in-winape/msg153779/#msg153779)


Silly Question, can I pass parameters through a ROM RSX?


I guess if that's the case, I can follow the LOCATE example I made in Assembly and store many bytes for other routines and simply POKE them to Memory by simply specifying a RSX, and free up all that String DATA from within the Main BASIC programme?


EDIT: I was able to come up with a ROM version of the Assembly Routines I use, though it was very fiddley from the instructions I had left myself from the original ROM I made back in 2017.  With the Winape Debugger Window, * I think I have to select 16384 bytes of 00 bytes, Save as the ROM I want to Create and then Select Any Memory, Enable the Upper ROM Tab, Select ROM 1 with the File I saved, Compile the Assembly (see below), Select the Entire Area (16384 bytes) and Save. When I went back to the Emulator, the ROM was doing a Hissy Fit and only came good after I close the Emulator and Rebooted it.




org &af00


.store
defb 0,0,0,0,0,0,0,0,0,0,0,0,0
defb 0,0,0


org #C000


write direct -1,1,#c0


defb 1
defb 1,1,1


defw nametable


jp initialize


jp rtines


ret


.nametable
defb "TBAS Routine"
defb "s"+#80
defb "RTIN"
defb "E"+#80
defb 0


.initialize
push de
push hl


ld hl,message
call print


pop hl


ld de,100
sbc hl,de


pop de



scf
ret


.message
defb "TBAS Routines Installed",0


.print ld a,(hl)
cp 0
ret z
call #bb5a
inc hl
jr print


.rtines
ld a,(ix+00)
cp 4
jr z,isfour
cp 6
jr z,issix
cp 8
jr z,iseght
cp 10
jr z,isten
cp 12
jr z,istwelve
cp 14
jr z,fourteen
cp 15
jp z,fifteen
ret
.isfour
ld de,fourdat
ld hl,store
ld b,9
call poke
call p1
ld a,(&be01)
ld (store+3),a
ret


.issix
ld de,sixdat ;; de = six data
ld hl,store ;; hl = location of store
ld b,11 ;; number of times to loop
call poke ;; poke there
call sbr1
ld a,(&be01) ;; and a low numerical from &be01
ld (store+5),a ;; is stored at store+5
ret


.iseght
ld hl,store
ld a,&3e
ld (hl),a
call p1
ld hl,&ffff
ld (store+2),hl
ret


.isten
ld de,tendat
ld hl,store
ld b,11
call poke
call p1
ld b,(ix+02)
call caln
ld (store+3),a
ld a,(&be87)
ld (store+4),a
ret


.istwelve
ld de,twelvedat
ld hl,store
ld b,13
call poke
call sbr1
ld b,(ix+02)
call caln
ld (store+5),a
ld a,(&be87)
ld (store+6),a
ret


.fourteen
ld hl,store
ld a,&2a
ld (hl),a
ld b,(ix+04)
call calin
ld (store+1),a
ld a,(&be89)
ld (store+2),a
ld a,&7e
ld (store+3),a
ld hl,&ffff
ld (store+4),hl
ret


.fifteen
ld hl,store
ld a,&3a
ld (hl),a
call sbr1
ld hl,&ffff
ld (store+3),hl
ret


.caln
ld a,(&be86) ;; value of variable ptr &00..&a0
.nloop
inc a ;; increment based on numberal position
djnz nloop ;; loop until reached
ret


.calin
ld a,(&be88) ;; value of integer variable ptr &00..&a1
.niloop
inc a
inc a ;; increment twice to return correct position
djnz niloop ;; until b=0
ret


.poke
ld a,(de)
ld (hl),a
inc hl
inc de
djnz poke
ret


.sbr1
ld b,(ix+04) ;; b = n(1) position
call caln
call p2
ret


.p1 ld a,(&be00)
ld (store+1),a
ret


.p2 ld (store+1),a ;; store this at store+1
ld a,(&be87) ;; along with the
ld (store+2),a ;; high byte.
ret


.fourdat
defb &26,&00,&2E,&00,&CD,&75,&BB,&ff,&ff
.sixdat
defb &3A,&00,&00,&67,&2E,&00,&CD,&75,&BB,&ff,&ff
.tendat
defb &26,&00,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff
.twelvedat
defb &3A,&00,&00,&67,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff
Title: Re: TBAS - writing a little computer language
Post by: zhulien on 17:39, 05 August 20
Quote from: AMSDOS on 01:24, 03 August 20
So, I wasn't sure if you were suggesting that I should be making a ROM, and stick my Machine Code Routines in it instead of having in extra 64k of RAM.


I was suggesting it could be a good feature if people could use your TINYBASIC to make their own ROMS, or even BASIC extension RSXs on ROM.
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 22:56, 05 August 20
Quote from: zhulien on 17:39, 05 August 20

I was suggesting it could be a good feature if people could use your TINYBASIC to make their own ROMS, or even BASIC extension RSXs on ROM.


Okay, well I started putting the Assembly Routines I was using onto a ROM and from that I was able to use RSX from anywhere regardless of Memory Bank selected.


I think it would be a good means to move a lot of the String Bytes I have within the BASIC file and use the ROM to select the bytes needed to POKE into RAM, which should reduce the size of the BASIC file a fair bit.


It will just take a bit of work to get things like that, though should be worthwhile.
Title: Re: TBAS - writing a little computer language
Post by: ervin on 04:55, 06 August 20
Quote from: AMSDOS on 22:56, 05 August 20
Okay, well I started putting the Assembly Routines I was using onto a ROM and from that I was able to use RSX from anywhere regardless of Memory Bank selected.

I think it would be a good means to move a lot of the String Bytes I have within the BASIC file and use the ROM to select the bytes needed to POKE into RAM, which should reduce the size of the BASIC file a fair bit.

It will just take a bit of work to get things like that, though should be worthwhile.


What sort of impact would this have on program execution speed?
Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 10:29, 06 August 20
Quote from: ervin on 04:55, 06 August 20

What sort of impact would this have on program execution speed?


So at the moment the only routines the Assembly uses are locate and pen. In the Assembly code for locate, are 4 sections called 'fourdat','sixdat','tendat' and 'twelvedat' which handle the 4 different scenarios that could be thrown at locate, those being 'locate <num>,<num>,'... <b(num)>,<num>','...<num>,<b(num)>' and '... <b(num)>,<b(num)>'. When one of those is found, the bytes are poked to &af00 and then the BASIC programme takes over from that by storing them into a$ and finally poked to the central area.


I think I can improve on that Assembly by replacing the double &FF bytes at the end of each of those and just have a Counter Counting the Number of Bytes used, which I can then use when Poking the Bytes to the Main Area. Unfortunately I need to double handle the bytes in order to Poke the Number or Byte Variable Address to a fixed area before Poking to Main Memory which could be any address.


If successful a lot of the String Data through HEX$ can be removed from the BASIC file, MEMORY below Programme HIMEM won't be filled with String Data that HEX$ stores there. I have tried to reduce it with CLEAR which helps, though if I can reduce it to Zero by Fetching Bytes from ROM Routine and Store in Fixed Area before transferring to Main Memory, it should free a lot of space in the BASIC file.
The disadvantage for me is part of the Language is on ROM and I cannot test on my 6128 because the Expansion Port was modified to operate as a RS-232 Port.


Though it should be an noticable improvement after each instruction is entered. I have been looking at other ways though at Loading the commands as a Text file, though have only done experimental stuff, otherwise I hope the improvement from the ROM will execute faster than a lot of BASIC HEX$ Data stuff and have code Pasted Correctly.


The Execution Speed of the programmes generated should remain the same, some examples I coded on the Weekend revealed code slowing down, though seem to be the result of a lack of Array's currently.





Title: Re: TBAS - writing a little computer language
Post by: AMSDOS on 06:51, 11 October 20
Have finally managed to create a version which has it's own ROM.


Fingers Crossed I have found all the bugs, there were some problems with the LET statement section relating to Integer Number/variable handling, which became aparent when testing some of the early code samples.


Size wise, removal of the String Characters from the BASIC file has reduce it by 2kb, all the code generated now comes from the ROM except for some Offset or fixed addressing which needs to be stored in RAM. The ROM merely pokes the relevant bytes to RAM which I refer to as the store at &AF01 with &AF00 being used as a Counter, once it's ready to be stored to it's final resting place, the counter is cleared. At the moment this is still a BASIC routine, though could be made into another ROM routine to place into Main Memory.




100 MODE 2:SYMBOL AFTER 256:MEMORY &3FFF
110 |DOKE,&BE80,&4000 ' Address Ptr
120 |DOKE,&BE82,&9000 ' String Ptr
121 |DOKE,&BE86,&A000 ' Variable Ptr
122 |DOKE,&BE88,&A100 ' Integer Variable Ptr
123 POKE &BF00,0:POKE &A770,0 ' Jump & While Loop Counter
130 GOSUB 1100
135 DEFINT a-z
136 a=0:|DEEK,&BE80,@a:GOSUB 1040
140 LINE INPUT":-",c$
150 IF UPPER$(c$)="RUN" THEN CALL &4000:CLEAR:GOTO 140
160 GOSUB 2000
170 IF a$="CLS" THEN |SF,1:GOSUB 1000
180 IF a$="LOCATE" THEN t=8:GOSUB 2100:GOSUB 1160:GOSUB 1000
190 IF a$="PRINT" THEN GOSUB 2300:GOSUB 2400:GOSUB 1000
200 IF a$="LET" THEN GOSUB 2600:GOSUB 1000
210 IF a$="FOR" THEN GOSUB 3000
220 IF a$="NEXT" THEN GOSUB 3050
229 IF a$="SCR" THEN t=12:GOSUB 2100:GOSUB 1160:|SF,5:GOSUB 1000
230 IF a$="PEN" THEN t=12:GOSUB 2100:GOSUB 2227:GOSUB 1160:|SF,2:GOSUB 1000
231 IF a$="BKG" THEN t=12:GOSUB 2100:GOSUB 1160:|SF,10:GOSUB 1000
232 IF a$="PAL" THEN t=35:GOSUB 2100:|RTINE,32:|RTINE,c-1,t:|RTINE,c-1,33:GOSUB 1000
240 IF a$="IF" THEN GOSUB 3500
250 IF a$="ENDIF" THEN GOSUB 3700
260 IF a$="WHILE" THEN GOSUB 4000
270 IF a$="WEND" THEN GOSUB 4200
280 IF a$="FLY" THEN |SF,3:GOSUB 1000
290 CLEAR
300 GOTO 135
999 ' Poke Main Code to Memory
1000 b=0:WHILE PEEK(&AF00)>0
1010   POKE PEEK(&BE81)*256+PEEK(&BE80),PEEK(&AF01+b)
1020   IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
1021   b=b+1:POKE &AF00,PEEK(&AF00)-1
1030 WEND
1040 IF PEEK(a)=0 THEN a=0:|DEEK,&BE80,@a:POKE a,&C9
1050 RETURN
1099 ' Delete any old routines if found
1100 |NEW
1150 RETURN
1151 ' Move Code for Jump Routines and then clean up code
1152 |MOVE,s,d,l
1153 |MOVE,d,s+jb,l
1154 |MOVE,d+1,d+2,l
1155 RETURN
1159 ' Check Locate Routine
1160 |RTINE,n(1),n(2),t
1220 RETURN
1229 ' Extract a value for LET, FOR...
1230 a1=a:s=1
1240 WHILE (a<>LEN(c$)+1) AND (MID$(c$,a,1)<>" ")
1250   s=s+1:a=a+1
1260 WEND
1270 n2=VAL(MID$(c$,a1,s))
1280 RETURN
1899 ' Regular routines used though the programme.
1900 a=INSTR(c$,"=")+1:RETURN
1901 a=INSTR(c$," ")+1:RETURN
1902 e$=MID$(c$,a,1):RETURN
1903 s=PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))
1904 d=PEEK(&BE81)*256+PEEK(&BE80)+3
1905 l=PEEK(&BE81)*256+PEEK(&BE80)-(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))+3
1906 RETURN
1907 a=INSTR(c$,CHR$(34))+1:RETURN
1908 a=INSTR(a,c$,"(")+1:RETURN
1909 a=INSTR(a,c$,")")+1:RETURN
1910 a=INSTR(c$,","):RETURN
1911 n=(PEEK(&BE81)*256)+(PEEK(&BE80)+PEEK(&A770)*3):RETURN
1912 n=(PEEK(&BF00+(PEEK(&BF00)*3))*256)+(PEEK(&BEFF+(PEEK(&BF00)*3)))+(PEEK(&A770)*3):RETURN
1999 ' Search for Main Keywords
2000 a$="":a=1
2010 IF INSTR(c$," ")=0 THEN s=LEN(c$) ELSE s=INSTR(c$," ")-1
2020 a$=UPPER$(MID$(c$,a,s))
2030 RETURN
2099 ' Search parameters for 8bit values
2100 a$="":GOSUB 1901:a1=a:c=1
2101 WHILE ASC(MID$(c$,a1,1))<58
2110   s=1
2120   WHILE a<=LEN(c$)
2130     WHILE (MID$(c$,a,1)<>CHR$(44)) AND (a<>LEN(c$)+1)
2140       s=s+1
2150       a=a+1
2160     WEND
2170     IF s1=2 THEN |DOKE,&BE00+(c*2),VAL(MID$(c$,a1,s)) ELSE POKE &BDFF+c,VAL(MID$(c$,a1,s))
2180     a=a+1:s=1:a1=a:c=c+1
2190     IF (a<=LEN(c$)) THEN IF ASC(MID$(c$,a1,1))>57 THEN GOTO 2101
2200   WEND
2201   IF a>LEN(c$) THEN t=t-4:RETURN
2202 WEND
2210 GOSUB 2220
2211 n(c)=n:a=a+1:c=c+1
2212 GOSUB 1902:IF e$="," THEN a=a+1:a1=a:t=t+2:GOTO 2101 ELSE t=t+2:RETURN
2219 ' Search variable position
2220 a=INSTR(a,c$,"(")+1 ' move ptr to number position
2221 s=INSTR(a,c$,")")-a ' get the size of that number
2222 n=VAL(MID$(c$,a,s)) ' store in n
2223 a=INSTR(a,c$,")") ' increment a
2226 RETURN
2227 IF INSTR(c$,"b") THEN t=t+1 ' disquinguish between pen i(0) & pen b(0)
2228 RETURN
2299 ' Search PRINT strings and store to memory.
2300 GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:|RTINE,PEEK(&BE86)+n,PEEK(&BE87),15:|SF,4:sk=1:RETURN
2309 a$="":a=1:sp=0:|DEEK,&BE82,@sp:|DOKE,&BE84,sp ' string start ptr
2310 WHILE (MID$(c$,a,1)<>CHR$(34)) AND (a<>LEN(c$)+1)
2320   a=a+1
2330 WEND
2340 a=a+1:p=a:d=LEN(c$):RETURN
2350 WHILE p<=d
2360  POKE PEEK(&BE83)*256+PEEK(&BE82),ASC(MID$(c$,p,1))
2370  IF PEEK(&BE82)=255 THEN POKE &BE82,0:POKE &BE83,PEEK(&BE83)+1 ELSE POKE &BE82,PEEK(&BE82)+1
2375  p=p+1
2380 WEND:POKE PEEK(&BE83)*256+PEEK(&BE82)-1,0
2390 RETURN
2399 ' Check if Character or String
2400 IF sk=1 THEN RETURN ELSE IF p<8 THEN RETURN ELSE IF p+1=d THEN GOSUB 2410:RETURN ELSE GOSUB 2350:adr=&7FFF:sl=1:GOSUB 2420:RETURN
2409 ' If Character is found use this routine
2410 GOSUB 1907
2411 POKE &BE00,ASC(MID$(c$,a,1)):|RTINE,8:|SF,4:RETURN
2419 ' Otherwise use Text String Routine
2420 p=1:p1=1
2430 WHILE PEEK(adr+1)=0
2440   ON sl GOSUB 2511,2512
2490 WEND
2500 IF sl=1 THEN |RTINE,3
2510 RETURN
2511 |RTINE,adr+1,1:POKE &AF00,0:RETURN
2512 |RTINE,adr+1,2:POKE &AF00,0:RETURN
2520 ' Store Jump Address
2530 POKE &BF00,PEEK(&BF00)+1:POKE &BEFE+(PEEK(&BF00)*3),k
2531 POKE &BEFF+(PEEK(&BF00)*3),PEEK(&BE80):POKE &BF00+(PEEK(&BF00)*3),PEEK(&BE81):RETURN
2532 POKE &A770,PEEK(&A770)+1:POKE &A76E+(PEEK(&A770)*2+1),j1:POKE &A76E+(PEEK(&A770)*2+2),j2:RETURN
2540 ' Delete Jump Address
2550 POKE &BEFF+PEEK(&BF00)*3,0:POKE &BEFE+(PEEK(&BF00)*3),0
2551 POKE &BF00+PEEK(&BF00)*3,0:POKE &BF00,PEEK(&BF00)-1:RETURN
2552 POKE &A76E+(PEEK(&A770)*2+2),0:POKE &A76E+(PEEK(&A770)*2+1),0:POKE &A770,PEEK(&A770)-1:RETURN
2599 ' Evaluate LET command to determine if Byte or Integer Variable
2600 a$="":IF MID$(c$,5,1)="i" THEN a=5:GOSUB 2780:RETURN
2620 GOSUB 2220:GOSUB 1900
2621 IF MID$(c$,a,1)="t" THEN n2=n:GOSUB 2881:RETURN
2622 IF MID$(c$,a,1)="r" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 2220:|RTINE,n,5:n=n2
2623 IF MID$(c$,a,1)="m" THEN n2=n:sl=2:adr=&800B:GOSUB 2420:GOSUB 1908:sl=3
2624 IF sl=3 THEN IF MID$(c$,a,1)="b" THEN GOSUB 2220:|RTINE,n,n2,21:RETURN ELSE n=n2:GOSUB 1230:|RTINE,n,n2,23:RETURN
2630 IF INSTR(c$,"+") THEN s1=1:a=a+1
2640 IF INSTR(c$,"-") THEN s1=2:a=a+1
2641 IF sl=2 THEN GOTO 2720
2650 GOSUB 1902:IF e$="b" THEN n2=n:GOSUB 2220:|RTINE,s1,n,n2,11:RETURN
2710 IF s1=0 THEN GOSUB 1230:IF n2<>0 THEN POKE &BE00,n2:|RTINE,8:|RTINE,n,9:RETURN ELSE |RTINE,n,13:RETURN
2720 IF s1=1 THEN IF sl=0 THEN GOSUB 2771:GOSUB 2772 ELSE IF s1=1 THEN IF sl=2 THEN GOSUB 2772
2730 IF s1=2 THEN IF sl=0 THEN GOSUB 2771:GOSUB 2772 ELSE IF s1=2 THEN IF sl=2 THEN GOSUB 2772
2740 IF s1=1 OR s1=2 OR sl=2 THEN |RTINE,n,9
2741 IF sl=2 THEN RETURN
2770 RETURN
2771 |RTINE,n,0,15:RETURN
2772 IF s1=1 THEN a=INSTR(c$,"+")+1:GOSUB 1230:b$=RIGHT$(HEX$(n2,4),2) ELSE IF s1=2 THEN a=INSTR(c$,"-"):GOSUB 1230:b$=RIGHT$(HEX$(n2,4),2)
2773 IF n2=1 OR n2=-1 THEN IF s1=1 THEN |RTINE,s1,7 ELSE IF s1=2 THEN |RTINE,s1,7
2774 IF n2>1 OR n2<-1 THEN |RTINE,VAL("&"+b$),16
2775 RETURN
2780 GOSUB 2220:GOSUB 1900
2790 IF INSTR(c$,"+") OR INSTR(c$,"-") THEN s1=1:a=a+1
2800 GOSUB 1902:IF e$="&" THEN h=1:a=a+1
2801 IF e$<>"i" AND h<>1 AND MID$(c$,a-1,1)<>"=" THEN a=a-1
2802 IF e$="i" THEN s1=2:n2=n:GOSUB 2220:|RTINE,n,n2,17:RETURN
2810 IF h=0 THEN n$=HEX$(VAL(MID$(c$,a,LEN(c$)+1-a)),4) ELSE n$=HEX$(VAL("&"+MID$(c$,a,LEN(c$)+1-a)),4)
2820 lo=VAL("&"+MID$(n$,1,2)):hi=VAL("&"+MID$(n$,3,2))
2830 IF s1=1 THEN |RTINE,lo,hi,n,18
2870 IF s1=0 THEN |RTINE,lo,hi,n,19
2880 RETURN
2881 GOSUB 1908:s1=2:a1=a:c=0:t=24:GOSUB 2101
2882 |RTINE,n(0),n(1),t:|SF,7:|RTINE,n2,9
2885 RETURN
2999 ' FOR Loop
3000 GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220:GOSUB 1900:GOSUB 2710
3010 a=INSTR(UPPER$(c$),"TO ")+3:GOSUB 1230:|RTINE,n2,24:GOSUB 1000
3011 IF PEEK(&BE00)<n2 THEN k=3 ELSE k=1
3020 GOSUB 2530
3030 |PS,1:GOSUB 1000
3040 RETURN
3049 ' NEXT
3050 GOSUB 1901:GOSUB 1902:IF e$="b" THEN GOSUB 2220
3060 |PS,2:GOSUB 1000:|RTINE,n,0,15
3061 IF PEEK(&befe+(PEEK(&bf00)*3))=3 THEN |RTINE,1,7 ELSE |rtine,2,7
3062 |RTINE,n,9:|RTINE,25:GOSUB 1000
3070 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-126 THEN GOSUB 3100:RETURN
3080 |JPS,PEEK(&BEFE+(PEEK(&BF00)*3)):GOSUB 1912:|RTINE,n,29:GOSUB 1000:GOSUB 3130
3090 RETURN
3100 |JRS,PEEK(&BEFE+(PEEK(&BF00)*3)):GOSUB 1000
3110 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))-(PEEK(&BE81)*256+PEEK(&BE80))-1)
3120 hi=VAL("&"+MID$(n$,3,2)):|RTINE,hi,27:GOSUB 1000
3130 GOSUB 2550:RETURN
3499 ' IF
3500 a$="":GOSUB 1901:GOSUB 1902
3501 IF e$="b" THEN GOSUB 3502:GOSUB 2530:RETURN ELSE IF e$="k" THEN GOSUB 3511:GOSUB 2530:RETURN
3502 GOSUB 2220
3503 a=a+1
3504 GOSUB 1902
3505 IF e$="=" THEN a=a+1:k=1 ELSE IF e$="<" THEN a=a+1:k=3 ELSE IF e$=">" THEN a=a+1:k=4
3506 IF MID$(c$,a,1)<>"b" THEN GOSUB 1230:|RTINE,PEEK(&BE86)+n,PEEK(&BE87),15 ELSE GOSUB 3528:f=1
3507 IF n2<>0 AND f=0 THEN |RTINE,&FE,27:|RTINE,n2,27:GOSUB 1000 ELSE IF n2=0 AND f=0 THEN |RTINE,&A7,27:GOSUB 1000
3508 RETURN
3511 GOSUB 2220
3512 |RTINE,&3E,27:|RTINE,n,27:|SF,8
3513 GOSUB 1000
3514 k=2
3517 RETURN
3528 n3=n:GOSUB 2220:|RTINE,PEEK(&BE86)+n,PEEK(&BE87),15:|RTINE,&47,27
3529 a=0:|DEEK,&BE86,@a:a=a+n3:|RTINE,&3A,27:|RTINE,a,29:|RTINE,&B8,27
3530 GOSUB 1000:RETURN
3699 ' ENDIF
3700 a$=""
3710 GOSUB 1905:l=l-3:IF l>=125 THEN jb=3 ELSE jb=2
3720 GOSUB 1903
3730 GOSUB 1152
3740 IF jb=3 AND ss=0 THEN GOSUB 3762
3750 IF jb=2 AND ss=0 THEN GOSUB 1905:l=l-3:GOSUB 3770
3760 IF ss=0 THEN GOSUB 2550
3761 RETURN
3762 |JPS,PEEK(&BEFE+PEEK(&BF00)*3)
3763 GOSUB 2532:GOSUB 1911:GOSUB 2552:|RTINE,n,29:GOSUB 3779:RETURN
3770 |JRS,PEEK(&BEFE+PEEK(&BF00)*3)
3771 |RTINE,l,27:GOSUB 3779:RETURN
3779 FOR a=0 TO jb-1:POKE PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3))+a,PEEK(&AF01+a)
3780 IF PEEK(&BE80)=255 THEN POKE &BE80,0:POKE &BE81,PEEK(&BE81)+1 ELSE POKE &BE80,PEEK(&BE80)+1
3790 NEXT a:POKE &AF00,0:RETURN
3999 ' WHILE
4000 GOSUB 1901
4001 IF MID$(c$,a,1)="b" THEN GOSUB 2220:a=a+1:GOSUB 2530:GOSUB 4031
4010 IF MID$(c$,a,2)="k=" OR MID$(c$,a,3)="k<>" THEN GOSUB 2530:|SF,9
4020 IF MID$(c$,a+1,1)="=" THEN |RTINE,&A7,27:j1=&20:j2=&C2
4021 IF MID$(c$,a+1,2)="<>" THEN IF MID$(c$,a+3,2)<>CHR$(34)+CHR$(34) THEN GOSUB 1907:|RTINE,&FE,27:|RTINE,ASC(MID$(c$,a,1)),27:j1=&28:j2=&CA ELSE |RTINE,&A7,27:j1=&28:j2=&CA
4030 GOSUB 2532:GOSUB 1000:GOSUB 2530:RETURN
4031 IF MID$(c$,a,1)="<" THEN a=a+1:j1=&30:j2=&D2:GOSUB 4036
4032 IF MID$(c$,a,1)=">" THEN a=a+1:j1=&38:j2=&DA:GOSUB 4036
4033 IF MID$(c$,a,1)="=" THEN a=a+1:j1=&20:j2=&C2:GOSUB 4036
4034 RETURN
4035 IF n2=0 THEN GOSUB 4038:|RTINE,&A7,27:RETURN ELSE GOSUB 4038:|RTINE,&FE,27:|RTINE,n2,27:RETURN
4036 IF MID$(c$,a,1)="b" THEN n2=n:GOSUB 2220:GOSUB 4039:RETURN
4037 GOSUB 1230:GOSUB 4035:RETURN
4038 |RTINE,n,0,30:RETURN
4039 |RTINE,n,0,30:|RTINE,&3A47,29:a=0:|DEEK,&BE86,@a:a=a+n2:|RTINE,a,29:|RTINE,&B8,27:RETURN
4199 ' WEND
4200 IF (PEEK(&BF00+(PEEK(&BF00)*3))*256+PEEK(&BEFF+(PEEK(&BF00)*3)))-(PEEK(&BE81)*256+PEEK(&BE80))>=-121 THEN GOSUB 4220:RETURN
4210 |JPS,5:GOSUB 4214:|RTINE,n,29:GOSUB 1000
4211 ss=1:jb=3:a=PEEK(&A76E+PEEK(&A770)*2+2):|RTINE,a,27:GOSUB 1911:|RTINE,n,29
4212 GOSUB 2552:GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN
4214 n=PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+(PEEK(&BEFF+(PEEK(&BF00)-1)*3)+(PEEK(&A770)-1)*3):RETURN
4220 |JRS,5:GOSUB 1000
4230 n$=HEX$(PEEK(&BF00+(PEEK(&BF00)-1)*3)*256+PEEK(&BEFF+(PEEK(&BF00)-1)*3)-(PEEK(&BE81)*256+PEEK(&BE80))-3)
4240 hi=VAL("&"+MID$(n$,3,2)):|RTINE,hi,27:GOSUB 1000
4241 jb=2:ss=1:GOSUB 1905:l=l-3:a=PEEK(&A76E+PEEK(&A770)*2+1):|RTINE,a,27:|RTINE,l,27
4250 GOSUB 2552:GOSUB 3710:GOSUB 3779:GOSUB 2550:GOSUB 2550:RETURN



The ROM is a series of RSXs, in order to get the most from using the same RSX to carry out different tasks, I created an RSX called RTINE with the last number representing what operation to carry out. This has resulted in a Long range list that I guess needs to search through before the right number is found, though I haven't noticed any speed restrictions (maybe because their's only 30 odd tasks to carry out so far?).




org &af01


.store
defb 0,0,0,0,0,0,0,0,0,0,0,0,0
defb 0,0


org #C000


write direct -1,1,#c0


defb 1
defb 1,1,1


defw nametable


jp initialize


jp rtines
jp findfirm
jp new
jp move
jp doke
jp deek
jp pushpop
jp jrsel
jp jpsel


ret


.nametable
defb "TBAS Routine"
defb "s"+#80
defb "RTIN"
defb "E"+#80
defb "S"
defb "F"+#80
defb "NE"
defb "W"+#80
defb "MOV"
defb "E"+#80
defb "DOK"
defb "E"+#80
defb "DEE"
defb "K"+#80
defb "P"
defb "S"+#80
defb "JR"
defb "S"+#80
defb "JP"
defb "S"+#80
defb 0


.initialize
push de
push hl


ld hl,message
call print


pop hl


ld de,100
sbc hl,de


pop de



scf
ret


.message
defb " TBAS Routines Installed",10,10,13,0


.print ld a,(hl)
cp 0
ret z
call #bb5a
inc hl
jr print


.new
ld hl,&4000
ld bc,&667b
.delprg
ld a,0
ld (hl),a
inc hl
dec bc
ld a,b
or c
jr nz,delprg
ret


.move
ld c,(ix+00)
ld b,(ix+01)
ld e,(ix+02)
ld d,(ix+03)
ld l,(ix+04)
ld h,(ix+05)
ldir
ret


.doke
ld e,(ix+00)
ld d,(ix+01)
ld l,(ix+02)
ld h,(ix+03)
ld (hl),e
inc hl
ld (hl),d
ret


.deek
ld e,(ix+02)
ld d,(ix+03)
ld l,(ix+00)
ld h,(ix+01)
ld a,(de)
ld (hl),a
inc de
inc hl
ld a,(de)
ld (hl),a
ret




.rtines
ld a,(ix+00)
cp 1
jp z,isone
cp 2
jp z,istwo
cp 3
jp z,isthree
cp 4
jp z,isfour
cp 5
jp z,isfive
cp 6
jp z,issix
cp 7
jp z,issvn
cp 8
jp z,iseght
cp 9
jp z,isnine
cp 10
jp z,isten
cp 11
jp z,iselvn
cp 12
jp z,istwelve
cp 13
jp z,thrteen
cp 14
jp z,fourteen
cp 15
jp z,fifteen
cp 16
jp z,sixteen
cp 17
jp z,svnteen
cp 18
jp z,eghteen
cp 19
jp z,ninteen
cp 20
jp z,twenty
cp 21
jp z,twntone
cp 22
jp z,twntwo
cp 23
jp z,twnthree
cp 24
jp z,twnfour
cp 25
jp z,twnfive
cp 26
jp z,twensx
cp 27
jp z,twensv
cp 28
jp z,tweneg
cp 29
jp z,twenine
cp 30
jp z,thirty
cp 31
jp z,thirtyone
cp 32
jp z,thirtytwo
cp 33
jp z,thirthree
ret
.isone
ld de,onedat
ld l,(ix+02)
ld h,(ix+03)
ld b,9
call poke
ret


.istwo
ld de,twodat
ld l,(ix+02)
ld h,(ix+03)
ld b,21
call poke
ret


.isthree
ld de,thredat
ld hl,store
ld b,6
call poke
ld hl,(&be84)
ld (store+1),hl
ret

.isfour
ld de,fourdat
ld hl,store
ld b,7
call poke
call p1
ld a,(&be01)
ld (store+3),a
ret


.isfive
ld de,fivedat
ld hl,store
ld b,8
call poke
ld a,(ix+02)
ld (store+4),a
ret


.issix
ld de,sixdat ;; de = six data
ld hl,store ;; hl = location of store
ld b,9 ;; number of times to loop
call poke ;; poke there
call sbr1
ld a,(&be01) ;; and a low numerical from &be01
ld (store+5),a ;; is stored at store+5
ret


.issvn ;; evaluate if inc or dec
call calarea ;; calculate area to poke at &af01
ld a,(ix+02)
cp 2
jr z,twofnd
ld a,&3c
jr esven
.twofnd
ld a,&3d
.esven
ld (hl),a
ret
.iseght ;; ld a,val
ld hl,store
ld a,&3e
ld (hl),a
call bytecounter
call p1
call bytecounter
ret


.isnine ;; ld (byte variable ptr),a
call calarea
ld a,&32
ld (hl),a
inc hl
ld b,(ix+02)
call caln
;; ld a,(ix+02)
ld (hl),a
call bytecounter
inc hl
ld a,(&be87)
;; ld a,(ix+04)
ld (hl),a
call bytecounter
ret



.isten
ld de,tendat
ld hl,store
ld b,9
call poke
call p1
ld b,(ix+02)
call caln
ld (store+3),a
ld a,(&be87)
ld (store+4),a
ret


.iselvn ;; Determine if add or subtract 8bit number
ld de,evndat
ld hl,store
ld b,11
call poke
ld a,(ix+6)
cp 2
jr nz,cont11
ld a,&90
ld (store+7),a
.cont11
call sbr1
call sbr2
ld b,(ix+02)
call caln
ld (store+9),a
ld a,(&be87)
ld (store+10),a
ret


.istwelve
ld de,twelvedat
ld hl,store
ld b,11
call poke
call sbr1
ld b,(ix+02)
call caln
ld (store+5),a
ld a,(&be87)
ld (store+6),a
ret


.thrteen ;; determine if number is zero.
ld hl,store
ld a,&af
ld (hl),a
call bytecounter
inc hl
ld a,&32
ld (hl),a
call bytecounter
inc hl
ld b,(ix+02)
call caln
ld (hl),a
call bytecounter
inc hl
ld a,(&be87)
ld (hl),a
call bytecounter
ret


.fourteen
ld hl,store
ld a,&2a
ld (hl),a
call bytecounter
ld b,(ix+04)
call calin
ld (store+1),a
ld a,(&be89)
ld (store+2),a
ld a,&7e
ld (store+3),a
ret


.fifteen
ld hl,store
call hand3a
call sbr1
call bytecounter
call bytecounter
ret


.sixteen ;; handle adding or subtracting numbers
;; larger than 1.
call calarea
ld a,&06
ld (hl),a
inc hl
call bytecounter
ld a,(ix+02)
ld (hl),a
call bytecounter
inc hl
ld a,&80
ld (hl),a
ret


.svnteen ;; handle if integer variable found and add
ld de,svntendat
ld hl,store
ld b,11
call poke
ld b,(ix+04)
call calin
ld (store+1),a
ld a,(&be89)
ld (store+2),a
ld b,(ix+02)
call calin
ld (store+5),a
ld (store+9),a
ld a,(&be89)
ld (store+6),a
ld (store+10),a
ret


.eghteen ;; lo,hi,n - increase integer number
ld de,svntendat
ld hl,store
ld b,3
call poke
ld de,eghtendat
ld b,7
call poke
ld b,(ix+2)
call calin
ld (store+1),a
ld (store+8),a
ld a,(&be89)
ld (store+2),a
ld (store+9),a
ld a,(ix+4)
ld (store+4),a
ld a,(ix+6)
ld (store+5),a
ret


.ninteen
ld de,nintendat
ld hl,store
ld b,6
call poke
ld b,(ix+2)
call calin
ld (store+4),a
ld a,(&be89)
ld (store+5),a
ld a,(ix+4)
ld (store+1),a
ld a,(ix+6)
ld (store+2),a
ret


.twenty
ld de,twntydat
ld hl,store
ld b,7
call poke
ld hl,(&be00)
ld (store+1),hl
ld hl,(&be02)
ld (store+5),hl
ret


.twntone
ld de,evndat
ld hl,store
ld b,7
call poke
ld de,twyonedat
ld b,6
call poke
call sbr1
call sbr2
ld b,(ix+2)
call caln
ld (store+11),a
ld a,(&be87)
ld (store+12),a
ret



.twntwo
ld de,twtwdat
ld hl,store
ld b,7
call poke
ld b,(ix+04)
call calin
ld (store+1),a
ld a,(&be89)
ld (store+2),a
ld hl,(&be02)
ld (store+5),hl
ret


.twnthree
ld de,evndat
ld hl,store
ld b,3
call poke
ld a,&06
ld (store+3),a
inc hl
call bytecounter
ld a,(ix+02)
ld (store+4),a
inc hl
call bytecounter
ld de,twyonedat
ld b,6
call poke
call sbr1
ld b,(ix+04)
call caln
ld (store+9),a
ld a,(&be87)
ld (store+10),a
ret


.twnfour ;; used in for loop
call calarea ;; rtine,n2,24
ld a,&47
ld (hl),a
inc hl
call bytecounter
ld a,&0e
ld (hl),a
inc hl
call bytecounter
ld a,(ix+02)
ld (hl),a
ret


.twnfive
call calarea
ld a,&47
ld (hl),a
inc hl
call bytecounter
ld a,&79
ld (hl),a
inc hl
call bytecounter
ld a,&b8
ld (hl),a
ret



.twensx
ld de,twnsxdat
ld hl,store
ld b,7
call poke
ld hl,(&be00)
ld (store+1),hl
ld b,(ix+02)
call calin
ld (store+5),a
ld a,(&be89)
ld (store+6),a
ret


.twensv
call calarea
ld a,(ix+02)
ld (hl),a
ret


.tweneg
ld de,twnegdat
ld hl,store
ld b,7
call poke
ld b,(ix+04)
call calin
ld (store+1),a
ld a,(&be89)
ld (store+2),a
ld b,(ix+02)
call calin
ld (store+5),a
ld a,(&be89)
ld (store+6),a
ret


.twenine
call calarea
ld e,(ix+02)
ld d,(ix+03)
ld (hl),e
inc hl
call bytecounter
ld (hl),d
ret


.thirty
ld de,evndat
ld hl,store
ld b,3
call poke
call sbr1
ret


.thirtyone
ld b,(ix+02) ;; size of palette.
ld hl,&be00 ;; parameters
ex de,hl ;; stored in de.
ld hl,(&be82) ;; string ptr in hl
.thrloop
ld a,(de)
ld (hl),a
inc hl
inc de
djnz thrloop
ld (&be82),hl ;; store new string ptr position
ret


.thirtytwo
ld hl,store
ld a,&21
ld (hl),a
call bytecounter
ld hl,(&be82)
ld (store+1),hl
call bytecounter
call bytecounter
ret


.thirthree
call calarea
ld de,thrthdat
ld b,14
call poke
ld a,(ix+02)
ld (hl),a
inc hl
inc de
ld b,2
call poke
ret


.hand3a
ld a,&3a
ld (hl),a
call bytecounter
ret


.caln
ld a,(&be86) ;; value of variable ptr &00..&a0
.nloop
inc a ;; increment based on numberal position
djnz nloop ;; loop until reached
ret


.calin
ld a,(&be88) ;; value of integer variable ptr &00..&a1
.niloop
inc a
inc a ;; increment twice to return correct position
djnz niloop ;; until b=0
ret


.poke
ld a,(de)
ld (hl),a
inc hl
inc de
call bytecounter
djnz poke
ret


.sbr1
ld b,(ix+04) ;; b = n(1) position
call caln
call p2
ret


.sbr2
ld b,(ix+02)
call caln
call p3
ret


.p1 ld a,(&be00)
ld (store+1),a
ret


.p2 ld (store+1),a ;; store this at store+1
ld a,(&be87) ;; along with the
ld (store+2),a ;; high byte.
ret


.p3 ld (store+5),a
ld a,(&be87)
ld (store+6),a
ret


.bytecounter
ld a,(&af00)
inc a
ld (&af00),a
ret


.calarea ;; <NOTE>: each time calarea is used
call bytecounter ;; a new address spot is assigned,
ld b,a ;; so one less call to bytecounter is
ld hl,&af00 ;; needed when calarea is used.
.fspot
inc hl
djnz fspot
ret


.onedat
defb &7E,&CD,&5A,&BB,&23,&A7,&20,&F8,&C9 ;; prints string
.twodat
defb &2A,&09,&80,&ED,&5F,&57,&5F,&19,&AD,&87,&AC,&6F,&22,&09,&80,&C9,&90,&30,&FD,&80,&C9
;; r(num) & m(num) routine
.thredat
defb &21,&00,&00,&CD,&00,&80 ;; print "string"
.fourdat
defb &26,&00,&2E,&00,&CD,&75,&BB ;; locate <num>,<num>
.fivedat
defb &CD,&0C,&80,&06,&00,&CD,&1C,&80
.sixdat
defb &3A,&00,&00,&67,&2E,&00,&CD,&75,&BB ;; locate <b(num)>,<num>
.tendat
defb &26,&00,&3A,&00,&00,&6F,&CD,&75,&BB ;; locate <num>,<b(num)>
.evndat
defb &3a,&00,&00,&47,&3a,&00,&00,&80,&32,&00,&00 ;; let b(x)=(+,-)b(x)
.twelvedat
defb &3A,&00,&00,&67,&3A,&00,&00,&6F,&CD,&75,&BB ;; locate <b(num)>,<b(num)>
.svntendat
defb &2A,&00,&00,&EB,&2A,&00,&00,&19,&22,&00,&00
.eghtendat
defb &11,&00,&00,&19,&22,&00,&00
.nintendat
defb &21,&00,&00,&22,&00,&00
.twntydat ;; 20
defb &21,&00,&00,&eb,&21,&00,&00 ;; test(num,num)
.twyonedat ;; 21
defb &cd,&1c,&80,&32,&00,&00
.twtwdat  ;; 22
defb &2a,&00,&00,&eb,&21,&00,&00 ;; test(i(n),num)
.twnsxdat ;; 26
defb &21,&00,&00,&eb,&2a,&00,&00 ;; test(num,i(n))
.twnegdat ;; 28
defb &2a,&00,&00,&eb,&2a,&00,&00 ;; test(i(n),i(n))
.thrthdat ;; 33
defb &3e,&00,&4e,&41,&f5,&e5,&cd,&32,&bc,&e1,&f1,&23,&3c,&fe,&00,&38,&f1


.findfirm
ld b,(ix+00)
ld hl,buffer
.floop
inc hl
inc hl
inc hl


djnz floop


ex de,hl ;; de = buffer + 3 bytes (position of firmware routine)


ld a,(&af00)
inc a
inc a
inc a
ld (&af00),a ;; byte counter


ld a,(&af00) ;; a = byte counter
ld b,a
ld hl,&aefe ;; hl = base address of routine
.floop2
inc hl ;; increase base address
djnz floop2 ;; until base address value @ &af00 = 0


ld b,3 ;; number of bytes to poke
.floop3
ld a,(de) ;; a = content of de
ld (hl),a ;; store at address of routine
inc hl ;; increase address for routine
inc de ;; increase address of firmware routine
djnz floop3 ;; until b = 0


ret
.buffer
defb 0,0,0
defb &cd,&6c,&bb
defb &cd,&90,&bb
defb &cd,&19,&bd
defb &cd,&5a,&bb
defb &cd,&0e,&bc
defb &cd,&18,&bb
defb &cd,&f0,&bb
defb &cd,&1e,&bb
defb &cd,&09,&bb
defb &cd,&96,&bb


.pushpop
ld b,(ix+00)
ld hl,ptable
.ploop
inc hl
djnz ploop
ld a,(hl)
push af
call calarea
pop af
ld (hl),a
ret

.ptable
defb 0
defb &c5,&c1
defb &d5,&d1
defb &e5,&e1
defb &f5,&f1


.jrsel
ld b,(ix+00)
ld hl,jrtable
.jloop
inc hl
djnz jloop
ld a,(hl)
ld hl,&af01
ld (hl),a
call bytecounter
ret
.jrtable
defb 0
defb &20 ;; jr nz,loop
defb &28 ;; jr z,loop
defb &30 ;; jr nc,loop
defb &38 ;; jr c,loop
defb &18 ;; jr loop


.jpsel
ld b,(ix+00)
ld hl,jptable
.jpoop
inc hl
djnz jpoop
ld a,(hl)
ld hl,store
ld (hl),a
call bytecounter
ret


.jptable
defb 0
defb &c2 ;; jp nz,loop
defb &ca ;; jp z,loop
defb &d2 ;; jp nc,loop
defb &da ;; jp c,loop
defb &c3 ;; jp loop



The slowest things I can determine are the paramater handling routine coded in BASIC, it's not bad when it only needs to deal in fewer parameters, though on the recently added 'pal' command which can handle 16 parameters, it's quite noticable. The problem is that routine converts string parameters into values, I recently updated it to also handle 16-bit values, which is now used in the 't' function to test for pixel values, which what I had earlier had some problems between dealing with integer variable and integer number.


The ROM I think will in any slot (obviously not 1 or 7 since BASIC ROM or a DOS ROM reside there), once it's installed, the message 'TBAS Routines Installed' will display itself after the computer is reset.


I have updated the opening thread with the appropriate files, the ROM is enclosed with the DSK file in the ZIP file, which can be put into the ROM directory for the Emulator to find.
Powered by SMFPacks Menu Editor Mod