Jump to content
IGNORED

Camel99 Forth Information goes here


TheBF

Recommended Posts

On 3/1/2020 at 5:55 PM, Lee Stewart said:

 

Yeah—perhaps a one-character word using an unused character like ‘~’ or ‘`’ would take up the least space:


: `  ;     \ dummy starting word

 

...lee


I took your advice and just did a   : ~ ;  to properly finish the re-linking.

I seems to work very well.  Now I need to study how you binary load the Assembler. That is a cool feature too.

 

  • Like 1
Link to comment
Share on other sites

15 hours ago, TheBF said:

I seems to work very well.  Now I need to study how you binary load the Assembler. That is a cool feature too.

 

If you are referring to how I do it in fbForth, that is more complication than you will need because I must save/restore vocabulary information. If you will always be copying the image to the same address in low RAM, you should first LOAD the assembler such that the first lfa will land at that address. Then, I think you should only need to save LATEST and, the dictionary pointer (only for marking where free low RAM begins). Then, upon restoring the image, patch the first lfa with the current LATEST and replace the current LATEST with the one saved with the image to make it easy to link with new program code. Lastly, recover the dictionary pointer to keep track of the end of the assembler image, if that is important. I think that should do it.

 

...lee

  • Like 1
Link to comment
Share on other sites

I think your Forth has a Lithp   :lol:

I have been having some fun with code written in 1985 by Martin J. Tracy.  I was revisiting my Eliza program and realized that I  made a chewing gum and hay-wire way to make lists of strings. It's ugly.  I had always wondered how LISP did it. I knew I had an old file called Microlisp that was educational, by Martin Tracy so I pulled it out of mothballs.  I dumned it down because I don't need full blown LISP but it allowed be to make some working list constructors and some operations on the lists.  It's pretty cool.

 

LISP uses a pool of double pointers called "CONS".  One pointer in a CONS holds the link to another CONS and the second pointer points to some data. It gets a little weird to understand the code until that makes sense, but then it starts to get a little easier.  I have to admit that it would have taken me a lot of time to write some of these operators without Martin's code.  I put the CONS pool in LOW RAM.

 

The video shows these simply lists of strings in operation.

 

What's missing (partial list)

  1. Lists of lists:  I can build them with what I have, but I need a recursive way to read them to get at the data.
  2. Garbage collection: Currently these lists are created and can't be destroyed
  3. Numbers in lists: I can see how that is done but it is a lot of code and I only need text at this time.
  4. A proper LISP REPL (read,evaluate,print,loop)  Again not something needed immediately.

Here is the code:

\ static lists in Forth
\ based on code by Martin J Tracy  Nov 17 1985

NEEDS DUMP FROM DSK1.TOOLS
NEEDS MALLOC FROM DSK1.MALLOC
NEEDS S= FROM DSK1.COMPARE

\ utility words
: ERASE  ( addr len -- ) 0 FILL ;
: CELLS+ ( n -- n')  CELLS + ;
: NOT    ( n -- ? ) 0= ; 

\ lists are two cell structure with a pointer to the next item 
\ and a pointer  to the data
\
\  [link],[^data]
\ For historical reasons the link is called the CDR
\ The data pointer is called the CAR


\ There we can create an "NIL" list in Forth like this
\            cdr   car
\           ----- -----
CREATE NIL   NIL , NIL ,

\ extracts the value pointer of the first link of a list
: CAR  ( list -- ^value) CELL+ @  ;

\ extracts the next link of a list (follows the list)
: CDR  ( list -- list')  @ ;

: CADR  ( list -- next-item)  CDR CAR ;

 \ returns true if list is NIL (empty)
: NULL  ( list -- f) NIL = ;

\ returns true if list is non-NIL (not empty)
: NOT-NULL  ( list -- f) NIL <> ;

\  Allocate LISP "CONS" memory
DECIMAL
            1000 CONSTANT #LINKS    \ 1000 cells for now.
         2 CELLS CONSTANT CONSIZE   \ size of 1 CONS structure
#LINKS CONSIZE * CONSTANT LINKSIZE

\ CONS cells are allocated in the HEAP
 LINKSIZE MALLOC CONSTANT LINKS

VARIABLE FREE-LINK                \ points to an available link

\ Create pool of CONS cells as one list of "free-links"
: NEW-LINKS  ( --)
     LINKS  LINKSIZE ERASE
     LINKS
     #LINKS 1- 0           \ all links but last
     DO
       DUP CONSIZE + OVER ! CONSIZE +
     LOOP
     NIL SWAP !            \ last link is NIL
     LINKS FREE-LINK !  ;  \ set FREE-LINK to start of CONS memory

  NEW-LINKS          \ init the links array now

: GET-CELL  ( -- cell) \ allocate a free cell and return its address
     FREE-LINK @ DUP NULL ABORT" No more links"
     DUP CDR FREE-LINK !  ( unlink top cell)  ;

\ CONS is the fundamental LIST contructor
\ add a link whose CAR (1st list item)  points to the value
: CONS  ( ^value list -- list')  GET-CELL  DUP >R 2!  R>  ;

\ '(  )' TICK brackets count items on DATA stack and build a list
: '(   ( -- )  !CSP ;       \ start a list. record DATA stack position

: ITEMS  ( -- n) CSP @  SP@ - 2/ 2- ;  \ count items from '{

: )'   ( -- ) NIL  ITEMS 0 ?DO  CONS  LOOP ;  \ build list with NIL at end

\ compile a string in Forth dictionary, return address
: "   ( -- $addr ) [CHAR] " WORD DUP C@ 1+ ALLOT ALIGN ;

\ ===[ list operations ] =======================
: LENGTH  ( list -- n)  \ finds the number of items in a list.
    0 ( accumulator)
    BEGIN OVER NOT-NULL
    WHILE
       1+
       SWAP CDR SWAP
    REPEAT
    NIP  ;

: UWITHIN  ( address low-bound high-bound -- f) 
\ true if low-bound U<= address U< hi-bound.
   >R OVER  R> U< -ROT  U< NOT AND  ;

: LISTP  ( addr -- ?)
\ true if the address argument is a list or NIL
  DUP  LINKS  [ LINKS LINKSIZE + ] LITERAL  UWITHIN
  IF  CDR 0 <>  ELSE  NULL  THEN  ;

DECIMAL

: "("   ." (" ;
: ")"   ." )" ;
: .$    ( addr -- ) COUNT TYPE ;

: .ITEM ( addr -- )
        DUP LISTP IF CAR THEN
        DUP NULL
        IF  DROP
        ELSE SPACE .$ SPACE
        THEN ;

: .LIST ( list --) \ prints a list of literal symbols.
        DUP LISTP NOT ABORT" Not a list"
        CR "("
        BEGIN
           DUP NOT-NULL
        WHILE
           DUP .ITEM
           CDR
        REPEAT
        DROP ")" ;

: NTH  ( list n -- list)
       ?DUP           \ dup if n<>0
       IF             \ if n<>0
         0 ?DO
            CDR       \ traverse list 'n' times
         LOOP
       THEN  ;        \ then get the pointer to data

: .NTH  ( list n -- ) NTH  .ITEM ;

: REVERSE  ( list -- new-list)
\ copies a list reversing the top-level only.
  NIL  SWAP
  BEGIN DUP NOT-NULL
  WHILE
     DUP  CAR  ROT CONS   ( create a new list with CONS)
     SWAP CDR
  REPEAT
  DROP  ;

:  LAST  ( list -- list') \ returns last link of given list as a list.
  DUP NOT-NULL
  IF  DUP LISTP  NOT ABORT" Can't LAST"
      BEGIN  DUP CDR
        NOT-NULL
      WHILE
        CDR
      REPEAT
  THEN  ;

:  APPEND  ( list1 list2 -- list1+list2)
\ appends two lists.  The originals are "surgically" joined
   OVER LISTP  OVER LISTP  AND NOT ABORT" Can't APPEND"
   DUP  NULL
   IF  DROP
   ELSE
        OVER NULL
        IF  NIP
        ELSE   OVER LAST !
        THEN
   THEN  ;

\  Manually Construct a list with CONS
 " AUTOMOBILE" " BOAT" " PLANE" NIL CONS CONS CONS CONSTANT VEHICLES

\ Example Lists
 '( " GOAT"  " CAT"     " DOG"
    " HORSE" " CHICKEN" " MONKEY" )' CONSTANT ANIMALS

 '( " LINCOLN" " WASHINGTON" " GROVER"
    " KENNEDY" " OBAMA"      " TRUMP" )' CONSTANT PRESIDENTS

 '( " APPLE"   " BANANA"  " CRANBERRY"
    " DORIAN"  " GUAVA"   " PEAR" )' CONSTANT FRUIT
    


 

 

  • Like 2
