6502.org Forum  Projects  Code  Documents  Tools  Forum
It is currently Thu Nov 21, 2024 10:47 am

All times are UTC




Post new topic Reply to topic  [ 354 posts ]  Go to page Previous  1 ... 17, 18, 19, 20, 21, 22, 23, 24  Next
Author Message
PostPosted: Sat Mar 18, 2023 1:29 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
GARTHWILSON wrote:
Quote:
Code:
IF  LEAVE  THEN

I use that enough that I've made it part of my kernel, as ?LEAVE.  It pays for itself in memory, and also runs a lot faster because the ?leave (the internal compiled by the immediate compile-only word ?LEAVE) is a primitive.

So have I. Since the redefinition of \S uses LEAVE , that is the one I used in the example.
Code:
?LEAVE
  2130          INX
  2131          INX
  2132   254 ,X LDA  W
  2134   255 ,X ORA  W 1+
  2136  2164    BNE ' (LOOP) >BODY 13 +
  2138  2174    BEQ NEXT
10

The first branch branches to the body of LEAVE , which LEAVE shares with (LOOP)
Code:
  2164          PLA       \ CFA OF LEAVE POINTS HERE
  2165          PLA
  2166          PLA
  2167          PLA
  2168          PLA       \ CFA OF EXIT POINTS HERE
  2169   251    STA IP
  2171          PLA
  2172   252    STA IP 1+

which falls into NEXT .
Fleet Forth's LEAVE and ?LEAVE are not compiled by secondaries.


Top
 Profile  
Reply with quote  
PostPosted: Tue Apr 11, 2023 2:30 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

Although it looks as though Fleet Forth's (LOOP) falls into NEXT , it really doesn't. The following is a disassembly of Fleet Forth's (LOOP) .
Code:
SEE (LOOP)
(LOOP)
  867         PLA
  868         TAY
  869         INY
  86A  8EB    BNE ' ?BRANCH >BODY 16 +
  86C         SEC
  86D         PLA
  86E    0  # ADC
  870  8EA    BVC ' ?BRANCH >BODY 15 +
  872  876    BVS
  874         PLA
  875         PLA
  876         PLA
  877         PLA
  878         PLA
  879   FB    STA IP
  87B         PLA
  87C   FC    STA IP 1+
  87E    1  # LDY
  880   FB )Y LDA IP
  882   FF    STA  W 1+
  884         DEY
  885   FB )Y LDA IP
  887   FE    STA  W
  889         CLC
  88A   FB    LDA IP
  88C    2  # ADC
  88E   FB    STA IP
  890  895    BCS
  892   FD    JMP  W 1-
  895   FC    INC IP 1+
  897   FD    JMP  W 1-
33
 OK

The two complementary branches, BVC and BVS, mark the end of (LOOP) . The string of PLA instructions which follow are the start of the code for LEAVE . It's header and code field are farther ahead and it's code field points to address $874.
Fleet Forth's kernel was rewritten to make this obvious and to give the new metacompiler one more test. The disassembly is as follows.
Code:
SEE LEAVE
LEAVE
  866         PLA
  867         PLA
  868         PLA
  869         PLA
  86A         PLA
  86B   FB    STA IP
  86D         PLA
  86E   FC    STA IP 1+
  870    1  # LDY
  872   FB )Y LDA IP
  874   FF    STA  W 1+
  876         DEY
  877   FB )Y LDA IP
  879   FE    STA  W
  87B         CLC
  87C   FB    LDA IP
  87E    2  # ADC
  880   FB    STA IP
  882  887    BCS
  884   FD    JMP  W 1-
  887   FC    INC IP 1+
  889   FD    JMP  W 1-
26
 OK
SEE (LOOP)
(LOOP)
  897         PLA
  898         TAY
  899         INY
  89A  900    BNE ' ?BRANCH >BODY 17 +
  89C         SEC
  89D         PLA
  89E    0  # ADC
  8A0  8FF    BVC ' ?BRANCH >BODY 16 +
  8A2  868 ^^ BVS ' LEAVE >BODY 2 +
D
 OK
SEE (+LOOP)
(+LOOP)
  8B0         INX
  8B1         INX
  8B2         CLC
  8B3         PLA
  8B4   FE ,X ADC  W
  8B6         TAY
  8B7         PLA
  8B8   FF ,X ADC  W 1+
  8BA  8FF    BVC ' ?BRANCH >BODY 16 +
  8BC  868 ^^ BVS ' LEAVE >BODY 2 +
E
 OK

It is now clear that (LOOP) branches into the body of ?BRANCH or into the body of LEAVE .

Another change to the kernel is having store, ! , fall into the body of 2DROP .
Code:
CODE !  ( N ADR -- )
   2 ,X LDA  0 X) STA  0 ,X INC
   0= IF  1 ,X INC  THEN
   3 ,X LDA  0 X) STA
   LABEL POPTWO ( N1 N2 -- )
   INX  INX
   LABEL POP
   INX  INX
   NEXT 0< NOT BRAN
   LABEL RUNG1
   // WILL BE PATCHED
   0 JSR           // >FORTH
   LABEL DO.?STACK
   0 ,             // ?STACK
   END-CODE

   ...

CODE 2DROP  ( N1 N2 -- )
   POPTWO  LATEST NAME> !
   END-CODE
CODE DROP  ( N1 -- )
   POP  LATEST NAME> !
   END-CODE

I've shown the disassembly for the loop words because the source can be difficult to follow for those not used to an assembler which uses RPN and the use of the auxiliary stack to temporarily store control flow data. The assembler and meta assembler both use the same size control flow data as Fleet Forth's high level control flow words.
Here is the source code for ?EXIT 0EXIT ?LEAVE LEAVE (LOOP) (+LOOP) ! and ?BRANCH .

