Block 4023
( acl-std79.4th - FORTH-79/83 standard-word-only lockdown )
( Denies+pins every dict word not on ACL-STD79-LIST below. )
( Excludes: BYE, COLD/WARM/REBOOT/SAVE-SYSTEM, the block   )
( editor (L S SHOW EDIT UPDATE SAVE-BUFFERS), BLK-ACL-*,   )
( FORGET/FENCE. Kept: (BRANCH) etc -- IF/DO/LOOP compile   )
( calls to these; denying them breaks control flow.        )
( Full rationale: FABRIC-3.md, 2026-09-07. )
CREATE ACL-STD79-LIST

Block 4024
( Stack + return stack )
' DROP , ' DUP , ' ?DUP , ' SWAP , ' OVER ,
' ROT , ' -ROT , ' DEPTH , ' PICK , ' ROLL ,
' >R , ' R> , ' R@ ,

Block 4025
( Memory )
' @ , ' ! , ' C@ , ' C! , ' +! , ' -! ,
' 2@ , ' 2! , ' FILL , ' MOVE , ' ERASE ,
' CELLS ,

Block 4026
( Arithmetic )
' + , ' - , ' * , ' / , ' MOD , ' /MOD ,
' */ , ' */MOD , ' 1+ , ' 1- , ' 2+ , ' 2- ,
' 2* , ' 2/ , ' ABS , ' NEGATE , ' MIN , ' MAX ,

Block 4027
( Logical / comparison, part 1 )
' AND , ' OR , ' XOR , ' NOT , ' INVERT ,
' LSHIFT , ' RSHIFT , ' 0= , ' 0< , ' 0> ,
' 0<> , ' = , ' <> ,

Block 4028
( Logical / comparison, part 2 )
' < , ' > , ' >= , ' <= , ' U< , ' U> ,
' WITHIN , ' TRUE , ' FALSE ,

Block 4029
( Mixed / double arithmetic, part 1 )
' M+ , ' M- , ' M* , ' M/MOD ,
' S>D , ' D+ , ' D- , ' DNEGATE , ' DABS ,
' DMAX , ' DMIN , ' D< , ' D= ,

Block 4030
( Mixed / double arithmetic, part 2 )
' 2DROP , ' 2DUP , ' 2SWAP , ' 2OVER ,
' 2ROT , ' 2>R , ' 2R> , ' 2R@ ,
' D0= , ' D0< , ' D2* , ' D2/ ,

Block 4031
( Formatted output )
' . , ' .R , ' U. , ' U.R , ' D. , ' D.R ,
' .S , ' ? , ' DUMP , ' <# , ' # , ' #S ,
' #> , ' HOLD , ' SIGN , ' BASE ,
' DECIMAL , ' HEX , ' OCTAL ,

Block 4032
( Strings, part 1 )
' COUNT , ' EXPECT , ' SPAN , ' QUERY ,
' TIB , ' WORD , ' (s") , ' S" , ' >IN ,
' SOURCE , ' BL , ' ['] ,

Block 4033
( Strings, part 2 )
' LITERAL , ' [LITERAL] , ' CONVERT ,
' NUMBER , ' ENCLOSE , ' -TRAILING ,
' CMOVE , ' CMOVE> , ' COMPARE ,
' SEARCH , ' SCAN , ' SKIP , ' BLANK ,

Block 4034
( I/O )
' EMIT , ' CR , ' KEY , ' ?TERMINAL ,
' TYPE , ' SPACE , ' SPACES ,
' (do-string) , ' ." ,

Block 4035
( Block -- read-only subset, no editor/writer )
' BLOCK , ' BUFFER , ' FLUSH , ' LOAD ,
' LIST , ' THRU , ' SCR , ' --> ,

Block 4036
( Dictionary space )
' HERE , ' ALIGN , ' ALLOT , ' , , ' C, ,
' 2, , ' PAD , ' SP! , ' SP@ , ' LATEST ,

Block 4037
( Dictionary internals -- introspection only; )
( execution stays gated per-target-word.      )
' SMUDGE , ' HIDDEN , ' >BODY , ' >NAME ,
' NAME> , ' >LINK , ' LINK> , ' CFA ,
' LFA , ' NFA , ' PFA , ' TRAVERSE ,
' INTERPRET , ' FIND ,

Block 4038
( Vocabulary / search order )
' VOCABULARY , ' DEFINITIONS , ' CONTEXT ,
' CURRENT , ' FORTH , ' ORDER , ' (FIND) ,

Block 4039
( System -- lifecycle words excluded )
' WORDS , ' VLIST , ' SEE , ' PAGE ,
' EXECUTE , ' NOP , ' QUIT , ' ABORT ,
' (ABORT") , ' ABORT" , ' ( , ' \ ,

Block 4040
( Defining words -- FORGET/FENCE excluded )
' : , ' ; , ' CREATE , ' VARIABLE ,
' CONSTANT , ' IMMEDIATE , ' STATE ,
' [ , ' ] , ' COMPILE , ' [COMPILE] ,
' LIT , ' DOES> ,

Block 4041
( Control flow runtime primitives -- kept, )
( IF/DO/LOOP compile calls to these. )
' (BRANCH) , ' (0BRANCH) , ' (?DO) ,
' (DO) , ' (LOOP) , ' (+LOOP) , ' (LEAVE) ,

Block 4042
( Control flow, part 1 )
' IF , ' ELSE , ' THEN , ' BEGIN ,
' WHILE , ' REPEAT , ' AGAIN , ' UNTIL ,

Block 4043
( Control flow, part 2 )
' ?DO , ' DO , ' LOOP , ' +LOOP ,
' LEAVE , ' I , ' J , ' UNLOOP ,
' EXIT , ' CASE , ' OF , ' ENDOF ,
' ENDCASE ,

Block 4044
( ACL-STD79-ALLOWED? ( xt -- flag ) )
: ACL-STD79-ALLOWED? ( xt -- flag )
  >R
  ACL-STD79-LIST
  BEGIN
    DUP @
  WHILE
    DUP @ R@ = IF R> DROP DROP TRUE EXIT THEN
    1 CELLS +
  REPEAT
  DROP R> DROP FALSE ;

Block 4047
( ACL-LOCKDOWN-STD79's own walk loop calls all   )
( four of these on every iteration -- if the     )
( walk denied any one, it would deny its own      )
( ability to keep running: a real self-           )
( referential fault caught live 2026-09-07 (VM    )
( fault, emergency console disabled), twice, one  )
( word at a time. Must all stay allowed. Sentinel )
( last.                                            )
' ACL-STD79-LIST , ' ACL-STD79-ALLOWED? ,
' ACL-ALLOW! , ' ACL-PIN ,
0 ,   ( sentinel )

Block 4045
( ACL-WALK-MARK's own xt = correct walk-  )
( start (the true dictionary head at the  )
( moment the walk runs). Same >LINK/LINK> )
( traversal ACL-INIT-PRIMITIVES/WORDS use. )
: ACL-WALK-MARK ( -- ) ;

Block 4046
: ACL-LOCKDOWN-STD79 ( -- )
  ['] ACL-WALK-MARK
  BEGIN
    DUP
  WHILE
    DUP ACL-STD79-ALLOWED?
    IF   1 OVER ACL-ALLOW!
    ELSE 0 OVER ACL-ALLOW!
    THEN
    DUP ACL-PIN
    DUP >LINK LINK>
    SWAP DROP
  REPEAT
  DROP ;