Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF

Recommended Posts

I have decided that this code that I used for VI99 is so handy that I am adding it to the library disk. 

 

The users words are:

+PATH    takes a string and prepends the current disk device to the string. 

 ?+PATH  checks for a '.' in the string. If its not there it does the prepend.

 

This will require a bit of extra work to translate to other Forth systems.

C+!  SCAN   and getting a CRU address into R12 are the sticky bits from what I can see. 

 

Spoiler
\ pluspath.fth   add path to a filename      Mar 4 2023 Brian Fox 

: +PLACE  ( addr n $ -- ) 2DUP 2>R  COUNT +  SWAP MOVE 2R> C+! ;

\ ========================
\ get current drive string
\ ========================
DECIMAL
24 USER 'R12

HEX
CODE 0SBO  ( -- ) 1D00 ,  NEXT, ENDCODE \ turn on card 
CODE 0SBZ  ( -- ) 1E00 ,  NEXT, ENDCODE \ turn off card 

: DISKCARD ( -- CRU) 83D0 @ ;    ( CRU address of the disk CARD )
: DEVLIST  ( -- $)  83D2 @ 4 + ; ( device strings in the card's ROM)

CREATE DSK$ 8 ALLOT  \ place for the device name in Forth 

: GETDEV  (  -- addr len) \ DSK$ will contain boot device 
  DISKCARD 'R12 !
  0SBO   DEVLIST COUNT DSK$ PLACE   0SBZ
  S" ." DSK$ +PLACE \ add the '.' char
  DSK$ COUNT 
;

\ ========================
\ append drive to filename 
\ ========================
: +PATH  ( filename$ len -- path$ len )
   GETDEV PAD PLACE  PAD +PLACE   PAD COUNT ;

\ test if we need to append the drive
: ?+PATH   ( addr$ len -- addr$ len )
    2DUP [CHAR] . SCAN NIP   \ scan string for '.'
    0= IF  +PATH  THEN  ;    \ if no '.' add the path 

 

 

  • Like 1
Link to comment
Share on other sites

9 hours ago, TheBF said:

I have decided that this code that I used for VI99 is so handy that I am adding it to the library disk. 

 

The users words are:

+PATH    takes a string and prepends the current disk device to the string. 

 ?+PATH  checks for a '.' in the string. If its not there it does the prepend.

 

This will require a bit of extra work to translate to other Forth systems.

C+!  SCAN   and getting a CRU address into R12 are the sticky bits from what I can see. 

 

  Reveal hidden contents
\ pluspath.fth   add path to a filename      Mar 4 2023 Brian Fox 

: +PLACE  ( addr n $ -- ) 2DUP 2>R  COUNT +  SWAP MOVE 2R> C+! ;

\ ========================
\ get current drive string
\ ========================
DECIMAL
24 USER 'R12

HEX
CODE 0SBO  ( -- ) 1D00 ,  NEXT, ENDCODE \ turn on card 
CODE 0SBZ  ( -- ) 1E00 ,  NEXT, ENDCODE \ turn off card 

: DISKCARD ( -- CRU) 83D0 @ ;    ( CRU address of the disk CARD )
: DEVLIST  ( -- $)  83D2 @ 4 + ; ( device strings in the card's ROM)

CREATE DSK$ 8 ALLOT  \ place for the device name in Forth 

: GETDEV  (  -- addr len) \ DSK$ will contain boot device 
  DISKCARD 'R12 !
  0SBO   DEVLIST COUNT DSK$ PLACE   0SBZ
  S" ." DSK$ +PLACE \ add the '.' char
  DSK$ COUNT 
;

\ ========================
\ append drive to filename 
\ ========================
: +PATH  ( filename$ len -- path$ len )
   GETDEV PAD PLACE  PAD +PLACE   PAD COUNT ;

\ test if we need to append the drive
: ?+PATH   ( addr$ len -- addr$ len )
    2DUP [CHAR] . SCAN NIP   \ scan string for '.'
    0= IF  +PATH  THEN  ;    \ if no '.' add the path 

 

 

 

I think we’ve had a semblance of this discussion before, but how persistent are the values at >83D0 and >83D2? Do they not change when the next file is accessed? Do we know they are only used for searching cards and device names?

 

...lee

  • Like 1
Link to comment
Share on other sites

9 minutes ago, Lee Stewart said:

 

I think we’ve had a semblance of this discussion before, but how persistent are the values at >83D0 and >83D2? Do they not change when the next file is accessed? Do we know they are only used for searching cards and device names?

 

...lee

Ya I just cleaned this up a bit.

From my working with VI99 the values seem to reflect that last disk accessed.

But I keep a copy in DSK$ so if it's needed it's there without calling GETDEV.

 

 

Link to comment
Share on other sites

Minor update to the manual.

 

Updated a demo program on page 169 to work with the new compiler. (Removed the word PATTERN: which has been deprecated)

Camel99 now uses the word MOVE  to replace CMOVE and CMOVE> so that is updated. 

 

CAMEL99-ITC/Camel99 for TI-BASIC Programmers Rev 2.3.pdf at master · bfox9900/CAMEL99-ITC · GitHub

  • Like 3
Link to comment
Share on other sites

15 minutes ago, Retrospect said:

that's the key thing.

Yes PAUSE is actually a call to the mulit-tasker's "scheduler". It switches to the next task in the list.

And the delay word MS  has PAUSE built in so that while a task is waiting it just throws control to the next task.

It's elegantly simple. 

  • Like 2
Link to comment
Share on other sites

Just now, TheBF said:

Yes PAUSE is actually a call to the mulit-tasker's "scheduler". It switches to the next task in the list.

And the delay word MS  has PAUSE built in so that while a task is waiting it just throws control to the next task.

It's elegantly simple. 

I'm going to need all of this , I think, for my " Schooner " demo / game.  I aren't even sure what it's going to be yet because I'm still not confident enough to say " it's going to be a game" :)

  • Like 2
Link to comment
Share on other sites

I tried to use the MOTION library file last week to try and keep up with @Retrospect and found that it was less than perfect.

DSK1.MOTION lets you control the sprites only with your own code. No interrupts. It creates motion vector table in RAM.

These vectors are set with the MOTION command and are added to individual Sprites or all at once under programmer control.

 

I try my best to make these interfaces correctly but in this case I reversed the x and y coordinates.

I went  back and double checked the AUTOMOTION version of MOTION course the same mistake was there.

Since I don't use these things very much it's bound to happen.

 

Needless to say I got tons of complaints from the global users, so I fixed them up. 🤣

 

Here is a zip file of the Github Repository for DSK1. with the fixes for anyone who wants a refresh. 

 

As a reminder if you want the source code in PC text file format they are here along with other things that caught my fancy over the years. 

 

CAMEL99-ITC/LIB.ITC at master · bfox9900/CAMEL99-ITC (github.com)

 

DSK1.ITC.zip

  • Like 2
  • Thanks 1
Link to comment
Share on other sites

On 3/12/2023 at 10:08 PM, Retrospect said:

It switches to the next task in the list.

So , like this ...

: A do something .. PAUSE ;

: B do something else ... PAUSE ;

: C do another thing ...  PAUSE ;

And if it gets to the end of the list of tasks, it goes back to the top?

  • Like 1
Link to comment
Share on other sites

9 minutes ago, Retrospect said:

So , like this ...

: A do something .. PAUSE ;

: B do something else ... PAUSE ;

: C do another thing ...  PAUSE ;

And if it gets to the end of the list of tasks, it goes back to the top?

That's exactly how you use it yes.

 

Getting it setup can be the tricky bit. 

 

Look at DSK3.1TASK  

And look at DSK3.10TASKS

 

 

  • Like 3
Link to comment
Share on other sites

I messed up.

I thought I would be clever and reduced the size of thE motion table in the manual MOTION file. 

I forgot that the reason I used an integer for each motion direction is because it is faster to add negative or positive values using +.

I could make signed character addition but that seems silly. (until I need 64 extra bytes) 

 

So humbly here is the "next" new  DSK1.MOTION  with the problem fixed. 

Please put the MOTION file in your DSK1.  folder

MOTION.FTH is a PC text file format and goes in LIB.ITC if you have downloaded that from the GITHUB repository.

 

Humble apology for my carelessness.

Edit: And... I put the wrong binary in the zip file.

 

See next post.

 

 

  • Like 3
Link to comment
Share on other sites

So when I really started using the manual motion file for a demo for Retrospect I found another error. 

 

The MOTION word was changed to have the fix for automotion that makes sprites move down one line as they travel left. (I think that's it) 

Anyway it turns out I didn't need that correction with the manual system and it only showed up under special circumstances.

You know the drill. 

 

So throw those old files away and use these. 

 

Damn good thing I don't work for Spacex. :( 

MOTION MOTION.FTH

  • Like 2
Link to comment
Share on other sites

Now that someone else is trying to use Camel99 Forth I am trying to make it work better. 

One the really different things about Forth coming from BASIC is the use of "data". 

The efficient way to change character patterns in Forth or Assembler is to define them in a block of RAM and then blast that block into VDP ram with VMBW or VWRITE as I call it, when you need them.

In BASIC you have CALL CHAR.  I believe G.E.M.  has CHAR2 which if much faster. 

 

Last year or so I added CALLCHAR ( addr len char -- )  to bridge a gap from BASIC to Forth.

It works ok but it not fast because it is parsing the string a char at a time, converting each digit to a hex number and compiling it into then VDP pattern table. 

 

A while back I also made HEX#, which is similar, but it takes the string 4 chars at a time, converts them to an integer and compiles that integer into RAM.

Much more efficient with the caveat that you must have a least 4 characters in your string. 

 

What I want is the speed of HEX#, in CALLCHAR but one compiles into CPU RAM and the other compiles into VDP RAM. 

 

So as Neil Baud once said maybe I can "divide and concur"  :)

 

I factored out the conversion code from HEX#,  and made it a function that takes an execution token. A so called higher-order-function (HOF) 

The word INTEGERS can actually do anything you want with each integer it creates from the input stream, but I didn't want to go whole-hog on this HOF concept. 

\ converts a string into integers and does XT with the integer 
: INTEGERS ( addr len XT -- ) 
        >R  
        BEGIN DUP
        WHILE            \ while len<>0
           OVER 4 NUMBER? ?ERR  R@ EXECUTE  
           4 /STRING     \ cut 4 digits off left side of string
        REPEAT           \ keep going until string is exhausted
        2DROP
        R> DROP 
;

 

Then use INTEGERS to make the other two words by passing the correct operator in each word to compile the number to the proper memory. 

: HEX#, ( addr len  --)
        BASE @ >R        \ save radix
        HEX              \ converting string to hex numbers
        ['] , INTEGERS 
        R> BASE !        \ restore radix
;

 

: CALLCHAR ( addr len char --) \ can handle long strings. DV80 files limit size 
        BASE @  VP @ 2>R  \ save BASE and VDP pointer 
        ]PDT VP !         \ set vdp mem pointer to character location
        HEX             
        ['] V, INTEGERS 
        2R> VP ! BASE !   \ restore the variables
;

 

Seems to work.

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

I think I have a simpler syntax for dealing with data blocks of character patterns than all that stuff in the previous post. 

I never like the complexity of CALLCHAR but it serves the purpose of letting BASIC programmers try Forth with something more familar.

But the BASIC programmer never understands how patterns work inside the TI-99, requiring data to be written into VDP RAM.

And the speed to update patterns is dreadful with CALLCHAR because it is interpreting text numbers. 
 

So here my objectives were:

  1. Use as little code as possible for the language extensions to save space for programs 
  2. Data will be defined at compile time like variable and constant (Keeps it simple by not needing STATE dependent words)
  3. Make "syntax" that a beginner can understand or at least remember how to use

This got me to four definitions which are small in themselves. (and 2CONSTANT is useful elsewhere) 

: {   HERE ;      \ remember dictionary location (starts a data block )
: }   ( addr1 -- addr1 size) HERE OVER -  ;  \ calc. bytes between { and }
: 2CONSTANT  CREATE  ,  ,  DOES> 2@ ;        \ a way to record two numbers (addr len)

\ Write data block to pattern descriptor table ( ]PDT is defined in DSK1.GRAFIX) 
: PDT-WRITE  ( data size 1stchar)  ]PDT  SWAP VWRITE ; 

 

