Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

Yeah, I believe his colors represent what's going on at the moment kinda thing. As, compiled words are a color, remarks are a color, etc...

I just thought it gives something extra to the OS that, I believe, for newbies would be a visual aid.

Me, I just see red, error!!!!!

  • Like 1

Share this post


Link to post
Share on other sites
1 hour ago, TheBF said:

It would be trival to compile a new kernel that boots in Graphics mode if you want one. That would not give you COLOR Forth however.

The compiler loop must be changed to read the color of the text to determine what's going on in the code. Not really hard to do but it will require that I understand what COLOR Forth actually does.  :)   I think we would need to add some magic key code as well to control the text color.  Chuck originally developed Color Forth to use a 3 button mouse as the keyboard enhancement and he memorize the binary codes for 0 to 7 to control colors (It was something like that. I don't remember the exact detail)

 

Definitely need to grok the details, but, if it requires changing letters to any arbitrary color, Graphics mode cannot do that. Changing the color of any letter affects all 8 contiguous characters of the character set of which that character is a member.

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites

Good point.

 

So a solution might be to create new fonts that are in contiguous color sets and then convert from ASCII to the new values when displaying to the screen.

I saw this kind of thing in XB256 project I think.  I assume this is how they got 6 upper case fonts in different colors. (?)

 

Total pain in the tushy to code it up but it might work... eventually :) 

 

  • Like 2

Share this post


Link to post
Share on other sites
1 hour ago, GDMike said:

Or, just thinking out loud, setting a color of a space character preceding the word. 

Yes, but that would be GDColorForth. :)

 

  • Haha 1

Share this post


Link to post
Share on other sites

Multi-User Platform Concept Test on TI-99 with SAMS

 

It works!  

I modified my multi-tasking file MTASK99 to make a multi-user version and it actually works.

It uses a partial memory swapper for the HI RAM from B000...FFFF.

The second process starts its own local Forth dictionary at B000 by default.

The second process has it's workspace in a shared block of memory at >2000 at this time. 

 

The test code is simply filling memory in the 2nd process at various address BUT it is NOT colliding with the primary Forth task because the context switcher is paging SAMS memory in and out for each context switch. :) 

 

The new word added is PROCESS:  ( map[] -- )   which needs the address of the MAP array. PROCESS: makes a 256 byte workspace for each new process, sets the local MEM variable to the array address and sets the local dictionary pointer to >B000.  This means the local process can compile code from B000 to FF00 and has it's own local terminal input buffer at FF00.  

 

It's a good beginning.  :) 

I made a video on my phone of this running, but it is 47Mbytes so I won't upload it. You will have to take my word for it.

 

Code for the second process.  Note:  MS below is passing control back to Forth while it waits. 

\ mtask demo
NEEDS PROCESS: FROM DSK1.MUSER99

INIT-MULTI

MAP1 PROCESS: USER1

HEX
: PROCTEST  \ write to local memory pages
         BEGIN
           100 0
           DO
              B000 100 I FILL  100 MS
              C000 100 I FILL  100 MS
              D000 100 I FILL  100 MS
           LOOP
           PAUSE
         AGAIN ;

' PROCTEST USER1 ASSIGN

 

New MUSER99 file:

Spoiler
\ MUSER99.HSF for CAMEL99                       16AUG2020 Brian Fox
\ Multi-user system for SAMS Memory Card

\ NEEDS DUMP  FROM DSK1.TOOLS
NEEDS MOV,  FROM DSK1.ASM9900
NEEDS MALLOC FROM DSK1.MALLOC

\ Each task has a Process ID (PID)
\ In this system we use the workspace address as the PID
\ Each task swaps out HEX B000..FFFF for a task
HEX
CODE MYSELF  ( -- pid)
     0646 , \    *SP DECT,  ( make room on stack)
     C584 , \ TOS *SP MOV,  ( push TOS reg.)
     02A4 , \    TOS STWP,  (fetch the cpu WP register to Forth TOS)
     NEXT,
    ENDCODE

MYSELF CONSTANT USER0    \ USER0 is the main Forth task workspace (>8300)

\ Extended "workspace" is 256 BYTES (>100)
\ Each workspace includes registers, user variables
\ the data stack & return stack.
HEX 100 CONSTANT USIZE

