Author Topic: TBAS - writing a little computer language  (Read 3978 times)

0 Members and 1 Guest are viewing this topic.

Offline ervin

  • Supporter
  • 6128 Plus
  • *
  • Posts: 1.394
  • Country: au
    • index.php?action=treasury
  • Liked: 1081
  • Likes Given: 1258
Re: TBAS - writing a little computer language
« Reply #25 on: 13:12, 13 July 20 »
Cool, thanks!
My (cancelled) entry for the CPCRetroDev 2017 Competition http://www.cpcwiki.eu/forum/programming/my-cpcretrodev-2017-entry/
FAST line drawing in CPCtelera http://www.cpcwiki.eu/forum/programming/drawing-lines-with-cpctelera-sdcc/
RUNCPC My entry for the CPCRetroDev 2015 Competition http://www.cpc-power.com/index.php?page=detail&num=12494

Offline ervin

  • Supporter
  • 6128 Plus
  • *
  • Posts: 1.394
  • Country: au
    • index.php?action=treasury
  • Liked: 1081
  • Likes Given: 1258
Re: TBAS - writing a little computer language
« Reply #26 on: 15:41, 13 July 20 »
Alrighty, I've had a go with it, and I'm afraid I get an error when I run 15.BAS from "tbas 12072020.dsk".
I get "Unexpected RETURN in 1150".

Really looking forward to trying this out though - it's a fascinating project.
My (cancelled) entry for the CPCRetroDev 2017 Competition http://www.cpcwiki.eu/forum/programming/my-cpcretrodev-2017-entry/
FAST line drawing in CPCtelera http://www.cpcwiki.eu/forum/programming/drawing-lines-with-cpctelera-sdcc/
RUNCPC My entry for the CPCRetroDev 2015 Competition http://www.cpc-power.com/index.php?page=detail&num=12494

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #27 on: 12:49, 14 July 20 »
Alrighty, I've had a go with it, and I'm afraid I get an error when I run 15.BAS from "tbas 12072020.dsk".
I get "Unexpected RETURN in 1150".

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


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


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


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

EDIT: Correction, the Firmware guide by Bob Taylor and Thomas Defoe, has the detailed summary of addresses for 6128 & 464 and what's stored there. The area I used &AF00 is used for WHILE, FOR & GOSUB Stack, which begins at &AE70 on the 6128 and &AE8C on the 464, is &1FF in size, which results in that area used ceasing at &B06F on 664/6128 and &808B on 464. Unfortunately, the other area I'm using at &B0D0 to handle the code shifting the firmware guide doesn't tell me what it is. On 664/6128 it starts at &B0A5 is &5B bytes in size, and &B0C7 on 464 and is &39 bytes in size, which is meant to consist of &FF, though Winape has it as &00. I'm guessing it's something relating to BASIC, but I don't know what. The other higher end areas I'm using at &BE00 is &40 bytes of &FF on all systems and &BE80 being &80 bytes of &FF though the area maybe used as part of the Machine Stack, which begins at &BFFF.
« Last Edit: 04:04, 16 July 20 by AMSDOS »
* Using the old Amstrad Languages :D   * with 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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #28 on: 04:00, 15 July 20 »
Okay, have updated new DSK image to opening thread, fingers crossed it works, have tried on 6128, 664 & 464 and haven't found any problems. I had to save 2 BINary files just so I wasn't saving Internal Machine Handling Stuff and dumping from the 6128 to the 464 and so, though the main offender in this case was the routine I used to move code around for when I'm handling Loops and IF statements, located initially at &B060 it was poking stuff past &B06E, I moved it to &B0D0 which appears to be Free Area on all CPCs - but as I said earlier, it doesn't feel like solid ground and I hope there's no hidden surprises I don't know about!  :o


Latest Source Code:



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


And Assembly Routines:

Code: [Select]

org &af00


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


org &af10


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


org &b0d0

ld c,(ix+00)
ld b,(ix+01)
ld e,(ix+02)
ld d,(ix+03)
ld l,(ix+04)
ld h,(ix+05)
ldir
ret
* Using the old Amstrad Languages :D   * with 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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #29 on: 12:53, 16 July 20 »
I wrote this little example because I think it maybe time to move my assembly routines to the extra 64k bank. The idea would be to have a main hub around &af00 to bank to that extra ram, call the routine and then return back to normal ram. I wasn't sure if I could call to &af00 with an extra parameter and then the routine in extra ram would take that parameter and process accordingly, though it seems to be working. The only other trick is to poke (in BASIC) the appropriate routine before calling &af00, at the moment I'm only using 3 routines, two of those will need to stay in the main ram because they handle the main code areas, which needs to be done in bank &c0, so just 1 routine to handle the return of appropriate mc bytes could be located in the extra ram, though it seems to be the most extensive code. In this example I've setup a MODE routine and INK routine in extra memory.


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

org &af00


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


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


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


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


