Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF

Recommended Posts

When you learn about other architectures, and what a context switch really means, you gotta love BLWP.

 

It's a nice instruction for sure, but there are other ways to skin the cat too.

 

The classic Forth virtual machine uses only three registers to record context.

  1. Data stack pointer
  2. Return stack pointer
  3. Instruction Pointer

So that is the same number of registers you need to save the context of the 9900.

 

Here is a context switcher for the same Forth system but without resorting to using RTWP.

\ Conventional Forth context switcher
CODE: PAUSE  ( -- )           
         SP RPUSH,           \ 28
         IP RPUSH,           \ 28
         RP  4 (UP) MOV,     \ 22 save my return stack pointer in RSAVE user-var
         BEGIN,
            2 (UP) UP MOV,   \ 22 load the next task's UP into CPU UP  (context switch)
            *UP R0 MOV,      \ 18 test the tflag for zero
         NE UNTIL,           \ 10 loop until it's not zero
         4 (UP) RP MOV,      \ 22 restore local Return stack pointer so I can retrieve IP and SP
         IP RPOP,            \ 22 load this task's IP
         SP RPOP,            \ 22  load this task's SP
         NEXT,               \ = 194 * .333 = 64.6uS context switch
         END-CODE

Just counting cycles it is just over 3 times slower, but to be fair it's all software, the RPUSH macros are 2 instructions and the RPOP macro is a Register indirect,auto-inc instruction.

If the 9900 had hardware support for stacks it would be much faster.

 

This two stack architecture has also been cast in silicon and FPGAs and it goes pretty fast!

 

I actually envision a machine with both features: two hardware driven stacks and a WP register that can point to fast RAM.

I need to get up to speed on FPGAs... :(

Link to comment
Share on other sites

Integrating BLWP into Forth

 

Can we make BLWP sub-routines that create their own vectors and call themselves? :grin:

 

Previously I experimented with using BLWP in the Forth environment here:

http://atariage.com/forums/topic/273872-camel99-forth-information-goes-here/?p=4087033

 

I took up my own idea, in that thread, of perhaps using BLWP with a byte queue structure so that the input/output pointers would be managed in registers rather than memory addresses. (ie: Forth variables)

This worked ok but doing it seemed to create a lot of noise code which looked complicated to me.

 

Just like in Assembler, to make a BLWP callable sub-routine we must:

  1. Define the workspace memory
  2. Define the code that will run
  3. Create the vector in memory with the workspace address and the code address

Now Forth is a programmable Compiler. I felt there must be a way to "automate" that noise code away by extending the compiler to do the grunt work.

 

I envisioned being able to do this:

MYWKSP SUB: MYSUB1 
        <INSTRUCTION>
        <INSTRUCTION>
        <INSTRUCTION>
         ETC...

        RTWP,
      ENDSUB

The workspace is passed to the sub-routine as a parameter. Then SUB: creates a new word in Forth at compile time. (when the program is loading)

 

We follow that new word with assembly language and end with RTWP.

ENDSUB is just a housekeeping routine that checks if we left any garbage on the forth stack with our assembly language and halts if we did.

We gave it a nice name so that the code looks better. This is common in Forth where you are making a language as you write the program.

 

This is pretty simple to do. In Forth it looks like this:

: SUB: ( wksp -- )
       CREATE                       \ make a new word in Dictionary
       !CSP                         \ record current stack position (for error checking)
       ( wksp) ,   HERE CELL+ ,     \ compile a 9900 vector into memory
 
: ENDSUB  ( -- ) ?CSP  ;  \ HALT if stack position has changed

Forth ASM coders HERE is the equivalent of $ in ALC. CELL+ adds 2 to a number. So HERE CELL+ is equivalent to $+2.

The comma compiles both numbers into Forth memory creating a BLWP vector.

HERE CELL+ as the 2nd address in the vector means the code must begin in the next memory location.

 

Once we have the SUB: directive defined, we can define a sub-routine and it makes it's own vector. Cool!

 

Since we added a BLWP command to CAMEL99 Forth, we would run it like this: MYSUB1 BLWP

 

But there's more!

 

This can be hard to grok but here goes...

 

Forth's compiler can also specify some extra code that will run when you invoke a word.

This is equivalent to creating an Object with only one method. This is Forth's super-power as a low level language.

 

What if we created the vector (which is data, ie an object)

And specified that the code that runs on that data (ie the method) is "BLWP"

 

Whoa!! That would mean that the vector would call itself! :-o

 

Forth can specify the "method" code to be in Forth or Assembly language. So for efficiency let's use Assembly language.

: SUB: ( wksp -- )
       CREATE                 \ make a new word in Dictionary
       !CSP                   \ record current stack position
      ( wksp) ,  HERE CELL+ , \ compile a vector (2 cells)

      ;CODE *W BLWP,          \ code that runs when word is invoked
               NEXT,          \ return to Forth
             ENDCODE

Explanation of the ";code" section

  • All words created with SUB: will run BLWP *W and return to Forth
  • Forth's "working register" is called W ( alias for R5)
  • When a Forth word is executed, R5 contains the address of the DATA which in this case is the address of the vector that SUB: created

 

So with this we can safely make Assembly language sub-routines that call themselves from Forth. I like this!

 

The spoiler has the code for testing this idea. I did not complete code to read the Queue yet but It's coming soon.

 

 

 

\ byte queue using BLWP to manage pointers

\ Concept here is to replace variables that manage circular pointers
\ with registers in a workspace. The requires less code because registers
\ do not need to loaded if the workspace is initialized first.
\ It also runs faster because the data is always in registers.

\ Interface to Forth is through R0 of the QREGS workspace.
\ The base address of QREGS workspace is used just like a forth variable
\ since it is just an address like a Forth variable.

\ Use C! to write a byte into QREGS(R0) puts the byte in the correct side of the register.
\ Use @ to fetch the value from QREGS(R0) to get the error flag.

INCLUDE DSK1.TOOLS.F
INCLUDE DSK1.ASM9900.F

\ DATA =======================
HEX
100        CONSTANT QSIZE  \  size be must power of 2
QSIZE 1-   CONSTANT QMASK  \ used for wrap pointer wrap around

\ data is allocated in Lo memory with MALLOC
QSIZE MALLOC CONSTANT Q      \ points to Q's data
20    MALLOC CONSTANT QREGS  \ points to a workspace for Q operations

\ ============================
\ Compiler Directive to create a BLWP subroutine ...
\ ... THAT CALLS ITSELF!
: SUB: ( wksp -- )
\ At COMPILE TIME:
\     - Create a label in the dictionary
\     - compile a BLWP vector ( 2 addresses)
\     - pull the workspace from Forth stack and compile it
\     - The code starts at next cell after current address
\     - Compute that address and compile into the vector

       CREATE       \ make a new word in Dictionary
             !CSP   \ record current stack position

\              compile wksp    compile code address
\              ------------    --------------------
                 ( wksp) ,      HERE CELL+ ,

\ At RUNTIME: ( when Forth executes the "word" we create)
\     - Forth's "working register is called W  ( R5)
\     - When a Forth word is executed, R5 contains the address
\       of the "body" of the word
\     - all words created with SUB: run BLWP *W

      ;CODE *W BLWP,        \ code that runs when word is invoked
               NEXT,        \ return to Forth
             ENDCODE

: ENDSUB  ( -- ) ?CSP  ;  \ check stack positio for junk left on it.

QREGS SUB: INIT-QREGS        \ code that initializes wksp
      \ R0 is character input buffer
        R1 CLR,       \ flag for no error
        R2 SETO,      \ flag for error
        R8 Q LI,      \ R8 holds the Q data buffer address
    	R9   CLR,     \ R9 is the input pointer
    	R10  CLR,     \ R10 is the output pointer
    	RTWP,
      ENDSUB


\ Forth word to erase Q data and QREGS and call INIT-REGS
: INIT-Q
        QREGS 20 0 FILL
        Q QSIZE  0 FILL
        INIT-QREGS ;

\ =====================================
\ code to enqueue a byte in 'Q'

QREGS SUB: ENQ ( c -- ? )
        R9 INC,            \ inc input pointer
        R9 QMASK ANDI,     \ binary wrap around
        R9 R10 CMP,        \ did we hit the deQ pointer?
        NE IF,
             R0 Q R9 () MOVB, \ move char in R0 to Q(R9)
             R0 CLR,        \ reset R0, it's the return value
        ELSE,
             R0 SETO,       \ return true as error flag
        ENDIF,
        RTWP,
      ENDSUB

\  Forth word to call the code.
: ENQ   ( c -- )
         QREGS C!        \ put c in R0 of QREGS workspace
         ENQ             \ call ENQ and return flag
;

: TEST  ( -- )  \ fill the Q with ascii chars
        INIT-Q
        BEGIN
          [CHAR] ~ [CHAR] !  \ for all ASCII chars
          DO
            I ENQ 
            QREGS @ ABORT" Q over-run"
          LOOP
          ?BREAK
        AGAIN ;

 

 

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

Further development on using BLWP.

 

I believe it is more correct to refer to these routines called by BLWP as SUB-PROGRAMS. So I have changed the names to PROG: ;PROG.

 

The interesting challenge is exchanging data from the Forth stack to the sub-program's workspace. There are many ways to do it by I chose to use the [TOS] macro to reference R4 in Forth's workspace.

The other obvious way is to simply put the data directly in the SUB-PROGRAM'S workspace. They are just like a Forth variable after all.

 

I am still not convinced that BLWP is the absolute fastest way to do this from inside Forth, but with the PROG: directive it is very convenient to create the structure needed to do use it. And registers make nicer code.

 

The spoiler has a re-worked version of the previous code with a Hi-level API for the Forth programmer to read,write and query the Queue and a test program that exercises the code.

 

*EDIT* Code cleanup, comment improvements

 

 

INCLUDE DSK1.TOOLS.F
INCLUDE DSK1.ASM9900.F

\ DATA =======================
HEX
100        CONSTANT QSIZE  \  size be must power of 2
QSIZE 1-   CONSTANT QMASK  \ used for wrap pointer wrap around

\ data is allocated in Lo memory with MALLOC
QSIZE MALLOC CONSTANT Q      \ points to Q's data
20    MALLOC CONSTANT QREGS  \ points to a workspace for Q operations

\ ============================
\ Compiler Directive to create a BLWP sub-program
\ ... THAT CALLS ITSELF!
: PROG: ( wksp -- )
       CREATE
         ( wksp) ,  HERE CELL+ ,
         !CSP
      ;CODE *W BLWP,
               NEXT,
            ENDCODE

: ;PROG  ( -- ) ?CSP  ;  \ check stack position for junk left on it

: [TOS]  8 R13 () ;      \ macro for Forth's TOS register

\ ============================
\ create sub-programs 
QREGS PROG: INIT-QREGS   \ code that initializes wksp
      \ R0 is character input buffer
        R8 Q LI,         \ R8 holds the Q data buffer address
    	R9   CLR,        \ R9 is the input pointer
    	R10  CLR,        \ R10 is the output pointer
    	RTWP,
      ;PROG

\ code to enqueue a byte in 'Q'
QREGS PROG: ENQ ( c -- ? ) \ put byte in Q, return error code
        R9 INC,            \ inc input pointer
        R9 QMASK ANDI,     \ binary wrap around
        R9 R10 CMP,        \ did we hit the out pointer?
        NE IF,
             [TOS] SWPB,         \ fix byte order 
             [TOS] Q R9 () MOVB, \ move char in TOS to Q(R9)
             [TOS] CLR,          \ reset TOS, it's the return value
        ELSE,
             [TOS] SETO,      \ return true as error flag
        ENDIF,
        RTWP,                 \ return to Forth
      ;PROG

\ DEQ requires we put a zero on the Forth stack.
\ This makes room on the Forth stack for the return data
QREGS PROG: DEQ ( 0 -- c) \ returned char can be any byte value. [0..255]
        R9 R10 CMP,
        NE IF,
             R10 INC,           \ bump out pointer
             R10 QMASK ANDI,    \ wrap pointer
             Q R10 () [TOS] MOVB,  \ take char from Q->Forth tos
             [TOS] SWPB,        \ fix the byte order
        ELSE,
             [TOS] SETO,        \ no data, return -1
        ENDIF,
        RTWP,
      ;PROG

\ qdata? requires we put a zero on the Forth stack.
\ This makes room on the Forth stack for the return flag
QREGS PROG: QSTAT ( 0 -- ?) \ true means data waiting
        R9 R10 CMP,
        NE IF,
             [TOS] SETO,
        ENDIF,
        RTWP,
      ;PROG

\ Hi-level Forth API to the sub-programs
: QDATA?  ( -- ?) 0 QSTAT ;
: QC!   ( c -- ) ENQ ABORT" Q full" ;
: QC@   ( -- c |-1) 0 DEQ DUP TRUE = ABORT" Q empty" ;

: Q$! ( addr len -- ) BOUNDS DO  I C@ QC! LOOP ;

: QEMIT  ( -- )
          BEGIN 
            QDATA?
          WHILE
            QC@ EMIT
          REPEAT ;
          
: INIT-Q
        QREGS 20 0 FILL
        Q QSIZE  0 FILL
        INIT-QREGS ;

: TEST  ( -- )
        INIT-Q
        PAGE ." Testing character Queue"
        BEGIN  
          CR
          CR ." Loading 5 strings into Q..."
          S" String #1. " Q$!
          S" String #2. " Q$!
          S" String #3. " Q$!
          S" String #4. " Q$!
          S" String #5. " Q$!
          CR
          CR ." Reading ALL strings..."
          CR QEMIT CR

          ?BREAK
        AGAIN ; 

 

 

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

Does this look like Forth?

 

CREATE FRUIT { " Apples" " Oranges" } ok

FRUIT {LEN} . 2 ok

 

CREATE NAMES { " Bob" "Carol" "Ted" "Alice" }

 

I revisited an old post on Rosetta Code and updated it. The problem task was to count the number of elements in an array that contain two strings.

 

One of the fun things about playing with Forth is inventing the way you want your program to look by making it yourself.

 

I saw how this was done in Factor and imitated it somewhat which makes very nice to use.

 

http://www.rosettacode.org/wiki/Array_length#Forth

 

 

I need to add more functions to this concept. The spoiler shows what I have so far.

 

 

 

\ string array meta language

: STRING,  ( caddr len -- ) \ Allocate space & compile string into memory
             HERE  OVER CHAR+  ALLOT  PLACE ;
 
: "     ( -- ) [CHAR] " PARSE  STRING, ; \ Parse input to " and compile to memory
 
\ Array delimiter words
: {  ALIGN 0 C, ;               \ Compile 0 byte start/end of array
: }  ALIGN 0 C,  ;
 
\ String array words
: {NEXT}    ( str -- next_str)       \ Iterate to next string
           COUNT + ;
 
: {NTH}    ( n array_addr -- str)   \ Returns address of the Nth item in the array
           SWAP 0 DO {NEXT} LOOP ;
 
: {LEN} ( array_addr -- )  \ count strings in the array
          0 >R                      \ Counter on Rstack
          {NEXT}
          BEGIN
             DUP C@                 \ Fetch length byte
          WHILE                     \ While true
             R> 1+ >R               \ Inc. counter
             {NEXT}
          REPEAT
          DROP
          R> ;      \ return counter to data stack 
          
: {.}   ( $ -- ) COUNT TYPE ;

: '"'    [CHAR] " EMIT ;   

: {""}  ( $ -- )  '"' SPACE {.} '"' SPACE ; 

: }PRINT ( n array -- ) SWAP {NTH} {.} ;

