Strictly speaking, this works. It enumarates the PnP devices, and
load the modules needed according to a file relating module names
(actually, _file_ names, not really modules -- the dependency
stuff is not exported to loader's UI) to PnP IDs.

But it still lacks a number of desired features, and it's too crude
for my tastes. But since I don't have time to work on it, it might
be preferable to make it available to those who might. It's not
installed by default, much less loaded. In fact, it wouldn't even
had a copyright message (who? me? assume responsibility for _this_?),
if the cvs commit hadn't aborted for lack of $FreeBSD$, and I decided
to just cut&paste the stuff from elsewhere.

\ Copyright (c) 2000 Daniel C. Sobral <dcs@freebsd.org>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

pnpdevices drop

: enumerate
  pnphandlers begin
    dup @
  while
    ." Probing " dup @ pnph.name @ dup strlen type ." ..." cr
    0 over @ pnph.enumerate @ ccall drop
    cell+
  repeat
;

: summary
  ." PNP scan summary:" cr
  pnpdevices stqh_first @
  begin
    dup
  while
    dup pnpi.ident stqh_first @ pnpid.ident @ dup strlen type
    dup pnpi.desc @ ?dup if
      ."  : "
      dup strlen type
    then
    cr
    pnpi.link stqe_next @
  repeat
  drop
;

: compare-pnpid ( addr addr' -- flag )
  begin
    over c@ over c@ <> if drop drop false exit then
    over c@ over c@ and
  while
    char+ swap char+ swap
  repeat
  c@ swap c@ or 0=
;

: search-pnpid  ( id -- flag )
  >r
  pnpdevices stqh_first @
  begin ( pnpinfo )
    dup
  while
    dup pnpi.ident stqh_first @
    begin ( pnpinfo pnpident )
      dup pnpid.ident @ r@ compare-pnpid
      if
	r> drop
	\ XXX Temporary debugging message
	." Found " pnpid.ident @ dup strlen type
	pnpi.desc @ ?dup if
	  ." : " dup strlen type
	then cr
	\ drop drop
	true
	exit
      then
      pnpid.link stqe_next @
      ?dup 0=
    until
    pnpi.link stqe_next @
  repeat
  r> drop
  drop
  false
;

: skip-space  ( addr -- addr' )
  begin
    dup c@ bl =
    over c@ 9 = or
  while
    char+
  repeat
;

: skip-to-space  ( addr -- addr' )
  begin
    dup c@ bl <>
    over c@ 9 <> and
    over c@ and
  while
    char+
  repeat
;

: premature-end?  ( addr -- addr flag )
  postpone dup postpone c@ postpone 0=
  postpone if postpone exit postpone then
; immediate

0 value filename
0 value timestamp
0 value id

only forth also support-functions

: (load) load ;

: check-pnpid  ( -- )
  line_buffer .addr @
  \ Search for filename
  skip-space premature-end?
  dup to filename
  \ Search for end of filename
  skip-to-space premature-end?
  0 over c!  char+
  \ Search for timestamp
  skip-space premature-end?
  dup to timestamp
  skip-to-space premature-end?
  0 over c!  char+
  \ Search for ids
  begin
    skip-space premature-end?
    dup to id
    skip-to-space dup c@ >r
    0 over c!  char+
    id search-pnpid if
      filename dup strlen 1 ['] (load) catch if
	drop drop drop
	." Error loading " filename dup strlen type cr
      then
      r> drop exit
    then
    r> 0=
  until
;

: load-pnp
  0 to end_of_file?
  reset_line_reading
  s" /boot/pnpid.conf" fopen fd !
  fd @ -1 <> if
    begin
      end_of_file? 0=
    while
      read_line
      check-pnpid
    repeat
    fd @ fclose
  then
;

error: pathspec 'sys/boot/forth/pnp.4th' did not match any file(s) known to git


Added standard library directory to git

Added standard library directory to git

: true swap call ;
: false call     ;

: if rot call    ;

error: pathspec 'src/std/cond.4th' did not match any file(s) known to git


Add the updated Forth system calls code.

\ Wrappers for SAPI functions, ABI 2.x

\ Note that the system call number is embedded into the instruction,
\ so this is not so easily parameterized.

#0 equ SAPI_VEC_VERSION
#1 equ SAPI_VEC_01_GetRuntimeLinks
#2 equ SAPI_VEC_02_PutChar
#3 equ SAPI_VEC_03_GetChar
#4 equ SAPI_VEC_04_GetCharAvail
#5 equ SAPI_VEC_05_PutString
#6 equ SAPI_VEC_06_EOL
#14 equ SAPI_VEC_14_PetWatchdog
#15 equ SAPI_VEC_15_GetTimeMS

CODE SAPI-Version  \ -- n
\ *G Get the version of the binary ABI in use.
	svc # SAPI_VEC_VERSION
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE

CODE GETRUNTIMELINKS  \ type -- n
\ *G Get the runtime linking information.   Type 0 - A Dynamic linking
\ ** table with name, address pairs.  Type 1 - A Zero-Terminated Jump table.
	mov r0, tos
	svc # SAPI_VEC_01_GetRuntimeLinks
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE

\ --------------------------------------------
\ System calls that will require wrappers
\ --------------------------------------------

CODE (SEREMITFC) \ char base --
\ *G Service call for a single char - This one has a special name because
\ ** It'll be wrapped by something that can respond to the flow control
\ ** return code and PAUSE + Retry
	mov r0, tos
	ldr r1, [ psp ], # 4
	[defined] SAPIWakeSupport? [if] mov r2, up [else] mov r2, # 0 [then]
	svc # SAPI_VEC_02_PutChar
	mov tos, r0
    next,
END-CODE

CODE (SERKEYFC) \ base -- char
\ *G Get a character from the port, or -1 for fail
	mov r0, tos
	[defined] SAPIWakeSupport? [if] mov r1, up [else] mov r1, # 0 [then]
	svc # SAPI_VEC_03_GetChar
	mov tos, r0
	next,
END-CODE

CODE (SERTYPEFC) \ caddr len base -- return
\ *G Output characters.
	mov r0, tos
	ldr r1, [ psp ], # 4
	ldr r2, [ psp ], # 4
	[defined] SAPIWakeSupport? [if] mov r3, up [else] mov r3, # 0 [then]
	svc # SAPI_VEC_05_PutString
	mov tos, r0
	next,
END-CODE

CODE (SERCRFC) \ base -- return
\ *G Send a line terminator to the port.  Return 0 for success, -1 for fail.
	mov r0, tos
	[defined] SAPIWakeSupport? [if] mov r1, up [else] mov r1, # 0 [then]
	svc # SAPI_VEC_06_EOL
	mov tos, r0
	next,
END-CODE

\ --------------------------------------------
\ Direct substitures for existing stuff.
\ --------------------------------------------

CODE (SERKEY?) \ base -- t/f
\ *G Return true if the given stream has a character avilable to read.
\ The call returns the number of chars available.
	mov r0, tos
	svc # SAPI_VEC_04_GetCharAvail
	mov tos, r0
	next,
END-CODE

CODE PETWATCHDOG  \ n --
\ *G Refresh the watchdog.  Pass in a platform-specific number
\ ** To specify a timerout (if supported), or zero for the default value.
	mov r0, tos
	ldr r1, [ psp ], # 4
	svc # SAPI_VEC_14_PetWatchdog
	ldr tos, [ psp ], # 4
	next,
END-CODE

CODE TICKS  \ -- n
\ *G The current value of the millisecond ticker.
    mov r0, # 0 \ We want the actual value.
	svc # SAPI_VEC_15_GetTimeMS
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE

error: pathspec 'forth/SysCalls.fth' did not match any file(s) known to git


0 value ii        0 value jj
0 value KeyAddr   0 value KeyLen
create SArray   256 allot   \ state array of 256 bytes
: KeyArray      KeyLen mod   KeyAddr ;

: get_byte      + c@ ;
: set_byte      + c! ;
: as_byte       255 and ;
: reset_ij      0 TO ii   0 TO jj ;
: i_update      1 +   as_byte TO ii ;
: j_update      ii SArray get_byte +   as_byte TO jj ;
: swap_s_ij
    jj SArray get_byte
       ii SArray get_byte  jj SArray set_byte
    ii SArray set_byte
;

: rc4_init ( KeyAddr KeyLen -- )
    256 min TO KeyLen   TO KeyAddr
    256 0 DO   i i SArray set_byte   LOOP
    reset_ij
    BEGIN
        ii KeyArray get_byte   jj +  j_update
        swap_s_ij
        ii 255 < WHILE
        ii i_update
    REPEAT
    reset_ij
;
: rc4_byte
    ii i_update   jj j_update
    swap_s_ij
    ii SArray get_byte   jj SArray get_byte +   as_byte SArray get_byte  xor
;

\https://pt.stackoverflow.com/q/356658/101

error: pathspec 'Portugol/ExampleForth.fth' did not match any file(s) known to git


a new example

a new example

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/crcx/rx-nga.git/'


Tested and working basic Serial IO.

Tested and working basic Serial IO.

\ serCM3_sapi_level0.fth - SAPI polled RX, polled TX, serial communication drivers
\ Written to run against the SockPuppet API.

\ Level 0 support, with WFI instead of pause.
\ The SAPI is a system call interace, so there is no blocking.
\ KEY requires blocking, so that must be implemented here.

only forth definitions

\ ==============
\ *T SAPI polled serial driver
\ ==============
\ *P This driver provides polled serial comms for Cortex-M3 CPUs
\ ** using the internal UARTs via the SAPI call layer.   This is
\ ** The simplest implementation level.

\ ****************
\ *S Configuration
\ ****************
\ *P Configuration is managed by the SAPI

target

\ ********************
\ *S Serial primitives
\ ********************
internal

: +FaultConsole	( -- )  ;
\ *G Because this is a polled driver, *\fo{+FaultConsole} for
\ ** fault handling is a *\fo{NOOP}. See *\i{Cortex/FaultCortex.fth}
\ ** for more details.

target

\ CODE (seremitfc)	\ char base --
\ This is a system call.

: (seremit)	\ char base --
\ *G Wrapped call that checks for throttling, and if so,
\ calls PAUSE to let another task run, or just does a WFI if no multitasker.
\ The only interesting thing is failure, or -1.  That means retry.
	begin
	2dup (seremitfc) dup 0 < \ char base ret t/f
[ tasking? ] [if]
	IF PAUSE THEN
[else]
	IF [asm wfi asm] THEN
[then] \ char base ret
    0 >= until
    2drop
	;

: (sertype)	\ caddr len base --
\ *G Transmit a string on the given UART.
  -rot bounds
  ?do  i c@ over (seremit)  loop
  drop
;

: (sercr)	\ base --
\ *G Transmit a CR/LF pair on the given UART.
  $0D over (seremit)  $0A swap (seremit)
;

: (serkey) \ base -- c
\ *G Get a character from the port.  Retry until we get it.
\ See if its negative.  If so, discard it and leave false to re-loop.
\ If not negative, leave true on the stack to exit.
    begin \ base ret t/f
	dup (serkeyfc) dup 0 <  \ base ret t/f
	[ tasking? ] [if]
		IF PAUSE drop false ELSE true THEN
	[else]
		IF [asm wfi asm] drop false ELSE true THEN
	[then] \ base ret
	until  \ base ret
	swap drop
;

\ THis is a system call.
\ CODE (serkey?)     \ base -- t/f
\ *G Return true if the given UART has a character avilable to read.

external

: seremit0	\ char --
\ *G Transmit a character on UART0.
  0 (seremit)  ;
: sertype0	\ c-addr len --
\ *G Transmit a string on UART0.
  0 (sertype)  ;
: sercr0	\ --
\ *G Issue a CR/LF pair to UART0.
  0 (sercr)  ;
: serkey?0	\ -- flag
\ *G Return true if UART0 has a character available.
  0 (serkey?)  ;
: serkey0	\ -- char
\ *G Wait for a character on UART0.
  0 (serkey)  ;
create Console0	\ -- addr ; OUT managed by upper driver
\ *G Generic I/O device for UART0.
  ' serkey0 ,		\ -- char ; receive char
  ' serkey?0 ,		\ -- flag ; check receive char
  ' seremit0 ,		\ -- char ; display char
  ' sertype0 ,		\ caddr len -- ; display string
  ' sercr0 ,		\ -- ; display new line

\ Non-UARTs.
: seremit10 #10 (seremit)  ;
: sertype10	#10 (sertype)  ;
: sercr10	#10 (sercr)  ;
: serkey?10	#10 (serkey?)  ;
: serkey10	#10 (serkey)  ;
create Console10 ' serkey10 , ' serkey?10 , ' seremit10 , ' sertype10 , ' sercr10 ,

console-port 0 = [if]
  console0 constant console
\ *G *\fo{CONSOLE} is the device used by the Forth system for interaction.
\ ** It may be changed by one of the phrases of the form:
\ *C   <device>  dup opvec !  ipvec !
\ *C   <device>  SetConsole
[then]

console-port  #10 = [if]
  console10 constant console
[then]

\ ************************
\ *S System initialisation
\ ************************

\ This is a NOP in the SAPI environment
: init-ser ;	\ --
\ *G Initialise all serial ports

\ ======
\ *> ###
\ ======

decimal

error: pathspec 'forth/serCM3_SAPI-level0.fth' did not match any file(s) known to git


Create primes.frt

Create primes.frt

error: pathspec 'examples/primes.frt' did not match any file(s) known to git


Work in progress forth implementation. It has the correct basic structure minus the lack of additional constraints, but something is causing it to abort early.

3 constant width
21 constant goal
width 1- constant wm
width 1+ constant wp
width width * constant size

create choices  3 ,  4 ,  5 ,
                6 ,  7 ,  8 ,
                9 , 10 , 11 ,

variable picked size allot

: clearPicked
    size
    begin
        1- dup 0>= while
            dup picked + 0 swap C!
    repeat
    drop ;

variable a size cells allot

: choiceSearch
    0
    begin
        dup size < while
            choices over cells + @
            rot tuck = if
                drop -1 exit
            endif
            swap 1+
    repeat
    2drop 0 ;

: reverseCrossInvalid
    0
    wm wp * wm do
        a i cells + @ +
    wm +loop
    goal = ;

: crossInvalid
    0
    size 0 do
        a i cells + @ +
    wp +loop
    goal = ;

: bottomRowInvalid
    0
    size size width - do
        a i cells + @ +
    loop
    goal = ;

: bottomRightInvalid
    bottomRowInvalid if
        -1
    else
        crossInvalid
    endif ;

0 VALUE pickNextRef

: pickInternal
    size 0 do
        dup cells a + choices i cells + @ swap !
        i picked + C@ 0= if
            1 i picked + C!
            dup pickNextRef execute
            0 i picked + C!
        endif
    loop
    drop ;

: pickRight
    0 over dup dup width mod - do
        a i cells + @ +
    loop
    goal swap -
    over over swap cells a + !
    choiceSearch if
        dup picked + C@ 0= if
            1 over picked + C!
            over pickNextRef execute
            0 swap picked + C!
        endif
    endif
    drop ;

: pickBottom
    0 over dup width mod do
        a i cells + @ +
    width +loop
    goal swap -
    over over swap cells a + !
    choiceSearch if
        dup picked + C@ 0= if
            1 over picked + C!
            over pickNextRef execute
            0 swap picked + C!
        endif
    endif
    drop ;

create solution_count 0 ,

: solution
    solution_count @ 1+ dup solution_count !
    ." --- Solution " . ." ---" CR
    size 0 do
        a i cells + @ .
        i 3 mod 2 = if CR endif
    loop ;

: pickNext
    dup ." pickNext " .
    dup size 1- = if
        drop ." -> solution" CR solution exit
    endif
    dup width wm * >= if
        wm -
    else
        dup width dup 2 - * >= if
            width + ." -> pickBottom " dup . CR pickBottom exit
        else
            1+
        endif
    endif
    dup width mod wm = if
        ." -> pickRight " dup . CR pickRight
    else
        ." -> pickInternal " dup . CR pickInternal
    endif ;

' pickNext TO pickNextRef

: initBoard
    9 0 do
        i 1+ a i cells + !
    loop ;

: solve-puzzle
    clearPicked initBoard 0 solution_count !
    0 pickInternal ;

error: pathspec 'magic-puzzle/magic-puzzle.fth' did not match any file(s) known to git


forthlet: disassembler

forthlet: disassembler


Fix WHEN and UNLESS. Add SQUARE, SUM, and AREA.

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/SamSkulls/filth.git/'


missing file for interrupt support

missing file for interrupt support

( Words to work with interrupts.

  vi:ft=forth
)

( Example:
    PORT1_VECTOR INTERRUPT handler_name
        WAKEUP
        0 P1IFG C!
    END-INTERRUPT

  - Words defined with INTERRUPT must not be called from user code.
)

( Interrupts save the MSP430 context [registers] on the data stack. This is no
  problem as an interrupt handler can work with values that have been on the
  stack and it must be stack balanced itself.
)

( The word INTERRUPT generates an entry code block specific for each interrupt.
    sub \x23 4, RTOS ; prepare to push 2 values on return stack
    mov IP, 2[RTOS]  ; save IP on return stack
    mov SP, 0[RTOS]  ; save SP pointer on return stack it points to SR on stack
    mov #XXX, IP     ; Move address of thread of interrupt handler in IP
    mov @IP+, PC     ; NEXT
)

( Entering an interrupt handler )
CODE DO-INTERRUPT ( R: - int-sys )
    ." \t ; save registers\n "
    ." \t push R6\n "
    ." \t push R7\n "
    ." \t push R8\n "
    ." \t push R9\n "
    ." \t push R10\n "
    ." \t push R11\n "
    ." \t push R12\n "
    ." \t push R13\n "
    ." \t push R14\n "
    ." \t push R15\n "
    ASM-NEXT
END-CODE

( Restore state at exit of interrupt handler )
CODE EXIT-INTERRUPT ( R: int-sys - )
    ." \t ; restore registers\n "
    ." \t pop R15\n "
    ." \t pop R14\n "
    ." \t pop R13\n "
    ." \t pop R12\n "
    ." \t pop R11\n "
    ." \t pop R10\n "
    ." \t pop R9\n "
    ." \t pop R8\n "
    ." \t pop R7\n "
    ." \t pop R6\n "
    ." \t incd RTOS ; forget about pointer to SR on stack \n "
    ." \t mov @RTOS+, IP  \t; get last position from return stack \n "
    ." \t reti\n "
END-CODE

( Patch the saved status register so that LPM modes are exit after the
  interrupt handler is finished.

  Only allowed in INTERRUPT definition. Not in called functions.
  May be called multiple times.
)
CODE WAKEUP ( R: int-sys - int-sys )
    ." \t mov @RTOS, W        \t; read pointer to SR\n "
    ." \t bic \x23 LPM4, 0(W) \t; patch SR on stack\n "
    ASM-NEXT
END-CODE

error: pathspec 'msp430/asm/forth/_interrupts.forth' did not match any file(s) known to git


Stripped-down start cortex.

Stripped-down start cortex.

\ StartCortexThread.fth - generic Cortex startup code
\ Stripped down version of MPE version.
\ The supervisor does most of the important work.
\ so StartCortex is simpler.

only forth definitions  decimal

\ ===========
\ *! initcortex
\ *T Generic Cortex start up
\ ===========

l: ExcVecs	\ -- addr ; start of vector table
\ *G The exception vector table is *\fo{/ExcVecs} bytes long. The
\ ** equate is defined in the control file.
  /ExcVecs allot&erase

interpreter
: SetExcVec	\ addr exc# --
\ *G Set the given exception vector number to the given address.
\ ** Note that for vectors other than 0, the Thumb bit is forced
\ ** to 1.
  dup if				\ If not the stack top
    swap 1 or swap			\   set the Thumb bit
  endif
  cells ExcVecs + !  ;
target

L: CLD1		\ holds xt of main word
  0 ,					\ fixed by MAKE-TURNKEY

\ Calculate the initial value for the data stack pointer.
\ We allow for TOS being in a register and guard space.

[undefined] sp-guard [if]		\ if no guard value is set
0 equ sp-guard
[then]

init-s0 tos-cached? sp-guard + cells -
  equ real-init-s0	\ -- addr
\ The data stack pointer set at start up.

internal
: StartCortex	\ -- ; never exits
\ *G Set up the Forth registers and start Forth. Other primary
\ ** hardware initialisation can also be performed here.
  begin
    \ INT_STACK_TOP SP_main sys! \ set SP_main for interrupts - we don't own it.
    \ INIT-R0 SP_process sys!	 \ set SP_process for tasks - the loader will do this.
    \ 2 control sys!			 \ switch to SP_process - handled by the loader.
    REAL-INIT-S0 set-sp			 \ Allow for cached TOS and guard space
    INIT-U0 up!				\ USER area
    CLD1 @ execute
  again
;
external

INIT-R0 StackVec# SetExcVec	\ Define initial return stack
' StartCortex ResetVec# SetExcVec	\ Define startup word

\ ------------------------------------------
\ reset values for user and system variables
\ ------------------------------------------
L: USER-RESET
  init-s0 tos-cached? sp-guard + cells - ,	\ s0
  init-r0 ,				\ r0
  0 ,  0 ,                              \ #tib, 'tib
  0 ,  0 ,                              \ >in, out
  $0A ,  0 ,                            \ base, hld

\ initial values of system variables
L: INIT-FENCE 0 ,                       \ fence
L: INIT-DP 0 ,                          \ dp
L: INIT-VOC-LINK 0 ,                    \ voc-link

\ ======
\ *> ###
\ ======

decimal

error: pathspec 'leopard/usbforth/StartCortexThread.fth' did not match any file(s) known to git


Added screen file with high level definitions of Core.

( block 100 )

: NIP ( n1 n2 -- n2)   SWAP DROP ;
: 2DROP   DROP DROP ;
: 2DUP  OVER OVER ;
: ?DUP  DUP IF DUP THEN ;

: 1+  1 + ;
: 1-  1 - ;
: INVERT  -1 XOR ;
: NEGATE  INVERT 1+ ;
: ABS  DUP 0< IF NEGATE THEN ;
( shadow 100 )
( block 101 )
( shadow 101 )
( block 102 )

( shadow 102 )
( block 103 )
( shadow 103 )
( block 104 )
( shadow 104 )
( block 105 interpreter )

CREATE _INPUT-BUFFER 80 CHARS ALLOT ( may do this internally? )

: EVALUATE  >IN @ >R 0 >IN ! SOURCE >R >R #IN 2! _INTERPRET
    R> R> #IN 2! R> >IN ! ;

: QUIT  _RESET-RSTACK
      BEGIN
        BEGIN
	  _READ-LINE 0 >IN ! _INPUT-BUFFER 0 EVALUATE CR
	  STATE @
        UNTIL ." ok "  ( exhausted input in interpretation mode )
      AGAIN ;

  ( shadow 105 )
( block 106 )
( shadow 106 )
( block 107 )
( shadow 107 )
( block 108 )
( shadow 108 )
( block 109 )
( shadow 109 )
( block 110 compiler )

: VARIABLE CREATE 1 CELLS ALLOT ;

VARIABLE STATE  ( compilation state variable )
0 STATE !       ( interpreting by default )
: [  FALSE STATE ! ;
: ]  TRUE STATE ! ;

( Colon definitions )
: :  CREATE ] ;
: ;  POSTPONE EXIT SMUDGE [ ; IMMEDIATE

( shadow 110 )
( block 111 )
( shadow 111 )
( block 112 )
( shadow 112 )

error: pathspec 'src/lib/core.fth' did not match any file(s) known to git


Adds congruentp.

Adds congruentp.


Level 1 driver with support for auto-pause.

\ serCM3_sapi_level1.fth - SAPI polled RX, polled TX, serial communication drivers
\ with support for blocking IO.
\ Written to run against the SockPuppet API.

\ Level 1 support.   Requires TASKING.  System calls request blocking.
\ KEY requires blocking, so that must be implemented here.

\ Copyright (c) 2017, Robert Sexton.  All rights reserved.
\ Covered by the terms of the supplied Licence.txt file

only forth definitions

\ ==============
\ *T SAPI polled serial driver
\ ==============
\ *P This driver provides polled serial comms for Cortex-M3 CPUs
\ ** using the internal UARTs via the SAPI call layer.   This is
\ ** The simplest implementation level.
\ ** It doesn't use the CR or TYPE calls, but rather emulates them.

\ ****************
\ *S Configuration
\ ****************
\ *P Configuration is managed by the SAPI

target

\ ********************
\ *S Serial primitives
\ ********************
internal

: +FaultConsole	( -- )  ;
\ *G Because this is a polled driver, *\fo{+FaultConsole} for
\ ** fault handling is a *\fo{NOOP}. See *\i{Cortex/FaultCortex.fth}
\ ** for more details.

target

\ CODE (seremitfc)	\ char base --
\ This is a system call.

: (seremit)	\ char base --
\ *G Wrapped call that checks for throttling, and if so,
\ calls PAUSE to let another task run, or just does a WFI if no multitasker.
\ The only interesting thing is failure, or -1.  That means retry.
    (seremitfc) if pause then
	;

: (sertype) \ caddr len base --
\ *G Transmit a string on the given UART.
  -rot bounds
  ?do  i c@ over (seremit)  loop
  drop
;

: (sercr)	\ base --
\ *G Transmit a CR/LF pair on the given UART.
   $0D over (seremit)  $0A swap (seremit)
;

: (serkey) \ base -- c
\ *G Get a character from the port.  Retry until we get it.
\ See if its negative.  If so, discard it and leave false to re-loop.
\ If not negative, leave true on the stack to exit.
    begin \ base ret t/f
	dup (serkeyfc) dup 0 <  \ base ret t/f
	 IF [ tasking? ] [if] PAUSE [else] [asm wfi asm] [then] drop false
	 ELSE true
	 THEN \ base ret t/f
	until  \ base ret
	swap drop
;

\ THis is a system call.
\ CODE (serkey?)     \ base -- t/f
\ *G Return true if the given UART has a character avilable to read.

external

: seremit0	\ char --
\ *G Transmit a character on UART0.
  0 (seremit)  ;
: sertype0	\ c-addr len --
\ *G Transmit a string on UART0.
  0 (sertype)  ;
: sercr0	\ --
\ *G Issue a CR/LF pair to UART0.
  0 (sercr)  ;
: serkey?0	\ -- flag
\ *G Return true if UART0 has a character available.
  0 (serkey?)  ;
: serkey0	\ -- char
\ *G Wait for a character on UART0.
  0 (serkey)  ;
create Console0	\ -- addr ; OUT managed by upper driver
\ *G Generic I/O device for UART0.
  ' serkey0 ,		\ -- char ; receive char
  ' serkey?0 ,		\ -- flag ; check receive char
  ' seremit0 ,		\ -- char ; display char
  ' sertype0 ,		\ caddr len -- ; display string
  ' sercr0 ,		\ -- ; display new line

\ Non-UARTs.
: seremit10 #10 (seremit)  ;
: sertype10	#10 (sertype)  ;
: sercr10	#10 (sercr)  ;
: serkey?10	#10 (serkey?)  ;
: serkey10	#10 (serkey)  ;
create Console10 ' serkey10 , ' serkey?10 , ' seremit10 , ' sertype10 , ' sercr10 ,

console-port 0 = [if]
  console0 constant console
\ *G *\fo{CONSOLE} is the device used by the Forth system for interaction.
\ ** It may be changed by one of the phrases of the form:
\ *C   <device>  dup opvec !  ipvec !
\ *C   <device>  SetConsole
[then]

console-port  #10 = [if]
  console10 constant console
[then]

\ ************************
\ *S System initialisation
\ ************************

\ This is a NOP in the SAPI environment
: init-ser ;	\ --
\ *G Initialise all serial ports

\ ======
\ *> ###
\ ======

decimal

error: pathspec 'forth/serCM3_SAPI-level1.fth' did not match any file(s) known to git


logto: add logto.fth to broken/

logto: add logto.fth to broken/

Work in progress.

\ Send output to a file or device.
\
\ You can send to the printer with   LOGTO PRT:
\
\ Author: Phil Burk
\ Copyright 1990 Phil Burk
\
\ MOD: PLB 12/28/86 Add filtering of CRs.
\ MOD: PLB 9/9/88 Add IF.FORGOTTEN , SAVE-FORTH fix.
\ MOD: PLB 1/21/89 Add PRINTER.ON, some reorganization
\ MOD: PLB 4/3/90 Converted to Mac HMSL

ANEW TASK-LOGTO

decimal
\ Provide a log of the output to a file.
variable LOGTO-ID
variable LOGTO-OLDTYPE
variable LOGTO-OLDCR

decimal

: LOGGED?  ( -- flag )
  logto-oldtype @ 0= 0=
;

: <LOGSTOP>  ( -- , Stop logging files )
  logged?
  IF  logto-oldtype @ is type
      logto-oldtype off
      logto-oldcr @ is cr
  THEN
;

: FLOGTYPE  ( addr count-- , send chars to console, if appropriate )
  logto-id @  -rot
  dup>r fwrite    r> -
  IF   <logstop>
       ." FLOGtype failed to write buffer; recommend LOGEND" abort
  THEN
;

: FLOGCR  ( -- , send carriage return )
    logto-id @ $ 0D femit
;

: LOGTO&TYPE ( addr count -- , send to both file and screen )
    2dup logto-oldtype @execute
    flogtype
;

: LOGTO&CR  ( -- )
    logto-oldcr @ execute
    flogcr
;

: LOGSTART  ( -- , Start logging characters )
  LOGGED?
  IF   ." can't LOGSTART, already logged." cr
  ELSE what's type logto-oldtype !  ( save old cfa )
       ' logto&type is type         ( set vector )
       what's cr  logto-oldcr !
       ' logto&cr is cr
  THEN
;

: $LOGTO  ( $filename -- , Open file and log characters to it. )
    logto-id @ 0=
    IF  new $FOPEN ?dup
        IF   logto-id !   logstart
        ELSE ." Could not be opened!" cr abort
        THEN
    ELSE ." Can't LOGTO " $type  ." , already logged."
    THEN
;

: LOGTO ( <name> --IN-- , Log characters to a file. )
    fileword  $logto
;

: LOGSTOP  ( -- , temporarily stop logging )
    logged?
    IF <logstop>
    THEN
;

: <LOGEND> ( -- , used internally )
    cr logstop
    logto-id @ fclose
    logto-id off
;

: LOGEND ( -- . terminate logto, close file )
    logto-id @
    IF <logend>
    ELSE ." Can't LOGEND, not logged!" cr
    THEN
;

: LOGTERM ( -- , used internally for cleanup )
    logto-id @
    IF  ." Turning off LOGTO !!!" cr
        <logend>
    THEN
;

decimal
if.forgotten logterm

: AUTO.TERM  logterm auto.term ;

error: pathspec 'hmsl/broken/logto.fth' did not match any file(s) known to git