News:

Printed Amstrad Addict magazine announced, check it out here!

Main Menu
avatar_AMSDOS

TBAS - writing a little computer language

Started by AMSDOS, 10:14, 01 April 20

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

AMSDOS


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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Gryzor


AMSDOS

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.
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Gryzor

Actually this is a great April Fool's :D

AMSDOS

#4
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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

#5
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



* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

zhulien

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...

AMSDOS

#7
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. 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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

zhulien

#8
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.

AMSDOS

I'm looking at languages like 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.
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

zhulien

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




AMSDOS

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


* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

#12

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:
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

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.
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

zhulien

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.

AMSDOS

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.
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS


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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

funkheld

#19


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

AMSDOS



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


* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

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
* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

AMSDOS

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 - 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 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, 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.

* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

ervin

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?

AMSDOS

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 & Commands PDF file.


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.

* Using the old Amstrad Languages :D * And create my own ;)
* Incorporating the Firmware :P
* I also like to problem solve code in BASIC :)   * And type-in Type-Ins! :D

Home Computing Weekly Programs
Popular Computing Weekly Programs
Your Computer Programs
Updated Other Program Links on Profile Page (Update April 16/15 phew!)
Programs for Turbo Pascal 3

Powered by SMFPacks Menu Editor Mod