DECIMAL
\ name the CPU register addresses in a task's workspace
  12 USER 'SP             \ the task's Forth SP register ( R6)
  14 USER 'RP             \ the task's Forth RP register ( R7)
  18 USER 'IP             \ the task's Forth IP register ( R8)
  20 USER 'R10            \ address of R10 (holds the NEXT routine)

\ rename registers 13,14,15, used by RTWP to change context
  26 USER TLINK           \ R13 = next task's wksp
  28 USER TPC             \ R14 = next task's program counter
  30 USER TST             \ R15 = next task's status register
HEX

\ SAMS memory manager starts at page >FF. allocation decrements
VARIABLE MP  FF00  MP !  \ 1st SAMS page = >FF

\ Compile next SAMS page into array, decrement Memory pointer MP
: SAMS,    MP @ DUP ,   0100 - MP !  ;

\ create map arrays for 3 users
CREATE MAP0  0B00 , 0C00 , 0D00 , 0E00 , 0F00 , \ pass through values
CREATE MAP1  SAMS,  SAMS,  SAMS,  SAMS,  SAMS,  \ MAP array for USER1
CREATE MAP2  SAMS,  SAMS,  SAMS,  SAMS,  SAMS,  \ MAP array for USER2

\ each user has a variable that points to their MAP array
  6E USER MEM      MAP0 MEM !   \ pass thru pages are default


HEX
CREATE 'YIELD \ *this is the context switcher
\ Address of TSTAT is loaded into R14 of every task. ie program counter)
     BEGIN,
         RTWP,                \ change tasks! 1 instruction
( TSTAT) R1 STWP,             \ get our workspace -> R1
         20 R1 () R0 MOV,     \ fetch TFLAG->R0
     NE UNTIL,               \ if tflag=0 jmp to RTWP
     6E R1 ()  R2 MOV,       \ get MEM map array -> R2
     R12 1E00  LI,
     0 SBO,             \ card on
     R0  4016  LI,      \ HI ram SAMS register for B000
     R2 *+  R0 *+ MOV,  \ MAP B000
     R2 *+  R0 *+ MOV,  \ MAP C000
     R2 *+  R0 *+ MOV,  \ MAP D000
     R2 *+  R0 *+ MOV,  \ MAP E000
     R2 *+  R0 ** MOV,  \ MAP F000
     0 SBZ,             \ card off
     NEXT,              \ run Forth

'YIELD CELL+ CONSTANT 'TSTAT  \ record tstat address as constant

 'R10 @ CONSTANT 'NEXT      \ R10 has the address of Forth NEXT

.( ..)
 DECIMAL
\ PID = process ID.  It is the address of the task's user area memory block
: LOCAL    ( PID uvar -- addr' ) MYSELF - + ;     \ get a task's user var.
: SLEEP    ( PID -- ) FALSE SWAP TFLAG LOCAL ! ;  \ put PID to sleep
: WAKE     ( PID -- ) TRUE  SWAP TFLAG LOCAL ! ;  \ wake up PID

\ turn multi-tasking on or off by changing the CODE address in PAUSE
: SINGLE   ( -- ) 'NEXT  ['] PAUSE ! ;  \ disable multi-tasking
: MULTI    ( -- ) 'YIELD ['] PAUSE ! ;  \ enable multi-tasking.

( *** YOU  M U S T  use INIT-MULTI before multi-tasking ***)
: INIT-MULTI ( -- )
        MYSELF TLINK !    \ Set my TLINK to my own Workspace
       'TSTAT TPC !       \ set my task PC register to TSTAT
        MYSELF WAKE  ;    \ mark myself awake

\ FORK
\ - copy the the calling task's USER area into a new workspace.
\ - SET both stack addresses to the proper registers in the user area,
\ - insert PID into the round-robin list
\ - your program needs to allocate USIZE bytes in heap
\ - the address of your memory block will become the PID.

: FORK ( PID -- )
       DUP >R                               \ copy PID to RSTACK
      ( PID) USIZE 0 FILL                   \ erase new task block
       MYSELF [email protected] USIZE CMOVE                \ copy myself to the new task

       [email protected] USIZE +  ( addr )                 \ calc. end of task block
       DUP [email protected] 'RP LOCAL !                   \ dup & store in local RP
     ( RPaddr) 22 CELLS -                   \ calc. Pstack addr
       [email protected] 'SP LOCAL !                       \ store in local SP register

