1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; and now
for something completely different
...
5 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6 ;; Z80 Assembler
: code emitter
7 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10 vocab
-if-none asm
-emit
15 def
: zx
-mflag
-reserved
25 : used?
( addr
-- bool
)
26 dup
0x1_
0000 u
< swap zx
-mflags
+ c@ zx
-mflag
-used and logand
30 : find
-used
( from
-- addr TRUE
/ FALSE
)
31 begin dup
0x1_
0000 u
< over used? not and
while 1+ repeat
32 dup
0x1_
0000 u
< if true
else drop false
endif
35 : find
-unused
( from
-- addr TRUE
/ FALSE
)
36 begin dup
0x1_
0000 u
< over used? and
while 1+ repeat
37 dup
0x1_
0000 u
< if true
else drop false
endif
42 ;; main driver sets it before calling instruction words
50 : instruction
-start
( -- )
55 : .hex2
( n
-- ) base @ hex swap
<# # # #
> type base
! ;
56 : .hex4
( n
-- ) base @ hex swap
<# # # # # #
> type base
! ;
57 : .hex4
-r
( n
-- ) dup
.hex2 space
-8 lsh
.hex2
;
59 ;; used in various unpackers
(RLE
, for example
)
60 ;; doesn
't change flags
61 : c!-if-free ( value addr -- )
63 dup zx-mflags + c@ zx-mflag-used and ifnot
69 ;; doesn't change flags
70 : cmove
-from
-normal
( src zx
-dest count
-- )
73 over c@ over zx
-mem
+ c
!
79 : here
( -- addr
) disp
;
81 : or
-c
! ( value addr
-- )
82 dup
65535 u
> " invalid zx address" ?error
83 dup zx
-mflags
+ forth
:c@ zx
-mflag
-used
<> " trying to patch undefined zx memory address" ?error
84 zx
-mem
+ dup forth
:c@ rot or swap forth
:c
!
87 : c
! ( value addr
-- )
88 dup
65535 u
> " invalid zx address" ?error
89 dup zx
-mflags
+ forth
:c@ zx
-mflag
-used
<> " trying to patch undefined zx memory address" ?error
93 : w
! ( value addr
) 2dup c
! 1+ swap
-8 lsh swap c
! ;
101 : .pc
( -- ) ." #" pc
.hex4
." : " ;
103 : (emit
-byte
) ( byte
-- )
104 pc
65536 u
> " zx memory overflow (pc)" ?error
105 disp
65536 u
> " zx memory overflow (disp)" ?error
106 disp zx
-mflags
+ forth
:c@ zx
-mflag
-reserved and
" trying to write to reserved memory" ?error
107 disp zx
-mem
+ forth
:c
!
108 disp zx
-mflags
+ dup forth
:c@ zx
-mflag
-used or swap forth
:c
!
117 : neg
-byte
( byte
-- )
125 dup
(emit
-byte
) -8 lsh
(emit
-byte
)
130 dup
(emit
-byte
) -8 lsh
(emit
-byte
)
134 : (im
) ( byte
-- opcode
)
139 otherwise
" wtf?!" error
143 : im
( byte
-- ) (im
) byte
;
145 : rst
( rst
-addr
-- ) 0o307 or byte
;
146 : rst
-c
! ( rst
-addr addr
-- ) swap
0o307 or swap c
! ;
148 : bit
-c
! ( bitnum addr
+1 -- ) swap
3 lsh swap
1- or
-c
! ;