Category : Forth Source Code
Archive   : FPCSLICE.ZIP
Filename : RJG-LIB.SEQ

\ MISC. WORDS
\ -----------------------------------------------------------------------
: $<>L ( aL1 aL2 cnt -- f ) ; \ needs to be string compare long
: 4* ( n -- 4*n ) 4 * ; \ need to write in code
\ -----------------------------------------------------------------------
comment:
I use on the stack diagrams and in comments the sequence aL
(address long) to refer to segment then offset on stack
( seg off -- ) = ( aL -- ).
comment;
\ -----------------------------------------------------------------------
: COMPLIT ( -- ) [COMPILE] LITERAL ;

: PFA-OF ( -- ) ' >BODY ;

: PADL ( -- aL ) ?CS: PAD ;

: 4DROP ( q -- ) 2DROP 2DROP ;

: DUMPL ( aL n -- ) ROT DUMPSEG ! LDUMP ;

' PERFORM ALIAS EXECUTE@
' NIP ALIAS PLUCK
' DARK ALIAS CLS
\ -----------------------------------------------------------------------
ONLY FORTH ALSO ASSEMBLER DEFINITIONS ALSO
: RESTORE_DS: ( -- ) MOV BX, CS MOV DS, BX A; ;
ONLY FORTH DEFINITIONS ALSO
\ -----------------------------------------------------------------------
CODE OVER- ( n1 n2 -- n1 n2-n1 )
POP AX MOV BX, SP SUB AX, 0 [BX]
1PUSH END-CODE
\ -----------------------------------------------------------------------
CODE I! ( n addr index -- ) \ indexed store
POP AX POP BX ADD BX, AX
POP 0 [BX] NEXT END-CODE

CODE I@ ( addr index -- n ) \ indexed fetch
POP AX POP BX ADD BX, AX
PUSH 0 [BX] NEXT END-CODE

CODE I2@ ( adr index -- d ) \ indexed double fetch
POP AX POP BX ADD BX, AX
PUSH 2 [BX] PUSH 0 [BX]
NEXT END-CODE

CODE I2! ( d adr index -- ) \ indexed double store
POP AX POP BX ADD BX, AX
POP 0 [BX] POP 2 [BX]
NEXT END-CODE

CODE I!L ( n seg off index -- ) \ indexed store long (seg,off)
POP AX POP BX ADD BX, AX
POP DS POP AX MOV 0 [BX], AX
RESTORE_DS: NEXT END-CODE

CODE I@L ( seg off index -- n ) \ indexed fetch long (seg,off)
POP AX POP BX ADD BX, AX
POP DS MOV AX, 0 [BX] PUSH AX
RESTORE_DS: NEXT END-CODE

CODE 2@L ( aL -- d )
POP BX POP DS
PUSH 2 [BX] PUSH 0 [BX]
RESTORE_DS: NEXT END-CODE

CODE 2!L ( d aL -- )
POP BX POP DS
POP 0 [BX] POP 2 [BX]
RESTORE_DS: NEXT END-CODE

CODE 3@L ( -- n n n )
POP BX POP DS
PUSH 4 [BX] PUSH 2 [BX] PUSH 0 [BX]
RESTORE_DS: NEXT END-CODE

CODE +!L ( n aL -- )
POP BX POP DS POP AX
ADD 0 [BX], AX
RESTORE_DS: NEXT END-CODE
\ -----------------------------------------------------------------------
CODE DUP>R ( n -- n ) \ same as dup >r
POP AX PUSH AX
DEC RP DEC RP MOV 0 [RP], AX
NEXT END-CODE

CODE 2IR@ ( -- n ) \ fetches the second number from the return stack
MOV AX, 2 [RP] 1PUSH END-CODE

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

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

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

CODE RDROP ( -- )
INC RP INC RP
NEXT END-CODE

CODE 2RDROP ( -- )
INC RP INC RP INC RP
INC RP NEXT END-CODE

\ --|