\ insert this task into round-robin list of tasks
       TLINK @                 ( -- link)   \ get round-robin link
       [email protected] TLINK !                           \ replace with addr of new task
       [email protected] TLINK LOCAL !                     \ store copy in new task's tlink
       R> SLEEP ;                           \ mark this new task as asleep

.( ..)
: JOB->IP ( xt pid -- xt pid)     \ XT -> task's IP register
       DUP JOB LOCAL  OVER 'IP LOCAL ! ;

: ASSIGN ( xt pid -- )
       JOB->IP  JOB LOCAL ! ; \ store the XT in the PID's JOB user var.

: RESTART ( pid -- )
       JOB->IP
       DUP USIZE +  OVER 'RP LOCAL !  \ reset local Rstack
       WAKE ;                         \ pid wake

\ overwrite these commands for mulit-tasking
: COLD  ( -- ) SINGLE  COLD ;  \ stop multi-tasker before quitting Forth
: BYE   ( -- ) SINGLE  BYE ;

HEX
: PROCESS: ( map[] -- )
          USIZE MALLOC  ( -- workspace )
          DUP FORK                 \ copy current workspace
          SWAP OVER MEM LOCAL !    \ set local MEM to map array
          B000 OVER DP LOCAL !     \ set local dictionary pointer to B000
          CONSTANT ;               \ name this workspace

INIT-MULTI
CR .( Multi-tasker initialized)

HEX

 

 

 

  • Like 3
  • Thanks 1

Share this post


Link to post
Share on other sites

Higher Order Function (HOF) for Files

 

A concept of some high level languages is the ability to MAP some computer operation across an entire array of data.

While working on ED99 I found an error in my save-file routine.  The save and load file code is completely different.

I decided to see if I could use the same loop of code for all file operations and that way remove this kind of error.

 

The method is to use a common loop to scan through a file and use a DEFER word to perform the action.

The action can be passed to the common loop as a parameter.  So far it is working to perform the read a file into SAMS and to interpret a file like the config file.

Saving may break the mold because I have to open the file in write mode but this looks promising

 

Spoiler

DEFER MAPACTION     \ what to do with each file record

: MAPFILE ( addr len XT -- ) \ perform XT on all records in file
     IS MAPACTION
     DV80 R/O OPEN-FILE ?FILERR >R
     BEGIN
       PAD DUP 80 [email protected] READ-LINE ?FILERR ( -- pad len ?)
     WHILE
       MAPACTION   \ perform on every record
       SPINNER
       ?BREAK
     REPEAT
     2DROP
     R> CLOSE-FILE ?FILERR
;

: STORE_REC ( addr len -- )
       LASTLINE @ ]RECORD SWAP CMOVE
       LASTLINE 1+! ;

