\ The Rest is Silence 04Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for 68000 Dependent Code 07Apr84map ONLY FORTH ALSO DEFINITIONS DECIMAL 3 LOAD ( The Assembler ) 18 LOAD ( The Low Level for the Debugger ) 21 LOAD ( The Low Level for the MultiTasker ) 24 LOAD ( The Machine Dependent IO words ) CR .( 68000 Machine Dependent Code Loaded ) \ 68000 Assembler Load Screen 13Apr84mapONLY FORTH ALSO DEFINITIONS 1 14 +THRU : NEXT >NEXT #) JMP ; : INIT [ ASSEMBLER ] WORD ; ONLY FORTH ALSO DEFINITIONS HEX 4EB8 CONSTANT DOES-OP DECIMAL 4 CONSTANT DOES-SIZE : DOES? (S IP -- IP' F ) DUP DOES-SIZE + SWAP @ DOES-OP = ; : LABEL CREATE ASSEMBLER [ ASSEMBLER ] INIT ; : CODE CODE [ ASSEMBLER ] INIT ; \ 68000 Assembler 10Jan84mapASSEMBLER ALSO DEFINITIONS : A?>MARK (S -- addr f ) HERE TRUE ; : A?>RESOLVE (S addr f -- ) ?CONDITION HERE OVER - SWAP 1- C! ; : A?MARK ' A?>MARK IS ?>MARK DEFER ?>RESOLVE ' A?>RESOLVE IS ?>RESOLVE DEFER ? @ SIZE @ AND OR ; 00300 SZ SZ3 00400 SZ SZ4 04000 SZ SZ40 30000 SZ SZ300 : LONG? SIZE @ 24600 = ; : -SZ1 LONG? IF 100 OR THEN ; \ addressing modes 18Apr84map: 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 ) 0770 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 02Apr84map: 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= ; : SRC (S ea instr -- ea instr' ) OVER EAS OR ; : DST (S ea instr -- ea instr' ) SWAP RD OR ; A7 CONSTANT SP ( Stack pointer ) A6 CONSTANT RP ( Return stack pointer ) A5 CONSTANT IP ( Interpreter pointer ) A4 CONSTANT W ( Working register ) \ extended addressing 31Oct83map: DOUBLE? ( mode -- flag ) DUP L#) = SWAP # = LONG? AND OR ; : INDEX? ( {n} mode -- {m} mode ) DUP >R DUP 0770 AND A0 DI) = SWAP PCDI) = OR IF DUP RD 10 * SWAP MS IF 100000 OR THEN SZ40 SWAP LOW OR THEN R> ; : MORE? ( ea -- ea flag ) DUP MS 0040 > ; : ,MORE ( ea -- ) MORE? IF INDEX? DOUBLE? ?, ELSE DROP THEN ; \ extended addressing extras 10Jan84mapCREATE EXTRA HERE 5 DUP ALLOT ERASE \ temporary storage area : EXTRA? ( {n} mode -- mode ) MORE? IF >R R@ INDEX? DOUBLE? EXTRA 1+ SWAP IF 2! 2 ELSE ! 1 THEN EXTRA C! R> ELSE 0 EXTRA ! THEN ; : ,EXTRA ( -- ) EXTRA C@ ?DUP IF EXTRA 1+ SWAP 1 = IF @ , ELSE 2@ 2, THEN EXTRA 5 ERASE THEN ; \ immediates & address register specific 31Oct83map: IMM CONSTANT DOES> @ >R EXTRA? EAS R> OR SZ3 , LONG? ?, ,EXTRA ; ( n ea ) 0000 IMM ORI 1000 IMM ANDI 2000 IMM SUBI 3000 IMM ADDI 5000 IMM EORI 6000 IMM CMPI : IMMSR CONSTANT DOES> @ SZ3 2, ; ( n ) 001074 IMMSR ANDI>SR 005074 IMMSR EORI>SR 000074 IMMSR ORI>SR : IQ CONSTANT DOES> @ >R EXTRA? EAS SWAP RS 1000 * OR R> OR SZ3 , ,EXTRA ; ( n ea ) 050000 IQ ADDQ 050400 IQ SUBQ : IEAA CONSTANT DOES> @ DST SRC SZ4 , ,MORE ; ( ea An ) 150300 IEAA ADDA 130300 IEAA CMPA 040700 IEAA LEA 110300 IEAA SUBA \ shifts, rotates, and bit manipulation 31Oct83map: ISR 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 , ELSE DUP EAS 300 OR R@ 400 AND OR R> 70 AND 100 * OR 160000 OR , ,MORE THEN ; ( Dm Dn ) ( m # Dn ) ( ea ) 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 CONSTANT DOES> @ >R EXTRA? DN? IF RD SRC 400 ELSE DROP DUP EAS 4000 THEN OR R> OR , ,EXTRA ,MORE ; ( ea Dn ) ( ea n # ) 000 IBIT BTST 100 IBIT BCHG 200 IBIT BCLR 300 IBIT BSET \ branch, loop, and set conditionals 18Apr84map: SETCLASS ' SWAP 0 DO I OVER EXECUTE LOOP DROP ; : IBRA 400 * 060000 OR CONSTANT ( label ) DOES> @ SWAP ?>MARK DROP 2+ - DUP ABS 200 < IF LOW OR , ELSE SWAP 2, THEN ; 20 SETCLASS IBRA BRA BSR BHI BLS BCC BCS BNE BEQ BVC BVS BPL BMI BGE BLT BGT BLE : IDBR 400 * 050310 OR CONSTANT ( label \ Dn - ) DOES> @ SWAP RS OR , ?>MARK DROP - , ; 20 SETCLASS IDBR DXIT DBRA DBHI DBLS DBCC DBCS DBNE DBEQ DBVC DBVS DBPL DBMI DBGE DBLT DBGT DBLE : ISET 400 * 050300 OR CONSTANT ( ea ) DOES> @ SRC , ,MORE ; 20 SETCLASS ISET SET SNO SHI SLS SCC SCS SNE SEQ SVC SVS SPL SMI SGE SLT SGT SLE \ moves 10Jan84map: MOVE EXTRA? 7700 AND SRC SZ300 , ,MORE ,EXTRA ; ( ea ea ) : MOVEQ RD SWAP LOW OR 070000 OR , ; ( n Dn ) : MOVE>USP RS 047140 OR , ; ( An ) : MOVE EXTRA? EAS 044200 OR -SZ1 , , ,EXTRA ; ( n ea ) : MOVEM< EXTRA? EAS 046200 OR -SZ1 , , ,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 , ; ( long reg move ) \ odds and ends 16Jan84map: CMPM RD SWAP RS OR 130410 OR SZ3 , ; ( An@+ Am@+ ) : EXG DN? IF SWAP DN? IF 140500 ELSE 140610 THEN >R ELSE SWAP DN? IF 140610 ELSE 140510 THEN >R SWAP THEN RS DST R> OR , ; ( Rn Rm ) : EXT RS 044200 OR -SZ1 , ; ( Dn ) : SWAP RS 044100 OR , ; ( Dn ) : STOP 47162 2, ; ( n ) : TRAP 17 AND 47100 OR , ; ( n ) : LINK RS 047120 OR 2, ; ( n An ) : UNLK RS 047130 OR , ; ( An ) : EOR EXTRA? EAS DST SZ3 130400 OR , ,EXTRA ; ( Dn ea ) : CMP 130000 DST SRC SZ3 , ,MORE ; ( ea Dn ) \ arithmetic and logic 08Apr84map: IBCD CONSTANT DOES> @ DST OVER RS OR [ FORTH ] SWAP MS IF 10 OR THEN , ; ( Dn Dm ) ( An@- Am@- ) 140400 IBCD ABCD 100400 IBCD SBCD : IDD CONSTANT DOES> @ DST OVER RS OR [ FORTH ] SWAP MS IF 10 OR THEN SZ3 , ; ( 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 , ,MORE ELSE EXTRA? EAS DST 400 OR R> OR SZ3 , ,EXTRA THEN ; 150000 IDEA ADD 110000 IDEA SUB 140000 IDEA AND 100000 IDEA OR : IEAD CONSTANT DOES> @ DST SRC , ,MORE ; ( ea Dn ) 040600 IEAD CHK 100300 IEAD DIVU 100700 IEAD DIVS 140300 IEAD MULU 140700 IEAD MULS \ arithmetic and control 31Oct83map: IEA CONSTANT DOES> @ SRC , ,MORE ; ( ea ) 047200 IEA JSR 047300 IEA JMP 042300 IEA MOVE>CCR 040300 IEA MOVESR 044000 IEA NBCD 044100 IEA PEA 045300 IEA TAS : IEAS CONSTANT DOES> @ SRC SZ3 , ,MORE ; ( ea ) 047200 IEA JSR 047300 IEA JMP 042300 IEA MOVE>CCR 041000 IEAS CLR 043000 IEAS NOT 042000 IEAS NEG 040000 IEAS NEGX 045000 IEAS TST : ICON CONSTANT DOES> @ , ; 47160 ICON RESET 47161 ICON NOP 47163 ICON RTE 47165 ICON RTS \ structured conditionals +/- 256 bytes 08Apr84map: THEN ?>RESOLVE ; : IF , ?>MARK ; HEX : ELSE 6000 IF 2SWAP THEN ; : BEGIN ?MARK DROP [ FORTH ] SWAP ; : LOOP DBRA ; 6600 CONSTANT 0= 6700 CONSTANT 0<> 6A00 CONSTANT 0< 6B00 CONSTANT 0>= 6C00 CONSTANT < 6D00 CONSTANT >= 6E00 CONSTANT <= 6F00 CONSTANT > DECIMAL \ DEBUGGER 10Jan84map1 2 +THRU \ Vocabulary, Range test 02Apr84mapVOCABULARY BUG BUG ALSO DEFINITIONS VARIABLE VARIABLE CNT VARIABLE 'DEBUG LABEL FNEXT IP )+ D7 MOVE D7 W LMOVE HERE W )+ D7 MOVE D7 A0 LMOVE A0 ) JMP C; CONSTANT FNEXT1 FORTH DEFINITIONS CODE UNBUG (S -- ) BUG FNEXT ASSEMBLER 0 L#) >NEXT #) LONG MOVE WORD NEXT C; BUG DEFINITIONS \ Debug version of Next 10Jan84mapLABEL DEBNEXT HEX IP D0 MOVE = ) IF IP> #) D0 CMP 6200 ( U<= ) IF CNT 0 L#) D2 MOVE 1 D2 ADDQ D2 CNT 0 L#) MOVE 2 # D2 CMP 0= IF CNT 0 L#) CLR LONG FNEXT 0 L#) >NEXT #) MOVE WORD IP SP -) MOVE 'DEBUG 0 L#) D7 MOVE D7 W LMOVE FNEXT1 0 L#) JMP THEN THEN THEN FNEXT 0 L#) JMP C; DECIMAL LABEL JBUG DEBNEXT #) JMP C; CODE PNEXT JBUG 0 L#) >NEXT #) LONG MOVE WORD NEXT C; \ Load Screen for the MultiTasker 18APR83HHLONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( MultiTasker Low Level Loaded ) ONLY FORTH ALSO DEFINITIONS EXIT The MultiTasker is loaded as an application on top of the regular Forth System. There is support for it in the nucleus in the form of USER variables and PAUSEs inserted inside of KEY EMIT and BLOCK. The Forth multitasking scheme is co-operative instead of interruptive. All IO operations cause a PAUSE to occur, and the multitasking loop looks around at all of the current task for something to do. \ Multitasking low level 10Jan84mapCODE (PAUSE) (S -- ) IP SP -) MOVE ( IP to stack ) RP SP -) MOVE ( RP to stack ) UP 0 L#) D7 MOVE D7 A0 LMOVE SP A0 )+ MOVE ( SP to USER area ) 2 A0 LONG ADDQ WORD A0 ) D7 MOVE D7 A0 LMOVE A0 ) JMP ( to next task) C; LABEL RESTART (S -- ) SP )+ D7 MOVE ( drop SR ) SP )+ A0 LMOVE ( return address) 4 A0 SUBQ A0 UP 0 L#) MOVE ( Set UP to new user ) A0 ) D7 MOVE D7 SP LMOVE ( Restore stack ) SP )+ D7 MOVE D7 RP LMOVE ( Return stack ) SP )+ D7 MOVE D7 IP LMOVE ( Restore IP ) NEXT C; HEX 4E47 ENTRY ! ( TRAP 7 ) DECIMAL ENTRY LINK ! ( only task points to itself ) \ Manipulate Tasks 08JAN84MAPHEX : LOCAL (S base addr -- addr' ) UP @ - + ; : @LINK (S -- addr ) LINK @ ; : !LINK (S addr -- ) LINK ! ; : SLEEP (S addr -- ) 4EF8 SWAP ENTRY LOCAL ! ; : WAKE (S addr -- ) 4E47 SWAP ENTRY LOCAL ! ; : STOP (S -- ) UP @ SLEEP PAUSE ; : SINGLE (S -- ) ['] PAUSE >BODY ['] PAUSE ! ; : MULTI (S -- ) 0 9C ! RESTART 9E ! ['] (PAUSE) @ ['] PAUSE ! ; DECIMAL \ Load Screen for Machine Dependent IO Words 28Feb84mapONLY FORTH ALSO DEFINITIONS 1 1 +THRU CR .( Machine Dependent IO Words Loaded ) EXIT \ P@ P! 04Apr84mapCODE LC@ (S dadr -- char ) SP )+ A0 LMOVE D0 CLR BYTE A0 ) D0 MOVE WORD D0 SP -) MOVE NEXT C; CODE LC! (S char dadr -- ) SP )+ A0 LMOVE SP )+ D0 MOVE BYTE D0 A0 ) MOVE NEXT C; HEX 00FF CONSTANT IO-PAGE DECIMAL : PC@ (S port -- byte ) IO-PAGE LC@ ; : PC! (S byte port -- ) IO-PAGE LC! ; \ Load Screen for 68000 Dependent Code 28Feb84map All of the machine dependent code for a particular Forth implementation is factored out and placed into this file. For the 68000 there are 3 different components. The 68000 assembler,the run time debugger, which must have knowledge of how NEXT is implemented, and the MultiTasker, which uses code words to WAKE tasks and put them to SLEEP. \ 68000 Assembler Load Screen 11Mar84map NEXT is a macro. It assembles a jump to >NEXT. Nearly all CODE words end with NEXT. DOES-OP is the call opcode compiled by DOES>. DOES-SIZE is the length of the call in bytes. DOES? (S IP -- IP' F ) test for DOES> word. Used by the decompiler. LABEL marks the start of a subroutine whose name returns its address. CODE creates a Forth code word. \ 68000 Assembler 11Mar84map Deferring the definitions of the commas, marks, and resolves allows the same assembler to serve for both the system and the Meta-Compiler. \ 68000 Assembler 18Apr84mapC; is a synonym for END-CODE ?, compiles one or two numbers. 2, compiles two numbers. OCTAL is convenient for the bit fields in the 68000. Many 68000 instructions can operate on either 8, 16, or 32-bit data. Rather than specify the size individually for each instruction, the variable SIZE contains the size information forany instruction which needs it. Size is set by BYTE, WORD, and LONG. SZ defines words which select certain bits from SIZE and installthem into the instruction being assembled. The size field moves around considerably. LONG? leaves a flag, true if SIZE is LONG. -SZ1 handles an special case where the size field is inverted with respect to all others. Nice job, Motorola! \ Assembler registers and addressing modes. 18Apr84mapNotice that REGS defines several words each time it is used. MODE defines modifiers which will follow an address register. Examples: D0 thru D7 are data registers. A0 thru A7 are address registers. D0 A1 ) MOVE Move contents of D0 to where A1 points. A7 )+ D1 MOVE pop item off stack pointed to by A7 into D1. D2 A6 -) MOVE push D2 onto stack pointed to by A6. 12 A3 D) CLR clear address 12 bytes past where A3 points. 34 D3 A4 DI) NEG negate contents of address at A4+D3+34. 1234 #) JMP jump to absolute address 1234. *NOTE* sign extends!12.3456 L#) JMP jump to long absolute address 123456. 56 PCD) D4 MOVE get contents of address at PC+56 into D4. 78 D5 PCDI) NOT complement contents of address at PC+D5+78. 9876 # D6 MOVE put the value 9876 into D6. \ fields and register assignments 18Apr84mapFIELD defines words which mask off various bit fields. RS and RD select the source or destination register field. MS selects the source mode field. EAS selects the source effective address field. LOW selects the low byte. DN? tests for data register mode. SRC merges the source register and mode into the instruction. DST merges the destination register into the instruction. These are the register assignments for the virtual Forth machineYou can refer to the virtual machine registers, for example: RP )+ SP -) MOVE pops the top item from the return stack onto the data stack. NOTE: registers A4-A7 and D7 are used, all others are free. Registers which are used by Forth must be saved and restored by any routine which uses them. \ extended addressing 18Apr84mapMany of the 68000's addressing modes require additional bytes following the opcode. DOUBLE? leaves true if the given mode requires 32 bits of extra addressing information. INDEX? does nothing unless the given mode is an indexed mode, in which case it packs the extra data into the required format. MORE? tests for extra addressing words. ,MORE assembles the extra words. \ extended addressing extras 02Apr84mapEXTRA is a temporary storage area for extended addressing operands. EXTRA? tests a mode for extra words. If present, they are saved in EXTRA to get them out of the way until needed. ,EXTRA retrieves the words in EXTRA, if any, and assembles them. \ immediates & address register specific 02Apr84mapIMM defining word for immediate instructions. IMMSR defining word for immediate to ststus register instructions. IQ defining word for quick instructions. IEAA defining word for effective address to address register instructions. \ shifts, rotates, and bit manipulation 02Apr84mapISR defining word for shifts and rotates. IBIT defining word for bit manipulators. \ branch, loop, and set conditionals 18Apr84map 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 words for each class, the word SETCLASS is used to define all sixteen at once by re-executing the defining word with a different value for the condition code each time. Of the 48 words so defined, only DXIT and SNO are useless. Compiler directives like SETCLASS can be very useful. It wouldbe better if there was a way to throw them away after use. I am planning to add a TRANSIENT definitions capability for this and other reasons. \ moves 18Apr84mapThese are the MOVE instructions in all their glory. Notice that I have added LMOVE. This is because the 68000 treatsaddresses as signed numbers. When a 16 bit address is loaded into an address register, it is sign-extended. This is never what I want. Values loaded into data registers is not extended, so I often load 16 bits into a data register, then move all 32 bits into an address register to get an unextended address. Data register 7 is reserved in this system for this purpose. LMOVE lets me do the above nonsense without switching to betweenLONG and WORD sizes constantly. To keep the assembler simple, some words use modified Motorola mnemonics. HEX FFFF SP -) MOVEM> will save all registers on the stack. ( pronounced MOVEM-OUT ). \ odds and ends 04Apr84mapExamples: A5 )+ A3 )+ CMPM D0 A3 EXG D2 EXT D1 SWAP 1234 STOP 3 TRAP 8 A6 LINK A6 UNLK D0 A5 ) EOR A7 )+ D0 CMP \ arithmetic and logic 04Apr84mapIBCD defining word for Binary Coded Decimal instructions. IDD defining word for extended instructions. e.g. A1 -) A2 -) ADDX D0 D1 ADDX IDEA defining word for some arithmetic and logical instructions. IEAD defining word for some arithmetic and logical instructions. \ arithmetic and control 04Apr84mapIEA defining word for instructions which take only an effective address. IEAS defining word for instructions which take only an effective address, and are affected by SIZE. ICON defining word for instructions which take no arguments. \ structured conditionals +/- 256 bytes 18Apr84map These words implement structured conditionals for the assembler. This is a much cleaner way to express control flow than the usual technique of random jumps to nonsense labels. e.g. D0 D0 OR 0= IF 5 # D1 ADD ELSE 3 # D1 ADD THEN BEGIN A0 ) D0 MOVE 0<> WHILE D0 A0 MOVE REPEAT 5 D3 DO 1 D6 ADDQ LOOP The last is especially interesting. It will repeat the code between DO and LOOP 5 times using D3 as a counter. Note that any DBcc can replace LOOP. IF, WHILE, and UNTIL all expect a branch opcode on the stack. The most commonly used ones are defined here as constants named for the corresponding condition. \ 16 Bit Subtract Subroutine 02Apr84mapBUG The vocabulary that holds the Debugging Words The range of IP values we are interested in FNEXT A copy of next that gets exeucted instead of the normal one. FNEXT1 Ditto for execute. UNBUG restores Forth's Next to its original condition. Effectively disabling tracing. \ Debug version of Next 02Apr84map DEBNEXT is the debugger's version of next If the IP is between then the contents of the execution variable 'DEBUG are executed. First the IP is pushed onto the parameter stack. The word pointed to by 'DEBUG can be any high or low level word so long as it discards the IP that was pushed before it is called, and it must terminate by callingPNEXT to patch next once again for more tracing. PNEXT patches Forth's Next to jump to DEBNEXT. This puts us into DEBUG mode and allows for tracing. 31Oct83map \ Multitasking low level 26MAY83HHL(PAUSE) (S -- ) Puts a task to sleep by storing the IP and the RP on the parameter stack. It then saves the pointer to the parameter stack in the user area and jumps to the code pointed at by USER+3, switching tasks. RESTART (S -- ) Sets the user pointer to point to a new user area and restores the parameter stack that was previously saved in the USER area. Then pops the RP and IP off of the stack and resumes execution. The inverse of PAUSE. Initialize current User area to a single task. \ Manipulate Tasks 12Oct83mapLOCAL Map a User variable from the current task to another task@LINK Return a pointer the the next tasks entry point !LINK Set the link field of the current task (perhaps relative)SLEEP makes a task pause indefinitely. WAKE lets a task start again. STOP makes a task pause indefinitely. SINGLE removes the multi-tasker's scheduler/dispatcher loop. MULTI installs the multi-tasker's scheduler/dispatcher loop. By patching the appropriate INT vector and enabling PAUSE. 31Oct83map \ Machine dependent IO words 04Apr84mapLC@ get a byte from the 32 bit address on the stack. LC! store a byte into the 32 bit address on the stack. PC@ (S port# -- n ) Fetch the value at the given input port and push it onto the stack. PC! (S n port# -- ) Write the value to the specified port number. 31Oct83map