Camel99 Forth Information goes here

+TheBF · May 11, 2021

Forth as a Script Language

DOCGEN is working at the simple level outputting to the screen as you can see in the video.

If nothing else this lets me get file names and all words and stack diagrams from the library files.

There is some other cruft from misc. comments in the code but that' easy to cleanup.

I have the markers working to have special comments spill out. I will look to see if there any that should go into a document.

I hesitate to add much more text to the library files because it takes disk space on our little drives.

I have a re-worked the OUTPUT system os it has a 2K VDP buffer. It stores counted strings and there is a word FLUSHALL to write the buffer to the output file where each counted string is a record. I need to integrate the output system to DOCGEN and then I think I will use Classic99 and send all the text to CLIP and paste that into a word file.

I halted the process in the video with break to limit the video length.

+TheBF · May 14, 2021

Well... it turns out that creating a bullet proof script language, to interpret the keywords in source code, with re-directed output to a file is not as easy as I would like it to be.

I have made some good progress but encountered some bugs that crash the program. A big bug was accidentally inserting binary zero into text files.

TI-99 really doesn't like that.

The spoiler text was generated by running DOCGEN on DSK1.

It crashed on the CODEX1 file. Not sure why yet.

The output is not pretty yet but can provide a skeleton for me to document all the libraries.

Also some of the output is not complete because I need to go through all the files and tag the valuable comments with \ *G

This is how you tag a comment to write itself on a new line.

Spoiler


 
DSK1.
123 
 
DSK1.+CONSTANT
 
 +CONSTANT  an incrementing decrementing constants
+CONSTANT       word       
,           create     
DOES>  
Lines: 11 
Bytes: 324 
--- End of file ---
1 
DSK1.2ROT
 
 2ROT is ROT for double precision number.
2ROT            word       ( d d2 d3 -- d2 d3 d) 
Lines: 3 
Bytes: 98 
--- End of file ---
1 
DSK1.3RD4TH
  fast access to items deeper in the stack 
 works like OVER.  50% faster than PICK 
*********************************************** 
***********************************************
3RD         code word  ( a b c d --  a b c d b) 
4TH         code word  ( a b c d e--  a b c d e a) 
Lines: 26 
Bytes: 776 
--- End of file ---
1 
DSK1.80COL
( default colors BLACK on CYAN ) 
40COL       create       40 col register data
80COL       create       80 col register data
VREGS           word       ( addr n -- ) 
40COLS          word       ( -- ) 
80COLS          word       ( -- ) 
Lines: 26 
Bytes: 829 
--- End of file ---
1 
DSK1.ANSFILES
 
 Ansfiles  for Camel99 v2.1 bjf  Feb 2020
 V2.24 removed file length and FAM=0 error test from OPEN-FILE
 V2.25  used new FOPEN to simplify OPEN-FILE, FREAD for READ-FILE
#FILES      constant   
LASTH       variable   
FIDS        create     ( -- addr) 
FATAL           word       ( -- true) 
?HNDL           word       ( n -- ) 
]FID            word       ( hndl -- PAB_addr ) 
NEWHNDL         word       ( -- hndl) 
RELEASE         word       ( hndl -- ) 
SELECT          word       ( hndl -- ) 
VCOUNT          word       ( vdp$adr -- vdpadr len ) 
.FNAME          word       ( padaddr -- ) 
DUMP]           word       ( vaddr -- ) 
?FILERR         word       ( ior -- ) 
FAM         variable   
AND!        code word  ( mask addr -- ) 
OR!         code word  ( mask addr -- ) 
 TI-99 file access mode modifiers
DISPLAY         word       ( -- ) 
SEQUENTIAL      word       ( -- ) 
RELATIVE        word       ( -- ) 
UPDATE          word       ( -- ) 
INPUT           word       ( -- ) 
OUTPUT          word       ( -- ) 
APPEND          word       ( -- ) 
B/REC       variable   
VARI            word       ( size -- fam) 
FIXED           word       ( size -- fam) 
R/W             word       ( -- fam) 
R/O             word       ( -- fam) 
W/O             word       ( -- fam) 
 ANS Forth BIN replaces TI-99 "INTERNAL"
BIN             word       ( fam -- fam') 
DV80            word       ( -- ) 
OPEN-FILE       word       ( $addr len fam -- fid ior) ( -- $addr len b/rec fam
) ( -- addr ) ( -- ior ior ) 
CLOSE-FILE      word       ( fid -- ior) 
EOF             word       ( fid -- c) 
CREATE-FILE     word       ( caddr len fam -- fid ior ) 
FILE-POSITION   word       ( fid -- rec# ior) 
REPOSITION-FILE word       ( rec# fid -- ior) 
DELETE-FILE     word       ( caddr len fam -- ior) 
READ-LINE       word       ( addr u1 fid -- u2 flag ior ) ( addr ior) ( 
-- ior u2) 
WRITE-LINE      word       ( c-addr u fileid -- ior ) ( -- ior) 
Lines: 120 
Bytes: 3627 
--- End of file ---
1 
DSK1.ARRAYS
 
 These work as expected but were a litte slow due to DOES> overhead
 Replaced runtime Forth with machine code that is 3X faster.
 CARRAY  creates a byte size array.
 Usage:  20 CARRAY Q     99 Q C!   Q C@ . ( 99)
CARRAY          word       ( n -- ) 
ALLOT       create     ( n -- addr) 
 ARRAY  creates a cell size array.
ARRAY           word       ( n -- ) 
CELLS       create     ( n -- addr) 
 Usage: ( square bracket is a reminder, this is an array. NOT SYNTAX
   20 CARRAY ]Q     99 6 ]Q C!   6 ]Q C@ . ( 99)
   20 ARRAY ]T    1234 3 ]T !    3 ]T @ . ( 1234)
Lines: 30 
Bytes: 1081 
--- End of file ---
1 
DSK1.ASM9900
 
 ORIGINAL TI-FORTH ASSEMBLER modified by Mark Wills, Turboforth
 Dec 23,2020
 Huge simplification with ANS style branching & looping. Brian Fox
 Notes:
  Compare instruction has been changed to CMP,
  Changed  A, and S, to ADD, SUB,
/ASM        Marker     
R0          constant   
R1          constant   
R2          constant   
R3          constant   
R4          constant   
R5          constant   
R6          constant   
R7          constant   
R8          constant   
R9          constant   
R10         constant   
R11         constant   
R12         constant   
R13         constant   
R14         constant   
R15         constant   
ADR?            word       ( n -- ? ) 
 n is address or register?
GOP'            word       ( arg instr --) 
GOP             word       ( instr --) 
,           create     
DOES>  
GROP            word       
,           create     
DOES>  
GGOP            word       
,           create     
DOES>  
0OP             word       
,           create     
DOES>  
ROP             word       
,           create     
DOES>  
IOP             word       
,           create     
DOES>  
RIOP            word       
,           create     
DOES>  
RCOP            word       
,           create     
DOES>  
DOP             word       
,           create     
DOES>  
 Jump tokens
GTE         constant   
HI          constant   
NE          constant   
LO          constant   
LTE         constant   
EQ          constant   
OC          constant   
NC          constant   
OO          constant   
HE          constant   
LE          constant   
NP          constant   
GCOP            word       
,           create     
DOES>  
@@              word         symbolic addressing
**              word         indirect addressing
*+              word         indirect addressing, auto-increment
()              word         indexed addressing
 Structured branching and looping
AJUMP,          word       ( token --) 
 >1000+token makes a jump instruction