DECIMAL
: LOADDV80 ( addr len -- )
     TOPLINE OFF
     LASTLINE OFF
     ['] STORE_REC MAPFILE
;

: EVAL_REC  ( addr len -- ) EVALUATE   LINES 1+! ;

.( .)
 : LOADFILE ( addr len -- ) \ interprets the ED99CONFIG file
     LINES OFF
     ['] EVAL_REC  MAPFILE ;

 

 

  • Like 1

Share this post


Link to post
Share on other sites

Simplifed ALLOCATE, FREE, RESIZE   in ANS/ISO Forth

 

I was reading a thread in comp.lang.forth about these words and discovered that a lot of people don't bother implementing the most formal interpretation of these words for small systems.

By formal I mean something that would allow allocation, freeing and resizing memory blocks in such a way that there would never be fragmentation. This requires a way to read all the allocations either in a table or as a linked list so you can examine the state of each allocation.

 

However if you don't need all that it becomes quite simple to make simple system that does the same job with the caveat that you have a more static allocation process which is more in line with Forth thinking.

So instead of a full implementation that takes 768 bytes.  Here is one that takes 118 bytes. :)  In fact if you remove the luxury of remembering the size of an allocation it would be even smaller.

This version includes the word SIZE which seems to be commonly written by others.

The Forth variable H is initialized to >2000 when Camel99 Forth starts and is used a the HEAP pointer for the lower 8K RAM.

To reset the heap you would use  HEX 2000 H !  in Forth or make a word to do it.

\ Minimal ALLOCATE FREE RESIZE for Camel99 Forth B Fox Sept 3 2020
\ Mostly Static allocation
HEX
: HEAP,    ( n --) H @ !  [ 1 CELLS ] LITERAL  H +! ;
: ALLOCATE ( n -- addr ?) DUP HEAP, H @   SWAP H +!  FALSE ;
: SIZE     ( addr -- n) 2- @ ; \ not ANS/ISO commonly found
\ *warning* FREE removes everything above it as well
: FREE     ( addr -- ?) 2- DUP OFF  H ! FALSE ;
\ *warning* RESIZE will fragment the HEAP
: RESIZE   ( n addr -- addr ?) DROP ALLOCATE ;

 

Usage would typically be something like this:

\ protection and syntax sugar
 : ?ALLOC ( ? --) ABORT" Allocate error" ;
 : ->     ( -- addr ?) ?ALLOC  POSTPONE TO ; IMMEDIATE

\ define the variables during compiling
 0 VALUE X
 0 VALUE Y

: START-PROGRAM
    50 ALLOCATE -> X
    50 ALLOCATE -> Y
    .... PROGRAM continues

 

  • Like 2

Share this post


Link to post
Share on other sites

In my efforts to speed up erasing SAMS memory for ED99 I came up with a variation on the Forth word FILL.  FILL16 copies the character argument to both sides of a register and writes two bytes at once. 

It will always write an even number of bytes but that it good for erasing 4K pages.  It allows me to erase 64K of SAMS pages in under 1 second, about 2X faster than using standard Forth FILL.

 

\ FILL16 fills even number of bytes a CELL at a time
NEEDS  DUMP FROM DSK1.TOOLS
NEEDS MOV, FROM DSK1.ASM9900

CODE FILL16   ( addr cnt char -- )
\ copy char into both bytes of TOS register
             TOS R0 MOV,      \ dup the char
             R0 SWPB,         \ move to other byte
             R0 TOS SOC,      \ OR both bytes into TOS

\ compute even number of loops
            *SP+ R0 MOV,       \ pop cnt->R0
             R0  INC,          \ inc by one
             R0  1 SRA,        \ divide cnt by 2
\ do the filling...
            *SP+ R1 MOV,       \ pop addr->R1
             BEGIN,
                TOS R1 *+ MOV, \ 2 chars are in TOS register
                R0 DEC,        \ decr. count
             EQ UNTIL,         \ loop until r0=0
             TOS POP,          \ refill the TOS register
             NEXT,
             ENDCODE

 

  • Like 3

Share this post


Link to post
Share on other sites

My new IDE card forced me to take a look at my DSR routine. I have never been totally happy with it. It's not nicely structured code and it uses three variables that had questionable value IMHO. :)

Anyway I wanted to be sure it could see a card at CRU address >1000.

While there I of course got distracted with the parts I didn't like and took a run at it. It still seems to work and I saved another 30 bytes!

 

One day I will stop doing all that @!#$!$ text comparisons for the file name. They should be done once before entering the DSR and the "real" PAB address at the '.' should recorded for re-use for that PAB.

One day...

 

I have yet to try calling this DSRLINK with the 'A" parameter so more work to do.

 

In the meantime here is how it looks written in CROSS-ASSEMBLER. 

[cc] means use the cross-compiler vocabulary.  [tc] means use the target compiler vocabulary. 

[cc] allows me to use the host computer's interpreter for calculations and control commands

[tc] compiles code into the memory image used for the TI-99.

 

Code failed on real hardware. Worked on Classic99.

Back to the drawing board...

 

EDIT: Removed code. Found a bug in handling Error 6. New version will be below

 

 

 

 

  • Like 1

Share this post


Link to post
Share on other sites

dsrlnkc.hsf  seems to be my best version and it works on real iron.

 

I figured out a better way to handle unknown device error. 

 

 

Spoiler
\ DSRLNKC.HSF for XFC99 cross-compiler/Assembler  19SEP2020
\ PASSES error code back to Forth workspace, TOS register

\ Source:
\ http://atariage.com/forums/topic/283914-specialized-file-access-from-xb/page-2
\ posted by InsaneMultitasker via Thierry Nouspikel

\ - Changed some jumps to structured loops & IF/THEN
\ - ADD GPl error byte to error code on Forth TOS
\ - Removed GPLSTAT constant from kernel, made an Equate here
\ - saved 44 bytes!!                                      B. Fox
\ 20SEPT2020
\ - remove code checking for CRU address >1300 and unused variables
\ - changed error handling for last card detection
\ - save 18 bytes

CROSS-ASSEMBLING  XASSEMBLER DEFINITIONS

\ we need more labels than I normally use for Forth style CODE Words
 A DUP refer: @@A    binder: @@A:
 B DUP refer: @@B    binder: @@B:

CROSS-COMPILING XASSEMBLER DEFINITIONS
\ MACRO to simplify the VDP code
: VDPWA, ( reg -- )
       DUP           SWPB,   \ setup VDP address
       DUP VDPWA @@  MOVB,   \ write 1st byte of address to VDP chip
       DUP           SWPB,
           VDPWA @@  MOVB,   \ write 2nd byte of address to VDP chip
                     NOP,  ; \ need this tiny delay for VDP chip

: [TOS]      8 (R13)  ;  \ gives access to Forth top of stack register

[CC]
HEX 837C EQU GPLSTAT

TARGET-COMPILING
l: HEX20   20 BYTE,
l: HEXAA   AA BYTE,
l: PERIOD  2E BYTE,      \ '.'
          .EVEN
l: CYC1    DATA 0000           \ this empty space seems to be required ??

[CC] RP0 80 -     EQU DREGS    \ memory below Forth RETURN stack is DSR workspace
[CC] 5 2* DREGS + EQU DREG(5)  \ compute address of DREGS register 5
[CC] DREGS 10 -   EQU NAMBUF   \ 16 byte buffer


CLR-JMPTABLE
\ === DSR ENTRY POINT ===
l: DSR1
                 0  LIMI,   \ disable interrupts for VDP access
      *R14+     R5  MOV,    \ fetch '8' from program ->R5, auto inc PC for return
       HEX20 @@ R15 SZCB,   \ status flag=0. *this is critical for REAL IRON*
       8356 @@  R0  MOV,    \ [PAB FNAME] to R0
       R0       R9  MOV,    \ dup R0 to R9
       R9       -8  ADDI,   \ R9-8 = [PAB FLG]
       R0          VDPWA,   \ set the VDP address to use
       VDPRD @@ R1  MOVB,   \ read length of FNAME -> R1

\ setup to copy VDP FNAME -> namebuf to '.' character
       R1       R3  MOVB,   \ DUP length byte to R3
       R3       08  SRL,    \ swap the byte to other side
       R4           SETO,   \ R4 = -1
       R2   NAMBUF  LI,     \ R2 is ^namebuf
       BEGIN,
         R0            INC,    \ point to next fname VDP address
         R4            INC,    \ counter starts at -1
         R4       R3   CMP,    \ is counter = fnamelength
         @@1           JEQ,    \ if true goto @@1:
         R0          VDPWA,    \ set VDP address
         VDPRD @@ R1  MOVB,    \ read next VDP char from fname
         R1      *R2+ MOVB,    \ copy to namebuf & inc pointer
         R1 PERIOD @@ CMPB,    \ is it a '.'
       EQ UNTIL,               \ until '.' found  34 bytes!!!

@@1:   R4        R4  MOV,    \ test R4(device name length)=0
       @@6           JEQ,    \ if so, goto ERROR
       R4        07  CMPI,   \ is dev name length>7
       @@8           JGT,    \ if so, goto @@8 ERROR
       83D0 @@       CLR,    \ erase magic CRU addr. holder
       R4   8354 @@  MOV,    \ put length in magic address
       R4            INC,    \ +1 points to '.' character
       R4   8356 @@  ADD,    \ add offset to PAB address (makes "real PAB")

\ ==== GPL WORKSPACE ====
       83E0         LWPI,    \ SROM (search ROM device list)
       R1           CLR,     \ MAGIC GPL REG. 1 to call DSR, returns error
       R12     0F00 LI,      \ init CRU base to 0F00
\ scan for I/O cards
      BEGIN,
@@A:     R12   R12   MOV,
         NE IF,              \ if card address<>0
              00 SBZ,        \ turn off card
         ENDIF,
         R12    0100  ADDI,  \ advance CRU to next card
         83D0 @@      CLR,   \ erase magic address
         R12    1F00  CMPI,  \ last card?
         GT IF,
              DREGS   LWPI, \ Switch to DSR Workspace
              R1 0006 LI,   \ set error 6
              @@5 JMP,      \ jump to errors
         ENDIF,

\ card activation...
         R12  83D0 @@ MOV,   \ save card CRU in magic address
         00           SBO,   \ turn on the card
         R2   4000    LI,    \ ROM start addr -> R2
        *R2  HEXAA @@ CMPB,  \ test for card ID byte "AA"
      EQ UNTIL,              \ loop until card is found
      DREG(5) @@ R2 ADD,     \ add '8'+4000= >4008 DSR ROM list
      @@B           JMP,

@@3: \ scan ROM linked list for code address
      BEGIN,
         BEGIN,
           83D2 @@   R2 MOV,   \ start of ROM device list -> R2
           00           SBO,   \ turn card on
@@B:      *R2       R2  MOV,   \ Fetch next link
           @@A          JEQ,   \ if link=0 goto @@A (NEXT CARD)
           R2  83D2 @@  MOV,   \ save link address in magic address
           R2           INCT,  \ R2 = code pointer
          *R2+      R9  MOV,   \ fetch code address ->R9
           8355 @@  R5  MOVB,  \ dev length->R5
           @@4          JEQ,   \ if 0 we have a string match
           R5      *R2+ CMPB,
         EQ UNTIL,

\ find dev string match
         R5       08  SRL,     \ shift length byte
         R6   NAMBUF  LI,      \ R6 hold ^nambuf
         BEGIN,
           *R6+   *R2+ CMPB,   \ compare namebuf to ROM string
            @@3        JNE,    \ if mismatch goto @@3
            R5         DEC,    \ dec the counter register
         EQ UNTIL,
@@4: \ run DSR code
         R1        INC,        \ count entries into the DSR ?
        *R9         BL,        \ call the DSR code
      AGAIN,                   \ try next card
\   -- DSR returns here if we are done --

\ error handlers
 @@6:  \ device len=0 error
 @@8:  \ device len>7 error
       00            SBZ,  \ Turn off the card
       DREGS         LWPI, \ ==== DSR Workspace ====
       R9           VDPWA, \ set vdp address to [PAB FLAG]
       VDPRD @@  R1  MOVB, \ read error value to DREGS R1
       R1 0D         SRL,  \ shift error to correct range
       NE IF,
@@5:       \ end of cards error entry point
           R1      [TOS] MOV,  \ Move error code to Forth TOS
           GPLSTAT @@ R0 MOVB, \ get gpl status byte
                      R0 SWPB,
           R0       0020 ANDI, \ mask to get GPL error bit
           R0      [TOS] OR,   \ combine GPL & DSR error codes
       ENDIF,
       RTWP,                   \ return to Forth

\    ====== DSR LINK ENDS======
\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/

\ create the vector for BLWP
l: DLNK      DREGS DATA,   \ the workspace
             DSR1  DATA,   \ entry address of the code

CODE: DSRLNK  ( [pab_fname] -- ior)
      TOS  8356 @@ MOV,
               TOS CLR,
    TOS GPLSTAT @@ MOVB,   \ clear GPL status register
           DLNK @@ BLWP,
                 8 DATA,   \ Offset to DSR linked list in card ROM
                 2 LIMI,
                   NEXT,
END-CODE

 

 

  • Like 2

Share this post


Link to post
Share on other sites
On 9/17/2020 at 9:06 PM, TheBF said:

Code failed on real hardware. Worked on Classic99.

Also check the debug log for warnings if you're writing DSR code. Classic99's DSR is more forgiving than the TI one but most common cases are trapped and reported. Once you have it working with no warnings, you can switch to the TI controller inside Classic99 and verify it. "Worked on Classic99 but not on hardware" has no excuses anymore. ;)

 