: {LIST} ( array_addr -- )  \ count strings in the array
          CR ." { "
          {NEXT}
          BEGIN
             DUP C@                 \ Fetch length byte
          WHILE                     \ While true
             DUP  {""} 
             {NEXT}
          REPEAT
          DROP  ." }"  ;  
          
          
          
CREATE OZ { " LIONS" 
            " and" 
            " TIGERS" 
            " and" 
            " BEARS" 
            " OH MY!" }

 

 

  • Like 2
Link to comment
Share on other sites

Adding CALLCHAR to Camel99 Forth

 

I had avoided making character patterns the way TI BASIC does it because I felt that converting the 16 digit text string to binary was needless when I could simple convert 4 separate integers.

 

When I took a run at making a word to do it, a long time ago, it always turned into something too complicated so I abandoned it.

I was playing with a little string tool called CHOP and I realized it could be part of the solution.

 

CHOP takes a string and cuts it at the place you specify returning the two pieces on the data stack. Because the remainder string is on top you can CHOP a string over and over.

 

So 1st I took the pattern string like: S" AAAABBBBCCCCDDDD" and did 4 CHOP 4 CHOP 4 CHOP which gives 4 strings on the data stack:

S" AAAABBBBCCCCDDDD" 4 CHOP 4 CHOP 4 CHOP 

TYPE DDDD  ( <-- TOP of stack)
TYPE CCCC
TYPE BBBB
TYPE AAAA

CHOP is very fast because it does not copy strings into memory. It starts with the address and length of the string and simply calculates a new address and new length for whatever you CHOP. This is 10X faster than copying sub-strings into memory. So with CHOP I could get 4 hex strings, convert them to integers and write them to VDP memory.

 

Then I realized that ANS Forth has a 32 bit string->integer convertor word! So this means I could cut the big string into just 2 parts and convert each part into 32 bit numbers which is 2X faster.

 

So this version of CALLCHAR is not too slow however it is still many times slower than using CHARDEF, which takes binary data in CPU ram and "blits" all 8 bytes into VDP RAM at once.

However if you are setting character patterns while your program is loading (at compile time) then it very convenient and does not affect runtime at all.

But if you do this:

 

: ASQUARE S" FFFFFFFFFFFFFFFF" 93 CALLCHAR ;

 

… and use ASQUARE repeatedly in your program know that it will be a little slow because the conversion is being done every time ASQUARE runs.

 

The current version is writing to VDP memory at runtime, but now that the conversion is pretty efficient, the next step would be to compile the binary data into CPU RAM and feed that to CHARDEF when needed.

Hmm... I think it's time to re-look at the word PATTERN:

 

FYI: This effort is all about trying to bridge the gap for the BASIC programmer looking to try Forth.

 

 

 

\ CALLCHAR  for CAMEL99 Forth    BJF  Aug 2018

\ Usage:
\  DECIMAL
\  S" FFFF0000FFFF0000" 92 CALLCHAR

 INCLUDE DSK1.TOOLS.F
 INCLUDE DSK1.GRAFIX.F

