--- \ load screen for 68k assembler 12/02/86 16 load \ get calculated goto 18 load \ get 1-dimensional arrays octal next_screen 124 loads \ load the next 84 screens decimal forth definitions --- \ f_and f_or f_not f_swap 11/26/86 \ define new names for forth vocabulary words to avoid name \ conflicts with 68kasm words : f_and and ; : f_or or ; : f_not not ; : f_swap swap ; : f_w@ w@ ; : f_w, w, ; : f_w! w! ; --- \ 68kasm vocabulary and variables 12/01/86 vocabulary 68kasm immediate 68kasm definitions 0 variable size \ holds the operand size flag 0 variable extend_word_count \ holds the number of extend words 4 matrix(1d) extend_words \ holds extend words --- \ error handling words 11/26/86 \ if true flag, output the appropriate error message and quit : ?invalid_mode ( f _ ) 3 ?error ; \ "wrong addressing mode" : ?\ load screen for 68k assembler 12/23/86 " forth.data" 16 fload \ get calculated goto " forth.data" 18 fload \ get 1-dimensional arrays octal 12 124 loads \ load screens 10 through 93 decimal forth definitions \ error messages 11/25/86 empty stack dictionary full wrong addressing mode isn't unique out of range disc range ? full stack disc error ! string stack empty string stack overflow can't redirect input string too small wrong operand size Hewlett Packard Integral Personal Computer forth \ error messages compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary \ f_and f_or f_not f_swap 11/26/86 \ define new names for forth vocabulary words to avoid name \ conflicts with 68kasm words : f_and and ; : f_or or ; : f_not not ; : f_swap swap ; : f_w@ w@ ; : f_w, w, ; : f_w! w! ; \ 68kasm vocabulary and variables 12/01/86 vocabulary 68kasm immediate 68kasm definitions 0 variable size \ holds the operand size flag 0 variable extend_word_count \ holds the number of extend words 4 matrix(1d) extend_words \ holds extend words \ error handling words 11/26/86 \ if true flag, output the appropriate error message and quit : ?invalid_mode ( f _ ) 3 ?error ; \ "wrong addressing mode" : ?out_of_range ( f _ ) 5 ?error ; \ "out of range" : ?wrong_size ( f _ ) 15 ?error ; \ "wrong operand size" \ output the appropriate error message and quit : invalid_mode ( _ ) 3 error ; \ "wrong addressing mode" : out_of_range ( _ ) 5 error ; \ "out of range" : wrong_size ( _ ) 15 error ; \ "wrong operand size" \ memory loading, storing, and depositing words 12/03/86 : b@ ( addr _ n8 ) c@ ; \ load a byte : w@ ( addr _ n16 ) f_w@ ; \ load a word : l@ ( addr _ n32 ) @ ; \ load a long word : b, ( n8 _ ) c, ; \ deposit a byte (dangerous!) : w, ( n16 _ ) f_w, ; \ deposit a word : l, ( n32 _ ) , ; \ deposit a long word : b! ( n8 addr _ ) c! ; \ store a byte : w! ( n16 addr _ ) f_w! ; \ store a word : l! ( n32 addr _ ) ! ; \ store a long word \ field isolating words 11/26/86 : lower_byte ( n _ lower_byte_field ) 000377 f_and ; : upper_byte ( n _ upper_byte_field ) 177400 f_and ; : lower_reg ( n _ lower_reg_field ) 000007 f_and ; : upper_reg ( n _ upper_reg_field ) 007000 f_and ; : lower_mode ( n _ lower_mode_field ) 000070 f_and ; : upper_mode ( n _ upper_mode_field ) 000700 f_and ; : clear_modes ( n _ cleared_mode_fields) 177007 f_and ; : lower_ea ( n _ lower_ea_field ) 000077 f_and ; : upper_ea ( n _ upper_ea_field ) 007700 f_and ; \ signed number range checking words 12/03/86 : 1_to_8? ( n _ f ) dup 0 > f_swap 11 < f_and ; : 0_to_15? ( n _ f ) dup -1 > f_swap 20 < f_and ; : 8_bits? ( n _ f ) abs 200 < ; : 16_bits? ( n _ f ) abs 100000 < ; : 1_to_8 ( n _ n ) dup 1_to_8? 0= ?out_of_range ; : 0_to_15 ( n _ n ) dup 0_to_15? 0= ?out_of_range ; : 8_bits ( n _ n8 ) dup 8_bits? 0= ?out_of_range lower_byte ; : 16_bits ( n _ n16 ) dup 16_bits? 0= ?out_of_range ; \ log 11/25/86 \ return the current logical address : log ( _ current_logical_address ) dp @ ; \ resolve> lresolve> 12/04/86 \ resolve 8-bit relative forward reference : resolve> ( addr_of_branch_op-code _ ) log over 2+ - \ compute offset to current address 8_bits \ offset must fit in 8 bits over w@ \ get branch op-code upper_byte \ clear old offset from branch op-code f_or \ or new offset into branch op-code f_swap w! ; \ store op-code (containing offset) \ resolve 16-bit relative forward reference : lresolve> ( addr_of_relative_offset_word _ ) log over - \ compute offset to current address 16_bits \ offset must fit in 16 bits f_swap w! ; \ store offset in offset_word \ size setting and checking words 11/11/86 \ set the operand size to 'byte', 'word', or 'long' : byte ( _ ) 0 size ! ; : word ( _ ) 100 size ! ; : long ( _ ) 200 size ! ; \ return a 'true' flag if the operand size is set appropriately : byte? ( _ f ) size @ 0 = ; \ true flag if 'byte' size : word? ( _ f ) size @ 100 = ; \ true flag if 'word' size : long? ( _ f ) size @ 200 = ; \ true flag if 'long' size \ size checking words 11/26/86 \ abort with an error message if the wrong operand size is set : byte_wrong ( _ ) byte? ?wrong_size ; : word_wrong ( _ ) word? ?wrong_size ; : long_wrong ( _ ) long? ?wrong_size ; \ abort with an error message if the correct operand size is \ not set : byte_only ( _ ) byte? 0= ?wrong_size ; : word_only ( _ ) word? 0= ?wrong_size ; : long_only ( _ ) long? 0= ?wrong_size ; \ save_extend_word deposit_extend_words 12/01/86 : save_extend_word ( n _ ) extend_word_count @ extend_words ! \ save the extend word 1 extend_word_count +! ; \ point to next word : deposit_extend_words ( _ ) extend_word_count @ -dup \ get number of extend words if 0 f_swap \ if there are any, deposit them do \ in reverse order i 1 - \ get index of extend word extend_words @ \ get extend word w, \ deposit extend word -1 +loop endif ; \ split_32 save_8 save_16 save_32 12/01/86 : split_32 ( n _ most_sig_16_bits_of_n least_sig_16_bits_of_n ) dup 20 0 do >> loop \ compute most sig 16 bits f_swap 177777 f_and ; \ compute least sig 16 bits \ save a number as an extend word : save_8 ( n _ ) 8_bits save_extend_word ; : save_16 ( n _ ) 16_bits save_extend_word ; : save_32 ( n _ ) split_32 save_extend_word save_extend_word ; \ setup cleanup 11/17/86 : setup ( _ ) long \ set operand size to 'long' 0 extend_word_count ! ; \ clear extend word buffer : cleanup ( op-code _ ) w, \ deposit instruction op-code deposit_extend_words \ deposit any extend words 0 extend_word_count ! \ clear extend word buffer long ; \ set operand size to 'long' \ data register names and data register direct mode 11/17/86 \ addressing mode number 1 : data_reg ( builds: reg_num _ ) ( does: addr _ reg_num mode_num ) @ 1 ; 0000 data_reg d0 1001 data_reg d1 2002 data_reg d2 3003 data_reg d3 4004 data_reg d4 5005 data_reg d5 6006 data_reg d6 7007 data_reg d7 \ address register names and address reg direct mode 11/17/86 \ addressing mode number 2 : address_reg ( builds: reg_num _ ) ( does: addr _ reg_num mode_num ) @ 2 ; 0110 address_reg a0 1111 address_reg a1 2112 address_reg a2 3113 address_reg a3 4114 address_reg a4 5115 address_reg a5 6116 address_reg a6 7117 address_reg a7 \ the other addressing modes 12/02/86 : am_con ( builds: mode_num op_con _ ) ( does: addr _ op_con mode_num ) dup @ f_swap 4+ @ ; 3 0220 am_con ) \ address reg indirect 4 0330 am_con )+ \ address reg indirect w/postincrement 5 0440 am_con -( \ address reg indirect w/predecrement 6 0550 am_con d( \ address reg indirect w/displacement 7 0660 am_con di.w( \ address reg indirect with word index 10 0660 am_con di( \ address reg indirect with long index 11 0770 am_con (#.w) \ absolute (immediate indirect) short 12 1771 am_con (#) \ absolute (immediate indirect) long 13 2772 am_con d(pc) \ program counter with displacement 14 3773 am_con di.w(pc) \ program counter with word index 15 3773 am_con di(pc) \ program counter with long index 16 4774 am_con # \ immediate \ addressing mode checking words 12/02/86 \ returns a true flag if the corresponding addressing mode flag \ is on the stack : mode_check ( builds: mode_num _ ) ( does: mode addr _ f ) @ = ; 1 mode_check Dn? 2 mode_check An? 3 mode_check )? 4 mode_check )+? 5 mode_check -(? 6 mode_check d(? 7 mode_check di.w(? 10 mode_check di(? 11 mode_check (#.w)? 12 mode_check (#)? 13 mode_check d(pc)? 14 mode_check di.w(pc)? 15 mode_check di(pc)? 16 mode_check #? \ addressing mode checking words 12/02/86 \ abort with an error message if addressing mode other than \ desired is used : ?mode_check ( builds: mode_num _ ) ( does: mode addr _ ) @ = 0= ?invalid_mode ; 1 ?mode_check ?Dn 2 ?mode_check ?An 3 ?mode_check ?) 4 ?mode_check ?)+ 5 ?mode_check ?-( 6 ?mode_check ?d( 7 ?mode_check ?di.w( 10 ?mode_check ?di( 11 ?mode_check ?(#.w) 12 ?mode_check ?(#) 13 ?mode_check ?d(pc) 14 ?mode_check ?di.w(pc) 15 ?mode_check ?di(pc) 16 ?mode_check ?# \ true false data_ea? 11/18/86 : true ( _ true_flag ) 1 ; : false ( _ false_flag ) 0 ; \ returns a 'true' flag if one of the data addressing modes : data_ea? ( mode _ f ) cgoto invalid_mode true false true true true true true true true true true true true true invalid_mode then ; \ mem_ea? 11/18/86 \ returns a 'true' flag if one of the memory addressing modes : mem_ea? ( mode _ f ) cgoto invalid_mode false false true true true true true true true true true true true true invalid_mode then ; \ cont_ea? 11/18/86 \ returns a 'true' flag if one of the control addressing modes : cont_ea? ( mode _ f ) cgoto invalid_mode false false true false false true true true true true true true true false invalid_mode then ; \ alter_ea? 11/18/86 \ returns a 'true' flag if one of the alterable addressing modes : alter_ea? ( mode _ f ) cgoto invalid_mode true true true true true true true true true true false false false false invalid_mode then ; \ addressing mode checking words 12/01/86 \ abort with an error message if an addressing mode other than \ desired is used : ?alter_ea ( mode _ ) alter_ea? 0= ?invalid_mode ; : ?cont_ea ( mode _ ) cont_ea? 0= ?invalid_mode ; : ?mem_ea ( mode _ ) mem_ea? 0= ?invalid_mode ; : ?data_ea ( mode _ ) data_ea? 0= ?invalid_mode ; : ?mem_alter_ea ( mode _ ) dup mem_ea? f_swap alter_ea? f_and 0= ?invalid_mode ; : ?data_alter_ea ( mode _ ) dup data_ea? f_swap alter_ea? f_and 0= ?invalid_mode ; \ do effective addresses Dn An ) )+ -( 11/26/86 : do_Dn ( Dn_op_con _ op_con ) ; : do_An ( An_op_con _ op_con ) ; : handle_An ( xx_op_con _ op_con ) >r \ save the op_con ?An do_An \ handle address reg clear_modes \ clear An mode from address reg r> f_or ; \ or op_con with address reg num : do_) \ )_op_con _ handle_An ; : do_)+ \ )+_op_con _ handle_An ; : do_-( ( -(_op_con _ ) handle_An ; \ do effective addresses d( d(pc) 12/01/86 : do_d( ( n d(_op_con _ op_con ) handle_An \ handle the address reg f_swap save_16 ; \ save a 16_bit displacement : do_d(pc) \ n d(pc)_op_con _ op_con f_swap save_16 ; \ save a 16_bit displacement \ index_code handle_Rn 12/01/86 : index_code ( Rn_mode _ index_code ) dup Dn? \ check for Dn if drop 000000 \ if yes, leave D/A bit clear else An? \ check for An if 100000 \ if yes, set D/A bit else invalid_mode \ if neither, invalid addr mode endif endif ; : handle_Rn ( Rn_op_code Rn_mode _ index_con ) index_code \ convert reg mode to index code f_swap upper_reg << << << \ get reg number in proper field f_or ; \ construct index extension word\ handle_index handle_w_index handle_l_index 12/01/86 : handle_index ( n _ index_word ) handle_Rn f_swap \ handle index reg 8_bits f_or ; \ or 8-bit displacement with index word : handle_w_index ( n op_con _ op_con ) >r \ save op_con handle_index \ handle index reg num save_extend_word r> ; \ save index word as extend word : handle_l_index ( n op_con _ op_con ) >r \ save op_con handle_index \ handle index reg num 4000 f_or \ mark index word as 'long' index save_extend_word r> ; \ save index word as extend word \ do effective addresses di.w( di( di.w(pc) di(pc) 12/02/86 : do_di.w( ( n di.w(_op_con _ op_con ) handle_An handle_w_index ; : do_di( ( n di(_op_con _ op_con ) handle_An handle_l_index ; : do_di.w(pc) \ n di.w(pc)_op_con _ op_con handle_w_index ; : do_di(pc) \ n di(pc)_op_con _ op_con handle_l_index ; \ do effective addresses (#.w) (#) # 12/02/86 : do_(#.w) \ n (#.w)_op_con _ op_con f_swap \ save op_con save_16 ; \ save word absolute address : do_(#) \ n (#)_op_con _ op_con f_swap \ save op_con save_32 ; \ save long absolute address : do_# ( n #_op_con _ op_con ) f_swap \ save op_con byte? if save_8 endif \ handle byte literal word? if save_16 endif \ handle word literal long? if save_32 endif \ handle long literal ; \ do effective addresses 12/02/86 : do_ea ( xx_ea_op_con ea_mode_flag _ ea_op_con ) cgoto invalid_mode do_Dn do_An do_) do_)+ do_-( do_d( do_di.w( do_di( do_(#.w) do_(#) do_d(pc) do_di.w(pc) do_di(pc) do_# invalid_mode then ; \ handle the various lower field effective addresses 12/02/86 : ea do_ea lower_ea ; : alter_ea dup ?alter_ea ea ; : cont_ea dup ?cont_ea ea ; : mem_ea dup ?mem_ea ea ; : data_ea dup ?data_ea ea ; : mem_alter_ea dup ?mem_alter_ea ea ; : data_alter_ea dup ?data_alter_ea ea ; \ handle register numbers and or_size 12/03/86 \ return register numbers in upper or lower register fields : Dn_upper ( _ upper_data_reg_num ) ?Dn do_Dn upper_reg ; : Dn_lower ( _ lower_data_reg_num ) ?Dn do_Dn lower_reg ; : An_upper ( _ upper_addr_reg_num ) ?An do_An upper_reg ; : An_lower ( _ lower_addr_reg_num ) ?An do_An lower_reg ; \ or the 'size' bits into the normal field in the op-code : or_size ( op_con _ op_con_or-ed_with_size ) size @ f_or ; \ 1-8_#_to_count copy_third byte_An_wrong 12/02/86 : 1-8_#_to_count ( n <#> _ op_con ) ?# drop 1_to_8 \ immed number must be 1 to 8 dup 10 = if drop 0 endif \ convert 8 to 0 11 0 do << loop ; \ line up with correct field : copy_third ( n1 n2 n3 _ n1 n2 n3 n1 ) >r >r dup r> r> rot ; : byte_An_wrong ( ea_mode_flag _ ea_mode_flag ) dup An? \ if An addr mode and byte size if byte_wrong \ then error message endif ; \ Dl_Du Du_Dl -(_-( 12/01/86 : Dl_Du (
_ op_con ) Dn_upper >r \ get destination data reg num Dn_lower \ get source data reg num r> f_or ; \ or reg nums together : Du_Dl (
_ op_con ) Dn_lower >r \ get destination data reg num Dn_upper \ get source data reg num r> f_or ; \ or reg nums together : -(_-( ( <-(> <-(> _ op_con ) ?-( drop An_upper >r \ get destination addr reg num ?-( drop An_lower \ get source addr reg num r> f_or ; \ or reg nums together \ Du_Dl_or_#_Dn 12/01/86 : Du_Dl_or_#_Dn ( _ op_con ) copy_third dup \ get 2 copies of source mode Dn? \ check for source data reg if drop \ if yes, 2nd copy not needed Du_Dl \ get source, dest data reg nums 40 f_or \ set i/r bit else #? \ else check for source immed num if Dn_lower >r \ if yes, get dest data reg num 1-8_#_to_count \ handle immed number r> f_or \ don't set i/r bit else invalid_mode \ else invalid mode endif endif ; \ Du_Al Al_Du Au_Al 12/03/86 : Du_Al ( _ op_con ) An_lower >r \ get destination addr reg num Dn_upper \ get source data reg num r> f_or ; \ or reg nums together : Al_Du ( _ op_con ) Dn_upper >r \ get destination data reg num An_lower \ get source addr reg num r> f_or ; \ or reg nums together : Au_Al ( _ op_con ) An_lower >r \ get destination addr reg num An_upper \ get source addr reg num r> f_or ; \ or reg nums together \ abcd sbcd 12/02/86 : i_bcd_Dl_Du_or_-(_-( ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code dup Dn? \ check for Dn addr mode if Dl_Du \ if yes, do Dl_Du else -(_-( \ else do Al_-(_Au_-( 10 f_or \ set R/M bit endif r> f_or \ or op-code with addr info cleanup ; \ deposit instruction 140400 i_bcd_Dl_Du_or_-(_-( abcd 100400 i_bcd_Dl_Du_or_-(_-( sbcd \ addx subx 12/01/86 : i_Dl_Du_or_-(_-( ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code dup Dn? \ check for Dn addr mode if Dl_Du \ if yes, leave R/M bit clear else -(_-( 10 f_or \ else set R/M bit endif or_size \ handle size r> f_or \ or op-code with addressing info cleanup ; \ deposit instruction 150400 i_Dl_Du_or_-(_-( addx 110400 i_Dl_Du_or_-(_-( subx \ add sub 12/03/86 : i_ea_Dn_or_Dn_maea ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code dup Dn? \ is destination a data reg? if Dn_upper >r \ if yes, handle dest data reg byte_An_wrong ea \ handle source addr modes r> f_or \ or addr info together else mem_alter_ea >r \ else handle dest addr modes Dn_upper \ handle source data reg r> f_or 400 f_or \ or addr info together endif or_size \ handle size r> f_or \ or in op-code cleanup ; \ deposit instruction 150000 i_ea_Dn_or_Dn_maea add 110000 i_ea_Dn_or_Dn_maea sub \ adda suba cmpa 12/01/86 : i_ea_An ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code byte_wrong \ no 'byte' size An_upper r> f_or >r \ or dest addr reg num with op-code ea r> f_or \ or source addr info with op-code word? if 300 endif \ get 'word' size value long? if 700 endif \ get 'long' size value f_or \ or size value with op-code cleanup ; \ deposit instruction 150000 i_ea_An adda 130000 i_ea_An cmpa 110000 i_ea_An suba \ addi subi cmpi andi ori eori 12/01/86 : i_#_daea ( builds: con _ ) ( does: n <#> addr _ ) @ >r \ save instruction op-code data_alter_ea \ handle data alterable ea r> f_or >r \ or addr info with op-code ?# do_# drop \ handle immediate data r> or_size \ or size with op-code cleanup ; \ deposit instruction 003000 i_#_daea addi 001000 i_#_daea andi 006000 i_#_daea cmpi 005000 i_#_daea eori 000000 i_#_daea ori 002000 i_#_daea subi \ addq subq 12/03/86 : i_#_aea ( builds: con _ ) ( does: n <#> addr _ ) @ >r \ save instruction op-code byte_An_wrong \ error if 'byte' size and An dest alter_ea \ handle addr info r> f_or >r \ or addr info with op-code 1-8_#_to_count \ convert 1-8 to count field r> f_or \ or count field with op-code or_size \ handle size cleanup ; \ deposit instruction 050000 i_#_aea addq 050400 i_#_aea subq \ and or 12/03/86 : i_dea_Dn_or_Dn_maea ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code dup Dn? \ is destination a data reg? if Dn_upper >r \ if yes, get dest data reg num data_ea r> f_or \ or with source addr info else mem_alter_ea >r \ else get dest addr info Dn_upper r> f_or \ or with source data reg num 400 f_or \ set 'source data reg' bit endif or_size \ or size with addr info r> f_or \ or in op-code cleanup ; \ deposit instruction 140000 i_dea_Dn_or_Dn_maea and 100000 i_dea_Dn_or_Dn_maea or \ andi>ccr eori>ccr ori>ccr 12/01/86 : i_#_byte ( builds: con _ ) ( does: n <#> addr _ ) @ >r \ save instruction op-code ?# drop save_8 \ save 8_bit immed number r> \ recover op-code cleanup ; \ deposit instruction 001074 i_#_byte andi>ccr 005074 i_#_byte eori>ccr 000074 i_#_byte ori>ccr \ andi>sr eori>sr ori>sr 12/01/86 : i_#_word ( builds: con _ ) ( does: n <#> addr _ ) @ >r \ save instruction op-code ?# drop save_16 \ save 16-bit immed num r> \ recover op-code cleanup ; \ deposit instruction 001174 i_#_word andi>sr 005174 i_#_word eori>sr 000174 i_#_word ori>sr \ asl asr lsl lsr rol ror roxl roxr 12/03/86 : i_shift_rot ( builds: reg_con mem_con _ ) ( does: addr _ ) >r \ save addr dup Dn? \ check for dest Dn addr modes if Du_Dl_or_#_Dn \ if yes, handle dest Dn addr modes or_size \ handle size r> 4+ @ f_or \ or op-code with addressing info else mem_ea \ else handle memory ea modes r> @ f_or \ or op-code with addressing info endif cleanup ; \ deposit instruction 160400 160700 i_shift_rot asl 160000 160300 i_shift_rot asr 160410 161700 i_shift_rot lsl 160010 161300 i_shift_rot lsr 160430 163700 i_shift_rot rol 160030 163300 i_shift_rot ror 160420 162700 i_shift_rot roxl 160020 162300 i_shift_rot roxr \ condition codes 12/02/86 hex 0000 constant t 0100 constant f 0200 constant hi 0300 constant ls 0400 constant cc 0500 constant cs 0400 constant hs 0500 constant lo 0600 constant ne 0700 constant eq 0600 constant nz 0700 constant ze 0800 constant vc 0900 constant vs 0A00 constant pl 0B00 constant mi 0C00 constant ge 0D00 constant lt 0E00 constant gt 0F00 constant le octal \ check_cc not_cc 12/03/86 hex : check_cc ( condition_code _ ) \ error if not condition code F0FF f_and \ check for non-cc bits all zero ?invalid_mode ; \ if not, then invalid mode error : not_cc ( condition_code _ opposite_condition_code ) dup check_cc \ check for condition code 0100 xor ; \ invert sense of condition code octal \ bcc bra bsr 12/01/86 : bcc ( address_to_branch_to condition_code _ ) dup check_cc \ check for valid condition code 060000 f_or f_swap \ or condition code with op-code log 2+ - \ compute offset to branch address 8_bits f_or \ or 8-bit offset with op-code cleanup ; \ deposit instruction : bra ( address_to_branch_to _ ) t bcc ; : bsr ( address_to_branch_to _ ) f bcc ; \ lbcc lbra lbsr 12/01/86 : lbcc ( address_to_branch_to condition_code _ ) dup check_cc \ check for valid condition code 060000 f_or f_swap \ or condition code with op-code log 2+ - \ comput offset to branch address save_16 \ save 16-bit offset cleanup ; \ deposit instruction : lbra ( address_to_branch_to _ ) t lbcc ; : lbsr ( address_to_branch_to _ ) f lbcc ; \ bchg bclr bset btst 12/03/86 : i_bit_ops ( builds: reg_con mem_con _ ) ( does: addr _ ) >r \ save addr data_alter_ea >r \ handle data alter ea dup Dn? \ is source data reg? if Dn_upper r> f_or \ if yes, or reg num with addr info r> 4+ @ f_or \ or addr info with op-code else ?# drop \ else must be immed num save_16 \ handle 16-bit immed num r> r> @ f_or \ or addr info with op-code endif cleanup ; \ deposit instruction 000500 004100 i_bit_ops bchg 000600 004200 i_bit_ops bclr 000700 004300 i_bit_ops bset 000400 004000 i_bit_ops btst \ chk divs divu muls mulu 12/01/86 : i_dea_Dn ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code word_only \ only allow 'word' size Dn_upper >r \ get dest data reg num data_ea r> f_or \ or with source addr info r> f_or \ or addr info with op-code cleanup ; \ deposit instruction 040600 i_dea_Dn chk 100700 i_dea_Dn divs 100300 i_dea_Dn divu 140700 i_dea_Dn muls 140300 i_dea_Dn mulu \ clr neg negx not tst 12/02/86 : i_dea ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code data_alter_ea \ handle data alter ea addressing or_size \ handle size r> f_or \ or addressing info with ea cleanup ; \ deposit instruction 041000 i_dea clr 042000 i_dea neg 040000 i_dea negx 043000 i_dea not 045000 i_dea tst \ cmp cmpm 12/01/86 : cmp ( _ ) Dn_upper >r \ get dest data reg num byte_An_wrong ea \ handle source ea r> f_or \ or addr info with data reg num or_size \ handle size 130000 f_or \ or addr info with op-code cleanup ; \ deposit instruction : cmpm \ <)+> <)+> _ ?)+ drop An_upper >r \ get dest addr reg num ?)+ drop An_lower r> f_or \ or with source addr reg num or_size \ handle size 130410 f_or \ or op-code with addr info cleanup ; \ deposit instruction \ dbcc dbra 12/03/86 : dbcc ( address_to_branch_to condition_code _ ) dup check_cc \ check for valid condition code 050310 f_or >r \ or condition code with op-code log 2+ - \ compute offset to branch addr save_16 \ save 16-bit offset Dn_lower r> f_or \ or with data reg num cleanup ; \ deposit instruction : dbra ( address_to_branch_to _ ) f dbcc ; \ eor 12/01/86 : eor ( _ ) data_alter_ea >r \ handle data alter ea Dn_upper r> f_or \ or with source data reg num or_size \ handle size 130400 f_or \ or with instruction op-code cleanup ; \ deposit instruction \ exg 12/01/86 : exg ( _ ) dup Dn? \ is destination a data reg? if copy_third Dn? \ if yes, is source a data reg? if Du_Dl 140500 f_or \ if yes, two data regs else Al_Du 140610 f_or \ else addr, data regs endif else copy_third Dn? \ else is source a data reg? if Du_Al 140610 f_or \ if yes, data, addr regs else Au_Al 140510 f_or \ else two addr regs endif endif cleanup ; \ deposit instruction \ ext 12/03/86 : ext ( _ ) byte_wrong \ no 'byte' size Dn_lower \ get data reg num word? if 000200 endif \ handle 'word' size long? if 000300 endif \ handle 'long' size f_or \ or size with data reg num 044000 f_or \ or with instruction op-code cleanup ; \ deposit instruction \ illegal nop reset rte rtr rts trapv 12/03/86 : icon ( builds: con _ ) ( does: addr _ ) @ cleanup ; 045374 icon illegal 047160 icon reset 047161 icon nop 047163 icon rte 047165 icon rts 047166 icon trapv 047167 icon rtr \ jmp jsr 12/03/86 : i_cea ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code cont_ea \ handle control ea r> f_or \ or addressing info with op-code cleanup ; \ deposit instruction 047300 i_cea jmp 047200 i_cea jsr \ lea link 12/01/86 : lea ( _ ) An_upper >r \ handle dest addr reg cont_ea \ handle source ea r> f_or \ or source and dest info 040700 f_or \ or addr info with op-code cleanup ; \ deposit instruction : link ( n <#> _ ) An_lower >r \ handle address reg ?# drop save_16 \ handle 16-bit immed num r> 047120 f_or \ or reg num with op-code cleanup ; \ deposit instruction \ move 12/02/86 : move ( _ ) dup ?data_alter_ea \ handle dest addr info do_ea upper_ea >r byte_An_wrong ea \ handle source addr info r> f_or \ or source and dest addr info byte? if 010000 endif \ 'byte' size op-code word? if 030000 endif \ 'word' size op-code long? if 020000 endif \ 'long' size op-code f_or \ or op-code with addr info cleanup ; \ deposit instruction \ move>ccr move>sr move addr _ ) @ >r \ save instruction op-code word_only \ only 'word' size allowed data_ea \ handle data ea r> f_or \ or addr info with op-code cleanup ; \ deposit instruction 042300 i_move move>ccr 043300 i_move move>sr : move _ ) data_alter_ea \ handle data alter ea 040300 f_or \ or addr info with op-code cleanup ; \ deposit instruction \ move>usp move addr _ ) @ >r \ save instruction op-code An_lower \ handle addr reg num r> f_or \ or reg num with op-code cleanup ; \ deposit instruction 047140 i_An move>usp 047150 i_An move _ ) byte_wrong \ no 'byte' size An_upper >r \ handle dest addr reg ea \ handle source ea r> f_or \ or source and dest addr info word? if 030100 endif \ handle 'word' size op-code long? if 020100 endif \ handle 'long' size op-code f_or \ or opcode and addr info cleanup ; \ deposit instruction \ movem> 12/01/86 : movem> ( _ ) byte_wrong \ no 'byte' size dup dup \ get two copies of ea mode cont_ea? f_swap \ is it a cont ea? -(? f_or \ or is it <-(> 0= ?invalid_mode \ if not, error ea >r \ handle ea save_16 \ handle register list mask word? if 044200 endif \ handle 'word' op-code long? if 044300 endif \ handle 'long' op-code r> f_or \ or op-code with addr info cleanup ; \ deposit instruction \ movem< 12/01/86 : movem< \ _ byte_wrong \ not 'byte' size save_16 \ handle register list mask dup dup \ get two copies of ea mode cont_ea? f_swap \ is it a cont ea? )+? f_or \ or is it <)+>? 0= ?invalid_mode \ if not, error ea >r \ handle ea word? if 046200 endif \ handle 'word' op-code long? if 046300 endif \ handle 'long' op-code r> f_or \ or op-code with addr info cleanup ; \ deposit instruction \ movep 12/03/86 : movep ( _ ) byte_wrong \ no 'byte' size dup d(? \ is dest ea ? if ?d( drop An_lower >r \ if yes, get dest addr reg num save_16 \ save 16-bit offset Dn_upper r> f_or \ or with source data reg num 000610 f_or \ or addr info with op-code else Dn_upper >r \ else get dest data reg num ?d( drop An_lower \ get source addr reg num r> f_or \ or together f_swap save_16 \ save 16-bit offset 000410 f_or \ or addr info with op-code endif long? if 000100 f_or endif \ handle size cleanup ; \ deposit instruction \ moveq 12/01/86 : moveq ( n <#> _ ) Dn_upper >r \ get dest data reg num ?# drop 8_bits \ handle source immed num r> f_or \ or source and dest info 070000 f_or \ or addr info and op-code cleanup ; \ deposit instruction \ nbcd tas 12/01/86 : i_dae_byte ( builds: con _ ) ( does: addr _ ) @ >r \ save instruction op-code data_alter_ea \ handle data alter ea r> f_or \ or addr info with op-code cleanup ; \ deposit instruction 044000 i_dae_byte nbcd 045300 i_dae_byte tas \ pea scc 12/01/86 : pea ( _ ) cont_ea \ handle control ea 044100 f_or \ or addr info with op-code cleanup ; \ deposit instruction : scc ( condition_code _ ) dup check_cc \ check for valid condition code 050300 f_or >r \ or condition code with op-code data_alter_ea \ handle data alter ea r> f_or \ or addr info with op-code cleanup ; \ deposit instruction \ stop swap 12/01/86 : stop ( n <#> _ ) ?# drop \ handle immed num save_16 \ save immed num as extend word 047162 \ get instruction op-code cleanup ; \ deposit instruction : swap ( _ ) Dn_lower \ handle data reg num 044100 f_or \ or reg num with op-code cleanup ; \ deposit instruction \ trap 12/02/86 : trap ( n <#> _ ) ?# drop \ handle immed num 0_to_15 \ immed num must be 0 to 15 047100 f_or \ or number with opcode cleanup ; \ deposit instruction \ begin until again 11/25/86 : begin ( _ begin_addr 1 ) ?exec \ error if not executing log 1 ; \ leave 'begin' address and code on stack : until ( begin_addr 1 cc _ ) ?exec \ error if not executing not_cc >r \ invert sense of condition code, save cc 1 ?pairs \ check for matching 'begin' code r> bcc ; \ do conditional branch back to 'begin' : again ( begin_addr 1 _ ) ?exec \ error if not executing 1 ?pairs \ check for matching 'begin' code bra ; \ do unconditional branch back to 'begin' \ while repeat 11/26/86 : while ( begin_addr 1 cc _ offset_addr begin_addr 1 ) ?exec \ error if not executing not_cc >r \ invert sense of condition code, save it 1 ?pairs \ check for matching 'begin' code log \ get addr of branch op-code (includes offset) log \ get addr to branch to (self, for now) r> \ restore inverted sense condition code bcc \ the offset of the conditional branch will be \ resolved later by 'repeat' f_swap 1 ; \ leave stack looking like 'begin' : repeat ( offset_addr begin_addr 1 ) again \ handle branch to 'begin' resolve> ; \ resolve branch offset from 'while' \ if endif 11/25/86 : if ( cc _ offset_addr 2 ) ?exec \ error if not executing not_cc >r \ invert sense of condition code, save it log \ get addr of branch op-code (includes offset) log \ get addr to branch to (self, for now) r> bcc \ the offset of the conditional branch \ will be resolved later by 'else' or 'endif' 2 ; \ leave offset addr and 'if' code on stack : endif ( offset_word_addr 2 _ ) ?exec \ error if not executing 2 ?pairs \ check for matching 'if' code resolve> ; \ resolve branch offset from 'if' or 'else' \ else then 11/26/86 : else ( old_offset_addr 2 _ new_offset_addr 2 ) ?exec \ error if not executing 2 ?pairs \ check for matching 'if' code log \ get addr of branch op-code (includes offset) log \ get addr to branch to (self, for now) bra \ the offset of the unconditional branch will \ be resolved later by 'endif' or 'then' f_swap \ swap old and new offset addresses resolve> \ resolve branch offset from 'if' 2 ; \ leave stack looking like 'if' : then ( offset_addr 2 _ ) \ another name for 'endif' endif ; \ lbegin luntil lagain 11/25/86 : lbegin ( _ lbegin_addr 3 ) ?exec \ error if not executing log 3 ; \ leave 'lbegin' address and code on stack : luntil ( lbegin_addr 3 cc _ ) ?exec \ error if not executing not_cc >r \ invert sense of condition code, save cc 3 ?pairs \ check for matching 'lbegin' code r> lbcc ; \ do conditional branch back to 'lbegin' : lagain ( lbegin_addr 3 _ ) ?exec \ error if not executing 3 ?pairs \ check for matching 'lbegin' code lbra ; \ do unconditional branch back to 'lbegin' \ lwhile lrepeat 12/04/86 : lwhile ( lbegin_addr 3 cc _ offset_word_addr lbegin_addr 3 ) ?exec \ error if not executing not_cc >r \ invert sense of condition code, save it 3 ?pairs \ check for matching 'lbegin' code log 2+ \ get addr of relative offset word log \ get addr to branch to (self, for now) r> \ restore inverted sense condition code lbcc \ the offset of the conditional branch will be \ resolved later by 'lrepeat' f_swap 3 ; \ leave stack looking like 'lbegin' : lrepeat ( offset_word_addr begin_addr 3 ) lagain \ handle branch to 'lbegin' lresolve> ; \ resolve branch offset from 'lwhile' \ lif lendif 11/25/86 : lif ( cc _ offset_word_addr 4 ) ?exec \ error if not executing not_cc >r \ invert sense of condition code, save it log 2+ \ get address of relative offset word log \ get addr to branch to (self, for now) r> lbcc \ the offset of the conditional branch \ will be resolved later by 'lelse' or 'lendif' 4 ; \ leave offset addr and 'lif' code on stack : lendif ( offset_word_addr 4 _ ) ?exec \ error if not executing 4 ?pairs \ check for matching 'lif' code lresolve> ; \ resolve branch offset from 'lif' or 'lelse' \ lelse lthen 11/26/86 : lelse ( old_offset_word_addr 4 _ new_offset_word_addr 4 ) ?exec \ error if not executing 4 ?pairs \ check for matching 'lif' code log 2+ \ get addr of relative offset word log \ get addr to branch to (self, for now) lbra \ the offset of the unconditional branch will \ be resolved later by 'lendif' or 'lthen' f_swap \ swap old and new offset word addresses lresolve> \ resolve branch offset from 'lif' 4 ; \ leave stack looking like 'lif' : lthen ( offset_word_addr 4 _ ) \ another name for 'lendif' lendif ; \ rp s ip w next 12/04/86 : rp ( _ ) a7 ; \ forth 'return stack pointer' register : s ( _ ) a5 ; \ forth 'computation stack pointer' register: ip ( _ ) a4 ; \ forth 'instruction pointer' register : w ( _ ) a3 ; \ forth 'temporary' register \ a7 is also used as the HP-UX return stack pointer register \ a6 is reserved for the HP-UX stack frame pointer register \ a0, a1, a2, and all data registers are 'scratch' registers : next ( _ ) \ forth 'next' macro ip )+ w movea \ get addr of addr of executable code in 'w' w )+ a2 movea \ get address of executable code in a2 a2 ) jmp \ jump to executable code ; \ end-code 11/25/86 : end-code ( _ ) \ terminate a 'code' definition ?csp \ error if stack is different depth \ than when 'code' was executed smudge \ allow definition to be found \ in dictionary searches current @ context ! ; \ leave the assembler vocabulary \ and go to the vocabulary in which \ the current code word is defined \ code ;code 11/26/86 forth definitions : code ( _ ) \ start a 68000 code definition !csp \ save current stack depth create \ create forth definition header [compile] 68kasm \ switch to the assembler vocaulary 68kasm setup forth ; \ do any needed initialization : ;code ( _ ) \ 'does>' but in code instead of forth ?csp \ error if stack depth doesn't match compile (;code) \ compile procedure to change header [compile] 68kasm \ switch search vocabulary to assembler [compile] [ \ stop compiling, start executing ; immediate \ "loaded too far" screen 11/25/86 cr ." loaded too far" cr