Share this post


Link to post
Share on other sites

Branching and looping

 

I was reading comp.lang.forth this morning and a poster named dxforth posted his code for branches and looping.

I had been using a version similar to FIG-Forth which was a little bigger than I wanted and doesn't allow a new construct with double WHILE clauses in a loop.

The double while clause has been used to good effect in some new Forth code.

 

Here is what dxforth posted with some minor changes for Camel99 Forth which uses an offset calculation versus dxforth using an absolute address.

I still find it remarkable that you can write all this functionality so succinctly.

 

Spoiler

\ dxforth uses absolute address for branching.
\ Changed THEN and <RESOLVE to compute branch offsets for Camel99
 : >MARK    HERE 0 , ;
 : <RESOLVE  HERE -  , ;
 : AHEAD    POSTPONE BRANCH >MARK ; IMMEDIATE

 : IF       POSTPONE ?BRANCH >MARK ; IMMEDIATE
 : THEN     HERE OVER - SWAP ! ; IMMEDIATE
 : ELSE     POSTPONE AHEAD SWAP POSTPONE THEN ; IMMEDIATE
 
 : BEGIN    HERE ; IMMEDIATE
 : UNTIL    POSTPONE ?BRANCH <RESOLVE ; IMMEDIATE
 : AGAIN    POSTPONE BRANCH  <RESOLVE ; IMMEDIATE
 : WHILE    POSTPONE IF SWAP ; IMMEDIATE
 : REPEAT   POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE

 

 

  • Like 2