: CHOP   ( addr len n -- addr len addr len )
          >R                  \ Rpush n
          2DUP DROP R@        \ dup $, do left$
          2SWAP               \ put original $ on top
          R> /STRING ;        \ cut remainder string

: >UINT32 ( addr len -- d )   \ hex string->unsigned 32 bit integer
          BASE @ >R
          HEX
          0 0 2SWAP >NUMBER ABORT" bad int"
          DROP
          R> BASE ! ;

: CALLCHAR ( addr len char-- addr )
          ]PDT >R             \ rpush pat. desc. table address
          8 CHOP              \ chop string in half
          >UINT32 R@ 4 + V!   \ convert 8 digits and write to VDP
                  R@ 6 + V!

          >UINT32 R@     V!   \ convert 8 digits and write to VDP
                  R> 2+  V! ;

 

 

Edited by TheBF
Link to comment
Share on other sites

So armed with these 2 new words CHOP and >UINT32 I decided to do this the Forth way.

 

I extended the compiler and made a word that creates new words. This is very much like an object constructor to use modern lingo.

 

The new word creator is call SHAPE:

 

When you create a new Shape you give it a character pattern and SHAPE: remembers that pattern in its own little memory space.

SHAPE: also lets you name that pattern and records the new word name in the Forth Dictionary.

 

It looks like this:

S" FFFFFFFFFFFFFFFF" SHAPE: ASQUARE

OK. So that's pretty straightforward except that ASQUARE is not just a dumb little structure with some data in it. No! ASQUARE knows how to write it's pattern into the VDP RAM memory where the pattern descriptions are kept.

Yes! ASQUARE can do stuff.

 

In fact if you give ASQUARE an ascii number it knows how to find the VDP pattern location for that ASCII character AND it will write the pattern that you gave it earlier directly into the pattern table.

 

So you can say this:

CHAR A ASQUARE
CHAR Q ASQUARE
   150 ASQUARE
   158 ASQUARE

And all four characters will now look like square blocks.

 

Here is the code for SHAPE:


: CHOP   ( addr len n -- addr len addr' len' )
          >R                  \ Rpush n
          2DUP DROP R@        \ dup $, do left$  ** see footnote:
          2SWAP               \ put original $ on top
          R> /STRING ;        \ cut remainder string

: >UINT32 ( addr len -- d )   \ hex string->unsigned 32 bit integer
          BASE @ >R
          HEX
          0 0 2SWAP >NUMBER ABORT" bad int"
          DROP
          R> BASE ! ;


: SHAPE: ( addr len -- addr)  \ S" FFFFFFFFFFFFFFFF" SHAPE: ASQUARE
\ COMPILE TIME behavioue         
         CREATE               \ create a name in dictionary
         8 CHOP 2SWAP         \ chop the stack string into 2 strings
         >UINT32 , ,          \ convert & compile 1st 2 integers
         >UINT32 , ,          \ convert & compile 2nd 2 integers

\ RUNTIME behavior
         DOES> ( char DataAddr -- )   \ CHAR X ASQUARE changes X to a square
            SWAP ]PDT 8 VWRITE ;  \ compute PDT address of char
                                  \ write 8 bytes to VDP

** Doing a LEFT$ operation on a stack string is so easy it's hard to believe.

Given a stack string (address length) combination on the data stack, all you do is DROP length and put your new length in it's place.

So simple and very fast.

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

  • 2 weeks later...

Struggling with Eliza

 

Many many years ago I found a version of *Eliza the classic Lisp chatbot program, written in a dialect of BASIC. Naturally I spent a bunch of time converting it to TI-BASIC. Truth be told it was the funniest before I had it debugged because the responses were totally unpredictable.

 

One of the things that was difficult about doing Eliza in line-numbered BASIC was that making changes to the keywords and responses was very manual.

I always thought there had to be a way to make it easier in Forth but never got around to it.

It's a pretty big program coming in at 664 lines. I added some Forth words to create lists of strings and a few operations for those lists. This really helped to make editing simpler.

 

Example:

CREATE KEYWORDS   \ original Eliza keywords
    {
      " COMPUTER"          " NAME"          " SORRY"        " I REMEMBER"
      " DO YOU REMEMBER"   " I DREAMT"      " DREAM ABOUT"  " DREAM"
      " MY MOTHER"         " MY FATHER"     " I WANT"       " I AM GLAD"
      " I AM SAD"          " ARE LIKE"      " IS LIKE"      " ALIKE"
      " I WAS"             " WAS I"         " I AM"         " AM I"
      " AM"                " ARE YOU"       " YOU ARE"      " BECAUSE"
      " WERE YOU"          " I FEEL"        " I FELT"       " WHY DON'T YOU"
      " YES"               " NO"            " SOMEONE"      " EVERYONE"
      " ALWAYS"            " WHAT"          " PERHAPS"      " ARE"
      " BYE"               " CONSOLE"
     }

Here is the reply compiler. It takes the list and gives it a name in the Forth dictionary. It also creates 2 internal variables that record the length of the list (how many strings) and another that keeps track of which one you last printed, automatically incrementing that counter each time.

 

Here is a sample reply list:

'{ " What would it mean if you got~"
   " Why do you want~"
   " Suppose you soon got~"
   " What if you never got~"
 } REPLY: IWANT

I kind of like the final program :)

: ELIZA    ( -- )
        TEXT WHT/BLK
        COLLAPSE  ( reset string stack)
        S" Eliza" BIG.TYPE CR
        GREETING
        BEGIN
          LISTEN  ANALYZE  REPLY
        AGAIN ;

The spoiler has the program and there is video of a quick interaction on GitHub : https://github.com/bfox9900/CAMEL99-V2/blob/master/Video/ELIZA1.mp4

 

 

 

\ ELIZA in CAMEL99 Forth

\ This implementation uses the Forth dictionary as a big case statement
\ Eliza's KEYWORD phrases are converted to Forth words by removing the spaces
\ and punctuation.

\ Example:
\ "I CAN'T" becomes ICANT.  ICANT is a FORTH word so all we need is a word 
\ in the dictionary called ICANT to make something happen.

\ INCLUDE DSK1.TOOLS.F   \ for debugging

\ ======[ punctuation characters ]======
DECIMAL
CHAR ~ CONSTANT '~'   \ strings that end with '~' reflect the users input
CHAR , CONSTANT ','
CHAR . CONSTANT '.'

\ working memory for string processing
CREATE INPUT$  81 ALLOT  \ holds the "clean" reply from the patient

\ === string stack in HEAP ====
         VARIABLE SSP     \ the string stack pointer
     255 CONSTANT MXLEN   \ 255 bytes is longest string
MXLEN 1+ CONSTANT SSW     \ width of string stack items

SSW 10 * MALLOC CONSTANT $STAK  \ ten strings deep  (2.5 Kbytes!)

: NEW:     ( -- ) SSW SSP +! ;  \ bump string stack pointer by 256
: COLLAPSE ( -- ) SSP OFF  ;    \ reset string stack pointer to zero
: TOP$     ( -- $) SSP @ $STAK + ; \ string stack in dictionary

\ string stack helpers ====
: SPUSH    ( addr len -- top$ ) NEW: TOP$ DUP >R PLACE R> ;
: ?SSP     ( -- ) SSP @ 0= ABORT" Empty $ stack" ;
: DROP$    ( -- ) ?SSP MXLEN NEGATE SSP +! ;

: $=    ( $1 $2 -- ?) S= 0= ;

: POS$  ( $1 $2 -- n )  \ return "position" $1 in $2
           DUP -ROT DUP -ROT    ( -- $2 $2 $1 $2)
           COUNT BOUNDS
           DO
             I OVER COUNT $=
             IF
               NIP I SWAP
               LEAVE
             THEN
           LOOP
           DROP - ABS ;
           
\ special case that checks for trailing space after matched word
: MATCH$  ( $1 $2 -- n )  \ return "position" $1 in $2
           DUP -ROT DUP -ROT    ( -- $2 $2 $1 $2)
           COUNT BOUNDS
           DO
             I OVER COUNT        \ ( -- addr caddr len )
             DUP I + C@ BL = >R  \ check for space, rpush result
             $=  R> AND          \ if match AND a trailing space
             IF
                  NIP I SWAP
                  LEAVE
             THEN
           LOOP
           DROP - ABS ;
\
\ ---[ utility words ]---
\
: LEN      ( $ -- length)  C@ ;
: LASTCHAR ( $ -- c)  DUP LEN + C@ ;             \ get last char in a string
: BETWEEN  ( n min max -- ?)  1+ WITHIN ;        \ is n between or equal-to min/max
: FORALLCHARS ( $ -- end start) COUNT BOUNDS  ;  \ for DO LOOP on strings

: >=      ( n n -- ? ) 1- > ;
: <=      ( n n -- ? ) 1+ < ;
: $.      ( $ --) COUNT TYPE ;

\ text color definitions
HEX
: WHT/BLK ( -- ) F1 7 VWTR ;
DECIMAL

\ ---[ string support ]---
: MEMBER? ( addr len char -- ? )
          SCAN NIP ;        \  is char in stack string addr,len

: APPEND-CHAR ( char $ -- )
              DUP >R        \ copy string address
              COUNT DUP 1+  \ addr,len, len+1
              R> C!         \ store new length
              + C! ;        \ put char at end of string

\ --------[ STRIP$ ]--------
\ passed to STRIP$. 1st char is blank. Rest is punctutation
: "NOISE" ( -- addr len) S"  ,.?!'@#$[]%^&*()_+-{}:<>" ;