Defining data blocks and usage looks like this. (using some shapes from @Retrospect )

HEX 
{ 0018 , 1818 , 3C7E , 7E42 ,  
  427E , 7E3C , 1818 , 1800 , 
  0007 , 0E7E , 7E0E , 0700 , 
  00E0 , 707E , 7E70 , E000 , 
} 2CONSTANT SCHOONERS          \ SCHOONERS returns the address and size 

{ 
  0000 , 3C3C , 3C3C , 0000 , 
} 2CONSTANT AMISSLE 

{ FCFC , C0C0 , C0C0 , FCFC , 
  0C0C , 0C0C , 0C0C , FCFC , 
  FCFC , C0C0 , C0C0 , C0C0 , 
  C0C0 , C0C0 , C0C0 , FCFC ,
  CCCC , CCCC , CCCC , FCFC , 
  CCCC , CCCC , CCCC , CCCC ,
  FCFC , CCCC , CCCC , CCCC , 
  CCCC , CCCC , CCCC , FCFC ,
  CCCC , CCEC , FCFC , DCCC ,
  FCFC , C0C0 , C0C0 , F0F0 ,
  F8FC , CCCC , CCCC , FCF8 ,
  F0F8 , DCCC , CCCC , CCCC ,
 } 2CONSTANT TITLING 

