\ Amiga. 26Feb88pJa A Forth system for Amiga's based on Laxen & Perry's F83 Peter Appelman 1460 Ghent Ave apt 704 Burlington Ontario, Canada L7S-1X7 ( GEnie address: P.APPELMAN) legal: This is a public domain system, and may be freely distributed and copied, as long as the author is given credit and no copyright notice is placed upon it. \ Load Screen for 68k assembler. 13Jan88pJaonly forth also assembler definitions warning off : end-code avoc @ context ! reveal ; : c; end-code ; : *swap swap ; 2 16 thru ( assembler ) 18 load ( low level debugger ) cr .( 68k code loaded ) \ Deferred words. 13Jan88pJa: A?>mark (s -- adr f ) here true ; : A?>resolve (s adr f -- ) ?condition here over - swap 1- c! ; : A?<mark (s -- adr f ) here true ; : A?<resolve (s adr f -- ) ?condition here - here 1- c! ; defer c, forth ' c, assembler is c, defer w, forth ' w, assembler is w, defer , forth ' , assembler is , defer ?>mark ' A?>mark is ?>mark defer ?>resolve ' A?>resolve is ?>resolve defer ?<mark ' A?<mark is ?<mark defer ?<resolve ' A?<resolve is ?<resolve \ Sizes. 13Jan88pJa: ?, (s n1 f -- ) if , else w, then ; : 2, (s n -- ) w, w, ; octal variable size variable isize : byte (s -- ) 10000 size ! ; : word (s -- ) 30100 size ! ; : long (s -- ) 24600 size ! ; long : i.w (s -- ) 00000 isize ! ; : i.l (s -- ) 04000 isize ! ; i.l : sz (s n -- ) constant does> @ size @ and or ; 00300 sz sz3 00400 sz sz4 30000 sz sz300 : long? (s -- f ) size @ 24600 = ; : -sz1 (s op -- op' ) long? if 100 or then ; \ Addressing modes. 13Jan88pJa: regs (s n -- ) ( register direct ) 10 0 do dup 1001 i * or constant loop drop ; : mode (s n -- ) constant does> @ swap 7007 and or ; 0000 regs d0 d1 d2 d3 d4 d5 d6 d7 0110 regs a0 a1 a2 a3 a4 a5 a6 a7 0220 mode ) \ address register indirect 0330 mode )+ \ adr reg ind post-increment 0440 mode -) \ adr reg ind pre-decrement 0550 mode d) \ adr reg ind displaced 0660 mode di) \ adr reg ind displaced index 0770 constant w#) \ immediate address word size 1771 constant #) \ immediate long address 2772 constant pcd) \ pc displaced 3773 constant pcdi) \ pc displaced indexed 4774 constant # \ immediate data \ Register assignments. 13Jan88pJa: field (s n -- ) constant does> @ and ; 7000 field rd 0007 field rs 0070 field ms 0077 field eas 0377 field low : dn? (s ea -- ea fl ) dup ms 0= ; : src (s ea n -- ea n' ) over eas or ; : dst (s dn n -- n' ) swap rd or ; a7 constant sp a6 constant rp a5 constant ip a4 constant w a3 constant >next \ Extended addressing. 13Jan88pJa: double? (s mode -- flag ) dup #) = swap # = long? and or ; : index? (s {n} mode -- {m} mode ) dup >r dup 0770 and a0 di) = swap pcdi) = or if dup rd 10 * swap ms if 100000 or then ( now 'or' in the size of index ) or swap low or then r> ; : di) isize @ -rot di) ; : pcdi) isize @ swap pcdi) ; : more? (s ea -- ea fl ) dup ms 0040 > ; : ,more (s ea -- ) more? if index? double? ?, else drop then ; \ Extended addressing, extra's. 13Jan88pJacreate extra here 6 allot align 6 erase : extra? (s {n} mode -- mode ) more? if >r r@ index? double? extra 2+ swap if ! 2 else w! 1 then extra w! r> else 0 extra ! then ; : ,extra (s -- ) extra w@ ?dup if extra 2+ swap 1 = if w@ w, else @ , then extra 6 erase then ; \ Immediates & address register specific. 13Jan88pJa: imm (s n ea -- ) constant does> @ >r extra? eas r> or sz3 w, long? ?, ,extra ; 0000 imm ori 1000 imm andi 2000 imm subi 3000 imm addi 5000 imm eori 6000 imm cmpi : immccr (s n ea -- ) constant does> @ 2, ; 001074 immccr andi>ccr 005074 immccr eori>ccr 000074 immccr ori>ccr : iq (s n ea -- ) constant does> @ >r extra? eas swap rs 1000 * or r> or sz3 w, ,extra ; 050000 iq addq 050400 iq subq : ieaa (s ea An -- ) constant does> @ dst src sz4 w, ,more ; 150300 ieaa adda 130300 ieaa cmpa 040700 ieaa lea 110300 ieaa suba \ Shifts, rotates, bit manipulation. 13Jan88pJa: isr (s Dm Dn | m # Dn | ea -- ) constant does> @ >r dn? if swap dn? if r> 40 or >r else drop swap 1000 * then rd swap rs or r> or 160000 or sz3 w, else dup eas 300 or r@ 400 and or r> 70 and 100 * or 160000 or w, ,more then ; 400 isr asl 000 isr asr 410 isr lsl 010 isr lsr 420 isr roxl 020 isr roxr 430 isr rol 030 isr ror : ibit (s ea Dn | ea n # -- ) constant does> @ >r extra? dn? if rd src 400 else drop dup eas 4000 then or r> or w, ,extra ,more ; 000 ibit btst 100 ibit bchg 200 ibit bclr 300 ibit bset \ Branch, loop, set conditionals. 13Jan88pJa: setclass ' swap 0 do i over execute loop drop ; : ibra 400 * 060000 or constant does> @ swap ?>mark drop 2+ - dup abs 200 < if low or w, else swap 2, then ; ( adr ) : idbr 400 * 050310 or constant does> @ swap rs or w, ?>mark drop - w, ; ( adr Dn ) : iset 400 * 050300 or constant does> @ src w, ,more ; ( ea ) 20 setclass ibra bra bsr bhi bls bcc bcs bne beq bvc bvs bpl bmi bge blt bgt ble 20 setclass idbr dxit dbra dbhi dbls dbcc dbcs dbne dbeq dbvc dbvs dbpl dbmi dbge dblt dbgt dble 20 setclass iset set sno shi sls scc scs sne seq svc svs spl smi sge slt sgt sle \ Moves. 13Jan88pJa: move extra? 7700 and src sz300 w, ,more ,extra ; ( ea ea ) : moveq rd swap low or 070000 or w, ; ( n Dn ) : move>usp rs 047140 or w, ; ( An ) : move<usp rs 047150 or w, ; ( An ) : movem> extra? eas 044200 or -sz1 w, w, ,extra ; ( n ea ) : movem< extra? eas 046200 or -sz1 w, w, ,extra ; ( n ea ) : movep dn? if rd swap rs or 410 or else rs rot rd or 610 or then -sz1 2, ; ( Dm d An ) ( d An Dm ) : lmove 7700 and swap eas or 20000 or w, ; \ Odds and ends. 13Jan88pJa: cmpm rd swap rs or 130410 or sz3 w, ; ( An@+ Am@+ ) : exg dn? if swap dn? if 140500 else 140610 then >r else swap dn? if 140610 else 140150 then >r swap then rs dst r> or w, ; ( Rn Rm ) : ext rs 044200 or -sz1 w, ; ( Dn ) : swap rs 044100 or w, ; ( Dn ) : stop 47162 2, ; ( n ) : trap 17 and 47100 or w, ; ( n Am ) : link rs 047120 or 2, ; ( n Am ) : unlk rs 047130 or w, ; ( An ) : eor extra? eas dst sz3 130400 or w, ,extra ; ( Dn ea ) : cmp 130000 dst src sz3 w, ,more ; ( ea Dn ) \ Arithmatic and Logic. 13Jan88pJa: ibcd constant does> @ dst over rs or *swap ms if 10 or then w, ; ( Dn Dm ) ( An@- Am@- ) 140400 ibcd abcd 100400 ibcd sbcd : idd constant does> @ dst over rs or *swap ms if 10 or then sz3 w, ; ( Dn Dm ) ( An@- Am@- ) 150400 idd addx 110400 idd subx : idea constant does> @ >r dn? ( ea Dn ) ( Dn ea ) if rd src r> or sz3 w, ,more else extra? eas dst 400 or r> or sz3 w, ,extra then ; 150000 idea add 110000 idea sub 140000 idea and 100000 idea or : iead constant does> @ dst src w, ,more ; ( ea Dn ) 040600 iead chk 100300 iead divu 100700 iead divs 140300 iead mulu 140700 iead muls \ Arithmatic and control. 13Jan88pJa: iea constant does> @ src w, ,more ; ( ea ) 047200 iea jsr 047300 iea jmp 042300 iea move>ccr 040300 iea move<sr 043300 iea move>sr 044000 iea nbcd 044100 iea pea 045300 iea tas : ieas constant does> @ src sz3 w, ,more ; ( ea ) 041000 ieas clr 043000 ieas not 042000 ieas neg 040000 ieas negx 045000 ieas tst : icon constant does> @ w, ; 47160 icon reset 47161 icon nop 47163 icon rte 47165 icon rts 47166 icon trapv 47167 icon rtr \ Structured conditionals +/- 256 bytes. 13Jan88pJa: if w, ?>mark ; : then ?>resolve ; hex : else 6000 if 2swap then ; : begin ?>mark ; : until w, ?<resolve ; : again 6000 until ; : while if ; : repeat 2swap again then ; : do ?>mark drop *swap ; : loop dbra ; : ?do 6000 if rot ?>mark drop *swap 2swap ; : loop: ?>resolve ; \ like: d3 ?do ... loop: dbcc 6200 constant u<= 6300 constant u> 6400 constant u< 6500 constant u>= 6600 constant 0= 6700 constant 0<> 6A00 constant 0< 6B00 constant 0>= 6C00 constant < 6D00 constant >= 6E00 constant <= 6F00 constant > decimal \ High level. 13Jan88pJa: init long i.l ; : next >next ) jmp ; only forth also definitions : label create assembler [ assembler ] init ; : code create hide here dup 4- ! context @ avoc ! assembler [ assembler ] init ; : c: [ assembler ] hilevel #) jsr forth ] ; : ;c compile (;c) assembler [compile] [ ; immediate hex 4EB9 constant does-op decimal forth \ (spare) 01Feb88pJa \ Load screen for low level debugger. 28Feb88pJaonly forth also definitions 1 2 +thru only forth also definitions \s The debugger is designed to let the user single step the execution of a high level definition. Here we declare the necessary low level support for the debuggerIn Utilities.blk is the rest of the debugger support. The debugger works by patching the next routine, and is highly machine and implementation dependent. \ Variables and debugnext. 28Feb88pJavocabulary bug also bug also definitions variable <ip variable ip> variable cnt variable 'debug label debnext <ip #) ip cmpa u>= if ip> #) ip cmpa u<= if cnt # a0 move 1 a0 ) addq 2 a0 ) cmpi 0= if a0 ) clr @next # >next move ip sp -) move 'debug #) w move w )+ a0 move a0 ) jmp then then then ip )+ w move w )+ a0 move a0 ) jmp bug \ Patching and fixing next. 28Feb88pJacode pnext debnext # >next move next end-code forth definitions code unbug @next # >next move next end-code \ Assembler for 68000 26Feb88pJaBased on the 68000 forth assembler published in Dr. Dobb's, Sep 1983, by M.Perry. This assembler assumes 32 bit integer and defaults to this. Ex- ceptions are words/bytes. E.g. absolute addressing is #) and is32 bits. To use word sized absolute use w#). This assembler is not finished. It needs cleaning up in the ccr area, also needs to be updated for 68010/20 instructions. \ Load Screen for 68k assembler. 13Jan88pJaSince SWAP is 68k mnemonic, must make a synonym, *swap. AVOC is a word in the kernel, saves current 'context'. Load the assembler. \ Deferred words. 13Jan88pJaBy making the words which put stuff in the dictionary, deferred they can be used for a meta compiler, by redefining 'm. c, stores a character in the dictionary ( watch for alignment ) w, stores a word in the dictionary , stores a long 32bits. Normally they are the same as forth's c, w, and , Only when meta assembling are they redefined. Notice that the assembler branching are only -128..+127 bytes because code words must be short, according to Forth's philosophy. You can use +- 32k offsets, by using the Bcc mnemonics, but for structures, such as "if..else..then" the abo-ve limit applies. \ Sizes. 13Jan88pJa?, depending on flag stores long or word in dictionary. 2, stores 2 words, not always the same as a long. Many instructions in the 68k can operate on 8, 16 or 32 bits. The variable size contains the size information. It's set by thewords: byte,word,long. Indexed registers can be word or long, the difference is set by the words: i.l,i.w 'sz' defines words which select certain bits from 'size' and install them into the instruction being assembled. The size field moves around, and is even inverted in some cases. ?long returns a true flag if 'size' is long. -sz1 is used in a special case where the size flag has the opposite sense of all other size flags. Orthogonal? Good job, Motorola. (But head and shoulders above Intel junk). \ Addressing modes. 13Jan88pJaThis screen defines the 16 data and address registers, and the various addressing modes. Notice that 'regs' defines several words each time it is used; it is a 'do constant loop'. Words defined by 'mode' are modifiers, they follow an addr register name. For example, a5 ), means addr reg. 5 indirect. Examples of usages: a5 )+ a5 -) a5 indirect, post-increment and pre-decrement. 3 a5 d) a5 inderect with a displacement of 3 3 d2 a5 di) a5 indirect indexed by d2 with displacement of 3 1234 w#) absolute address 00001234 ( immediate indirect ) 1234.5676 #) absolute 12345676 ( long imm. indirect ) 3 pcd) program counter offset by 3 3 d2 pcdi) program counter indexed by d2, offset by 3 1234 # immediate data ( size determined by 'size' ). \ Register assignments. 13Jan88pJafield creates words which mask off various bit field. 'rs' and 'rd' select the source or destination register fields. 'ms' selects the source mode field. 'eas' selects the source effective address field. 'low' selects the low byte. 'Dn?' tests for data register direct mode. 'Src' and 'dst' contain phrases which occur frequently in source or destination mode calculations. These are the virtual machine register assignments. The forth virtual machine has five registers. Each of these is assigned toa 68k address register. These definitions allow your code to reference the virtual machine registers symbollically. E.g.: rp )+ sp -) move, pops the top item off the return stack and pushes is onto the data stack. NOTE, I keep the address of next in a3, to jump to it: >next ) jmp, which is defined in the macro 'next'. \ Extended addressing. 13Jan88pJaMany of the 68k's addressing modes require additional bytes following the opcode. double? Leaves true if the given mode requires 32bits of additional addressing information. index? Does nothing unless the given mode is an indexed mode, in which case it takes the data under the mode and packs it into the appropriate format. di) and pcdi) are redefined to allow long and word indexed size more? Returns a true flag if the mode has extended addressing. ,more Will append the extended addressing bytes to the dictionary. \ Extended addressing, extra's. 13Jan88pJaextra This is a holding area for destination extensions. extra? Tests the mode for extensions, and if present stores them at extra. ,extra Removes the extras ( if any ) from extra and adds them to the dictionary. \ Immediates & address register specific. 13Jan88pJaThis screen sets the pattern for the rest of the assembler. Defining words are created, then used to define a group of similar instructions. The stack comment (s n ea ) indicates the allowed addressing modes. In this case, for immediate instructions, a number followed by an effective addressing mode is required before the instruction. For example 123 a5 ) ori means to perform a logical or of the immediate data 123 with thecontents of the address pointed to by address register 5, with the result going to that address. \ Shifts, rotates, bit manipulation. 13Jan88pJaisr Creates instructions which shift or rotate. ibit Creates instructions which manipulate bits. \ Branch, loop, set conditionals. 13Jan88pJa There are three classes of conditional instructions: branch, decrement and branch, and set. In each case there is a four bit field which contains the condition code; this field is the only difference between members of a class. Rather than explicitly define sixteen separate words for each class, the word setclass is used to define all sixteen at once by re-executing the same defining word with a different value for the condition code field each time. Of the 48 words so defined, only 'dxit' and 'sno' are not actually useful. \ Moves. 13Jan88pJaTo keep the assembler simple, some compromise was made here on compatability with Motorola's mnemonics. The instruction names explicitly indicate the direction of data flow in several instructions. For example, hex FFFF sp -) movem> will save all registers on the stack. ( pronounced movem-out ) lmove is left from the source article, it was used to move 32b size register, regardless of 'size' to allow address calculation with the base register, as used in that assembler. Here it is not used. \ Odds and ends. 13Jan88pJaSome of the explicitly defined mnemonics. See Motorola's programming manuals for the 68k, on their useage. \ Arithmatic and Logic. 13Jan88pJaibcd Instructions which take either a pair of data registers idd or a pair of address registers used in post-increment mode idea Instructions which take an ea and a data register, in either order. iead Instructions which take any ea for the source, and a data register for the destination. \ Arithmatic and control. 13Jan88pJaiea Instructions which take only an effective address. ieas Instructions which take only an effective address and use 'size'. icon Instructions which assemble a constant value. \ Structured conditionals +/- 256 bytes. 13Jan88pJaThe usual complement of forth conditionals is provided, including the 'do..loop'. The last is unusual in assemblers. No error checking is provided for mismatched conditionals as it is desirable when writing code to be able to easily bend the rules of strictly structured code. ?do..loop: Is different. It allows for a simple loop with a data register as index. The loop is entered at the dbcc statement and is decremented, tested for -1, and the branch condition. If all is well it will branch back to the loop beginning and continue. This allows statements like 100 d0 moveq d0 ?do ........ loop: dbpl which will loop 100 times, exit at the end or if the compare results in a plus flag. NOTE: ?do..loop: must have a loop body, or an illegal instruction will occur. \ High level. 13Jan88pJainit sets the default size to long and the index to long. index is used in indexed addressing, eg. d0 a0 di) next is macro, that's easy in forth. label is used to name the entry point to a subroutine. code creates a forth word which will be defined in assembler. c: allows high level word calls from within code words ;c stops highlevel compilation and continues code definition. \ Variables and debugnext. 28Feb88pJabug The vocabulary that holds the debugging words. <ip ip> The range of ip values we are interested in. cnt is a pass counter 'debug contains the address of the trace routine. debnext is the debugger's version of next. If the ip is between <ip and ip> then the contents of the execution variable 'debug is executed. First the ip is pushed onto the parameter stack. The word pointed to by 'debug can be any high level word as long as it discards the ip that was pushed before it is called, and it must terminate by calling pnext to patch next once again for more tracing. \ Patching and fixing next. 28Feb88pJapnext Patches the Forth next routine to jump to debnext This puts us in debug mode and allows for tracing. unbug Restores the jump to regulare next, disabling tracing.