: STRIP$ ( $ addr len -- $)  \ Use: C" TEST 1 2 3" "BL" STRIP$
            ROT
            NEW: TOP$ OFF                \ set TOP$ to empty
            FORALLCHARS
            DO
               2DUP I C@ MEMBER? 0=
               IF   I C@ TOP$ APPEND-CHAR  \ build new string
               THEN
            LOOP
            2DROP
            TOP$  ;

\
\ ---[ case testers ]---
\
: LOWER?  ( char -- ?)  [CHAR] a [CHAR] z BETWEEN ;
: UPPER?  ( char -- ?)  [CHAR] A [CHAR] Z BETWEEN ;

\
\ ---[ Forth stack string words ]---
\
: -TRAILING  ( adr len -- adr len') \ remove trailing blanks (spaces)
             BEGIN  2DUP + 1- C@  BL =
             WHILE  1-
             REPEAT ;

: TRIM     ( addr len -- addr' len')
            BL SKIP -TRAILING ;

: +CHAR    ( addr len char -- addr len')
            >R             \ save the char
            2DUP +         \ calc end address+1
            R> SWAP C!     \ store character
            1+ ;           \ inc length
\
\ ---[ case covertors ]---
\
HEX
: UPPER    ( c -- c ) DUP LOWER? IF  05F AND THEN ;
: LOWER    ( c -- c ) DUP UPPER? IF  020 OR  THEN ;

: TOUPPER ( addr len -- addr len ) \  convert STACK$ to uppercase in place
          2DUP BOUNDS DO  I C@ UPPER I C!  LOOP ;

: TOLOWER ( addr len -- addr len ) \  convert STACK$ to uppercase
          2DUP BOUNDS DO  I C@ LOWER I C!  LOOP ;

: LOWER.TYPE ( adr len -- ) \ cleaning leading space, print in lower case
              BOUNDS ?DO  I C@ LOWER EMIT  LOOP ;

\ ---[ list words ]---
\
CREATE {NIL}   0 ,                      \ nil list

: {   ( -- ) ALIGN !CSP  ;              \  record stack pos.
: }   ( -- ) ALIGN {NIL} @ , ?CSP ;     \ ends list, check stack
: '{  ( -- addr) HERE { ;               \ start a new list, address on stack


: "   ( -- )                 \ compile a linked-list string
      HERE 0 ,               \ make space for link
      [CHAR] " WORD DUP C@ 1+ ALLOT ALIGN
      HERE SWAP 2- ! DROP ;  \ fill in the link

\ : CAR  ( list -- next)  @ ;
\ : CDR  ( list -- addr) CELL+ ;

: {NEXT}   ( list -- list' )  @  ;  \ get next string in a list
: {$}     ( link -- $)  CELL+ ;

: {NTH}    ( list n -- $addr )  \ the nth string in a list
             0  ?DO  {NEXT}  LOOP ;

: {PRINT} ( link -- ) {$} COUNT CR TYPE ;

: {LEN}   ( list -- n )  \ count the no. of items in a list
          0 >R
          BEGIN
            {NEXT} DUP
            R> 1+ >R
          0= UNTIL
          DROP
          R> 1- ;

: {PRINT} ( list -- )  \ for viewing a list when debugging
          CR
          0 >R
          BEGIN
             DUP @
          WHILE
            DUP {$} COUNT
            DUP 4 + C/L@ > IF  CR THEN TYPE ." , "
            {NEXT}
            R> 1+ >R
          REPEAT
          DROP
          R> CR . ." items" ;

VARIABLE MFLAG     \ simpler that stack juggling :-)
VARIABLE POSITION  \ ALSO record the position keyword in $

: {MEMBER}  ( $ {list} -- -1 | ndx )  \ is ANY member of {list} in $
          MFLAG ON                   \ -1 flag means not found
          SWAP COUNT NEW: TOP$ PLACE \ $ goes on string stack
          0 >R                       \ counter on rstack
          BEGIN
            DUP @                    \ CAR the list
          WHILE
            DUP {$} TOP$ MATCH$ DUP POSITION !
            IF R@ MFLAG !
               DROP {NIL}      \ drop {list}, replace with {nil}
            ELSE
               {NEXT}
               R> 1+ >R        \ inc the counter
            THEN                   \ to end the loop
          REPEAT
          DROP$                \ clean string stack
          DROP                 \ clean data stack
          R> DROP
          MFLAG @  ;           \ return the mflag value
          

\ ---[ Traditional Eliza Banner Printer ]===
HEX
 : ]PDT ( char# -- 'pdt[n] )  8* 800 + ; \ character bit-map table

 VARIABLE LETTER
: BIG.TYPE ( addr len -- )
    8 0 DO  CR                       ( str len)
        2DUP BOUNDS ?DO
            I C@ DUP LETTER !
            ]PDT J +  VC@            \ PDT char, byte# J from VDP RAM
            2 7 DO                   \ from bit# 7 to 2
                DUP 1 I LSHIFT AND   \ mask out each bit
                IF    LETTER @ EMIT  \ if true emit a character
                ELSE  SPACE          \ else print space
                THEN
            -1 +LOOP
            DROP
        LOOP                         ( str len)
    LOOP
    2DROP ;

\ =========================[ ELIZA BEGINS ] ========================
\  --- REFLECTIONS ---
CREATE PHRASES
    { " I AM"      \ 0
      " I HAVE"    \ 1
      " I'VE"      \ 2
      " I'M"       \ 3
      " I WILL"    \ 4
      " I'D"       \ 5
      " I'LL"      \ 6
      " MINE"      \ 7
      " ARE"       \ 8
      " WERE"      \ 9
      " ME"        \ 11
      " YOUR"      \ 12
      " IS"        \ 13
      " MY"
      " I"
      " YOU"
     }

CREATE CONJUGATIONS  \ trailing space needed for correct printing
    { " YOU ARE "    \ 0
      " YOU'VE "     \ 1
      " YOU'VE "     \ 2
      " YOU'RE "     \ 4
      " YOU'LL "     \ 5
      " YOU WOULD "  \ 6
      " YOU WILL "   \ 7
      " YOURS "      \ 8
      " AM "         \ 9
      " WAS "        \ 9
      " YOU "        \ 11
      " MY "         \ 12
      " BEING "      \ 13
      " YOUR "
      " YOU "
      " I "
     }

CONJUGATIONS {LEN} CONSTANT #CONJUGATES

: ]PHRASE     ( n -- $) PHRASES SWAP {NTH} {$} ;
: ]CONJUGATE  ( n -- $) CONJUGATIONS SWAP {NTH} {$} ;

\ ---[ KEYWORDS ]---
\
DECIMAL
CREATE KEYWORDS   \ original Eliza keywords
    {
      " COMPUTER"          " NAME"          " SORRY"        " I REMEMBER"
      " DO YOU REMEMBER"   " I DREAMT"      " DREAM ABOUT"  " DREAM"
      " MY MOTHER"         " MY FATHER"     " I WANT"       " I AM GLAD"
      " I AM SAD"          " ARE LIKE"      " IS LIKE"      " ALIKE"
      " I WAS"             " WAS I"         " I AM"         " AM I"
      " AM"                " ARE YOU"       " YOU ARE"      " BECAUSE"
      " WERE YOU"          " I FEEL"        " I FELT"       " WHY DON'T YOU"
      " YES"               " NO"            " SOMEONE"      " EVERYONE"
      " ALWAYS"            " WHAT"          " PERHAPS"      " ARE"
      " BYE"               " CONSOLE"
     }

: ]KEYWORD ( ndx -- $) \ keyword indexed array with protection
           DUP 0<
           IF
             DROP {NIL}   ( return empty string)
           ELSE
              KEYWORDS SWAP {NTH} {$}
           THEN ;

\ convert keyword# into a FORTH word by removing spaces and NOISE.
\ Output is a stack string for EVALUATE to use
: >ACTION  ( n -- addr len )
            DUP 0< ABORT" >ACTION ndx err"
            ]KEYWORD "NOISE" STRIP$ COUNT ;

\ ==============================================
\        --- REPLIES SUPPORT CODE ---

: REPLY: ( list -- )
         DUP {LEN}        \ count the strings in the list
          1-              \ 1 less is the last string in the list
          0               \ 0 is the first string to use
          ROT             \ put the list address on top
         CREATE           \ create a Forth name for the list
             ,            \ compile list addres
             ,            \ compile the string to use as reply
             ,   ;        \ compile the list length

\ given a reply address these words compute the offset of the fields
: ->USE#  ( replyaddr -- fld_addr) CELL+  ;
: ->CNT#  ( replyaddr -- fld_addr) 2 CELLS + ;
: ->LIST  ( replyaddr -- fld_addr) {NEXT} ;
: ->1ST$  ( replyaddr -- $ ) {NEXT} {$}  ;    \ returns 1st string in list
: REPLY$  ( replyaddr -- $ ) DUP ->USE# @ SWAP ->LIST SWAP {NTH} {$} ;
: LASTREPLY?  ( replyaddr -- ) ->USE# 2@ = ;  \  compare CNT# & USE#.

: REPLY++  ( replyaddr -- ) \ circular increment USE#
           DUP LASTREPLY?
           IF   ->USE# OFF
           ELSE 1 SWAP ->USE# +!
           THEN ;

