home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
forth
/
forthed.arc
/
ASMBLR.SCR
next >
Wrap
Text File
|
1987-09-09
|
28KB
|
1 lines
( 8086 ASSEMBLER 04/28/84 ) This is a copy of the 8086 Forth assembler from the source-code for the public domain version of PC-Forth. ( 8086 ASSEMBLER 04/28/84 ) ONLY DEFINITIONS VOCABULARY ASSEMBLER FORTH 83STD ALSO ASSEMBLER DEFINITIONS : RESET ( -- ) "01C0 mode ! ; RESET ( mode is a USER V) : CLR ( n1 n2 -- n3 ) -1 XOR AND ; : OR-MODE ( n -- ) mode C@ OR mode C! ; : AND-MODE ( n -- ) mode C@ AND mode C! ; : SET-FLAG ( n -- ) mode 1+ C@ OR mode 1+ C! ; : CLR-FLAG ( n -- ) mode 1+ C@ SWAP CLR mode 1+ C! ; : IN-RANGE? ( n -- b ) ABS "80 U< ; : REG? ( -- b ) mode C@ "C0 U< 0= ; : INDIR-REG? ( n -- n b ) DUP 3 U< OVER 4 = OR OVER 8 = OR OVER 13 U< 0= OR 0= ; --> ( 8086 ASSEMBLER 09/24/82 ) "01 CONSTANT word# "02 CONSTANT direc# "04 CONSTANT addr# "08 CONSTANT imm# "10 CONSTANT indir# "20 CONSTANT disp# "40 CONSTANT count# "80 CONSTANT seg# "40 CONSTANT sign# : flag ( COMP: n -- RUN: -- flag ) CREATE C, DOES> C@ mode 1+ C@ AND ; word# flag word direc# flag direc addr# flag addr imm# flag imm indir# flag indir disp# flag disp count# flag count seg# flag seg sign# flag sign : S-REG ( COMP: n1 -- RUN: -- n2 ) CREATE 8 + C, DOES> C@ seg# SET-FLAG ; 0 S-REG ES 1 S-REG CS 2 S-REG SS 3 S-REG DS --> ( 8086 ASSEMBLER 06/07/84 ) : BYTE ( -- ) word# CLR-FLAG ; RE- : # ( -- ) imm# SET-FLAG DUP IN-RANGE? IF sign# SET-FLAG THEN ; : #A ( -- n ) addr# SET-FLAG "3F AND-MODE "06 OR-MODE "FFFF ; : ) ( n1 -- n2) indir# SET-FLAG "3F AND-MODE "E000 OR ; : reg) ( COMP: n -- RUN: -- n ) CREATE "E000 OR , DOES> disp# SET-FLAG "BF AND-MODE @ ; 3 CONSTANT W 5 CONSTANT R 6 RE- CONSTANT I W reg) 3) R reg) 5) I reg) 6) 7 reg) 7) W reg) W) R reg) R) I reg) I) 4 CONSTANT S --> ( 8086 ASSEMBLER 04/06/84 ) : L ( n1 -- n2 ) DUP 4 U< IF BYTE ELSE . 1 ABORT" BAD-L/H" THEN ; : H ( n1 -- n2 ) L 4 + ; : (CL) ( -- ) count# SET-FLAG ; ( For Shifts & Rots ) : (DX) ( -- ) (CL) ; ( For IN, & OUT, ) : REL ( -- ) direc# SET-FLAG ; ( For CALL, & JMP, ) : FAR ( -- ) seg# SET-FLAG ; ( For CALL, & JMP, ) : B? ( n1 -- n2 ) word 0= IF 1 CLR THEN ; : V? ( n1 -- n2 ) count IF 2 OR THEN ; : D? ( n1 -- n2 ) direc IF 2 OR THEN ; : D/? ( n1 -- n2 ) direc 0= IF 2 OR THEN ; : S? ( n1 -- n2 ) sign IF 2 OR THEN ; --> ( 8086 ASSEMBLER 09/24/83 ) : DO-REG ( n -- ) DUP 8 U< IF OR-MODE ELSE . 1 ABORT" Bad R/M#" THEN ; : DO-MEM ( n -- ) INDIR-REG? IF 3 OVER = IF 7 ELSE 5 OVER = IF 6 ELSE 6 OVER = IF 4 ELSE 7 OVER = IF 5 ELSE 9 - DUP THEN THEN THEN THEN SWAP DROP OR-MODE ELSE . 1 ABORT" Bad M/R#" THEN ; : SET-R/M ( n -- ) REG? IF DO-REG ELSE DO-MEM THEN ; : SET-REG ( n1 n2 -- ) seg IF 8 CLR 4 ELSE 8 THEN OVER SWAP U< IF 8 * OR-MODE ELSE . 1 ABORT" Bad REG#" THEN ; --> ( 8086 ASSEMBLER 09/24/82 ) : R/M-DIRECT ( S a F or a F D -- a S/D ) DUP "FFFF = IF ( S a F - ) DROP SWAP ELSE ( a F D - ) SWAP DROP direc# SET-FLAG THEN ; : R/M-DISPLACE ( S d D or d S D -- d D S or d S D ) DUP "8000 AND IF ( S d D - ) "FF AND ROT SWAP ELSE ( d S D - ) SWAP "FF AND direc# SET-FLAG THEN ; : R/M-INDIRECT ( S D -- S D or D S ) DUP "8000 AND IF "FF AND ELSE SWAP "FF AND direc# SET-FLAG THEN ; --> ( 8086 ASSEMBLER 12/24/82 ) : REG-R/M ( T10 ) ( X n -- Y n ) >R addr IF ( direct ) R/M-DIRECT ELSE ( r - r/m ) disp IF ( displacement ) R/M-DISPLACE ELSE ( indirect or ) indir IF ( reg. to reg. ) R/M-INDIRECT THEN THEN SET-R/M THEN SET-REG R> ; : OP-R/M ( T9 ) ( X n -- Y ) OR-MODE ( SET-OP ) addr IF ( direct ) DROP ( FFFF ) ELSE ( r - r/m ) "FF AND SET-R/M THEN ; --> ( 8086 ASSEMBLER 09/24/83 ) : MODE, ( X n -- ) mode C@ disp IF OVER IN-RANGE? IF "40 ELSE ( 01 ) 00 THEN ( 10 ) - C, DUP IN-RANGE? IF C, ELSE , THEN ELSE indir IF ( 00 ) DUP 7 AND 6 = IF ( and r/m6 ) "40 OR C, 0 C, ELSE ( force 01 ) C, THEN ELSE ( 00 ) C, THEN ( 11 ) addr IF , THEN THEN ; --> ( 8086 ASSEMBLER 09/24/83 ) : DATA, ( n -- ) word IF sign IF C, ELSE , THEN ELSE C, THEN ; : IMM, ( X n -- ) OP-R/M MODE, word IF , ELSE C, THEN ; : A-IMM, ( n1 0 n2 n3 -- ) OR B? C, DROP word IF , ELSE C, THEN ; : B-OFFSET, ( n -- ) HERE 1+ - DUP IN-RANGE? IF C, ELSE . 1 ABORT" RANGE-ERR" THEN ; : W-OFFSET, ( n -- ) HERE 2+ - , ; : OC, ( n -- ) 8 * C, ; --> ( 8086 ASSEMBLER 09/24/82 ) : ADDR, ( S D -- ) R/M-DIRECT ?DUP IF SET-REG "89 B? D? C, mode C@ C, ELSE "A1 B? D/? C, THEN , ; : SEG-R/M ( X n -- Y n ) word IF REG? IF OVER 8 AND IF >R SWAP R> direc# SET-FLAG THEN THEN REG-R/M ELSE . 1 ABORT" SEG-ERR" THEN ; : R-IMM, ( n D -- ) word IF "B8 ELSE "B0 THEN OR C, word IF , ELSE C, THEN ; --> ( 8086 ASSEMBLER 10/26/82 ) : T10 CREATE C, DOES> . 1 ABORT" ESC, not defined." ; : T11 CREATE C, DOES> C@ C, RESET ; ( ALL OTHER ) : T12 CREATE C, DOES> C@ C, "0A C, RESET ; ( AAD, AAM, ) ( CMPS, LODS, MOVS, STOS, ) : T13 CREATE C, DOES> C@ B? C, RESET ; ( JC, ie: Jump-on-condition ) : T14 CREATE C, DOES> C@ OVER "10 U< IF SWAP 1 XOR OR C, B-OFFSET, RESET ELSE . 1 ABORT" Cond-Err" THEN ; ( JCXZ, LOOP, LOOPE, LOOPNE, LOOPNZ, LOOPZ, ) : T15 CREATE C, DOES> C@ C, B-OFFSET, RESET ; ( DIV, IDIV, IMUL, MUL, NEG, NOT, ) : T16 CREATE OC, DOES> C@ "F7 B? C, OP-R/M MODE, RESET ; ( RCL, RCR, ROL, ROR, SAL, SAR, SHL, SHR, ) : T17 CREATE OC, DOES> C@ "D1 B? V? C, OP-R/M MODE, RESET ; --> ( 8086 ASSEMBLER 09/24/83 ) ( LDS, LEA, LES, ) : T18 CREATE C, DOES> C@ REG-R/M REG? direc 0= OR IF . 1 ABORT" MOD-ERR" ELSE C, MODE, THEN ( SEG, ) RESET ; : T19 CREATE C, DOES> C@ SWAP SET-REG mode C@ "18 AND OR C, RESET ; ( XCHG, ) : T21 CREATE DOES> DROP OVER 0= OVER 0= OR ( one is acc ) word AND REG? AND IF ( & word mode, & reg to reg ) ?DUP IF "90 OR C, DROP ELSE "90 OR C, THEN ELSE "87 REG-R/M B? C, MODE, THEN RESET ; --> ( 8086 ASSEMBLER 05/08/84 ) ( IN, OUT, ) : T22 CREATE C, DOES> C@ "E5 OR B? count IF 8 OR C, ELSE C, DUP "FF U> ABORT" I/O range err" C, THEN RESET ; ( INC, DEC, ) : T23 CREATE OC, DOES> C@ word REG? AND IF "40 OR OR C, ELSE "FF B? C, OP-R/M MODE, THEN RESET ; ( INT, ) : T24 CREATE C, DOES> C@ OVER 3 = IF 1- C, DROP ELSE C, C, THEN RESET ; --> ( 8086 ASSEMBLER 09/24/82 ) ( PUSH, POP, ) : T31 CREATE C, DOES> C@ seg IF "06 OR SWAP SET-REG mode C@ "18 AND OR C, ELSE word REG? AND IF "50 SWAP IF 8 OR THEN OR C, ELSE IF "00 "8F ELSE "30 "FF THEN C, OP-R/M MODE, THEN THEN RESET ; --> ( 8086 ASSEMBLER 09/24/83 ) ( ADC, ADD, CMP, SBB, SUB, ) : T32 CREATE OC, DOES> C@ imm IF OVER IF "81 B? S? C, OP-R/M MODE, DATA, ELSE "05 A-IMM, THEN ELSE "01 OR REG-R/M B? D? C, MODE, THEN RESET ; : T33 CREATE OC, DOES> C@ imm IF ( AND, OR, XOR, ) OVER IF "81 B? C, IMM, ELSE "05 A-IMM, THEN ELSE "01 OR REG-R/M B? D? C, MODE, THEN RESET ; --> ( 8086 ASSEMBLER 09/24/82 ) ( TEST, ) : T34 CREATE OC, DOES> C@ imm IF OVER IF "F7 B? C, IMM, ELSE "A9 A-IMM, THEN ELSE REG-R/M DROP "85 B? C, MODE, THEN RESET ; --> ( 8086 ASSEMBLER 04/21/84 ) ( CALL, ) : T41 CREATE OC, DOES> C@ direc IF DROP "E8 C, W-OFFSET, ELSE imm IF DROP "9A C, SWAP , , ELSE seg IF 8 OR THEN "FF C, OP-R/M MODE, THEN THEN RESET ; --> ( 8086 ASSEMBLER 04/21/82 ) ( JMP, ) : T42 CREATE OC, DOES> C@ direc IF DROP "E9 OVER IN-RANGE? IF 2 OR C, B-OFFSET, ELSE C, W-OFFSET, THEN ELSE imm IF DROP "EA C, SWAP , , ELSE seg IF 8 OR THEN "FF C, OP-R/M MODE, THEN THEN RESET ; ( RET, ) : T43 CREATE C, DOES> C@ seg IF 8 OR THEN imm IF 1 CLR THEN C, imm IF , THEN RESET ; -->( 8086 ASSEMBLER 09/24/82 ) ( MOV, ) : T51 CREATE OC, DOES> imm IF OVER "8000 AND IF "C7 B? C, C@ IMM, ELSE DROP R-IMM, THEN ELSE seg IF DROP "8C SEG-R/M D? C, MODE, ELSE addr IF DROP ADDR, ELSE REG-R/M DROP "89 B? D? C, MODE, THEN THEN THEN RESET ; --> ( 8086 ASSEMBLER 12/24/82 ) HEX 37 T11 AAA, 07 T32 CMP, CD T24 INT, E1 T15 LOOPE, D5 T12 AAD, A7 T13 CMPS, CE T11 INTO, E0 T15 LOOPNE, D4 T12 AAM, 99 T11 CWD, CF T11 IRET, E0 T15 LOOPNZ, 3F T11 AAS, 27 T11 DAA, E3 T15 JCXZ, E1 T15 LOOPZ, 02 T32 ADC, 2F T11 DAS, 04 T42 JMP, 00 T51 MOV, 00 T32 ADD, 01 T23 DEC, 70 T14 JC, A5 T13 MOVS, 04 T33 AND, 06 T16 DIV, 9F T11 LAHF, 04 T16 MUL, 02 T41 CALL, D8 T10 ESC, C5 T18 LDS, 03 T16 NEG, 98 T11 CBW, F4 T11 HLT, 8D T18 LEA, 90 T11 NOP, F8 T11 CLC, 07 T16 IDIV, C4 T18 LES, 02 T16 NOT, FC T11 CLD, 05 T16 IMUL, F0 T11 LOCK, 01 T33 OR, FA T11 CLI, 00 T22 IN, AD T13 LODS, 02 T22 OUT, F5 T11 CMC, 00 T23 INC, E2 T15 LOOP, 01 T31 POP, DECIMAL --> ( 8086 ASSEMBLER 07/07/87 ) HEX 9D T11 POPF, 9E T11 SAHF, 00 T34 TEST, 00 T31 PUSH, 04 T17 SAL, 9B T11 WAIT, 9C T11 PUSHF, 07 T17 SAR, T21 XCHG, 02 T17 RCL, 03 T32 SBB, D7 T11 XLAT, 03 T17 RCR, AF T13 SCAS, 06 T33 XOR, F3 T11 REP, 26 T19 SEG, F3 T11 REPE, 04 T17 SHL, F2 T11 REPNE, 05 T17 SHR, F2 T11 REPNZ, F9 T11 STC, F3 T11 REPZ, FD T11 STD, C3 T43 RET, FB T11 STI, 00 T17 ROL, AB T13 STOS, 01 T17 ROR, 05 T32 SUB, DECIMAL --> ( 8086 ASSEMBLER Additions 04/06/84 ) 0 CONSTANT AX 1 CONSTANT CX 2 CONSTANT DX 3 CONSTANT BX 4 CONSTANT SP 5 CONSTANT BP 6 CONSTANT SI 7 CONSTANT DI : XL CREATE , DOES> @ L ; : XH CREATE , DOES> @ H ; 0 XL AL 1 XL CL 2 XL DL 3 XL BL 0 XH AH 1 XH CH 2 XH DH 3 XH BH ( NOTE: BL is redefined! ) --> These additions are for those who like reg. names vs numbers. --> GmK ( 8086 ASSEMBLER Additions 02/20/87 ) : [r] CREATE , DOES> @ ) ; 3 [r] [BX] 5 [r] [BP] 6 [r] [SI] 7 [r] [DI] 9 [r] [BX+SI] 10 [r] [BX+DI] 11 [r] [BP+SI] 12 [r] [BP+DI] 3 reg) [BX+] 5 reg) [BP+] 6 reg) [SI+] 7 reg) [DI+] 9 reg) [BX+SI+] 10 reg) [BX+DI+] 11 reg) [BP+SI+] 12 reg) [BP+DI+] --> GmK ( ASSEMBLER 06/13/87 ) ALSO FORTH DEFINITIONS : SUB ( -- ) CREATE HIDE ALSO ASSEMBLER RESET DOES> ; : END-SUB ( -- ) REVEAL -ALSO ; : MACRO ( -- addr ) HEADER HIDE ['] : @ , ALSO ASSEMBLER RESET ] ; : END-MAC ( addr -- ) [COMPILE] ; -ALSO ; IMMEDIATE : CODE ( -- ) HEADER HERE 2+ , HIDE ALSO ASSEMBLER RESET ; 83STD : END-CODE ( -- ) REVEAL -ALSO ; 83STD : ;CODE ( -- ) COMPILE (;CODE) [COMPILE] [ ALSO ASSEMBLER RESET ; IMMEDIATE COMPILE-ONLY 83STD -ALSO DEFINITIONS --> GmK ( 8086 ASSEMBLER 09/24/83 ) : A-MSG . ." Bad-COND." WHERE ; \ 07/31/87 : IF, ( n -- a ) DUP "F U< IF "70 OR C, 0 C, HERE ELSE A-MSG THEN ; : ELSE, ( a1 -- a2 ) "EB C, 0 C, HERE OVER - DUP IN-RANGE? IF SWAP 1- C! HERE ELSE A-MSG THEN ; : THEN, ( a -- ) DUP HERE SWAP - DUP IN-RANGE? IF SWAP 1- C! ELSE A-MSG THEN ; : BEGIN, ( -- a ) HERE ; : WHILE, ( n -- a ) IF, ; : REPEAT, ( a a -- ) SWAP "EB C, HERE 1+ - C, THEN, ; : END, ( a n -- ) DUP "F U< IF "70 OR C, HERE 1+ - DUP IN-RANGE? IF C, ELSE A-MSG THEN ELSE A-MSG THEN ; : NEXT, ( -- ) RESET LODS, 0 W XCHG, W ) JMP, ; --> ( 8086 ASSEMBLER <LOAD THIS AS LAST ASM SCR !> 03/28/87 ) RE- : NOT 1 XOR ; 5 RE- CONSTANT = 5 RE- CONSTANT 0= "D RE- CONSTANT < "E RE- CONSTANT > 6 RE- CONSTANT U> 3 RE- CONSTANT U< 3 CONSTANT CY 8 CONSTANT POS 1 CONSTANT OVFLW "A CONSTANT PODD ( SYNTAX: = IF, < NOT END, etc. ) ONLY FORTH DEFINITIONS ALSO
