mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-12-01 19:49:57 +00:00
1 line
34 KiB
Plaintext
Executable File
1 line
34 KiB
Plaintext
Executable File
\ 8086 Assembler cas 10nov05 The 8086 Assembler was written by Mike Perry. To create and assembler language definition, use the defining word CODE. It must be terminated with either END-CODE or its synonym C;. How the assembler operates is a very interesting example of the power of CREATE DOES> Basically the instructions are categorized and a defining word is created for each category. When the nmemonic for the instruction is interpreted, it compiles itself. Adapted for volksFORTH by Klaus Schleisiek No really tested, but CODE TEST TOS PUSH 1 # TOS MOV NEXT END-CODE works! \ 8086 Assembler ks cas 10nov05Onlyforth Vocabulary Assembler : octal 8 Base ! ; decimal 1 14 +THRU clear Onlyforth : Code Create [ Assembler ] here dup 2- ! Assembler ; CR .( 8086 Assembler loaded ) Onlyforth \ 8086 Assembler ks 19 m<>r 88 : LABEL CREATE ASSEMBLER ; \ 232 CONSTANT DOES-OP \ 3 CONSTANT DOES-SIZE \ : DOES? ( IP -- IP' F ) \ DUP DOES-SIZE + SWAP C@ DOES-OP = ; ASSEMBLER ALSO DEFINITIONS : C; ( -- ) END-CODE ; OCTAL DEFER C, FORTH ' C, ASSEMBLER IS C, DEFER , FORTH ' , ASSEMBLER IS , DEFER HERE FORTH ' HERE ASSEMBLER IS HERE DEFER ?>MARK DEFER ?>RESOLVE DEFER ?<MARK DEFER ?<RESOLVE \ 8086 Assembler Register Definitions ks 19 m<>r 88 | : REG 11 * SWAP 1000 * OR CONSTANT ; | : REGS ( MODE N -- ) SWAP 0 DO DUP I REG LOOP DROP ; 10 0 REGS AL CL DL BL AH CH DH BH 10 1 REGS AX CX DX BX SP BP SI DI 10 2 REGS [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI] [BP] [BX] 4 2 REGS [SI+BX] [DI+BX] [SI+BP] [DI+BP] 4 3 REGS ES CS SS DS 3 4 REGS # #) S#) BP Constant UP [BP] Constant [UP] \ User Pointer SI CONSTANT IP [SI] CONSTANT [IP] ( INTERPRETER POINTER ) DI Constant W [DI] Constant [W] \ WORKING REGISTER BX Constant RP [BX] Constant [RP] \ Return Stack Pointer DX Constant TOS \ Top Of Stack im Register\ Addressing Modes ks 19 m<>r 88 | : MD CREATE 1000 * , DOES> @ SWAP 7000 AND = 0<> ; | 0 MD R8? | 1 MD R16? | 2 MD MEM? | 3 MD SEG? | 4 MD #? | : REG? ( n -- f ) 7000 AND 2000 < 0<> ; | : BIG? ( N -- F ) ABS -200 AND 0<> ; | : RLOW ( n1 -- n2 ) 7 AND ; | : RMID ( n1 -- n2 ) 70 AND ; | VARIABLE SIZE SIZE ON : BYTE ( -- ) SIZE OFF ; | : OP, ( N OP -- ) OR C, ; | : W, ( OP MR -- ) R16? 1 AND OP, ; | : SIZE, ( OP -- OP' ) SIZE @ 1 AND OP, ; | : ,/C, ( n f -- ) IF , ELSE C, THEN ; | : RR, ( MR1 MR2 -- ) RMID SWAP RLOW OR 300 OP, ; | VARIABLE LOGICAL | : B/L? ( n -- f ) BIG? LOGICAL @ OR ; \ Addressing ks 19 m<>r 88 | : MEM, ( DISP MR RMID -- ) OVER #) = IF RMID 6 OP, DROP , ELSE RMID OVER RLOW OR -ROT [BP] = OVER 0= AND IF SWAP 100 OP, C, ELSE SWAP OVER BIG? IF 200 OP, , ELSE OVER 0= IF C, DROP ELSE 100 OP, C, THEN THEN THEN THEN ; | : WMEM, ( DISP MEM REG OP -- ) OVER W, MEM, ; | : R/M, ( MR REG -- ) OVER REG? IF RR, ELSE MEM, THEN ; | : WR/SM, ( R/M R OP -- ) 2 PICK DUP REG? IF W, RR, ELSE DROP SIZE, MEM, THEN SIZE ON ; | VARIABLE INTER : FAR ( -- ) INTER ON ; | : ?FAR ( n1 -- n2 ) INTER @ IF 10 OR THEN INTER OFF ; \ Defining Words to Generate Op Codes ks 19 m<>r 88 | : 1MI CREATE C, DOES> C@ C, ; | : 2MI CREATE C, DOES> C@ C, 12 C, ; | : 3MI CREATE C, DOES> C@ C, HERE - 1- DUP -200 177 uWITHIN NOT ABORT" Branch out of Range" C, ; | : 4MI CREATE C, DOES> C@ C, MEM, ; | : 5MI CREATE C, DOES> C@ SIZE, SIZE ON ; | : 6MI CREATE C, DOES> C@ SWAP W, ; | : 7MI CREATE C, DOES> C@ 366 WR/SM, ; | : 8MI CREATE C, DOES> C@ SWAP R16? 1 AND OR SWAP # = IF C, C, ELSE 10 OR C, THEN ; | : 9MI CREATE C, DOES> C@ OVER R16? IF 100 OR SWAP RLOW OP, ELSE 376 WR/SM, THEN ; | : 10MI CREATE C, DOES> C@ OVER CL = IF NIP 322 ELSE 320 THEN WR/SM, ; \ Defining Words to Generate Op Codes ks 19 m<>r 88 | : 11MI CREATE C, C, DOES> OVER #) = IF NIP C@ INTER @ IF 1 AND IF 352 ELSE 232 THEN C, SWAP , , INTER OFF ELSE SWAP HERE - 2- SWAP 2DUP 1 AND SWAP BIG? NOT AND IF 2 OP, C, ELSE C, 1- , THEN THEN ELSE OVER S#) = IF NIP #) SWAP THEN 377 C, 1+ C@ ?FAR R/M, THEN ; | : 12MI CREATE C, C, C, DOES> OVER REG? IF C@ SWAP RLOW OP, ELSE 1+ OVER SEG? IF C@ RLOW SWAP RMID OP, ELSE COUNT SWAP C@ C, MEM, THEN THEN ; | : 14MI CREATE C, DOES> C@ DUP ?FAR C, 1 AND 0= IF , THEN ; \ Defining Words to Generate Op Codes ks 19 m<>r 88 | : 13MI CREATE C, C, DOES> COUNT >R C@ LOGICAL ! DUP REG? IF OVER REG? IF R> OVER W, SWAP RR, ELSE OVER DUP MEM? SWAP #) = OR IF R> 2 OR WMEM, ELSE ( # ) NIP DUP RLOW 0= ( ACC? ) IF R> 4 OR OVER W, R16? ,/C, ELSE OVER B/L? OVER R16? 2DUP AND -ROT 1 AND SWAP NOT 2 AND OR 200 OP, SWAP RLOW 300 OR R> OP, ,/C, THEN THEN THEN ELSE ( MEM ) ROT DUP REG? IF R> WMEM, ELSE ( # ) DROP 2 PICK B/L? DUP NOT 2 AND 200 OR SIZE, -ROT R> MEM, SIZE @ AND ,/C, SIZE ON THEN THEN ; \ Instructions ks 19 m<>r 88 : TEST ( source dest -- ) DUP REG? IF OVER REG? IF 204 OVER W, SWAP RR, ELSE OVER DUP MEM? SWAP #) = OR IF 204 WMEM, ELSE ( # ) NIP DUP RLOW 0= ( ACC? ) IF 250 OVER W, ELSE 366 OVER W, DUP RLOW 300 OP, THEN R16? ,/C, THEN THEN ELSE ( MEM ) ROT DUP REG? IF 204 WMEM, ELSE ( # ) DROP 366 SIZE, 0 MEM, SIZE @ ,/C, SIZE ON THEN THEN ; \ Instructions ks 19 m<>r 88 HEX : ESC ( source ext-opcode -- ) RLOW 0D8 OP, R/M, ; : INT ( N -- ) 0CD C, C, ; : SEG ( SEG -- ) RMID 26 OP, ; : XCHG ( MR1 MR2 -- ) DUP REG? IF DUP AX = IF DROP RLOW 90 OP, ELSE OVER AX = IF NIP RLOW 90 OP, ELSE 86 WR/SM, THEN THEN ELSE ROT 86 WR/SM, THEN ; : CS: CS SEG ; : DS: DS SEG ; : ES: ES SEG ; : SS: SS SEG ; \ Instructions ks 19 m<>r 88 : MOV ( S D -- ) DUP SEG? IF 8E C, R/M, ELSE DUP REG? IF OVER #) = OVER RLOW 0= AND IF A0 SWAP W, DROP , ELSE OVER SEG? IF SWAP 8C C, RR, ELSE OVER # = IF NIP DUP R16? SWAP RLOW OVER 8 AND OR B0 OP, ,/C, ELSE 8A OVER W, R/M, THEN THEN THEN ELSE ( MEM ) ROT DUP SEG? IF 8C C, MEM, ELSE DUP # = IF DROP C6 SIZE, 0 MEM, SIZE @ ,/C, ELSE OVER #) = OVER RLOW 0= AND IF A2 SWAP W, DROP , ELSE 88 OVER W, R/M, THEN THEN THEN THEN THEN SIZE ON ; \ Instructions 12Oct83map 37 1MI AAA D5 2MI AAD D4 2MI AAM 3F 1MI AAS 0 10 13MI ADC 0 00 13MI ADD 2 20 13MI AND 10 E8 11MI CALL 98 1MI CBW F8 1MI CLC FC 1MI CLD FA 1MI CLI F5 1MI CMC 0 38 13MI CMP A6 5MI CMPS 99 1MI CWD 27 1MI DAA 2F 1MI DAS 08 9MI DEC 30 7MI DIV ( ESC ) F4 1MI HLT 38 7MI IDIV 28 7MI IMUL E4 8MI IN 00 9MI INC ( INT ) 0CE 1MI INTO 0CF 1MI IRET 77 3MI JA 73 3MI JAE 72 3MI JB 76 3MI JBE E3 3MI JCXZ 74 3MI JE 7F 3MI JG 7D 3MI JGE 7C 3MI JL 7E 3MI JLE 20 E9 11MI JMP 75 3MI JNE 71 3MI JNO 79 3MI JNS 70 3MI JO 7A 3MI JPE 7B 3MI JPO 78 3MI JS 9F 1MI LAHF C5 4MI LDS 8D 4MI LEA C4 4MI LES F0 1MI LOCK 0AC 6MI LODS E2 3MI LOOP E1 3MI LOOPE E0 3MI LOOPNE \ Instructions 12Apr84map ( MOV ) 0A4 5MI MOVS 20 7MI MUL 18 7MI NEG 90 1MI NOP 10 7MI NOT 2 08 13MI OR E6 8MI OUT 8F 07 58 12MI POP 9D 1MI POPF 0FF 36 50 12MI PUSH 9C 1MI PUSHF 10 10MI RCL 18 10MI RCR F2 1MI REP F2 1MI REPNZ F3 1MI REPZ C3 14MI RET 00 10MI ROL 8 10MI ROR 9E 1MI SAHF 38 10MI SAR 0 18 13MI SBB 0AE 5MI SCAS ( SEG ) 20 10MI SHL 28 10MI SHR F9 1MI STC FD 1MI STD FB 1MI STI 0AA 6MI STOS 0 28 13MI SUB ( TEST ) 9B 1MI WAIT ( XCHG ) D7 1MI XLAT 2 30 13MI XOR C2 14MI +RET \ Structured Conditionals ks 19 m<>r 88 : A?>MARK ( -- f addr ) TRUE HERE 0 C, ; : A?>RESOLVE ( f addr -- ) HERE OVER 1+ - SWAP C! true ?pairs ; : A?<MARK ( -- f addr ) TRUE HERE ; : A?<RESOLVE ( f addr -- ) HERE 1+ - C, true ?pairs ; ' A?>MARK ASSEMBLER IS ?>MARK ' A?>RESOLVE ASSEMBLER IS ?>RESOLVE ' A?<MARK ASSEMBLER IS ?<MARK ' A?<RESOLVE ASSEMBLER IS ?<RESOLVE HEX 75 CONSTANT 0= 74 CONSTANT 0<> 79 CONSTANT 0< 78 CONSTANT 0>= 7D CONSTANT < 7C CONSTANT >= 7F CONSTANT <= 7E CONSTANT > 73 CONSTANT U< 72 CONSTANT U>= 77 CONSTANT U<= 76 CONSTANT U> 71 CONSTANT OV DECIMAL \ Structured Conditionals cas 10nov05HEX : IF C, ?>MARK ; : THEN ?>RESOLVE ; : ELSE 0EB IF 2SWAP THEN ; : BEGIN ?<MARK ; : UNTIL C, ?<RESOLVE ; : AGAIN 0EB UNTIL ; : WHILE IF ; : REPEAT 2SWAP AGAIN THEN ; : DO # CX MOV HERE ; : Next AX lods AX DI xchg 0 [DI] jmp [ Assembler ] here next-link @ , next-link ! ; \ volksFORTH uses "inline" Next and a linked list, to find all \ existing NEXT for the debugger. DECIMAL \ 8086 Assembler 08OCT83HHLLABEL marks the start of a subroutine whose name returns its address. DOES-OP Is the op code of the call instruction used for DOES> U C; A synonym for END-CODE Deferring the definitions of the commas, marks, and resolves allows the same assembler to serve for both the system and the Meta-Compiler. \ 8086 Assembler Register Definitions 12Oct83map On the 8086, register names are cleverly defined constants. The value returned by registers and by modes such as #) containsboth mode and register information. The instructions use the mode information to decide how many arguments exist, and what toassemble. Like many CPUs, the 8086 uses many 3 bit fields in its opcodesThis makes octal ( base 8 ) natural for describing the registers We redefine the Registers that FORTH uses to implement its virtual machine. \ Addressing Modes 16Oct83mapMD defines words which test for various modes. R8? R16? MEM? SEG? #? test for mode equal to 0 thru 4. REG? tests for any register mode ( 8 or 16 bit). BIG? tests offsets size. True if won't fit in one byte. RLOW mask off all but low register field. RMID mask off all but middle register field. SIZE true for 16 bit, false for 8 bit. BYTE set size to 8 bit. OP, for efficiency. OR two numbers and assemble. W, assemble opcode with W field set for size of register. SIZE, assemble opcode with W field set for size of data. ,/C, assemble either 8 or 16 bits. RR, assemble register to register instruction. LOGICAL true while assembling logical instructions. B/L? see 13MI \ Addressing 16Oct83mapThese words perform most of the addressing mode encoding. MEM, handles memory reference modes. It takes a displacement, a mode/register, and a register, and encodes and assembles them. WMEM, uses MEM, after packing the register size into the opcodeR/M, assembles either a register to register or a register to or from memory mode. WR/SM, assembles either a register mode with size field, or a memory mode with size from SIZE. Default is 16 bit. Use BYTE for 8 bit size. INTER true if inter-segment jump, call, or return. FAR sets INTER true. Usage: FAR JMP, FAR CALL, FAR RET. ?FAR sets far bit, clears flag. \ Defining Words to Generate Op Codes 12Oct83map1MI define one byte constant instructions. 2MI define ascii adjust instructions. 3MI define branch instructions, with one byte offset. 4MI define LDS, LEA, LES instructions. 5MI define string instructions. 6MI define more string instructions. 7MI define multiply and divide instructions. 8MI define input and output instructions. 9MI define increment/decrement instructions. 10MI define shift/rotate instructions. *NOTE* To allow both 'ax shl' and 'ax cl shl', if the register on top of the stack is cl, shift second register by cl. If not, shift top ( only) register by one. \ Defining Words to Generate Op Codes 09Apr84map11MI define calls and jumps. notice that the first byte stored is E9 for jmp and E8 for call so C@ 1 AND is zero for call, 1 for jmp. syntax for direct intersegment: address segment #) FAR JMP 12MI define pushes and pops. 14MI defines returns. RET FAR RET n +RET n FAR +RET \ Defining Words to Generate Op Codes 16Oct83map13MI define arithmetic and logical instructions. \ Instructions 16Oct83mapTEST bits in dest \ Instructions 16Oct83map ESC INT assemble interrupt instruction. SEG assemble segment instruction. XCHG assemble register swap instruction. CS: DS: ES: SS: assemble segment over-ride instructions. \ Instructions 12Oct83mapMOV as usual, the move instruction is the most complicated. It allows more addressing modes than any other, each of which assembles something more or less unique. \ Instructions 12Oct83mapMost instructions are defined on these two screens. Mnemonics inparentheses are defined earlier or not at all. \ Instructions 12Oct83mapMost instructions are defined on these two screens. Mnemonics inparentheses are defined earlier or not at all. \ Structured Conditionals 16Oct83mapA?>MARK assembler version of forward mark. A?>RESOLVE assembler version of forward resolve. A?<MARK assembler version of backward mark. A?<RESOLVE assembler version of backward resolve. These conditional test words leave the opcodes of conditional branches to be used by the structured conditional words. For example, 5 # CX CMP 0< IF AX BX ADD ELSE AX BX SUB THEN \ Structured Conditionals 12Oct83map One of the very best features of FORTH assemblers is the abilityto use structured conditionals instead of branching to nonsense labels. |