Link to comment
Share on other sites

Did I understand rightly how to make a list of lists? but, CSP! and CSP don't support that, do they?

How would you do it?

 

'( '( ." GOAT"      ( ." EATS-EVERYTHING" ." SAYS-EHEHEH" )' )'
   '( ." GUINEAPIG" ( ." EATS-HAY"        ." SAYS-WHEEK" )' )'
   '( ." DOG"       ( ." EATS-SHOES"      ." SAYS-WOOF" )' )'
   '( ." MOUSE"     ( ." EATS-DOGFOOD"    ." SAYS-EEK" )' )'
)' CONSTANT ANIMALS

 

Is "(" there just to escape the parenthesis as a string? Or does it have some meaning inside a list?

 

 

 

Not Dorian, Durian

 

image.jpeg.728c752a81d2bf2a411cfd6ac076ebb4.jpeg

Link to comment
Share on other sites

1 hour ago, FarmerPotato said:

Did I understand rightly how to make a list of lists? but, CSP! and CSP don't support that, do they?

How would you do it?


'( '( ." GOAT"      ( ." EATS-EVERYTHING" ." SAYS-EHEHEH" )' )'
   '( ." GUINEAPIG" ( ." EATS-HAY"        ." SAYS-WHEEK" )' )'
   '( ." DOG"       ( ." EATS-SHOES"      ." SAYS-WOOF" )' )'
   '( ." MOUSE"     ( ." EATS-DOGFOOD"    ." SAYS-EEK" )' )'
)' CONSTANT ANIMALS

Is "(" there just to escape the parenthesis as a string? Or does it have some meaning inside a list?

 

Not sure what you are doing there, but the lone ( starts a comment, which will be terminated by the ) of )' which will leave ' (tick) to be interpreted—probably not what you want, but I really am asea here. I am sure Brian will comment shortly. :)

 

...lee

 

Link to comment
Share on other sites

2 hours ago, FarmerPotato said:

Did I understand rightly how to make a list of lists? but, CSP! and CSP don't support that, do they?

How would you do it?

 


'( '( ." GOAT"      ( ." EATS-EVERYTHING" ." SAYS-EHEHEH" )' )'
   '( ." GUINEAPIG" ( ." EATS-HAY"        ." SAYS-WHEEK" )' )'
   '( ." DOG"       ( ." EATS-SHOES"      ." SAYS-WOOF" )' )'
   '( ." MOUSE"     ( ." EATS-DOGFOOD"    ." SAYS-EEK" )' )'
)' CONSTANT ANIMALS

 

Is "(" there just to escape the parenthesis as a string? Or does it have some meaning inside a list?

 

 

 

Not Dorian, Durian

 

image.jpeg.728c752a81d2bf2a411cfd6ac076ebb4.jpeg

LOL,  Yes Durian fruit, the stinky one.

 

At the moment there is no way to do lists in lists. I made this to implement the simple lists used in Eliza.

I will fix that with a separate list stack to replace !CSP.  Each time '( is executed in this future version, the data stack pointer will be pushed onto the stack.

 

The "(" was just to show that that the contents are a list. They could be removed from .LIST. 

 

Can you tell I am feeling my way along here... :)

 

 

Link to comment
Share on other sites

4 hours ago, FarmerPotato said:

Did I understand rightly how to make a list of lists? but, CSP! and CSP don't support that, do they?

How would you do it?

 


'( '( ." GOAT"      ( ." EATS-EVERYTHING" ." SAYS-EHEHEH" )' )'
   '( ." GUINEAPIG" ( ." EATS-HAY"        ." SAYS-WHEEK" )' )'
   '( ." DOG"       ( ." EATS-SHOES"      ." SAYS-WOOF" )' )'
   '( ." MOUSE"     ( ." EATS-DOGFOOD"    ." SAYS-EEK" )' )'
)' CONSTANT ANIMALS

 

Is "(" there just to escape the parenthesis as a string? Or does it have some meaning inside a list?

 

 

 

Not Dorian, Durian

 

image.jpeg.728c752a81d2bf2a411cfd6ac076ebb4.jpeg

So Mr. Potato, ( are we on a first name basis? I could call you Farmer)  :)

 

You have got my head spinning.

Your code example used dot-quote inside the list. This made me realize that if I am clever, I should be able to put "Execution tokens" into these lists which would mean that each item in the list could be executed and just do what it is supposed to do. 

 

I can't say it's advisable, but it works.  I show an example at the end.

 

Here is the latest version of what I have that uses a list stack instead of !CSP. 

The important thing to note is this is very simple; not real LISP.  The word '(  marks the data stack position.

The word "   reads text into Forth memory and returns the address of the count byte of the text

The word )'   takes the number of addresses on the data stack and puts them all into LINKS in the "pool" of links.

 

There is a new word LIST-VAR which makes a variable that is traceable to other LIST-VARs.

And another new word LIST-VALUE that makes a Forth VALUE that is also traceable in the list-var  list.  I like the LIST-VALUE best.

These traceable variables will allow a way to recover space when I figure out how that works.

 

I am going through Martin Tracy's code to see what I can extract as Forth features rather than making a "microlisp" as he did.

\ static lists in Forth
\ based on code by Martin J Tracy  Nov 17 1985

NEEDS DUMP FROM DSK1.TOOLS
NEEDS MALLOC FROM DSK1.MALLOC
NEEDS S= FROM DSK1.COMPARE
NEEDS TO  FROM DSK1.VALUES
NEEDS LIFO: FROM DSK1.STACKS