Code:
CODE ?EXIT  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= IF CS>A               // EXIT
   0= NOT IF CS>A  END-CODE // NEXT
CODE 0EXIT  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= NOT IF CS>A           // EXIT
   0= IF CS>A  END-CODE     // NEXT
CODE ?LEAVE  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= IF CS>A               // LEAVE
   0= NOT IF CS>A  END-CODE // NEXT

CODE LEAVE
   A>CS A>CS THEN
   PLA  PLA
   PLA  PLA
   A>CS A>CS THEN
   A>CS A>CS THEN
   LABEL EXIT.BODY
   PLA  IP STA   PLA  IP 1+ STA
   THEN
   THEN
   THEN
   LABEL NEXT
   1 # LDY
   IP )Y LDA  W 1+ STA  DEY
   IP )Y LDA  W    STA  CLC
   IP LDA  2 # ADC  IP STA
   CS NOT IF
      W 1- JMP
   THEN
   IP 1+ INC
   W 1- JMP  END-CODE

CODE (LOOP)
   PLA  TAY  INY
   0= IF                 // TO ?BRANCH
   SEC  PLA  0 # ADC
   VS IF                 // TO ?BRANCH
   ' LEAVE @ 2+ VS BRAN
   CS-SWAP CS>A CS>A
   END-CODE
CODE (+LOOP)  ( N -- )
   INX  INX  CLC
   PLA  $FE ,X  ADC  TAY
   PLA  $FF ,X  ADC
   VS IF  CS>A           // TO ?BRANCH
   ' LEAVE @ 2+ VS BRAN
   END-CODE

CODE !  ( N ADR -- )
   2 ,X LDA  0 X) STA  0 ,X INC
   0= IF  1 ,X INC  THEN
   3 ,X LDA  0 X) STA
   LABEL POPTWO ( N1 N2 -- )
   INX  INX
   LABEL POP
   INX  INX
   NEXT 0< NOT BRAN
   LABEL RUNG1
   // WILL BE PATCHED
   0 JSR           // >FORTH
   LABEL DO.?STACK
   0 ,             // ?STACK
   END-CODE

CODE ?BRANCH  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= NOT IF
      LABEL 2.IP.+!
      CLC
      IP LDA  2 # ADC  IP STA
      CS IF  IP 1+ INC  THEN
      NEXT JMP
      A>CS THEN  A>CS THEN
      PHA
      A>CS THEN
      TYA  PHA  0 # LDY
   THEN
   LABEL BRANCH.BODY
   IP )Y LDA  PHA  INY
   IP )Y LDA  IP 1+ STA
   PLA  IP STA
   NEXT 2+ JMP  END-CODE



Top
 Profile  
Reply with quote  
PostPosted: Sat Apr 15, 2023 2:20 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