: {REPLY}  ( keyword# -- {list}) >ACTION EVALUATE ->LIST ;

VARIABLE ROGERIAN        \ set if Rogerian answer is needed

: PRINT.REPLY ( $ -- $ ) \ prints everthing up to the '~' char
              ROGERIAN OFF
              CR CR
              FORALLCHARS
              DO
                  I C@ DUP '~' =
                  IF  DROP
                      ROGERIAN ON
                      LEAVE
                  THEN EMIT
              LOOP
              SPACE ;

\ dot reply prints the reply to "USE" and advances the '->USE#' or resets it to 1
: .REPLY  ( reply_addr -- )
           DUP REPLY$ PRINT.REPLY
           REPLY++ ;

\  =============================
\      === REPLY LISTS ===
\
'{ " Are you frightened by machines?"
   " Are you talking about me in particular?"
   " What do you think computers have to do with your problem?"
   " Don't you think computers can help people?"
   " What is it about machines that worries you?"
 } REPLY: COMPUTER

'{ " Names don't interest me."
   " I don't care about names. Go on."
 } REPLY: NAME

'{ " Please don't apologize."
   " Apologies are not necessary."
   " What feelings do you get when you apologize?"
 } REPLY: SORRY

'{ " Do you often think of~"
   " Does thinking of this bring anything else to mind~"
   " What else do you remember?"
   " Why do you recall this right now?"
   " What in the present situation reminds you of~"
   " What is the connection between me and~"
 } REPLY: IREMEMBER

'{  " Did you think I would forget~"
    " Why do you think I should recall~"   \ now
    " What about~"
    " You mentioned!"        \ this should bring back word from Remember
    " Do you really think its likely that~"
    " Do you wish that~"
    " What do you think about~"
    " Really-- if!"
 } REPLY: DOYOUREMEMBER

'{ " Really--~"
   " Have you ever fantasized about this while you were awake?"
   " Have you dreamt about this before?"
 } REPLY: IDREAMT

'{ " In reality, how do you feel about~"
 } REPLY: DREAMABOUT

'{ " What does this dream suggest to you?"
   " Do you dream often?"
   " What persons appear in your dreams?"
   " Don't you believe that dream has to do with your problem?"
 } REPLY: DREAM

'{ " Who else in your family~"
   " Tell me more about your family"
 } REPLY: MYMOTHER

'{ " Your father~"
   " Does he influence you strongly?"
   " What else comes to mind when you think of your father?"
 } REPLY: MYFATHER


'{ " What would it mean if you got~"
   " Why do you want~"
   " Suppose you soon got~"
   " What if you never got~"
 } REPLY: IWANT

'{ " How have I helped you to be~"
   " What makes you happy just now?"
   " Can you explain why you are suddenly~"
 } REPLY: IAMGLAD

'{ " I am sorry to hear you are depressed"
   " I'm sure its not pleasant to be saD"
 } REPLY: IAMSAD
     
\ (((?* ?x) are like (?* ?y))   NEED TO ADD THIS CAPABILITY

'{ " What resemblance do you see between them?" } REPLY: ARELIKE

\ (((?* ?x) is like (?* ?y))   NEED TO ADD THIS CAPABILITY

'{ " In what way is it that the two are alike?"
   " What resemblance do you see?"
   " Could there really be some connection?"
   " How?"
 } REPLY: ISLIKE

'{ " In what way?"
   " What simililarities do you see?"
   " How?"
 } REPLY: ALIKE
       
'{ " Were you really?"
   " Perhaps I already knew you were~"
   " Why are you telling you were~"
 } REPLY: IWAS

'{ " What if you were~"
   " Do you think you were~"
   " What would it mean if you were~"
 } REPLY: WASI

'{ " In what way are you~"
   " Do you want to be~"
 } REPLY: IAM

'{ " Do you believe you are~"
   " Would you want to be~"
   " You wish I would tell you you are~"
   " What would it mean if you were~"
 } REPLY: AMI

'{ " Why do you say 'AM?'"
   " I don't understand that."
 } REPLY: AM

'{ " Why are you interested in whether or not i am~"
   " Would you prefer if i were not~"
   " Perhaps in your fantasies i am~"
 } REPLY: AREYOU

'{ " What makes you think i am~" } REPLY: YOUARE

'{ " Is that the real reason?"
   " Do any other reasons come to mind?"
   " Does that reason explain anything else?"
 } REPLY: BECAUSE

'{ " Perhaps I was~"
   " What do you think?"
   " What if I had been~"
 } REPLY: WEREYOU

'{ " Maybe NOW you could~"
   " What if you could~"
 } REPLY: ICANT

'{ " How often do you feel~"
   " Do you enjoy feeling~"
 } REPLY: IFEEL

'{ " What other feelings do you have?" } REPLY: IFELT

\    (((?* ?x) I (?* ?y) you (?* ?z))    COOL ONE! Need to do this
\    (Perhaps in your fantasy we ?y each other))

'{ " Why don't you~" } REPLY: WHYDONTYOU

'{ " You seem quite positive."
   " Are you sure?"
   " I understand."
 } REPLY: YES

'{ " Are you saying 'NO' just to be negative?"
   " You are being a bit negative."
   " Why not?"
 } REPLY: NO

'{ " Can you be more specific?" } REPLY: SOMEONE

'{ " Surely not everyone"
   " Can you think of anyone in particular?"
   " Who for example?"
   " Are youe thinking of a special person"
 } REPLY: EVERYONE

'{ " Can you think of a specific example"
   " When?"
   " What incident are you thinking of?"
   " Really-- always?"
 } REPLY: ALWAYS

'{ " Why do you ask?"
   " Does that question interest you?"
   " What is it you really want to know?"
   " What do you think?"
   " What else comes to mind when you ask that?"
 } REPLY: WHAT

'{ " You do not seem quite certain" } REPLY: PERHAPS

'{ " Did you think they might not be~"
   " Possibly they are~"
 } REPLY: ARE

: END_SESSION  TEXT  QUIT ;  \  can change this to BYE

: BYE    CR ." OK. Thanks for chatting."
         CR ." Bye bye!"  700 MS
         1500 MS
         END_SESSION ;

'{ " What does that suggest to you?"
   " I see."
   " I'm not sure I understand you fully."
   " Can we get back to the topic of your mental health?"
   " Can you expand on that a bit?"
   " That is quite interesting. Tell me more. "
   " Are you being honest?"
 } REPLY: TAPDANCE

: CONSOLE   CR
            CR ." Exiting program..."
            CR ." CAMEL99 FORTH"
            CR  QUIT ;

\ ------------------[ replies end ]-----------------
\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\

: GREETING  ( -- )
            CR ." ==================================="
            CR
            CR ." Hi! My name is Eliza."
            CR ." Can I help you?" ;


: $ACCEPT ( $addr -- ) DUP  1+ 80 ACCEPT  SWAP C!  ;

: READLINE ( $ -- addr len  )   \ **returns a stack string **
           CR BEEP ." >" $ACCEPT ;

: LISTEN   ( -- $ )
           BEGIN
             PAD DUP READLINE
             LEN 0>
           UNTIL
           PAD COUNT  TRIM TOUPPER  BL +CHAR INPUT$ PLACE
           INPUT$ ;

\ "cut tail" of INPUT$
\ return everything after the keyword phrase as stack string
 : /TAIL  ( keyword input$ -- adr len)   \ "cut tail"
           2DUP POS$ >R     \ -- key input
           SWAP LEN         \ -- input length
           R> +             \ -- input offset
           SWAP COUNT ROT /STRING ;

: 3RD  ( a b c -- a b c a ) 2 PICK ;

: SPLIT ( addr len char -- str1 len1 str2 len2)
         >R  2DUP  R> SCAN  2SWAP  3RD - ;

: /WORD ( addr len char --  1word len remainder len)
        SPLIT 1+            ( add one to include the trailing space)
        2SWAP 1 /STRING  ;

: CONJUGATE$ ( $ -- $ | $') \ check for PHRASES membership
         DUP PHRASES {MEMBER} 
         DUP 0<                \ ( -- $ ndx ?)
         IF                    \ not a member
             DROP              \ drop ndx, keep original $
         ELSE
             NIP               \ remove original $, keep ndx
             ]CONJUGATE        \ replaced with conjugate
        THEN ;

: /CONJUGATE  ( addr len -- )
         TRIM
         BEGIN
           DUP 0> ( len>0 ?)
         WHILE
            BL /WORD 2SWAP SPUSH            \ cut each word->string stack
            CONJUGATE$ COUNT LOWER.TYPE
            COLLAPSE  ( string stack)
         REPEAT
         2DROP ;

DECIMAL
\ keywords are found by {MEMBER} which scans $ for any MEMBER of the list
: ANALYZE   ( $ -- 0 | ndx)
            KEYWORDS {MEMBER} ;

: REPLY   ( n -- )  \ n= keyword index
           DUP -1 =
           IF  ( no matching keyword)
               DROP
               TAPDANCE .REPLY

           ELSE ( keywords found)
                DUP >ACTION EVALUATE .REPLY
                ROGERIAN @
                IF  ( n) ]KEYWORD INPUT$ /TAIL /CONJUGATE
                ELSE DROP
                THEN
           THEN  ;

DECIMAL
: ELIZA    ( -- )
        TEXT WHT/BLK
        COLLAPSE  ( reset string stack)
        S" Eliza" BIG.TYPE CR
        GREETING
        BEGIN
          LISTEN  ANALYZE  REPLY
        AGAIN ;

 

 

 

 