Share this post


Link to post
Share on other sites

In my work to investigate and perhaps improve the DSRLINK that I am using I built a couple of utilities that might be useful to other Forthers.

 

ALLCARDS  does a card search in the system and reports the CRU addresses.

DSRLIST  takes a CRU address argument and prints a list of DSR devices.

 

I think I now understand enough to move a lot of the DSRLINK back to Forth. The idea is to do the text searching parts on OPEN-FILE only and remember all the pertinent bits and pieces.

(PAB address at the 'dot' character, device name length etc.)

Then when doing file-io I should be able to loadup the magic addresses and BL *R9 making for faster file operations.

I was almost there before but didn't have it working on real iron. I believe R1 in GPL workspace was the missing piece. We shall see... :) 

 

The video is running on my real TI-99 with PEB over RS232.

 

 

Spoiler
\ CARDUTIL.FTH lets you search for and examine cards in your system
NEEDS .S FROM DSK1.TOOLS

MARKER /CARDS

HEX
\ *set the CRU address in 'R12 before using these words*
CODE 0SBO  ( -- ) 1D00 ,  NEXT, ENDCODE
CODE 0SBZ  ( -- ) 1E00 ,  NEXT, ENDCODE

4000 CONSTANT 'ID  \ address of 'AA' byte
00AA CONSTANT 'AA' \ id byte for TI-99 cards