\ utility words
: ERASE  ( addr len -- ) 0 FILL ;
: CELLS+ ( n -- n')  CELLS + ;
: NOT    ( n -- ? ) 0= ; 

\ lists are two cell structure with a pointer to the next item 
\ and a pointer  to the data
\
\  [link],[^data]
\ For historical reasons the link is called the CDR
\ The data pointer is called the CAR


\ There we can create an "NIL" list in Forth like this
\            cdr   car
\           ----- -----
CREATE NIL   NIL , NIL ,

\ extracts the value pointer of the first link of a list
: CAR  ( list -- ^value) CELL+ @  ;

\ extracts the next link of a list (follows the list)
: CDR  ( list -- list')  @ ;

: CADR  ( list -- next-item)  CDR CAR ;

 \ returns true if list is NIL (empty)
: NULL  ( list -- f) NIL = ;

\ returns true if list is non-NIL (not empty)
: NOT-NULL  ( list -- f) NIL <> ;

\  Allocate a Pool of links
DECIMAL
            1000 CONSTANT #LINKS    \ 1000 links for now.
         2 CELLS CONSTANT CONSIZE   \ size of 1 CONS structure
#LINKS CONSIZE * CONSTANT LINKSIZE

\ CONS cells are allocated in the HEAP
 LINKSIZE MALLOC CONSTANT LINKS

VARIABLE FREE-LINK         \ points to an available link

\ Create pool of CONS cells as one list of "free-links"
: NEW-LINKS  ( --)
     LINKS  LINKSIZE ERASE
     LINKS
     #LINKS 1- 0           \ all links but last
     DO
       DUP CONSIZE + OVER ! CONSIZE +
     LOOP
     NIL SWAP !            \ last link is NIL
     LINKS FREE-LINK !  ;  \ set FREE-LINK to start of CONS memory

  NEW-LINKS          \ init the links array now

: GET-CELL  ( -- cell) \ allocate a free cell and return its address
     FREE-LINK @ DUP NULL ABORT" No more links"
     DUP CDR FREE-LINK !  ( unlink top cell)  ;

\ CONS is the fundamental LIST contructor
\ add a link whose CAR (1st list item)  points to the value
: CONS  ( ^value list -- list')  GET-CELL  DUP >R 2!  R>  ;

\ create a stack to save data stack position.
\ With this stack we can nest list creation (I hope)
20 LIFO: LISTSTAK

\ '(  )' TICK brackets count items on DATA stack and builds a list
: '(   ( -- ) SP@ LISTSTAK PUSH  ;  \ start a list. record DATA stack position

: ITEMS  ( -- n) LISTSTAK POP  SP@ - 2/ 2- ;  \ count items from '{

: BUILDLIST ( addr1...addrn -- ) ITEMS 0 ?DO  CONS  LOOP ;

: )'   ( -- )  NIL BUILDLIST ;

\ compile a string in Forth dictionary, return address
: "   ( -- $addr ) [CHAR] " WORD DUP C@ 1+ ALLOT ALIGN ;

\ ===[ list operations ] =======================
: LENGTH  ( list -- n)  \ finds the number of items in a list.
    0 ( accumulator)
    BEGIN OVER NOT-NULL
    WHILE
       1+
       SWAP CDR SWAP
    REPEAT
    NIP  ;

: UWITHIN  ( address low-bound high-bound -- f) 
\ true if low-bound U<= address U< hi-bound.
   >R OVER  R> U< -ROT  U< NOT AND  ;

: LISTP  ( addr -- ?)
\ true if the address argument is a list or NIL
  DUP  LINKS  [ LINKS LINKSIZE + ] LITERAL  UWITHIN
  IF  CDR 0 <>  ELSE  NULL  THEN  ;

DECIMAL

: .$    ( addr -- ) COUNT TYPE ;

: .CAR ( addr -- )
        DUP LISTP IF CAR THEN
        DUP NULL IF  ." ()"  ABORT THEN
        SPACE .$ SPACE ;


: ?LIST ( list -- )  \ TRAP if not a list
        DUP LISTP NOT ABORT" Not a list" ;

: .LIST ( list --) \ prints a list of literal symbols.
        ?LIST
        CR ." ("
        BEGIN
           DUP NOT-NULL
        WHILE
           DUP .CAR
           CDR
        REPEAT
        DROP ." )"  ;


: NTH  ( list n -- list)
       ?DUP           \ dup if n<>0
       IF             \ if n<>0
         0 ?DO
            CDR       \ traverse list 'n' times
         LOOP
       THEN  ;        \ then get the pointer to data

: .NTH  ( list n -- ) NTH  .CAR ;

: REVERSE  ( list -- new-list)
\ copies a list reversing the top-level only.
  NIL  SWAP
  BEGIN DUP NOT-NULL
  WHILE
     DUP  CAR  ROT CONS   ( create a new list with CONS)
     SWAP CDR
  REPEAT
  DROP  ;

:  LAST  ( list -- list') \ returns last link of given list as a list.
  DUP NOT-NULL
  IF  DUP LISTP  NOT ABORT" Can't LAST"
      BEGIN  DUP CDR
        NOT-NULL
      WHILE
        CDR
      REPEAT
  THEN  ;

:  APPEND  ( list1 list2 -- list1+list2)
\ appends two lists.  The originals are "surgically" joined
   OVER LISTP  OVER LISTP  AND NOT ABORT" Can't APPEND"
   DUP  NULL
   IF  DROP
   ELSE
        OVER NULL
        IF  NIP
        ELSE   OVER LAST !
        THEN
   THEN  ;

: LERASE ( list -- ) \ erases, but does not return links to pool... YET
        BEGIN
           DUP CDR NOT-NULL
        WHILE
           DUP CAR OFF
           CDR
        REPEAT
        CAR OFF  ;

\ create a "list" variable that is linked to other list variables
  VARIABLE LASTLIST
: VARLINK  ( addr -- ) LASTLIST @ ,  LASTLIST ! ;

: LIST-VAR      CREATE  NIL , HERE VARLINK  ;

\ list-value returns the list address like a VALUE. Set them with TO
: LIST-VALUE   CREATE      , HERE CELL+  VARLINK
               DOES> @ ;

\  Manually Construct a list with CONS and a list "variable"
LIST-VAR VEHICLES
 " AUTOMOBILE" " BOAT" " PLANE" NIL CONS CONS CONS VEHICLES !

NIL LIST-VALUE ANIMALS
NIL LIST-VALUE PRESIDENTS

\ Example Lists
 '( " GOAT"  " CAT"     " DOG"
    " HORSE" " CHICKEN" " MONKEY" )' TO ANIMALS

 '( " LINCOLN" " WASHINGTON" " GROVER"
    " KENNEDY" " OBAMA"      " TRUMP" )' TO PRESIDENTS

\ alternative way to make and assign a list-value
 '( " APPLE"   " BANANA"  " CRANBERRY"
    " DURIAN"  " GUAVA"   " PEAR" )' LIST-VALUE FRUIT

And here are the executable lists compile a Forth word, and put the Execution tokens (ie: code field address) into lists in the pool.

Execute-list traverses the list and executes whatever code was compiled. :)  In this case just dot-quote.


 : (:    :NONAME  ;
 : ;)    POSTPONE EXIT  REVEAL  POSTPONE ;  ?CSP ;  IMMEDIATE

: ?FORTH    ( n -- ) 
            DUP  LINKS [ LINKS LINKSIZE + ] LITERAL UWITHIN ABORT" Not Forth" ;

: EXECUTE-LIST  ( list -- )
        ?LIST
        CR ." ("
        BEGIN
           DUP NOT-NULL
        WHILE
           DUP CAR ?FORTH EXECUTE
           CDR
        REPEAT
        DROP ." )"  ;


 '( (: ." String1" ;)
    (: ." String2" ;)  )'   LIST-VALUE Q

 

EXECUTELIST.jpg

  • Like 1
Link to comment
Share on other sites

Camel99 V2.59

 