* https://en.wikipedia.org/wiki/ELIZA

post-50750-0-55582200-1535391558.jpg

  • Like 5
Link to comment
Share on other sites

My objective with CAMEL99 Forth was to create some "training wheels" for someone who is a TI-BASIC programmer but wanted to try Forth.

I am not sure that it is as painless as I wanted it to be. :-)

 

I suppose the only way to be truly painless would be to write a BASIC language in Forth. :grin:

 

Here is an example I used from the TI-BASIC User Reference Guide that is in the CAMEL99 Document.

100 REM  Random Color Dots
110 RANDOMIZE
120 CALL CLEAR
130 FOR C=2 TO 16
140 CALL COLOR(C,C,C)
150 NEXT C
160 N=INT(24*RND+1)         ( N is the note value)
170 Y=110*(2^(1/12))^N      ( this calculates a musical note frequency)
180 CHAR=INT(120*RND)*40
190 ROW=INT(23*RND)+1
200 COL=INT(31*RND)+1
210 CALL SOUND(-500,Y,2)
220 CALL HCHAR(ROW,COL,CHAR)
230 GOTO 160

And here is how it looks in CAMEL99 Forth with "training wheels included"

\ Random Color Dots
INCLUDE DSK1.RANDOM.F
INCLUDE DSK1.SOUND.F
INCLUDE DSK1.CHARSET.F
INCLUDE DSK1.GRAFIX.F
DECIMAL
: SET-COLORS ( -- )
     19 4 DO   I I I COLOR   LOOP ;  \ lines 130,140,150

\ rather than use variables we make words with the same names
\ that calculate the numbers we need and leave them on the stack
: Y   ( -- n ) 1001 RND 110 + ;  \ does not calc. musical notes.
: CHR ( -- n )   79 RND 32 + ;
: ROW ( -- n )   23 RND  ;
: COL ( -- n )   31 RND  ;

\ create a SOUND word from primitives HZ DB MS MUTE
: SOUND  ( dur freq att --) DB  HZ  MS MUTE ;

: RUN ( -- )
      RANDOMIZE
      CLEAR
      SET-COLORS
      BEGIN
        GEN1 125 Y -2 SOUND     \ Use Generator #1. Controls speed also
	COL ROW CHR 1 HCHAR    
	?TERMINAL               \ check for the break key
      UNTIL
      8 SCREEN                  \ restore things like BASIC does
      4 19 2 1 COLORS           \ change char sets 4..19
      CHARSET ;
Link to comment
Share on other sites

V 2.0.22 : Multi-task Friendly VDP I/O and Numeric Conversion

 

I am really liking 9900 indexed addressing these days. I have re-written the ASM I/O primitives in the CAMEL99 Kernel so they use USER variables rather that absolute variable addresses.

USER variables are a table of variables created for each task (including the root task). These variables are referenced based on base address of the task.

 

In CAMEL99 we have expanded the concept of the 9900 Workspace so that after the registers there is a table of USER variables.

The USER VARIABLES are reference by putting the workspace address into a register with the STWP instruction and using indexed addressing to get their address.

 

This added very little complexity to the system and it now means that each task can reference its own cursor positions and print numbers without messing up another task because there is separate copy of all the needed variables for each task and the system I/O routines automagically select the correct variable addresses.

 

Update Notes:

Sept 1, 2018 V2.0.22
- V2.0.22 now can print text and numbers to VDP screen from any task
- Changes to Video i/o primitives so they are multi-tasking friendly. ASM code now uses USER variable indexed addressing so that variables VROW VCOL C/L and OUT are unique for every task.
- HOLD reverted back to Forth version for multi-tasking
- Added TPAD USER VARIABLE which holds the offset of PAD from HERE. By setting TPAD to bigger number for other tasks, each task gets a PAD and HOLD buffer in unallocated dictionary memory.

The spoiler shows the current USER variable list in CAMEL99 Forth. Many are commented out in the kernel to save dictionary space in the Kernel.

 

 

\ USER 0..1F are CPU workspace registers
\       0 USER: 'R0
\       2 USER: 'R1
\       4 USER: 'R2
\       6 USER: 'R3
\       8 USER: 'R4
\       A USER: 'R5
\       C USER: 'R6
\       E USER: 'R7
\      10 USER: 'R8
\      12 USER: 'R9
\      14 USER: 'R10
\      16 USER: 'R11
\      18 USER: 'R12
\      1A USER: 'R13
\      1C USER: 'R14
\      1E USER: 'R15
\ ( *not all USER vars are named to save KERNEL space* )
      20 USER: TFLAG             \ TASK flag awake/asleep status
      22 USER: JOB               \ Forth word that runs in a task
      24 USER: DP                \ dictionary pointer
      26 USER: HP                \ hold pointer, for text->number convertion
      28 USER: CSP
      2A USER: BASE
      2C USER: >IN
\      2E USER: 'EMIT            \ vector for char. output routine
\      30 USER: 'CR              \ vector for carriage return
\      32 USER: 'KEY             \ vector for wait-for-key 
\      34 USER: 'KEY?            \ vector for key pressed test
\      36 USER: 'TYPE            \ vector for block output
\      38 USER: 'PAGE            \ vector for screen clear
      3A USER: LP                \ LEAVE stack pointer.
      3C USER: SOURCE-ID         \ 0 for console,  -1 for EVALUATE, 1 for include
      3E USER: 'SOURCE           \ WATCH OUT! This is 2variable, occupies 3E and 40
\      40 USER: -------          \ used by 'SOURCE
\      42 USER: CURRENT
\      44 USER: CONTEXT
\      46 USER: LH               \ local TASK HEAP pointer if needed
      48 USER: OUT               \ counts chars since last CR (newline)
      4A USER: VROW              \ current VDP column (in fast RAM)
      4C USER: VCOL              \ current VDP row (in fast RAM)
      4E USER: C/L               \ Chars per line (32 or 40 depending on VDP mode)
      50 USER: C/SCR             \ chars per screen >300 or 3C0
      52 USER: 'INTERPRET        \ Vector for the interpreter

\      54 USER: ---  1+ DSRSIZ    \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      56 USER: ---  DSRNAM       \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks
\      58 USER: ---               \ O/S use *PROTECTED IN ROOT TASK, Free for other tasks

       5A USER: TPAD              \ offset used so each task has a separate PAD
\      5C USER:                   \ Free user variable
\      5E USER:                   \ Free user variable
\      60 USER:                   \ Free user variable
\      62 USER:                   \ Free user variable
\      64 USER:                   \ Free user variable
\      66 USER:                   \ Free user variable
\      68 USER:                   \ Free user variable
\      6A USER:                   \ Free user variable
\      6C USER:                   \ Free user variable
\      6E USER:                   \ Free user variable

 

 

  • Like 2
Link to comment
Share on other sites

 

My objective with CAMEL99 Forth was to create some "training wheels" for someone who is a TI-BASIC programmer but wanted to try Forth.

I am not sure that it is as painless as I wanted it to be. :-)

 

I suppose the only way to be truly painless would be to write a BASIC language in Forth. :grin:

 

Here is an example I used from the TI-BASIC User Reference Guide that is in the CAMEL99 Document.

 

 

100 REM  Random Color Dots
110 RANDOMIZE
120 CALL CLEAR
130 FOR C=2 TO 16
140 CALL COLOR(C,C,C)
150 NEXT C
160 N=INT(24*RND+1)         ( N is the note value)
170 Y=110*(2^(1/12))^N      ( this calculates a musical note frequency)
180 CHAR=INT(120*RND)*40
190 ROW=INT(23*RND)+1
200 COL=INT(31*RND)+1
210 CALL SOUND(-500,Y,2)
220 CALL HCHAR(ROW,COL,CHAR)
230 GOTO 160

And here is how it looks in CAMEL99 Forth with "training wheels included"

\ Random Color Dots
INCLUDE DSK1.RANDOM.F
INCLUDE DSK1.SOUND.F
INCLUDE DSK1.CHARSET.F
INCLUDE DSK1.GRAFIX.F
DECIMAL
: SET-COLORS ( -- )
     19 4 DO   I I I COLOR   LOOP ;  \ lines 130,140,150

\ rather than use variables we make words with the same names
\ that calculate the numbers we need and leave them on the stack
: Y   ( -- n ) 1001 RND 110 + ;  \ does not calc. musical notes.
: CHR ( -- n )   79 RND 32 + ;
: ROW ( -- n )   23 RND  ;
: COL ( -- n )   31 RND  ;

\ create a SOUND word from primitives HZ DB MS MUTE
: SOUND  ( dur freq att --) DB  HZ  MS MUTE ;

: RUN ( -- )
      RANDOMIZE
      CLEAR
      SET-COLORS
      BEGIN
        GEN1 125 Y -2 SOUND     \ Use Generator #1. Controls speed also
	COL ROW CHR 1 HCHAR    
	?TERMINAL               \ check for the break key
      UNTIL
      8 SCREEN                  \ restore things like BASIC does
      4 19 2 1 COLORS           \ change char sets 4..19
      CHARSET ;

 

 

 

Line 180 of the TI Basic program should end with “+40”, not “*40” (see the TI User’s Reference Guide). Adding 40 gives a range of 40 – 159, which makes sense because the highest character code for TI Basic is 159.

 

Also, should not the numbers consumed by RND in CHR, ROW and COL each be one higher to give maximum values of 111, 23 and 31, respectively?

 

