( file SYSOMIT.4TH -- this is not used in 4th/86 and is included
    only for information -- 8 July 88 -- MFB )

OFF PRINTLOAD
(
This file lets you take words out of the system dictionary.  
Loading this file accomplishes the following:
  1. The symbols for the words listed at the end of
     this file are removed from dictionary.
  2. As much as possible of the users dictionary is moved
     to the reclaimed space.
  3. All traces of this file are removed from system.

This file is loaded by the file EXTEND.4TH (EXTEND builds
a 'full blown' system).  Generally, it will not be used for
any other purposes.
)

HEAD @ LAST @ ( Get head and last for later restore)
  CONST PLAST
  CONST PHEAD

: SYSOMIT
  WORD LAST @ FIND DUP 0= IF ( not found)
    DROP CRLF ATOM ." "  Not Found by SYSOMIT" ." RETURN
  THEN
  SYSLUM OVER U> 0= IF ( not in system area)
    DROP CRLF ATOM ." "  Not in 'system' dictionary"
    ." RETURN
  THEN
  DUPB@ 4 + ( length of entry) SWAP OVER OVER + SWAP
  ( stack: dest, src, entry len)
  OVER SYSLUM SWAP - ( stk: move cnt, dest, src, entry len)
  MOVE ( entry removed)
  DROP
; IMMEDIATE

SYNONYM SOMIT SYSOMIT

: FORGETSYSOMIT ( This forgets all definitions in this file)
  PHEAD HEAD ! PLAST LAST ! ;

: RVSMOVE ( tos=count, nos=dest, 30s=src  move with decrement)
  DUP 4 PICK + 3 POKE ( ->src+count)
  DUP 3 PICK + 2 POKE ( ->dst+count)
  REPEAT
    DUP
  WHILE ( count <> 0)
    3 PICK 1- DUP 4 POKE ( dec src) B@ ( get src)
    3 PICK 1- DUP 4 POKE ( dec dst) B! ( put dst)
    1- ( dec count)
  ENDWHILE
  3 KILL ;


: SYSAPPEND
( move as much as possible of user dict to free space in
  sys dict )
  SYSLAST REPEAT ( find free space)
    DUPB@
  WHILE
    DUPB@ + 4 +
  ENDWHILE
    3 + ( tos = addr after sys dict end link)
  SYSLUM SWAP - ( size of free space at end of sys dict.)
  DUP 36 U> PLAST B@ 0= 0= OR IF ( at least one addition)
    PLAST REPEAT
      OVER OVER TOPDICT SWAP - 1- U> 0= ( curent amt won't fit)
    WHILE
      DUPB@ + 4 + ( eliminate 1)
    ENDWHILE
    TOPDICT OVER - ( move length)
    SYSLAST ( src) OVER OVER + ( dst)
    SYSLUM SYSLAST - 4 PICK - ( count)
    RVSMOVE ( make room in sys dict)
    SWAP ( src) SYSLAST ( dst) 3 PICK  ( count)
    MOVE ( move part of user dict to sys)
    PLAST ( src) OVER PLAST + ( dst)
    TOPDICT PLAST - 4 PICK - ( cnt)
    RVSMOVE ( fix up user dict)
    CRLF DUP . "  bytes of user dictionary" ." CRLF
    "  moved to system dictionary" ."
    PLAST + ' PLAST 3 + ! ( patch plast)
  THEN
  DROP ;

        

( remove little used system dictionary entries)
 SOMIT IMWGET
 SOMIT IMWPUT SOMIT IMPUT SOMIT IMFCB
 SOMIT OLDLUM SOMIT OLDHEAD
 SOMIT CROSSTOP SOMIT %XACL8, SOMIT %XACL7,
 SOMIT %XACL6, SOMIT %XACL5,
 SOMIT %XACL4, SOMIT %XACL3, SOMIT %XACL2,
 SOMIT %XACL15 SOMIT %XACL14
 SOMIT %XACL13 SOMIT %XACL12 SOMIT %XACL11
 SOMIT %XACL1C SOMIT %XVAVAL
 SOMIT %XVAREG SOMIT %PWR2 SOMIT %XVALVL
 SOMIT TSTLIST SOMIT BADTL
 SOMIT DACLS2 SOMIT DACLS SOMIT COMLOOP
 SOMIT STDFS SOMIT CLRFIND
 SOMIT CNVPOP SOMIT CNVCHK SOMIT CNVPSH
 SOMIT CMPERR3 SOMIT CMPERR2
 SOMIT CMPERR SOMIT CMPERR1 SOMIT DOLVLCHK
 SOMIT %ERNUM SOMIT "HEAD
 SOMIT "PROCESS SOMIT DEBUGCLI SOMIT %DS+
 SOMIT %DS* SOMIT STRIM
 SOMIT XDF SOMIT DOIT SOMIT STORIT SOMIT %ASMCHK
 SOMIT GETIMMED SOMIT DEBUGERMSG
 SOMIT %WORDFORWARD SOMIT %CLIFORWARD
 SOMIT DOLVL SOMIT CNVMAX
 SOMIT CNVNUM SOMIT CNVSTK SOMIT FCBS SOMIT NLLIN
 SOMIT %LST2 SOMIT %RWCOM
 SOMIT %DIO# SOMIT %CLOSE SOMIT %IBUFS
 SOMIT %DIOSET SOMIT %PFNERR
 SOMIT %UPC SOMIT %DTMP SOMIT %CSPSH#
 SOMIT %MPYU# SOMIT %CDIV# SOMIT %DIVU#

SYSAPPEND

FORGETSYSOMIT