Here is the version I have been working with for over a month or so with the library files on DSK1 as I used them.

It seems pretty stable.

 

It's more of a maintenance update:

  • Improved speed of number conversion.  ?NUMBER has been removed and replaced with NUMBER?
  • Simplified interpret loop.  Shortened some names to save bytes :
    • <INTERPRET> became <INTERP>
    • Interpret vector name changed from 'INTERPRET to 'IV
  • Added word PERFORM (Forth 2012) which works like @ EXECUTE, but in CODE.
  • Stole 80 bytes from the HEAP for a buffer for INCLUDED. Save code space of MALLOC/MFREE but used data space. Oh well.
  • Removed MALLOC/MFREE from the kernel. INCLUDE DSK1.MALLOC  if you need it.
    • No longer need in kernel with new scroll routine.
  • Simplified BEGIN/WHILE loops. Had doubled up the compile time testing. Fixed that.
  • Kernel compiles with FILESYSY.HSF that created INCLUDED without MALLOC
  • WITHIN is now a CODE word but only 2 bytes bigger than Forth version. Less registers, more *SP made it smaller.
  • '=' and '0=' sped up because these are used more frequently.
  • Added FORGET.  DSK1.FORGET loads with DSK1.TOOLS now *edit

CAMEL259.ZIP

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

I should add a note about ?NUMBER vs NUMBER? in case anyone wants to use it.  I changed this in Camel Forth because the original was quite big and therefore slow.

NUMBER? also let me streamline the logic in the INTEPRETER loop because it provides the correct logic to use  ABORT"  and words derived from it.

 

?NUMBER  from original Camel Forth has this stack diagram:

: ?NUMBER    ( c-addr -- n      true)  \ good conversion
\                     -- c-addr false)  \ convert error

NUMBER? was created to align more with modern thinking and the use of stack strings ( caddr len) pairs.

It also return a "0" (false) if everything goes well which is more consistent with Modern Forth use of false meaning "there is no error".

 

: NUMBER? ( addr len -- n     false) \ good conversion
\                    -- 0     len  ) \ bad conversion, len is used as a NOT FALSE flag 

 

Link to comment
Share on other sites

GOOD NEWS AND BAD NEWS

 

 

The good news:

  • I have an editor platform that can inhale a 500 line file and works with disk based VIRTUAL memory. :)
  • I have a platform that is stable enough to be improved

The bad news:

  • It is a very naive record based editor so deleting the top line in a 408 line file takes 10 seconds! ?
     

I have used the platform to build a 100 line version that works in RAM and it is ok, but I want to be able to handle big files.

I suspect that even if I use SAMS memory a 500 line file will still be pretty slow.  I should be able to switch the virtual memory blocks with SAMS blocks pretty easily so we shall see.

 

It looks like I will have to have get familiar with the GAP concept for text editors to get more reasonable speed.

 

Something that I like is having the interpreter to allow commands to control the utility functions (PURGE, LOAD, SAVE, SAVEAS etc.)

Below you can see the 10 second delete. :)   I then slide down to the end of the file where deletions are reasonable speed.

  • Like 1
Link to comment
Share on other sites

It turns out that using the SAMS card is rather faster. :)

But I did have to learn about double buffering...

When deleting a record using the BLOCK file method, two adjacent lines that crossed a buffer boundary could never be in the same buffer.

The virtual memory system allocated a new buffer when needed.

Not so when you use a single PAGE of SAMS memory.  This means that to copy line(i+1) to line(i)  you have to first copy line(i+1) somewhere else and copy the "somewhere else" back to line(i). Once I figured that out things worked much better!

 

The little video shows me loading the entire editor file into the editor. You can see how much faster it scrolls through pages.

I didn't demonstrate it before but here you can see something I call a "line-stack".  The line-stack is a clipboard stack.

It's simpler to implement than marking text for copy and paste.

 

When you hit ^Y  we just copy the line onto a VDP stack starting at >1000 and delete the line.

Pressing ^V pastes the top of the line-stack into the editor.

^C copies the line to the line-stack so you can copy to another place. If you need multiple copies of the same line just press ^C multiple times.

 

With SAMS it takes about 3 seconds to delete the top line of the 412 line file. Not great, but I could live with it since most files are much smaller.

The editor compiles to 4K of space mostly because I used large readable word names to help me remember what everything does.

It might a good candidate to be cross-compiled with all the headers removed except the commands and load it as a binary file.

But that's after I am happy with how it works.

 

There are still some things I need to protect, but its starting to feel like an editor now.

 

\ ED99 SAMS memory file editor for CAMEL99 Forth  Brian Fox

NEEDS CASE      FROM DSK1.CASE
NEEDS READ-LINE FROM DSK1.ANSFILES
NEEDS PAGED     FROM DSK1.SAMS
NEEDS RKEY      FROM DSK1.RKEY
NEEDS MALLOC    FROM DSK1.MALLOC
NEEDS -TRAILING FROM DSK1.TRAILING
NEEDS VTYPE     FROM DSK1.VTYPE
NEEDS .R        FROM DSK1.UDOTR

HERE
CR .( ED99 for Camel99 Forth V1.0 ) CR
.( .)
HEX
 01 CONSTANT BLACK   02 CONSTANT GREEN   07 CONSTANT CYAN
 0E CONSTANT GRAY    0F CONSTANT WHITE   03 CONSTANT LTGRN

80 CONSTANT TOPBAR  81 CONSTANT BOTBAR
\ cursor shapes
DECIMAL
95 CONSTANT UNDERLINE
30 CONSTANT BAR
31 CONSTANT BOX
\ screen management & records
 40 CONSTANT WIDTH   \ screen width
 80 CONSTANT #80     \ length of file records
 16 CONSTANT EL/SCR  \ editor lines per screen
128 CONSTANT RECSIZE
512 CONSTANT MAXLINES

\ utility words
: GETXY   ( -- COL ROW)  VROW 2@ ;
: BLANKS  ( adr len -- ) BL FILL ;
: BETWEEN ( n lo hi -- ? ) 1+ WITHIN ;

\ EDITOR variables
HEX
CREATE EROW  0 ,  0 ,     \ hold row and colum as 2variable
EROW CELL+ CONSTANT ECOL  \ name the ECOL variable

VARIABLE SCR
VARIABLE TOPLINE      \ top line of the display
VARIABLE INSERTING
.( .)
\ graphics helpers
HEX
 0800 CONSTANT PDT   \ "pattern descriptor table"