RESOLVE         word       ( 'jmp offset --) 
 compile offset into 'jmp'
<BACK           word       ( addr addr' -- ) 
IF,             word       ( addr token -- 'jmp') 
ENDIF,          word       ( 'jmp addr --) 
ELSE,           word       ( -- addr ) 
BEGIN,          word       ( -- addr) 
WHILE,          word       ( token -- *while *begin) 
AGAIN,          word       ( *begin --) 
UNTIL,          word       ( *begin token --) 
REPEAT,         word       ( *while *begin -- ) 
;CODE           word       
 CAMEL99 Forth named registers
TOS         constant   
(TOS)           word       
*TOS            word       
*TOS+           word       
SP          constant   
(SP)            word       
*SP             word       
*SP+            word       
RP          constant   
(RP)            word       
*RP             word       
*RP+            word       
W           constant   
(W)             word       
*W              word       
*W+             word       
IP          constant   
(IP)            word       
*IP             word       
*IP+            word       
*R10            word       
*R11            word       
 Pseudo instructions
RT,             word       ( -- ) 
NOP,            word       ( -- ) 
NEXT,           word       ( -- ) 
PUSH,           word       ( src -- ) 
POP,            word       ( dst -- ) 
RPUSH,          word       ( src -- ) 
RPOP,           word       ( dst -- ) 
Lines: 190 
Bytes: 5016 
--- End of file ---
1 
DSK1.ASMLABELS
 
 ASMLABELS.FTH   numbered labels for ASM9900           Apr 3 2021 Fox
 Original idea from DxForth. Complete rewrite uses a stack for forward refs.
#FWD        constant   
#LABELS     constant   
FS0         create     
FSP         create     
FSDEPTH         word       ( -- n) 
>FS             word       ( addr --) 
FS>             word       ( -- addr) 
LABELS      create     
]LBL            word       ( n -- addr) 
NEWLABELS       word       ( -- ) 
 clear label array  reset fwd stack pointer to base address
$:              word       ( n -- ) 
 code label creator
$               word       ( n -- 0) 
 jump label creator
?LABEL          word       ( addr -- addr) 
RESOLVER        word       ( -- ) 
 Resolves all reference on the label stack( lbladdress ) ( jmpaddr offset) 
+CODE           word       ( <name> ) 
;           code word  
 Used to jump across CODE words
CODE            word       ( <name> ) 
NEWLABELS   code word  
ENDCODE         word       ( -- ) 
L:              word       ( <text> ) 
;           create     
Lines: 47 
Bytes: 1343 
--- End of file ---
1 
DSK1.AUTOMOTION
 
 Interrupt Driven Sprite motion (like Extended BASIC)  BJF July 21 2019
 Nov 2020  - corrected MOTION to correct X vector when Y vector is negative
          - Changed ]SMT motion array to machine code. Same size as Forth
SMT         constant     SPRITE motion table VDP address
AMSQ        constant     interrupts, software DISABLE bits
 AMSQ bit meaning:
 80 all interrupts disabled
 40 motion disabled
 20 Sound disabled
 10 quit key disabled
 access the sprite tables in VDP like arrays
]SMT        code word  ( spr# -- vaddr) 
MOVING          word       ( n -- )   # of sprites moving automatically
INITMOTION      word       ( -- ) 
STOPMOTION      word       ( -- ) 
AUTOMOTION      word       ( -- ) 
 Enable interrupt motion
MOTION          word       ( vx vy spr# -- ) ( -- vy vx) ( -- vy vx ?) ( 
-- vy vx' ) 
Lines: 39 
Bytes: 1421 
--- End of file ---
1 
DSK1.BASICHLP
 
 Loads TOOLS, INPUT, RANDOM, STRINGS, GRAFIX and CHARSET
 Gives Forth training wheels for new programmers. More like TI-BASIC
Lines: 13 
Bytes: 334 
--- End of file ---
1 
DSK1.BGSOUND
 
SILENT          word       ( --) 
PLAY$           word       ( caddr -- ) 
PLAYLIST        word       ( addr -- ) ( <> 0) 
SHEAD       variable   
STAIL       variable   
SOUNDQ      create     
Q+!             word       ( fifo -- n) 
Q@              word       ( fifo -- n) 
Q!              word       ( n fifo --) 
Q?              word       ( fifo -- ?) 
BGPLAYER        word       ( -- ) 
PLAYER      create     
>SNDQ           word       ( list -- ) 
PLAYQ           word       ( list -- ) 
KILLQ           word       ( -- ) 
?BYTE           word       ( c -- ) 
NUMBUF      create     
BYTE            word       ( -- ) 
/END            word       
Lines: 96 
Bytes: 2752 
--- End of file ---
1 
DSK1.BLOCKS
 
#BUFF       constant   
B/BUF       constant   
B/REC       constant   
LIMIT       constant   
FIRST       constant   
B/SEC       constant   
PREV        variable   
USE         variable   
LOWBLK      variable   
HIGHBLK     variable   
BHNDL       variable   
ACTIVE      create     
?BLOCKS         word       ( -- ) 
MASK        code word  ( n -- n) 
SEEK            word       ( blk# -- ) 
RBLK            word       ( adr blk# -- adr) ( end-addr,start-addr) 
WBLK            word       ( adr blk# -- ) ( end-addr,start-addr) 
UPDATE          word       ( -- ) 
+BUF            word       ( addr1-- addr2) 
BUFFER          word       ( n -- addr ) 
BLOCK           word       ( block# --- addr ) ( faster than 0= UNTIL) 
FLUSH           word       ( -- ) 
EMPTY-BUFFERS   word       ( -- ) 
DF128           word       
OPEN-BLOCKS     word       ( file$ len -- ) 
CLOSE-BLOCKS    word       ( -- ) 
MAKE-BLOCKS     word       ( n file len -- ) 
Lines: 147 
Bytes: 4027 
--- End of file ---
1 
DSK1.BLWP
 
BLWP        code word  ( daddr -- ) 
Lines: 10 
Bytes: 365 
--- End of file ---
1 
DSK1.BOOLEAN
 
BITS/BYTE   constant   
BITS/CELL   constant   
BITS:           word       ( n -- ) 
BITS/BYTE   create     
BITFLD          word       ( bit# bits[] -- bit#' addr) 
BITMASK         word       ( bit# -- n ) 
BIT@            word       ( bit# bits[] -- ?) 
BSET            word       ( bit# bits[] -- ) 
BRST            word       ( bit# bits[] -- ) 
BTOG            word       ( bit# bits[] -- ) 
Lines: 29 
Bytes: 1106 
--- End of file ---
1 
DSK1.BREAK
 
?BREAK          word       ( -- ) 
Lines: 9 
Bytes: 153 
--- End of file ---
1 
DSK1.BUFFER
 
BUFFER:         word       
ALLOT       create     
Lines: 3 
Bytes: 43 
--- End of file ---
1 
DSK1.CALLCHAR
 
>NIB            word       ( char -- n) 
CALLCHAR        word       ( addr len char --) 
Lines: 21 
Bytes: 488 
--- End of file ---
1 
DSK1.CAM267SC
 
DSK1.CAMEL267
 
DSK1.CASE
 
CASE            word       ( -- 0 ) 
OF              word       ( -- ) 
?OF             word       ( flag -- here ) 
ENDOF           word       ( -- ) 
ENDCASE         word       ( -- ) 
Lines: 28 
Bytes: 493 
--- End of file ---
1 
DSK1.CATALOG
 
U.R             word       ( u n --) ( adr len) 
$.              word       ( $addr -- ) 
NEXT$           word       ( addr len -- addr len ) 
$.LEFT          word       ( $ width -- ) 
F>INT           word       ( addr len -- addr len n) ( -- mantissa) ( default) 
DIR.TYPE        word       ( addr -- ) 
HEAD.REC        word       ( addr -- ) ( addr len) 
DIR.REC         word       ( addr -- ) ( addr len) 
PAGEBRK         word       ( -- ) 
CAT             word       ( <DSK?.> ) ( PAD) 
Lines: 90 
Bytes: 2451 
--- End of file ---
1 
DSK1.CHAR
 
CHAR            word       ( -- <c>) 
[CHAR]          word       ( -- <c>) 
Lines: 9 
Bytes: 204 
--- End of file ---
1 
DSK1.CHARSET
 
GROM            word       ( addr -- ) 
GC@+            word       ( -- c) 
]PDT            word       ( char# -- 'pdt[n] ) 
]GFONT          word       ( ascii -- grom_adr) 
GVMOVE          word       ( grom_addr vdp_addr cnt -- ) 
CHARSET         word       ( -- ) 
HICHARSET       word       ( -- ) 
Lines: 38 
Bytes: 1531 
--- End of file ---
1 
DSK1.CLOCK
 
SECONDS     create     
SECONDS++       word       ( -- ) 
TICKER      constant   
1/60            word       ( -- ) 
1SEC            word       ( -- ) 
SEXTAL          word       
<:>             word       
HOLD            word       
<.>             word       
##:             word       
.TIME           word       ( d -- ) 
CLOCK           word       ( -- ) 
Lines: 43 
Bytes: 981 
--- End of file ---
1 
DSK1.CLOCKRAM
 
ctrl        constant   ( base address & control register of clock) 
sec         constant   
day         constant   
date        constant   
BCD>S           word       ( bcd -- n ) 
S>BCD           word       ( n -- bcd ) 
BCD@            word       ( adr -- c) 
clkwrt          word       ( --) 
clkrd           word       ( --) 
CLKOFF          word       ( --) 
CLKON           word       ( --) 
##              word       ( n -- ) 
DAY@            word       ( -- c ) 
TIME@           word       ( -- sec min hr) 
DATE@           word       ( -- date month yr) ( stop updates ) ( 
read the bytes ) 
.TIME           word       ( -- ) 
TIME!           word       ( hr min sec -- ) 
DATE!           word       ( yr month date  -- ) 
.DATE           word       ( -- ) 
Lines: 76 
Bytes: 2025 
--- End of file ---
1 
DSK1.CMLTTY67
 
DSK1.CODE
 
CODE            word       ( -- ) 
NEXT,           word       ( -- ) 
ENDCODE         word       ( -- ) 
Lines: 17 
Bytes: 329 
--- End of file ---
1 
DSK1.CODEMACROS
 
MACRO           word       
;           code word  
;MACRO          word       
DUP,            word       ( n -- n n) 
DROP,           word       ( n --) 
2*,             word       ( n -- n') 
()@,            word       ( addr -- ) ( addr) 
()!,            word       ( addr -- ) ( addr) 
()C@,           word       ( addr -- ) ( addr) 
()C!,           word       ( c addr --) ( addr ) 
LIT,            word       ( n -- ) ( n) 
@,              word       ( addr --) ( addr) 
!,              word       ( n addr -- ) 
C@,             word       ( addr --) 
C!,             word       ( n addr --) 
Lines: 34 
Bytes: 1033 
--- End of file ---
1 
DSK1.CODEX1
 
CSEG        constant   
PLINKS      constant   
CREG        constant   
TOTAL-AMS   variable   
BANK#       variable   
PAGE#       variable   
HOME        create     
CODEX-RESET     word       ( -- ) 
NEWPAGE         word       ( - n) 
pages"      code word  
CMAP            word       ( bank# -- ) ( bank#) 
AMS-HERE        word       ( -- addr) 
DICTIONARY      word       ( -- dp context) 
RELINK          word       ( dp context -- ) 
ACTIVATE        word       ( bank# -- ) 
FAR:            word       ( -- ) 
LOCAL:          word       ( -- ) 
END-LOCAL       word       ( -- ) 
BANK-MEM        word       ( -- n ) 
END-SAMS        word       ( -- ) 
.SAMSCODE       word       
CODEX:          word       ( -- )

+TheBF · May 16, 2021

Dr. C. H. Ting's recursive line drawing routine. PLOT in this version takes no stack parameter. It must have its own container/variable for what it's drawing.


: TINGLINE ( X1 Y1 X2 Y2 -- ) \ ANS version of Ting's code
     2OVER 2OVER  ROT - ABS >R
     - ABS R>
     MAX  2 <
     IF  2DROP PLOT EXIT THEN
     2OVER 2OVER  ROT + 1+ 2/ >R ( Y3)
     + 1+ 2/ ( X3) R>
     2DUP 2ROT
     RECURSE RECURSE ;

+TheBF · May 17, 2021

I got the DOCGEN program doing useful work over the weekend. Some of my source code can still fool DOCGEN so just letting it go on an entire directory proved to be a problem.

By writing some short scripts I was able to create 14 separate glossary files from 120 source code files. This way I didn't blow up the entire output file when a crash happened.

Now I am formatting the text in Libre Office.

A script looked like this:

S" DSK6.GLOSS1"  MAKE-OUTPUT
MAP: DOCGEN

S" DSK1.+CONSTANT" MAPFILE
S" DSK1.2ROT"      MAPFILE
S" DSK1.3RD4TH" MAPFILE
S" DSK1.80COL" MAPFILE
S" DSK1.ANSFILES" MAPFILE
S" DSK1.ARRAYS" MAPFILE
S" DSK1.ASM9900" MAPFILE
S" DSK1.ASMLABELS" MAPFILE
S" DSK1.AUTOMOTION" MAPFILE
CLOSE-OUTPUT

There are a lot of explanation comments missing in the DOCGEN files because I did not go over every file and include the "generate" tokens (*G) .

This means there is a considerable amount of writing still required but it saves time to get the all declarations and stack diagrams.

I now have to change my style to include the *G token to generate meaningful comments in my source code.

Making documents also forced me to double check some things as true. What a concept!

All in all it has been a good project to make as it will save a lot of time in the future.

For the curious the spoiler shows what it took to do this.

The 1st spoiler shows OUTFILE created to let me echo text to the screen and to an output file.

The 2nd spoiler is the DOCGEN program commands.

Spoiler


\ OUTFILE.FTH   echo screen output to text file      May 2021  Brian Fox
\ CPU RAM BUFFER used in this version
\ Automatic flush on buffer overflow

NEEDS .S          FROM DSK1.TOOLS
NEEDS WRITE-FILE  FROM DSK1.ANSFILES
NEEDS VALUE       FROM DSK1.VALUES

DECIMAL
CREATE OUTBUFF 160 ALLOT

0 VALUE OHNDL   \ output file handle

: MAKE-OUTPUT ( a u -- ) \ *G creates a new output file
      DV80 W/O CREATE-FILE ?FILERR  TO OHNDL ;

: W/A ( -- ) APPEND FAM @ ;  \ Not standard Forth but needed for TI file sys.

: OPEN-OUTPUT  ( a u -- ) \ open output file in APPEND mode
      OHNDL ABORT" Output file is already open"
      DV80 W/A OPEN-FILE ?FILERR  TO OHNDL ;

: CLOSE-OUTPUT ( -- )
      OHNDL CLOSE-FILE DROP   0 TO OHNDL ;

: FLUSH-BUFFER ( -- )
      OUTBUFF OUT @ 80 MIN OHNDL WRITE-LINE ?FILERR
      OUT OFF ;  \ reset output counter

: OVERFLOW? ( n -- ) OUT @ + 80 > ;

: STD-OUT ( -- addr) OUTBUFF  OUT @ + ;

: >>BUFFER  ( caddr len -- )
       TUCK   ( -- len caddr len )  \ get a copy of the length
       DUP OVERFLOW?
       IF FLUSH-BUFFER            \ write to disk, reset OUT
       THEN  STD-OUT SWAP CMOVE   \ write string to buffer
       ( len) OUT +! ;             \ update buffer char count

: >>OUT ( caddr len -- )
       OHNDL  DUP 0= ABORT" Output file not open"
       SELECT >>BUFFER ;

\ ==========================================
\ redefine standard output words to echo to file if output handle is active

: EMIT ( c --)
      DUP EMIT
      OHNDL IF HERE C!  HERE 1 >>OUT  EXIT
      THEN DROP ;

: TYPE  ( a u --)
      2DUP TYPE
      OHNDL IF  >>OUT  EXIT
      THEN 2DROP ;

: SPACE   BL EMIT ;
: SPACES  ( n -- ) 0 MAX  0 ?DO  SPACE LOOP ;

: CR   ( -- )
      CR
      OHNDL
      IF \ file is open
         OUT @ 0=
         IF \ buffer is empty add a space
            SPACE
         THEN
         FLUSH-BUFFER
      THEN ;

\ number output with echo
: UD.    ( d -- ) <#  #S  #> TYPE SPACE ;
: U.     ( u -- ) 0 UD. ;
: .      ( n -- ) DUP ABS 0 <#  #S ROT SIGN  #> TYPE SPACE ;

Spoiler


\ DOCGEN.FTH   Extract words and comments from Files    Fox  APR 29 2021

\ Principle is based on DOCGEN system by MPE Forth systems but simpler.
\ Let the Forth dictionary do the work.
\ Create a set of duplicate keywords in a WORDLIST
\ Make a new interpeter loop
\ Open a file, read it and INTERPRET each line
\ 1. Interpret with ONLY KEYWORDS WORDLIST
\ 2. Anything not recognized is ignored
\ 3. Keywords that are found DO a DOCGEN action.
\    See code for KEYWORDS details

MARKER /DOCGEN
NEEDS .S        FROM DSK1.TOOLS
NEEDS MAKE-OUTPUT FROM DSK6.OUTFILE

NEEDS CASE      FROM DSK1.CASE
NEEDS DEFER     FROM DSK1.DEFER
NEEDS DUMP      FROM DSK1.TOOLS
NEEDS OPEN-FILE FROM DSK1.ANSFILES
NEEDS MALLOC    FROM DSK1.MALLOC
NEEDS WORDLIST  FROM DSK1.WORDLISTS
NEEDS VALUE     FROM DSK1.VALUES
NEEDS -TRAILING FROM DSK1.TRAILING

ONLY FORTH DEFINITIONS
\ string helpers ..............

\ allocate a string in low RAM. No safety net!
: STRING:   CREATE  ALLOT  ;

256 STRING: TEMP$   \ concatenate buffer
: +PLACE ( addr n $ -- ) 2DUP 2>R  COUNT +  SWAP CMOVE 2R> C+! ;

: &    ( addr len addr len -- addr len ) \ concatenate operator
       2SWAP TEMP$ DUP>R PLACE
       R@ +PLACE
       R> COUNT ;  \ return address of TEMP$

\ file handles
0 VALUE MAPH

\ Directory manager .................................
DECIMAL
\ Directory array ................
DECIMAL
VARIABLE DIRPT
: DMEM      DIRPT @ ;
: DALLOT    DIRPT +! ;
: N,        DMEM ! 2 DALLOT ;
: DIR$,    ( c-addr u -- ) DMEM OVER 1+ DALLOT PLACE  ;

\ max size for 127 file names in TI99 directory. We have room for 256
10 1+ 256 * CONSTANT DIRSIZE

HEX  2000 H !    \ reset the heap now
DIRSIZE MALLOC CONSTANT []DIR   \ counted string array in low RAM

\ index into a counted string array. (poor man's linked list)
: NTH$  ( $array ndx -- caddr len ) 0 ?DO COUNT + LOOP ;

\ navigate the []DIR array.
: ]DIR$ ( n -- caddr ) []DIR SWAP NTH$ ;
: CLR.ARRAY ( addr -- ) DUP DIRPT !  DIRSIZE  0 FILL  ;

VARIABLE #FILES
HEX
: READ-DIR  ( Caddr len -- ) \ read dir into []DIR array
          []DIR CLR.ARRAY
          #FILES OFF
          RELATIVE 100 FIXED R/O BIN OPEN-FILE ?FILERR >R
          PAD 50 R@ READ-LINE ?FILERR 2DROP \ read disk name
          LINES OFF
          BEGIN
             PAD DUP 80 R@ READ-LINE ?FILERR 2DROP \ file name
             ( PAD) C@
          WHILE \ do while length > 0
             PAD COUNT DIR$,
             1 #FILES +!
             ?BREAK
          REPEAT
          R> CLOSE-FILE \ ?FILERR
          DECIMAL
          CR #FILES @ . ." files" CR
          HEX ;

: SEEDIR  #FILES @ DUP 0= ABORT" DIR not read"
          0 ?DO   I ]DIR$ COUNT TYPE SPACE   LOOP ;

\ File stats ................................
VARIABLE #BYTES
VARIABLE #LINES

: RESET-STATS  ( -- )  #BYTES OFF   #LINES OFF ;

\ =====================================================
\ file mapper applies MAPACTION to all lines in a file


: REPORT
          DECIMAL
          CR S" Lines: " TYPE #LINES @ U.
          CR S" Bytes: " TYPE #BYTES @ U. ;

82 STRING: READBUFF
: REFILL ( -- addr len)
      READBUFF DUP 80 MAPH READ-LINE ?FILERR DROP
      DUP #BYTES +! ;

DEFER MAPACTION
: MAP: '     IS MAPACTION  ;

\ use: MAP: DOCGEN  S" DSK1.MYFILE" MAPFILE
: MAPFILE  ( addr len --)
    2DUP CR TYPE CR
    RESET-STATS
    DV80 R/O OPEN-FILE  DUP IF 2DROP EXIT THEN ?FILERR  TO MAPH
    BEGIN
      REFILL ( -- addr len ) MAPACTION
      #LINES 1+!
      MAPH EOF
    UNTIL
    REPORT
    CR S" --- End of file ---" TYPE
    CR DEPTH .
    MAPH CLOSE-FILE ?FILERR
    0 TO MAPH
;

\ =========================================================
\ DOCGEN  finds keywords and definitions and coded comments

: TYPE.L ( Addr len width -- )  \ type left justified by width
          OVER - 0 MAX >R  TYPE  R> SPACES ;

VOCABULARY KEYWORDS
ONLY FORTH ALSO KEYWORDS DEFINITIONS

\ docgen tokens: short list from MPE Forth
 CHAR G CHAR * FUSE CONSTANT '*G'   \ Generate a comment on new line
 CHAR * CHAR * FUSE CONSTANT '**'   \ print comment on same line

DECIMAL
\ change the meaning of special Forth words so they output information
: VARIABLE   CR PARSE-NAME 12 TYPE.L  S" variable"   11 TYPE.L ;
: CREATE     CR PARSE-NAME
             DUP 0= IF   2DROP
             ELSE 12 TYPE.L  S" create"     11 TYPE.L
             THEN ;

: DOES>      14 SPACES S" CREATE/DOES>" TYPE CR  ;

: CONSTANT   CR PARSE-NAME 12 TYPE.L  S" constant"   11 TYPE.L ;
: USER       CR PARSE-NAME 12 TYPE.L  S" user"       11 TYPE.L ;
: ARRAY      CR PARSE-NAME 12 TYPE.L  S" int array"  11 TYPE.L ;
: CARRAY     CR PARSE-NAME 12 TYPE.L  S" char array" 11 TYPE.L ;
: VALUE      CR PARSE-NAME 12 TYPE.L  S" value"      11 TYPE.L ;
: CODE       CR PARSE-NAME 12 TYPE.L  S" code word"  11 TYPE.L ;
: MARKER     CR PARSE-NAME 12 TYPE.L  S" Marker"     11 TYPE.L ;
: ENUM       CR PARSE-NAME 12 TYPE.L  S" Enumerated " TYPE ;
: FROM       CR S" Dependancy: "  TYPE  PARSE-NAME TYPE ;
: INCLUDE    CR S" Includes  : "  TYPE  PARSE-NAME TYPE ;

\ The line comment becomes an interpreter so that normal comments are ignored
\ Tokens that follow the comment char are interpreted as commands
\ *G  generate text on a new line
\ **  output text on same line
: \   ( -- )
      1 PARSE
      OVER @
      CASE
        '*G' OF CR  2 /STRING TYPE           ENDOF
        '**' OF S"  "  TYPE  2 /STRING TYPE  ENDOF
                 2DROP
      ENDCASE
;

: (       S" ( " TYPE  [CHAR] ) PARSE TYPE S" ) "  TYPE ;
: :       CR  PARSE-NAME 12 TYPE.L      S" word " 11 TYPE.L  ;

ONLY FORTH DEFINITIONS
\ keyword interpret only executes KEYWORDS. Does nothing for anything else
: DOCGEN ( addr len -- )
          ONLY KEYWORDS
         'SOURCE 2! >IN OFF
          BEGIN
              BL WORD DUP C@ ( -- Caddr len)
          WHILE
              FIND ( -- XT ?)
              IF ( -- XT)             \ we found a word
                 DUP ['] ONLY =      ( can't let file change search order)
                 OVER ['] FORTH = OR ( -- XT ? )
                 IF   DROP
                 ELSE EXECUTE
                 THEN
              ELSE
                 DROP
              THEN
          REPEAT
          DROP
          ONLY FORTH
;

\ ===========================================
\ directory processor ALLFILES
DECIMAL
 20 STRING: DEV$    \ DSK1. DSK2. etc.

\ Usage:   MAP: DOCGEN  S" DSK1." ALLFILES

: ALLFILES ( addr len -- ) \ input arg is a valid disk device name
       2DUP DEV$ PLACE
       CR ." Reading catalog " DEV$ COUNT TYPE
       READ-DIR
       #FILES @ 0
      ?DO
          DEV$ COUNT  I ]DIR$ COUNT &   MAPFILE
          ?TERMINAL ABORT" halt!"
      LOOP ;

MAP: DOCGEN

+TheBF · May 19, 2021

So this by no means the end of the road for this document but it is more than we had before.

The is library file reference document. For some files there is just the word and the stack diagram. (inputs/output)

To some degree the file name gives some context and there are more things to read in the files themselves.

I will add to this document as time permits. I just recently got a little contract work that will take me away from all this fun for bit.

If anybody has any questions I will be checking in here regularly and I can update specific parts of the document that are wanting more attention.

CAMEL99-LIB-GLOSSARY.pdf

+TheBF · May 24, 2021

Over on the help I'm stuck topic I made a piece of code that I quite like.

I thought I would separate it out here for anyone playing with character patterns who might have a use.

It makes nice use of the Forth stack-string addr,len pair and the /STRING word.

It is so simple to cut strings as needed with this technique. It always amazes me because brain doesn't go there first.

To perform SEG$(A$,1,4) we use:

DROP 4

Meaning drop the existing length and replace it with a 4.

SEG$(A$,4,LEN(A$)-4) becomes:

   4 /STRING

HEX#, converts a string to 16 bit ints and compiles them into memory so you can easily make multi-character pattern data structures from a text string.

This can make it easier to translate BASIC DATA statements that are character patterns when you want to borrow some game ideas from BASIC programs.

(Which is why I made CALLCHAR as well)

There is no compiling speed improvement versus CALLCHAR (from the GRAFIX library) but HEX#, can save memory if you have a lot of pattern data, by storing integers instead of strings and the patterns will change much faster when you use HEX#, compiled patterns, fed into CHARDEF.


: HEX#, ( addr len  --) \ can be used for longstrings
        BASE @ >R  \ save radix
        HEX               \ we are converting hex numbers in the string
        BEGIN
        DUP WHILE        \ while len<>0
            2DUP DROP 4  \ get 4 digits from left end of string
            NUMBER? ABORT" Bad number"  \ convert string to number
             ,           \ compile the integer into memory
            4 /STRING    \ cut 4 digits off left side of string
        REPEAT
        2DROP
        R> BASE !  \ restore radix
;

+TheBF · June 13, 2021

I finally convinced my V2.67 code to run over RS232. It turns out that for reasons I don't understand yet, I had to reset my stacks before entering the interpreter.

That's usually an indication that there is something I am missing in the startup code but I can't see what it might be. I will figure that out eventually.

I really want to make a file editor that works over RS232. I took to studying a paper on editors by Ray Valdes written in 1993.

It has a lot of good ideas and it showed a factored out single line editor in C. That seem like a good way to start and after way more time than I wanted it to take, I have

EDITLN ( addr buffsize col -- ) that lets me point this thing at a block of memory and edit it.

I re-worked some code to handle escape sequences from the keyboard so I can have the HOME,END, arrow keys etc. work as expected. They work ok as long as I set the terminal to send characters with a slightly delay. Without a receive interrupt on the com port I have to do it that way.

(I may revisit bringing in some code I have that successfully gave me interrupt driven receive.

It might make more sense to compile it into a running kernel than trying to wake up the machine with it.)

I have used DEFER words as place holders for the future functions that will be coded for whatever the editor becomes.

I have one bug to kill when I cursor back and forth too much but it is working otherwise.

I am excited about getting this TTY based system working as a development environment on real hardware.

I envision using the VDP screen on a separate workspace/task that can be used to for graphics and games but the PC keyboard can still be the controller.

Edit: Updated code to working version

Spoiler


\ editln.fth  single line input with insert,delete & tab/-tab  Brian Fox 2021

NEEDS CASE        FROM DSK1.CASE
NEEDS COMPARE     FROM DSK1.COMPARE
NEEDS DEFER       FROM DSK1.DEFER
NEEDS -TRAILING   FROM DSK1.TRAILING
NEEDS DUMP        FROM DSK1.TOOLS
NEEDS <ERASERIGHT> FROM DSK1.VT100+  \ extra vt100 screen functions

MARKER /EDLINE

\ =====================[ Case statement Extension ]=====================
: 2OVER ( d1 d2 -- d1 d2 d1 )  3 PICK 3 PICK ;
: $$=  ( addr n addr n -- ?) ROT MIN S=  0= ;
: $OF  ( addr len -- )
        POSTPONE 2OVER
        POSTPONE $$=
        POSTPONE IF
        POSTPONE 2DROP
; IMMEDIATE

\ ======================[ escape code reader ]===========================
\ TKEY wait for a key -or- counter hits zero
\ Approx. 1 mS per count value on TI-99/4A
DECIMAL
: TKEY ( wait-time -- 0 | c )
        BEGIN
          DUP
        WHILE
          CKEY? ?DUP
          IF   NIP EXIT
        THEN 1-
        REPEAT ;
\ ESCape sequence reader. Needed for polled RS232.
: READ-SEQ  ( caddr n -- n')
        OVER + OVER
        BEGIN
          250 TKEY   \ wait 250 mS MAX for a character
        DUP WHILE
            OVER C!  \ store char in caddr
            1+       \ bump n
        REPEAT
        OVER C!       \ store last character
        NIP SWAP -    \ compute length
;
\ =========================[ Line editor]==============================
DECIMAL
\ data variables for the editor
VARIABLE EBUFF  \ Pointer to buffer we are editing.
VARIABLE ELEN   \ max length of editing buffer
VARIABLE ECOL   \ the cursor position in the buffer
VARIABLE INSERTING

CREATE COL/ROW  0 , 0 ,   \ remembers screen position for editor

: COL/ROW!  ( col row -- ) COL/ROW 2! ;  \ screen position of editor

COL/ROW CONSTANT EROW   \ when we just need the row variable

: 'EBUFF    ( -- addr)   EBUFF @ ;    \ return address of the buffer
: GETXY     ( -- col row ) VROW 2@ ;  \ get Forth's screen position
: BLANK     ( addr len -- ) BL FILL ;
: LEN       ( caddr -- n)  ELEN @ ;    \ return buffer max length

: CLIP      ( n lo hi -- n') ROT MIN MAX ;
: |MARGINS| ( n -- n')  0  LEN 1- CLIP ;
: LIMITED   ( addr -- ) DUP @ |MARGINS| SWAP ! ;
: ECOL+!    ( n -- ) ECOL +! ECOL LIMITED  ;

: OUT$      ( -- caddr len) 'EBUFF LEN ;
: RIGHTSIDE ( -- caddr n) OUT$ ECOL @  /STRING ;

: 'CURS     ( -- addr) 'EBUFF ECOL @ + ;
: !CHAR     ( c -- )  'CURS C! ;

\ Editing cursor control
: CURSRIGHT ( -- )  1 ECOL+! ;
: CURSLEFT  ( -- ) -1 ECOL+! ;
: PUTCHAR   ( c -- ) DUP EMIT !CHAR CURSRIGHT  ;
: TAB       ( -- )  8 ECOL+! ;
: BACKTAB   ( -- ) -8 ECOL+! ;
: TOEOL     ( -- ) OUT$ -TRAILING NIP   ECOL ! ECOL LIMITED ;
: TOGGLE    ( -- ) INSERTING @ -1 XOR INSERTING ! ;
: PUTCURS   ( -- ) ECOL @ EROW @ AT-XY ; \ put cursor on screen
: RELINE    ( -- ) PUTCURS <ERASERIGHT> RIGHTSIDE -TRAILING TYPE  ;
: HOME      ( -- )  ECOL OFF  RELINE ;

: DELCHAR   ( -- )
      RIGHTSIDE 1 /STRING 'CURS SWAP 1+ CMOVE
      BL OUT$ + C!   RELINE
;

: PUSHRIGHT ( -- )
      RIGHTSIDE OVER 1+  SWAP 1- 0 MAX CMOVE>
      BL !CHAR     \ blank at cursor position
;

: BSPACE  ( -- )
      CURSLEFT  08 EMIT
      BL PUTCHAR
      CURSLEFT  08 EMIT
;

\ additional functions are NOOPs at this stage
DEFER PGUP   :NONAME ; IS PGUP
DEFER PGDN   :NONAME ; IS PGDN
DEFER UP     :NONAME ; IS UP
DEFER DOWN   :NONAME ; IS DOWN
DEFER CUT    :NONAME ; IS CUT
DEFER COPY   :NONAME ; IS COPY
DEFER PASTE  :NONAME ; IS PASTE
DEFER UNDO   :NONAME ; IS UNDO

: ESC-HANDLER ( caddr len -- )
     CASE
       S" [C"  $OF   CURSRIGHT ENDOF
       S" [D"  $OF   CURSLEFT  ENDOF
       S" [1~" $OF   HOME      ENDOF
       S" [2~" $OF   TOGGLE    ENDOF
       S" [4~" $OF   TOEOL     ENDOF
       S" [Z"  $OF   BACKTAB   ENDOF
       S" [5~" $OF   PGUP      ENDOF
       S" [6~" $OF   PGDN      ENDOF
       S" [A"  $OF   UP        ENDOF
       S" [B"  $OF   DOWN      ENDOF
    ENDCASE
;

HEX
1B CONSTANT ESC
0D CONSTANT ^M

CREATE CMD$   6 ALLOT  \ escape sequence input buffer

\ IBM PC key codes with extended escape code handler
HEX
: KEYHANDLER ( char -- ) \ TI-99 BASIC key codes used
      CASE
         09 OF  TAB               ENDOF  \ TAB
         08 OF  BSPACE            ENDOF  \ ^backspace
         7F OF  DELCHAR           ENDOF  \ PC Delete / FCTN 1
         19 OF  CUT               ENDOF  \ ^Y
         03 OF  COPY              ENDOF  \ ^C
      ENDCASE
;

DECIMAL
\ : .DEBUG
\      GETXY
\      0 18 AT-XY DEPTH ." S| " .
\      CR  RP0 RP@ - 2/ ." R| " .
\      AT-XY ;

: EDITLN ( addr maxlen col -- ) \ col is the cursor position
      ECOL !
      ELEN !
      EBUFF !
      0 VROW @  COL/ROW!
      INSERTING ON
      <ERASELINE> RELINE
      BEGIN
         PUTCURS KEY DUP>R
         ESC =
         IF
            CMD$ DUP 4 READ-SEQ ( -- addr len )
            ESC-HANDLER
         ELSE
             R@ DUP 20 127 WITHIN
             IF
                 INSERTING @ IF PUSHRIGHT THEN  PUTCHAR RELINE
             ELSE
                 KEYHANDLER
             THEN
         THEN
\         .DEBUG
         R> ^M =
      UNTIL
;

\ test code
: .OUT$     ( -- ) CR  OUT$ -TRAILING TYPE ;

CREATE A$ 120 ALLOT

A$ 120 BLANK
S" Editing a buffer on the TI-99 over RS232.BA=19200" A$ PLACE

A$ COUNT DROP C/L@ 1-  0   PAGE EDITLN

+TheBF · June 13, 2021

I think this EDITLN function is reliable enough to move to the next stage and implement a Forth block editor with it.

+TheBF · June 14, 2021

While looking at the C code in the first spoiler I saw that Valdes put the printable character test and writing to the buffer in the default section of the switch statement.

Spoiler


/* EditLine() -- The simplest text editing routine */
void EditLine(char* buffer, int max_length, int curr_row)
{
    int c, str_length  = strlen(buffer), curr_column = str_length,
           insert_mode = TRUE;
    ChangeCursorShape(insert_mode);
    do
    {   vt_ClearLineAt(curr_row,0);
    vt_OutputStringAt(buffer, curr_row,0);
    vt_SetCursorPositionAt(curr_row,curr_column);
    switch(c = vt_GetKeystroke())   /* dispatch on user's keystroke */
    {
         /*-------- keystrokes that terminate the editing session-----*/
         case ESCAPE_KEY:
         case ENTER_KEY:     break;
        /*--------- keystrokes that merely change the cursor position---*/
 
       case HOME_KEY:      curr_column = 0;                break;
        case END_KEY:       curr_column = str_length;           break;
            case LEFT_KEY:      if (curr_column > 0) curr_column--; break;
        case RIGHT_KEY:     if (curr_column < str_length) curr_column++;
                break;
        case INSERT_KEY:    insert_mode = !insert_mode;
                ChangeCursorShape(insert_mode);
                break;
        /*------ keystrokes that alter the contents of the buffer----*/
        case BACKSPACE_KEY: if (curr_column > 0)
                {
                    movmem( &buffer[curr_column],  /*source*/
                        &buffer[curr_column-1], /*dest*/
                        str_length - curr_column + 1);
                    curr_column--;
                    str_length--;
                }
                break;
         case DELETE_KEY:   if (curr_column < str_length)
                {
                    movmem( &buffer[curr_column+1], /*source*/
                    &buffer[curr_column],       /*dest*/
                    str_length - curr_column);
                    str_length--;
                 }
                 break;
         default:        if (((c >= ' ') && (c <= '~')) &&
                        (str_length < max_length))
                 {
                    if (insert_mode)
                    {
                        movmem(
                            &buffer[curr_column],
                        &buffer[curr_column + 1],
                        str_length - curr_column + 1);
                        str_length++;
                    }
                    else if (curr_column >= str_length)
                        str_length++;
                    buffer[curr_column] = c;
                    curr_column++;
                  }
                  break;
         }
         buffer[str_length] = '\0';
    }
 
    while ((c != ENTER_KEY) && (c != ESCAPE_KEY));
}

This made me wonder how I would do that in Forth and this lead me to find a use for the ?OF extension to the standard Eaker case statement in Forth.

?OF is used to detect a true/false condition in a case/endcase structure and comes from MPE Forth in the UK.

The printable char test uses WITHIN which is assembler in CAMEL99 Forth to generate the flag for ?OF.

This simplified the code nicely for the KEYHANDLER

\ PC/Teraterm key code handler 
HEX
: KEYHANDLER ( char -- ) 
      CASE
         09 OF  TAB               ENDOF  \ TAB
         08 OF  BSPACE            ENDOF  \ ^backspace
         7F OF  DELCHAR           ENDOF  \ PC Delete / FCTN 1
         19 OF  CUT               ENDOF  \ ^Y
         03 OF  COPY              ENDOF  \ ^C
\ default:         
         DUP 20 127 WITHIN
        ?OF  INSERTING @
            IF PUSHRIGHT
            THEN  PUTCHAR RELINE  ENDOF 
      ENDCASE
;

And then EDITLN then becomes:

: EDITLN ( addr maxlen col -- ) \ col is the cursor position
      ECURS !
      ELEN !
      EBUFF !
      GETXY COL/ROW 2!
      INSERTING ON
      <ERASELINE> RELINE
      BEGIN
         PUTCURS KEY DUP>R
         ESC =
         IF
            CMD$ DUP 4 READ-SEQ ( -- addr len )
            ESC-HANDLER
         ELSE
             R@ KEYHANDLER
         THEN
\         .DEBUG
         R> ^M =
      UNTIL
;

+TheBF · June 16, 2021

I finally have RS232 editor that works quite well. Block Editor for TTY or BETTY.

The VIBE editor (Falvo) I had before suffered from using the dictionary search for command lookup which is a bit slow on TI-99.

I used the EDITLN code but quickly realized there was little benefit in passing a pointer to the editor loop.

I was much less complicated to simply compute the line buffer from the col & row position of the cursor the way Forth block editors do.

Now I will add a copy stack in VDP RAM to make CUT,COPY,PASTE and this will be a useful editor.

Once BETTY is done I will move on to a DV80 editor over RS232.

A current disadvantage of using escape sequences is that I don't have repeating functions on the arrow keys and page-up/page-down.

I think it is because while the program is performing the function new escape sequences are coming into the RS232 port and the key loop misses some of the contents.

It's not a show stopper but it does make me long for an ISR that can queue up the keystrokes. Make it work then make it better is how I will proceed.

Spoiler


\ BETTY.FTH  Block Editor for TTY Camel99 Forth    B Fox 2021

NEEDS DUMP        FROM DSK1.TOOLS
NEEDS CASE        FROM DSK1.CASE
NEEDS COMPARE     FROM DSK1.COMPARE
NEEDS DEFER       FROM DSK1.DEFER
NEEDS -TRAILING   FROM DSK1.TRAILING
NEEDS <ERASERIGHT> FROM DSK1.VT100+
NEEDS BLOCK       FROM DSK1.BLOCKS

MARKER /EDLINE
\ ========[ Case statement Extension ]===========
: 2OVER ( d1 d2 -- d1 d2 d1 )  3 PICK 3 PICK ;
: $$=  ( addr n addr n -- ?) ROT MIN S=  0= ;
: $OF  ( addr len -- )
        POSTPONE 2OVER
        POSTPONE $$=
        POSTPONE IF
        POSTPONE 2DROP
; IMMEDIATE

\ =============[ escape code reader ]============
\ TKEY wait for a key -or- counter hits zero
\ Approx. 1 mS per count value on TI-99/4A
DECIMAL
: TKEY ( wait-time -- 0 | c )
        BEGIN
          DUP
        WHILE
          CKEY? ?DUP
          IF   NIP EXIT
        THEN 1-
        REPEAT ;
\ ESCape sequence reader. Needed for polled RS232.
: KEYS  ( caddr n -- n') \ store n KEYS into caddr[n] sequentially
        OVER + OVER
        BEGIN
          250 TKEY   \ wait 250 mS MAX for a character
        DUP WHILE
            OVER C!  \ store char in caddr
            1+       \ bump n
        REPEAT
        OVER C!       \ store last character
        NIP SWAP -    \ compute length
;

\ ===============[ Line editor ]=====================
DECIMAL
: GETXY     ( -- col row ) VROW 2@ ;
: BLANK     ( addr len -- ) BL FILL ;

64 CONSTANT MAXLEN              \ max length of editing buffer

\ variables for the editor
VARIABLE INSERTING
VARIABLE SCR
\ col & row track the cursor position in the file block
VARIABLE ROW
VARIABLE COL

\ compute address of 64 char line in the active block buffer
: ELINE     ( n -- addr) 6 LSHIFT SCR @ BLOCK + ;
: 'EBUFF    ( -- addr)  ROW @ ELINE ;    \ address  in block
: 'CURS     ( -- addr) 'EBUFF COL @ + ;  \ cursor in block

: CLIP      ( n lo hi -- n') ROT MIN MAX ;
: |MARGINS| ( n -- n')  0  MAXLEN 1- CLIP ;
: LIMITED   ( addr -- ) DUP @ |MARGINS| SWAP ! ;
: !CHAR     ( c -- )  'CURS C! ;
\ Editing cursor control
: ECURS+!   ( n -- ) COL +! COL LIMITED  ;
: CURSRIGHT ( -- )  1 ECURS+! ;
: CURSLEFT  ( -- ) -1 ECURS+! ;
: TAB       ( -- )  8 ECURS+! ;
: BACKTAB   ( -- ) -8 ECURS+! ;
: TOGGLE    ( -- ) INSERTING @ -1 XOR INSERTING ! ;

: PUTCURS   ( -- ) COL @ 3 + ROW @ 2+  AT-XY ;
: OUT$      ( -- caddr len) 'EBUFF MAXLEN  ;
: RIGHTSIDE ( -- caddr n) OUT$ COL @ /STRING ;
: RELINE    ( -- ) PUTCURS <ERASERIGHT>  RIGHTSIDE -TRAILING TYPE  ;
: PUTCHAR   ( c -- ) DUP EMIT !CHAR RELINE  CURSRIGHT  UPDATE ;
: HOME      ( -- )  COL OFF  RELINE ;
: TOEOL     ( -- ) OUT$ -TRAILING NIP  COL !  COL LIMITED ;
: DELCHAR   ( -- )
      RIGHTSIDE 1 /STRING 'CURS SWAP  CMOVE
      BL OUT$ + C!   RELINE  ;

: PUSHRIGHT ( -- )
      RIGHTSIDE OVER 1+  SWAP 1- 0 MAX CMOVE>
      BL !CHAR ;    \ blank at cursor position

: BSPACE  ( -- )
      CURSLEFT  08 EMIT
      BL PUTCHAR
      CURSLEFT  08 EMIT
;
\ additional functions are NOOPs at this stage
DEFER ENTER  :NONAME ; IS ENTER
DEFER PGUP   :NONAME ; IS PGUP
DEFER PGDN   :NONAME ; IS PGDN
DEFER UP     :NONAME ; IS UP
DEFER DOWN   :NONAME ; IS DOWN
DEFER CUT    :NONAME ; IS CUT
DEFER COPY   :NONAME ; IS COPY
DEFER PASTE  :NONAME ; IS PASTE
DEFER UNDO   :NONAME ; IS UNDO

: ESCHANDLER ( caddr len -- )
     CASE
       S" [C"  $OF   CURSRIGHT ENDOF
       S" [D"  $OF   CURSLEFT  ENDOF
       S" [1~" $OF   HOME      ENDOF
       S" [2~" $OF   TOGGLE    ENDOF
       S" [4~" $OF   TOEOL     ENDOF
       S" [Z"  $OF   BACKTAB   ENDOF
       S" [5~" $OF   PGUP      ENDOF
       S" [6~" $OF   PGDN      ENDOF
       S" [A"  $OF   UP        ENDOF
       S" [B"  $OF   DOWN      ENDOF
    ENDCASE
;

\ PC/Teraterm key code handler
HEX
: KEYHANDLER ( char -- )
  CASE
  09 OF  TAB               ENDOF  \ TAB
  08 OF  BSPACE            ENDOF  \ ^backspace
  7F OF  DELCHAR           ENDOF  \ PC Delete / FCTN 1
  0D OF  ENTER             ENDOF
  16 OF  PASTE             ENDOF  \ ^V
  19 OF  CUT               ENDOF  \ ^Y
  03 OF  COPY              ENDOF  \ ^C
  11 OF  0 13 AT-XY ." Forth"   QUIT  ENDOF  \ ^Q
  \ Printable:
   DUP 20 127 WITHIN
   ?OF INSERTING @
   IF PUSHRIGHT THEN  PUTCHAR RELINE ENDOF
  ENDCASE ;

HEX
1B CONSTANT ESC
0D CONSTANT ^M

DECIMAL
 : .DEBUG
      GETXY
      0 19 AT-XY DEPTH ." S| " .
      CR  RP0 RP@ - 2/ ." R| " .
      CR  HERE 3 TYPE
      AT-XY ;

\ ================[ BLOCK EDITOR ]====================
DECIMAL
: .RULER ( -- ) 2 SPACES  13 0 DO ." +----" LOOP ;
: .FILE  ( -- ) 30 0 AT-XY  ACTIVE COUNT TYPE ;
: TOP   ( -- ) COL OFF  ROW OFF ;
: LIST  ( n --)
        DECIMAL
        DUP SCR !
        PAGE  ." SCR: " 3 U.R   .FILE
        CR .RULER
        CR 16 0
        DO
           I DUP 2 U.R ." |"
         ( I) ELINE MAXLEN -TRAILING TYPE CR
        LOOP
        ."   +------"  TOP ;

: <LF>  ( -- ) ROW @ 1+  15 MIN ROW ! ;   ' <LF> IS DOWN
: -<LF> ( -- ) ROW @ 1-   0 MAX ROW ! ;   ' -<LF> IS UP

: <CR>  ( -- ) <LF>  COL OFF ;            ' <CR> IS ENTER

: SCR++ ( -- ) SCR 1+!    SCR @ LIST  ;   ' SCR++ IS PGDN
: SCR-- ( -- ) SCR @ 1-  0 MAX SCR ! SCR @ LIST ;
' SCR-- IS PGUP

: EDIT ( 0 -- )
      LIST
      INSERTING ON
      TOP
      BEGIN
         PUTCURS KEY DUP ESC =
         IF DROP
            HERE DUP 3 KEYS  ESCHANDLER
         ELSE
             KEYHANDLER
         THEN
\        .DEBUG
    AGAIN
;

GDMike · June 16, 2021

You know we love videos

+TheBF · June 17, 2021

I keep finding uses for this /STRING function that surprise me. Part of it's power is because takes an addr,len pair and returns a new addr,len pair.

I was reviewing my PUSHRIGHT word, the one that slides text to the right when you are editing in insert mode, and I realized it was simpler like this:

: PUSHRIGHT ( -- )
      RIGHTSIDE OVER SWAP 1 /STRING 0 MAX CMOVE>
      BL !CHAR ;    \ blank at cursor position

The way it works is RIGHTSIDE uses /STRING (another nice use) to derive the string from the cursor and to the right starting with the OUT$ which is the full length of the line we are editing.

: OUT$      ( -- caddr len) 'EBUFF MAXLEN  ;
: RIGHTSIDE ( -- caddr n) OUT$ COL @ /STRING ;

Once we have the RIGHTSIDE ( addr len ) we use OVER SWAP to give us ( addr addr len ) on the data stack.

We cut 1 char off of the top addr,len pair which gives us ( src-addr dst-addr len )

We make sure the len never goes negative with 0 MAX then feed those arguments to CMOVE> and voila! the string slides to the right.

We just have to put a blank character where the cursor is sitting to complete the job.

+TheBF · June 17, 2021

I am very happy with this BETTY editor. I have couple of things to fix most which I made while typing this demo text into the editor.

The video shows what it can do.

I will wrap up this RS232 Forth on a few disks if somebody makes a request for it.

It's quite nice to able to talk to real hardware with your PC keyboard.

Since Camel99 Forth uses DV80 text files for source code the next step is to take these learnings and try and make a serviceable Text editor.

This block file was really a simple way to get a feel for how things work over the RS232 connection but it is a nice foundation to build on.

Here's another video Mike. :)

+TheBF · June 18, 2021

BETTY source code just in case any wants to see it.

I tried to imitate the style in VIBE using short definitions that named the function as well as I could.

Spoiler


\ BETTY.FTH  Block Editor for TTY Camel99 Forth    B Fox 2021

NEEDS DUMP        FROM DSK1.TOOLS
NEEDS CASE        FROM DSK1.CASE
NEEDS COMPARE     FROM DSK1.COMPARE
NEEDS DEFER       FROM DSK1.DEFER
NEEDS -TRAILING   FROM DSK1.TRAILING
NEEDS <ERASERIGHT> FROM DSK1.VT100+
NEEDS BLOCK       FROM DSK1.BLOCKS

MARKER /BETTY

\ ========[ Case statement Extension ]===========
: 2OVER ( d1 d2 -- d1 d2 d1 )  3 PICK 3 PICK ;
: $$=  ( addr n addr n -- ?) ROT MIN S=  0= ;
: $OF  ( addr len -- )
        POSTPONE 2OVER
        POSTPONE $$=
        POSTPONE IF
        POSTPONE 2DROP
; IMMEDIATE
.( .)
\ =============[ escape code reader ]============
\ TKEY wait for a key -or- counter hits zero
\ Approx. 1 mS per count value on TI-99/4A
DECIMAL
: TKEY ( wait-time -- 0 | c )
        BEGIN
          DUP
        WHILE
          CKEY? ?DUP
          IF   NIP EXIT
        THEN 1-
        REPEAT ;

\ ESCape sequence reader. Needed for polled RS232.
: KEYS  ( caddr n -- n') \ store n KEYS into caddr[i] sequentially
        OVER + OVER
        BEGIN
          250 TKEY   \ wait 250 mS MAX for a character
        DUP WHILE
            OVER C!  \ store char in caddr
            1+       \ bump n
        REPEAT
        OVER C!       \ store last character
        NIP SWAP -    \ compute length
;
.( .)
\ ----[ utility words ]----
DECIMAL
: GETXY   ( -- col row ) VROW 2@ ;
: BLANK   ( addr len -- ) BL FILL ;
: Y/N?    ( -- flag) KEY  DUP [CHAR] Y =  SWAP [CHAR] y =  OR ;
: PROMPT: ( -- )  0 19 AT-XY <ERASELINE>  ;
: BELL    07 EMIT ;
: END.    POSTPONE EXIT POSTPONE THEN ;  IMMEDIATE

\ ===============[ Line editor ]=====================
64 CONSTANT MAXLEN   \ length of 1 line in a block
HEX 1B CONSTANT ESC

DECIMAL
VARIABLE INSERTING
VARIABLE SCR
VARIABLE ROW  \ col/row track cursor position in the file block
VARIABLE COL

\ ====[ low level editor functons ]====
: ELINE     ( n -- addr) 6 LSHIFT SCR @ BLOCK + ;
: 'EBUFF    ( -- addr)  ROW @ ELINE ;    \ address in block
: 'CURS     ( -- addr) 'EBUFF COL @ + ;  \ cursor in block
.( .)
: CLIP      ( n lo hi -- n') ROT MIN MAX ;
: |MARGINS| ( n -- n')  0  MAXLEN 1- CLIP ;
: LIMITED   ( addr -- ) DUP @ |MARGINS| SWAP ! ;
: !CHAR     ( c -- )  'CURS C! ;
\ Editing cursor control
: ECURS+!   ( n -- ) COL +! COL LIMITED  ;
: CURSRIGHT ( -- )  1 ECURS+! ;
: CURSLEFT  ( -- ) -1 ECURS+! ;
: >TAB      ( n -- n') DUP 8 MOD - COL ! COL LIMITED ;
: TAB       ( -- ) COL @ 8 + >TAB ;
: BACKTAB   ( -- ) COL @ 8 - >TAB ;

: PUTCURS   ( -- ) COL @ 3 + ROW @ 2+  AT-XY ;
: OUT$      ( -- caddr len) 'EBUFF MAXLEN  ;
: RIGHTSIDE ( -- caddr n) OUT$ COL @ /STRING ;
: RELINE    ( -- ) PUTCURS <ERASERIGHT>  RIGHTSIDE -TRAILING TYPE  ;
: PUTCHAR   ( c -- ) DUP EMIT !CHAR RELINE  CURSRIGHT  UPDATE ;
: ERASELN   ( n -- ) ELINE MAXLEN BLANK UPDATE ;

\ ====[ hi-level editor functions ]====
: TOGGLE  ( -- ) INSERTING @ -1 XOR INSERTING ! ;
: TOEOL   ( -- ) OUT$ -TRAILING NIP  COL ! ;
: DOWN    ( -- ) ROW @ 1+  15 MIN ROW ! ;
: UP      ( -- ) ROW @ 1-   0 MAX ROW ! ;
: HOME    ( -- ) COL OFF ;
: TOP     ( -- ) HOME  ROW OFF ;
.( .)
: DELCHAR   ( -- )
      RIGHTSIDE 1 /STRING 'CURS SWAP  CMOVE
      BL OUT$ + C!   RELINE  ;

: PUSHRIGHT ( -- )
      RIGHTSIDE OVER SWAP 1 /STRING 0 MAX CMOVE>
      BL !CHAR ;    \ blank at cursor position

: BSPACE  ( -- )
      CURSLEFT  08 EMIT
      BL PUTCHAR
      CURSLEFT  08 EMIT
;
\ ================[ Screen format ]==================
DECIMAL
: .RULER ( -- ) 2 SPACES  13 0 DO ." +----" LOOP ;
: .FILE  ( -- ) 30 0 AT-XY  ACTIVE COUNT TYPE ;
: LIST  ( n --)
        DECIMAL
        DUP SCR !
        PAGE  ." SCR: " 3 U.R   .FILE
        CR .RULER
        CR 16 0
        DO
           I DUP 2 U.R ." |"
         ( I) ELINE MAXLEN -TRAILING TYPE CR
        LOOP
        ."   +------"  ;

: RELIST   SCR @ LIST ;  \ re-list current screen
: PGDN    ( -- ) SCR 1+!   RELIST TOP ;
: PGUP    ( -- ) SCR @ 1-  0 MAX SCR ! RELIST TOP ;
.( .)
\ ======================================================
\ CLIPBOARD MANAGEMENT
DECIMAL
VARIABLE #CLIPS    \ count of lines in the clipboard
: #CLIPS+!  ( n --) #CLIPS @ +  0 16 CLIP #CLIPS ! ;

HEX 1000 CONSTANT CLIPBOARD  \ VDP RAM Address

DECIMAL
\ clipline returns the record at top of clipstack
: CLIPLINE ( -- addr) #CLIPS @ MAXLEN * CLIPBOARD +  ;
: LINE2CLIP ( row -- ) 1 #CLIPS+!  ELINE CLIPLINE MAXLEN VWRITE ;
: CLIP2LINE ( row -- ) CLIPLINE SWAP ELINE MAXLEN VREAD  -1 #CLIPS+! ;

\ ====[ Line movers ]====
: BYTES-BELOW ( row -- n)  16 SWAP - MAXLEN * ; \ bytes below cursor

: MOVEUP   ( row --)
  DUP>R 1+ ELINE  R@ ELINE  R> BYTES-BELOW MAXLEN -  CMOVE ;

: MOVEDN   ( row --)
  DUP>R ELINE  R@ 1+ ELINE R> BYTES-BELOW CMOVE>  ;
.( .)
DECIMAL
: .#CLIPS   55 19 AT-XY ." Clips:" #CLIPS @ 3 U.R   ;

: DELETE  \ ^X  extract
  ROW @ MOVEUP  15 ERASELN  RELIST  .#CLIPS ;

: INSRTLN \ ^L
  15 ELINE MAXLEN -TRAILING
  IF PROMPT: ." Erase line 15?" Y/N?
     IF 15 CLIP2LINE
     THEN
  THEN  ROW @ DUP MOVEDN ERASELN RELIST ;

\ clipboard limited to 16 lines. More than that is awkward
: FULL?  ( -- flag)  #CLIPS @ 15 > ;

: CUTLN \ ^Y yank
        FULL? IF BELL  END.
        ROW @ DUP LINE2CLIP MOVEUP
        15 ERASELN
        RELIST  .#CLIPS ;

: COPYLN \ ^C
       FULL? IF BELL  END.
       ROW @ LINE2CLIP  .#CLIPS ;

: PASTELN \ ^V
      #CLIPS @ 0= IF BELL  END.
      ROW @ DUP MOVEDN CLIP2LINE UPDATE
      RELIST .#CLIPS ;

\ PC function keys assignable by user
DEFER [F1]    :NONAME BELL ; IS [F1]
DEFER [F2]    :NONAME BELL ; IS [F2]
DEFER [F3]    :NONAME BELL ; IS [F3]
DEFER [F4]    :NONAME BELL ; IS [F4]
DEFER [F5]    :NONAME BELL ; IS [F5]
DEFER [F6]    :NONAME BELL ; IS [F6]
DEFER [F7]    :NONAME BELL ; IS [F7]
DEFER [F8]    :NONAME BELL ; IS [F8]
.( .)
: ESCHANDLER ( caddr len -- )
     CASE
       S" [A"  $OF   UP        ENDOF
       S" [B"  $OF   DOWN      ENDOF
       S" [C"  $OF   CURSRIGHT ENDOF
       S" [D"  $OF   CURSLEFT  ENDOF
       S" [Z"  $OF   BACKTAB   ENDOF
       S" [1~" $OF   HOME      ENDOF
       S" [2~" $OF   TOGGLE    ENDOF
       S" [4~" $OF   TOEOL     ENDOF
       S" [5~" $OF   PGUP      ENDOF
       S" [6~" $OF   PGDN      ENDOF

       S" [11~" $OF  [F1]       ENDOF
       S" [12~" $OF  [F2]       ENDOF
       S" [13~" $OF  [F3]       ENDOF
       S" [14~" $OF  [F4]       ENDOF
       S" [15~" $OF  [F5]       ENDOF
       S" [17~" $OF  [F6]       ENDOF
       S" [18~" $OF  [F7]       ENDOF
       S" [19~" $OF  [F8]       ENDOF
    ENDCASE
;
.( .)
\ ====[ PC/Teraterm key code handler ]====
HEX
: KEYHANDLER ( char -- )
  CASE
    03 OF  COPYLN               ENDOF  \ ^C
    08 OF  BSPACE               ENDOF  \ ^backspace
    09 OF  TAB                  ENDOF  \ TAB
    0C OF  INSRTLN              ENDOF  \ ^L
    0D OF  DOWN  COL OFF        ENDOF  \ ^M or Enter
    13 OF  FLUSH                ENDOF  \ ^S
    16 OF  PASTELN              ENDOF  \ ^V
    18 OF  DELETE               ENDOF  \ ^X
    19 OF  CUTLN                ENDOF  \ ^Y
    1A OF  EMPTY-BUFFERS RELIST ENDOF  \ ^Z
    7F OF  DELCHAR              ENDOF  \ PC Delete
    11 OF  PROMPT: ." Forth"
           CR QUIT              ENDOF  \ ^Q

  \ Printable:
    DUP 20 127 WITHIN
    ?OF INSERTING @
    IF PUSHRIGHT THEN  PUTCHAR RELINE ENDOF
  ENDCASE ;
.( .)
DECIMAL
DEFER DEBUG

DECIMAL
: EDIT ( 0 -- )
      LIST
      INSERTING ON
      TOP
      BEGIN
         PUTCURS KEY DUP ESC =
         IF DROP
            HERE DUP 4 KEYS  ESCHANDLER
         ELSE
             KEYHANDLER
         THEN
\         DEBUG
     AGAIN
;

\ ---[ BONUS  functions ]---
CLIPBOARD B/BUF + CONSTANT COPYBUFF
.( .)
: COPYBLK
    SCR @ BLOCK  COPYBUFF  B/BUF VWRITE
    PROMPT: ." Block copied to buffer" ;

: CLEAR  ( -- )
    PROMPT: ." Clear block? Y/N" Y/N?
    IF  SCR @ BLOCK B/BUF BLANK  UPDATE
    THEN RELIST ;

: PASTEBLK
    PROMPT: ." Overwrite this block?" Y/N?
    IF  COPYBUFF  SCR @ BLOCK  B/BUF VREAD
        UPDATE
    THEN RELIST ;

\ assign to function keys
' TOP      IS [F1]
' CLEAR    IS [F5]
' COPYBLK  IS [F6]
' PASTEBLK IS [F7]

.( .)
\ build anonymous program, assign to F2
:NONAME   0 COL !  15 ROW ! ;  IS [F2]

\ ====[ Command line commands ] ====
: >>   PGDN ;
: <<   PGUP ;
: ..   SCR @ EDIT ;
: OB   BHNDL @ IF CLOSE-BLOCKS THEN  ACTIVE COUNT OPEN-BLOCKS ;
: USE   PARSE-NAME
        BHNDL @ IF CLOSE-BLOCKS THEN OPEN-BLOCKS ;

+TheBF · June 18, 2021

Things to keep one Humble.

A long time ago I replaced this Camel Forth code:

: DIGIT?  ( c -- n -1)  \ if c is a valid digit
\         (   -- x  0 ) \ otherwise
   [ HEX ] DUP 39 > 100 AND +    \ silly looking
   DUP 140 > 107 AND -   30 -    \ but it works!
   DUP BASE @ U< ;

With a translation to code of the GForth version, which was Forth, into a much faster code version.

I failed to pay attention to the fact that in the GForth code it used U>= (unsigned great than or equal to) when testing if the input character was valid.

I used the the TI-FORTH assembler GT IF, which is a signed comparison. DOH!

I had noticed some weird things occasionally but hey the code was all running.

Then I tried to define the Forth word "-->" today for my Forth BLOCK based programming over RS232.

"-->" was being interpreted as a valid NUMBER!

I had made a more efficient version of NUMBER? so I thought aha! That's got to be it. But no.

I looked at >NUMBER the primitive conversion word which is original Camel Forth code. No luck.

Finally got to DIGIT?, the code below.

Replaced GT IF, with HI IF, and the world is a better place.

I will release an update for my thousands of followers next week.

CODE DIGIT?   ( char -- n f )
            TOS PUSH,          \  dup char
            TOS -30 ADDI,      \  convert char to number
            TOS 9 CMPI,
            HI IF,            \ June 2021. Must be un-signed compare!
               TOS -7 ADDI,
               LTE IF,
                    TOS CLR,  \ bad result
                    NEXT,
               ENDIF,
            ENDIF,
            TOS BASE @@ CMP,   \ compare to radix
            GTE IF,
               TOS CLR,    \ bad result
               NEXT,
            ENDIF,
            TOS *SP MOV,   \ replace char with no.
            TOS SETO,      \ set flag to true
            NEXT,          \ 24 bytes 3 uS
            ENDCODE

+TheBF · June 19, 2021

Lol. Staring at this code again today I spied another bug waiting to happen.

BASE is a USER variable. In this code the cross-compiler is replacing the BASE with an address in root Forth task's USER memory because it knows where that is.

If I try to use this code in another task it will ignore the BASE in it's own task because BASE, in another task, will be in a different location.

I need to add 2 instructions or revert back to Forth code. I am going for the two instructions.

"And still I am learning"

Michelangelo

CODE DIGIT?   ( char -- n f )
            TOS PUSH,          \  dup char
            TOS -30 ADDI,      \  convert char to number
            TOS 9 CMPI,
            HI IF,            \ June 2021. Must be un-signed compare!
               TOS -7 ADDI,
               LTE IF,
                    TOS CLR,  \ bad result
                    NEXT,
               ENDIF,
            ENDIF,
            R1 STWP,          \ accessing a USER variable
            TOS 2A (R1) CMP,  \ compare to USER 2A (BASE)
            GTE IF,
               TOS CLR,    \ bad result
               NEXT,
            ENDIF,
            TOS *SP MOV,   \ replace char with no.
            TOS SETO,      \ set flag to true
            NEXT,          \ 24 bytes 3 uS
            ENDCODE

+TheBF · June 21, 2021

I found that to make the ALC version of DIGIT? work properly like Brad's original version it actually took more memory. There also needs to be TOUPPER code in there as well.

So I am reverting back to the Forth code so I can focus on more fun stuff. The only speed up I added was a word BASE@ in code because it is used 4 times in the kernel.

For reference here is Brad's clever version

HEX 
: DIGIT?  ( c -- n -1) \ if c is a valid digit
 \             -- x  0  \ otherwise
  DUP 39 > 100 AND +    \ silly looking
  DUP 140 > 107 AND -   30 -    \ but it works!
  DUP BASE@ U< ;

+TheBF · June 21, 2021

Handling Delimited Text in Memory for a proper Text Editor

As I expected handling text in memory as continuous strings rather than fixed length line buffers is a bit trickier.

So far I some code that reads a DV80 file in memory with each line delimited by a ^M (carriage return) with a >FF tacked on at the end to mark end of data.

I needed a fast way to delimit the lines and was assisted by the word SCAN with can search for the ^M character as assembler speed in the word /EOL.

/EOL is used to make NEXTLN which lets you create pretty fast way to seek through the data to any specific line in the word SEEKLN.

Rolling it all up we get a LIST word that lists 19 lines of the loaded file starting at any line. This is not a screaming fast screen refresh over RS232 but it will make a usable editor.

Seeking in through the delimited text takes about a second for 200 lines so not too bad. I have some ways to manage that for most cases.

The system disk is a very full floppy drive and I find the seek for the file name before it loads to be a large delay. On an floppy with only a few files it's quick.

This was all developed over RS232 by sending source code to the TI-99 where is compiled and then can be tested interactively.

The video shows a bit of the process to remove and compile a new version of list. Serial sending is delayed after each character to not overrun the compiler.

Spoiler


\ TEDTTY.FTH  tEXT Editor for TTY Camel99 Forth    B Fox 2021

\ Method:
\ 1. Read CR delimited lines into low ram BUFFER
\ 2. Create a GAP buffer for editing
\ 3. Create GAP management functions

NEEDS DUMP        FROM DSK1.TOOLS
NEEDS CASE        FROM DSK1.CASE
NEEDS COMPARE     FROM DSK1.COMPARE
NEEDS DEFER       FROM DSK1.DEFER
NEEDS VALUE       FROM DSK1.VALUES
NEEDS -TRAILING   FROM DSK1.TRAILING
NEEDS READ-LINE   FROM DSK1.ANSFILES
NEEDS <ERASERIGHT> FROM DSK1.VT100+

MARKER /GAPTTY
HEX
01B CONSTANT ESC
00D CONSTANT ^M
0FF CONSTANT $FF  \ End of file marker in memory

DECIMAL
   80 CONSTANT #80
C/L @ CONSTANT MAXLEN   \ chars per line is the max line length (80)
CREATE FILENAME  20 ALLOT

\ file buffer memory manager
VARIABLE MPT   \ memory pointer for data array
0 VALUE #1     \ file handle

HEX
2000 CONSTANT []DATA  \ ^M delimited strings in low RAM
2000 CONSTANT DSIZE   \ use all of low RAM

4000 H !    \ mark entire heap allocated

: []HERE     MPT @ ;   \ memory buffer HERE. Next available byte
: []ALLOT    MPT +! ;
: [],        []HERE !  2 []ALLOT ;  \ compile integer
: []C,       []HERE C! 1 []ALLOT ;  \ compile a character

\ compile a string into file buffer
: $,    ( c-addr u -- ) TUCK  []HERE SWAP CMOVE  []ALLOT  ;

: ERASE ( addr len -- )  0 FILL ;
: NEW   ( -- )
        []DATA DSIZE DUP MPT !  ERASE
        $FF []DATA C! ;

\ Utility words
: $.    ( caddr -- )  COUNT TYPE ;
: CLIP  ( n lo hi -- n')  ROT MIN MAX ;

: CR,  ( -- ) ^M []C, ;  \ compile CR char into file buffer

\ Read data directly into []DATA array, remember filename
: LOAD-FILE  ( caddr len -- ior) \ caddr len is a file path string
        2DUP FILENAME PLACE
        NEW
        LINES OFF
        DV80 R/O OPEN-FILE ?FILERR TO #1
        BEGIN
           []HERE #80 #1 READ-LINE ( len ? ior) NIP
           SWAP []ALLOT  \ allot space for the string, which moves []HERE
           CR,           \ compile CR for end of line
           LINES 1+!
        UNTIL
        DROP
        #1 CLOSE-FILE
        $FF []C,
;

\ scan for end of line
: /EOL    ( addr -- addr n) DUP MAXLEN ^M SCAN DROP OVER - ;
: NEXTLN  ( addr -- Addr') /EOL + 1+ ;
: LEN     ( addr -- addr n) /EOL 1- ;

VARIABLE TOPLINE  \ the first line# to list
VARIABLE TOPBUFF  \ the address of topline

: SEEKLN ( n -- addr) \
        []DATA SWAP 0
        ?DO
          I LINES @ = ABORT" end of buffer"
          NEXTLN
        LOOP
;

DECIMAL
: .FILE   ( -- )  0 0 AT-XY  FILENAME $. ;
: .BYTES  ( -- )  20 0 AT-XY ." Bytes: " MPT @ []DATA - . ;
: .LINE#S ( -- )  60 0 AT-XY  TOPLINE @ .  ." of " LINES @ . ;
: .RULER  ( -- )  0 1 AT-XY  15 0 DO ." +----" LOOP ;
: .HEADER ( -- ) .FILE .LINE#S .BYTES .RULER ;

: LIST ( topline -- )
    DECIMAL
    DUP TOPLINE !
    PAGE
    .HEADER
     0 LINES @ CLIP SEEKLN  DUP TOPBUFF !
     19 0
     DO
        DUP C@ $FF = IF LEAVE THEN
        DUP /EOL CR TYPE
        NEXTLN
    LOOP
    DROP
;

+Lee Stewart · June 21, 2021

11 hours ago, TheBF said:
I found that to make the ALC version of DIGIT? work properly like Brad's original version it actually took more memory. There also needs to be TOUPPER code in there as well.

So I am reverting back to the Forth code so I can focus on more fun stuff. The only speed up I added was a word BASE@ in code because it is used 4 times in the kernel.

For reference here is Brad's clever version
HEX 
: DIGIT?  ( c -- n -1) \ if c is a valid digit
 \             -- x  0  \ otherwise
  DUP 39 > 100 AND +    \ silly looking
  DUP 140 > 107 AND -   30 -    \ but it works!
  DUP BASE@ U< ;  

Here is my fbForth (from TI Forth) ALC version:

Spoiler


;[*** DIGIT ***      ( char n1 --- false | n2 true )
* Only used by (NUMBER) in the resident dictionary.
*  n1   = base
*  char = ASCII char to test and convert
*  n2   = valid digit converted from char
*
*        DATA J__N
* DIGI_N .name_field 5, 'DIGIT'
*
* DIGIT  DATA $+2
*        BL   @BLF2A
*        DATA _DIGIT->6000+BANK2  

_DIGIT MOV  *SP+,R1        pop base
       MOV  *SP,R2         copy char
       AI   R2,->0030      ASCII to binary, assuming good digit
       CI   R2,10          logical < 10?
       JL   DIGIT1         if yes, test base
       AI   R2,-7          no, subtract hole between '9' and 'A'
       CI   R2,10          logical >= 10?
       JHE  DIGIT1         if yes, test base
DIGIT2 CLR  *SP            no, invalid digit..
       JMP  DIGITX         ..exit with only a false flag
DIGIT1 C    R2,R1          logical >= base?
       JHE  DIGIT2         if yes, invalid digit
       MOV  R2,*SP         no, put valid digit on stack
       DECT SP             \
       SETO *SP             >> push true flag
       NEG  *SP            /
DIGITX B    @RTNEXT        back to bank 0 and the inner interpreter
*
;]*

You would not need the NEG instruction because TRUE for Camel99 Forth is -1 rather than the 1 I am sort of stuck with.

I am not sure why you think you need TOUPPER code in the mix. That would screw up a radix higher than 36. Though not likely to be used all that often, I suppose, but I can actually think of reasons to use a radix like 60.

...lee

+TheBF · June 21, 2021

31 minutes ago, Lee Stewart said:

Here is my fbForth (from TI Forth) ALC version:

Hide contents

You would not need the NEG instruction because TRUE for Camel99 Forth is -1 rather than the 1 I am sort of stuck with.

I am not sure why you think you need TOUPPER code in the mix. That would screw up a radix higher than 36. Though not likely to be used all that often, I suppose, but I can actually think of reasons to use a radix like 60.

...lee

Thanks, I will see what I can glean from your version.

When I correct the unsigned comparison it was catching the "---" as a non-number but failed to catch "<<<".

I noticed in GForth they had a toupper before all testing began and assumed that was part of my trouble.

I looked like a lot more ALC was needed and I didn't want to add more code so I bailed.

\ gforth version decompiled
: digit?
  toupper 48 - dup 9 u>
  IF     7 - dup 9 u<=
         IF     drop false EXIT
         THEN
  THEN
  dup base @ u>=
  IF     drop false EXIT
  THEN
  true ; ok

+Lee Stewart · June 21, 2021

22 hours ago, Lee Stewart said:

I am not sure why you think you need TOUPPER code in the mix. That would screw up a radix higher than 36. Though not likely to be used all that often, I suppose, but I can actually think of reasons to use a radix like 60.

Oops! Using a radix higher than 36 would need a different DIGIT? definition because [ \ ] ^ are all resident definitions and would never get through INTERPRET as numbers. Oh, well! [EDIT: Actually, not a problem—see my post #979]

...lee

Edited June 22, 2021 by Lee Stewart
CORRECTION

+TheBF · June 21, 2021

Well thanks for giving me a shove Lee. I was missing one compare instruction all this time.

When I printed out the GForth version again to show you I had it sitting in a window, then I studied your version. The different format made me see it differently.

Then I re-looked at GForth and one of the 7 neurons left in this old head fired. :))

It looks like I was thinking in Forth when I wrote the second ALC IF, statement like it automatically did the compare for me and it looks like I did not respect the unsigned comparisons.

So this version below is like the GForth version translated to my 9900 Forth Cross-assembler without the toupper conversion so it should work like yours now.

At least it seems to...

CODE DIGIT?   ( char -- n f )
            TOS PUSH,          \  dup char
            TOS -30 ADDI,      \  convert char to number
            TOS 9 CMPI,
            HI IF,           \ <--- FIXED THIS BEFORE
               TOS -7 ADDI,
               TOS 9 CMPI,   \ <--- THIS WAS MISSING
               LO IF,        \ <--- THIS WAS WRONG 
                   TOS CLR,  \ bad result
                   NEXT,
               ENDIF,
            ENDIF,
            R1 STWP,       \ multi-tasking friendly
            TOS 2A (R1) CMP, \ USER var 2A (BASE)
            HE IF,         \ <--- THIS WAS ALSO WRONG. 
               TOS CLR,    \ bad result
               NEXT,
            ENDIF,
            TOS *SP MOV,   \ replace char with no.
            TOS SETO,      \ set flag to true
            NEXT,         
            ENDCODE

Good thing this is just a hobby. Nobody died.

I am grateful for your help as always.

GDMike · June 21, 2021

Way off topic, but that's me.

I'm still looking for this magazine, of course at a reasonable price, not the$27 that someone is asking, but it's an august 1980 print.

But at least I can read the online version. ?

Edited June 21, 2021 by GDMike

+TheBF · June 21, 2021

Ya that was when Forth hit mainstream publishing. I don't have one. I didn't start buying byte regularly until later in the 1980s.

+Lee Stewart · June 21, 2021

45 minutes ago, GDMike said:

Way off topic, but that's me.

I'm still looking for this magazine, of course at a reasonable price, not the$27 that someone is asking, but it's an august 1980 print.

But at least I can read the online version. ?

I have the R. G. Loeliger book, Threaded Interpretive Languages, that came as a result (I think) of that Byte issue (I might even have that issue buried somewhere here!). It was published by Byte Publications with the graphic on its cover from the cover of that issue. I just saw a used copy on Amazon for $149!! You can read it here—or I could sell you mine (just kidding).

...lee

Camel99 Forth Information goes here

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members