.ink
ld c,(ix+00)
ld b,c
ld a,(ix+02)
call &bc32
ret
* Using the old Amstrad Languages :D   * with 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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #30 on: 12:57, 19 July 20 »

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


Code: [Select]
let b(0)=25
let b(1)=b(0)
locate b(0),b(1)
print "*"
locate 1,1


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


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


Assembly Routines:


Code: [Select]
   org &af00


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


   org &af10


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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

« Last Edit: 14:12, 22 July 20 by AMSDOS »
* Using the old Amstrad Languages :D   * with 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

Offline zhulien

  • 6128 Plus
  • ******
  • Posts: 546
  • Country: au
    • 8bitology
  • Liked: 225
  • Likes Given: 174
Re: TBAS - writing a little computer language
« Reply #31 on: 14:52, 23 July 20 »
the easiest way i have found to do loops and nestings is with a nestcount that forever increases for new nest usage, but decreases for closing of nestings.Here is an example of 3 loops.  First a nested loop, then a 3rd loop that is not nested:

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

becomes:

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

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

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

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

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

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

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

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

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

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

main_3_e: ; source line 14
   ret ; source line 15
« Last Edit: 14:55, 23 July 20 by zhulien »

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #32 on: 13:05, 24 July 20 »
the easiest way i have found to do loops and nestings is with a nestcount that forever increases for new nest usage, but decreases for closing of nestings.


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



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

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

becomes:

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

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

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

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

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

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

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

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

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

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

main_3_e: ; source line 14
   ret ; source line 15


Yes, I wrote my own little version in Locomotive BASIC, which had me thinking of how variables could range in size, which created this nested Loop task I need to address in my WHILE..WEND loop setup. The FOR..NEXT Loops work fine as Nested Loops though.
* Using the old Amstrad Languages :D   * with 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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #33 on: 14:15, 25 July 20 »

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


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


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


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

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


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

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

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

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

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

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

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

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

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


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


Examples:

Some Blinking Stars:


Code: [Select]
cls
let b(0)=3
let b(1)=1
while b(0)>1
while b(1)<10


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


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


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


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


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


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


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


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


wend


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


Testing 2nd variable:



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


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



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


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



Code: [Select]
cls
let b(0)=3
let b(3)=1
locate 1,1
while b(0)>1
while k=""
if b(3)<20
print "*"
print "@"
print "#"
print "'"
print "-"
print "!"
print "$"
print "%"
print "^"
print "&"
print "("
print ")"
print "{"
print "}"
print "0"
print "1"
print "2"
print "3"
print "4"
print "5"
print "6"
print "7"
print "8"
print "9"
print "a"
print "b"
print "c"
print "d"
print "e"
print "f"
endif
let b(3)=+1
for b(5)=1 to 2
fly
next b(5)
wend
let b(1)=10
let b(2)=13
print b(1)
print b(2)
let b(3)=1
let b(0)=-1
wend
« Last Edit: 09:37, 26 July 20 by AMSDOS »
* Using the old Amstrad Languages :D   * with 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

Offline zhulien

  • 6128 Plus
  • ******
  • Posts: 546
  • Country: au
    • 8bitology
  • Liked: 225
  • Likes Given: 174
Re: TBAS - writing a little computer language
« Reply #34 on: 17:14, 26 July 20 »
Here's a challenge...


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


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


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


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


will the code be fast? not really but it will be quite flexible.

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #35 on: 13:06, 27 July 20 »
I'm not following what you're suggesting:

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

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

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

* The only other thing which could be changed are how the PRINT "string", Random Number and MOD routines are stored in memory. At the moment the Language puts them in the same place regardless of if their used or not, so for example when I use the MOD routine an area of blank bytes at &8000 is present for when the PRINT "String" routine is used. All those things are Relocatable, though depending on what I add to it next may depend on if I should keep that in place or have some flexability.
* Using the old Amstrad Languages :D   * with 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

Offline andycadley

  • Supporter
  • 6128 Plus
  • *
  • Posts: 913
  • Liked: 445
  • Likes Given: 73
Re: TBAS - writing a little computer language
« Reply #36 on: 14:42, 27 July 20 »
Z80 (and most 8 bit CPU languages) isn't particularly well suited to writing fully relocatable code. It just lacks too much in terms of addressing modes. It can be done, but it's not pleasant and if you want the code to perform well you're probably going to need an assembler than can generate relocation tables so that you can write code normally and then fix it up on loading rather than trying to have the whole thing work wherever it is loaded.


Not a job for the faint hearted.

Offline zhulien

  • 6128 Plus
  • ******
  • Posts: 546
  • Country: au
    • 8bitology
  • Liked: 225
  • Likes Given: 174
Re: TBAS - writing a little computer language
« Reply #37 on: 22:58, 28 July 20 »
I'm not following what you're suggesting:

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



Perhaps you could add a new command such as:


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


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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #38 on: 12:25, 29 July 20 »

Latest version 29072020, corrects similiar problems I found earlier with WHILE..WEND, IF..ENDIF, so FOR..NEXT now correctly adjusts address offsets if Nested Loops come into play and Long Jumps are needed.


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