: ]PDT     ( char# -- 'pdt[n])  8* PDT + ;
: CHARDEF  ( addr char# --)  ]PDT 8 VWRITE ;
: HLINE    ( col row char cnt --) 2>R >VPOS 2R> VFILL ;
: COLORS   ( fg bg -- ) SWAP 4 LSHIFT SWAP +  7 VWTR ;

HEX
CREATE DBLN  0000 , FF00 , FF00 , 0000 ,
CREATE SGLN  0000 , 0000 , FF00 , 0000 ,
CREATE VERT  A0A0 , A0A0 , A0A0 , A0A0 ,
CREATE ABOX  FC84 , 8484 , 8484 , 84FC ,
.( .)
HEX
: DEF-CHARS
       DBLN  TOPBAR CHARDEF
       SGLN  BOTBAR CHARDEF
       ABOX    BOX  CHARDEF ;

\ busy spinner ...
VARIABLE SPIN#
CREATE SCHARS   CHAR | C, CHAR / C, CHAR - C, CHAR \ C,
: SPINCHAR ( -- char ) SPIN# @ 1+ 3 AND DUP SPIN# ! SCHARS + C@  ;
: SPINNER  ( -- )      SPINCHAR GETXY >VPOS 2+ VC! ;

\ SCREEN formatting ...
DECIMAL
  VARIABLE LASTLINE
  VARIABLE SOL       \ "start of line"
  VARIABLE LISTLINE  \ VDP address of first line to "list"

: CURSOR   ( char -- ) CURS ! ;
.( .)
DECIMAL
CREATE FILENAME  16 ALLOT  S" DSK1.UNTITLED"  FILENAME PLACE

\ EROW is screen row we are editing,TOPLINE the topline on the screen.
: THEREC#  ( -- n ) EROW @ TOPLINE @ + ; \ the record  we are editing
: .STRING     COUNT TYPE ;
: .FILENAME  ( -- )  0 0 AT-XY FILENAME COUNT VTYPE ;
: .LINE#     ( -- ) 30 0 AT-XY ." Line "  THEREC# 4 .R  ;

: RULER$  ( -- addr len)
S" 0----+----1----+----2----+----3----+----4----+----5----+----6----+----7-" 
;

: .TOPBAR    ( -- ) RULER$ SOL @ /STRING C/L@ MIN C/L@ SWAP VWRITE ;
: .BOTBAR    ( -- ) 0 18 C/L@  BOTBAR HLINE ;
: HEADER     ( -- ) .FILENAME  .LINE# .TOPBAR ;

\ compute address of 128 byte record in any block(n)
: ]RECORD   ( n -- addr) RECSIZE *  PAGED  ;

\ Screen X/Y control uses VDP address
: \home ( -- )  0 2 >VPOS LISTLINE ! ;
: \n    ( -- )  WIDTH LISTLINE +! ;
: WRITELN  ( addr -- ) SOL @ +  LISTLINE @  WIDTH  VWRITE  ;

: LIST ( -- )
        \home
        TOPLINE @ DUP EL/SCR +  SWAP
        DO
           I ]RECORD WRITELN \n
        LOOP
;

.( .)
\ prompt management at bottom of screen
: PROMPT:    ( -- ) 0 19 AT-XY VPOS WIDTH BL VFILL ;

\ HEX
\ : TOUPPER ( c -- c') 5F AND ;
\ : ?YN     ( -- ?)    KEY  TOUPPER [CHAR] Y = ;

DECIMAL
: CLIP ( n n1 n2 -- n1..n2) ROT MIN MAX ;

: ?ERR    ( ERR# $addr len -- )
          ROT ?DUP IF  PROMPT: TYPE .  KEY DROP ABORT THEN ;

: ?OPENERR ( n -- ) ?DUP IF . TRUE ABORT" Open error" THEN ;
: ?R/WERR  ( n -- ) ?DUP IF . TRUE ABORT" R/W error" THEN ;
: ?CLOSERR ( N -- ) ?DUP IF . TRUE ABORT" Close error" THEN ;
.( .)

DECIMAL
: LOADDV80 ( addr len -- )
       2DUP FILENAME PLACE
       DV80 R/O OPEN-FILE ?OPENERR >R
       TOPLINE OFF
       LASTLINE OFF
       BEGIN
         PAD DUP 80 R@ READ-LINE ?R/WERR ( -- pad len ?)
       WHILE
         LASTLINE @ ]RECORD DUP RECSIZE BLANKS
       ( pad len record -- ) SWAP CMOVE  
         SPINNER
         LASTLINE 1+!
       REPEAT
        
       R> CLOSE-FILE ?CLOSERR
;
.( .)
VARIABLE SH   \ save handle var is simpler inside DO/LOOP

: SAVEDV80  ( addr len -- )  \ save block file data, remove trailing zeros
      DV80 R/W OPEN-FILE ?OPENERR SH !
      LASTLINE @ 0
      ?DO
         I ]RECORD #80 -TRAILING 1 MAX  SH @ WRITE-LINE ?R/WERR
        SPINNER
      LOOP
      SH @ CLOSE-FILE ?CLOSERR
;
.( .)
\ cursor movement
DECIMAL
: HOMECURS   ( -- )   0 0 EROW 2! ;
: COL&ROW    ( -- ecol erow) EROW 2@ 2+ ; \ Editor's X,Y on vdp
: PUTCURS    ( -- ) COL&ROW  AT-XY  ;

: [CURS]RECORD  ( -- ) THEREC# ]RECORD ;

: EDLINE    ( -- addr len ) [CURS]RECORD  RECSIZE ;

: BLKCURS   ( -- n ) ECOL @  SOL @  + ;  \ cursor pos. in record
: 'CHAR     ( --  adr ) [CURS]RECORD BLKCURS + ; \ address in disk block
: !CHAR     ( n -- )   'CHAR C!    ;
: 'EOL      ( -- adr )  EDLINE 1- + ;    \ End of Line address

: RIGHTSIDE ( -- addr len) EDLINE BLKCURS  /STRING ;
: LEFTSIDE  ( -- addr len) EDLINE BLKCURS - ;

: 'SCRPOS ( -- vdpaddr) COL&ROW >VPOS  ;

: RELINE    ( -- )
         RIGHTSIDE DROP        ( -- addr )
         WIDTH ECOL @ -        ( -- addr bytestoend)
         'SCRPOS               ( -- addr bytestoend vdpaddr)
         SWAP VWRITE
         PUTCURS ;
.( .)
: REDRAW    ( -- ) .TOPBAR .LINE# LIST PUTCURS ;

\ create left/right scrolling of of the text window
: SOL+!      ( n -- ) SOL  @ +  0 WIDTH CLIP  SOL ! ; \ 0..79 virtual screen width
: HORIZONTAL ( n -- ) SOL+!  .TOPBAR LIST ; \ +n  slide right, -n slide left
: TOPLINE+!  ( n -- ) TOPLINE @ +   0 MAXLINES 15 - CLIP   TOPLINE ! ;
: LASTLINE!  ( -- ) LASTLINE @  THEREC# MAX  LASTLINE ! ;

\ decrement a varible, clip at zero
: SAFE-! ( n addr -- ) TUCK @ SWAP - 0 MAX SWAP ! ;

: LEFT  ( -- ) \ automatically scrolls screen if at limits
        ECOL 1 OVER SAFE-!
        @ 0=  IF -1 HORIZONTAL     THEN RELINE ;

: RIGHT ( -- )
        ECOL 1+@ 39 >
        IF  1 HORIZONTAL  39 ECOL ! THEN RELINE ;

: +LINE ( -- )
       EROW DUP @ 1+ SWAP !
       EROW @ 15 >
       IF   1 TOPLINE+!  15 EROW !
       THEN LASTLINE!  REDRAW ;

: -LINE ( -- )
       EROW 1 OVER SAFE-!
       @ 0= IF -1 TOPLINE+! THEN REDRAW ;

: -TAB  ( -- ) ECOL  -8 HORIZONTAL REDRAW ;
: +TAB  ( -- )
       ECOL 8 OVER +!
       @ 39 > IF 8 HORIZONTAL  39 ECOL !  THEN REDRAW ;

: TOSTART ( -- ) ECOL OFF  SOL OFF  REDRAW ;
: TOEND   ( -- ) [CURS]RECORD #80 -TRAILING NIP  ECOL ! REDRAW ;
: ENTER   ( -- ) +LINE TOSTART ;