On another note, attempting to convert this little program to run in fbForth 2.0 revealed a bug in my SOUND word that I must fix before I release Build 11. I need to tell @Willsy that he has the same problem in TurboForth because I copied his code! [Edit: The code looks to be correct, but something was not working properly. I will post more in proper thread. between my ears!]

 

...lee

Link to comment
Share on other sites

 

Line 180 of the TI Basic program should end with “+40”, not “*40” (see the TI User’s Reference Guide). Adding 40 gives a range of 40 – 159, which makes sense because the highest character code for TI Basic is 159.

 

Also, should not the numbers consumed by RND in CHR, ROW and COL each be one higher to give maximum values of 111, 23 and 31, respectively?

 

On another note, attempting to convert this little program to run in fbForth 2.0 revealed a bug in my SOUND word that I must fix before I release Build 11. I need to tell @Willsy that he has the same problem in TurboForth because I copied his code!

 

...lee

 

Ah right on line 180. Thanks.

 

Yes you are correct on the CHR,ROW AND COL values. I should add a 1+.

 

And for once I accidentally found a bug for you.

 

B

Link to comment
Share on other sites

Ah right on line 180. Thanks.

 

Yes you are correct on the CHR,ROW AND COL values. I should add a 1+.

 

Won’t that cause the ranges to start at 1 when they should(?) start at 0 for ROW and COL?

 

And for once I accidentally found a bug for you.

 

I think the bug was between my ears! I will post an fbForth version shortly.

 

...lee

Link to comment
Share on other sites

