OPT PRT * runtimelib FOR 6800 * Joel Matthew Rees April 2020 * Borrowing some concepts from fig-Forth. * Not tested! * ------------------------------------LICENSE------------------------------------- * * Copyright (c) 2009, 2010, 2011 Joel Matthew Rees * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. * * --------------------------------END-OF-LICENSE---------------------------------- * * These must be edited for target runtime: * Necessary here for fake forward referencing: BYTESZ EQU 8 ; bit count in byte ADRWDSZ EQU 2 ; bytes per address word * If at all possible, a CELL should be able to contain an address. * Otherwise, fetch and store become oddities. CELLSZ EQU ADRWDSZ CELLBSZ EQU (CELLSZ*BYTESZ) ; bit count in CELL DBLSZ EQU (CELLSZ*2) DBLBSZ EQU (DBLSZ*BYTESZ) ; bit count in DOUBLE GAPCT EQU 2 ; address words for the gaps ALLOGAP EQU (GAPCT*CELLSZ) ; For crude checks, gaps always zero. * Declare initial Return Stack (flow-of-control stack): RSTKBND EQU $8000 ; Bound: one beyond RSTKINI EQU (RSTKBND-1) ; Init: next available byte on 6800 RSTKSZ EQU (62*CELLSZ) ; Size: Safe for most purposes. RSTKLIM EQU (RSTKBND-RSTKSZ) ; Limit: Last useable * Kibitzing -- CPUs really should have automatic stack bounds checking. * Don't forget gaps for CPUs that don't automatically check. * Crude guard rails is better than none? * Declare initial Parameter Stack (data stack): SSTKBND EQU (RSTKLIM-ALLOGAP) SSTKINI EQU (SSTKBND-CELLSZ) ; Also post-dec on 6800, but on address word boundary. SSTKSZ EQU (126*CELLSZ) ; Size: CELL addressing, small stacks. SSTKLIM EQU (SSTKBND-SSTKSZ) * The paramater stack and heap at opposite ends of the same region * has mixed benefits. * The initial per-user allocation heap: UPGBND EQU (SSTKLIM-ALLOGAP) UPGSZ EQU (64*CELLSZ) ; This will need adjusting in many cases. UPGBASE EQU (UPGBND-UPGSZ) UPGINI EQU UPGBASE * ORG directives in older assemblers can get tangled up * if they are convoluted. Keep the ORGs in assending order. ORG $40 * Internal registers -- * (When switching contexts, these must be saved and restored.): * RP RMB ADRWDSZ ; the return/flow-of-control stack pointer is 6800 S PSP RMB ADRWDSZ ; the parameter/data stack pointer (Forth SP) UP RMB ADRWDSZ ; pointer to the per-task heap TEMP RMB 2*CELLSZ ; for general math GCOUNT RMB CELLSZ ; general counter IXDEST RMB ADRWDSZ ; destination index pointer IXSRC RMB ADRWDSZ ; source index pointer IXTERM RMB ADRWDSZ ; terminator for moves ORG $100 NOP COLD JMP COLDENT NOP WARM JMP WARMENT * _LOWORD_ Move 256 bytes or less going up: * 0=256, do not enter without pretesting for 0 count! * source in IXSRC, destination in IXDEST, count in B: * Overlaps only work if source is higher than dest. SMOVEUP LDX IXSRC LDAA 0,X INX STX IXSRC LDX IXDEST STAA 0,X INX STX IXDEST DECB BNE SMOVEUP RTS * _LOWORD_ Move 256 bytes or less going down: * 0=256, do not enter without pretesting for 0 count! * source in IXSRC, destination in IXDEST, count in B, A is overwritten: * Overlaps only work if source is higher than dest. SMOVEDN TBA ADDA IXSRC+1 STAA IXSRC+1 CLRA ; 1# 2~ -- BCC takes 2#, 4~; INC IXSRC takes 3# & 6~ ADCA IXSRC ; 2# 3~ STAA IXSRC ; 2# 4~ TBA ADDA IXDEST+1 STAA IXDEST+1 CLRA ; 1# 2~ -- BCC takes 2#, 4~; INC IXDEST takes 3# & 6~ ADCA IXDEST ; 2# 3~ STAA IXDEST ; 2# 4~ SMOVEDL LDX IXSRC DEX LDAA 0,X STX IXSRC LDX IXDEST DEX STAA 0,X STX IXDEST DECB BNE SMOVEDL RTS * _WORD_ Move up to 32K bytes ( src dest count --- ): * Copies zero when count >= 2^15 * Compare CMOVE in Forth. BMOVE LDX PSP ; get paramaters LDX 0,X BEQ DEALL3 ; bail now if zero BMI DEALL3 ; also if greater than 32K STX GCOUNT LDX PSP LDX CELLSZ,X LDAA 0,X ; SRC, going to do math LDAB 1,X STAA IXDEST STAB IXDEST+1 SUBB CELLSZ+ADRWDSZ+1,X ; DEST SBCA CELLSZ+ADRWDSZ,X STAB TEMP+1 STAA TEMP BCS BMOVEDN BMOVEUP ****** Working in here to make it go both ways. ****** Also need to check multiply and divide. LDX PSP LDX CELLSZ+ADRWDSZ,X STX IXSRC * SUBB LDAB GCOUNT+1 ; Get low byte for partial block CLR GCOUNT+1 ; To avoid debugging confusion. BMOVEL BSR SMOVE ; partial block and full blocks DEC GCOUNT ; count high byte down (blocks) BPL BMOVEL ; This limits the count. * Rob point to deallocate 3 on stack, as long as CELLSZ == ADRWDSZ. DEALL3 LDAB PSP+1 ; 2# 3~ ADDB #(CELLSZ+2*ADRWDSZ) ; 2# 3~ STAB PSP+1 ; 2# 4~ BCC BMOVEX ; 2# 4~ INC PSP ; 3# 6~ Unaries have no direct page version. => 11# 20~ BMOVEX RTS * DEALL3 * LDAB PSP+1 ; 2# 3~ * ADDB #(CELLSZ+2*ADRWDSZ) ; 2# 3~ * STAB PSP+1 ; 2# 4~ * LDAA PSP ; 2# 3~ * ADCA #(CELLSZ+2*ADRWDSZ) ; 2# 3~ * STAA PSP ; 2# 4~ => 12# 20~ * RTS * DEALL3 * LDX PSP ; 6 INXs is around the breakover point in the 6800. * INX ; 2 + 6 + 2 bytes => 11# * INX ; 4 + 24 + 5 cycles => 33~ * INX * INX * INX * INX * STX PSP * RTS * * _LOWORD_ Subtract byte in B from cell pointed to by X: * Not really all that useful when you can CLRA and SUBCELL? * SUBBYT * LDAA 1,X * SBA * STAA 1,X * BCC ADDBYTX * DEC 0,X * SUBBYTX RTS * _LOWORD_ Add byte in B to cell pointed to by X: * Not really all that useful when you can CLRA and ADDCELL? * ADDBYT * ADDB 1,X * STAB 1,X * BCC ADDBYTX * INC 0,X * ADDBYTX RTS * GETAB MACRO * LDX PSP * LDAB 1,X * LDAA 0,X * INX * INX * STX PSP * ENDM * Or doing as subroutine would would add 4 bytes and about ten cycles? * How useful would it be? * _WORD_ Take logical AND of top two on stack ( n1 n2 --- n3 ): AND LDX PSP LDAA 0,X LDAB 1,X ANDA CELLSZ,X ANDB CELLSZ+1,X BRA STDEALL * _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ): OR LDX PSP LDAA 0,X LDAB 1,X ORAA CELLSZ,X ORAB CELLSZ+1,X BRA STDEALL * _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ): XOR LDX PSP LDAA 0,X LDAB 1,X EORA CELLSZ,X EORB CELLSZ+1,X BRA STDEALL * _WORD_ Add top two cells on stack ( n1 n2 --- sum ): ADD LDX PSP ; MACRO GETAB LDAB CELLSZ+1,X ; n2 LDAA CELLSZ,X * Fall through: * * _LOWORD_ Add cell in A:B to cell pointed to by X: ADDCELL ADDB 1,X ADCA 0,X * Keep rob point for storing over 2nd and deallocating top. STDEALL STAB CELLSZ+1,X STAA CELLSZ,X INX ; deallocate INX STX PSP RTS * _WORD_ Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ): SUB LDX PSP ; MACRO GETAB LDAB CELLSZ+1,X LDAA CELLSZ,X * Fall through: * * !xxx _LOWORD_ Subtract cell pointed to by 2,X from cell in A:B (not useful?): SUBCELL SUBB 1,X SBCA 0,X BRA STDEALL * STAB CELLSZ+1,X * STAA CELLSZ,X * INX ; deallocate * INX * STX PSP * RTS * _WORD_ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ): * (Refer to Forth's C@, but byte is not character!) BFETCH LDX PSP LDX 0,X ; adr LDAB 1,X LDX PSP CLR 0,X STAB 1,X ; Not worth robbing. RTS * _WORD_ Store low byte of cell at 2nd at address on top of stack, deallocate both ( n adr --- ): * (Refer to Forth's C!, but byte is not character!) BSTORE LDX PSP LDAB ADRWDSZ+1,X ; n low byte only LDX 0,X ; adr STAB 0,X ; Store only byte, do not clear high byte! BRA DEALL2 ; Rob code to deallocate. * ASSERT CELLSZ == ADRWDSZ * _WORD_ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ): FETCH LDX PSP LDX 0,X ; adr LDAA 0,X LDAB 1,X LDX PSP STAA 0,X STAB 1,X RTS * _WORD_ Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ): STORE LDX PSP LDAA ADRWDSZ,X ; n LDAB ADRWDSZ+1,X LDX 0,X ; adr STAA 0,X STAB 1,X * Rob point to deallocate 2 on stack. DEALL2 LDX PSP INX INX INX INX STX PSP RTS * _WORD_ Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ): USTAR LDX PSP LDAA #CELLBSZ ; bits/cell STAA GCOUNT+1 CLRA CLRB USTARL ROR CELLSZ,X ; shift multiplier ROR CELLSZ+1,X DEC GCOUNT+1 ; done? BMI USTARX BCC USTARNA ADDB CELLSZ+1,X ADCA CELLSZ,X USTARNA RORA RORB ; shift result in BRA USTARL USTARX STAB 1,X ; store more significant 16 bits STAA 0,X RTS * _WORD_ swap top two cells on stack ( n1 n2 --- n2 n1 ): SWAP LDX PSP SWAPROB LDAA 0,X LDAB CELLSZ,X STAB 0,X STAA CELLSZ,x LDAA 1,X LDAB CELLSZ+1,X STAB 1,X STAA CELLSZ+1,x RTS * _WORD_ Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor * ( ud u --- uremainder uquotient ) * Dividend should be range of product of 16 by 16 bit unsigned multiply, * divisor should be the multiplier or multiplicand: USLASH LDX PSP LDAA #CELLBSZ+1 ; one more than bits/cell STAA GCOUNT+1 LDAA CELLSZ,X ; dividend LDAB CELLSZ+1,X USLLUP CMPA 0,X ; divisor BHI USLSUB ; Make sure carry from LSB would carry over BCS USLNSUB CMPB 1,X BCC USLSUB ; CC = HS (High or Same) USLNSUB CLC ; For shifting BRA USLNEXT USLSUB SUBB 1,X SBCA 0,X SEC ; For shifting USLNEXT ROL 1+2*CELLSZ,X ROL 2*CELLSZ,X DEC GCOUNT+1 BEQ USLX ROLB ROLA BCC USLLUP BRA USLSUB ; Catch the excess. USLX INX ; Drop high cell. INX STX PSP STAA 0,X ; High cell now empty, save remainder. STAB 1,X ; But remainder is now top. BRA SWAPROB ; PSP in X, reverse quotient & remainder. * Steal return. * _WORD_ Save top cell on stack to return stack ( n --- ) { --- n }: TOR LDX PSP LDAA 0,X LDAB 1,X PSHB ; Watch order! PSHA INX ; Not worth robbing code. INX STX PSP RTS * _WORD_ Pop top of return stack to parameter stack ( --- n ) { n --- }: RFROM PULA ; Watch order PULB BRA ALLOSTO * _WORD_ Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }: R TSX LDAA 0,X LDAB 1,X ALLOSTO LDX PSP ; allocate DEX DEX STX PSP STAA 0,X STAB 1,X RTS * Should true be set as 1 or -1? * _WORD_ Test top cell on stack for zero ( n --- f(top==0) ): LDX PSP CLR A CLR B LDX 0,X BNE ZEQU2 INC B ZEQU2 TSX * JMP STABX * _LOWORD_ Duplicate (count in B) bytes on stack: NDUP LDX PSP STX TEMP * _WORD_ Execute the address on the stack: EXEC LDX PSP INX INX STX PSP LDX 0,X JSR 0,X ; For debugging and flattening, no early optimizations. RTS COLDENT EQU * LDS #RSTKINI LDX #SSTKINI STX PSP WARMENT EQU * LDS #RSTKINI LDX #SSTKINI STX PSP LDX #UPGINI STX UP