{ 80C0 , E0F0 , F8FC , FEFF ,
  C0F0 , FCFF , FFFF , FFFF ,
  0000 , 0000 , C0F0 , FCFF ,
  FFFF , FFFF , FFFF , FFFF ,
  0000 , 0000 , 030F , 3FFF ,
  030F , 3FFF , FFFF , FFFF ,
  0103 , 070F , 1F3F , 7FFF ,
} 2CONSTANT BORDERS    


\ 
\ DEFINE-SHAPES now blasts the data blocks into the pattern descriptor table. 
\
DECIMAL
: DEFINE-SHAPES ( -- ) 
    SCHOONERS   96 PDT-WRITE  
    AMISSLE    100 PDT-WRITE 
    TITLING    112 PDT-WRITE 
    BORDERS    128 PDT-WRITE 
;

 

 

  • Like 3
Link to comment
Share on other sites

Very nice!

 

Using DATA[ and ]DATA (as in fbForth) would be even faster, but you would need to define them:

 

Spoiler
\ fbForth 2.x port of Brian Fox's Camel99 Forth PDT updates...
HEX 
\ Access VDP table PDT like an array.
\ Usage:  9 ]PDT returns VDP addr of ASCII 9 character in PDT
 : ]PDT   ( char# -- 'pdt[n] )  
   3 SLA       \ multiply by 8
   PDT + ;     \ 8 byte fields in Pattern Descriptor Table

\ Write data block to Pattern Descriptor Table
: PDT-WRITE  ( data size 1stchar)  
   ]PDT SWAP         \ S:data 1stchar*8+PDT size
   VMBW  ;           \ write to correct spot in PDT

