\ Save us from manually calculating how many bytes is a given number of CELLS
:CELLSCELL* ;
\ Setup an easy to reference FLAGS offset Constant
:>FLAGS2CELLS + ;
\ Update the flags of the latest defintion to IMMEDIATE
:IMMEDIATELATEST>FLAGSDUP @ 0x2OR SWAP ! ;
\ Define ALLOT to allocate a give number of bytes
:ALLOTHERE + DP!;
\ Read a word, lookup and return pointer to its definition and don't use up HEAP space doing it
:'HERE WORD DROP FIND >CFASWAP 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['LITDUP , , ], , ;
\ 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['0BRANCHLITERAL ], HERE 0, ; IMMEDIATE
\ Get displacement between two address and write the difference to the address first given
:TARGET!OVER - SWAP ! ;
\ equivalent to "ENDIF".
:THENHERE TARGET!; IMMEDIATE
\ And our ELSE for our IF
:ELSEHERE 2CELLS + TARGET!['] BRANCH, HERE 0, ; IMMEDIATE
\ Put here on the stack for the while to pickup and turn into an immediate jump
:BEGINHERE ; IMMEDIATE
\ Use stack value from begin to loop if still true
:WHILE[COMPILE] IF ; IMMEDIATE
\ Who doesn't love repeat?
:REPEATHERE 2CELLS + TARGET!['] BRANCH, HERE SWAP TARGET!CELLALLOT ; IMMEDIATE
\ Writes our repetition target
:AGAINHERE SWAP TARGET!; IMMEDIATE
\ If true put t otherwise put f
:.BOOLIF 116EMIT ELSE 102EMIT THEN ;
\ Writes a Byte to HEAP
:C,HERE C! 1ALLOT ;
\ Prints Memory from address a to a + b when invoked as a b TYPE
:TYPEOVER + SWAP BEGIN 2DUP > WHILE DUP C@ EMIT 1+ REPEAT 2DROP ;
\ So we don't have to type 10 EMIT for newlines anymore
:CR10EMIT ;
\ 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
:/MOD2DUP MOD >R / R> ;
\ Primitive needed for printing base 10 numbers
:NEXT-DIGIT10/MOD ;
\ Give us a 400bytes of storage to play with
:PADHERE 100CELLS + ;
\ Assuming 2's complement
:NEGATENOT1+ ;
\ 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-STRINGOVER + 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>STRINGDUP >R OVER 0< IF SWAP NEGATE SWAP 45+C!THEN DUP >R SWAP BEGIN NEXT-DIGITROT SWAP 48+ +C!SWAP DUP WHILE REPEAT DROP R> 2DUP - REVERSE-STRINGR> SWAP OVER - ;
\ A user friendly way to print a number
:.PAD NUM>STRINGTYPE ;
\ A temp constant that is going to be replaced
:STACK-BASE0x00090000;
\ Given current stack pointer calculate and display number of underflowed cells
:.UNDERFLOW."Warning: stack is underflowed by "STACK-BASESWAP - CELL/ . ." cells!"CR ;
\ Display the number of entries on stack in <n> form
:.HEIGHTSTACK-BASE- CELL/ ."<". ."> ";
\ Display count and contents of stack or error message if Underflow
:.SDSP@DUP STACK-BASE< IF .UNDERFLOWELSE DUP .HEIGHTSTACK-BASEBEGIN 2DUP > WHILE DUP @ . 32EMIT CELL+ REPEAT 2DROP THEN ;
\ Pop off contents of stack to Zero stack
:CLEAR-STACKBEGIN DSP@STACK-BASE> WHILE .S 10EMIT DROP REPEAT STACK-BASEDSP!;