DECIMAL
  24 USER 'R12    \ address of R12 in any Camel99 Forth task

: CARDON ( CRUaddr -- )  'R12 ! 0SBO ;

: ?CARD  ( c -- ) 'ID [email protected] <> ABORT" Wrong card ID." ;

HEX
: ALLCARDS ( -- )
          0F00                   \ dummy CRU address
          BEGIN
            0100 +               \ next card address
            DUP CARDON
            'ID [email protected] 'AA' =        \ test if card present
            IF
               CR ." Card found at:>" DUP U.
            THEN
            0SBZ                 \ turn the card off
            DUP 2000 =           \ last address ?
          UNTIL
          DROP ;

: DSRLIST ( CARDaddr -- )
          CARDON
          'AA' ?CARD             \ test ID byte
          'ID 8 +                \ fetch pointer to DSR list
          BEGIN
             @                   \ fetch list item
             DUP                 \ test it for zero (end of list)
          WHILE
             DUP 4 +              \ get address of the counted string
             COUNT TYPE ." , "    \ convert to addr,len & type with comma
          REPEAT
          0SBZ
          DROP ;

 

 

  • Like 1

Share this post


Link to post
Share on other sites

I really like the elegance of such compact code.  😎

 

So do I get it right that you'r connected to your TI-99/4a via RS232 and your forth kernel is handling the tty?

  • Like 1

Share this post


Link to post
Share on other sites
1 hour ago, retroclouds said:

I really like the elegance of such compact code.  😎

 

So do I get it right that you'r connected to your TI-99/4a via RS232 and your forth kernel is handling the tty?

Yes.  I wrote a custom Forth kernel that does not use VDP or console keyboard.

It's neat because I can test code by pasting into the terminal program and Forth swallows it. :)

 

  • Like 5

Share this post


Link to post
Share on other sites

Where have I been lately?

 

Well it started with a question: " Since I have a cross-assembler, can I put a cross-compiler on top of that to create stand alone binary programs in Forth?"

That lead to a week or so of trying to do it without namespace control (1 dictionary).

 