\ Returns the address and byte size of array SCHOONERS
: SCHOONERS    ( -- addr bytelen )  
   DATA[ 0018 1818 3C7E 7E42  
         427E 7E3C 1818 1800 
         0007 0E7E 7E0E 0700 
         00E0 707E 7E70 E000
   ]DATA
   1 SLA  ;    \ convert cell count to byte count

\ Returns the address and byte size of array AMISSLE
: AMISSLE   ( -- addr bytelen )
   DATA[
      0000 3C3C 3C3C 0000 
   ]DATA
   1 SLA  ;    \ convert cell count to byte count

\ Returns the address and byte size of array TITLING
: TITLING   ( -- addr bytelen )
   DATA[
      FCFC C0C0 C0C0 FCFC 
      0C0C 0C0C 0C0C FCFC 
      FCFC C0C0 C0C0 C0C0 
      C0C0 C0C0 C0C0 FCFC
      CCCC CCCC CCCC FCFC 
      CCCC CCCC CCCC CCCC
      FCFC CCCC CCCC CCCC 
      CCCC CCCC CCCC FCFC
      CCCC CCEC FCFC DCCC
      FCFC C0C0 C0C0 F0F0
      F8FC CCCC CCCC FCF8
      F0F8 DCCC CCCC CCCC
   ]DATA
   1 SLA  ;    \ convert cell count to byte count

