\ load screen gst850930\ note: added negate's for true =-1 may not be needed : ?condition 0= if cr ." conditions mismatched" abort then ; : (s [compile] ( ; immediate : (p [compile] ( ; immediate \ ignore just like comment 2 19 thru \ load assembler \ 9 11 R .v. R@ \ 5 variable \ 9 create -dup .v. ?dup \ 12 cfa after ' for execute (still needed for f-79) \ 3 hide..unhide .v. smudge <builds .v. create \ 7 sp is a6 on sep.hd system \ 68000 Assembler a few examples gst850923 \ code FOO \ sp )+ d0 move \ pop one word to d0 \ 1 d0 addq \ add one to d0 \ 1 # d0 and \ mask just right bit \ 0<> if \ do following if non-zero \ sp )+ d0 long add word \ add long word from stack \ then \ revert to word length \ d0 sp -) move \ push resulting word in d0 \ end-code \ 68000 Assembler gst850930vocabulary ASSEMBLER immediate : subroutine \ -- | like code, but leaves its addr only create smudge [compile] assembler \ finish it sp@ csp ! ; \ primed for little safety too : code subroutine \ -- | start of a code definition \ CREATE SMUDGE \ start a definition, leave it smudged HERE LATEST PFA CFA ! ; \ <;CODE> to pt cfa to code\ [compile] assembler ; \ finish off this definition assembler definitions : end-code \ base -- | done with a code definition CURRENT @ CONTEXT ! ?CSP smudge ; \ 68000 Assembler gst850923ASSEMBLER DEFINITIONS : ?>MARK (S -- addr f ) HERE TRUE ; : ?>RESOLVE (S addr f -- ) ?CONDITION HERE OVER - SWAP 1- C! ; : ?<MARK (S -- addr f ) HERE TRUE ; : ?<RESOLVE (S addr f -- ) ?CONDITION HERE - HERE 1- C! ; \ DEFER C, FORTH ' C, ASSEMBLER IS C, \ DEFER , FORTH ' , ASSEMBLER IS , \ 68000 Meta Assembler gst851001\ : C; END-CODE ; : ?, IF , THEN , ; : 2, , , ; OCTAL VARIABLE SIZE \ fig forth : BYTE 10000 SIZE ! ; : WORD 30100 SIZE ! ; WORD : LONG 24600 SIZE ! ; : SZ CONSTANT DOES> @ SIZE @ AND OR ; 00300 SZ SZ3 00400 SZ SZ4 04000 SZ SZ40 30000 SZ SZ300 : LONG? SIZE @ 24600 = negate ; : -SZ1 LONG? IF 100 OR THEN ; VARIABLE INDEX-SIZE 0 INDEX-SIZE ! \ <>0 IF DI.L) \ addressing modes gst851001: REGS 10 0 DO DUP 1001 I * OR CONSTANT LOOP DROP ; : MODE 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 indexed ) : DI.L) 7007 and 0660 or 1 index-size ! ; \ lond DI) mode0770 CONSTANT #) ( immediate address ) 1771 CONSTANT L#) ( immediate long address ) 2772 CONSTANT PCD) ( PC relative displaced ) 3773 CONSTANT PCDI) ( PC relative displaced indexed ) 4774 CONSTANT # ( immediate data ) \ fields and register assignments gst850930: FIELD CONSTANT DOES> @ AND ; 7000 FIELD RD 0007 FIELD RS 0070 FIELD MS 0077 FIELD EAS 0377 FIELD LOW : DN? (S ea -- ea flag ) DUP MS 0= negate ; : SRC (S ea instr -- ea instr' ) OVER EAS OR ; : DST (S ea instr -- ea instr' ) SWAP RD OR ; A5 CONSTANT SP ( Stack pointer ) A7 CONSTANT RP ( Return stack pointer ) A4 CONSTANT IP ( Interpreter pointer ) D6 CONSTANT W ( Working register Hi Word MUST be 0 ) D5 constant OS ( Hi word MUST be 0 ) A3 constant BP ( Base pointer for forth addr space )