Here is an fbForth version of “Random Color Dots” (see post #158):

 

 

 

\ "Random Color Dots"--conversion of TI Basic example from TI-99/4A
\ _User's Reference Guide_, p. 259 through Camel99 Forth to fbForth 2.0

DECIMAL
: SET-COLORS ( -- )  \ lines 130,140,150
     19 4 DO   I I I COLOR   LOOP ;  

\ Rather than use variables, we make words with the same names
\ that calculate the numbers we need and leave them on the stack.
: Y   ( -- n )    \ lines 160,170 [floating point (FP) calculations]
   >F 111860.8          \ K: FP sound chip frequency constant
   >F 1.059463094359    \ FP tone-step base = 2^(1/12)
   24 RND S->F          \ N: FP tone-step base exponent for 24 half
                        \    tones from 110 Hz to 415 Hz
   ^                    \ (2^(1/12))^N in FP
   >F 110 F*            \ F: FP frequency of new note
   F/                   \ K/F: FP frequency code for SOUND chip
   F->S  ;              \ K/F converted to integer for SOUND-chip input
: CHR ( -- n )   80 RND 32 + ;   \ line 180 [range: 32-111]
: ROW ( -- n )   24 RND  ;       \ line 190 [range: 0-23]
: COL ( -- n )   32 RND  ;       \ line 200 [range: 0-31]
: BASIC-MODE ( -- ) 
      5911 ( 1717h) DCT 4 + !    \ store black/cyan in default color table
      GRAPHICS  ;                \ set GRAPHICS mode as in TI BASIC
: WAIT  ( ms -- ) \ approx. ms of time to wait
      0 DO 
         10 0 DO 
         LOOP 
      LOOP  ;
: RUN ( -- )
      BASIC-MODE
      RANDOMIZE
      CLS
      SET-COLORS
      BEGIN
         Y 0 0 SOUND    \ use Generator #1--also controls pitch
         100 WAIT       \ wait ~100 ms
         COL ROW 1 CHR HCHAR    
         ?TERMINAL               \ check for the break key
      UNTIL
      0 15 0 SOUND               \ mute Generator #1
      BASIC-MODE  ;              \ restore things like BASIC does 

 

 

 

...lee

  • Like 1
Link to comment
Share on other sites

 

Won’t that cause the ranges to start at 1 when they should(?) start at 0 for ROW and COL?

 

 

I think the bug was between my ears! I will post an fbForth version shortly.

 

...lee

 

Yes, and it appears that I have to look at my PRNG. It seems to not work well with even numbers.

I like it because it did not repeat for 64K numbers, but it has other issues.

 

It never ends...

 

B

Link to comment
Share on other sites

Here is an fbForth version of “Random Color Dots” (see post #158):

 

 

 

\ "Random Color Dots"--conversion of TI Basic example from TI-99/4A
\ _User's Reference Guide_, p. 259 through Camel99 Forth to fbForth 2.0

DECIMAL
: SET-COLORS ( -- )  \ lines 130,140,150
     19 4 DO   I I I COLOR   LOOP ;  

\ Rather than use variables, we make words with the same names
\ that calculate the numbers we need and leave them on the stack.
: Y   ( -- n )    \ lines 160,170 [floating point (FP) calculations]
   >F 111860.8          \ K: FP sound chip frequency constant
   >F 1.059463094359    \ FP tone-step base = 2^(1/12)
   24 RND S->F          \ N: FP tone-step base exponent for 24 half
                        \    tones from 110 Hz to 415 Hz
   ^                    \ (2^(1/12))^N in FP
   >F 110 F*            \ F: FP frequency of new note
   F/                   \ K/F: FP frequency code for SOUND chip
   F->S  ;              \ K/F converted to integer for SOUND-chip input
: CHR ( -- n )   80 RND 32 + ;   \ line 180 [range: 32-111]
: ROW ( -- n )   24 RND  ;       \ line 190 [range: 0-23]
: COL ( -- n )   32 RND  ;       \ line 200 [range: 0-31]
: BASIC-MODE ( -- ) 
      5911 ( 1717h) DCT 4 + !    \ store black/cyan in default color table
      GRAPHICS  ;                \ set GRAPHICS mode as in TI BASIC
: WAIT  ( ms -- ) \ approx. ms of time to wait
      0 DO 
         10 0 DO 
         LOOP 
      LOOP  ;
: RUN ( -- )
      BASIC-MODE
      RANDOMIZE
      CLS
      SET-COLORS
      BEGIN
         Y 0 0 SOUND    \ use Generator #1--also controls pitch
         100 WAIT       \ wait ~100 ms
         COL ROW 1 CHR HCHAR    
         ?TERMINAL               \ check for the break key
      UNTIL
      0 15 0 SOUND               \ mute Generator #1
      BASIC-MODE  ;              \ restore things like BASIC does 

 

 

 

...lee

 

Ooooo I am jealous of those floating point routines. :woozy:

Link to comment
Share on other sites

 

Yes, and it appears that I have to look at my PRNG. It seems to not work well with even numbers.

I like it because it did not repeat for 64K numbers, but it has other issues.

 

It never ends...

 

B

 

Ok I surrender... for now.

 

I have put the TI Forth PRNG in RANDOM.F as machine code.

All the methods I see online use 32 bit integers which I can do but it I want to do better analysis.

 

My 16 BIT version of the GForth PRNG didn't repeat for 64K numbers but it was not nearly random enough.

So the old TI Forth algorithm will be part of CAMEL99 until further notice.

HEX
83C0 CONSTANT SEED   \ TI incrementing number in main menu

 CODE RNDW    ( -- n)
             0646 , C584 , \ TOS PUSH,
             C0E0 , SEED , \ SEED @@ R3 MOV,
             0202 , 6FE5 , \ R2 6FE5  LI,
             38C2 ,        \ R2  R3   MPY,
             0224 , 7AB9 , \ TOS 7AB9 AI,
             0B54 ,        \ TOS 5 SRC,
             C804 , SEED , \ TOS SEED @@ MOV,
             NEXT,
             ENDCODE   \ 24 bytes

: RANDOMIZE ( n -- )   SEED ! ;
: RND       ( n -- n') RNDW ABS SWAP MOD ;
Edited by TheBF
  • Like 1
Link to comment
Share on other sites

Ok I surrender... for now.

 

I have put the TI Forth PRNG in RANDOM.F as machine code.

All the methods I see online use 32 bit integers which I can do but it I want to do better analysis.

 

My 16 BIT version of the GForth PRNG didn't repeat for 64K numbers but it was not nearly random enough.

So the old TI Forth algorithm will be part of CAMEL99 until further notice.

HEX
83C0 CONSTANT SEED   \ TI incrementing number in main menu

 CODE RNDW    ( -- n)
             0646 , C584 , \ TOS PUSH,
             C0E0 , SEED , \ SEED @@ R3 MOV,
             0202 , 6FE5 , \ R2 6FE5  LI,
             38C2 ,        \ R2  R3   MPY,
             0224 , 7AB9 , \ TOS 7AB9 AI,
             0B54 ,        \ TOS 5 SRC,
             C804 , SEED , \ TOS SEED @@ MOV,
             NEXT,
             ENDCODE   \ 24 bytes

: RANDOMIZE ( n -- )   SEED ! ;
: RND       ( n -- n') RNDW ABS SWAP MOD ;

 

Just to be clear: Rather than the address of the seed, SEED in TI Forth is a word that stores the number on the stack at the seed address, >83C0. Once off of the TI-99/4A title screen, >83C0 is static unless changed programmatically.

 

I am not sure I understand RANDOMIZE here. In TI Forth, it neither takes nor leaves anything from/on the stack. Instead, it races the ISR for the VDP interrupt in a loop that counts how many iterations it takes to catch the interrupt. That number becomes the new seed. For fbForth, I converted the high-level Forth of TI Forth:

: RANDOMIZE   ( --- )
   8802 C@ DROP           \ clear VDP interrupt
   0                      \ initialize race counter
   BEGIN                  \ begin race for VDP interrupt
      1+                  \ increment counter
      8802 C@ 80 AND      \ test for VDP interrupt
   UNTIL
   SEED  ;                \ store count at >83C0 

to ALC:

* Body of RANDOMIZE---

RNDMZ  DATA $+2
       MOVB @>8802,R0    get VDP status byte
       CLR  R0           discard it
       CLR  R1           clear counter
S1016A INC  R1           increment counter
       MOVB @>8802,R0    get VDP status byte
       ANDI R0,>8000     VDP interrupt?
       JEQ  S1016A          no, increment counter
       MOV  R1,@>83C0    yes, store new seed
       B    *NEXT        return to Forth inner interpreter 

[Aside: I just noticed that I wasted an instruction in the ALC. The ANDI instruction clears the low byte of R0, which obviates the necessity for clearing R0 ahead of the loop. :dunce:]

 

As always, if any of my code interests you, you have carte blanche on its use.

 

...lee

Link to comment
Share on other sites

As usual I took a "slightly" different approach from what was.

I looked at >83C0 in the debugger and saw that it spins in the MAIN menu until I enter the E/A menus.

That gives me a pretty random number to "seed" the PRNG when you start CAMEL99 Forth so for things like games it seemed ideal.

In the event that you want to start with a specific SEED value, say for a specific sequence, I used RANDOMIZE to let you set the "SEED".

 

The word RANDOMIZE is arguably not the best choice. I can readily change it to SEED, since most of the system is a library file.

 

Thanks for showing me the RANDOMIZE code.

Isn't it strange how we see these things in our code after we present them to someone. Our focus must change somehow.

 

I might try a different approach. There are two addresses madly incrementing all the time. >8379 and the screen time out.

It would be simple to grab a byte from each and fuse them together,

 

What do you think of that idea?

HEX
: RANDOMIZE  ( -- )  8379 C@  83D7 C@ FUSE SEED ;
( FUSE is in CAMEL99 Kernel for "fusing" 2 bytes together)
Link to comment
Share on other sites

I might try a different approach. There are two addresses madly incrementing all the time. >8379 and the screen time out.

It would be simple to grab a byte from each and fuse them together,

 

What do you think of that idea?

HEX
: RANDOMIZE  ( -- )  8379 C@  83D7 C@ FUSE SEED ;
( FUSE is in CAMEL99 Kernel for "fusing" 2 bytes together)

 

Not too bad. I have thought of doing something with those counters, as well. >8379 is the VDP interrupt timer and ticks once every 1/60 second. In fact, all that TI Basic’s RANDOMIZE does is to grab that byte and jam it into the low byte of >83C0, viz., >83C1.

 

There are a couple of potential problems with the screen timeout timer, however:

  1. The console keyboard service routine (KSR) resets it to 0 at every keystroke.
  2. The console KSR or ISR (I forget which) increments it by 2, so it is always an even number. You can change it to an odd number after each keystroke to prevent the screen timing out, but then it will always be odd until the next keystroke.

...lee

Link to comment
Share on other sites

I revisited the GForth PRNG and the problem I was having seems to be due to the magic number they call generator.

I used 1/2 of the original 32 bit number and It was very bad.

 

I used the TI magic number and it works quite well now and still has a repeat frequency of 64K.

 

The other thing that I believe is good is not using MOD to get the reduced values from RND although that is hearsay to me. I don't know the math to prove it.

\ GForth Random number method, modified for CAMEL Forth BJF Sept 5 2018

HEX 83C0 CONSTANT 'SEED   

6FE5 CONSTANT GENERATOR

: RNDW  ( -- N ) GENERATOR  'SEED @  UM* DROP 1+ DUP 'SEED ! ;

: RND ( N -- 0..N-1 ) RNDW UM* NIP ;

1235 'SEED !

I wrote a test that puts letters on the screen in random places until every hole is not blank.

I uses an ALC version of SCAN so it goes reasonably fast.

 

The TI version seems to take longer to get that last hole filled. 7062 vs 5169 for GForth version with the >1235 SEED

 

Gotta go to bed now. :sleep:


CREATE SBUFF   C/SCR @ ALLOT

: SCAN-FOR-BLANKS ( -- ?)
     0  SBUFF C/SCR @ VREAD       \ read VDP into buffer
     SBUFF C/SCR @ BL SCAN NIP ;  \ scan buffer for blanks

VARIABLE ITERATIONS
VARIABLE DUPLICATES 

: WAIT-KEY   BEGIN KEY? UNTIL ;

: UNTILFULL ( -- )
      PAGE
      DUPLICATES OFF
      ITERATIONS OFF
      BEGIN
          C/SCR @ RND DUP VC@
          DUP BL =
          IF
               DROP
               [CHAR] A SWAP VC!
          ELSE
               1+ SWAP VC!
               1 DUPLICATES +!
          THEN
         1 ITERATIONS +!
         SCAN-FOR-BLANKS 0=
      UNTIL
      BEEP
      WAIT-KEY
      PAGE ." Random Screen Fill"
      CR
      CR ITERATIONS @ U. ." iterations"  ( 7062 )
      CR DUPLICATES @ U. ." duplicates"  ( 6102 )
;
Edited by TheBF
Link to comment
Share on other sites

DUH! My previous GForth PRNG did not use a prime number.

I believe that is why it is working better now with 28649 ( 6FE5)

 

Now it does not repeat for 65535 numbers.

In the screen fill test it took 6148 iterations to fill every position in TEXT mode with HEX 1235 as the seed value.

\ GForth Random number method, modified for CAMEL Forth BJF Sept 5 2018

HEX 83C0 CONSTANT RND#  \ TI incrementing number in main menu

DECIMAL 28649 ( 6FE5) CONSTANT PRIME#  ( PRIME number)

: SEED      ( n -- )        RND# ! ;
: RNDW      ( -- n )        PRIME#  RND# @  UM* DROP 1+ DUP SEED ;
: RND       ( n -- 0..n-1 ) RNDW UM* NIP ;

HEX
: RANDOMIZE  ( -- )  8379 C@  83D7 C@ FUSE SEED ;

 1235 SEED  ( COMMENT OUT IF YOU WANT RND# FROM MAIN MENU)
Edited by TheBF
  • Like 1
Link to comment
Share on other sites

DUH! My previous GForth PRNG did not use a prime number.

I believe that is why it is working better now with 28649 ( 6FE5)

 

28649 (>6FE9) is, indeed, prime, but >6FE5 (28645) is not. It is the latter that TI used. The number (>7AB9) TI used to add to the product of >6FE5 and the value at >83C0 is not prime either. They do not have any primes in common, however. I always thought the bit pattern of the two numbers might be important, but I am not sure.

 

It is kind of interesting that the second number is π to 5 places with 1 added to the last place—as though to insure the lowest bit is 1. In fact the lowest bit of both numbers is 1.

 

...lee

Link to comment
Share on other sites

Here is a much faster version of your PRNG-testing program that avoids copying the screen from VRAM to CRAM every iteration:

\ Random Screen Fill that avoids using SCAN and whole-screen copying.

VARIABLE BLANK_CNT
VARIABLE ITERATIONS
VARIABLE DUPLICATES 

: WAIT-KEY   BEGIN KEY? UNTIL ;

: UNTILFULL ( -- )
      PAGE
      C/SCR @ BLANK_CNT !     \ initialize to screenfull of blanks
      DUPLICATES OFF
      ITERATIONS OFF
      BEGIN
          C/SCR @ RND DUP VC@
          DUP BL =
          IF
               DROP
               [CHAR] A SWAP VC!
               -1 BLANK_CNT +!      \ decrement blank count
          ELSE
               1+ SWAP VC!
               1 DUPLICATES +!
          THEN
         1 ITERATIONS +!
         BLANK_CNT @ 0=          \ did we hit all the blanks?
      UNTIL
      BEEP
      WAIT-KEY
      PAGE ." Random Screen Fill"
      CR
      CR ITERATIONS @ U. ." iterations"
      CR DUPLICATES @ U. ." duplicates"
;

and here it is converted to fbForth:

 

 

\ Random Screen Fill converted from CAMEL99 to fbForth 2.0---
\ ...avoids using SCAN and whole-screen copying

0 VARIABLE BLANK_CNT
0 VARIABLE ITERATIONS
0 VARIABLE DUPLICATES 

: WAIT-KEY   BEGIN ?KEY UNTIL ;

: UNTILFULL ( -- )
      PAGE
      SCRN_END @ BLANK_CNT !     \ initialize to screenfull of blanks
      0 DUPLICATES !
      0 ITERATIONS !
      BEGIN
          SCRN_END @ RND DUP VSBR
          DUP BL =               
          IF                     
               DROP              
               ASCII A SWAP VSBW 
               -1 BLANK_CNT +!      \ decrement blank count
          ELSE                   
               1+ SWAP VSBW      
               1 DUPLICATES +!
          THEN
         1 ITERATIONS +!
         BLANK_CNT @ 0=          \ did we hit all the blanks?
      UNTIL
      BEEP
      WAIT-KEY
      PAGE ." Random Screen Fill"
      CR
      CR ITERATIONS @ U. ." iterations"
      CR DUPLICATES @ U. ." duplicates"
; 

 

 

 

...lee

  • 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   0 members

    • No registered users viewing this page.
×
×
  • Create New...