I've mentioned Fleet Forth's WORD before. Reading through "standard" Forth and the following quotes from scotws motivated me to clarify something about Fleet Forth's WORD .
scotws wrote:
... but what this does is use PARSE-NAME (that's BL WORD COUNT in paleolithic Forths)...
scotws wrote:
... PARSE-NAME replaces WORD and just does ( "name" -- addr u ) while WORD ends up being BL WORD COUNT anyway...

Two of the drawbacks to WORD mentioned are the time used copying the parsed string to a transient area and the possibility of overwriting something beyond the transient area.
This is the source for Fleet Forth's WORD .
Code:
: WORD  ( C -- HERE )
   'STREAM
   BLK 2@ HISTORY 2!
   DUP >IN +!
   2PICK SKIP
   ROT 2PICK -ROT SCAN
   1- 0 MAX NEGATE >IN +!
   OVER - >HERE ;

The word >HERE just before the semicolon takes an address and count. It copies the string at that address to HERE as a counted string with a trailing blank. It will NOT copy more than 255 bytes! With the count byte and trailing blank, that is a maximum of 257 bytes at HERE which could get overwritten. Sure, the first 172 byes of PAD could possibly be overwritten. I wrote >HERE as a primitive so it would be fast.
I mentioned that >HERE takes an address and a count. If I wanted to support PARSE-NAME , I would have factored (WORD) out of WORD .
Code:
: (WORD)  ( C -- ADR CNT )
   'STREAM
   BLK 2@ HISTORY 2!
   DUP >IN +!
   2PICK SKIP
   ROT 2PICK -ROT SCAN
   1- 0 MAX NEGATE >IN +!
   OVER -
   ;
: WORD  ( C -- HERE )
   (WORD) >HERE ;
: PARSE-NAME  ( -- ADR CNT )
   BL (WORD) ;

Why haven't I done this? COUNT does not appear after WORD in any of the source files for Fleet Forth. The counted string from WORD is used as is. WORD is normally just used to parse names and numbers from the text stream.
I have another word to parse strings. It is used by the following words.
Code:
(
.(
"
."
ABORT"

I call this word CHAR ; however, the Ansi Forth standard has a word by that name which, along with [CHAR] , does what ASCII does in a Forth-83 system so I may rename Fleet Forth's CHAR . It works a lot like the Ansi Forth word PARSE in that it does not skip initial occurrences of the delimiter and it returns an address and count. It is different in that it will ABORT if the delimiter is not found.

WORD does not end up being BL WORD COUNT anyway. The two standards did things differently. It's not like PARSE-NAME just becomes PARSE-NAME >HERE anyway.


Top
 Profile  
Reply with quote  
PostPosted: Sun Apr 16, 2023 7:31 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
JimBoyd wrote:
I made a change to Fleet Forth's LINELOAD , which is used by LOAD . LINELOAD takes a line number and a screen number as parameters. It loads a given screen starting at the line specified.
I read somewhere (I don't remember where) a recommendation that LOAD should set BASE to decimal prior to loading a screen. I've given this some thought and can not really see a down side.

And now I have. I failed to consider the case where a screen might not contain source to compile but commands to run like a script. Just a reminder, a screen is a block which contains source to compile OR commands to execute. Consider a set of blocks which have screens of tests. Nothing gets compiled, the tests are run by loading the screen. Depending on the tests, it would be convenient to be able to set the BASE prior to loading.
Likewise, If the a screen changes BASE to something other than decimal, it will not be set to decimal for any screens chain loaded from that one with --> .
It is for these reasons that Fleet Forth's LOAD will no longer have a default base, nor will it restore BASE to whatever it was prior to loading. I believe this will result in more flexibility in how screens are used.

JimBoyd wrote:
As it is, I have been in the habit of specifying the number base at the start of a screen. With this modification, I will not have to specify the number base if I am using decimal for a particular screen.

This may not be necessary because Fleet Forth's NUMBER? accepts a leading conversion base specifier ($,# or %) in a numeric string.
The source for Fleet Forth's new LINELOAD and LOAD .
Code:
: LINELOAD  ( LINE# BLK# -- )
   DUP 0=
   ABORT" CAN'T LOAD 0"
   BLK 2@ 2>R
   BLK !  C/L * >IN !
   INTERPRET  2R>
   BRANCH [ BLK.2! , ] -;
: LOAD  ( U -- )
   0 SWAP BRANCH
   [ ' LINELOAD >BODY , ] -;



Top
 Profile  
Reply with quote  
PostPosted: Mon Apr 17, 2023 1:05 pm 
Offline

Joined: Sun May 13, 2018 5:49 pm
Posts: 255
JimBoyd wrote:
I failed to consider the case where a screen might not contain source to compile but commands to run like a script.
I use blocks like this all the time, and often have blocks that load other blocks with LOAD and THRU. I usually set the base, if it's important, right at the top and set it to decimal right at the end. I would like to make some words that save and restore the old base so that I can put it back the way it was, but it hasn't been a big enough issue to focus on and I just use the stack to hold the old base when I really need to do that.

You showed your co-routine method earlier in this thread and I was able to get your co-routine method to work in Tali (even though it's STC and your forth was ITC), so I will probably implement your RB (Restore Base) word that way when/if I get around to it.
JimBoyd wrote:
This may not be necessary because Fleet Forth's NUMBER? accepts a leading conversion base specifier ($,# or %) in a numeric string.
Tali2 supports this as well, and I've recently started to make use of it. It's actually a much better solution all around, in my opinion, because the person reading the code (which will probably be me at a later date) can easily tell $100 from #100 from %100 without having to figure out what the base is at that moment. It also allows for multiple bases to be used easily in the same screen, such as looping a decimal number of times while accessing a hex address with a binary mask.


Top
 Profile  
Reply with quote  
PostPosted: Sat Apr 22, 2023 4:28 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

I've added --> to Fleet Forth. I use it to link together all screens used by a given word. I do not use --> to link all screens in place of THRU . Since Fleet Forth's THRU is compatible with --> , I can use THRU to load a range of screens for some useful utilities while still chaining together the two screens spanned by a word such as (RR/W) .
Code:
SCR# 52
// (RR/W)
HEX
CODE (RR/W)  ( ADR BLK# R/WF CNT -- )
   DF09 STY  DF0A STY
   DF09 LDA  1F # CMP
   0= IF
      DF0A LDA  3F # CMP
      0= IF
         DF04 STY  4 ,X LDA
         .A ASL  5 ,X ROL
         .A ASL  5 ,X ROL
         DF05 STA
         5 ,X LDA  DF06 STA
         0 ,X LDA  DF07 STA
         1 ,X LDA  DF08 STA
         -->

SCR# 53
// (RR/W)
         6 ,X LDA  DF02 STA
         7 ,X LDA  DF03 STA
         2 ,X LDA  90 # ORA  DF01 STA
         BEGIN
            DF00 BIT
         VS UNTIL
         INX  INX  INX  INX
         POPTWO JMP
      THEN
   THEN
   >FORTH
   TRUE ABORT" NO REU" -;
' (RR/W) IS RR/W

(RR/W) spans the screens 52 and 53 so they are linked together with --> at the bottom of screen 52; however, they can still be loaded with the screens in the range 46 - 78. If I have an idea to improve (RR/W) , I can load all of it just by loading screen 52. This loads (RR/W) , and only (RR/W) , for testing. This use of --> to chain together all the screens spanned by a word, and using it with a compatible version of THRU , rather than using --> to replace the function of THRU , negates one of the arguments against --> ; specifically, the argument that the use of --> precludes the ability to load individual screens. The way I use --> , the only screens which can not be loaded individually are the ones which should not be loaded individually.


Top
 Profile  
Reply with quote  
PostPosted: Mon Apr 24, 2023 6:50 pm 
Offline

Joined: Sun May 13, 2018 5:49 pm
Posts: 255
JimBoyd wrote:

This use of --> to chain together all the screens spanned by a word, and using it with a compatible version of THRU , rather than using --> to replace the function of THRU , negates one of the arguments against --> ; specifically, the argument that the use of --> precludes the ability to load individual screens. The way I use --> , the only screens which can not be loaded individually are the ones which should not be loaded individually.
That is very good work. The Forth-83 standard lists both --> and THRU as "controlled reference words" (eg. you don't have to provide them to meet the standard, but if you do provide them they should have defined behavior) and I always thought they were two different ways to solve the same issue (code that spans multiple screens). It looks like --> was dropped in the 94 standard and THRU was officially adopted into the "Block Extension" word set. The advantage of your forth having both words is that you are able to load older FIG Forth code as well as newer code.

I can see the advantage to having --> around (when it's like your version that is compatible with THRU) to ensure that a multiscreen definition of a single word always has the full definition loaded.


Top
 Profile  
Reply with quote  
PostPosted: Sun Apr 30, 2023 7:56 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

--> is a very simple word.
Code:
: -->  ( -- )
   1 BLK +!  >IN OFF ; IMMEDIATE

Here are generic versions of LOAD and THRU which are compatible with --> .


Top
 Profile  
Reply with quote  
PostPosted: Sun Apr 30, 2023 9:03 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

I've made some changes to Fleet Forth's multitasker.
UNLINK-TASK has been removed in an effort to keep the multitasker small.
UNLINK-ALL has been replaced with UNLINK .UNLINK is integrated into the kernel. The source for UNLINK-ALL
Code:
: UNLINK-ALL  ( -- )
   [ ASSEMBLER UP @ ] LITERAL
   DUP UP !  ENTRY ! ;   FORTH

and the source for a subroutine used by the WARM and COLD start routines.
Code:
HSUBR (WARM)
   SEI
   $2F # LDA  0 STA
   $36 # LDA  1 STA
   USER.DATA    LDA  UP    STA
   USER.DATA 1+ LDA  UP 1+ STA
   $6C # LDA  W 1- STA
   'THERE USER.DATA - 1- # LDY
   BEGIN
      USER.DATA ,Y LDA  UP )Y STA
      DEY
   0< UNTIL
   CLI
   >FORTH
      SP! AP! [COMPILE] [
      IORESET SINGLE DECIMAL
      PAGE BOOTCOLORS
   >ASSEM
      RTS
   END-CODE

Some of the functionality of (WARM) has been factored out into the new code word UNLINK .
Code:
CODE UNLINK  ( -- )
   USER.DATA    LDA  UP    STA
   USER.DATA 1+ LDA  UP 1+ STA
   'THERE USER.DATA - 1- # LDY
   BEGIN
      USER.DATA ,Y LDA  UP )Y STA
      DEY
   0< UNTIL
   NEXT JMP  END-CODE

Here is the new subroutine (WARM) .
Code:
HSUBR (WARM)
   SEI
   $2F # LDA  0 STA
   $36 # LDA  1 STA
   $6C # LDA  W 1- STA
   CLI
   >FORTH
      UNLINK
      SP! AP! [COMPILE] [
      IORESET SINGLE DECIMAL
      PAGE BOOTCOLORS
   >ASSEM
      RTS
   END-CODE

TASK and ACTIVATE have also been modified. They now support partitioning the auxiliary stack.
Code:
: ACTIVATE  ( TCF-ADR TASK-ADR -- )
   DUP WAKE
   TUCK  RP0 LOCAL @ 1- DUP>R !
   DUP SP0 LOCAL @ R@ 1- C!
   DUP TOS LOCAL R> 2- SWAP!
       AP0 LOCAL  @ DUP ! ;

: TASK  ( U AP0 SP0 RP0 -- )
   CREATE
        ( -- TADR )
      HERE RP0 LOCAL !
      HERE SP0 LOCAL !
      HERE AP0 LOCAL !
      // OPTIONAL
      #10 HERE BASE LOCAL !
      HERE #USER + HERE DP LOCAL !
      #12 UMAX ALLOT ;

The way ACTIVATE works is different. It now takes the address of a thread of high level Forth, such as the PFA , and the address of a task.
Here is the creation of a sample task:
Note: since this is on a Commodore 64, just think of each // as \.
Code:
DECIMAL
#USER 80 +  // 80 BYTES FOR 'HERE'
AP0 @ 42 -  // HALF OF AUX STACK
SP0 @ 62 -  // HALF OF DATA STACK
RP0 @ 128 - // HALF OF RETURN STACK
TASK BGTASK

Here is linking and activating.
Code:
: FLASH  ( -- )
   BEGIN
      $D020 C@ 1+ BORDER  // INCREMENT THE BORDER COLOR
      60 JIFFIES          // WAIT 1 SECOND
   AGAIN -;

BGTASK LINK-TASK
' FLASH >BODY BGTASK ACTIVATE
MULTI  // ENABLE MULTITASKING

PAUSE is not in the source for FLASH because JIFFIES calls DJIFFIES which has PAUSE .
A word of caution! FORGET switches off multitasking but does not unlink the tasks. After the use of FORGET it is the programmers responsibility to be certain none of the linked tasks or the words they run have been forgotten.
I could update FORGET to call UNLINK . It would be the programmers responsibility to relink and wake the tasks after the use of FORGET .


Top
 Profile  
Reply with quote  
PostPosted: Fri May 05, 2023 7:05 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
SamCoVT wrote:
I can see the advantage to having --> around (when it's like your version that is compatible with THRU) to ensure that a multiscreen definition of a single word always has the full definition loaded.


Yes, having all of a multi screen definition loaded when the first screen of said definition is loaded is nice. Fleet Forth has the word FH from Leo Brodie's Thinking Forth. After editing a screen, I can load it with the phrase 0 FH . It would be convenient after editing a word spanning multiple screens to be able to type 0 FH and load the new word regardless of which screen of a multi screen definition I was just editing. I would have liked to have such a feature back when I replaced PUSH and PUT with AYPUSH and AYPUT in Fleet Forth.
I've found a way to do just that. --> is redefined so it skips loading the comment line of the next block.
Code:
: -->  ( -- )
   1 BLK +!  C/L >IN ! ; IMMEDIATE

And a new word is added.
Code:
: <--  ( -- )
   TRUE BLK +!  >IN OFF ; IMMEDIATE

Here is Fleet Forth's BLOCK
Code:
SCR# 112
0: // BLOCK
1: CODE BLOCK  ( BLK -- ADR )
2:    DEY
3:    BLK/BUF STY
4:    ' MRU >BODY    LDA  W    STA
5:    ' MRU >BODY 1+ LDA  W 1+ STA
6:    6 # LDY
7:    W )Y LDA  0 ,X CMP
8:    0= IF
9:       INY  W )Y LDA  1 ,X CMP
A:       0= IF
B:          INY  (W)PUT JMP
C:       THEN
D:    THEN
E:    -->
F:

SCR# 113
0: // BLOCK
1:    >FORTH
2:    #BUF 1+ 2
3:    ?DO
4:       DUP I >BT @ =
5:       IF
6:          DROP I UNLOOP
7:          AHEAD CS>A
8:       THEN
9:    LOOP
A:       LRU 2+ 2+ @
B:       IF
C:          LRU 2@ 0 B/BUF R/W
D:          LRU 2+ 2+ OFF
E:       THEN
F:       -->

SCR# 114
0: // BLOCK BUFFER
1:       BLK/BUF C@
2:       IF
3:          LRU ON
4:          LRU 2+ @ DUP B/BUF TRUE FILL
5:          OVER 1 B/BUF R/W
6:       THEN
7:       LRU ! #BUF
8:    A>CS THEN
9:    DUP >BT MRU 6 CMOVE
A:    MRU 1 >BT ROT 6 * CMOVE>
B:    MRU 2+ @ ;
C:
D: CODE BUFFER  ( BLK# -- ADR )
E:    ' BLOCK @ 1+  LATEST NAME> !
F:    END-CODE

Here is the modified source.
Code:
SCR# 112
0: // BLOCK
1: CODE BLOCK  ( BLK -- ADR )
2:    DEY
3:    BLK/BUF STY
4:    ' MRU >BODY    LDA  W    STA
5:    ' MRU >BODY 1+ LDA  W 1+ STA
6:    6 # LDY
7:    W )Y LDA  0 ,X CMP
8:    0= IF
9:       INY  W )Y LDA  1 ,X CMP
A:       0= IF
B:          INY  (W)PUT JMP
C:       THEN
D:    THEN
E:    -->
F:

SCR# 113
0: <-- BLOCK
1:    >FORTH
2:    #BUF 1+ 2
3:    ?DO
4:       DUP I >BT @ =
5:       IF
6:          DROP I UNLOOP
7:          AHEAD CS>A
8:       THEN
9:    LOOP
A:       LRU 2+ 2+ @
B:       IF
C:          LRU 2@ 0 B/BUF R/W
D:          LRU 2+ 2+ OFF
E:       THEN
F:       -->

SCR# 114
0: <-- BLOCK BUFFER
1:       BLK/BUF C@
2:       IF
3:          LRU ON
4:          LRU 2+ @ DUP B/BUF TRUE FILL
5:          OVER 1 B/BUF R/W
6:       THEN
7:       LRU ! #BUF
8:    A>CS THEN
9:    DUP >BT MRU 6 CMOVE
A:    MRU 1 >BT ROT 6 * CMOVE>
B:    MRU 2+ @ ;
C:
D: CODE BUFFER  ( BLK# -- ADR )
E:    ' BLOCK @ 1+  LATEST NAME> !
F:    END-CODE

Here are the same three screens with most of the lines removed.
Code:
SCR# 112
0: // BLOCK
1: CODE BLOCK  ( BLK -- ADR )
E:    -->

SCR# 113
0: <-- BLOCK
F:       -->

SCR# 114
0: <-- BLOCK BUFFER
D: CODE BUFFER  ( BLK# -- ADR )
E:    ' BLOCK @ 1+  LATEST NAME> !
F:    END-CODE

By replacing the end of line comment word with <-- in the second and third screens used for BLOCK , I can load any one of the screens for BLOCK and all three will be loaded in the correct order.
When a screen starting with <-- is loaded by LOAD or THRU , the screen does not finish loading. loading resumes with the previous screen. This continues until loading resumes with a screen not having <-- . That screen loads normally. Assuming that screen has --> , loading resumes with the next screen but the comment line is skipped.


Top
 Profile  
Reply with quote  
PostPosted: Sun May 07, 2023 11:49 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
There are more changes for Fleet Forth's multitasker.
The data used to initialize the first six user variables has been changed so the main task is always awake by default.
The old system user area boot up values.
Code:
// SYSTEM USER AREA BOOT UP VALUES
USER.AREA ,    // ENTRY
   0 ,         // READY
   0 ,         // TOS
'RP0 ,         // RP0
'SP0 ,         // SP0
'AP0 ,         // AP0

The new values.
Code:
// SYSTEM USER AREA BOOT UP VALUES
USER.AREA ,    // ENTRY
TRUE ,         // READY
   0 ,         // TOS
'RP0 ,         // RP0
'SP0 ,         // SP0
'AP0 ,         // AP0

UNLINK has been added to FORGET just before SINGLE so FORGET and EMPTY will unlink all tasks.
TASK gives the created task the default of running the loop in STOP .
Code:
: STOP  ( -- )
   BEGIN
      READY OFF  PAUSE
   AGAIN -;

With these changes it is no longer necessary for LINK-TASK to put a task to sleep before linking it.

The multitasker has been moved from the utilities disk to the system loader disk. It is now loaded whenever the system is added to a new Fleet Forth kernel.


Top
 Profile  
Reply with quote  
PostPosted: Mon May 08, 2023 12:37 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895
I once mentioned that my Forth would not have a permanent stack display and it will not; however, there is a way to add a stack display to the top of the screen on an as needed temporary basis. This could be handy when hand tracing yet to be compiled (as in, not finished) forth words.
I was trying to think of a simple background task to demonstrate the multitasker when I thought of this.
Fleet Forth's interpret has the word PAUSE as the first word in the interpreter loop.
Code:
: INTERPRET
   BEGIN
      PAUSE NAME C@ 0EXIT
      HERE I/C
   AGAIN -;

Fleet Forth's IS only works with DEFERred words and its TO only works with VALUEs. When compiling, they both compile (IS) . (IS) will alter the first cell of the parameter field of any word.
It is used to define words to 'patch' the interpreter.
Code:
: TOP.S
   $400 #160 BLANK
   XY 2>R  CHARS @ >R
   0 1 AT-XY CHARS OFF .S
   R> CHARS !  2R> AT-XY ;
: TOP.S.ON  ( -- )
   ['] TOP.S (IS) INTERPRET ;
: TOP.S.OFF  ( -- )
   ['] PAUSE (IS) INTERPRET ;
: PAGE
    PAGE  CR CR CR CR ;

TOP.S saves the current screen coordinates as well as the number of characters emitted since the last page or carriage return. It sets the screen coordinates to the beginning of the second line and displays the stack contents before restoring the screen coordinates and the number of characters emitted.
TOP.S.ON and TOP.S.OFF switch on and off this capability.
The new PAGE is to leave room for the stack display.
Because task switching can occur in .S , multitasking still works while interpreting/compiling.


Top
 Profile  
Reply with quote  
PostPosted: Sun May 28, 2023 9:44 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

I've been reviewing Fleet Forth's implementation of virtual memory and noticed there is room for improvement.
Code:
0 VALUE BANK
: >VIRTUAL  ( VADR -- ADR )
   U/BBUF RAM BANK 6 LSHIFT + BLOCK + ;

Virtual memory normally started at the beginning of memory in the REU , the ram expansion unit. higher 64 kilobytes banks could be selected by setting the value BANK to the desired bank; however, this seems a bit clumsy.
The new version uses the value VOFFSET for a block offset. The following sets the start of virtual memory at the start of the ram expansion unit.
Code:
0 RAM TO VOFFSET

The start of virtual memory can also be set to start at a higher address in the ram expansion unit; therefore BANK is no longer needed.
The following causes virtual memory to start 128 kilobytes into the ram expansion unit.
Code:
128 RAM TO VOFFSET

The following causes virtual memory to start 20 kilobytes into the ram expansion unit.
Code:
20 RAM TO VOFFSET

I feel that setting VOFFSET is a much nicer solution that setting a bank number.

I've been rereading Dick Pountain's "Object Oriented Forth". By pointing the start of virtual memory at one of the disk drives, the virtual memory words can be used to store records or make a persistent copy of virtual memory.
The following sets the start of virtual memory to point to the third disk drive. In my case, the 1581 with a capacity for 799 blocks.
Code:
0 2 DR+ TO VOFFSET

I've also defined >VIRTUAL to call a long address version >LVIRTUAL to allow for an optional long address set of virtual memory words.
Large virtual memory addresses used with >LVIRTUAL , and >VIRTUAL with a high value in VOFFSET , could be larger than what can be accessed with the highest block; therefore, >LVIRTUAL has range checking to make sure the block number doesn't wrap around.
Code:
// VOFFSET V >LVIRTUAL >VIRTUAL
0 RAM VALUE VOFFSET
CODE V  ( UD -- OFS BLK# F )
   3 ,X LDA  TAY
   3 # AND  3 ,X STA  TYA
   1 ,X LSR  0 ,X ROR  .A ROR
   1 ,X LSR  0 ,X ROR  .A ROR
   0 ,X LDY  0 ,X STA
   1 ,X LDA  1 ,X STY
   APUSH JMP  END-CODE
: >LVIRTUAL  ( VLADR -- ADR )
   V  VOFFSET 0 D+
   ABORT" BLOCK LIMIT"
   BLOCK + ;
: >VIRTUAL ( VADR -- ADR )
   0 >LVIRTUAL ;

CMOVE>V and CMOVEV> were rewritten for greater speed and the BEGIN loop in VMSAVE was cleaned up a little.
Code:
: #LIM  ( VADR CNT1 -- CNT2 )
   B/BUF ROT $3FF AND - UMIN ;

: CMOVE>V  ( ADR VADR CNT -- )
   BEGIN
      2DUP #LIM >R
      2PICK 2PICK >VIRTUAL R@
      CMOVE UPDATE
      ROT R@ + -ROT
      R> /STRING
      ?DUP 0=
   UNTIL
   2DROP ;

: CMOVEV>  ( VADR ADR CNT -- )
   BEGIN
      2PICK OVER #LIM >R
      2PICK >VIRTUAL 2PICK R@
      CMOVE
      ROT R@ + -ROT R> /STRING
      ?DUP 0=
   UNTIL
   DROP ;

: VMSAVE  ( AS AE+1 ANAME CT -- )
   1 CLOSE
   1 DR# 1 OPEN IOERR ?DISK
   OVER -
   OVER  SPLIT SWAP
   1 CHKOUT ?IO  DEMIT DEMIT CLRCHN
   BEGIN
      2DUP #LIM >R
      OVER >VIRTUAL R@
      1 CHKOUT ?IO DTYPE CLRCHN
      R> /STRING ?DUP 0=
   UNTIL
   DROP 1 CLOSE ;

#LIM is a helper word which takes a virtual address and a count. It returns the unsigned minimum of the count and the maximum size for a move which will not overflow the block buffer.
CMOVE>V and CMOVEV> are considerably faster when moving a large amount of data. When moving a few bytes, no so much.


Top
 Profile  
Reply with quote  
PostPosted: Sun Jun 11, 2023 9:54 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

Last year I mentioned the changes I made to Fleet Forth's (ABORT") (.") and (") , the primitives compiled by ABORT" ." and " .
I've made another change.
The source presented for (") .
Code:
: (")  ( -- ADR )
   R@
   >ASSEM
   IP )Y LDA  SEC
   IP ADC  IP STA
   CS IF  IP 1+ INC  THEN
   NEXT JMP  END-CODE

Nine bytes were shaved off this by modifying ?BRANCH .
The original ?BRANCH .
Code:
CODE ?BRANCH  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= NOT IF
      LABEL 2.IP.+!
      CLC
      IP LDA  2 # ADC  IP STA
      CS IF  IP 1+ INC  THEN
      NEXT JMP
      A>CS THEN  A>CS THEN  \ ?BRANCH skips
      PHA                   \ this.
      A>CS THEN             \ It's support code
      TYA  PHA  0 # LDY     \ for (LOOP) and (+LOOP).
   THEN
   LABEL BRANCH.BODY        \ The CFA of BRANCH points here.
   IP )Y LDA  PHA  INY
   IP )Y LDA  IP 1+ STA
   PLA  IP STA
   NEXT 2+ JMP  END-CODE

And the modification.
Code:
CODE ?BRANCH  ( F -- )
   INX  INX
   $FE ,X LDA  $FF ,X ORA
   0= NOT IF
      LABEL 2.IP.+!
      1 # LDA
      LABEL X.IP.+!
      SEC  IP ADC  IP STA
      CS IF  IP 1+ INC  THEN
      NEXT JMP
      A>CS THEN  A>CS THEN  \ ?BRANCH skips
      PHA                   \ this.
      A>CS THEN             \ It's support code
      TYA  PHA  0 # LDY     \ for (LOOP) and (+LOOP).
   THEN
   LABEL BRANCH.BODY        \ The CFA of BRANCH points here.
   IP )Y LDA  PHA  INY
   IP )Y LDA  IP 1+ STA
   PLA  IP STA
   NEXT 2+ JMP  END-CODE

The label X.IP.+! has nothing to do with the X-register. It is X in the sense of a variable quantity, specifically the value in the accumulator plus one.
These two different versions of ?BRANCH do the same thing by slightly different means. The modification allowed me to shorten (") by nine bytes.
The new code for (") .
Code:
: (")  ( -- ADR )
   R@
   >ASSEM
   IP )Y LDA
   X.IP.+! JMP
   END-CODE


This change to ?BRANCH necessitated a change to NEXT .
I have a modified version of Blazin' Forth's TRACE utility. Blazin' Forth's trace utility works by patching NEXT . On at least one occasion I neglected to turn tracing off with NOTRACE before forgetting a word which resulted in forgetting the trace words. Since NEXT was still patched, disaster struck when the dictionary grew to where the destination address in the patch to NEXT was overwritten.
NOTRACE calls NEXT> to restore NEXT so I decided to include it in Fleet Forth's kernel. I wrote a slightly smaller version of NEXT> for Fleet Forth's kernel.
Code:
CODE NEXT>  ( -- )  // RESTORE NEXT
   2 # LDY
   BEGIN
      2.IP.+! ,Y LDA
      NEXT1 ,Y STA  DEY
   0< UNTIL
   NEXT JMP  END-CODE

This works by copying three bytes from ?BRANCH to replace the JMP placed in NEXT by the trace word >NEXT .
Fleet Forth's NEXT was changed from this:
Code:
   LABEL NEXT
   1 # LDY
   IP )Y LDA  W 1+ STA  DEY
   IP )Y LDA  W    STA  CLC
   IP LDA  2 # ADC  IP STA
   CS NOT IF               \ The idea for this
      W 1- JMP             \ was from
   THEN                    \ Garth Wilson.
   IP 1+ INC
   W 1- JMP  END-CODE

To this:
Code:
   LABEL NEXT
   -->

SCR# 10
// NEXT
   1 # LDY
   IP )Y LDA  W 1+ STA  DEY
   IP )Y LDA  W    STA
   LABEL NEXT1
   1 # LDA
   SEC  IP ADC  IP STA
   CS NOT IF               \ The idea for this
      W 1- JMP             \ was from
   THEN                    \ Garth Wilson.
   IP 1+ INC
   W 1- JMP  END-CODE

FORGET was modified to include NEXT> . To clarify, Blazin' Forth's trace function replaces the first three bytes at the label NEXT1 with a jump instruction. FORGET , and EMPTY , will now restore NEXT .


Top
 Profile  
Reply with quote  
PostPosted: Tue Jun 20, 2023 9:15 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 895

I took a look at an experimental word I wrote in response to some posts about three years ago. The word SFORGET was an experimental word which would only forget smudged words. I thought it would be a good idea to incorporate that ability directly into FORGET so it could forget a word even if it was smudged. Here is my first attempt.
The relevant section of code for Fleet Forth's original FORGET .
Code:
: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   VFIND ?HUH  >LINK


VFIND (vocabulary find) is like the find primitive (FIND) with one exception. It will not search parent vocabularies. It has no body of its own. It's code field points one byte into the body of (FIND) and it takes the same parameters: the address of the search string and the address of a vocabulary. It does not take the address of the latest word in a vocabulary. Assuming the address of a counted string is already on the data stack, it is used like this:

CURRENT @ VFIND
or
CONTEXT @ VFIND
or even
' FORTH >BODY VFIND

It is NOT used like this:

CURRENT @ @ VFIND

The word to be forgotten will only be forgotten if it is defined in the CURRENT vocabulary. The CONTEXT vocabulary will be set equal to the CURRENT vocabulary so there is no possibility of CONTEXT pointing to a vocabulary which was forgotten.
If the name was not found, ?HUH aborts with the message "WHAT?"
If the name was found, its CFA is converted to its LFA (link field address) the word's first field. This address is the "forget point."
It will be the new HERE and the lesser of it and the "empty point" will be the new "empty point." From this point on, FORGET will trim the VOC-LINK , a chain of all vocabularies. Of the vocabularies remaining in the VOC-LINK (the others will be forgotten) each of them will be trimmed. FORGET resets all deferred words which have a "vector" above the "forget point."
This is the modification to FORGET .
Code:
: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   VFIND 0=
   IF
      DUP TSB  CURRENT @ VFIND ?HUH
   THEN
   >LINK


The idea is if the word is not found, smudge the count of the search string and try once more.
This approach only adds sixteen bytes to the system but it has at least two flaws.
First, it only works on systems which set the high bit at the end of a word's name to signal the end of the word not just for traversing a word but also for the find primitive.
Second, if the smudged word is a redefinition of another word, FORGET will find the other word and either forget that word or abort with the message that the word is "PROTECTED." This effectively removes the advantage of the new FORGET when testing an idea for an improved system word. I suppose the "smudged" version of the search string could be used first and if it is not found then use the version which is not smudged; however, I said this approach has at least two flaws. The third flaw is more of a philosophical point, yet it may have unforeseen repercussions. When a word is sought in a dictionary search, the most recent definition with that name is found. According the Forth-83 standard, FORGET searches the compilation vocabulary so the latest word in the compilation vocabulary with the sought after name should be the one found.

Given these three flaws, FORGET really should have a version of (FIND) of it's own, FFIND , FORGET FIND or FORGET's FIND . Only a slight modification of Fleet Forth's (FIND) is required to accommodate this new word with a minimal size increase.

(FIND) masks off the highest two bits of a dictionary entry's count so that even immediate words will be found but smudged ones will not. Fleet Forth's smudge bit has the value $20. The value ANDed to the count byte of an entry is $3F, all the bits of the count and the smudge bit are used in the comparison. A version of (FIND) which ANDs the value $1F would find a matching word even if it's name was smudged. This is a detriment to the Forth interpreter and compiler, but quite useful for FORGET .
The modification to (FIND) is to logically AND the entry's count byte with the value from a zero page location. (FIND) and VFIND will store a value of $3F in this location; therefore, they will behave as they always have. The new find word FFIND will store the value $1F in this location by loading $1F into the accumulator and branch into the body of (FIND) . FFIND will find a matching name regardless of whether it is smudged, but only in the specified vocabulary. Like VFIND it will not search parent vocabularies, which is perfect for FORGET . Obviously, I feel strongly that FORGET should only operate on the compilation vocabulary, specified by CURRENT because that is where new definitions are added. Here are the relevant sections of Fleet Forth's (FIND) .
Code:
CODE (FIND)  ( ADR VOC -- ADR2 F )
   DEY  N 1- STY   \ N-1 is a flag
         .         \ $FF = check parent vocabularies
         .         \ $00 = do not check parent vocabularies
         .
         N )Y LDA
         SBIT $1F OR # AND   \ combine smudge bit with count bits
         N 2+ )Y EOR         \ for the mask
         .
         .
         .

And the modifications:
Code:
NH    \ make the following word headerless
CODE FFIND  ( ADR VOC -- ADR2 F )
   $1F # LDA
   0= IF  CS>A  END-CODE    \ branch out of FFIND
CODE (FIND)  ( ADR VOC -- ADR2 F )
   DEY  SBIT $1F OR # LDA
   A>CS  THEN               \ branch from FFIND to this address
   N 1- STY  N 6 + STA
         .
         .
         .
         N )Y LDA   N 6 + AND
         N 2+ )Y EOR
         .
         .
         .

This works well enough. For a ram based system like Fleet Forth, it can be better with some Self Modifying Code.
Code:
NH                         \ headerless
CODE FFIND  ( ADR VOC -- ADR2 F )
   $1F # LDA
   0= IF  CS>A  END-CODE
CODE (FIND)  ( ADR VOC -- ADR2 F )
   DEY  SBIT $1F OR # LDA
   A>CS  THEN               \ FFIND branches to this address
   N 1- STY
   HERE 1+ >A  $BAD STA     \ Store the value in the accumulator
         .
         .
         .
         N )Y LDA   $1F # AND   \ into the operand for this AND immediate
         HERE 1- A> !           \ opcode
         N 2+ )Y EOR
         .
         .
         .

This version of (FIND) is only five bytes bigger. The headerless FFIND is only six bytes. The original FORGET gets one slight modification.
Code:
: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   FFIND ?HUH
   >LINK


VFIND gets replaced with FFIND . This is a version of FORGET which will forget the most recent word in the compilation vocabulary which matches the search string regardless of whether it is smudged. Adding this ability only increases the size of Fleet Forth's kernel by eleven bytes.

Here is the full source for Fleet Forth's FORGET as it was before adding the ability to forget smudged words. As I said, the only difference is VFIND gets replaced with FFIND .
Code:
SCR# 14
// FORGET
: FORGET  ( -- )
   NAME  CURRENT @ DUP CONTEXT !
   VFIND ?HUH  >LINK
   LABEL (FORGET)
   NEXT> UNLINK SINGLE
   DUP>R FENCE @
   LIT
   LABEL KERNEL-FENCE
   [ 0 , ]  // WILL BE PATCHED
   UMAX U<
   ABORT" PROTECTED"
   VOC-LINK R@ TRIM
   VOC-LINK @
   -->

SCR# 15
// FORGET
   BEGIN
      DUP 2- 2- R@ TRIM
      @ ?DUP 0=
   UNTIL
   R> DUP DP ! [ 'THERE ] LITERAL @
   UMIN [ 'THERE ] LITERAL !
// RESET ANY SYSTEM DEFERRED WORD
// WITH CFA ABOVE HERE
   HERE [ END.FORGET ] LITERAL
// BRANCH INTO IORESET
   BRANCH [ (IORESET) , ] -;

Edit: I used the word any when I meant a. The word FFIND will find the most recent word in the specified vocabulary which matches the search string. Unlike (FIND) or VFIND it will find that word even if it is smudged. I also failed to mention that the modified (FIND) is not noticeably slower than the original because the extra work is performed before the first loop is entered.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 354 posts ]  Go to page Previous  1 ... 17, 18, 19, 20, 21, 22, 23, 24  Next

All times are UTC


Who is online

Users browsing this forum: No registered users and 25 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to: