94 lines
3.0 KiB
Forth
94 lines
3.0 KiB
Forth
\ **********************************************************************
|
|
|
|
\ util.fs - some broadly useful words for FlashForth programming
|
|
\ Copyright 2021 Christopher Howard
|
|
|
|
\ SPDX-License-Identifier: Apache-2.0
|
|
|
|
\ Licensed under the Apache License, Version 2.0 (the "License");
|
|
\ you may not use this file except in compliance with the License.
|
|
\ You may obtain a copy of the License at
|
|
|
|
\ http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
\ Unless required by applicable law or agreed to in writing, software
|
|
\ distributed under the License is distributed on an "AS IS" BASIS,
|
|
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
\ See the License for the specific language governing permissions and
|
|
\ limitations under the License.
|
|
|
|
\ This module provides a set of convenience words that are broadly
|
|
\ useful in FlashForth programming. Some of these are standard Forth
|
|
\ words not implemented in FlashForth
|
|
|
|
\ Public words:
|
|
\ ncell+ ncell- -rot pick 3dup 4dup cp>r 4>mem 4<mem | |] || ||]
|
|
\ low-byte high-byte 2< 2array
|
|
|
|
\ **********************************************************************
|
|
|
|
util
|
|
marker util
|
|
|
|
\ **********************************************************************
|
|
\ Memory calculations
|
|
\ **********************************************************************
|
|
|
|
: ncell+ ( a n -- a ) cell * + ;
|
|
|
|
: ncell- ( a n -- a ) cell * - ;
|
|
|
|
\ **********************************************************************
|
|
\ Return and data stack manipulation
|
|
\ **********************************************************************
|
|
|
|
: -rot ( u1 u2 u3 -- u3 u1 u2 ) rot rot ;
|
|
|
|
: pick ( xu ... x0 u -- xu ... x0 xu ) sp@ swap ncell+ @ ;
|
|
|
|
: 3dup ( x0 x1 x2 -- x0 x1 x2 x0 x1 x2 ) 2 pick 2 pick 2 pick ;
|
|
|
|
: 4dup ( x0 ... x3 -- x0 ... x3 x0 ... x3 )
|
|
3 pick 3 pick 3 pick 3 pick ;
|
|
|
|
: cp>r ( u -- u : -- u ) dup >r ; inlined
|
|
|
|
\ **********************************************************************
|
|
\ Copying data to/from memory
|
|
\ **********************************************************************
|
|
|
|
: 4>mem ( u u u u a -- )
|
|
cp>r 3 ncell+ ! r@ 2 ncell+ ! r@ 1 ncell+ ! r> ! ;
|
|
|
|
: 4<mem ( a -- u u u u )
|
|
cp>r @ r@ 1 ncell+ @ r@ 2 ncell+ @ r> 3 ncell+ @ ;
|
|
|
|
: | ( a x -- a ) swap cp>r ! r> cell + ;
|
|
|
|
: |] | drop ;
|
|
|
|
: || ( a x1 x2 -- a ) rot cp>r 2! r> 2 ncell+ ;
|
|
|
|
: ||] || drop ;
|
|
|
|
\ **********************************************************************
|
|
\ Comparison words, and bit field manipulation
|
|
\ **********************************************************************
|
|
|
|
: low-byte ( u -- u ) %0000000011111111 and ;
|
|
|
|
: high-byte ( u -- u ) %1111111100000000 and 8 rshift ;
|
|
|
|
: 2< ( u0 u1 u2 u3 -- b ) rot > -rot < and ;
|
|
|
|
\ **********************************************************************
|
|
\ 2D array data structure
|
|
\ **********************************************************************
|
|
|
|
: 2in-bounds ( n0 n1 a -- b ) 2@ swap 2< 0= ;
|
|
|
|
: 2array ( n0 n1 -- ) create 2dup , , * cells allot
|
|
does> ( n0 n1 -- a )
|
|
3dup 2in-bounds invert abort" out of bounds"
|
|
cp>r 2@ nip * + cells r> + ;
|