Which lead to: "Ok so what would it take to add vocabularies to Camel99" That lead to a week of working in a Forth 83 style vocabulary with search-order control words.

 

Which lead to: "How hard would it be to implement the F83 hashed dictionary. (I got those concepts working but I need to change the cross-compiler so that' on hold)

 

Which lead to: " What is all this talk about WORDLISTS in Forth 2012.

I am getting close to implementing WORDLISTS. :)

It meant making a change to FIND and a few other things in the Forth kernel.  FIND must scan through an array of CONTEXT variables but I understand it much better.

 

More to come...

 

And I have developed a sciatic nerve pain that makes concentration and sitting a little harder so productivity is down. 

 

  • Like 2
  • Sad 1

Share this post


Link to post
Share on other sites
1 hour ago, TheBF said:

Which lead to: "Ok so what would it take to add vocabularies to Camel99" That lead to a week of working in a Forth 83 style vocabulary with search-order control words.

 

Do you have Derick and Baker’s Forth Encyclopedia? On pages 306 ff is a pretty good description of fig-Forth vocabulary structure. There are errors in the explanation, which I have always intended on correcting, but you can probably tease them out. Perhaps, I will take this reminder to actually rewrite that section. :ponder:

 

...lee

  • Thanks 1

Share this post


Link to post
Share on other sites
1 hour ago, Lee Stewart said:

 

Do you have Derick and Baker’s Forth Encyclopedia? On pages 306 ff is a pretty good description of fig-Forth vocabulary structure. There are errors in the explanation, which I have always intended on correcting, but you can probably tease them out. Perhaps, I will take this reminder to actually rewrite that section. :ponder:

 

...lee

I don't have that one no.  FIG is probably the lowest overhead way to go.  I think that is like Forth 79 where all new vocabularies link back to Forth.  (?)

 

For a Cross compiler the ideal is to have  a search order like:   TARGET/COMPILER/FORTH

This way if it's defined in the target it's found first, if not there, then in the COMPILER and finally last resort is the Host machines Forth.

 

My confusion was how to map it only the Camel99 dictionary which is LFA->NFA.

I get confused with pointers to pointers. :)  (but it doesn't take much to confuse me really)

 

I will look that book up for extra knowledge. Thanks

 

P.S.

I spent a lot of time on that hashed dictionary idea. I got the concepts working per Dr. Ting's book.

 I just didn't have enough courage to break into the cross-compiler with this nerve pain, but it's becoming manageable.

I think some conditional compilation will let me test without breaking anything. :)

 

 

  • Like 1

Share this post


Link to post
Share on other sites
1 hour ago, Lee Stewart said:

 

Do you have Derick and Baker’s Forth Encyclopedia? On pages 306 ff is a pretty good description of fig-Forth vocabulary structure. There are errors in the explanation, which I have always intended on correcting, but you can probably tease them out. Perhaps, I will take this reminder to actually rewrite that section. :ponder:

 

...lee

That book is Mountain View Press.  Very neat.

My first PC Forth was MVP Forth by Glenn Hayden.  A friend found the source code on for the barest kernel on a machine at the local university.

He brought me a listing asking "How the hell does this work? It's mostly DW statments! :) 

 It's how I learned intel Assembler.  Trying to get that code to boot in 80 columns. :) 

 

I actually met Glenn in the 90s at a Forth conference that was held in Toronto at Ryerson U.  It's was amazing for me.

 

Thanks again for the excellent link.

 

  • Like 1

Share this post


Link to post
Share on other sites
36 minutes ago, TheBF said:

Thanks again for the excellent link.

 

You are most welcome. Right now going to the Zoom meeting—join us!

 

...lee

  • Like 1

Share this post


Link to post
Share on other sites
23 minutes ago, Lee Stewart said:

You are most welcome. Right now going to the Zoom meeting—join us!     ...lee

 

Oops! I was early. It’s at 6:00 pm EDT.

 

...lee

Share this post


Link to post
Share on other sites
6 hours ago, Lee Stewart said:

 

Oops! I was early. It’s at 6:00 pm EDT.

 

...lee

Man my timing is always off.  It's Thanksgiving weekend up here.

The wife and I went for a walk in the forest with the grandkids and then we had dinner.

I have to plan for the next one.

 

  • Like 1

Share this post


Link to post
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.

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