Code: [Select]

org &1000


call &bc14


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


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


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


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


call &bd19


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


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


jp while


.end
ret




Perhaps you could add a new command such as:


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


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


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


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


Adding Subroutines, was thinking of adding a point '.<num>' system, '.' to indicate I wish to add a subroutine, with a number to label which one, an address could then be assigned to it and when something like 'RETURN' is found, the address for a new subroutine can be +1 of that 'C9' byte, I'm not sure where to assign that Address system for the Subroutine, perhaps in Banked Memory?
* Using the old Amstrad Languages :D   * with 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

Offline zhulien

  • 6128 Plus
  • ******
  • Posts: 546
  • Country: au
    • 8bitology
  • Liked: 225
  • Likes Given: 174
Re: TBAS - writing a little computer language
« Reply #39 on: 17:41, 29 July 20 »
Extra memory usage from BASIC is really best the following ways.


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


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


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


Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #40 on: 03:24, 03 August 20 »
So, I wasn't sure if you were suggesting that I should be making a ROM, and stick my Machine Code Routines in it instead of having in extra 64k of RAM.


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


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


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


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


Code: [Select]

org &af00


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


org #C000


write direct -1,1,#c0


defb 1
defb 1,1,1


defw nametable


jp initialize


jp rtines


ret


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


.initialize
push de
push hl


ld hl,message
call print


pop hl


ld de,100
sbc hl,de


pop de



scf
ret


.message
defb "TBAS Routines Installed",0


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


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


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


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


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


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


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


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


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


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


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


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


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


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


.fourdat
defb &26,&00,&2E,&00,&CD,&75,&BB,&ff,&ff
.sixdat
defb &3A,&00,&00,&67,&2E,&00,&CD,&75,&BB,&ff,&ff
.tendat
defb &26,&00,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff
.twelvedat
defb &3A,&00,&00,&67,&3A,&00,&00,&6F,&CD,&75,&BB,&ff,&ff
« Last Edit: 11:59, 03 August 20 by AMSDOS »
* Using the old Amstrad Languages :D   * with 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

Offline zhulien

  • 6128 Plus
  • ******
  • Posts: 546
  • Country: au
    • 8bitology
  • Liked: 225
  • Likes Given: 174
Re: TBAS - writing a little computer language
« Reply #41 on: 19:39, 05 August 20 »
So, I wasn't sure if you were suggesting that I should be making a ROM, and stick my Machine Code Routines in it instead of having in extra 64k of RAM.


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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #42 on: 00:56, 06 August 20 »

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


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


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


It will just take a bit of work to get things like that, though should be worthwhile.
* Using the old Amstrad Languages :D   * with 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

Offline ervin

  • Supporter
  • 6128 Plus
  • *
  • Posts: 1.394
  • Country: au
    • index.php?action=treasury
  • Liked: 1081
  • Likes Given: 1258
Re: TBAS - writing a little computer language
« Reply #43 on: 06:55, 06 August 20 »
Okay, well I started putting the Assembly Routines I was using onto a ROM and from that I was able to use RSX from anywhere regardless of Memory Bank selected.

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

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


What sort of impact would this have on program execution speed?
My (cancelled) entry for the CPCRetroDev 2017 Competition http://www.cpcwiki.eu/forum/programming/my-cpcretrodev-2017-entry/
FAST line drawing in CPCtelera http://www.cpcwiki.eu/forum/programming/drawing-lines-with-cpctelera-sdcc/
RUNCPC My entry for the CPCRetroDev 2015 Competition http://www.cpc-power.com/index.php?page=detail&num=12494

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #44 on: 12:29, 06 August 20 »

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


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


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


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


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


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





* Using the old Amstrad Languages :D   * with 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

Offline AMSDOS

  • Supporter
  • 6128 Plus
  • *
  • Posts: 3.919
  • Country: au
    • index.php?action=treasury
    • Programs for Turbo Pascal 3
  • Liked: 1132
  • Likes Given: 1902
Re: TBAS - writing a little computer language
« Reply #45 on: 08:51, 11 October 20 »
Have finally managed to create a version which has it's own ROM.


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


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


Code: [Select]

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


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


Code: [Select]

org &af01


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


org #C000


write direct -1,1,#c0


defb 1
defb 1,1,1


defw nametable


jp initialize


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


ret


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


.initialize
push de
push hl


ld hl,message
call print


pop hl


ld de,100
sbc hl,de


pop de



scf
ret


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


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


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


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


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


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




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


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


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

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


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


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


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


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



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


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


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


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


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


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


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


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


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


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


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


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



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


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


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


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



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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


djnz floop


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


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


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


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


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


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

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


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


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


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


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


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


I have updated the opening thread with the appropriate files, the ROM is enclosed with the DSK file in the ZIP file, which can be put into the ROM directory for the Emulator to find.
* Using the old Amstrad Languages :D   * with 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