editor: implement F

This would allow things like temporary giving control to the *CL
line on the TRS-80. For example... A very far fetched example. Not
at all the only *raison d'etre* of the layer...

blk/064

@@ -1,6 +1,8 @@
 Disk
 
 BLK>  -- a      Address of the current block variable.
+BLK(  -- a      Beginning addr of blk buf.
+BLK)  -- a      Ending addr of blk buf.
 COPY  s d --    Copy contents of s block to d block.
 FLUSH --        Write current block to disk if dirty.
 LIST  n --      Prints the contents of the block n on screen
@@ -12,7 +14,3 @@ WIPE  --        Empties current block
 
 
 
-
-
-
-

blk/081

@@ -1,16 +1,16 @@
 (cont.)
-RAMSTART  INITIAL_SP    +53       readln's variables
+RAMSTART  INITIAL_SP    +55       EMITPTR override
-+02       CURRENT       +55       adev's variables
++02       CURRENT       +57       readln's variables
-+04       HERE          +57       blk's variables
++04       HERE          +59       blk's variables
-+06       C<?*          +59       z80a's variables
++06       C<?           +5b       z80a's variables
-+08       C<* override  +5b       FUTURE USES
++08       C<* override  +5d       adev's variables
-+0a       PARSEPTR      +70       DRIVERS
++0a       PARSEPTR      +5f       FUTURE USES
-+0c       C<*           +80       RAMEND
++0c       C<*           +70       DRIVERS
-+0e       WORDBUF
++0e       WORDBUF       +80       RAMEND
 +2e       BOOT C< PTR
 +4e       INTJUMP
 +51       CURRENTPTR
-
++53       EMITPTR
 
 
                                                         (cont.)

blk/101

@@ -1,8 +1,7 @@
 T ( n -- ): select line n for editing.
 P xxx: put typed line on selected line.
 U xxx: insert typed line on selected line.
-
+F xxx: find typed string in block.
-
 
 
 

blk/102

@@ -1,5 +1,5 @@
 152 LOAD ( extras )
-103 106 LOADR
+103 107 LOADR
 
 : BROWSE
     100 _LIST

blk/104

@@ -1,6 +1,7 @@
 ( Cursor position in buffer. EDPOS/64 is line number )
 VARIABLE EDPOS
-CREATE EDBUF 64 ALLOT
+CREATE IBUF 64 ALLOT
+CREATE FBUF 64 ALLOT
 : _cpos BLK( + ;
 : _lpos 64 * _cpos ;
 : _pln ( lineno -- )
@@ -9,8 +10,4 @@ CREATE EDBUF 64 ALLOT
         I C@ DUP 0x20 < IF DROP 0x20 THEN
         EMIT
     LOOP ( lno ) 1+ . ;
-: _zbuf EDBUF 64 0 FILL ;
+: _zbuf 64 0 FILL ; ( buf -- )
-: _type ( -- )
-    C< DUP 0xd = IF DROP EXIT THEN _zbuf EDBUF BEGIN ( c a )
-        C!+ C< SWAP OVER 0x0d = UNTIL ( c a )
-    2DROP ;

blk/105

@@ -1,6 +1,11 @@
+: _type ( buf -- )
+    C< DUP 0xd = IF DROP EXIT THEN OVER DUP _zbuf ( c a )
+    BEGIN ( c a )
+        C!+ C< SWAP
+    OVER 0x0d = UNTIL ( c a ) C! ;
 ( user-facing lines are 1-based )
 : T 1- DUP 64 * EDPOS ! _pln ;
-: P _type EDBUF EDPOS @ _cpos 64 MOVE BLK!! ;
+: P IBUF _type IBUF EDPOS @ _cpos 64 MOVE BLK!! ;
 : _mvln+ ( ln -- move ln 1 line further )
     DUP 14 > IF DROP EXIT THEN
     _lpos DUP 64 + 64 MOVE

blk/106

@@ -1,7 +1,5 @@
 : U
     15 EDPOS @ 64 / - 0 DO
         14 I - _mvln+
-    LOOP
+    LOOP P
-    P
 ;
-

blk/107

@@ -0,0 +1,12 @@
+: F
+    FBUF _type FBUF EDPOS @ _cpos ( a1 a2 )
+    BEGIN
+        C@+ ROT ( a2+1 c2 a1 ) C@+ ROT ( a2+1 a1+1 c1 c2 )
+        = NOT IF DROP FBUF THEN
+        SWAP OVER C@ 0xd = ( a1 a2 f1 )
+        OVER BLK) = OR ( a1 a2 f1|f2 )
+    UNTIL
+    DUP BLK) < IF BLK( - FBUF + -^ EDPOS ! THEN
+    EDPOS @ 64 / _pln
+;
+

blk/143

@@ -1,9 +1,9 @@
-: ADEVMEM+ 0x55 RAM+ @ + ;
+: ADEVMEM+ 0x5d RAM+ @ + ;
 : A@* 0 ADEVMEM+ ;
 : A!* 2 ADEVMEM+ ;
 
 : ADEV$
-    H@ 0x55 RAM+ !
+    H@ 0x5d RAM+ !
     4 ALLOT
     ['] C@ A@* !
     ['] C! A!* !

blk/213

@@ -1,9 +1,9 @@
-: Z80AMEM+ 0x59 RAM+ @ + ;
+: Z80AMEM+ 0x5b RAM+ @ + ;
 : ORG 0 Z80AMEM+ ;
 : BIN( 2 Z80AMEM+ ;
 : L1 4 Z80AMEM+ ; : L2 6 Z80AMEM+ ;
 : L3 8 Z80AMEM+ ; : L4 10 Z80AMEM+ ;
-: Z80A$ H@ 0x59 RAM+ ! 12 ALLOT 0 BIN( ! ;
+: Z80A$ H@ 0x5b RAM+ ! 12 ALLOT 0 BIN( ! ;
 : A 7 ; : B 0 ; : C 1 ; : D 2 ;
 : E 3 ; : H 4 ; : L 5 ; : (HL) 6 ;
 : BC 0 ; : DE 1 ; : HL 2 ; : AF 3 ; : SP AF ;

blk/352

@@ -11,5 +11,5 @@ ACIA_MEM
   +4 ACIA(
   +6 ACIA) )
 
-353 356 LOADR
+353 355 LOADR
 

blk/355

@@ -0,0 +1,17 @@
+            IFZ, ( end of buffer reached? )
+                ( yes )
+                ( +4 == ACIA( )
+                ACIA_MEM 4 + LDHL(nn),
+                ( +2 == ACIAW> )
+                ACIA_MEM 2+ LD(nn)HL,
+            THEN,
+        THEN,
+    THEN,
+    DE POPqq,
+    HL POPqq,
+    AF POPqq,
+    EI,
+    RETI,
+
+
+

blk/356

@@ -1,16 +0,0 @@
-            IFZ, ( end of buffer reached? )
-                ( yes )
-                ( +4 == ACIA( )
-                ACIA_MEM 4 + LDHL(nn),
-                ( +2 == ACIAW> )
-                ACIA_MEM 2+ LD(nn)HL,
-            THEN,
-        THEN,
-    THEN,
-    DE POPqq,
-    HL POPqq,
-    AF POPqq,
-    EI,
-    RETI,
-
-

blk/359

@@ -1,16 +1,16 @@
-: ACIA$
+: KEY
-    H@ DUP DUP ACIA( ! ACIAR> !
+    ( inc then fetch )
-    1+ ACIAW> !  ( write index starts one position later )
+    ACIAR> @ 1+ DUP ACIA) @ = IF
-    ACIABUFSZ ALLOT
+        DROP ACIA( @
-    H@ ACIA) !
+    THEN
-( setup ACIA
+    ( As long as R> == W>-1, it means that buffer is empty )
-  CR7 (1) - Receive Interrupt enabled
+    BEGIN DUP ACIAW> @ = NOT UNTIL
-  CR6:5 (00) - RTS low, transmit interrupt disabled.
+    ACIAR> !
-  CR4:2 (101) - 8 bits + 1 stop bit
+    ACIAR> @ C@
-  CR1:0 (10) - Counter divide: 64 )
+;
-    0b10010110 ACIA_CTL PC!
+: (emit)
-( setup interrupt )
+    ( As long at CTL bit 1 is low, we are transmitting. wait )
-    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
+    BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
-    ['] ~ACIA 0x4f RAM+ !
+    ( The way is clear, go! )
-    (im1)
+    ACIA_IO PC!
 ;

blk/360

@@ -1,16 +1,17 @@
-: KEY
+: ACIA$
-    ( inc then fetch )
+    H@ DUP DUP ACIA( ! ACIAR> !
-    ACIAR> @ 1+ DUP ACIA) @ = IF
+    1+ ACIAW> !  ( write index starts one position later )
-        DROP ACIA( @
+    ACIABUFSZ ALLOT
-    THEN
+    H@ ACIA) !
-    ( As long as R> == W>-1, it means that buffer is empty )
+( setup ACIA
-    BEGIN DUP ACIAW> @ = NOT UNTIL
+  CR7 (1) - Receive Interrupt enabled
-    ACIAR> !
+  CR6:5 (00) - RTS low, transmit interrupt disabled.
-    ACIAR> @ C@
+  CR4:2 (101) - 8 bits + 1 stop bit
-;
+  CR1:0 (10) - Counter divide: 64 )
-: EMIT
+    0b10010110 ACIA_CTL PC!
-    ( As long at CTL bit 1 is low, we are transmitting. wait )
+( setup interrupt )
-    BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
+    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
-    ( The way is clear, go! )
+    ['] ~ACIA 0x4f RAM+ !
-    ACIA_IO PC!
+    ['] (emit) 0x53 RAM+ ! ( 53==EMITPTR )
-;
+    (im1) ;
+

blk/405

@@ -1,15 +1,15 @@
 : BOOT
     0x02 RAM+ CURRENT* !
     LIT< (parse) (find) DROP (parse*) !
-    ( 2e == SYSTEM SCRATCHPAD )
+    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR)
-    CURRENT @ 0x2e RAM+ !
     0 0x08 RAM+ !  ( 08 == C<* override )
+    LIT< (emit) (find) DROP 0x53 RAM+ ! ( 53 == EMITPTR )
+    0 0x55 RAM+ !  ( 55 == EMITPTR override )
     ( 0c == C<* )
     LIT< (boot<) (find) DROP 0x0c RAM+ !
     ( boot< always has a char waiting. 06 == C<?* )
     1 0x06 RAM+ !
     LIT< INIT (find)
-    IF EXECUTE
+    IF EXECUTE ELSE DROP INTERPRET THEN
-    ELSE DROP INTERPRET THEN
 ;
 

blk/442

@@ -1,4 +1,6 @@
-( EMIT is needed for this unit to compile )
+: EMIT
+    ( 0x53==EMITPTR 0x55==override )
+    85 RAM+ @ DUP NOT IF DROP 83 RAM+ @ THEN EXECUTE ;
 
 : (print)
     BEGIN

blk/453

@@ -1,5 +1,5 @@
 64 CONSTANT INBUFSZ
-: RDLNMEM+ 0x53 RAM+ @ + ;
+: RDLNMEM+ 0x57 RAM+ @ + ;
 ( current position in INBUF )
 : IN> 0 RDLNMEM+ ;
 ( points to INBUF )

blk/457

@@ -1,7 +1,7 @@
 ( Initializes the readln subsystem )
 : RDLN$
-    ( 53 == rdln's memory )
+    ( 57 == rdln's memory )
-    H@ 0x53 RAM+ !
+    H@ 0x57 RAM+ !
     ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
       the last typed 0x0a and one for the following NULL. )
     INBUFSZ 4 + ALLOT

blk/464

@@ -1,4 +1,4 @@
-: BLKMEM+ 0x57 RAM+ @ + ;
+: BLKMEM+ 0x59 RAM+ @ + ;
 ( n -- Fetches block n and write it to BLK( )
 : BLK@* 0 BLKMEM+ ;
 ( n -- Write back BLK( to storage at block n )
@@ -8,5 +8,6 @@
 ( Whether buffer is dirty )
 : BLKDTY 6 BLKMEM+ ;
 : BLK( 8 BLKMEM+ ;
+: BLK) BLK( 1024 + ;
 
 

blk/465

@@ -1,5 +1,5 @@
 : BLK$
-    H@ 0x57 RAM+ !
+    H@ 0x59 RAM+ !
     ( 1024 for the block, 8 for variables )
     1032 ALLOT
     ( LOAD detects end of block with ASCII EOT. This is why

blk/493

@@ -4,7 +4,7 @@ CODE KEY
     L A LDrr, H 0 LDrn,
     HL PUSHqq,
 ;CODE
-CODE EMIT
+CODE (emit)
     BC POPqq, ( c == @DSP arg )
     chkPS,
     A 0x02 LDrn, ( @DSP )

emul/xcomp.fs

@@ -16,7 +16,7 @@ H@ 256 /MOD 2 PC! 2 PC!
 ( Update LATEST )
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
-," : EMIT 0 PC! ; "
+," : (emit) 0 PC! ; CURRENT @ 83 RAM+ ! "
 ," : KEY 0 PC@ ; "
 422 470 XPACKR
 ," ' KEY 12 RAM+ ! "

tests/forth/test_flow.fs

@@ -1,3 +1,4 @@
+152 LOAD ( extra )
 : foo
     CASE
         'X' OF 42 ENDOF