Category : Forth Source Code
Archive   : FPCSLICE.ZIP
Filename : LSLICE.SEQ

\ LSLICE.SEQ LSLICE WORDS
\ copyright 1988 Robert J. Gesswein
\ -----------------------------------------------------------------------
\ all these words expect aL of lslice type to be in CB.AL@
COMMENT: \ code versions below
: L.OFF@ ( - n) CB.AL@ L.Off# I@L ; : L.OFF! ( n - ) CB.AL@ L.Off# I!L ;
: L.CURROFF@ ( -- n ) CB.AL@ L.CurOff# I@L ;
: L.CURROFF! ( n -- ) CB.AL@ L.CurOff# I!L ;
: L.CURR@ ( - n) CB.AL@ L.Curr# I@L ; : L.CURR! ( n - ) CB.AL@ L.Curr# I!L ;
: L.TOT@ ( - n) CB.AL@ L.Tot# I@L ; : L.TOT! ( n - ) CB.AL@ L.Tot# I!L ;
: L.SIZE@ ( - n) CB.AL@ L.Size# I@L ; : L.SIZE! ( n - ) CB.AL@ L.Size# I!L ;
COMMENT;

CODE L.OFF@ L.Off# [email protected] C; CODE L.OFF! L.Off# CB!.MACRO C;
CODE L.CURROFF@ L.CurOff# [email protected] C; CODE L.CURROFF! L.CurOff# CB!.MACRO C;
CODE L.CURR@ L.Curr# [email protected] C; CODE L.CURR! L.Curr# CB!.MACRO C;
CODE L.TOT@ L.Tot# [email protected] C; CODE L.TOT! L.Tot# CB!.MACRO C;
CODE L.SIZE@ L.Size# [email protected] C; CODE L.SIZE! L.Size# CB!.MACRO C;

COMMENT:
\ all these words expect the proper node to be set
: NODE.AL ( -- node-aL ) CB.AL@ 2DUP 2 I@L + ;

: LN.BYTES@ ( -- n ) NODE.AL LN.Bytes# I@L ;
: LN.BYTES! ( n -- ) NODE.AL LN.Bytes# I!L ;
: LN.PREV@ ( -- n ) NODE.AL LN.Prev# I@L ;
: LN.PREV! ( n -- ) NODE.AL LN.Prev# I!L ;
COMMENT;

ONLY FORTH ALSO ASSEMBLER DEFINITIONS ALSO

: [email protected] ( n -- )
MOV BX, # 0 A; !'CB.AL \ BX=addr of cb.al variable
MOV AX, 0 [BX] MOV DS, 2 [BX] \ AX=offset DS=segment
MOV BX, AX ADD AX, 2 [BX] \ ds:ax = node.al
MOV BX, AX PUSH 2 [BX] A; !CB.OFF \ @ value from node
RESTORE_DS: NEXT ;

: LN!.MACRO ( n -- )
MOV BX, # 0 A; !'CB.AL \ BX=addr of cb.al variable
MOV AX, 0 [BX] MOV DS, 2 [BX] \ AX=offset DS=segment
MOV BX, AX ADD AX, 2 [BX] \ ds:ax = node.al
MOV BX, AX POP 2 [BX] A; !CB.OFF \ store value in node
RESTORE_DS: NEXT ;

ONLY FORTH DEFINITIONS ALSO

CODE LN.BYTES@ LN.Bytes# [email protected] C; CODE LN.BYTES! LN.Bytes# LN!.MACRO C;
CODE LN.PREV@ LN.Prev# [email protected] C; CODE LN.PREV! LN.Prev# LN!.MACRO C;

CODE NODE.AL ( -- aL )
MOV BX, # 0 A; !'CB.AL \ BX=addr of cb.al variable
MOV AX, 0 [BX] MOV DS, 2 [BX] \ AX=offset DS=segment
MOV BX, AX ADD AX, 2 [BX] \ ds:ax = node.al
PUSH DS PUSH AX
RESTORE_DS: NEXT END-CODE

\ -->
\ -----------------------------------------------------------------------
: FIRST-LSLICE ( -- ) \ to first lseek slice
L.OFF@ L.CURROFF!
0 L.CURR! ;
\ -----------------------------------------------------------------------
: NEXT-LSLICE? ( -- f ) \ f: T=on next lslice, F=allready on last
L.CURR@ L.TOT@ 1- < \ is there a next?
DUP IF
L.CURR@ 1+ L.CURR! \ bump current lslice#
L.CURROFF@ LN.BYTES@ + L.CURROFF! \ to next lslice
THEN ;

: PREV-LSLICE? ( -- f ) \ f: T=on prev. lslice, F=allready on first
L.CURR@ 0> \ is there a prev.?
DUP IF
L.CURR@ 1- L.CURR! \ ~bump current lslice#
L.CURROFF@ LN.PREV@ - L.CURROFF! \ to prev. lslice
THEN ;
\ -----------------------------------------------------------------------
: SET-LSLICE# ( lslice# -- ) \ makes lslice# the current lslice
FIRST-LSLICE
?DUP IF
0 DO NEXT-LSLICE? DROP LOOP
THEN ;

: GET-LSLICE# ( -- lslice# ) \ get current lslice#
L.CURR@ ;
\ -----------------------------------------------------------------------
: LSLICE#->AL ( lslice# -- aL ) \ aL=aL of 1st byte after node
GET-LSLICE# >R
SET-LSLICE# NODE.AL LCB.NodeBytes +
R> SET-LSLICE# ;

: LSLICE#->OFF ( lslice# -- off ) LSLICE#->AL PLUCK ;
\ -----------------------------------------------------------------------
: LAST-LSLICE ( -- ) L.TOT@ 1- SET-LSLICE# ;
\ -----------------------------------------------------------------------
\ to next/prev. lslice or wraps to first/last
: NEXT-LSLICE ( -- ) NEXT-LSLICE? 0= IF FIRST-LSLICE THEN ;
: PREV-LSLICE ( -- ) PREV-LSLICE? 0= IF LAST-LSLICE THEN ;
\ -----------------------------------------------------------------------
: SET-LSLICE-ACTION> ( -- } cfa' )
' STATE @ IF COMPLIT THEN ; IMMEDIATE

: RUN-LSLICES ( cfa -- )
GET-LSLICE# 2>R
FIRST-LSLICE
BEGIN
R@ EXECUTE
NEXT-LSLICE? 0=
UNTIL
RDROP R> SET-LSLICE# ;

: RUN-LSLICES-DOING> ( -- } cfa'.lslice.action )
' COMPLIT COMPILE RUN-LSLICES ; IMMEDIATE

\ --|