mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
104 lines
3.0 KiB
104 lines
3.0 KiB
; LISTING 4.
|
|
;
|
|
; ===============================================
|
|
; CamelForth for the Zilog Z80
|
|
; Copyright (c) 1994,1995 Bradford J. Rodriguez
|
|
;
|
|
; This program 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.
|
|
;
|
|
; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
; Commercial inquiries should be directed to the author at
|
|
; 115 First St., #105, Collingwood, Ontario L9Y 4W3 Canada
|
|
; or via email to bj@camelforth.com
|
|
;
|
|
; ===============================================
|
|
; CAMEL80R.AZM: ROMWBW additions
|
|
; Source code is for the ZSM assembler.
|
|
; Forth words are documented as follows:
|
|
;* NAME stack -- stack description
|
|
; Word names in upper case are from the ANS
|
|
; Forth Core word set. Names in lower case are
|
|
; "internal" implementation words & extensions.
|
|
; ===============================================
|
|
|
|
; DOUBLE PRECISION WORDS ==================
|
|
|
|
;C D. d -- display d signed
|
|
head DDOT,2,D.,docolon
|
|
DW LESSNUM,DUP,TOR,DABS,NUMS
|
|
DW RFROM,SIGN,NUMGREATER,TYPE,SPACE,EXIT
|
|
|
|
;X D+ d1 d2 -- d1+d2 Add double numbers
|
|
head DPLUS,2,D+,docode
|
|
exx
|
|
pop bc ; BC'=d2lo
|
|
exx
|
|
pop hl ; HL=d1hi,BC=d2hi
|
|
exx
|
|
pop hl ; HL'=d1lo
|
|
add hl,bc
|
|
push hl ; 2OS=d1lo+d2lo
|
|
exx
|
|
adc hl,bc ; HL=d1hi+d2hi+cy
|
|
ld b,h
|
|
ld c,l
|
|
next
|
|
|
|
;C 2>R d -- 2 to R
|
|
head TWOTOR,3,2!>R,docolon
|
|
DW SWOP,RFROM,SWOP,TOR,SWOP,TOR,TOR,EXIT
|
|
|
|
;C 2R> d -- fetch 2 from R
|
|
head TWORFROM,3,2R!>,docolon
|
|
DW RFROM,RFROM,RFROM,SWOP,ROT,TOR,EXIT
|
|
|
|
TNEGATE:
|
|
call docolon
|
|
DW TOR,TWODUP,OR,DUP,qbranch,TNEG1,DROP,DNEGATE,lit,1
|
|
TNEG1:
|
|
DW RFROM,PLUS,NEGATE,EXIT
|
|
|
|
qtneg:
|
|
call docolon
|
|
DW ZEROLESS,qbranch,qtneg1,TNEGATE
|
|
qtneg1:
|
|
DW EXIT
|
|
|
|
TSTAR:
|
|
call docolon
|
|
DW TWODUP,XOR,TOR
|
|
DW TOR,DABS,RFROM,ABS
|
|
DW TWOTOR
|
|
DW RFETCH,UMSTAR,lit,0
|
|
DW TWORFROM,UMSTAR
|
|
DW DPLUS
|
|
DW RFROM
|
|
DW qtneg
|
|
DW EXIT
|
|
|
|
TDIV:
|
|
call docolon
|
|
DW OVER,TOR,TOR
|
|
DW DUP,qtneg
|
|
DW RFETCH,UMSLASHMOD
|
|
DW ROT,ROT
|
|
DW RFROM,UMSLASHMOD
|
|
DW NIP,SWOP
|
|
DW RFROM,ZEROLESS,qbranch,tdiv1,DNEGATE
|
|
tdiv1:
|
|
DW EXIT
|
|
|
|
;C M*/ d1 n2 u3 -- d=(d1*n2)/u3 double precision mult. div
|
|
head MSTARSLASH,3,M*/,docolon
|
|
DW TOR,TSTAR,RFROM,TDIV,EXIT
|
|
|
|
|