.( .)
\ page movement
: PGUP  ( -- )  -16 TOPLINE+!  REDRAW ;
: PGDN  ( -- )
        LASTLINE @ THEREC# 1+ <
        IF  HONK  ELSE  16 TOPLINE+!  REDRAW THEN ;

\ EDITOR functions
DECIMAL
.( .)
: WRITECHAR  ( c -- ) DUP !CHAR EMIT RIGHT ;

: DELCHAR    ( -- )
     RIGHTSIDE  1 /STRING  \ cut 1st char of RIGHTSIDE, tuck length
     'CHAR SWAP MOVE       \ write buffer back to CURSOR position
     RELINE   
;

: PUSHRIGHT ( -- )
     RIGHTSIDE PAD PLACE
     PAD COUNT 'CHAR 1+ SWAP 1- MOVE  \ write back at 'CHAR+1
     BL !CHAR                         \ blank at cursor position
     RELINE   
;

.( .)
HEX
: TOGGLE  ( -- )
          INSERTING DUP DUP @ -1 XOR  SWAP !
          @ IF BAR CURSOR
               BLACK LTGRN COLORS PROMPT: ." Inserting"

          ELSE BOX CURSOR
               BLACK GREEN COLORS PROMPT: ." Overwrite"
          THEN PUTCURS ;

DECIMAL
: BSPACE  ( -- )
          LEFT
          INSERTING @
          IF    DELCHAR
          ELSE  BL DUP  !CHAR EMIT
          THEN  PUTCURS ;

: ESCAPE  ( -- )
          BLACK CYAN COLORS
          PROMPT: ." Forth ok"
          [CHAR] _ CURSOR
          CR QUIT ;

\ clipboard is a stack of lines in VDP RAM
HEX
1000 CONSTANT CLIPBASE     \ start of clipboard

DECIMAL
: VMALLOC   ( n -- addr ) VP +! VP @ ;
: VFREE     ( -- ) VP @ DUP #80 - CLIPBASE MAX VP !  ;

: SAVE-LINE ( -- )  [CURS]RECORD #80 VMALLOC #80 VWRITE ;

: DEL-LINE  ( -- )
            LASTLINE @ 1+  THEREC#
            ?DO
            \ need to double buffer paged records
               H @ 
               I 1+ ]RECORD OVER #80 CMOVE
               ( heap) I ]RECORD #80 CMOVE
               SPINNER
            LOOP
            LASTLINE @ ]RECORD #80 BLANKS
            1 LASTLINE SAFE-!
            REDRAW ;

: CUT     ( -- ) SAVE-LINE  DEL-LINE ;

: INSRT-LINE ( -- )
            LASTLINE 1+!
            THEREC# LASTLINE @
            ?DO
               H @
               I ]RECORD OVER #80 CMOVE
               I 1+ ]RECORD #80 CMOVE
               SPINNER
            -1 +LOOP
            [CURS]RECORD #80 BLANKS   RELINE
            REDRAW ;

: PASTE    ( -- )
           VP @ DUP CLIPBASE >
           IF   INSRT-LINE [CURS]RECORD #80 VREAD  RELINE  VFREE
           ELSE  DROP HONK
           THEN ;

.( .)
HEX
: KEYHANDLER ( char -- ) \ TI-99 BASIC key codes used
       CASE
         01 OF  +TAB              ENDOF  \  TAB
         B7 OF  -TAB              ENDOF  \ ^TAB
         02 OF  PGDN              ENDOF  \ FCTN 6
         03 OF  DELCHAR           ENDOF  \ PC Delete / FCTN 1
         04 OF  TOGGLE            ENDOF  \ PC Insert / FCTN 2
         06 OF  INSRT-LINE        ENDOF  \ FCTN 8
         07 OF  DEL-LINE          ENDOF  \ FCTN 3
         08 OF  LEFT              ENDOF  \ FCTN S
         09 OF  RIGHT             ENDOF  \ FCTN D
         0A OF  +LINE             ENDOF  \ FCTN X
         0B OF  -LINE             ENDOF  \ FCNT E
         0C OF  PGUP              ENDOF  \ FCTN 4
         0D OF  ENTER             ENDOF  \ ENTER
         0F OF  ESCAPE            ENDOF  \ Esc
         80 OF   1 HORIZONTAL     ENDOF  \ ^>
         83 OF  SAVE-LINE         ENDOF  \ ^C
         84 OF  TOEND             ENDOF  \ ^D
         9B OF  -1 HORIZONTAL     ENDOF  \ ^<
         93 OF  BSPACE            ENDOF  \ ^backspace
         95 OF  TOSTART           ENDOF  \ ^U / PC Home
         96 OF  PASTE             ENDOF  \ ^V
         99 OF  CUT               ENDOF  \ ^Y
                HONK                     \ key not found
       ENDCASE
;
.( .)
\ EDITOR COMMANDS
DECIMAL
: PARSE-PATH  ( -- addr len)
               BL PARSE-WORD  2DUP [CHAR] . SCAN NIP
               0= ABORT" '.' Path expected" ;

: .LINES ( -- ) CR LASTLINE @ . ."  lines" ;
: (SAVE) ( -- ) FILENAME COUNT SAVEDV80 .LINES ;

: SAVE   ( -- ) BL PARSE-WORD NIP 0> ABORT" Use SAVEAS command" (SAVE) ;
: SAVEAS ( -- ) PARSE-PATH FILENAME PLACE  (SAVE) ;

.( .)
DECIMAL
: DRAW.SCR ( scr# -- )  PAGE  HEADER  .BOTBAR ;

: (PURGE) ( -- )
       ." Purging "
       16 0
       DO
         I 4K * PAGED 4K BLANKS
         SPINNER
       LOOP
       TOPLINE OFF   LASTLINE OFF
       S" DSK1.UNTITLED" FILENAME PLACE ;

: PURGE ( -- ) (PURGE) DRAW.SCR PROMPT: ." Ready" ;

: LOAD   ( -- ) (PURGE) ." Loading" PARSE-PATH LOADDV80 .LINES ;

: EDIT ( -- )
       DECIMAL
       DEF-CHARS
       BLACK GREEN COLORS
       DRAW.SCR
       INSERTING ON  TOGGLE
       BOX CURSOR
       CLIPBASE VP !  \ set clipboard base in VDP RAM
       SAMS-ON
       LIST
       BEGIN
          RKEY DUP
          BL [CHAR] ~ BETWEEN
          IF   INSERTING @ IF PUSHRIGHT   THEN WRITECHAR
          ELSE KEYHANDLER
          THEN
       AGAIN  ;

CR .( ED99 loaded. ) HERE SWAP - DECIMAL .  .( bytes used)
( SAMSINI) SAMS-ON  PURGE

 

 

 

 

Edited by TheBF
fixed spoiler
  • Like 3
Link to comment
Share on other sites

Now it's getting fun.

 

Armed with a stable platform I wondered about features...

My SAMS implementation divides the card up into 64K segments. Intel 8086 kind of thinking. With 16 bit integers by default it was simplest to work that way.

There is a variable called SEG which holds the SEGMENT that is in use.  With SEG as an index I can manage the editor state for multiple files! :)

 

Since Forth's variables return addresses (ie: are pointers)  all I need to do is re-write the editors variables as arrays that are indexed by the SEG variable and I have it.

The code addition was just this:

\ Multiple file manager indexed via the SEG variable in SAMS.
\ SAMS implementation uses only SEGMENTS 1..15
\ SEG variable indexes into FILENAMES and LASTLINES
DECIMAL
CREATE FILENAMES  \ counted strings 15 bytes + COUNT BYTE
       S" DSK1.UNTITLED  " S, \ SEG=0 NOT USED
       S" DSK1.UNTITLED  " S,
       S" DSK1.UNTITLED  " S,
       S" DSK1.UNTITLED  " S,
       S" DSK1.UNTITLED  " S,
       S" DSK1.UNTITLED  " S,

CREATE LASTLINES
       0 ,   \ SEG=0 NOT USED
       0 , 0 , 0 , 0 , 0 ,

: LASTLINE ( -- addr)  SEG @ CELLS LASTLINES + ; \ like a variable
: FILENAME ( -- caddr) SEG @ 16 *  FILENAMES + ; \ like a variable

I will also need to do the same thing for the for the editor's cursor variables and the current line# to restore the entire state of the editor for each file.

Having a mega-byte of memory lying around is pretty cool.  ?

Once I add selector keys to the KEYHANDLER it will switch to different files instantly.

Link to comment
Share on other sites

Happy St. Virus  Patrick's  Day everyone :)

All bars in the province of Ontario (~14,000,000 people) are closed today for an indefinite time... :(

 

In the course of working on this editor. I have been plagued with a bug in my repeating key. I could not see it in a simple test and it only happened inside the editor very very infrequently. 

I was so frustrated I went back to the sacred scriptures. http://www.unige.ch/medecine/nouspikel/ti99/titechpages.htm

 

CONTENT REMOVED. I spoke too soon.

 

 

 

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

Be careful with Machine Code...

In the process of working on this editor I discovered in the translation of my SAMS code from ASM to Machine code I did not replace a numeric address with it's variable name.

When the file loaded at a different address of course the variable was in a different place. Made some weird bugs...  That goodness for the Classic99 Debugger. (again)

 

The repeating key is is better but I still don't trust it 100%.

I now have an editor that can simultaneously load and edit 10 files of 512 lines with a 100 line VDP line-stack for cutting and pasting. The video shows it in operation.

 

The editor commands available are:

  • SAVE          saves with the existing file name
  • SAVEAS      save with a new filename
  • SAVEALL     save all files that are not empty
  • PURGE        purge the current file slot
  • PURGEALL   purge all 10 slots
  • LOAD         load file name into current slot
  • /LOAD       "1 /LOAD DSK1.MYFILE"   load a file into given slot number
  • EDIT         edit the current file slot
  • /EDIT        "1 /EDIT"   edit the file in the given file slot

    The editor is a monster at 460 lines. It compiles to over 4100 bytes (not including the library code)

I had the challenge of managing a number of variables that control the state of the editor.

The normal way would be to make a data structure for each file. I think in Forth it was simpler to create a new kind of variable called an EVAR:

An EVAR: is actually 10 variables that are indexed by a variable called SEG which controls the 64K SAMS segment that is active.

So all I did after defining the EVAR: was redefine all the relevant VARIABLEs   as EVAR:s.

\ EVARS can hold 10 different values. One for each SAMS segment
: EVAR:      \ unused   1   2   3   4   5   6   7   8   9  10
        CREATE    0 ,   0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
        DOES>  SEG @ CELLS +  ( -- addr) ;

EVAR: LASTLINE
EVAR: TOPLINE
EVAR: SOL     \ start of line
EVAR: EROW
EVAR: ECOL

 

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

While I wait to get a Windows machine up and running again I thought I would share something that came from fixing the bugs in my SAMS code.

Previously I had separated the code into two routines. One that computed the correct BANK# to swap into CPU ram for a given address and also returning the offset into the CPU page.

CODE >BANK  ( addr -- offset bank# )
       R0  4K LI,      \ 4K divisor ->R0
       TOS R5 MOV,     \ address to r5
       SEG @@ TOS MOV, \ segment to TOS
       R0 TOS DIV,     \ unsigned division
       R5 PUSH,
       NEXT,           \ return 
       ENDCODE

The other routine tested if the BANK# was already mapped into memory and if not, it mapped it in.

The two words were connected together by passing parameters on the Forth data stack so it was trivial to remove that overhead by simple removing some lines of text.

This gives us a faster version of 'PAGED'.   So this routine takes any 64K address put into R4 and returns the address in your paged memory in R4.

Although it uses division it's still pretty fast.   The design goal was to use 16bit addresses only and a segment variable 'SEG' that you use to select other 64K segments in the SAMS space.  It seemed simpler that working with 32bit addresses on the 9900.

 

It requires two variables and two constants in the code below

(For ASM coders: CONSTANT is like EQU,  VARIABLE is just:   "<LABEL> DATA  0000" )

HEX
1000 CONSTANT 4K         \ bytes per bank = 4K
3000 CONSTANT PMEM       \ paged memory block location
     VARIABLE BANK#      \ current mapped bank
     VARIABLE SEG        \ sets the 64K segment currently in use

 

For Assembly language coders TOS is just R4 and PUSH could be replaced with a save to another register  or save to memory as you see fit.

       
CODE PAGED  ( addr -- addr') \ convert 64K address to a mapped address
       R0  4K LI,      \ 4K divisor ->R0
       TOS R5 MOV,     \ address to r5
       SEG @@ TOS MOV, \ segment to TOS
       R0 TOS DIV,     \ TOS has the BANK# we need
       R5 PUSH,        \ remainder has the offset. save it
       TOS BANK# @@ CMP,  
       EQ IF,
             TOS POP,          \  skip it, page is already mapped
       ELSE, 
             TOS BANK# @@ MOV, \ map in the page
       		 TOS SWPB,
             R12 1E00 LI,
             0 SBO,
             TOS 4006 @@ MOV,
             0 SBZ,
             TOS POP,
       ENDIF,
       TOS PMEM AI,    \ Add the offset to page memory address (>3000)
       NEXT,           \ return to Forth
       ENDCODE

EDIT:  LOL. I realized it could simplfied...

CODE PAGED  ( addr -- addr') \ convert 64K address to a mapped address
       R0  4K LI,      \ 4K divisor ->R0
       TOS R5 MOV,     \ address to r5
       SEG @@ TOS MOV, \ segment to TOS
       R0 TOS DIV,     \ TOS has the BANK# we need
       R5 PUSH,        \ remainder has the offset. save it
       TOS BANK# @@ CMP,  
       NE IF,
             TOS BANK# @@ MOV, \ map in the page
       		 TOS SWPB,
             R12 1E00 LI,
             0 SBO,
             TOS 4006 @@ MOV,
             0 SBZ,
       ENDIF,
	   TOS POP, 
       TOS PMEM AI,    \ Add the offset to page memory address (>3000)
       NEXT,
       ENDCODE

 

Edited by TheBF
Simpler version.
Link to comment
Share on other sites

  • 2 weeks later...

It's been so long since I built up a new Windows machine I forgot what a pain in the tuchie it is. :)

I am making progress.  I want to finish that editor and get all my changes published on Github.

 

Wash your hands and stay at home.

SARS-CV2 can kiss my Royal Canadian A** ! :) 

  • Like 1
Link to comment
Share on other sites

The new machine is mostly up and running. ? It's got 16Gb of RAM so it seems much snappier on 64bit Win OS.

I still need to look into what it takes to get Microsoft Office back. 

Never did much with the MS store except buy a copy a few years back. We shall see.

 

The good news about blowing up a machine is that I did some housekeeping.  There was a lot of old cruft lying around.

 

I took a minute to re-write and test that SAMS pager above. This code works and is even faster than my first version.

I am assuming that it is faster to not swap in a page if it is already in memory since it takes 6 less instructions versus adding one compare and one jump.

 

HEX
     VARIABLE BANK#      \ current mapped bank
1000 CONSTANT 4K         \ bytes per bank = 4K
3000 CONSTANT PMEM       \ paged memory block location
     VARIABLE SEG        \ holds current 64K segment

CODE PAGED  ( addr -- paged_address )
       R0  4K LI,         \ 4K divisor ->R0
       TOS R5 MOV,        \ address to r5
       SEG @@ TOS MOV,    \ segment# to R4,
       R0 TOS DIV,        \ TOS=bank#, R5=offset
       TOS BANK# @@ CMP,  \ switch page ?
       NE IF,
            TOS BANK# @@ MOV, \ YES, update BANK#
            TOS SWPB,
            R12 1E00 LI,      \ select SAMS
            0 SBO,            \ card on
            TOS 4006 @@ MOV,  \ map the page
            0 SBZ,            \ card off
       ENDIF,
       TOS PMEM LI,           \ page_mem->tos
       R5  TOS ADD,           \ add computed offset into page
       NEXT,
       ENDCODE

Some may not agree with using division but I think it is going to be as fast as working out the bank# and offset using bit banging because of the extra instructions.  If someone has faster way to divide by >1000 returning a dividend and a remainder I would benchmark it.

 

Here is the test code. Using these PAGE memory operators in a 64K Forth loops are about 35%  18% slower than using normal un-paged memory operators. Not too bad.

\ paged memory fetch and store
: C@P    ( addr -- n)    PAGED C@ ;   \ fetch a byte
: C!P    ( n addr -- )   PAGED C! ;   \ store a byte
: @P     ( addr -- n)    PAGED @ ;    \ fetch an int
: !P     ( n addr -- )   PAGED ! ;    \ store an int

HEX
\ test code
: ?BREAK   ?TERMINAL ABORT" BREAK" ;
 : LOADSAMS     FFFF 0 DO   I  I !P      2 +LOOP ; \ 17 secs
 : READSAMS     FFFF 0 DO  I @P .  ?BREAK   2 +LOOP ;

 

 

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

I got a nice surprise today while working on my editor.  My data structures and screen handling work for 40 column and 80 column modes.

If you include DSK1.80COL and then compile the editor it just works.

I have not fully beat-up the 80 column compile but it seems good so far.

 

I spent way to much time fighting with the repeating key routine. Just when I thought it good I would get random character on the screen while flying the cursor around the screen.  It seems solid now after my latest change which just forces a screen write of the correct character.

 

The photos show the editor in both modes and the black screen shows it compiling in 80columns.

It takes  57 seconds to build this darn thing. :)  That is about 800 lines of code.

ED99_40COL.jpg

ED99_80COL.jpg

ED99_80COL_COMPILE.jpg

  • Like 1
Link to comment
Share on other sites

22 hours ago, TheBF said:

Some may not agree with using division but I think it is going to be as fast as working out the bank# and offset using bit banging because of the extra instructions.  If someone has faster way to divide by >1000 returning a dividend and a remainder I would benchmark it.

 

How about this (untested):

HEX
     VARIABLE BANK#      \ current mapped bank
3000 CONSTANT PMEM       \ paged memory block location
     VARIABLE SEG        \ holds current 64K segment

CODE PAGED  ( addr -- paged_address )
       SEG @@ R0 MOV,     \ segment# to R0
       R0 4 SLA,          \ page# segment starts
       TOS R5 MOV,        \ address to R5
       R5 0FFF ANDI,      \ page offset
       TOS 0C SRL,        \ page of current segment
       R0 TOS A,          \ bank#
       TOS BANK# @@ CMP,  \ switch page ?
       NE IF,
            TOS BANK# @@ MOV, \ YES, update BANK#
            TOS SWPB,
            R12 1E00 LI,      \ select SAMS
            0 SBO,            \ card on
            TOS 4006 @@ MOV,  \ map the page
            0 SBZ,            \ card off
       ENDIF,
       TOS PMEM LI,           \ page_mem->tos
       R5  TOS A,             \ add computed offset into page
       NEXT,
       ENDCODE

 

The first 6 instructions above replace your first 4 and obviated the need for the 4K constant. Perhaps I am wrong, but I changed your ADD, to A, in the above. 

 

...lee

              [ EDIT: Corrected “TOS 12 SRL,” to “TOS 0C SRL,”. Also, the line above it. Sorry—I was in full Assembler mode at the time. |:) ]

Edited by Lee Stewart
Link to comment
Share on other sites

1 hour ago, Lee Stewart said:

 

How about this (untested):


HEX
     VARIABLE BANK#      \ current mapped bank
3000 CONSTANT PMEM       \ paged memory block location
     VARIABLE SEG        \ holds current 64K segment

CODE PAGED  ( addr -- paged_address )
       SEG @@ R0 MOV,     \ segment# to R0
       R0 4 SLA,          \ page# segment starts
       TOS R5 MOV,        \ address to R5
       R5 >FFF ANDI,      \ page offset
       TOS 12 SRL,        \ page of current segment
       R0 TOS A,          \ bank#
       TOS BANK# @@ CMP,  \ switch page ?
       NE IF,
            TOS BANK# @@ MOV, \ YES, update BANK#
            TOS SWPB,
            R12 1E00 LI,      \ select SAMS
            0 SBO,            \ card on
            TOS 4006 @@ MOV,  \ map the page
            0 SBZ,            \ card off
       ENDIF,
       TOS PMEM LI,           \ page_mem->tos
       R5  TOS A,             \ add computed offset into page
       NEXT,
       ENDCODE

 

The first 6 instructions above replace your first 4 and obviated the need for the 4K constant. Perhaps I am wrong, but I changed your ADD, to A, in the above. 

 

...lee

Cool!  I will give it a try.  

I took some liberties with the assembler Mnemonics so mine says ADD,   (what a shock) :) 

 

