Preparing the our next release with our first stage3 program
This commit is contained in:
parent
97a145ac1f
commit
1e28eadc7a
|
@ -22,6 +22,7 @@ Added DP! to stage2 forth
|
||||||
Added EXECUTE to stage2 forth
|
Added EXECUTE to stage2 forth
|
||||||
Added ABORT to stage2 forth
|
Added ABORT to stage2 forth
|
||||||
Added string print and address to output of High level prototype disassembler
|
Added string print and address to output of High level prototype disassembler
|
||||||
|
Added initial prototype library for forth developers who want better ANS support
|
||||||
|
|
||||||
** Changed
|
** Changed
|
||||||
Extended VPATH in makefile to shorten dependency names
|
Extended VPATH in makefile to shorten dependency names
|
||||||
|
|
|
@ -0,0 +1,139 @@
|
||||||
|
\ Copyright (C) 2017 Jeremiah Orians
|
||||||
|
\ Copyright (C) 2017 Reepca
|
||||||
|
\ This file is part of stage0.
|
||||||
|
\
|
||||||
|
\ stage0 is free software: you can redistribute it and/or modify
|
||||||
|
\ it under the terms of the GNU General Public License as published by
|
||||||
|
\ the Free Software Foundation, either version 3 of the License, or
|
||||||
|
\ (at your option) any later version.
|
||||||
|
\
|
||||||
|
\ stage0 is distributed in the hope that it will be useful,
|
||||||
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
\ GNU General Public License for more details.
|
||||||
|
\
|
||||||
|
\ You should have received a copy of the GNU General Public License
|
||||||
|
\ along with stage0. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
\ Simply cat this file to the top of any forth program that leverages its functionality
|
||||||
|
\ then execute the resulting out put as so:
|
||||||
|
\ ./bin/vm-production --rom roms/forth --memory 1M --tape_01 The_combined_file
|
||||||
|
\ All writes via WRITE8 will be written to tape_02 or whatever name you prefer via the --tape_02 option
|
||||||
|
|
||||||
|
|
||||||
|
\ Define our CELL size as 4 bytes
|
||||||
|
: CELL 4 ;
|
||||||
|
|
||||||
|
\ Save us from manually calculating how many bytes is a given number of CELLS
|
||||||
|
: CELLS CELL * ;
|
||||||
|
|
||||||
|
\ Setup an easy to reference FLAGS offset Constant
|
||||||
|
: >FLAGS 2 CELLS + ;
|
||||||
|
|
||||||
|
\ Update the flags of the latest defintion to IMMEDIATE
|
||||||
|
: IMMEDIATE LATEST >FLAGS DUP @ 0x2 OR SWAP ! ;
|
||||||
|
|
||||||
|
\ Define ALLOT to allocate a give number of bytes
|
||||||
|
: ALLOT HERE + DP! ;
|
||||||
|
|
||||||
|
\ Read a word, lookup and return pointer to its definition and don't use up HEAP space doing it
|
||||||
|
: ' HERE WORD DROP FIND >CFA SWAP DP! ;
|
||||||
|
|
||||||
|
\ Lookup a word and write the address of its definition
|
||||||
|
: [COMPILE] ' , ; IMMEDIATE
|
||||||
|
|
||||||
|
\ The literal code address of LIT. Don't think too hard about it.
|
||||||
|
: LITERAL [ ' LIT DUP , , ] , , ;
|
||||||
|
|
||||||
|
\ Lookup a word and append some literals
|
||||||
|
: ['] ' LITERAL ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Define IF as if top of stack is false branch to Literal value not yet written
|
||||||
|
: IF [ ' 0BRANCH LITERAL ] , HERE 0 , ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Get displacement between two address and write the difference to the address first given
|
||||||
|
: TARGET! OVER - SWAP ! ;
|
||||||
|
|
||||||
|
\ equivalent to "ENDIF".
|
||||||
|
: THEN HERE TARGET! ; IMMEDIATE
|
||||||
|
|
||||||
|
\ And our ELSE for our IF
|
||||||
|
: ELSE HERE 2 CELLS + TARGET! ['] BRANCH , HERE 0 , ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Put here on the stack for the while to pickup and turn into an immediate jump
|
||||||
|
: BEGIN HERE ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Use stack value from begin to loop if still true
|
||||||
|
: WHILE [COMPILE] IF ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Who doesn't love repeat?
|
||||||
|
: REPEAT HERE 2 CELLS + TARGET! ['] BRANCH , HERE SWAP TARGET! CELL ALLOT ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Writes our repetition target
|
||||||
|
: AGAIN HERE SWAP TARGET! ; IMMEDIATE
|
||||||
|
|
||||||
|
\ If true put t otherwise put f
|
||||||
|
: .BOOL IF 116 EMIT ELSE 102 EMIT THEN ;
|
||||||
|
|
||||||
|
\ Writes a Byte to HEAP
|
||||||
|
: C, HERE C! 1 ALLOT ;
|
||||||
|
|
||||||
|
\ Prints Memory from address a to a + b when invoked as a b TYPE
|
||||||
|
: TYPE OVER + SWAP BEGIN 2DUP > WHILE DUP C@ EMIT 1 + REPEAT 2DROP ;
|
||||||
|
|
||||||
|
\ So we don't have to type 10 EMIT for newlines anymore
|
||||||
|
: CR 10 EMIT ;
|
||||||
|
|
||||||
|
\ Makes a string on the HEAP from everything between it and "
|
||||||
|
: STR" HERE BEGIN KEY DUP 34 != WHILE C, REPEAT DROP HERE OVER - ;
|
||||||
|
|
||||||
|
\ Extends STR" to work in Compile mode
|
||||||
|
: S" STATE IF ['] BRANCH , HERE 0 , STR" ROT HERE TARGET! SWAP LITERAL LITERAL ELSE STR" THEN ; IMMEDIATE
|
||||||
|
|
||||||
|
\ Extends S" to behave the way most users want "
|
||||||
|
: ." [COMPILE] S" STATE IF ['] TYPE , ELSE TYPE THEN ; IMMEDIATE
|
||||||
|
|
||||||
|
\ add the ANS keyword for modulus
|
||||||
|
: MOD % ;
|
||||||
|
|
||||||
|
\ add ANS keyword for getting both Quotent and Remainder
|
||||||
|
: /MOD 2DUP MOD >R / R> ;
|
||||||
|
|
||||||
|
\ Primitive needed for printing base 10 numbers
|
||||||
|
: NEXT-DIGIT 10 /MOD ;
|
||||||
|
|
||||||
|
\ Give us a 400bytes of storage to play with
|
||||||
|
: PAD HERE 100 CELLS + ;
|
||||||
|
|
||||||
|
\ Assuming 2's complement
|
||||||
|
: NEGATE NOT 1 + ;
|
||||||
|
|
||||||
|
\ Swap the contents of 2 Memory addresses
|
||||||
|
: CSWAP! 2DUP C@ SWAP C@ ROT C! SWAP C! ;
|
||||||
|
|
||||||
|
\ Given an address and a number of Chars, reverses a string (handy for little endian systems that have bytes in the wrong order)
|
||||||
|
: REVERSE-STRING OVER + 1 - BEGIN 2DUP < WHILE 2DUP CSWAP! 1 - SWAP 1 + SWAP REPEAT 2DROP ;
|
||||||
|
|
||||||
|
\ Given an address and number, writeout number at address and increment address
|
||||||
|
: +C! OVER C! 1 + ;
|
||||||
|
|
||||||
|
\ Given a number and address write out string form of number at address and returns address and length (address should have at least 10 free bytes).
|
||||||
|
: NUM>STRING DUP >R OVER 0 < IF SWAP NEGATE SWAP 45 +C! THEN DUP >R SWAP BEGIN NEXT-DIGIT ROT SWAP 48 + +C! SWAP DUP WHILE REPEAT DROP R> 2DUP - REVERSE-STRING R> SWAP OVER - ;
|
||||||
|
|
||||||
|
\ A user friendly way to print a number
|
||||||
|
: . PAD NUM>STRING TYPE ;
|
||||||
|
|
||||||
|
\ A temp constant that is going to be replaced
|
||||||
|
: STACK-BASE 0x00090000 ;
|
||||||
|
|
||||||
|
\ Given current stack pointer calculate and display number of underflowed cells
|
||||||
|
: .UNDERFLOW ." Warning: stack is underflowed by " STACK-BASE SWAP - CELL / . ." cells!" CR ;
|
||||||
|
|
||||||
|
\ Display the number of entries on stack in <n> form
|
||||||
|
: .HEIGHT STACK-BASE - CELL / ." <" . ." > " ;
|
||||||
|
|
||||||
|
\ Display count and contents of stack or error message if Underflow
|
||||||
|
: .S DSP@ DUP STACK-BASE < IF .UNDERFLOW ELSE DUP .HEIGHT STACK-BASE BEGIN 2DUP > WHILE DUP @ . 32 EMIT CELL + REPEAT 2DROP THEN ;
|
||||||
|
|
||||||
|
\ Pop off contents of stack to Zero stack
|
||||||
|
: CLEAR-STACK BEGIN DSP@ STACK-BASE > WHILE .S 10 EMIT DROP REPEAT STACK-BASE DSP! ;
|
Loading…
Reference in New Issue