\ KERNEL1.SEQ  Source code for KERNEL1.COM,   modified by Tom Zimmer

ONLY FORTH   META ALSO FORTH

FALSE   CONSTANT INLINE_NEXT    \ Enable Inline NEXT

: ?.INLINE      ( --- )         \ Print state of INLINE_NEXT
                CR ." NEXT is currently " INLINE_NEXT >REV
                IF      [ASSEMBLER] INLINEON  [FORTH]
                        ."  INLINE. "
                ELSE    [ASSEMBLER] INLINEOFF [FORTH]
                        ."  NOT " >NORM ."  INLINE. "
                THEN    >NORM CR ;
?.INLINE

   256 DP-T !           \ Set Dictionary pointer
     0 DP-X !           \ Set LIST DP

HERE   10000 + ' TARGET-ORIGIN >BODY !

IN-META

: ]]   ]   ;
: [[   [COMPILE] [   ; FORTH IMMEDIATE META

FORWARD: DEFINITIONS
FORWARD: [

LABEL ORIGIN    JMP HERE 8000 + \ jump to cold start: will be patched
                JMP HERE 8000 + \ jump to warm start: will be patched
                END-CODE

LABEL DPUSH     PUSH DX         END-CODE
LABEL APUSH     PUSH AX         END-CODE
LABEL >NEXT     LODSW ES:
                JMP AX          END-CODE

\ Create the FORTH vocabulary as the first definition in dictionary.

HERE-T ,-Y                      \ valid "previous" CFA for "CREATE

HERE-Y HERE-T CNHASH !-Y        \ first entry in >NAME hash table

HERE-T DUP 100 + CURRENT-T !    \ harmless

HERE-Y VOCABULARY FORTH   FORTH DEFINITIONS

                                \ #THREADS - 1 = 127 the mask.
0 OVER 2+ !-Y ( link )          \ ASCII F     15 AND = 6
                                \ ASCII F 5 + 127 AND = 75
2+ SWAP  >BODY-T
ASCII F 5 +                     \ hash is first char + length
#TTHREADS 1- AND 2*             \ Determine which thread FORTH goes in.
\ ( 12 ) 150
+ !-T ( thread 75 )  IN-META

VOCABULARY FILES

FILES DEFINITIONS

\ Create the linked list of files that have been loaded.

VARIABLE KERNEL1.SEQ

FORTH DEFINITIONS

VARIABLE XSEG
VARIABLE YSEG

HEX
LABEL ABNORM    MOV AX, # AD26          \ Value to restore in >NEXT
                MOV >NEXT AX            \ Restore it
                MOV AX, # E0FF          \ Value to restore in >NEXT + 2
                MOV >NEXT 2+ AX         \ Restore it
                XOR AX, AX
                MOV DS, AX
                MOV BX, # 471
                MOV 0 [BX], AL
                MOV AX, CS
                MOV DS, AX
                JMP ORIGIN 3 +  END-CODE

LABEL BIOSBK    PUSH AX
                MOV AL, # E9
                MOV CS: >NEXT AL
                MOV AX, # ABNORM >NEXT - 3 -
                MOV CS: >NEXT 1+ AX
                POP AX
                IRET            END-CODE

LABEL DOSBK     PUSH AX
                MOV AH, # 0             \ throw away BREAK KEY
                INT 16
                POP AX
                CLC
                RETF            END-CODE

DECIMAL

LABEL NEST              \ JMP = 15 cycles
        SUB RP, # 4
        MOV 2 [RP], ES  \ 19 cycles
        MOV 0 [RP], IP  \ 14 cycles
        MOV DI, AX
        MOV AX, 3 [DI]  \ 18 cycles     \ get relative segment
        ADD AX, XSEG                    \ adjust by base of list space
        MOV ES, AX                      \ move into ES
        SUB IP, IP                      \ clear IP
        NEXT
        END-CODE
META

CODE EXIT     ( -- )
        MOV IP, 0 [RP]  \ 13 cycles
        MOV ES, 2 [RP]  \ 18 cycles
        ADD RP, # 4
        NEXT
        END-CODE

CODE UNNEST   ( --- )
        MOV IP, 0 [RP]  \ 13 cycles
        MOV ES, 2 [RP]  \ 18 cycles
        ADD RP, # 4
        NEXT            END-CODE

LABEL DODOES
        SUB RP, # 4
        MOV 2 [RP], ES  \ 19 cycles
        MOV 0 [RP], IP  \ 14 cycles
        POP DI
        MOV AX, 0 [DI]
        ADD AX, XSEG
        MOV ES, AX
        SUB IP, IP
        NEXT            END-CODE

VARIABLE UP

LABEL DOCONSTANT
        POP BX
        PUSH 0 [BX]
        NEXT            END-CODE

LABEL DOUSER-VARIABLE
        POP BX
        MOV AX, 0 [BX]
        ADD AX, UP
        1PUSH           END-CODE

CODE (LIT)      ( -- n )
                LODSW ES:       1PUSH           END-CODE

T: LITERAL      ( n -- ) [TARGET] (LIT)   ,-X   T;
T: DLITERAL     ( d -- ) [TARGET] (LIT) ,-X   [TARGET] (LIT) ,-X   T;
T: ASCII        ( -- )   [COMPILE] ASCII [[ TRANSITION ]] LITERAL [META]  T;
T: [']          ( -- )   'T >BODY @
                         [[ TRANSITION ]] LITERAL  [META]   T;
: CONSTANT      ( n -- )
                RECREATE   232 C,-T
                [[ ASSEMBLER DOCONSTANT ]] LITERAL HERE 2+ - ,-T
                DUP ,-T   CONSTANT   ;

FORWARD: <(;CODE)>
T: DOES>        ( -- )
                [FORWARD] <(;CODE)> HERE-T ,-X
                HERE-T  ( DOES-OP ) 232 C,-T
                [[ ASSEMBLER DODOES ]] LITERAL HERE 2+ - ,-T
                HERE-X PARAGRAPH-X + DUP DPSEG-X ! SEG-X @ - ,-T
                DP-X OFF T;

: NUMERIC   ( -- )
                [FORTH] HERE [META] NUMBER   DPL @ 1+
                IF      [[ TRANSITION ]] DLITERAL [META]
                ELSE    DROP   [[ TRANSITION ]] LITERAL [META]   THEN  ;

: UNDEFINED     ( -- )
                HERE-X >XREL 0 ,-X
                IN-FORWARD  [FORTH] CREATE [META] TRANSITION
                [FORTH] ,   FALSE ,   [META]
                DOES>   FORWARD-CODE   ;

[FORTH] VARIABLE T-IN      META

: ]             ( -- )
                STATE-T ON   IN-TRANSITION
        BEGIN   >IN @ T-IN !
                BEGIN   BL WORD DUP C@ 0=       \ If nothing in line
                        ?FILLBUFF               \ Optionally refill buffer
                        INLENGTH 0> AND         \ and input buf not empty
                WHILE   DROP FILLTIB            \ refill the buffer
                REPEAT  ?UPPERCASE FIND
                IF      EXECUTE
                ELSE    COUNT NUMERIC?
                        IF      NUMERIC
                        ELSE    T-IN @ >IN !   UNDEFINED
                        THEN
                THEN    STATE-T @ 0=
        UNTIL ;

T: [   ( -- )   IN-META   STATE-T OFF   T;

T: ;   ( -- )   [TARGET] UNNEST   [[ TRANSITION ]] [   T;

 : :   ( -- )   TARGET-CREATE   233 C,-T        \ a JUMP instruction
                [[ ASSEMBLER NEST ]] LITERAL HERE 2+ - ,-T
                HERE-X PARAGRAPH-X + DUP DPSEG-X !
                SEG-X @ - ( DUP H. ) ,-T
                DP-X OFF ] ;                              \ compile body addr

ASSEMBLER CLEAR_LABELS META

CODE DOBEGIN    ( -- )  \ REALLY A NOOP
                NEXT    END-CODE

CODE DOTHEN     ( -- )  \ REALLY A NOOP
                NEXT    END-CODE

CODE DOAGAIN    ( -- )
                MOV ES: IP, 0 [IP]
                NEXT           END-CODE

CODE DOREPEAT   ( -- )
LABEL DOREP1    MOV ES: IP, 0 [IP]
                NEXT           END-CODE

CODE ?WHILE     ( f -- )
                POP AX          OR AX, AX
                JE DOREP1
                ADD IP, # 2
                NEXT            END-CODE

CODE ?UNTIL     ( f -- )
                POP AX          OR AX, AX
                JE DOREP1
                ADD IP, # 2
                NEXT            END-CODE

CODE BRANCH     ( -- )
LABEL BRAN1     MOV ES: IP, 0 [IP]
                NEXT            END-CODE

CODE ?BRANCH    ( f -- )
                POP AX          OR AX, AX
                JE BRAN1
                ADD IP, # 2
                NEXT            END-CODE

T: BEGIN        [TARGET] DOBEGIN X?<MARK   T;
T: AGAIN        [TARGET] DOAGAIN X?<RESOLVE   T;
T: UNTIL        [TARGET] ?UNTIL  X?<RESOLVE   T;
T: IF           [TARGET] ?BRANCH X?>MARK      T;
T: THEN         [TARGET] DOTHEN  X?>RESOLVE    T;
T: ELSE         [TARGET] BRANCH  X?>MARK   2SWAP X?>RESOLVE   T;
T: WHILE        [TARGET] ?WHILE  X?>MARK   T;
T: REPEAT       2SWAP [TARGET] DOREPEAT X?<RESOLVE X?>RESOLVE T;

LABEL LOOPEXIT  ( --- )
                ADD RP, # 6     ADD IP, # 2
                NEXT            END-CODE

CODE (LOOP)     ( -- )
                INC 0 [RP] WORD
                JO LOOPEXIT
                MOV ES: IP, 0 [IP]
                NEXT            END-CODE

CODE (+LOOP)    ( n -- )
                AX POP          ADD 0 [RP], AX
                JO LOOPEXIT     MOV ES: IP, 0 [IP]
                NEXT            END-CODE

HEX
CODE (DO)       ( l i -- )
                POP AX          POP BX
LABEL PDO1      SUB RP, # 2
                MOV ES: DX, 0 [IP]
                MOV 0 [RP], DX
                ADD IP, # 2
                ADD BX, # 8000
                SUB RP, # 2
                MOV 0 [RP], BX  SUB AX, BX
                SUB RP, # 2
                MOV 0 [RP], AX
                NEXT            END-CODE
DECIMAL

CODE (?DO)      ( l i -- )
                POP AX          POP BX
                CMP BX, AX
                JNE PDO1        MOV ES: IP, 0 [IP]
                NEXT            END-CODE


CODE (OF)       ( n1 n2 -- n1 )  ( or )  ( n1 n1 -- )
                POP AX          XCHG SP, RP     CMP AX, 0 [RP]
        0= IF
                XCHG RP, SP     POP AX
                ADD IP, # 2     NEXT
        ELSE
                XCHG RP, SP     MOV ES: IP, 0 [IP]
                NEXT
        THEN
                END-CODE

CODE BOUNDS     ( n1 n2 --- n3 n4 )
                POP DX          POP AX          ADD DX, AX
                2PUSH           END-CODE

T: ?DO          [TARGET] (?DO)   X?>MARK   T;
T: DO           [TARGET] (DO)    X?>MARK   T;
T: LOOP         [TARGET] (LOOP)    2DUP 2+   X?<RESOLVE   X?>RESOLVE   T;
T: +LOOP        [TARGET] (+LOOP)   2DUP 2+   X?<RESOLVE   X?>RESOLVE   T;

ASSEMBLER >NEXT META CONSTANT >NEXT

CODE EXECUTE    ( cfa -- )
                POP AX          JMP AX          END-CODE

CODE PERFORM    ( addr-of-cfa -- )
LABEL DODEFER   POP BX          MOV AX, 0 [BX]
                JMP AX          END-CODE

CODE EXEC:      ( N1 -- )
                POP BX
                SHL BX, # 1
                ADD BX, IP
                MOV ES: AX, 0 [BX]
                MOV IP, 0 [RP]  \ 13 cycles
                MOV ES, 2 [RP]  \ 18 cycles
                ADD RP, # 4
                JMP AX          END-CODE

LABEL DOUSER-DEFER
                POP BX          MOV BX, 0 [BX]
                ADD BX, UP      MOV AX, 0 [BX]
                JMP AX          END-CODE

CODE GO         RET             END-CODE        ( ADDR --- )

CODE NOOP       NEXT            END-CODE

CODE PAUSE      NOOP                            \ Gets patched
                NOOP
                NOOP
                NEXT            END-CODE

DECIMAL

CODE I ( -- n ) MOV AX, 0 [RP]  ADD AX, 2 [RP]
                1PUSH           END-CODE

CODE J ( -- n ) MOV AX, 6 [RP]  ADD AX, 8 [RP]
                1PUSH           END-CODE

CODE K ( -- n ) MOV AX, 12 [RP] ADD AX, 14 [RP]
                1PUSH           END-CODE

CODE (LEAVE)    ( -- )
LABEL PLEAVE    ADD RP, # 4     MOV IP, 0 [RP]
                ADD RP, # 2
                NEXT            END-CODE

CODE (?LEAVE)   ( f -- )
                POP AX          OR AX, AX       JNE PLEAVE
                NEXT            END-CODE

T: LEAVE        [TARGET] (LEAVE)   T;
T: ?LEAVE       [TARGET] (?LEAVE)  T;

CODE @          ( addr -- n )
                POP BX          PUSH 0 [BX]
                NEXT            END-CODE

CODE !          ( n addr -- )
                POP BX          POP 0 [BX]
                NEXT            END-CODE

CODE C@         ( addr -- char )
                POP BX          SUB AX, AX      MOV AL, 0 [BX]
                1PUSH           END-CODE

CODE C!         ( char addr -- )
                POP BX          POP AX          MOV 0 [BX], AL
                NEXT            END-CODE

CODE CMOVE      (  from to count -- )
                CLD             MOV BX, IP      MOV AX, DS
                POP CX          POP DI          POP IP
                PUSH ES         MOV ES, AX
                REPNZ           MOVSB
                MOV IP, BX      POP ES
                NEXT            END-CODE

CODE CMOVE>     ( from to count -- )
                STD             MOV BX, IP      MOV AX, DS
                POP CX          DEC CX
                POP DI          POP IP
                ADD DI, CX      ADD IP, CX      INC CX
                PUSH ES         MOV ES, AX
                REPNZ           MOVSB
                MOV IP, BX      CLD             POP ES
                NEXT            END-CODE

CODE PLACE      ( from cnt to -- )
                POP BX          POP AX          MOV 0 [BX], AL
                INC BX          PUSH BX         PUSH AX
                CLD             MOV BX, IP      MOV AX, DS
                POP CX          POP DI          POP IP
                PUSH ES         MOV ES, AX
                REPNZ           MOVSB
                MOV IP, BX      POP ES
                NEXT            END-CODE

DECIMAL

CODE SP@        ( -- n )
                MOV AX, SP      1PUSH           END-CODE

CODE SP!        ( n -- )
                POP SP          NEXT            END-CODE

CODE RP@        ( -- addr )
                MOV AX, RP      1PUSH           END-CODE

CODE RP!        ( n -- )
                POP RP          NEXT            END-CODE

CODE DROP       ( n1 -- )
                POP AX          NEXT            END-CODE

CODE DUP        ( n1 -- n1 n1 )
                POP AX          PUSH AX
                1PUSH           END-CODE

CODE SWAP       ( n1 n2 -- n2 n1 )
                POP DX          POP AX
                2PUSH           END-CODE

CODE OVER       ( n1 n2 -- n1 n2 n1 )
                POP DX          POP AX
                PUSH AX         2PUSH           END-CODE

CODE TUCK       ( n1 n2 -- n2 n1 n2 )
                POP AX          POP DX
                PUSH AX         2PUSH           END-CODE

CODE NIP        ( n1 n2 -- n2 )
                POP AX          POP DX
                1PUSH           END-CODE

CODE ROT        ( n1 n2 n3 --- n2 n3 n1 )
                POP DX          POP BX          POP AX
                PUSH BX         2PUSH           END-CODE

CODE -ROT       ( n1 n2 n3 --- n3 n1 n2 )
                POP BX          POP AX          POP DX
                PUSH BX         2PUSH           END-CODE

CODE FLIP       ( n1 -- n2 )
                POP AX          XCHG AL, AH
                1PUSH           END-CODE

CODE ?DUP       ( n1 -- [n1] n1 )
                POP AX          CMP AX, # 0
            0<> IF
                PUSH AX
            THEN
                1PUSH           END-CODE

CODE R>         ( -- n )
                MOV AX, 0 [RP]  ADD RP, # 2
                1PUSH           END-CODE

CODE R>DROP     ( --- )
                ADD RP, # 2
                NEXT            END-CODE

CODE >R         ( n -- )
                POP AX          SUB RP, # 2
                MOV 0 [RP], AX
                NEXT            END-CODE

CODE 2R>        ( -- n )
                MOV DX, 0 [RP]
                MOV AX, 2 [RP]
                ADD RP, # 4
                2PUSH           END-CODE

CODE 2>R        ( n -- )
                POP AX
                MOV -2 [RP], AX
                POP AX
                MOV -4 [RP], AX
                SUB RP, # 4
                NEXT            END-CODE

CODE R@         ( -- n )
                MOV AX, 0 [RP]
                1PUSH           END-CODE

CODE 2R@        ( -- n )
                MOV DX, 0 [RP]
                MOV AX, 2 [RP]
                2PUSH           END-CODE

CODE 2R@SWAP    ( -- n )
                MOV DX, 2 [RP]
                MOV AX, 0 [RP]
                2PUSH           END-CODE

CODE PICK       ( nm ... n2 n1 k -- nm ... n2 n1 nk )
                POP BX          SHL BX, # 1     ADD BX, SP
                MOV AX, 0 [BX]  1PUSH           END-CODE

CODE AND        ( n1 n2 -- n3 )
                POP BX          POP AX          AND AX, BX
                1PUSH           END-CODE

CODE OR         ( n1 n2 -- n3 )
                POP BX          POP AX          OR AX, BX
                1PUSH           END-CODE

CODE XOR        ( n1 n2 -- n3 )
                POP BX          POP AX          XOR AX, BX
                1PUSH           END-CODE

CODE NOT        ( n -- n' )
                POP AX          NOT AX
                1PUSH           END-CODE

-1 CONSTANT TRUE
 0 CONSTANT FALSE

CODE CSET       ( b addr -- )
                POP BX          POP AX          OR 0 [BX], AL
                NEXT            END-CODE

CODE CRESET     ( b addr -- )
                POP BX          POP AX
                NOT AX          AND 0 [BX], AL
                NEXT            END-CODE

CODE CTOGGLE    ( b addr -- )
                POP BX          POP AX          XOR 0 [BX], AL
                NEXT            END-CODE

CODE ON         ( addr -- )
                POP BX          MOV 0 [BX], # TRUE WORD
                NEXT            END-CODE

CODE OFF        ( addr -- )
                POP BX          MOV 0 [BX], # FALSE WORD
                NEXT            END-CODE

CODE -1!        ( addr -- )
                POP BX          MOV 0 [BX], # TRUE WORD
                NEXT            END-CODE

CODE 0!         ( addr -- )
                POP BX          MOV 0 [BX], # FALSE WORD
                NEXT            END-CODE

CODE INCR       ( A1 --- )
                POP BX          INC 0 [BX] WORD
                NEXT            END-CODE

CODE DECR       ( A1 --- )
                POP BX          DEC 0 [BX] WORD
                NEXT            END-CODE

CODE +          ( n1 n2 -- sum )
                POP BX          POP AX          ADD AX, BX
                1PUSH           END-CODE

CODE NEGATE     ( n -- n' )
                POP AX          NEG AX
                1PUSH           END-CODE

CODE -          ( n1 n2 -- n1-n2 )
                POP BX          POP AX          SUB AX, BX
                1PUSH           END-CODE

CODE ABS        ( n -- n )
                POP AX
                CWD
                XOR AX, DX
                SUB AX, DX
                1PUSH
                END-CODE

CODE 2+!        ( d addr -- )
                POP BX          POP AX          POP DX
                ADD 0 [BX], DX  ADC 2 [BX], AX
                NEXT            END-CODE

CODE +!         ( n addr -- )
                POP BX          POP AX          ADD 0 [BX], AX
                NEXT            END-CODE

CODE C+!        ( n addr -- )
                POP BX          POP AX          ADD 0 [BX], AL
                NEXT            END-CODE


\ Since the 8086 has a seperate IO path, we define a Forth
\ interface to it.  Use P@ and P! to read or write directly to
\ the 8086 IO ports.

CODE PC@        ( port# -- n )
                POP DX          IN AL, DX       SUB AH, AH
                PUSH AX         NEXT            END-CODE

CODE P@         ( port# -- n )
                POP DX          IN AX, DX       PUSH AX
                NEXT            END-CODE

CODE PC!        ( n port# -- )
                POP DX          POP AX          OUT DX, AL
                NEXT            END-CODE

CODE P!         ( n port# -- )
                POP DX          POP AX          OUT DX, AX
                NEXT            END-CODE

                \ read drive path into addr, null terminated.
CODE PDOS       ( addr drive --- f1 ) \ RETURN PATH OF DRIVE
                pop dx          pop ax
                push si         mov si, ax
                mov ah, # 71    int 33
             u< if
                mov al, # 1
             else
                mov al, # 0
             then
                sub ah, ah      pop si
                1push           end-code

#TTHREADS CONSTANT #THREADS

CODE 2*         ( n -- 2*n )
                POP AX          SHL AX, # 1
                1PUSH           END-CODE

CODE 2/         ( n -- n/2 )
                POP AX          SAR AX, # 1
                1PUSH           END-CODE

CODE U2/        ( u -- u/2 )
                POP AX          SHR AX, # 1
                1PUSH           END-CODE

CODE U16/       ( u -- u/16 )
                POP AX
                SHR AX, # 1     SHR AX, # 1
                SHR AX, # 1     SHR AX, # 1
                1PUSH           END-CODE

CODE 8*         ( n -- 8*n )
                POP AX          SHL AX, # 1
                SHL AX, # 1     SHL AX, # 1
                1PUSH           END-CODE

                ( n1 --- n2 )
CODE 1+         POP AX          INC AX
                1PUSH           END-CODE

CODE 2+         POP AX          ADD AX, # 2
                1PUSH           END-CODE

CODE 1-         POP AX          DEC AX
                1PUSH           END-CODE

CODE 2-         POP AX          SUB AX, # 2
                1PUSH           END-CODE

CODE UM*        ( n1 n2 -- d )
                POP AX          POP BX          MUL BX
                XCHG DX, AX     2PUSH           END-CODE

CODE *          ( N1 N2 -- N3 )
                POP AX          POP BX          MUL BX
                1PUSH           END-CODE

: U*D           ( n1 n2 -- d )  UM*   ;

CODE UM/MOD     ( d1 n1 -- Remainder Quotient )
                POP BX          POP DX          POP AX
                CMP DX, BX
            U>=  ( divide by zero? )
            IF
                MOV AX, # -1    MOV DX, AX      2PUSH
            THEN
                DIV BX          2PUSH           END-CODE

LABEL YES       MOV AX, # TRUE  1PUSH           END-CODE

CODE 0=         ( n -- f )
                POP AX          OR AX, AX
                JE YES
                SUB AX, AX      1PUSH           END-CODE

CODE 0<         ( n -- f )
                POP AX          OR AX, AX
                JS YES
                SUB AX, AX      1PUSH           END-CODE

CODE 0>         ( n -- f )
                POP AX          OR AX, AX
                JG YES
                SUB AX, AX      1PUSH           END-CODE

CODE 0<>        ( n -- f )
                POP AX          OR AX, AX
                JNE YES
                SUB AX, AX      1PUSH           END-CODE

CODE =          ( n1 n2 -- f )
                POP AX          POP BX          CMP BX, AX
                JE YES
                SUB AX, AX      1PUSH           END-CODE

CODE <>         ( n1 n2 -- f )
                POP AX          POP BX          CMP BX, AX
                JNE YES
                SUB AX, AX      1PUSH           END-CODE

\ : <>            ( n1 n2 -- f )  = NOT   ;

: ?NEGATE       ( n1 n2 -- n3 ) 0< IF    NEGATE   THEN   ;

CODE   U<       ( n1 n2 -- f )
                POP AX          POP BX          CMP BX, AX
                JB YES
                SUB AX, AX      1PUSH           END-CODE

CODE   U>       ( n1 n2 -- f )
                POP AX          POP BX          CMP AX, BX
                JB YES
                SUB AX, AX      1PUSH           END-CODE

CODE <          ( n1 n2 -- f )
                POP AX          POP BX          CMP BX, AX
                JL YES
                SUB AX, AX      1PUSH           END-CODE

CODE >          ( n1 n2 -- f )
                POP AX          POP BX          CMP BX, AX
                JG YES
                SUB AX, AX
LABEL PUSH1     1PUSH           END-CODE

CODE MIN        POP AX          POP BX          CMP BX, AX
                JG PUSH1
LABEL MIN1      PUSH BX         NEXT            END-CODE

CODE MAX        POP AX          POP BX          CMP BX, AX
                JG MIN1
                1PUSH           END-CODE

: BETWEEN       ( n1 min max -- f )     >R  OVER > SWAP R> > OR NOT ;
: WITHIN        ( n1 min max -- f )     1- BETWEEN  ;

CODE 2@         ( addr -- d )
                POP BX          MOV AX, 0 [BX]  MOV DX, 2 [BX]
                2PUSH           END-CODE

CODE 2!         ( d addr -- )
                POP BX          POP 0 [BX]      POP 2 [BX]
                NEXT            END-CODE

CODE 2DROP      ( d -- )
                POP AX          POP AX
                NEXT            END-CODE

CODE 3DROP      ( d -- )
                POP AX          POP AX          POP AX
                NEXT            END-CODE

CODE 2DUP       ( d -- d d )
                POP AX          POP DX
                PUSH DX         PUSH AX
                2PUSH           END-CODE

CODE 3DUP       ( d -- d d )
                POP AX          POP DX          POP BX
                PUSH BX         PUSH DX         PUSH AX
                PUSH BX         PUSH DX         PUSH AX
                NEXT            END-CODE

CODE 2SWAP      ( d1 d2 -- d2 d1 )
                POP CX          POP BX
                POP AX          POP DX
                PUSH BX         PUSH CX
                2PUSH           END-CODE

CODE 2OVER      ( d2 d2 -- d1 d2 d1 )
                POP CX          POP BX
                POP AX          POP DX
                PUSH DX         PUSH AX
                PUSH BX         PUSH CX
                2PUSH           END-CODE

CODE D+         ( d1 d2 -- dsum )
                POP AX          POP DX
                POP BX          POP CX
                ADD DX, CX      ADC AX, BX
                2PUSH           END-CODE

CODE DNEGATE    ( d# -- d#' )
                POP AX
LABEL DNEG1     POP DX
                NEG AX
                NEG DX
                SBB AX, # 0
                2PUSH
                END-CODE

CODE   S>D      ( n -- d )
                POP AX          CWD             XCHG DX, AX
                2PUSH           END-CODE

CODE DABS       ( d# -- d# )
                POP AX
                OR AX, AX
                JS DNEG1
                1PUSH           END-CODE

CODE D2*        ( d -- d*2 )
                POP AX          POP DX
                SHL DX, # 1     RCL AX, # 1
                2PUSH           END-CODE

CODE D2/        ( d -- d/2 )
                POP AX          POP DX
                SAR AX, # 1     RCR DX, # 1
                2PUSH           END-CODE

: D-            ( d1 d2 -- d3 ) DNEGATE D+   ;

: ?DNEGATE      ( d1 n -- d2 )  0< IF   DNEGATE   THEN   ;

: D0=           ( d -- f )      OR 0= ;

: D=            ( d1 d2 -- f )  D-  D0=  ;

: DU<           ( ud1 ud2 -- f )
                ROT SWAP 2DUP U<
                IF      2DROP 2DROP TRUE
                ELSE    <> IF   2DROP FALSE  ELSE  U<  THEN
                THEN  ;

: D<            ( d1 d2 -- f )
                2 PICK OVER =
                IF      DU<
                ELSE  NIP ROT DROP <  THEN  ;

: D>            ( d1 d2 -- f )  2SWAP D<   ;

: 4DUP          ( a b c d -- a b c d a b c d )  2OVER 2OVER   ;

: DMIN          ( d1 d2 -- d3 ) 4DUP D> IF  2SWAP  THEN 2DROP ;

: DMAX          ( d1 d2 -- d3 ) 4DUP D< IF  2SWAP  THEN  2DROP ;

: *D            ( n1 n2 -- d# )
                2DUP  XOR  >R  ABS  SWAP  ABS  UM*  R>  ?DNEGATE  ;

: M/MOD         ( d# n1 -- rem quot )
                ?DUP
                IF  DUP >R  2DUP XOR >R  >R DABS R@ ABS  UM/MOD
                        SWAP R> ?NEGATE
                        SWAP R> 0<
                        IF  NEGATE OVER
                                IF  1- R@ ROT - SWAP  THEN
                        THEN    r>drop
                THEN  ;

: MU/MOD        ( d# n1 -- rem d#quot )
                >R  0  R@  UM/MOD  R>  SWAP  >R  UM/MOD  R>   ;

CODE /          ( NUM DEN --- QUOT )
                POP BX          POP AX          CWD
                MOV CX, BX      XOR CX, DX
            0>= IF                              \ POSITIVE QUOTIENT CASE
                IDIV BX         1PUSH
            THEN
                IDIV BX         OR DX, DX
            0<> IF
                DEC AX
            THEN
                1PUSH           END-CODE

CODE /MOD       ( NUM DEN --- REM QUOT )
                POP BX          POP AX          CWD
                MOV CX, BX      XOR CX, DX
            0>= IF
                IDIV BX         2PUSH
            THEN
                IDIV BX         OR DX, DX
            0<> IF
                ADD DX, BX      DEC AX
           THEN
                2PUSH           END-CODE

: MOD           ( n1 n2 -- rem ) /MOD  DROP  ;

CODE */MOD      ( N1 N2 N3 --- REM QUOT )
                POP BX          POP AX          POP CX
                IMUL CX         MOV CX, BX      XOR CX, DX
            0>= IF
                IDIV BX         2PUSH
            THEN
                IDIV BX         OR DX, DX
            0<> IF
                ADD DX, BX      DEC AX
            THEN
                2PUSH           END-CODE

: */            ( n1 n2 n3 -- n1*n2/n3 ) */MOD  NIP  ;

: ROLL          ( n1 n2 .. nk n -- wierd )
                >R R@ PICK   SP@ DUP 2+   R> 1+ 2* CMOVE>  DROP  ;

: 2ROT          ( a b c d e f - c d e f a b )   5 ROLL  5 ROLL  ;