Thanks

Link to comment
Share on other sites

I made your version as >PAGED to have a different name.

I measured them with the 9901 timer like this:  (it tests the literal parameter passed to the routine of course but that's reality)

: TEST1 ( -- n)  TMR@ D000   PAGED TMR@ NIP - ;

: TEST2 ( -- n)  TMR@ D000 >PAGED TMR@ NIP - ;

These both returned the value 13 the 1st time and 11 the 2nd time after the page is already in memory.

That converts to 276.9 uS and 234.3 uS

On modern processors this would probably be a win for your version but the 9900 sucks up a lot of cycles for even simple instructions. 

It was worth a try.

Link to comment
Share on other sites

It's also starting to look like there is little point in testing for BANK# in memory.

Using my version and this 32Kword load routine, It 13.98 seconds with no comparison and 13.41 seconds with the bank# comparison.

 : LOADSAMS     FFFF 0 DO   I  I PAGED !   2 +LOOP ; 

So the inner interpreter swamps the differences. Probably better to go with less space and simplify.

Link to comment
Share on other sites

4 minutes ago, Lee Stewart said:

Oops! I screwed up the code. As noted in the corrections in my post above, I was in full Assembler mode at the time!

 

...lee

I got it to work ok. No worries.

You gave the disclaimer. "Not tested"

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