\ Returns the address and byte size of array BORDERS
: BORDERS   ( -- addr bytelen )
   DATA[
      80C0 E0F0 F8FC FEFF
      C0F0 FCFF FFFF FFFF
      0000 0000 C0F0 FCFF
      FFFF FFFF FFFF FFFF
      0000 0000 030F 3FFF
      030F 3FFF FFFF FFFF
      0103 070F 1F3F 7FFF
   ]DATA
   1 SLA  ;    \ convert cell count to byte count

\ 
\ DEFINE-SHAPES now blasts the data blocks into the pattern descriptor table. 
\
DECIMAL
: DEFINE-SHAPES ( -- ) 
    SCHOONERS   96 PDT-WRITE  
    AMISSLE    100 PDT-WRITE 
    TITLING    112 PDT-WRITE 
    BORDERS    128 PDT-WRITE 
;

 

 

...lee

  • Like 1
Link to comment
Share on other sites

17 minutes ago, TheBF said:

Interesting. 

How are they faster?

Or do you mean I would not need to develop anything? :)

 

 

They are faster because DATA[ presumes its input is a number—unlike INTERPRET , which looks through the dictionary for a word before  deciding to try converting it to a number. I wrote it to allow comments ( both ( and \ ) or the LOAD continuation word --> (to allow multi-block arrays). Here is the code from fbForth 2.x:

 

Spoiler
*     _  __           __             ___                    
*    / |/ /_ ____ _  / /  ___ ____  / _ | ___________ ___ __
*   /    / // /  ' \/ _ \/ -_) __/ / __ |/ __/ __/ _ `/ // /
*  /_/|_/\_,_/_/_/_/_.__/\__/_/   /_/ |_/_/ /_/  \_,_/\_, / 
*                                                    /___/  
*                   _      __            __  
*                  | | /| / /__  _______/ /__
*                  | |/ |/ / _ \/ __/ _  (_-<
*                  |__/|__/\___/_/  \_,_/___/
*
;[*** DATA[] ***     ( -- addr #cells )
*  Runtime routine compiled by DATA[ to push addr and #cells of number array.

*        DATA FNTE_N
* DTOC_N .name_field 6, 'DATA[] '
* 
DATAOC DATA $+2
       MOV  *IP+,R1        get #cells in r1
       DECT SP             make space on the stack
       MOV  IP,*SP         push the address of the data
       DECT SP             make space on the stack
       MOV  R1,*SP         move #cells to stack
       SLA  R1,1           convert to bytes
       A    R1,IP          adjust Forth PC to jump over the data
       B    *NEXT

* : DATA[] ( -- addr #cells )
*    R 2+  R @ DUP 2 *  2+ R> + >R  ;
;]*
;[*** DATA[ ***      ( -- addr #cells )  ( IS: n1 ... nn)  [ IMMEDIATE word ]
*                 Compiling:  Also, compiles CFA of DATA[] and place-holder
*                             cell for cell count of data following.
*
*        DATA DTOC_N
* DATO_N .name_field_immediate 5, 'DATA['
* 
DATOPN DATA $+2
       BL   @BLF2A
       DATA _DATOP->6000+BANK2

*++ _DATOP code currently in fbForth204_ScreenFont.a99

* ( The following version of DATA[ allows comments and --> between DATA[ and ]DATA )
* 0 VARIABLE IN_TMP
* ( [NUMBER] expects packed string of number to convert at HERE)
* : [NUMBER]   ( cnt -- cnt+1 )
*    HERE NUMBER   ( convert to a double [32-bit] number)
*    DROP          ( make it a single [16-bit] number)
*    ,             ( compile number into dictionary)
*    1+            ( increment counter)
* ;
*
*
* : DATA[   ( -- addr count )   ( IS: n1 ... nn)
*    STATE @ IF
*       COMPILE DATA[]   ( compile CFA of DATA[] in new word definition)
*       0 ,              ( reserve space for count and zero it)
*    THEN
*    HERE                ( start address of list)
*    0                   ( start counter)
*    BEGIN               
*       IN @ IN_TMP !    ( get IN before reading next word)
*       BL WORD          ( get next token to HERE)
*       HERE 1+ C@       ( get first character)
*       CASE     ( check first character)
*          93 ( ']') OF IN_TMP @ IN !   ( restore IN to INTERPRET last word)
*             1          ( last time through loop [flag for UNTIL] )
*          ENDOF
*          40 ( left paren) OF HERE C@ 1 =   ( comment)
*             IF 
*                [COMPILE] ( 
*                0          ( once more through loop [flag for UNTIL] )
*             ELSE 
*                1 0 ?ERROR 
*             THEN
*          ENDOF
*          92 ( '\') OF HERE C@ 1 =   ( line comment)
*             IF 
*                [COMPILE] \ 
*                0          ( once more through loop [flag for UNTIL] )
*             ELSE 
*                1 0 ?ERROR 
*             THEN
*          ENDOF
*          45 ( '-') OF HERE 3 + C@ 62 ( '>') =  ( '-->')
*             IF    ( load next block)
*                [COMPILE] --> 
*             ELSE     ( convert and compile negative number)
*                [NUMBER]    ( convert and compile number at HERE; inc count)
*             THEN 
*             0           ( once more through loop [flag for UNTIL] )
*          ENDOF
*           0 OF CR QUERY 0 ENDOF  ( if terminating null, get next line)
*          ELSEOF [NUMBER]       ( convert and compile number at HERE; inc count)
*          0              ( once more through loop [flag for UNTIL] )
*          ENDOF
*       ENDCASE
*    UNTIL                ( get next number in input stream)
*    ;   IMMEDIATE
;]*
;[*** ]DATA ***   Executing: ( --- )                [ IMMEDIATE word ]
*                 Compiling: ( addr #cells --- )  <--stores #cells between CFA
*                                                    of DATA[] and first number
*                                                    of array.
* 
*        DATA DATO_N
* DATC_N .name_field_immediate 5, ']DATA'
* 
DATCLS DATA DOCOL
       DATA STATE,AT,ZBRAN,DATCLX-$
       DATA SWAP,TWOM,STORE
DATCLX DATA SEMIS
*
* : ]DATA   Executing: ( --- )            
*           Compiling: ( addr #cells --- )
*    STATE @              ( compiling?)
*    IF                   ( yes)
*       SWAP 2- !         ( store count in location before addr)
*    THEN
*    ;   IMMEDIATE 
;]*

 

 

and the code referenced by the above code:

 

Spoiler
;[*** DATA[ ***      ( -- addr count )   ( Input Stream: n1 ... nn)  [ IMMEDIATE word ]
*  FREEPD+8  = temp storage for IN (slots above FREEPD+8 used by QUERY/EXPECT/WORD)
*  FREEPD+10 = space delimiter (>0020) storage
*
*        DATA <previous word>_N
* DATO_N .name_field_immediate 5, 'DATA['
* 
* DATOPN DATA $+2
*        BL   @BLF2A
*        DATA _DATOP->6000+BANK2

* Insure HERE is on an even boundary.
*
_DATOP MOV  @$DP(U),R1        load R1 with HERE
       INC  R1                add 1
       ANDI R1,>FFFE          insure R1 is even
       MOV  R1,@$DP(U)        update adjusted HERE
*
* Compiling?
*
       MOV  @$STATE(U),R0     are we compiling?
       JEQ  DATAO1            nope
       LI   R0,DATAOC         yup...load R0 with CFA of DATA[]
       MOV  R0,*R1+           copy CFA of DATA[] to HERE, advancing HERE copy
       INCT R1                increment HERE copy again by one cell for count
       MOV  R1,@$DP(U)        update HERE
*
* Continue...
*
DATAO1 DECT SP                reserve stack space
       MOV  R1,*SP            push current value of HERE to stack
       DECT SP                reserve stack space for data counter
       CLR  *SP               start data counter
DATOLP LI   R1,>0020          load space as delimiter for WORD
       MOV  @$IN(U),@FREEPD+8  save IN
       BL   @__WORD           get next token to HERE
       MOV  @$DP(U),R2        get HERE
       MOV  *R2,R3            get length byte and first character at HERE
       CI   R3,>055D          ]DATA ?
       JNE  DATAO2            no--next test
       MOV  @FREEPD+8,@$IN(U)  yes--restore IN
       JMP  DTOXIT            we're outta here!
DATAO2 CI   R3,>0128          1 char = '(' ?
       JNE  DATAO3            no--next test
       BL   @BLA2F            branch to Forth's (
       DATA PAREN             
       JMP  DATOLP            get another token
DATAO3 CI   R3,>015C          1 char = '\' ?
       JNE  DATAO4            no--next test
       BL   @BLA2F            branch to Forth's \
       DATA PAREN             
       JMP  DATOLP            get another token
DATAO4 CI   R3,>032D          3 chars starting with '-' ?
       JNE  DATAO5            no--next test
       INCT R2                point to next 2 chars
       MOV  *R2,R3            get next 2 chars
       CI   R3,>2D3E          '->' ?
       JNE  DATAO6            try number conversion
       BL   @BLA2F            branch to Forth's -->
       DATA ARROW
       JMP  DATOLP            get another token
DATAO5 CI   R3,>0100          terminating null?
       JNE  DATAO6            no--try number conversion
       MOV  @$BLK(U),R3       yes--terminal input?
       JNE  DTOERR            no--ERROR
*
* Query another line from terminal
*
       LI   R2,13             load CR
       BL   @XPCTEM           EMIT CR
       LI   R2,10             load LF
       BL   @XPCTEM           EMIT LF
       MOV  @$TIB(U),R5       TIB address to R5 for EXPECT
       LI   R0,80             max line size...
       MOV  R0,@FREEPD        ...to loop limit for EXPECT
       BL   @__XPCT           call EXPECT in this bank
       CLR  @$IN(U)           zero TIB cursor
       JMP  DATOLP            get another token
*
* Try number conversion
*
DATAO6 DECT SP                reserve stack space
       MOV  @$DP(U),*SP       push HERE to stack
       BL   @BLA2F            call Forth's NUMBER
       DATA NUMBER
       INCT SP                force number on stack to 16 bits
       MOV  @$DP(U),R1        HERE to R1
       MOV  *SP+,*R1+         pop number to HERE, incrementing HERE
       MOV  R1,@$DP(U)        update HERE
       INC  *SP               increment counter on stack
       JMP  DATOLP            get another token

DTOXIT B    @RTNEXT           back to bank 0 and the inner interpreter

DTOERR DECT SP                reserve stack space
       CLR  *SP               message #0 to stack
       BL   @BLA2F            branch to Forth's ERROR..
       DATA ERROR             ...we won't be back
;]*

 

 

...lee

  • Like 1
Link to comment
Share on other sites

Ah of course. 

I don't think I have the luxury of that much code space for something that comma handles albeit slower.

 

I can do something similar.

I created a comma delimited data word so that could be modified to be space delimited.

So with the {  DATA } words I think I can get that benefit with less code. 

I don't feel the need to be able to compile data in a colon definition.

 

I will give it a try. 

 

 

Edited by TheBF
typo
  • Like 2
Link to comment
Share on other sites

ok. Perhaps this is a bit less sexy than DATA[  ]DATA. :) 

 

With the 5 definitions this adds 130 bytes to the system and the "syntax" is not too distasteful. 

 

If I could figure out how to write the word REFILL I might be able to make DATA[  ]DATA in less code maybe. 

 

: PARSE-NAME   BL PARSE-WORD ; 

 

\ Similar to DATA[  ]DATA for Camel99 Forth 
INCLUDE DSK1.TOOLS 
INCLUDE DSK1.GRAFIX

HERE 
: {   HERE ;     
: }   ( addr1 -- addr1 size) HERE OVER -  ; 
: 2CONSTANT  CREATE  ,  ,  DOES> 2@ ; 
: PDT-WRITE  ( data size 1stchar)  ]PDT  SWAP VWRITE ; 

: DATA ( -- )
    BEGIN
      PARSE-NAME 
    DUP WHILE
      NUMBER? ABORT" DATA error" 
      ,
    REPEAT
    2DROP ;

HERE SWAP - DECIMAL . .( bytes)

HEX 
{ 
  DATA 0018 1818 3C7E 7E42   
  DATA 427E 7E3C 1818 1800  
  DATA 0007 0E7E 7E0E 0700  
  DATA 00E0 707E 7E70 E000  
} 2CONSTANT SCHOONERS

 

  • Like 1
Link to comment
Share on other sites

It turns out if you read the specifications (duh!)  REFILL in the simplest form is like QUERY in earlier Forth standards but it leaves a flag on the stack. 

( It gets more complicated if you are taking input from files and blocks as well) 

REFILL - CORE EXT (forth-standard.org)

REFILL CORE EXT

( -- flag )

Attempt to fill the input buffer from the input source, returning a true flag if successful.

When the input source is the user input device, attempt to receive input into the terminal input buffer. If successful, make the result the input buffer, set >IN to zero, and return true. Receipt of a line containing no characters is considered successful. If there is no input available from the current input source, return false.

 

So this seems to work. 

: REFILL  ( -- ? )
    TIB DUP 80 ACCEPT  
    DUP IF >IN OFF 
           'SOURCE 2!  
            TRUE  
            EXIT 

    THEN NIP
;

 

So with that I can make DATA take multiple lines like this: 

: DATA ( -- )
  BEGIN 
    BEGIN
      PARSE-NAME 
    DUP WHILE
      NUMBER? ABORT" DATA error" 
      ,
    REPEAT
    2DROP
    REFILL 
  0= UNTIL 
;

 

And with this DATA word we can do this. Because DATA is only interpreting numbers it only stops when there is a blank line.

HEX
{ DATA 
  0018 1818 3C7E 7E42   
  427E 7E3C 1818 1800  
  0007 0E7E 7E0E 0700  
  00E0 707E 7E70 E000  
  
} 2CONSTANT SCHOONERS 

Which is getting closer. 

 

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   1 member

×
×
  • Create New...