ProfitPress Mega CDROM2 Shareware Freeware (MSDOS)(1992)(Eng)

home *** CD-ROM | disk | FTP | other *** search

/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / PASM386C.ZIP / PASM386.SEQ < prev next >

Wrap

Text File | 1989-11-24 | 99.4 KB | 2,490 lines

\ PASM386.SEQ 8086/80286/80386 PreFix & PostFix Assembler - Version 1.4 \ PASM.SEQ PREFIX & POSTFIX assembler by Robert L. Smith & Tom Zimmer comment: An assembler for the 8086/8088 and the 80386/80386SX with both Prefix and Postfix syntax. The Intel 80286 offers little extra instruction which are useful for a Forth system. The 386/386SX (on the other hand) is a big step and does add capabilities which could be used in Forth - the least of which is 32-bit registers and operations which can be used to extend F-PC (F-TZ, etc.) into a 32 bit world. This is the reason PASM has been extended to create PASM386. The generated machine code was checked for compatability with MicroSoft's MASM 5.1 PASM386.SEQ Version 1.0 Supported - 286/386 unqiue instructions - Extended (32 bit) size registers and memory Not Supported - ENTER, LEAVE - Long (2 byte) offset conditional jumps - Extended (32 bit) addressing - MOV with CRx or DRx registers - Protected mode instructions in general Updated 17sep89, Gene Czarcinski - based on FTZ 3.x version: file dated 03/15/89 (compatible with OBESE) - change to inline NEXT - "cleanup" source (comments & form, NOT code), shuffle code around to "group better" and make it more readable (again, no code changes), add documentation from PASM.HLP (it was not HELP in any case), add more comments - First, fixup the basic 8086 assembler . have IN/OUT check operands . fix MOVS (did not use 1AMI), add SCAS and CMPS - add 386 "mode-code" - ASM.cpu Variable, etc. - redo segment overrides, add 386 support - Add structure for 386 registers and define the 386 regs - add 386 unique instructions and modify existing instructions to support 386 unique options (e.g., 32 bit operand size prefix) - Fix 9MIF for processing shift instructions (BUGFIX) -- it would NOT handle a memory address as the destination operand. This MAY cause compatibility problems (!) with code that wasn't correct anyway: ROL ax # 1 was valid, now it is NOT but: ROL WORD zzz # 1 did NOT work and now it does. - Oops, but it still does not work, for compatibility, do "swap" that was done before IF (and only if) DEST is NOT specified AND the SOURCE is a REG or INDEXED. PASM386.SEQ Version 1.1 Updated 30sep89, Gene Czarcinski - Add support for the 8087/80287/80387(sx) Numerical Processor ( based on the HFLOAT.SEQ code - Steve Pollack's ASM8087 with Mark Smiley's modes) -- Code "merged" into Pasm386. Pasm386.seq Version 1.2 Updated 30sep89, Gene Czarcinski - fix support for 386 "extended size" operands - FFs INC/DEC Pasm386.seq Version 1.3 Updated 25oct89, Gene Czarcinski - update to F-PC (F-TZ) 3.50 Level (some fixes, some new features/capabilities) . add support for /LISTING . use LOADLINE rather than ERRORLINE Pasm386.seq Version 1.4, updated 08nov89, Gene Czarcinski - merge help inline as comments and delete .HLP Overview PASM.SEQ is an assembler which is based on an assembler published in DDJ, February 1982 by Ray Duncan. That assembler was subsequently modified by Robert L. Smith to repair bugs, and support the Prefix assembler notation. I (Tom Zimmer) have made additional modifications to allow switching syntaxes, and to increase compatibility in POSTFIX mode with the F83 assembler. PREFIX or POSTFIX ? PASM supports dual syntaxes. The words PREFIX and POSTFIX switch between the two supported modes. The POSTFIX mode is VERY similar to F83's CPU8086 assembler. PREFIX mode which is the default mode, allows a syntax which is much closed to MASM. Macros in PASM Another area of interest is macros, here is the definition of the NEXT macro: : NEXT >PRE JMP >NEXT A; PRE> ; The macro itself is simply the sequence JMP >NEXT. The surrounding words are used for support. Since PASM supports both Sufix as well as Prefix notation, It is not know on entry to a macro what mode is selected. The words >PRE and PRE> select Prefix, and restore the previous mode so macros will always be in Prefix notation. The A; after >NEXT, forces the assembly of the JMP instruction before the mode switch. Why Dual Syntax The assembler supports Prefix syntax, in an attempt to provide a syntax which is more readable to programmers of other languages. It supports Postfix syntax to prevent alienating the established base of F83 users. The prefix notation is I think more readable, and certainly will be more familiar to programmers of other languages. Please consider writting any new assembly code you need in the Prefix mode. Syntax Comparison PREFIX POSTFIX MASM AAA AAA AAA ADC AX, SI SI AX ADC ADC AX,SI ADC DX, 0 [SI] 0 [SI] DX ADC ADC DX,0[SI] ADC 2 [BX+SI], DI DI 2 [BX+SI] ADC ADC 2[BX][SI],DI ADC MEM BX BX MEM #) ADC ADC MEM,BX ADC AL, # 5 5 # AL ADC ADC AL,5 AND AX, BX BX AX AND AND AX,BX AND CX, MEM CX MEM #) AND AND CX,MEM AND DL, # 3 3 # DL AND AND DL,3 CALL NAME NAME #) CALL CALL NAME CALL FAR [] NAME FAR [] NAME #) CALL ????? CMP DX, BX BX DX CMP CMP DX,BX CMP 2 [BP], SI SI 2 [BP] CMP CMP [BP+2],SI DEC BP BP DEC DEC BP DEC MEM MEM DEC DEC MEM DEC 3 [SI] 3 [SI] DEC DEC 3[SI] DIV CL CL DIV DIV CL DIV MEM MEM DIV DIV MEM IN PORT# WORD WORD PORT# IN IN AX,PORT# IN PORT# PORT# IN IN AL,PORT# IN AX, DX DX AX IN IN AX,DX INC MEM BYTE MEM INC INC MEM BYTE INC MEM WORD MEM #) INC INC MEM WORD INT 16 16 INT INT 16 JA NAME NAME JA JA NAME JNBE NAME NAME #) JNBE JNBE NAME JMP NAME NAME #) JMP JMP LODSW AX LODS LODS WORD LODSB AL LODS LODS BYTE LOOP NAME NAME #) LOOP LOOP NAME MOV AX, BX BX AX MOV MOV AX,BX MOV AH, AL AL AH MOV MOV AH,AL MOV BP, 0 [BX] 0 [BX] BP MOV MOV BP,0[BX] MOV ES: BP, SI ES: BP SI MOV MOV ES:BP,SI MOVSW AX MOVS MOVS WORD POP DX DX POP POP DX POPF POPF POPF PUSH SI SI PUSH PUSH SI REP REP REP RET RET RET ROL AX, # 1 AX ROL ROL AX,1 ROL AX, CL AX CL ROL ROL AX,CL SHL AX, # 1 AX SHL SHL AX,1 XCHG AX, BP BP AX XCHG XCHG AX,BP XOR CX, DX DX, CX XOR XOR CX,DX PASM defaults to Prefix notation, but can be switched to F83 style Postfix notation with the word POSTFIX. To revert back to Prefix notation, use PREFIX. See the file ASSEM.TXT for a further description of the syntax. Some comments about the Internals of the Assembler ================================================== 1. Although this was originally based on Duncan's 8086 assembler, Robert L. Smith and Tom Zimmer have modified this assembler to handle PREFIX notation. This version is highly dependent in Zimmer's Forth (F-PC, F-TZ, etc.). It is interesting to note how much of Duncan's original assembler still exists in this package. In fact, this assembler seems to be closer to Duncan's original than assembler in Laxon&Perry's F83. 2. This assembler depends on the Kernel functions: RUN, DEFER, CREATE, and DOES> for its functioning. DEFER is used (among other things) to provide the hooks for the meta-compilation process. CREATE and DOES> provide the capability to create the defining words which define the instructions as well as the register notations. RUN and DEFER are used to create the capability to handle the PREFIX notation. 3. The Local Labels, Inline-NEXT, and INLINE code functions are built on top of the basic assembler. 4. The register operand functions define a set of words which use the register names as the definition names. At run-time, these definitions store values into a set of variables to indicate what registers have been specified and what their order was. These information is used to complete the instruction at "instruction build" time. 5. The basic process of the assembler uses the CREATE DOES> construct to create the code to handle both the register definitions and the instruction definitions. Each set of registers or instructions are grouped into categories and a defining word is created for each category. These defining words create the definitions (one for each register specification or instruction) which (at run-time) creates the code which is the equivalent instruction. My, how powerful this is in that the whole assembler is created using only FORTH (no CODE definitions). 6. The original POSTFIX format process is fairly easy to understand. A defining word is created for each instruction category. This word contains the fixed (e.g., opcode) portion of the instruction as data in the CREATE part of the defining word (the address of this data is passed to the run-time or DOES> code). Immediate data or the addresses of VARIABLEs are placed on the stack. The register functions set other (internal) variables to values which indicate the register, register size, etc. The register specifications, immediate data, addresses, etc. must be place before the instruction. When the instruction-word is executed, it uses the data from the stack or internal variables together with the pre-compiled "opcode" data to assemble the instruction into memory. 7. The new PREFIX format modifies the process slightly - the instruction-word now occurs BEFORE the operand information. To accomodate this format, the instruction-word saves the address of passed data and the address of a subroutine to build the instruction into a special (internal) variable: APRIOR. Execution of the save information is executed at a deferred time - this time can be when the next assembly instruction mnemonic occurs, when the END-CODE function is executed or at the end of a physical line. At the "deferred time", the instruction has all of the information necessary to build the correct code. comment; ONLY FORTH ALSO DEFINITIONS 0 VALUE ?LISTING 0 VALUE LRUNSAVE 0 VALUE LINESTRT DEFER LIHERE ' HERE IS LIHERE DEFER LIC@ ' C@ IS LIC@ : <LRUN> ( -- ) LIHERE =: LINESTRT <RUN> BASE @ >R HEX CR LINESTRT 4 U.R SPACE LIHERE IF LINESTRT LIHERE OVER - 5 MIN BOUNDS ?DO I LIC@ 0 <# # # BL HOLD #> TYPE LOOP THEN 22 #OUT @ - SPACES TIB #TIB @ TYPE R> BASE ! ; : /LISTING ( -- ) \ Enable "listing" output when assembling/compiling ON> ?LISTING LRUNSAVE ABORT" Already LISTING!" @> RUN =: LRUNSAVE ['] <LRUN> IS RUN ; : /NOLISTING ( -- ) \ Disable "listing" output when assembling/compiling OFF> ?LISTING LRUNSAVE IS RUN OFF> LRUNSAVE ; DEFER .INST ' NOOP IS .INST ONLY FORTH ALSO ASSEMBLER DEFINITIONS ALSO 2VARIABLE APRIOR 4 ALLOT \ PREFIX's deferred-instruction save area ' DROP APRIOR ! ' DROP APRIOR 4 + ! : <A;!> ( A1 A2 --- ) \ Set up assembly instruction APRIOR 4 + 2! ; \ completion function : <A;> ( --- ) \ Completes the assembly of the previous instruction (used in \ INLINE coding). APRIOR 2@ EXECUTE \ perform assembly completion APRIOR 4 + 2@ APRIOR 2! \ SET UP FOR NEXT PREVIOUS ['] DROP APRIOR 4 + ! \ Make it not care if it is redone. .INST \ LIHERE =: LINESTRT ; : <RUN-A;> ( --- ) \ make sure we complete instruction ?LISTING IF LIHERE =: LINESTRT <RUN> <A;> BASE @ >R HEX CR LINESTRT 4 U.R SPACE LIHERE IF LINESTRT LIHERE OVER - 5 MIN BOUNDS ?DO I LIC@ 0 <# # # BL HOLD #> TYPE LOOP THEN 22 #OUT @ - SPACES TIB #TIB @ TYPE R> BASE ! ELSE <RUN> <A;> \ at the end of each line. THEN ; VARIABLE POSTVAR \ is this post fix notation? Variable ASM.cpu \ Determines Assembler Mode Variable ASM.warn \ Switch for warning messages ASM.warn off FORTH DEFINITIONS DEFER A;! ' <A;!> IS A;! DEFER A; ' <A;> IS A; \ Completes the assembly of the previous instruction (used in \ INLINE coding). DEFER RUN-A; ' <RUN-A;> IS RUN-A; : PREFIX ( --- ) \ Assert prefix mode for the following code definitions. ['] <A;!> IS A;! ['] <A;> IS A; ['] <RUN-A;> IS RUN-A; POSTVAR OFF ; : POSTFIX ( --- ) \ Assert posrfix mode for the following code definitions. ['] EXECUTE IS A;! ['] NOOP IS A; ['] <RUN> IS RUN-A; POSTVAR ON ; PREFIX \ Default is PREFIX assembler. : >PRE 2R> POSTVAR @ >R 2>R PREFIX ; \ SAVE AND SET PREFIX \ Restore the previously saved setting of prefix/postfix mode. : PRE> 2R> R> IF POSTFIX THEN 2>R ; \ RESTORE PREVIOUS FIX \ Save current prefix/postfix setting and set prefix mode. : ASM.8086 ( --- ) \ DEFAULT -- generate only 8086/8088 code ASM.cpu off ; : ASM.386 ( --- ) \ Generate 80386/80386SX code. This will also generate those \ instruction which only work on the 80286. ASM.cpu ON ; ASM.8086 \ default ASSEMBLER DEFINITIONS DEFER C, FORTH ' C, ASSEMBLER IS C, DEFER , FORTH ' , ASSEMBLER IS , DEFER HERE FORTH ' HERE ASSEMBLER IS HERE ' HERE IS LIHERE DEFER TC! FORTH ' C! ASSEMBLER IS TC! DEFER TC@ FORTH ' C@ ASSEMBLER IS TC@ ' TC@ IS LIC@ DEFER T! FORTH ' ! ASSEMBLER IS T! DEFER ?>MARK DEFER ?>RESOLVE DEFER ?<MARK DEFER ?<RESOLVE comment: The assembler contains the following routines for labels, with +/- 127 byte offsets. They are used as follows: CLEAR_LABELS \ Reset label mechanism SUB AX, AX JNE 2 $ \ Jump on not equal to label # 2 ... ... \ You can have up to 127 bytes between ... 2 $: MOV AX, BX \ Destination of labeled jump. A total of 32 short labels are currently supported. The assembler also supports ONE long label. Use L$ as follows: \ Usable with JMP or CALL JMP L$ \ Does a long jump to L$: ... ... \ A bunch of bytes occur between these ... \ instructions ... L$: MOV X, X \ Destination of long jump comment; \ =========================================================================== \ BEGIN LOCAL LABELS SECTION: \ =========================================================================== \ "max-llabs" defines the maximum number of local labels \ allowed (per CODE word or LABEL word). The labels may be \ any of the values 0, 1, ..., (max-llabs - 1) $20 value max-llabs 5 value b/llab false value ll-global? \ are local labels available globally? \ The local label table consists of one line per entry. \ Each line consists of: \ \ 1. The label dictionary location, ( 2 bytes) \ \ 2. a pointer to the location of the first forward \ reference (if any), and ( 2 bytes) \ \ 3. an "ever referenced?" flag. ( 1 byte ) create %llab[] max-llabs b/llab * allot %llab[] value llab[] \ default to %llab[] array \ This flag is set if local labels are ever used (i.e., the \ "$" or the "$:" word is used within a CODE word or a LABEL \ word). The idea is simply to add a smidgen more time to the \ "$" and "$:" words to save time later when checking for \ local label errors when END-CODE is called. false value ll-used? : llab-init ( -- ) \ Clear the local label mechanism to a clean or unused state in \ preparation for using local labels. This word need only be \ used in the GLOBAL_REFS mode. In LOCAL_REFS mode, the \ CLEAR_LABELS function is performed automatically. llab[] max-llabs b/llab * erase false !> ll-used? ; ' LLAB-INIT ALIAS CLEAR_LABELS headerless \ *************************************************** \ Given a label number, returns pointer to line in table. \ Aborts if label out of range. : llab>line ( n -- ^line ) dup max-llabs 1- u> abort" Bad Label" b/llab * llab[] + ; \ Translates a label reference to the appropriate dictionary \ location and sets the "ever referenced?" flag. \ \ If the reference is a forward reference, then a linked list \ of the forward references themselves is built using the \ dictionary byte locations where the jump offsets are \ "compiled". The reason for using this technique at all is \ that it allows an arbitrary number of forward references per \ label to be made (within the jump offset limitations of \ course) and that it requires table space only for the linked \ list head pointer. The technique is eloquent if convoluted \ and, as a minimum, needs explanation. headers \ *************************************************** : $ ( n1 -- n2 ) true !> ll-used? \ set "labels used?" flag llab>line 1 over 4 + c! \ set "ever referenced?" flag dup @ IF \ if the label is already defined: @ \ then return it for resolution ELSE \ otherwise: 2+ \ move to head of list pointer dup @ >r \ save old head of list on rstack here swap ! \ set new head of list r> \ retrieve old head of list dup 0= IF \ if list is empty: here + \ pass current dictionary location THEN \ end-if THEN ; \ end-if headerless \ *************************************************** \ Resolves all local label forward references for a given \ label. : >res ( ^line -- ) 2+ @ dup 0= IF \ if nothing to resolve drop exit \ then exit THEN 1+ BEGIN \ stack contains directory address of \ displacement to be resolved dup TC@ >r \ save link for now -- 3.50 here over - 1- \ calculate displacement dup $7f > abort" Branch out of range" over TC! \ and put in jump instruction -- 3.50 r> \ now ready for next link $fe over <> WHILE \ $fe value signifies end of list $ff00 or \ sign extend since link is backward + 2+ \ now move to next item on list REPEAT 2drop ; : $:f ( n -- ) \ defines a local label true !> ll-used? \ set "labels used?" flag llab>line dup @ 0<> abort" Label can't be multiply defined" dup >res \ resolve forward references if needed here swap ! ; \ and set label for subsequent refs headers \ *************************************************** : $: ( n -- ) \ allow use as prefix/postfix ['] $:f a;! a; ; headerless \ *************************************************** : _ll-errs? ( -- ) \ final error checking for local labels false max-llabs 0 DO \ check each label i b/llab * llab[] + dup 4 + c@ 0<> IF \ if jumps to label @ 0= IF \ and no label to jump to cr ." jump(s) to label " i . ." and label not defined" drop true \ set error flag THEN ELSE \ if no jumps to label @ 0<> IF \ and label defined cr ." warning - label " i . ." defined, but no jumps to it" THEN THEN LOOP IF abort THEN ; \ abort if fatal error : ll-errs? ( -- ) \ final error checking for local labels ll-used? IF _ll-errs? THEN ; \ =========================================================================== \ END LOCAL LABELS SECTION: \ =========================================================================== headers \ *************************************************** : L$ ( --- a1 ) \ Pass a1 to L$: 0 A; HERE ; : L$: ( a1 --- ) \ a1 = addr passed by L$ A; HERE OVER - SWAP 2- T! ; \ =========================================================================== \ End of Local Label definitions \ =========================================================================== FORTH DEFINITIONS headerless \ *************************************************** ' <RUN> VALUE ARUNSAVE \ -- 3.50 : DOASSEM ( --- ) @> RUN =: ARUNSAVE \ -- 3.50 ['] RUN-A; IS RUN 0 ['] DROP A;! APRIOR 4 + 2@ APRIOR 2! LIHERE =: LINESTRT \ -- 3.50 ll-global? 0= if llab-init \ in case labels used then ALSO ASSEMBLER ; ' DOASSEM IS SETASSEM headers \ *************************************************** : LOCAL_REF ( --- ) \ Set the mode so that local labels will NOT cross CODE word \ boundaries. The local label mechanism is cleared each time \ a new CODE word is started. This is the default mode. OFF> LL-GLOBAL? ; LOCAL_REF \ default to LOCAL references only : GLOBAL_REF ( --- ) \ Set the mode so that local labels can cross CODE definition \ boundaries. All local label definitions will be available \ and the mechanism is NOT reset at the beginning of a CODE \ definition. The local label mechanism must be reset with \ the CLEAR_LABELS function before using this mode. ON> LL-GLOBAL? ; : LABEL ( NAME --- ) \ Really just a constant addr \ Start an assembly routine or mark the current code address \ to be referenced later. SETASSEM CREATE ; : CODE ( NAME --- ) \ Define "name" as a new code definition. Assembly language \ follows, terminated by END-CODE. LABEL -3 DP +! HIDE ; ASSEMBLER DEFINITIONS : END-CODE \ Terminates CODE definitions. ll-global? 0= if ll-errs? \ check for local label errors then ARUNSAVE IS RUN \ -- 3.50 PREVIOUS A; REVEAL ; ' END-CODE ALIAS C; headerless \ *************************************************** \ =========================================================================== \ Errors detected during assembly, ABORT \ =========================================================================== : ERROR3 ( --- ) ['] DROP APRIOR 4 + ! \ Make it not care if it is redone. TRUE ABORT" Illegal Operand " ; : ERROR4 ( f1 --- ) IF ['] DROP APRIOR 4 + ! \ Make it not care if it is redone. TRUE ABORT" Illegal Operand Range" THEN ; : ERROR5 ( f1 --- ) IF ['] DROP APRIOR 4 + ! \ Make it not care if it is redone. TRUE ABORT" Illegal Operand Register" THEN ; : Error6 ( f --- ) \ Wrong Reg specified IF ['] DROP APRIOR 4 + ! \ Make it not care if it is redone. TRUE abort" Bad IN/OUT Register" THEN ; : ?ORDERERROR ( F1 --- ) IF ['] DROP APRIOR 4 + ! TRUE ABORT" Wrong Operand Order! " THEN ; : WarnMsg ( --- ) CR ." file=" .seqhandle ." at line " BASE @ Decimal LOADLINE @ U. Base ! CR ; : Chk.386 ( --- ) ASM.cpu @ not abort" Invalid Instruction/Operand" ; \ =========================================================================== \ =========================================================================== \ Functions, etc. to support Operands \ =========================================================================== \ =========================================================================== \ =========================================================================== \ Flags, Switches, etc. to define the operand \ \ For Width: 0=byte, 1=word, -1=Special \ =========================================================================== VARIABLE <TD> \ Destination Addressing Type VARIABLE <TS> \ Source Addressing Type VARIABLE <RD> \ Destination Register VARIABLE <RS> \ Source Register VARIABLE <W> \ Word/Byte Flag VARIABLE <WD> \ Destination Width (Word/Byte Flag) VARIABLE <WS> \ Source Width (Word/Byte Flag) VARIABLE <WD2> \ Destination Width (Word/Byte Flag) #2 VARIABLE <WS2> \ Source Width (Word/Byte Flag) #2 VARIABLE <OD> \ Destination Offset VARIABLE <OS> \ Source Offset VARIABLE <D> \ Direction Flag for R/M VARIABLE <FR> \ FAR Flag VARIABLE <ND> \ [] Indiect flag for Jump/Call VARIABLE <DST> \ Destination Processed Flag VARIABLE <SST> \ Source Processed Flag VARIABLE <ID> \ Immediate Data Flag VARIABLE <E> \ 386 Extended Processing Flag VARIABLE <ES> \ Source 386 Extended Processing Flag VARIABLE <ED> \ Destination 386 Extended Processing Flag VARIABLE <es2> \ Source 386 Extended Processing Flag #2 VARIABLE <ed2> \ Destination 386 Extended Processing Flag #2 Variable <I1> \ ... Temporary Storage for first 16 bits of immediate data Variable <I2> \ ... Temporary Storage for last 16 bits of immediate data (that is, 32 bit data) VARIABLE <FW> \ NPX ("F") word-type \ =========================================================================== \ Equates to Addressing Modes \ =========================================================================== 0 CONSTANT DIRECT 1 CONSTANT IMMED 2 CONSTANT REG8 3 CONSTANT REG16 4 CONSTANT INDEXED 5 CONSTANT SEGREG \ =========================================================================== \ Functions to Build and then Do Processing for Registers \ =========================================================================== : <SREG> ( A1 --- ) POSTVAR @ IF <DST> OFF \ Only reset dest if postfix THEN <SST> ON DUP C@ DUP $FF = IF DROP ELSE dup <ws2> ! DUP <W> ! <WS> ! THEN 1+ DUP C@ <TS> ! 1+ dup C@ <RS> ! 1+ C@ dup <ES> ! <es2> ! <TS> @ 4 = IF <OS> ! THEN ; : <DREG> ( A1 --- ) <DST> ON DUP C@ DUP $FF = IF DROP ELSE dup <wd2> ! DUP <W> ! <WD> ! THEN 1+ DUP C@ <TD> ! 1+ DUP C@ <RD> ! 1+ C@ dup <ED> ! <ed2> ! <TD> @ 4 = IF <OD> ! THEN ; \ Destination Register processing. : DREG CREATE C, C, C, C, \ Store input parameters DOES> POSTVAR @ IF <SREG> \ Source if PostFix ELSE <DREG> \ but Dest if PreFix THEN ; \ Source Register processing. : SREG CREATE C, C, C, C, \ store input parameters DOES> POSTVAR @ IF <SST> @ IF <DREG> \ if PostFix Mode & source defined, then dest \ (this provides F83 compatability) ELSE <SREG> \ else is source THEN ELSE <SREG> \ else is source THEN ; headers \ *************************************************** \ =========================================================================== \ Initialize all variables and flags \ =========================================================================== : RESET 0 <W> ! 0 <OS> ! 0 <RD> ! 0 <TD> ! 0 <TS> ! 0 <OD> ! 0 <D> ! 0 <WD> ! 0 <RS> ! 0 <FR> ! 0 <ND> ! 0 <E> ! 0 <ED> ! 0 <ES> ! 0 <es2> ! 0 <ed2> ! 0 <ws2> ! 0 <wd2> ! 0 <DST> ! 0 <SST> ! 0 <WS> ! 0 <ID> ! ; \ =========================================================================== \ Source Register Definitions \ =========================================================================== \ E Reg Type W Name 0 0 2 0 SREG AL \ Low Byte 0 1 2 0 SREG CL 0 2 2 0 SREG DL 0 3 2 0 SREG BL 0 4 2 0 SREG AH \ High Byte 0 5 2 0 SREG CH 0 6 2 0 SREG DH 0 7 2 0 SREG BH 0 0 3 1 SREG AX \ Full Word 0 1 3 1 SREG CX 0 2 3 1 SREG DX 0 3 3 1 SREG BX 0 4 3 1 SREG SP \ Ptr Regs 0 5 3 1 SREG BP ' BP ALIAS RP 0 6 3 1 SREG SI ' SI alias IP 0 7 3 1 SREG DI 3 0 3 1 SREG EAX \ 32 bit regs 3 1 3 1 SREG ECX 3 2 3 1 SREG EDX 3 3 3 1 SREG EBX 3 4 3 1 SREG ESP 3 5 3 1 SREG EBP 3 6 3 1 SREG ESI 3 7 3 1 SREG EDI 0 0 4 -1 SREG [BX+SI] \ Indirect/Indexed ' [BX+SI] alias [SI+BX] ' [BX+SI] alias [IP+BX] ' [BX+SI] alias [BX+IP] 0 1 4 -1 SREG [BX+DI] ' [BX+DI] alias [DI+BX] 0 2 4 -1 SREG [BP+SI] ' [BP+SI] ALIAS [SI+BP] ' [BP+SI] ALIAS [BP+IP] ' [BP+SI] ALIAS [RP+IP] ' [BP+SI] ALIAS [IP+BP] ' [BP+SI] ALIAS [IP+RP] 0 3 4 -1 SREG [BP+DI] ' [BP+DI] alias [DI+BP] ' [BP+DI] ALIAS [RP+DI] ' [BP+DI] ALIAS [DI+RP] 0 4 4 -1 SREG [SI] ' [SI] alias [IP] 0 5 4 -1 SREG [DI] 0 6 4 -1 SREG [BP] ' [BP] ALIAS [RP] 0 7 4 -1 SREG [BX] 0 0 5 -1 SREG ES \ Segment Regs 0 1 5 -1 SREG CS 0 2 5 -1 SREG SS 0 3 5 -1 SREG DS 9 4 5 -1 SREG FS \ 386 Extra Seg Regs 9 5 5 -1 SREG GS 0 0 6 1 SREG ST 0 0 6 1 SREG ST0 0 0 6 1 SREG ST(0) 0 1 6 1 SREG ST1 0 1 6 1 SREG ST(1) 0 2 6 1 SREG ST2 0 2 6 1 SREG ST(2) 0 3 6 1 SREG ST3 0 3 6 1 SREG ST(3) 0 4 6 1 SREG ST4 0 4 6 1 SREG ST(4) 0 5 6 1 SREG ST5 0 5 6 1 SREG ST(5) 0 6 6 1 SREG ST6 0 6 6 1 SREG ST(6) 0 7 6 1 SREG ST7 0 7 6 1 SREG ST(7) \ =========================================================================== \ Destination Register Definitions \ - Note the comma after the register specification. \ =========================================================================== \ E Reg Type W Name 0 0 2 0 DREG AL, \ Low Byte 0 1 2 0 DREG CL, 0 2 2 0 DREG DL, 0 3 2 0 DREG BL, 0 4 2 0 DREG AH, \ High Byte 0 5 2 0 DREG CH, 0 6 2 0 DREG DH, 0 7 2 0 DREG BH, 0 0 3 1 DREG AX, \ Full Word 0 1 3 1 DREG CX, 0 2 3 1 DREG DX, 0 3 3 1 DREG BX, 0 4 3 1 DREG SP, \ Ptr Regs 0 5 3 1 DREG BP, ' BP, ALIAS RP, 0 6 3 1 DREG SI, ' SI, ALIAS IP, 0 7 3 1 DREG DI, 3 0 3 1 DREG EAX, \ 32 bit regs 3 1 3 1 DREG ECX, 3 2 3 1 DREG EDX, 3 3 3 1 DREG EBX, 3 4 3 1 DREG ESP, 3 5 3 1 DREG EBP, 3 6 3 1 DREG ESI, 3 7 3 1 DREG EDI, 0 0 4 -1 DREG [BX+SI], \ Indirect/Indexed ' [BX+SI], alias [SI+BX], ' [BX+SI], alias [BX+IP], ' [BX+SI], alias [IP+BX], 0 1 4 -1 DREG [BX+DI], ' [BX+DI], alias [DI+BX], 0 2 4 -1 DREG [BP+SI], ' [BP+SI], alias [SI+BP], ' [BP+SI], alias [BP+IP], ' [BP+SI], alias [IP+BP], 0 3 4 -1 DREG [BP+DI], ' [BP+DI], alias [DI+BP], 0 4 4 -1 DREG [SI], ' [SI], ALIAS [IP], 0 5 4 -1 DREG [DI], 0 6 4 -1 DREG [BP], ' [BP], ALIAS [RP], 0 7 4 -1 DREG [BX], 0 0 5 -1 DREG ES, \ Segment Regs 0 1 5 -1 DREG CS, 0 2 5 -1 DREG SS, 0 3 5 -1 DREG DS, 9 4 5 -1 DREG FS, \ 386 extra seg regs 9 5 5 -1 DREG GS, 0 0 6 1 DREG ST, 0 0 6 1 DREG ST0, 0 0 6 1 DREG ST(0), 0 1 6 1 DREG ST1, 0 1 6 1 DREG ST(1), 0 2 6 1 DREG ST2, 0 2 6 1 DREG ST(2), 0 3 6 1 DREG ST3, 0 3 6 1 DREG ST(3), 0 4 6 1 DREG ST4, 0 4 6 1 DREG ST(4), 0 5 6 1 DREG ST5, 0 5 6 1 DREG ST(5), 0 6 6 1 DREG ST6, 0 6 6 1 DREG ST(6), 0 7 6 1 DREG ST7, 0 7 6 1 DREG ST(7), \ =========================================================================== \ \ =========================================================================== : WORD-TYPE CREATE C, DOES> C@ <FW> ! ; $01 WORD-TYPE REAL*4 $03 WORD-TYPE INTEGER*4 $2B WORD-TYPE TEMP_REAL $05 WORD-TYPE REAL*8 $07 WORD-TYPE INTEGER*2 $27 WORD-TYPE BCD $2F WORD-TYPE INTEGER*8 VARIABLE WAIT? WAIT? ON : NOWAIT WAIT? OFF ; headerless \ *************************************************** \ =========================================================================== \ Miscellaneous Operators \ =========================================================================== : TS@ <TS> @ ; \ fetch source addr type : TD@ <TD> @ ; \ fetch destination addr type : RD@ <RD> @ ; \ fetch destination register code : RS@ <RS> @ ; \ fetch source register code : ED@ <ED> @ ; \ Fetch Destination Extended Mode : ES@ <ES> @ ; \ Fetch Source Extended Mode : +D <D> @ 2* + ; \ merge direction flag into opcode : +W <W> @ + ; \ fetch word/byte flag : +RD <RD> @ + ; \ merge destination register code : +RS <RS> @ + ; \ merge source register code : MOD1 $3F AND $40 OR ; \ set mod field to 01 : MOD2 $3F AND $80 OR ; \ set mod field to 10 : MOD3 $3F AND $C0 OR ; \ set mod field to 11 : RS0 <RS> @ 8* ; : RSD RS0 +RD ; : MD, RS0 6 + C, ; : MS, RD@ 8* 6 + C, ; : RDS RD@ 8* +RS ; : CXD, C@ MOD3 +RD C, ; : CXS, C@ MOD3 +RS C, ; \ =========================================================================== \ Generate Prefix Byte for 386 32-bit Operand Size \ =========================================================================== : ESprefix ( n1 -- ) 3 = IF Chk.386 $66 C, 1 <W> ! THEN ; \ =========================================================================== \ Operand Functions \ =========================================================================== : D>S ( --- ) \ Move destination to source. <ED> @ <ES> ! <TD> @ <TS> ! <RD> @ <RS> ! <OD> @ <OS> ! ; : ?D>S ( --- ) \ Move Dest to Src if postfix <TS> @ 0= \ If no source specified POSTVAR @ 0<> AND \ and we are in postfix mode IF D>S \ Move destination to source THEN ; : ?D><S ( --- ) \ If no destinatiion specified <DST> @ IF \ yet, then swap source and dest. <TD> <TS> 2DUP @ SWAP @ ROT ! SWAP ! <RD> <RS> 2DUP @ SWAP @ ROT ! SWAP ! <OD> <OS> 2DUP @ SWAP @ ROT ! SWAP ! <ED> <ES> 2DUP @ SWAP @ ROT ! SWAP ! THEN <DST> OFF ; \ =========================================================================== \ Register Type Tests \ =========================================================================== : REG? REG8 OVER = SWAP REG16 = OR ; \ Test if this is regular reg : DREG? TD@ REG? ; \ do reg test for destination : ADREG? DREG? RD@ ( 3 AND ) 0= AND ; \ check if dest is AL or AX : ASREG? TS@ REG? RS@ ( 3 AND ) 0= AND ; \ check if source is AL or AX : SUBREG C@ $38 AND ; \ =========================================================================== \ Init. Direction Pointer \ =========================================================================== : DSET TS@ DUP INDEXED = SWAP DIRECT = OR NEGATE <D> ! ; \ =========================================================================== \ Calculate, Check, and Store 8-bit offset for Jumps, Loops, etc. \ =========================================================================== : OFFSET8, HERE 1+ - DUP ABS OVER 0< + $7F > Error4 C, ; \ =========================================================================== \ Calculate & Store 16-bit offset for Jumps, Loops, etc. \ =========================================================================== : OFFSET16, HERE 2+ - , ; \ =========================================================================== \ Calculate and store displacement for MEM/REG Instructions. \ =========================================================================== : DISP, <D> @ IF <OS> ELSE <OD> THEN @ DUP IF DUP ABS $7F > IF SWAP MOD2 C, , ELSE SWAP MOD1 C, C, THEN ELSE DROP DUP 7 AND 6 = IF MOD1 C, 0 THEN C, THEN ; \ =========================================================================== \ Calculate the M/R 2nd operator byte \ =========================================================================== : M/RS, $38 AND \ the REG part of ModRegR/M TS@ CASE DIRECT OF $06 + C, , ENDOF REG8 OF $C0 + +RS C, ENDOF REG16 OF $C0 + +RS C, ENDOF INDEXED OF <OS> @ 0= RS@ 6 <> AND IF +RS C, ELSE <OS> @ $80 + $100 U< IF $40 + +RS C, <OS> @ C, ELSE $80 + +RS C, <OS> @ , THEN THEN ENDOF ERROR3 drop ENDCASE ; : M/RD, D>S M/RS, ; \ Copy Dest to Source so ?/RS can process it : 8/16, <W> @ IF , ELSE C, THEN ; \ =========================================================================== \ Words to build the instructions: \ \ "Stack Pictures" \ \ ( A1 --- ) no operands \ ( A1 --- ) just register operands \ ( N1 A1 --- ) regs with immediate number operand \ ( A2 A1 --- ) memory operand \ ( A2 A1 --- ) memory and regs operands \ ( A2 N1 A1 --- ) memory and immediate number operands \ ( A2 N1 A1 --- ) memory, regs, and immediate number operands \ ( D1 A1 --- ) regs with immediate DOUBLE number (32 bit) \ ( A2 D1 A1 --- ) memory and immediate DOUBLE number (32 bits) \ ( A2 D1 A1 --- ) memory, regs, and immediate DOUBLE number (32 bits) \ \ A1 - points to the run-time op-code parameter list \ A2 - an operand (16 bit) memory address \ N1 - a 16 bit immediate data number \ D1 - a 32 bit immediate data double number \ \ =========================================================================== \ Single Byte Instruction -- NO operands : 1MIF ( A1 --- ) C@ C, RESET ; : 1MI CREATE C, DOES> ['] 1MIF A;! A; ; \ Conditional Jumps, Loops -- 1 byte plus 8-bit offset : 2MIF ( A1 --- ) C@ C, OFFSET8, RESET ; : 2MI CREATE C, DOES> ['] 2MIF A;! A; ; \ Special case single byte instruction for LODS AX, STOS AX, SCAS AX and CMPS AX : 3MIF ( A1 --- ) ES@ ESprefix \ 386 EAX C@ +W C, RESET ; : 3MI CREATE C, DOES> ['] 3MIF A;! A; ; \ IntraSegment Jump/Call -- 16-bit offset or reg/mem \ Intersegment Jump, Call -- via FAR [] structure : 5MIF ( A1 --- ) ?D>S TS@ CASE DIRECT OF <ND> @ IF $FF C, C@ <FR> @ IF 8 + THEN M/RS, ELSE <FR> @ IF 2+ C@ C, , , ELSE OVER HERE 3 + - $80 + $100 U< OVER C@ $20 = AND <WD> @ 0= AND IF DROP $EB C, OFFSET8, ELSE 1+ C@ C, OFFSET16, THEN THEN THEN ENDOF REG16 OF $FF C, CXS, ENDOF INDEXED OF DSET $FF C, C@ <FR> @ IF 8 + THEN +RS DISP, ENDOF ERROR3 ENDCASE RESET ; : 5MI CREATE C, C, C, DOES> ['] 5MIF A;! A; ; \ IN and OUT : 6MIF ( A1 --- ) DUP C@ 2 AND \ IN or OUT? IF <WS> @ \ This is an OUT rd@ td@ \ to check for DX Asreg? not Error6 \ source not AL or AX ADREG? ?ORDERERROR ELSE <WD> @ \ This is an IN rs@ ts@ \ to check for DX Adreg? not Error6 \ dest not AL or AX ASREG? ?ORDERERROR THEN <ID> @ \ WAS THERE IMMEDIATE DATA ? IF 2DROP \ DX check info SWAP C@ + ( +W ) C, \ yes, use it as port# dup $FF U> Error4 C, \ make sure data is OK ELSE REG16 = swap 2 = AND not Error6 \ make sure reg is DX SWAP 1+ C@ + ( +W ) C, \ no, DX contains port# THEN RESET ; : 6MI CREATE C, C, DOES> ['] 6MIF A;! A; ; \ Basic Arithmetic: ADC, ADD, SBB, SUB (1) \ Basic Logical: AND, OR, XOR (2) \ Basic Compare: CMP (1) \ Basic Test: TEST (2) \ \ NOTE: These instructions assume the immediate data is placed on the \ top-of-stack. When 7MIF is entered, any immediate data is \ "just behind" A1. This is true for both Prefix and Postfix modes. : 7MIF2 \ Register/Memory Operand C@ TS@ REG? IF \ NOT Immediate Data +W C, RS@ 8* M/RD, \ Op2 is register ELSE $84 \ Op2 is memory OVER - IF 2 OR THEN +W C, TD@ REG? IF RD@ 8* M/RS, ELSE ERROR3 THEN THEN ; : 7MIF3 \ Immed data Short Form with A-reg 2+ C@ +W C, TD@ REG8 = \ Yes, use short form IF <I1> @ C, \ One byte ELSE <I1> @ , \ two bytes ED@ 3 = IF <I2> @ , THEN \ four bytes THEN ; : 7MIF4 \ Immed data long form with reg/mem dup 3 + C@ CASE 1 OF \ ADC, ADD, SBB, SUB DUP 1+ C@ +W \ basic opcode <W> @ IF ED@ 3 = IF \ 32 bits Immed data C, \ basic opcode C@ M/RD, \ Instr type & ModRM <I1> @ , \ 16 bits of immediate data <I2> @ , \ 16 more for 32 total ELSE <I1> @ $80 + \ look for special case $100 U< IF 2 OR C, \ special case opcode C@ M/RD, \ instr + ModRM <I1> @ C, \ ** 1 byte data ELSE C, \ opcode C@ M/RD, \ instr + ModRM <I1> @ , \ 2 bytes data THEN THEN ELSE C, \ basic opcode C@ M/RD, \ Instr type & ModRM <I1> @ C, \ 8 bits of immediate data THEN ENDOF 2 OF \ AND, OR, XOR, CMP, TEST DUP 1+ C@ +W \ basic opcode <W> @ IF C, \ basic opcode C@ M/RD, \ Instr type & ModRM <I1> @ , \ 16 bits of immediate data ED@ 3 = IF \ total 32 bits <I2> @ , THEN ELSE C, \ basic opcode C@ M/RD, \ Instr type & ModRM <I1> @ C, \ 8 bits of immediate data THEN ENDOF ENDCASE ; : 7MIF ( A1 --- ) ES@ ED@ OR ESprefix \ E-mode if either source or dest TS@ IMMED = IF swap <I1> ! \ save the immediate data values ED@ 3 = IF swap <I2> ! THEN \ (including any 32 bit data) ADREG? IF \ Operand is Immediate data 7MIF3 \ Is EAX, AX or AL used? ELSE 7MIF4 \ Not AX or AL, use long form THEN ELSE \ No Immed data 7MIF2 THEN RESET ; : 7MI CREATE C, C, C, C, DOES> ['] 7MIF A;! A; ; \ DIV, IDIV, IMUL, MUL, NOT, NEG \ Only Register/Memory Format is supported \ with instr-code part of ModR/M byte : 8MIF ( A1 --- ) ?D>S ES@ ESprefix \ 386 extended regs DUP 1+ C@ +W C, \ opcode C@ M/RS, \ ModR/M with instr-code RESET ; : 8MI CREATE C, C, DOES> ['] 8MIF A;! A; ; \ Shift Rotate Instructions: ROL, ROR, RCL, RCR, SHL/SAL, SHR, SAR -- 16 & 32 bit \ \ The "source" operand should be CL or an immediate number \ (1 if 8086 or any number up to 31 if 386). : 9MIF2 TS@ 2 = RS@ 1 = AND IF \ Test if source is the CL reg 2+ C, \ set opcode C@ \ determines which instr. - ROL, RCL, etc. M/RD, \ set the ModR/M byte (with instr. code) exit THEN <id> @ 0= IF \ Old form -- for compatability ASM.warn @ IF cr ." Warning: Possible Immediate Error" WarnMsg THEN C, NIP \ old form, for compatability C@ \ determines which instr. - ROL, RCL, etc. M/RD, \ set the ModR/M byte (with instr. code) exit THEN <id> @ 0<> IF \ immediate number specified rot \ get the value of immediate dup 1 = IF \ check for special case of 1 drop \ trash the number 1 C, \ set opcode C@ \ determines which instr. - ROL, RCL, etc. M/RD, \ set the ModR/M byte (with instr. code) ELSE Chk.386 \ only valid for 386 <i1> ! \ save for later $C1 AND C, \ set opcode C@ M/RD, \ set ModR/M and instr. code <i1> @ C, \ and finally the immediate byte THEN exit THEN ERROR3 ; \ should not occur : 9MIF ( A1 --- ) <DST> @ 0= TS@ REG? TS@ INDEXED = OR AND IF 1 <DST> ! ?D><S 1 <TS> ! 1 <SST> ! 1 swap <W> @ <WD> ! ELSE POSTVAR @ IF \ If postfix, reverse ?D><S \ the operands <WS> @ <WD> ! \ Correct word mode THEN THEN ED@ ESprefix \ 32-bit reg prefix $D0 <WD> @ + \ get the basic opcode and merger in the word/byte bit 9MIF2 RESET ; : 9MI CREATE C, DOES> ['] 9MIF A;! A; ; \ Two Byte Instructions with NO operands -- AAD, AAM : 10MIF ( A1 --- ) DUP 1+ C@ C, C@ C, RESET ; : 10MI CREATE C, C, DOES> ['] 10MIF A;! A; ; \ DEC, INC : 11MIF ( A1 --- ) ?D>S \ make source & dest the same TS@ REG? <W> @ 0<> AND \ Determine if Word or Byte IF C@ +RS C, \ Word-Register, use short form ELSE \ use regular form ES@ ED@ or ESprefix \ 386 Extended mode Prefix $FE +W C, \ $FE for byte, $FF for word 1+ C@ \ next byte for modifier M/RS, \ then generate ModRM THEN RESET ; : 11MI CREATE C, C, DOES> ['] 11MIF A;! A; ; \ XCHG - this has only two forms: reg with accumulator \ reg with reg/memory : 13MIF ( A1 --- ) ES@ ED@ or ESprefix \ On 386 only, 32 bit operations DROP TS@ REG? TD@ REG? AND \ Both are registers RS@ 0= RD@ 0= OR AND \ Either register is AX <W> @ 1 = AND \ And it is AX not AL. IF \ Reg with assumulator RS@ 0= IF RD@ ELSE RS@ THEN $90 + C, \ Short opcode ELSE \ reg/Mem with register $86 +W TS@ REG? 0= IF TD@ REG? 0= IF ERROR3 ELSE C, RD@ 8* M/RS, THEN ELSE C, RS@ 8* M/RD, THEN THEN RESET ; : 13MI CREATE DOES> ['] 13MIF A;! A; ; \ 8086 Segment Control - LEA, LDS, LES : 14MIF ( A1 --- ) C@ C, TD@ REG? IF RD@ 8* M/RS, ELSE ERROR3 THEN RESET ; : 14MI CREATE C, DOES> ['] 14MIF A;! A; ; \ INT -- Int 3 is handled as a special case \ -- the numeric value of the interrupt is taken off the stack : 15MIF ( A1 --- ) DROP \ no parms passed dup $FF U> Error4 \ Validate Interrupt Number DUP 3 = \ check for Int 3 IF DROP $CC C, \ Special one-byte code for Int 3 ELSE $CD C, C, \ normal 2-byte code THEN RESET ; : 15MI CREATE DOES> ['] 15MIF A;! A; ; \ Segment override - do it now for PostFix or PreFix -- this is different so \ that it allows the segment override (e.g., ES:) to \ be placed anywhere in the instruction. For example, \ ES: ADD AX, [BX] \ and \ ADD ES: AX, [BX} \ are equivalent. : 30MI CREATE C, DOES> C@ C, ; \ 8086 version : 31MI CREATE C, DOES> chk.386 C@ C, ; \ 80386 version \ 386 Single Byte Instruction -- NO operands : 32MIF Chk.386 C@ C, RESET ; : 32MI CREATE C, DOES> ['] 32MIF A;! A; ; \ 386 Two Byte Instructions with NO operands : 33MIF Chk.386 DUP 1+ C@ C, C@ C, RESET ; : 33MI CREATE C, C, DOES> ['] 33MIF A;! A; ; \ 386 Segment Control - LFS, LGS, LSS : 34MIF Chk.386 DUP 1+ C@ C, C@ C, TD@ REG? IF RD@ 8* M/RS, ELSE ERROR3 THEN RESET ; : 34MI CREATE C, C, DOES> ['] 34MIF A;! A; ; \ PUSH : 35MIF ?D>S TS@ CASE SEGREG OF \ SEGMENT Reg ES@ 9 = IF DROP \ Test if 386 reg Chk.386 $0F C, \ First byte $80 RS@ 8* + C, ELSE \ 8086/386 Reg C@ RS@ 8* + C, THEN ENDOF REG16 OF \ 16 bit REGISTER ES@ ESprefix \ for 32 bit regs 1+ C@ +RS C, ENDOF REG8 OF ERROR3 \ 8 BIT ILLEGAL ENDOF IMMED OF Chk.386 \ Immediate Data OK for 386 drop \ ignore passed parms dup $ff > IF $68 C, , \ 2-bytes immediate data ELSE $6A C, C, \ 1-byte THEN ENDOF DROP 2+ C@ DUP C, \ Memory $30 AND M/RS, ENDCASE RESET ; : 35MI CREATE C, C, C, DOES> ['] 35MIF A;! A; ; \ POP : 36MIF ?D>S TS@ CASE SEGREG OF \ SEGMENT Reg ES@ 9 = IF DROP \ Test if 386 reg Chk.386 $0F C, \ First byte $81 RS@ 8* + C, ELSE \ 8086/386 Reg RS@ 1 = Error5 \ CS is invalid C@ RS@ 8* + C, THEN ENDOF REG16 OF \ 16 bit REGISTER ES@ ESprefix \ for 32 bit reg 1+ C@ +RS C, ENDOF REG8 OF ERROR3 \ 8 BIT ILLEGAL ENDOF IMMED OF Error3 \ Immediate Data Bad for POP ENDOF DROP 2+ C@ DUP C, \ Memory $30 AND M/RS, ENDCASE RESET ; : 36MI CREATE C, C, C, DOES> ['] 36MIF A;! A; ; \ The SETcc instructions : 37MIF Chk.386 \ 386 only ?D>S \ make source & dest the same TS@ REG16 <> <W> @ 0= AND \ 8-bit reg or memory operands only IF $0f C, C@ C, \ opcode 0 M/RS, \ then generate ModRM ELSE Error3 THEN RESET ; : 37MI CREATE C, DOES> ['] 37MIF A;! A; ; \ 386 Two Opcode plus ModRegR/M Byte : 38MIF Chk.386 ED@ ESprefix dup 1+ C@ C, C@ C, \ Opcode td@ reg16 = \ D must be reg16 IF rd@ 8* M/RS, ELSE Error5 THEN RESET ; : 38MI CREATE C, C, DOES> ['] 38MIF A;! A; ; \ Special case single byte instruction for 386 INS and OUTS : 39MIF Chk.386 ES@ ESprefix \ 386 EAX C@ +W C, RESET ; : 39MI CREATE C, DOES> ['] 39MIF A;! A; ; \ MOV -- reg/reg, reg/mem, or reg/immediate : 40MIF2 \ Actually generate code TD@ SEGREG = \ Dest is Seg Reg IF RD@ 1 = Error5 \ CS is not valid ED@ 0<> IF Chk.386 \ Make sure 386 is valid THEN $8E C, RD@ 8* M/RS, EXIT THEN TS@ SEGREG = \ Source is Seg Reg IF ED@ 0<> IF Chk.386 \ Make sure 386 is valid THEN $8C C, RS@ 8* M/RD, EXIT THEN TS@ IMMED = \ Dest Reg AND Immed TD@ REG? AND IF ED@ ESprefix $16 +W 8* +RD C, 8/16, ED@ 3 = IF , THEN \ 32 bits EXIT THEN TS@ 0= TD@ 0= OR \ Short form - ADREG? ASREG? OR \ Memory to/from Accumulator AND IF ES@ ED@ or ESprefix \ 386 32 bit Ac $A0 +W TS@ IF 2+ THEN \ Opcode C, \ set opcode , \ and address EXIT THEN TS@ IMMED = \ Immed to reg/mem IF postvar @ \ ***** 09/26/88 18:33:25.98 ******* ZIMMER *********** TD@ INDEXED <> AND IF swap <I1> ! \ save first 16 bits immed swap ELSE <I1> ! \ save first 16 bits immed THEN ED@ 3 = IF <I2> ! THEN \ save second 16 bits immed (32 total) ED@ ESprefix $C6 +W C, \ Opcode 0 M/RD, \ Reg/Mem dest <I1> @ 8/16, \ Set immediate data ED@ 3 = IF <I2> @ , THEN \ if extended, store 16 more bits EXIT THEN $88 +W \ Opcode for reg/mem TD@ REG? IF ED@ ESprefix 2+ C, \ memory to register RD@ 8* M/RS, EXIT THEN TS@ REG? IF ES@ ESprefix C, \ register to memory RS@ 8* M/RD, EXIT THEN ERROR3 ; \ Error if we get this far : 40MIF \ nest to use "EXIT" above DROP \ opcodes are inline 40MIF2 \ do-it RESET ; : 40MI CREATE DOES> ['] 40MIF A;! A; ; \ 386 Double Shift Instructions: SHLD and SHRD : 41MIF Chk.386 \ 386 only instruction ED@ ESprefix \ 32 bit operand regs TD@ REG8 = IF \ assume the source reg is right, # trashes <TS> Error5 THEN $0F C, \ 2-byte opcode C@ \ 2nd byte of op-code <ID> @ IF \ immediate 8-bit number C, \ set opcode <i1> ! \ save immediate number RS@ 8* M/RD, \ process ModRegR/M <i1> @ C, \ finally, set the immediate number ELSE \ uses CL reg (assumed if no immediate data) 1+ C, \ set opcode RS@ 8* M/RD, \ process ModRegR/M THEN RESET ; : 41MI CREATE C, DOES> ['] 41MIF A;! A; ; \ 386 Extended moves - move with extension - MOVSX and MOVZX \ \ Supported Forms: \ MOVSX AX, BL \ MOVSX AX, BX \ MOVSX EAX, BL \ MOVSX EAX, BX \ MOVSX AX, ZZZ \ word \ MOVSX AX, ZZZ BYTE \ byte \ MOVSX EAX, ZZZ \ word \ MOVSX EAX, ZZZ BYTE \ byte : 42MIF Chk.386 \ 386 only instruction <W> @ swap \ get width and save <ed2> @ ESprefix \ 32 bit operand regs TD@ REG8 = IF \ assume the source reg is right, # trashes <TS> Error5 THEN $0f C, \ set two-byte opcode C@ + C, RD@ 8* M/RS, \ set ModRegR/M byte RESET ; : 42MI CREATE C, DOES> ['] 42MIF A;! A; ; \ 386 Bit Test Instructions : 43MIF Chk.386 ED@ ESprefix $0f C, \ 2-byte Opcode <ID> @ 0<> IF swap <i1> ! dup 1+ C@ C, C@ M/RD, <i1> @ C, \ 8 bits of immediate data ELSE C@ C, RS@ 8* M/RD, THEN RESET ; : 43MI CREATE C, C, DOES> ['] 43MIF A;! A; ; \ =========================================================================== \ Numerical Processor Support \ =========================================================================== : COMP-WAIT \ The 8087 needs a WAIT inserted for synchronization \ and the 287/387 does not. ASM.cpu @ if exit then WAIT? @ IF $9B C, ( WAIT ) THEN WAIT? ON ; : ESC, ( n -- ) $D8 OR C, ; \ =========================================================================== : 1FPF COMP-WAIT DUP 1+ C@ ESC, C@ C, RESET ; : 1FP CREATE C, C, DOES> ['] 1FPF A;! A; ; : 2FPF COMP-WAIT DUP 1+ C@ ESC, C@ M/RS, RESET ; : 2FP CREATE C, C, DOES> ['] 2FPF A;! A; ; \ Fld, Fst, Fstp : 3FPF COMP-WAIT TS@ 6 = IF \ stack-reg specified DUP 1+ C@ ESC, C@ RS@ OR C, ELSE \ memory specified (need to check mem type) <FW> @ 7 AND ESC, <FW> @ $f8 AND 0= if \ regular real*4, real*8, int*2, int*4 2+ C@ M/RS, else 3 + C@ dup 0= if Error3 then <FW> @ $F8 AND OR M/RS, then THEN RESET ; : 3FP CREATE C, C, C, C, DOES> ['] 3FPF A;! A; ; : 4FPF COMP-WAIT DUP 1+ C@ ESC, C@ RS@ OR C, RESET ; : 4FP CREATE C, C, DOES> ['] 4FPF A;! A; ; : 5FPF COMP-WAIT 6 ESC, C@ RD@ OR C, RESET ; : 5FP CREATE C, DOES> ['] 5FPF A;! A; ; \ Fcom, Fcomp (similar to 7FP) : 6FPF COMP-WAIT TS@ 6 = IF \ stack-regs (only ST(i) is valid) 0 ESC, C@ RS@ OR C, ELSE \ for memory (Real*4, Real*8, Int*4, Int*2) <FW> @ 6 AND ESC, 1+ C@ M/RS, THEN RESET ; : 6FP CREATE C, C, DOES> ['] 6FPF A;! A; ; \ Fadd, Fmul, Fsub, Fsubr, Fdiv, Fdivr : 7FPF COMP-WAIT TS@ 6 = IF \ for stack-regs RD@ 0= IF 0 ESC, C@ RS@ OR C, ELSE 4 ESC, C@ RD@ OR C, THEN ELSE \ for memory (Real*4, Real*8, Int*4, Int*2) <FW> @ 6 AND ESC, 1+ C@ M/RS, THEN RESET ; : 7FP CREATE C, C, DOES> ['] 7FPF A;! A; ; : 8FPF Chk.386 DUP 1+ C@ ESC, C@ C, RESET ; : 8FP CREATE C, C, DOES> ['] 8FPF A;! A; ; : 9FPF Chk.386 DUP 1+ C@ ESC, C@ RS@ OR C, RESET ; : 9FP CREATE C, C, DOES> ['] 9FPF A;! A; ; headers \ *************************************************** \ =========================================================================== \ Now let's create the actual instructions. \ =========================================================================== \ Segment (prefix) Overrides $26 30MI ES: $2E 30MI CS: $36 30MI SS: $3E 30MI DS: $64 31MI FS: $65 31MI GS: $37 1MI AAA \ ASCII Adjust after Addition $D5 $0A 10MI AAD \ ASCII Adjust after Division $D4 $0A 10MI AAM \ ASCII Adjust after Multiplication $3F 1MI AAS \ ASCII Adjust after Subtraction $01 $14 $80 $10 7MI ADC \ Add with Carry $01 $04 $80 $00 7MI ADD \ Integer Addition $02 $24 $80 $20 7MI AND \ (logical) and $0F $BC 38MI BSF \ 386 Scan Bit Forward $0F $BD 38MI BSR \ 386 Scan Bit Reverse $BA $A3 43MI BT \ 386 Bit Test $BA $BB 43MI BTC \ 386 Bit Test and Complement $BA $B3 43MI BTR \ 386 Bit Test and Reset $BA $AB 43MI BTS \ 386 Bit Test and Set $9A $E8 $10 5MI CALL \ Call Procedure $98 1MI CBW \ Convert Byte to Word $F8 1MI CLC \ Clear Carry Flag $FC 1MI CLD \ Clear Direction Flag (increasing) $FA 1MI CLI \ Clear Interrupt Flag (Disable) $0F $06 33MI CLTS \ 386 Clear Task Switched Flag $F5 1MI CMC \ Complement Carry Flag $01 $3C $80 $38 7MI CMP \ Compare $A6 3MI CMPS \ Compare String $A6 1MI CMPSB \ Compare (byte) String $66 $A7 33MI CMPSD \ Compare (Dword) String $A7 1MI CMPSW \ Compare (word) String $99 1MI CWD \ Convert Word to Dword $27 1MI DAA \ Decimal Adjust after Addition $2F 1MI DAS \ Decimal Adjust after Subtraction $08 $48 11MI DEC \ Decrement $F6 $30 8MI DIV \ Unsigned divide 1 $F0 1FP F2XM1 \ x87 (2**x)-1 1 $E1 1FP FABS \ x87 absolute value 1 $E1 1FP FABS, \ x87 - for compatability $00 $C0 7FP FADD \ x87 Add (real/integer) $C0 5FP FADDP \ x87 Add Real and Pop 1 $E0 1FP FCHS \ x87 Change Sign 3 $E2 1FP FCLEX \ x87 Clear Exceptions $10 $D0 6FP FCOM \ x87 Compare (real/integer) $18 $D8 6FP FCOMP \ x87 Compare (real/integer and pop 6 $D9 1FP FCOMPP \ x87 Compare Real and Pop twice 1 $FF 8FP FCOS \ 387 Cosine of ST(0) 1 $F6 1FP FDECSTP \ x87 Decrement stack pointer 3 $E1 1FP FDISI \ 8087 DISABLE interrupts $30 $F0 7FP FDIV \ x87 Divide (real/integer) $F0 5FP FDIVP \ x87 Divide Real and Pop $38 $F8 7FP FDIVR \ x87 Divide (real/integer) REVERSE $F8 5FP FDIVRP \ x87 Divide Real Reverse and Pop 3 $E0 1FP FENI \ 8087 ENABLE interrupts 5 $C0 4FP FFREE \ x87 Free Register 1 $F7 1FP FINCSTP \ x87 Increment Stack pointer 3 $E3 1FP FINIT \ x87 Initialize Processor $20 $00 1 $C0 3FP FLD \ x87 Load (real/integer/bcd/temp_real) 1 $E8 1FP FLD1 \ x87 Load +1.0 1 $28 2FP FLDCW \ x87 Load control word 1 $20 2FP FLDENV \ x87 Load environment 1 $EA 1FP FLDL2E \ x87 Load LOG2(e) 1 $E9 1FP FLDL2T \ x87 Load LOG2(10) 1 $EC 1FP FLDLG2 \ x87 Load LOG10(2) 1 $ED 1FP FLDLN2 \ x87 Load LOGe(2) 1 $EB 1FP FLDPI \ x87 Load pi 1 $EE 1FP FLDZ \ x87 Load +0.0 $08 $C8 7FP FMUL \ x87 Multiply (real/integer) $C8 5FP FMULP \ x87 Multiply Real and Pop 1 $D0 1FP FNOP \ x87 no-operation 1 $F3 1FP FPATAN \ x87 Partial Arctangent 1 $F8 1FP FPREM \ x87 Partial Remainder 1 $F5 8FP FPREM1 \ 387 Partial Remainder 1 $F2 1FP FPTAN \ x87 Partial Tangent 1 $FC 1FP FRNDINT \ x87 Round to Integer 5 $20 2FP FRSTOR \ x87 Restore saved state 5 $30 2FP FSAVE \ x87 Save state 1 $FD 1FP FSCALE \ x87 Scale 1 $FE 8FP FSIN \ 387 Sine of ST(0) 1 $FB 8FP FSINCOS \ 387 Sine and Cosine of ST(0) 1 $FA 1FP FSQRT \ x87 Square root 1 $FA 1FP FSQRT, \ x87 -- for compat. $00 $10 5 $D0 3FP FST \ x87 Store (real/integer) 1 $38 2FP FSTCW \ x87 Store control word 1 $30 2FP FSTENV \ x87 Store environment $30 $18 5 $D8 3FP FSTP \ x87 Store (real/integer/BCD/temp_real) and Pop 5 $38 2FP FSTSW \ x87 Store status word $20 $E0 7FP FSUB \ x87 Subtract (real/integer) $E0 5FP FSUBP \ x87 Subtract real and pop $28 $E8 7FP FSUBR \ x87 Subtract (real/integer) REVERSE $E8 5FP FSUBRP \ x87 Subtract real reverse and Pop 1 $E4 1FP FTST \ x87 Test stack top against +0.0 5 $E0 9FP FUCOM \ 387 unordered compare 5 $E8 9FP FUCOMP \ 387 unordered compare and pop 2 $E9 8FP FUCOMPP \ 387 unordered Compare and Pop Twice 1 $E5 1FP FXAM \ x87 Examine stack top 1 $C8 4FP FXCH \ x87 Exchange registers 1 $F4 1FP FXTRACT \ x87 Extract exponent and significant 1 $F1 1FP FYL2X \ x87 Y*(LOG2(X)) 1 $F9 1FP FYL2XP1 \ x87 Y*(LOG2(X+1)) $F4 1MI HLT \ Halt Processor ! $F6 $38 8MI IDIV \ (integer) Signed Divide $F6 $28 8MI IMUL \ (integer) Signed Multiply $EC $E4 6MI IN \ Input from an I/O Port $00 $40 11MI INC \ Increment $6C 39MI INS \ 386 Input String - DX port $6C 32MI INSB \ 386 Input (byte) String - DX port $66 $6D 33MI INSD \ 386 Input (Dword) String - DX port $6D 32MI INSW \ 386 Input (word) String - DX port 15MI INT \ Call to Software-Interrupt Procedure $CE 1MI INTO \ On Overflow, call interrupt procedure $CF 1MI IRET \ Interrupt Return - restore 16 bit regs $66 $CF 33MI IRETD \ 386 Interrupt Return - restore 32 bit regs (protected mode) $77 2MI JA \ Jump if Above (CF=0 and ZF=0) $73 2MI JAE \ Jump if Above or Equal (CF=0) $72 2MI JB \ Jump if Below (CF=1) $76 2MI JBE \ Jump if Below or Equal (CF=1 or ZF=1) $72 2MI JC \ Jump if Carry (CF=1) $E3 2MI JCXZ \ Jump if CX Register is Zero $74 2MI JE \ Jump if Equal (ZF=1) $7F 2MI JG \ Jump if Greater (ZF=0 and SF=OF) $7D 2MI JGE \ Jump if Greater of Equal (SF=OF) $7C 2MI JL \ Jump if Less (SF<>OF) $7E 2MI JLE \ Jump if Less or Equal (ZF=1 or SF<>OF) $EA $E9 $20 5MI JMP \ Unconditional JUMP $76 2MI JNA \ Jump if Not Above (CF=1 and ZF=1) $72 2MI JNAE \ Jump if Not Above or Equal (CF=1) $73 2MI JNB \ Jump if Not Below (CF=0) $77 2MI JNBE \ Jump if Not Below or Equal (CF=0 and ZF=0) $73 2MI JNC \ Jump if Not Carry (CF=0) $75 2MI JNE \ Jump if Not Equal (ZF=0) $7E 2MI JNG \ Jump if Not Greater (ZF=1 or SF<>OF) $7C 2MI JNGE \ Jump if Not Greater or Equal (SF<>OF) $7D 2MI JNL \ Jump if Not Less (SF=OF) $7F 2MI JNLE \ Jump if Not Less or Equal (ZF=0 and SF=OF) $71 2MI JNO \ Jump if Not Overflow (OF=0) $7B 2MI JNP \ Jump if Not Parity (PF=0) $79 2MI JNS \ Jump if Not Sign (SF=0) $75 2MI JNZ \ Jump if Not Zero (ZF=0) $70 2MI JO \ Jump if Overflow (OF=1) $7A 2MI JP \ Jump if Parity (PF=1) $7A 2MI JPE \ Jump if Parity Even (PF=1) $7B 2MI JPO \ Jump if Parity Odd (PF=0) $78 2MI JS \ Jump if Sign (SF=1) $74 2MI JZ \ Jump if Zero (ZF=1) $9F 1MI LAHF \ Load Flags into AH register $C5 14MI LDS \ Load pointer into DS register $8D 14MI LEA \ Load Effective Address $C4 14MI LES \ Load pointer into ES register $0F $B4 34MI LFS \ 386 Segment Register Load $0F $B5 34MI LGS \ 386 Segment Register Load $F0 1MI LOCK \ Bus Lock $AC 3MI LODS \ Load String $AC 1MI LODSB \ Load (byte) String $66 $AD 33MI LODSD \ Load (Dword) String $AD 1MI LODSW \ Load (word) String $E2 2MI LOOP \ Loop with CX as counter $E1 2MI LOOPE \ Loop with CX as counter and Equal $E0 2MI LOOPNE \ Loop with CX as Counter and NOT Equal $E0 2MI LOOPNZ \ Loop with CX as Counter and NOT Zero $E1 2MI LOOPZ \ Loop with CX as Counter and Zero $0F $B2 34MI LSS \ 386 Segment Register Load 40MI MOV \ Move $A4 3MI MOVS \ Move String $A4 1MI MOVSB \ Move (byte) String $66 $A5 33MI MOVSD \ Move (Dword) String $A5 1MI MOVSW \ Move (word) String $BE 42MI MOVSX \ 386 move to reg with Sign Extension $B6 42MI MOVZX \ 386 move to reg with Zero Extension $F6 $20 8MI MUL \ Unsigned Multiply $F6 $18 8MI NEG \ Negate $90 1MI NOP \ No Operation $F6 $10 8MI NOT \ (Logical) Not $02 $0C $80 $08 7MI OR \ (logical) Or $EE $E6 6MI OUT \ Write to I/O Port $6E 39MI OUTS \ 386 Output String - DX port $6E 32MI OUTSB \ 386 Output (byte) String - DX port $66 $6F 33MI OUTSD \ 386 Output (Dword) String - DX port $6F 32MI OUTSW \ 386 Output (word) String - DX port $8F $58 $07 36MI POP \ Pop off Stack $61 32MI POPA \ 386 Pop All 16 bit Registers $66 $61 33MI POPAD \ 386 Pop All 32 bit Registers $9D 1MI POPF \ Pop Flags off Stack $66 $9D 33MI POPFD \ 386 Pop 32 bit Flags off Stack $FF $50 $06 35MI PUSH \ Push onto Stack $60 32MI PUSHA \ 386 Push All 16 bit Registers $66 $60 33MI PUSHAD \ 386 Push All 16 bit Registers $9C 1MI PUSHF \ Push Flags onto Stack $66 $9C 33MI PUSHFD \ 386 Push 32 bit Flags onto Stack $10 9MI RCL \ Rotate through Carry Left $18 9MI RCR \ Rotate through Carry Right $F3 1MI REP \ Repeat $F3 1MI REPE \ Repeat while Equal $F2 1MI REPNE \ Repeat while Not Equal $F2 1MI REPNZ \ Repeat while Not Zero $F3 1MI REPZ \ Repeat while Zero $C3 1MI RET \ Return from Procedure $CB 1MI RETF \ Return from Inter-Segment Procedure $00 9MI ROL \ Rotate Left $08 9MI ROR \ Rotate Right $9E 1MI SAHF \ Store AH into Flags $20 9MI SAL \ Shift Arithmetic Left $38 9MI SAR \ Shift Arithmetic Right $01 $1C $80 $18 7MI SBB \ Subtract with Borrow $AE 3MI SCAS \ Scan String $AE 1MI SCASB \ Scan (byte) String $66 $AF 33MI SCASD \ Scan (Dword) String $AF 1MI SCASW \ Scan (word) String $97 37MI SETA \ 386 SET if Above (CF=0 and ZF=0) $93 37MI SETAE \ 386 SET if Above or Equal (CF=0) $92 37MI SETB \ 386 SET if Below (CF=1) $96 37MI SETBE \ 386 SET if Below or Equal (CF=1 or ZF=1) $92 37MI SETC \ 386 SET if Carry (CF=1) $94 37MI SETE \ 386 SET if Equal (ZF=1) $9F 37MI SETG \ 386 SET if Greater (ZF=0 and SF=OF) $9D 37MI SETGE \ 386 SET if Greater of Equal (SF=OF) $9C 37MI SETL \ 386 SET if Less (SF<>OF) $9E 37MI SETLE \ 386 SET if Less or Equal (ZF=1 or SF<>OF) $96 37MI SETNA \ 386 SET if Not Above (CF=1 and ZF=1) $92 37MI SETNAE \ 386 SET if Not Above or Equal (CF=1) $93 37MI SETNB \ 386 SET if Not Below (CF=0) $97 37MI SETNBE \ 386 SET if Not Below or Equal (CF=0 and ZF=0) $93 37MI SETNC \ 386 SET if Not Carry (CF=0) $95 37MI SETNE \ 386 SET if Not Equal (ZF=0) $9E 37MI SETNG \ 386 SET if Not Greater (ZF=1 or SF<>OF) $9C 37MI SETNGE \ 386 SET if Not Greater or Equal (SF<>OF) $9D 37MI SETNL \ 386 SET if Not Less (SF=OF) $9F 37MI SETNLE \ 386 SET if Not Less or Equal (ZF=0 and SF=OF) $91 37MI SETNO \ 386 SET if Not Overflow (OF=0) $9B 37MI SETNP \ 386 SET if Not Parity (PF=0) $99 37MI SETNS \ 386 SET if Not Sign (SF=0) $95 37MI SETNZ \ 386 SET if Not Zero (ZF=0) $90 37MI SETO \ 386 SET if Overflow (OF=1) $9A 37MI SETP \ 386 SET if Parity (PF=1) $9A 37MI SETPE \ 386 SET if Parity Even (PF=1) $9B 37MI SETPO \ 386 SET if Parity Odd (PF=0) $98 37MI SETS \ 386 SET if Sign (SF=1) $94 37MI SETZ \ 386 SET if Zero (ZF=1) $20 9MI SHL \ Shift (logical) Left $A4 41MI SHLD \ 386 Shift Left Double $28 9MI SHR \ Shift (logical) Right $AC 41MI SHRD \ 386 Shift Right Double $F9 1MI STC \ Set Carry Flag $FD 1MI STD \ Set Direction Flag (decreasing) $FB 1MI STI \ Set Interrupt Flag (enable) $AA 3MI STOS \ Store String $AA 1MI STOSB \ Store (byte) String $66 $AB 33MI STOSD \ Store (Dword) String $AB 1MI STOSW \ Store (word) String $01 $2C $80 $28 7MI SUB \ Subtract $02 $A8 $F6 $84 7MI TEST \ Logical Compare $9B 1MI WAIT \ Wait for Coprocessor 13MI XCHG \ Exchange $D7 1MI XLAT \ Table Lookup Translation $02 $34 $80 $30 7MI XOR \ (logical) Exclusive Or \ =========================================================================== \ For Floating Point Processor \ =========================================================================== : WSS: ( -- ) WAIT SS: NOWAIT ; : WCS: ( -- ) WAIT CS: NOWAIT ; : WDS: ( -- ) WAIT DS: NOWAIT ; : WES: ( -- ) WAIT ES: NOWAIT ; \ =========================================================================== \ The jump mnemonics: \ =========================================================================== ' jmp alias j ( JMP ) ' jne alias j0<> ( JNE ) ' jz alias j0= ( JZ ) ' jns alias j0>= ( JNS ) ' js alias j0< ( JS ) ' jne alias j<> ( JNE ) ' jz alias j= ( JZ ) ' jnl alias j>= ( JNL ) ' jnge alias j< ( JNGE ) ' jnle alias j> ( JNLE ) ' jng alias j<= ( JNG ) ' jnc alias ju>= ( JNC ) ' jnae alias ju< ( JNAE ) ' jnbe alias ju> ( JNBE ) ' jna alias ju<= ( JNA ) \ =========================================================================== \ Operand Modifiers \ =========================================================================== : FAR 1 <FR> ! ; \ for intersegment jump/call : BYTE 0 <W> ! 0 <WD> ! 0 <ED> ! ; \ force byte size mode : WORD 1 <W> ! 1 <WD> ! 0 <ED> ! ; \ force word size mode : DWORD 1 <W> ! 1 <WD> ! 3 <ED> ! ; \ force Dword size mode : # 1 <TS> ! -1 <SST> ! 1 <ID> ! ; \ set immediate data flag \ to indicate immediate data \ is on the stack : #) ( ?D><S ) -1 <SST> ! \ Swap source and dest if no dest spec'ed. 1 <W> ! ; \ Default to word mode : [] 0 <W> ! 1 <ND> ! ; \ for indirect jump/call : 3* DUP 2* + ; \ *** Who knows what this is for, \ *** it is NOT used in the standard system. \ =========================================================================== \ MACROS for NEXT, 1PUSH, and 2PUSH. \ =========================================================================== VARIABLE INLN \ Flag to determine if we are compiling IN_LINE next. : INLINEON INLN ON ; \ turns generation of inline NEXT on. : INLINEOFF INLN OFF ; INLINEON \ Default to INLINE NEXT. \ turns generation of inline NEXT off. : NEXT ( -- ) >PRE INLN @ IF LODSW ES: JMP AX A; ELSE JMP >NEXT A; THEN PRE> ; : 1PUSH ( -- ) >PRE INLN @ IF PUSH AX LODSW ES: JMP AX A; ELSE JMP >NEXT 1- A; THEN PRE> ; : 2PUSH ( -- ) >PRE INLN @ IF PUSH DX PUSH AX LODSW ES: JMP AX A; ELSE JMP >NEXT 2- A; THEN PRE> ; \ =========================================================================== \ Control Constructs \ =========================================================================== headerless \ *************************************************** : A?>MARK ( -- f addr ) TRUE HERE 0 C, ; : A?>RESOLVE ( f addr -- ) HERE OVER 1+ - SWAP TC! ?CONDITION ; : A?<MARK ( -- f addr ) TRUE HERE ; : A?<RESOLVE ( f addr -- ) HERE 1+ - C, ?CONDITION ; ' A?>MARK ASSEMBLER IS ?>MARK ' A?>RESOLVE ASSEMBLER IS ?>RESOLVE ' A?<MARK ASSEMBLER IS ?<MARK ' A?<RESOLVE ASSEMBLER IS ?<RESOLVE headers \ *************************************************** $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> $70 CONSTANT OV<> $71 CONSTANT OV $E3 CONSTANT CX<>0 $7A CONSTANT PO $7B CONSTANT PE : BEGIN ( - a f ) A; ?<MARK ; : UNTIL ( a f n - ) >R A; R> C, ?<RESOLVE A; ; \ ** added A; : AGAIN ( a f - ) $EB UNTIL ; : IF ( n - A f ) >R A; R> C, ?>MARK A; ; \ ** added A; : FORWARD ( - A f ) $EB IF ; : THEN ( A f - ) A; ?>RESOLVE ; : AFT ( a f - a f A f ) 2DROP FORWARD BEGIN 2SWAP ; : ELSE ( A f - A f ) FORWARD 2SWAP THEN ; : REPEAT ( A f a f - ) A; AGAIN THEN ; : CONTINUE ( a f A f - a f ) 2OVER REPEAT ; : WHILE ( a f - A f a f ) IF 2SWAP ; \ =========================================================================== \ Functions to permit assembler code inside of a Colon Definition \ =========================================================================== FORTH DEFINITIONS : INLINE [COMPILE] [ SETASSEM HERE X, ; IMMEDIATE \ Starts an assembly language sequence in the middle of a : (colon) \ definition. Assembly code instructions follow until the sequence \ is terminated by END-INLINE. The sequence of assembly instructions \ normally includes NEXT, 1PUSH, or 2PUSH just prior to the word \ END-INLINE. ASSEMBLER DEFINITIONS : END-INLINE [ ASSEMBLER ] END-CODE ] ; \ Terminates a sequence of assembly instructions started with \ INLINE in the middle of a : (colon) definition. Compilation of \ the : (colon) definition resumes after END-INLINE is encountered COMMENT: \ Here is an example of how to use INLINE and END-INLINE to add \ assembly code in the middle of a CODE definition. : TEST ( --- ) 5 0 DO I INLINE pop ax add ax, # 23 1push END-INLINE . LOOP ; COMMENT; behead \ *************************************************** ONLY FORTH DEFINITIONS ALSO DECIMAL