( STARTUP SCREEN )                                                                                                              \ SOL-11 VERSION 0.5                                            \ BY NILS M HOLM, 2001;  IN THE PUBLIC DOMAIN                                                                                   CR .( WELCOME TO SOL) CR CR                                     .( KERNEL SIZE IS ) HERE ' SOL 2- - . .(  BYTES) CR             .( MEMORY SIZE IS ) MEMTOP U? .(  BYTES) CR CR                  .( THESE MESSAGES ARE LOADED FROM BLOCK #9.) CR                 .( TYPE  9 LIST  TO VIEW OR EDIT THIS BLOCK.) CR CR             .( THIS DISK CONTAINS THE HLL PART OF THE) CR                   .( SOL KERNEL. TYPE  9 51 INDEX  FOR A TABLE) CR                .( OF CONTENTS.) CR CR                                          .( REMEMBER TO TYPE  SAVE-BUFFERS  BEFORE) CR                   .( TURNING OFF YOUR MACHINE.) CR CR                             .( SOL IS READY TO TAKE COMMANDS NOW.) CR CR                    41 WORD ( KERNEL LOAD SCREEN ) DROP                                                                                             : \D >IN @ 64 + 63 INVERT AND >IN ! ;                           \D \D ( --> ) H:-S -- INTRODUCE DOCUMENTATION COMMENT                                                                           : ( 41 WORD DROP ; IMMEDIATE ( --> )                            \D ( ( --> ) H:IS -- INTRODUCE PARENTHESIZED COMMENT                                                                            11 LOAD  12 LOAD  13 LOAD  14 LOAD  15 LOAD  16 LOAD  17 LOAD   18 LOAD  19 LOAD  20 LOAD  21 LOAD  22 LOAD  23 LOAD  24 LOAD   25 LOAD  26 LOAD  27 LOAD  28 LOAD  29 LOAD  30 LOAD  31 LOAD   32 LOAD  33 LOAD  34 LOAD  35 LOAD  36 LOAD  37 LOAD  38 LOAD   39 LOAD  40 LOAD  41 LOAD  42 LOAD  43 LOAD  44 LOAD  45 LOAD   46 LOAD  47 LOAD  48 LOAD  49 LOAD  50 LOAD  51 LOAD                                                                                                                                            ( COMPILATION WORDS )                                                                                                           \D [COMPILE] ( --> ) H:IS -- COMPILE IMMEDIATE WORD             : [COMPILE] ( --> ) ' , ; IMMEDIATE                                                                                             \D LITERAL ( N --> ) H:I- -- COMPILE LITERAL NUMBER             : LITERAL ( N --> ) (LIT) (LIT) , , ; IMMEDIATE                                                                                 \D ['] ( --> ) H:IS -- COMPILE ADDRESS OF WORD AS LITERAL       : ['] ( --> ) ' [COMPILE] LITERAL ; IMMEDIATE                                                                                   \D COMPILE ( --> ) H:IS -- COMPILE CODE TO COMPILE WORD         : COMPILE ( --> ) [COMPILE] ['] ['] , , ; IMMEDIATE                                                                             \D RECURSE ( --> ) H:I- -- CALL CURRENTLY DEFINED WORD          : RECURSE ( --> ) LAST @ 6 + , ; IMMEDIATE                      ( DEFINITION WORDS )                                                                                                            \D VARIABLE ( --> ) HD-S -- DEFINE VARIABLE                     : VARIABLE ( --> ) CREATE 0 , LINK ;                                                                                            \D CONSTANT ( N --> ) HD-S -- DEFINE CONSTANT                   : CONSTANT ( N --> ) CREATE  H @ 2 - H !                          COMPILE (CONST) , LINK ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ( CONSTANTS AND CONVERSION )                                                                                                    \D 0 ( --> 0 ) HC-- -- CONSTANT 0                                      0 CONSTANT 0                                             \D 1 ( --> 1 ) HC-- -- CONSTANT 1                                      1 CONSTANT 1                                             \D 2 ( --> 2 ) HC-- -- CONSTANT 2                                      2 CONSTANT 2                                             \D FALSE ( --> 0 ) HC-- -- LOGICAL FALSITY                             0 CONSTANT FALSE                                         \D TRUE ( --> -1 ) HC-- -- LOGICAL TRUTH                        1 NEGATE CONSTANT TRUE                                          \D BL ( --> 32 ) HC-- -- SPACE CHARACTER                              32 CONSTANT BL                                            \D B/BUF ( --> 1024 ) HC-- -- BYTES PER BUFFER                      1024 CONSTANT B/BUF                                         ( CONSTANTS AND CONVERSION )                                                                                                    \D C/L ( --> 64 ) HC-- -- CHARACTERS PER LINE                         64 CONSTANT C/L                                           \D L/BUF ( --> 16 ) HC-- -- LINES PER BUFFER                         16 CONSTANT L/BUF                                          \D CELL ( --> 2 ) HC-- -- BYTES PER CELL                               2 CONSTANT CELL                                                                                                          \D +CELL ( N --> N+2 ) H:-- -- ADVANCE TO NEXT CELL             : +CELL ( N --> N+2 ) CELL + ;                                                                                                  \D -CELL ( N --> N-2 ) H:-- -- GO BACK ONE CELL                 : -CELL ( N --> N-2 ) CELL - ;                                                                                                                                                                  ( CONSTANTS AND CONVERSION )                                                                                                    \D CELLS ( N --> N*2 ) H:-- -- CONVERT CELLS TO BYTES           : CELLS ( N --> N*2 ) 1 LSHIFT ;                                                                                                \D /CELL ( N --> N/2 ) H:-- -- CONVERT BYTES TO CELLS           : /CELL ( N --> N/2 ) 1+ 1 RSHIFT ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( FLOW CONTROL )                                                                                                                \D HERE ( --> A ) H:-- -- BEGINNING OF HEAP                     : HERE ( --> A ) H @ ;                                                                                                          \D MARK ( --> A ) H:-- -- CREATE MARK FOR BACKPATCHING          : MARK ( --> A ) HERE 0 , ;                                                                                                     \D RESOLVE ( A --> ) H:-- -- RESOLVE (BACKPATCH) MARK           : RESOLVE ( A --> ) HERE SWAP ! ;                                                                                               \D IF ( F --> ) HSI- -- INTRODUCE CONDITIONAL BRANCH            : IF ( F --> ) COMPILE (?BR) MARK ; IMMEDIATE                                                                                   \D ELSE ( --> ) HSI- -- INTRODUCE ALTERNATE COND. BRANCH        : ELSE ( --> ) COMPILE (BR) MARK SWAP RESOLVE ; IMMEDIATE       ( FLOW CONTROL )                                                                                                                \D THEN ( --> ) HSI- -- DELIMIT CONDITONAL BRANCH               : THEN ( --> ) RESOLVE ; IMMEDIATE                                                                                              \D BEGIN ( --> ) HSI- -- INTRODUCE LOOP                         : BEGIN ( --> ) HERE ; IMMEDIATE                                                                                                \D WHILE ( F --> ) HSI- -- INTRODUCE WHILE LOOP BODY            : WHILE ( F --> ) COMPILE (?BR) MARK ; IMMEDIATE                                                                                \D REPEAT ( --> ) HSI- -- DELIMIT BEGIN-WHILE-REPEAT LOOP       : REPEAT ( --> ) COMPILE (BR) SWAP , RESOLVE ; IMMEDIATE                                                                        \D AGAIN ( --> ) HSI- -- DELIMIT BEGIN-AGAIN LOOP BODY          : AGAIN ( --> ) COMPILE (BR) , ; IMMEDIATE                      ( FLOW CONTROL )                                                                                                                \D FOR ( N --> ) HSI- -- INTRODUCE FOR-NEXT LOOP                : FOR ( N --> ) COMPILE >R HERE ; IMMEDIATE                                                                                     \D (NEXT) ( --> ) HR-- -- 'NEXT' RUNTIME                        : (NEXT) ( --> ) R> R> 1- DUP IF >R 0 ELSE DROP 1 THEN SWAP >R ;                                                                \D NEXT ( --> ) HSI- -- DELIMIT FOR FOR-NEXT LOOP               : NEXT ( --> ) COMPILE (NEXT) COMPILE (?BR) , ; IMMEDIATE                                                                                                                                                                                                                                                                                                                                                                                                       ( STACK WORDS )                                                                                                                 \D NIP ( N M --> M ) H:-- -- REMOVE 2ND STACK MEMBER            : NIP ( N M --> M ) SWAP DROP ;                                                                                                 \D -ROT ( N M K --> K N M ) H:-- -- ROTATE STACK DOWN           : -ROT ( N M K --> K N M ) ROT ROT ;                                                                                            \D DEPTH ( --> N ) H:-- -- NUMBER OF MEMBERS ON STACK           : DEPTH ( --> N ) 2046 SP@ - /CELL ;                                                                                            \D ?DUP ( N --> N [N] ) H:-- -- DUP IF TOS NOT ZERO             : ?DUP ( N --> N [N] ) DUP IF DUP THEN ;                                                                                        \D 2DROP ( N M --> ) H:-- -- DROP TWO MEMBERS                   : 2DROP ( N M --> ) DROP DROP ;                                 ( STACK WORDS )                                                                                                                 \D 2DUP ( N M --> N M N M ) H:-- -- DUP TWO MEMBERS             : 2DUP ( N M --> N M N M ) OVER OVER ;                                                                                          \D D0= ( N M --> F ) H:-- -- TEST 2 MEMBERS FOR ZERO            : D0= ( N M --> F ) NOT SWAP NOT AND ;                                                                                          \D D= ( N M K L --> F ) H:-- -- TEST 2 PAIRS FOR EQUALITY       : D= ( N M K L --> F ) ROT = -ROT = AND ;                                                                                       \D D<> ( N M K L --> F ) H:-- -- TEST 2 PAIRS FOR INEQUALITY    : D<> ( N M K L --> F ) D= NOT ;                                                                                                \D +! ( N A --> ) H:-- -- INCREMENT VAR AT TOS BY NUMBER        : +! ( N A --> ) DUP @ ROT + SWAP ! ;                           ( MORE FLOW CONTROL )                                                                                                           \D (DO) ( LIM I --> ) HR-- -- 'DO' RUNTIME                      : (DO) ( LIM I --> ) SWAP R> -ROT >R >R >R ;                                                                                    \D DO ( LIM I --> ) HSI- -- INTRODUCE DO-LOOP LOOP              : DO ( LIM I --> ) COMPILE (DO) HERE ; IMMEDIATE                                                                                \D (+LOOP) ( N --> ) HR-- -- '+LOOP' / 'LOOP' RUNTIME           : (+LOOP) ( N --> ) R> R> ROT + R> 2DUP                           > IF 2DROP 1 ELSE >R >R 0 THEN SWAP >R ;                                                                                      \D +LOOP ( N --> ) HSI- -- DELIMIT DO LOOP WITH VAR INCREMENT   : +LOOP ( N --> ) COMPILE (+LOOP) COMPILE (?BR) , ; IMMEDIATE                                                                                                                                   ( MORE FLOW CONTROL )                                                                                                           \D LOOP ( --> ) HSI- -- DELIMIT DO LOOP                         : LOOP ( --> ) 1 [COMPILE] LITERAL [COMPILE] +LOOP ; IMMEDIATE                                                                  \D I ( --> N ) H:-- -- DO-LOOP / FOR-NEXT INDEX                 : I ( --> N ) R> R@ SWAP >R ;                                                                                                   \D I' ( --> N ) H:-- -- DO-LOOP LIMIT                           : I' ( --> N ) R> R> R@ -ROT >R >R ;                                                                                            \D LEAVE ( --> ) H:-- -- LEAVE DO-LOOP LOOP                     : LEAVE ( --> ) R> R> R> NIP DUP >R >R >R ;                                                                                     \D UNTIL ( F --> ) HSI- -- DELIMIT BEGIN-UNTIL LOOP             : UNTIL ( F --> ) COMPILE (?BR) , ; IMMEDIATE                   ( MORE FLOW CONTROL )                                                                                                           \D BREAK ( --> ) H:-- -- LEAVE FOR-NEXT LOOP                    : BREAK ( --> ) R> R> DROP 1 >R >R ;                                                                                            \D ?LEAVE ( F --> ) H:-- -- LEAVE DO-LOOP LOOP IF TOS TRUE      : ?LEAVE ( F --> ) IF R> LEAVE >R THEN ;                                                                                        \D ?BREAK ( F --> ) H:-- -- LEAVE FOR-NEXT LOOP IF TOS TRUE     : ?BREAK ( F --> ) IF R> BREAK >R THEN ;                                                                                        \D ?EXIT ( F --> ) H:-- -- EXIT IF TOS TRUE                     : ?EXIT ( F --> ) IF R> DROP THEN ;                                                                                             \D DOCASE ( --> ) HSI- -- INTRODUCE DOCASE CONSTRUCT            : DOCASE ( --> ) 0 ; IMMEDIATE                                  ( MORE FLOW CONTROL )                                                                                                           \D CASE> ( F --> ) HSI- -- INTRODUCE CASE OF DOCASE             : CASE> ( F --> ) COMPILE (?BR) MARK ; IMMEDIATE                                                                                \D ;; ( --> ) HSI- -- DELIMIT CASE OF DOCASE                    : ;; ( --> ) COMPILE (BR) MARK SWAP RESOLVE ; IMMEDIATE                                                                         \D OTHERWISE ( --> ) HSI- -- INTRODUCE DEFAULT BRANCH OF DOCASE : OTHERWISE ( --> ) ; IMMEDIATE                                                                                                 \D CASEND ( --> ) HSI- -- DELIMIT DOCASE CONSTRUCT              : CASEND ( --> ) BEGIN DUP WHILE RESOLVE REPEAT DROP ;            IMMEDIATE                                                                                                                                                                                     ( ARITHMETIC )                                                                                                                  \D ABS ( N --> |N| ) H:-- -- ABSOLUTE VALUE OF INTEGER          : ABS ( N --> |N| ) DUP 0 < IF NEGATE THEN ;                                                                                    \D MIN ( N --> N|M ) H:-- -- MINIMUM OF TWO INTEGERS            : MIN ( N M --> N|M ) 2DUP < IF DROP ELSE NIP THEN ;                                                                            \D MAX ( N --> N|M ) H:-- -- MAXIMUM OF TWO INTEGERS            : MAX ( N M --> N|M ) 2DUP > IF DROP ELSE NIP THEN ;                                                                            \D 2+ ( N --> N+2 ) H:-- -- INCREMENT BY 2                      : 2+ ( N --> N+2 ) 2 + ;                                                                                                        \D 2- ( N --> N-2 ) H:-- -- DECREMENT BY 2                      : 2- ( N --> N-2 ) 2 - ;                                        ( ARITHMETIC )                                                                                                                  \D 0= ( N --> F ) H:-- -- TEST FOR ZERO                         : 0= ( N --> F ) NOT ;                                                                                                          \D * ( N M --> N*M ) H:-- -- SIGNED PRODUCT                     : * ( N M --> N*M ) 1 */MOD DROP ;                                                                                              \D / ( N M --> N/M ) H:-- -- SIGNED QUOTIENT                    : / ( N M --> N/M ) 1 SWAP */MOD DROP ;                                                                                         \D MOD ( N M --> N MOD M ) H:-- -- MODULUS                      : MOD ( N M --> N MOD M ) 1 SWAP */MOD NIP ;                                                                                    \D /MOD ( N M --> N/M N MOD M ) H:-- -- QUOTIENT AND MODULUS    : /MOD ( N N --> N/M N MOD M ) 1 SWAP */MOD ;                   ( ARITHMETIC )                                                                                                                  \D */ ( N M K --> N*M/K ) H:-- -- N*M/K, DOUBLE INTERMEDIATE    : */ ( N M K --> N*M/K ) */MOD DROP ;                                                                                           \D 2/ ( N --> N/2 ) H:-- -- DIVISION BY 2                       : 2/ ( N --> N/2 ) 2 / ;                                                                                                        \D U/ ( U --> U/V ) H:-- -- UNSIGNED QUOTIENT                   : U/ ( U V --> U/V ) U/MOD DROP ;                                                                                               \D UMOD ( U V --> U MOD V ) H:-- -- MODULUS                     : UMOD ( U V --> U MOD V ) U/MOD NIP ;                                                                                                                                                                                                                          ( CHARACTER FUNCTIONS )                                                                                                         \D CHAR ( --> C ) H:IS -- COMPILE CHARACTER LITERAL             : CHAR ( --> C ) BL WORD 1+ C@                                    STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE                                                                                 \D >LOWER ( C --> C2 ) H:-- -- CONVERT CHARACTER TO LOWER CASE  : >LOWER ( C --> C2 ) DUP CHAR A CHAR Z WITHIN IF BL + THEN ;                                                                   \D >VISUAL ( C --> C2 ) H:-- -- REPLACE UNPRINTABLE CHARACTERS  : >VISUAL ( C --> C2 ) DUP BL 126 WITHIN NOT IF                    DROP CHAR _ THEN ;                                                                                                                                                                                                                                                                                                           ( STRING FUNCTIONS )                                                                                                            \D $SKIP ( --> A ) H:-- -- SKIP OVER INLINE STRING LITERAL      : $SKIP ( --> A ) DUP DUP C@ + 2+ 1 INVERT AND ;                                                                                \D ($") ( --> A ) H:-- -- RUNTIME OF $"                         : ($") ( --> A ) R> $SKIP >R ;                                                                                                  \D $SAVE ( --> A ) H:-S -- SAVE STRING IN LEXICON               : $SAVE ( --> A ) 0 , HERE 2-  DUP H !                            CHAR " WORD C@ 4 + 1 INVERT AND ALLOT ;                                                                                       \D $" ( --> A ) HSIS -- COMPILE STRING LITERAL                  : $" ( --> A ) $SAVE ['] ($") SWAP ! ; IMMEDIATE                                                                                                                                                ( STRING FUNCTIONS )                                                                                                            \D (.") ( --> ) H:-S -- RUNTIME OF ."                           : (.") ( --> ) R> $SKIP >R COUNT TYPE ;                                                                                         \D ." ( --> ) H:IS -- TYPE STRING LITERAL                       : ." ( --> ) $SAVE ['] (.") SWAP ! ; IMMEDIATE                                                                                  \D (ABORT) ( --> ) H:-- -- RUNTIME OF ABORT"                    : (ABORT) ( --> ) CR QUIT ;                                                                                                     \D ABORT" ( --> ) H:IS -- PRINT STRING AND QUIT                 : ABORT" ( --> ) [COMPILE] ." COMPILE (ABORT) ; IMMEDIATE                                                                       \D .( ( --> ) H:IS -- PRINT EXECUTION TIME COMMENT              : .( ( --> ) CHAR ) WORD COUNT TYPE ; IMMEDIATE                 ( STRING FUNCTIONS )                                                                                                            \D \S ( --> ) H:-S -- COMMENT TO END OF SCREEN                  : \S ( --> ) 0 WORD DROP ;                                                                                                      \D \ ( --> ) H:IS -- COMMENT TO END OF LINE                     : \ ( --> ) \D ; IMMEDIATE                                                                                                      \D BLANK ( A N --> ) H:IS -- FILL MEMORY WITH BLANKS            : BLANK ( A N --> ) BL FILL ;                                                                                                   \D ERASE ( A N --> ) H:IS -- FILL MEMORY WITH ZEROES            : ERASE ( A N --> ) 0 FILL ;                                                                                                                                                                                                                                    ( CONSOLE I/O )                                                                                                                 \D SPACES ( N --> ) H:-- -- EMIT SPACE CHARACTERS               : SPACES ( N --> ) FOR SPACE NEXT ;                                                                                             \D ESC-[ ( --> ) H:-- -- EMIT ESC AND '['                       : ESC-[ ( --> ) 27 EMIT CHAR [ EMIT ;                                                                                           \D HOME ( --> ) H:-- -- MOVE CURSOR TO TOP/LEFT CORNER          : HOME ( --> ) ESC-[ CHAR H EMIT ;                                                                                              \D CLRSCR ( --> ) H:-- -- CLEAR REST OF SCREEN                  : CLRSCR ( --> ) ESC-[ CHAR J EMIT ;                                                                                            \D CLRLN ( --> ) H:-- -- CLEAR REST OF CURRENT LINE             : CLRLN ( --> ) ESC-[ CHAR K EMIT ;                             ( CONSOLE I/O )                                                                                                                 \D PAGE ( --> ) H:-- -- CLEAR SCREEN                            : PAGE ( --> ) HOME CLRSCR ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ( NUMERIC CONVERSION AND I/O )                                                                                                  \D HLD ( --> A ) HV-- -- PTR TO NUMERIC CONVERSION BUFFER       VARIABLE HLD                                                                                                                    \D PAD ( --> A ) H:-- -- SCRATCH PAD ADDRESS                    : PAD ( --> A ) HERE ;                                                                                                          \D <# ( N N --> N N ) H:-- -- BEGIN PICTURED CONVERSION         : <# ( N N --> N N ) PAD 128 + HLD ! ;                                                                                          \D HOLD ( C --> ) H:-- -- INSERT CHARACTER INTO SCRATCH PAD     : HOLD ( C --> ) HLD @ C! 1 NEGATE HLD +! ;                                                                                     \D SIGN ( N M --> N M ) H:-- -- HOLD MINUS IF N NEGATIVE        : SIGN ( N M --> N M ) OVER 0 < IF CHAR - HOLD THEN ;           ( NUMERIC CONVERSION AND I/O )                                                                                                  \D # ( N --> M ) H:-- -- CONVERT AND HOLD DIGIT                 : # ( N --> M ) BASE @ U/MOD CHAR 0 + HOLD ;                                                                                    \D #S ( N --> 0 ) H:-- -- CONVERT AND HOLD REMAINING DIGITS     : #S ( N --> 0 ) BEGIN # DUP NOT UNTIL ;                                                                                        \D #> ( N N --> ) H:-- -- END PICTURED NUMERIC CONVERSION       : #> ( N N --> A N ) 2DROP PAD 128 + HLD @ - HLD @ 1+ SWAP ;                                                                    \D . ( N --> ) H:-- -- PRINT SIGNED NUMBER                      : . ( N --> ) SPACE DUP ABS <# #S SIGN #> TYPE ;                                                                                \D U. ( U --> ) H:-- -- PRINT UNSIGNED NUMBER                   : U. ( U --> ) SPACE DUP <# #S #> TYPE ;                        ( NUMERIC CONVERSION AND I/O )                                                                                                  \D .PAD ( L A N --> A N ) H:-- -- PRINT L-N SPACES IF L-N>0     : .PAD ( LEN A N --> A N ) ROT OVER - DUP 0 > IF                  SPACES ELSE DROP THEN ;                                                                                                       \D .R ( N LEN --> ) H:-- -- PRINT SIGNED NUMBER W/PADDING       : .R ( N LEN --> ) SWAP DUP ABS <# #S SIGN #> .PAD TYPE ;                                                                       \D U.R ( U LEN --> ) H:-- -- PRINT UNSIGNED NUMBER W/PADDING    : U.R ( U LEN --> ) SWAP DUP <# #S #> .PAD TYPE ;                                                                               \D ? ( A --> ) H:-- -- PRINT VALUE OF CELL                      : ? ( A --> ) @ . ;                                                                                                                                                                             ( NUMERIC CONVERSION AND I/O )                                                                                                  \D U? ( A --> ) H:-- -- PRINT UNSIGNED VALUE OF CELL            : U? ( A --> ) @ U. ;                                                                                                           \D BINARY ( --> ) H:-- -- SET NUMERIC BASE TO 2                 : BINARY ( --> ) 2 BASE ! ;                                                                                                     \D OCTAL ( --> ) H:-- -- SET NUMERIC BASE TO 8                  : OCTAL ( --> ) 8 BASE ! ;                                                                                                      \D DECIMAL ( --> ) H:-- -- SET NUMERIC BASE TO 10               : DECIMAL ( --> ) 10 BASE ! ;                                                                                                                                                                                                                                   ( NUMERIC CONVERSION AND I/O )                                                                                                  \D #IN ( --> N ) H:-- -- QUERY AND TRANSLATE NUMBER             : #IN ( --> N ) >BUF @ >IN @ QUERY 0 >IN !                        BL WORD ?NUMBER  0= IF 0 THEN  -ROT >IN ! >BUF ! ;                                                                            \D (BASE) ( --> N ) H:-S -- RUNTIME OF '[OCT]' AND '[BIN]'      : (BASE) ( N --> N ) BASE @ SWAP BASE !  BL WORD ?NUMBER           NOT IF BASE ! ABORT"  (BASE)" ELSE  STATE @ IF                   [COMPILE] LITERAL ELSE SWAP THEN THEN  BASE ! ;                                                                             \D [OCT] ( --> N ) HSIS -- COMPILE OCTAL LITERAL                : [OCT] ( --> N ) 8 (BASE) ; IMMEDIATE                                                                                          \D [BIN] ( --> N ) HSIS -- COMPILE BINARY LITERAL               : [BIN] ( --> N ) 2 (BASE) ; IMMEDIATE                          ( LEXICON FUNCTIONS )                                                                                                           \D >LINK ( A --> A ) H:-- -- MOVE FROM CFA TO LINK FIELD        : >LINK ( A --> A ) 3 CELLS - ;                                                                                                 \D >NAME ( A --> A ) H:-- -- MOVE FROM CFA TO NAME FIELD        : >NAME ( A --> A ) 2 CELLS -  ;                                                                                                \D >CFA ( A --> A ) H:-- -- MOVE FROM CFA TO CFA                : >CFA ( A --> A ) ;                                                                                                            \D >PFA ( A --> A ) H:-- -- MOVE FROM CFA TO PFA                : >PFA ( A --> A ) 2 CELLS + ;                                                                                                  \D FENCE ( --> A ) HV-- -- TOP OF PROTECTED AREA                VARIABLE FENCE  ' ( >LINK FENCE !                               ( LEXICON FUNCTIONS )                                                                                                           \D FORGET ( --> ) H:-S -- DELETE WORDS FROM LEXICON             : FORGET ( --> ) ' >LINK DUP                                      FENCE @ U< IF ABORT"  BELOW FENCE" THEN                         DUP @ LEXICON ! DUP LAST ! H ! ;                                                                                              \D EMPTY ( --> ) H:-- -- FORGET ALL UNPROTECTED WORDS           : EMPTY ( --> ) FENCE @ DUP @ LEXICON ! DUP LAST ! H ! ;                                                                        \D HIDDEN ( --> A ) HV-- -- BEGINNING OF HIDDEN AREA            VARIABLE HIDDEN                                                                                                                 \D HIDE> ( --> ) H:-- -- MARK BEGINNING OF HIDDEN AREA          : HIDE> ( --> ) LAST @ HIDDEN ! ;                                                                                               ( LEXICON FUNCTIONS )                                                                                                           \D <HIDE ( --> ) H:-- -- MARK END OF HIDDEN AREA                : <HIDE ( --> ) HIDDEN @ LAST @ ! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( EVEN MORE FLOW CONTROL )                                                                                                      \D DEFER ( --> ) HDIS -- CREATE DEFERRED DEFINITION             : DEFER ( --> ) [COMPILE] : COMPILE HALT [COMPILE] ; ;            IMMEDIATE                                                                                                                     \D IS ( A --> ) HD-S -- BACKPATCH DEFERRED DEFINITION           : IS ( A --> ) ' >PFA ! ;                                                                                                       \D ?IF ( N --> N| ) HSI- -- SHORT FORM OF ?DUP IF               : ?IF ( N --> N| ) COMPILE ?DUP [COMPILE] IF ; IMMEDIATE                                                                                                                                                                                                                                                                                                                                        ( BLOCK I/O FUNCTIONS )                                                                                                         \D UPDATE ( --> ) H:-- -- MARK MOST RECENTLY USED BUFFER        : UPDATE ( --> ) IODESC @ @ 0 >= IF TRUE IODESC @ 2+ ! THEN ;                                                                   \D EMPTY-BUFFERS ( --> ) H:-- -- INVALIDATE I/O BUFFERS         : EMPTY-BUFFERS ( --> ) FALSE 0DESC 2+ !  FALSE 1DESC 2+ !         1 NEGATE  DUP 0DESC !  1DESC ! ;                                                                                             \D SAVE ( A --> ) H:-- -- SAVE AND UNMARK BUFFER, A='[01]DESC   : SAVE ( A --> ) DUP >R DUP 2+ @                                  IF DUP @ SWAP 4 + @ SAVE-BLOCK ELSE DROP THEN                   FALSE R> 2+ ! ;                                                                                                               \D SAVE-BUFFERS ( --> ) H:-- -- SAVE AND UNMARK BUFFERS         : SAVE-BUFFERS ( --> ) 0DESC SAVE 1DESC SAVE ;                  ( BLOCK I/O FUNCTIONS )                                                                                                         \D COPY ( SRC DST --> ) H:-- -- COPY BLOCK                      : COPY ( SRC DST --> ) SWAP BLOCK DROP                            IODESC @ ! UPDATE IODESC @ SAVE ;                                                                                             \D INDEX ( LO HI --> ) H:-- -- LIST BLOCK HEADINGS              : INDEX ( LO HI --> ) SWAP DO                                      I BLOCK DUP C@ CHAR ( = IF                                       CR  I 5 .R  SPACE  C/L TYPE   ELSE                             DROP THEN LOOP ;                                                                                                             \D BUF ( --> A ) H:-- -- ADDRESS OF CURRENT BUFFER              : BUF ( --> A ) IODESC @ 4 + @ ;                                                                                                                                                                ( EDITOR FUNCTIONS )                                                                                                            \D >L ( A N --> A ) H:-- -- ADDRESS OF LINE IN BUFFER           : >L ( A N --> A ) 1- C/L * + ;                                                                                                 \D PRINT ( N --> A ) H:-- -- PRINT LINE OF CURRENT BUFFER       : PRINT ( N --> A ) CR DUP 2 .R SPACE                             BUF SWAP >L DUP C/L TYPE  CHAR | EMIT ;                                                                                       \D LIST ( N --> ) H:-- -- LIST BLOCK                            : LIST ( N --> ) BLOCK DROP L/BUF 1 DO I PRINT DROP LOOP ;                                                                      \D REPLACE ( N --> ) H:-- -- QUERY AND REPLACE LINE             : REPLACE ( N --> ) PRINT CR 3 SPACES QUERY TIB C@ IF              TIB C/L 0 CSCAN DUP IF DUP TIB - C/L SWAP - BLANK THEN          TIB SWAP C/L CMOVE THEN  .OK QUIT ;                          ( EDITOR FUNCTIONS )                                                                                                            \D REST ( N X --> N X M ) H:-- -- SIZE REST OF BUFFER           : REST ( N X --> N X M ) OVER C/L * B/BUF SWAP - ;                                                                              \D INSERT-LINE ( A N --> ) H:-- -- INSERT BLANK LINE            : INSERT-LINE ( A N --> ) 2DUP >L                                 REST DUP IF OVER C/L - -ROT C/L + CMOVE ELSE 2DROP THEN         >L C/L BLANK ;                                                                                                                \D DELETE-LINE ( A N --> ) H:-- -- DELETE LINE                  : DELETE-LINE ( A N --> ) 2DUP >L                                 REST DUP IF OVER C/L + -ROT CMOVE ELSE 2DROP THEN               DROP 16 >L C/L BLANK ;                                                                                                                                                                        ( EDITOR FUNCTIONS )                                                                                                            \D INSERT ( N --> ) H:-- -- INSERT BLANK LINE INTO BUF          : INSERT ( N --> ) BUF SWAP INSERT-LINE ;                                                                                       \D DELETE ( N --> ) H:-- -- DELETE LINE FROM BUF                : DELETE ( N --> ) BUF SWAP DELETE-LINE ;                                                                                       \D P ( --> ) H:-- -- PRINT RECENTLY LISTED BLOCK                : P ( --> ) IODESC @ @ LIST ;                                                                                                                                                                                                                                                                                                                                                                                                                                   ( MORE CONSOLE I/O )                                                                                                            \D CURSOR ( X Y --> ) H:-- -- MOVE CURSOR                       : CURSOR ( X Y --> ) ESC-[ 0 .R CHAR ; EMIT 0 .R CHAR H EMIT ;                                                                  \D SO ( --> ) H:-- -- TURN ON STANDOUT MODE                     : SO ( --> ) ESC-[ CHAR 7 EMIT CHAR m EMIT ;                                                                                    \D SE ( --> ) H:-- -- TURN OFF STANDOUT MODE                    : SE ( --> ) ESC-[ CHAR m EMIT ;                                                                                                                                                                                                                                                                                                                                                                                                                                ( TRAP HANDLER )                                                                                                                \D (TRAP) ( --> ) H:-- -- DEFAULT TRAP HANDLER                  : (TRAP) ( --> ) ABORT"  TRAP" ; ' (TRAP) IS TRAP                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ( SYSTEM UTILITIES )                                                                                                            \D LOADS ( LO HI --> ) H:-- -- LOAD MULTIPLE BLOCKS             : LOADS ( LO HI --> ) OVER - 0 DO DUP I + LOAD LOOP DROP ;                                                                      \D SAVE-SYSTEM ( --> ) H:-- -- REPLACE KERNEL                   : SAVE-SYSTEM ( --> ) SAVE-BUFFERS EMPTY-BUFFERS  7 0 DO           I 1+ I 1024 * 4096 + SAVE-BLOCK LOOP ;                                                                                       \D .STACK ( --> ) H:-- -- PRINT STACK                           : .STACK ( --> ) SP@ BEGIN DUP 2048 < WHILE                        DUP @ . 2+ REPEAT DROP ;                                                                                                                                                                                                                                                                                                     ( SYSTEM GENERATION )                                                                                                           \D STARTUP ( --> ) H:-- -- STARTUP WORD                         : STARTUP ( --> ) 9 LOAD QUIT ;                                                                                                 ' STARTUP HELLO !                                               ' STARTUP 3 CELLS - FENCE !                                                                                                     HERE ' SOL 2- -                                                                                                                 : DONE DUP . ."  BYTES" CR 8192 > IF                               ABORT" KERNEL TOO BIG TO SAVE" THEN                            ." YOU MAY NOW TYPE  SAVE-SYSTEM  TO SAVE THE" CR               ." NEWLY CREATED KERNEL." ;                                                                                                   DONE FORGET DONE                                                ( ADDITIONAL TOOLS )                                                                                                            \D .WORD ( A --> ) H:-- -- PRINT NAME OF WORD                   : .WORD ( A --> ) >NAME COUNT DUP 127 AND .                       DUP 3 U> IF DROP 3 THEN TYPE ;                                                                                                \D WORDS ( --> ) H:-- -- PRINT LEXICON ENTRIES                  : WORDS ( --> ) LEXICON @ BEGIN DUP WHILE                          DUP 6 + .WORD @ REPEAT DROP ;                                                                                                \D -LEX ( A A --> F ) H:-- -- COMPARE LEXICON HEADERS           : -LEX ( A A --> F ) 2DUP @ [OCT] 177577 AND  SWAP @               [OCT] 177577 AND =  -ROT +CELL @ SWAP +CELL @ =  AND ;                                                                                                                                                                                                       ( ADDITIONAL TOOLS )                                                                                                            \D @FIND ( A A --> A|0 ) H:-- -- FIND WORD IN PARTIAL LEXICON   : @FIND ( A A --> A|0 ) BEGIN DUP WHILE                            2DUP 2+ -LEX IF NIP EXIT THEN @ REPEAT NIP ;                                                                                 \D CHECK-LEXICON ( --> ) H:-- -- CHECK LEXICON FOR CONFLICTS    : CHECK-LEXICON ( --> ) LEXICON @ BEGIN DUP WHILE                  DUP DUP 2+ SWAP @ @FIND IF 6 + .WORD CR QUIT THEN               @ CHAR . EMIT REPEAT DROP ;                                                                                                                                                                                                                                                                                                                                                                                                                                  ( ADDITIONAL TOOLS )                                                                                                            \D ODUMP ( A --> ) H:-- -- PRINT 4-WORD OCTAL DUMP              : ODUMP ( A --> ) BASE @ SWAP OCTAL 7 0 DO DUP I + @ 7 U.R         CELL +LOOP DROP BASE ! ;                                                                                                     \D CDUMP ( A --> ) H:-- -- PRINT 8-CHARACTER ASCII DUMP         : CDUMP ( A --> ) 7 0 DO DUP I + C@ >VISUAL EMIT LOOP DROP ;                                                                    \D DUMP ( A N --> ) H:-- -- PRINT OCTAL/CHAR DUMP               : DUMP ( A N --> ) 8 / 0 DO  CR  DUP I 8 * + DUP DUP               BASE @ SWAP OCTAL 7 U.R BASE ! 2 SPACES                         ODUMP 2 SPACES CDUMP  LOOP  DROP ;                                                                                           \D DDUMP ( BLK --> ) H:-- -- PRINT BLOCK DUMP                   : DDUMP ( BLK --> ) BLOCK B/BUF 1- DUMP ;                       ( SCREEN EDITOR )                                                                                                               : EDITOR ;                                                      VARIABLE E.INDENT  VARIABLE E.MBELL   VARIABLE E.UPCASE                                                                         HIDE>                                                                                                                           VARIABLE EB0    SRC @ EB0 !    VARIABLE E^XOK                   VARIABLE EBLK                                                   VARIABLE EBUF C/L ALLOT        VARIABLE ELAST C/L ALLOT         VARIABLE EX                    VARIABLE EY                      VARIABLE EMODI                                                  VARIABLE EMSG                                                   VARIABLE E#BUF                                                  VARIABLE E>MARK                                                                                                                 ( SCREEN EDITOR )                                                                                                               ( OPTION EDITOR -- PRESS ^X TO EXIT )                                                                                           ( 1/0  OPTION         DESCRIPTION )                                1   E.INDENT !   ( AUTO INDENT )                                1   E.MBELL  !   ( MARGIN BELL )                                1   E.UPCASE !   ( AUTO UPCASE )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             \S SCREEN EDITOR -- HELP                                           ^I    MOVE          ESC-B  BREAK LINE AT CURSOR              ^J ^K ^L CURSOR        ESC-J  JOIN LINES AT CURSOR              ^A ^E    HOME/END                                               ^F ^B    NEXT/PREV     ESC-M  SET MARK AT CURRENT LINE                                 ESC-C  CUT FROM MARK TO CURRENT          ^D   DELETE CHAR       ESC-Y  COPY FROM MARK TO CURRENT         ^H   DEL CHAR LEFT     ESC-P  PASTE CUT/COPIED LINES            ^C   CUT LINE                                                   ^P   PASTE LINE        ESC-G  GOTO BLOCK                                                                                        CR   OPEN LINE         ESC-S  SAVE BLOCK                        ^O   OPEN ABOVE        ESC-Q  QUIT (NO SAVE)                                           ESC-X  SAVE AND EXIT            PRESS ^X ^R   SCR REFRESH                                    (CONTROL-X) ESC  OPEN MENU         ESC-O  OPTION EDITOR           TO RETURN ( SCREEN EDITOR )                                                                                                               : VLINE ( --> ) CHAR + EMIT C/L 2+ FOR CHAR - EMIT NEXT           CHAR + EMIT ;                                                                                                                 : HLINES ( Y --> ) DUP 1 SWAP CURSOR CHAR | EMIT                  C/L 2+ 2+ SWAP CURSOR CHAR | EMIT ;                                                                                           : FRAME ( --> ) HOME VLINE 17 2 DO I HLINES LOOP CR VLINE         1 E>MARK @ 2+ CURSOR CHAR > EMIT ;                                                                                            : DISPLAY ( N --> ) 16 SWAP 1+ DO                                  3 I 1+ CURSOR  BUF I >L  C/L TYPE LOOP ;                                                                                     : EREFRESH ( --> ) PAGE FRAME 0 DISPLAY ;                                                                                       ( SCREEN EDITOR )                                                                                                               : EBELL ( --> ) 7 EMIT ;                                                                                                        : ESYNC ( --> ) EX @ 2+ 1+ EY @ 2+ CURSOR ;                                                                                     : ELINE ( --> A ) BUF EY @ 1+ >L ;                                                                                              : EREDRAW ( --> ) ELINE EX @ + C/L EX @ - TYPE ;                                                                                : EFWD ( --> ) EX @ 1+ DUP C/L >= IF DROP 0 THEN EX ! ;                                                                         : EBACK ( --> ) EX @ 1- DUP 0 < IF DROP C/L 1- THEN EX ! ;                                                                      : EDOWN ( --> ) EY @ 1+ DUP L/BUF >= IF DROP 0 THEN EY ! ;                                                                      ( SCREEN EDITOR )                                                                                                               : ELEN ( A --> N ) 0 C/L FOR                                       OVER I + 1- C@ BL <> IF DROP I BREAK THEN                      NEXT  NIP ;                                                                                                                   : EUP ( --> ) EY @ 1- DUP 0 < IF DROP L/BUF 1- THEN EY ! ;                                                                      : EHOME ( --> ) 0 EX ! ;                                                                                                        : EEOLN ( --> ) ELINE ELEN DUP C/L = IF 1- THEN EX ! ;                                                                          : ECHANGE ( --> ) 1 EMODI ! ;                                                                                                   : E>BUF ( --> A ) HERE 130 + ;                                                                                                  ( SCREEN EDITOR )                                                                                                               : ECLRMSG ( --> ) 1 19 CURSOR CLRLN 0 EMSG ! ESYNC ;                                                                            : EKEY ( --> ) KEY EMSG @ IF ECLRMSG THEN                         E.UPCASE @ IF >UPPER THEN ;                                                                                                   : EPOST ( A N --> ) 1 19 CURSOR COUNT TYPE  1 EMSG ! ;                                                                          : YN ( A N --> F ) EPOST ."  [YN] "                               KEY ECLRMSG >UPPER CHAR Y = ;                                                                                                 : E?MODI ( --> ) EMODI @ IF                                        $" SCREEN NOT SAVED. LOSE CHANGES?" YN NOT ELSE                 0 THEN ;                                                                                                                     ( SCREEN EDITOR )                                                                                                               : ELOAD ( N --> ) DUP EBLK ! BLOCK DROP 0 DISPLAY 0 EMODI !       $" BLOCK #" EPOST EBLK ? ;                                                                                                    : ESAVE ( --> ) UPDATE SAVE-BUFFERS  0 EMODI ! ;                                                                                : EQUIT ( --> ) E?MODI ?EXIT                                      EMPTY-BUFFERS EBLK @ ELOAD .OK QUIT ;                                                                                         : ENEXT ( --> ) E?MODI ?EXIT                                      EBLK @ 1+ DUP EBLK ! ELOAD ;                                                                                                  : EPREV ( --> ) E?MODI ?EXIT                                      EBLK @ 1- DUP EBLK ! ELOAD ;                                                                                                  ( SCREEN EDITOR )                                                                                                               : EDELCH ( --> ) EX @ C/L 1- < IF                                  ELINE EX @ + DUP 1+ SWAP C/L EX @ - 1- CMOVE                    BL ELINE C/L + 1- C!                                            EREDRAW THEN  ECHANGE ;                                                                                                      : EBKSP ( --> ) EBACK BACKSPACE EDELCH ;                                                                                        : EINSERT ( C --> ) EX @ C/L 1- < IF                               ELINE EX @ + DUP 1+ C/L EX @ - 1- CMOVE THEN                    ELINE EX @ + C! EREDRAW EFWD  ECHANGE                           EX @ 0= E.MBELL @ AND IF EBELL THEN ;                                                                                        : EOPEN ( --> ) BUF B/BUF + C/L - ELAST C/L CMOVE                 BUF EY @ 1+ INSERT-LINE  EY @ DISPLAY  ECHANGE ;              ( SCREEN EDITOR )                                                                                                               : ELCUT ( --> ) ELINE EBUF C/L CMOVE                              BUF EY @ 1+ DELETE-LINE                                         ELAST BUF B/BUF + C/L - C/L CMOVE                               ELAST C/L BLANK  EY @ DISPLAY  ECHANGE ;                                                                                      : ELPASTE ( --> ) EOPEN EBUF ELINE C/L CMOVE                      EY @ DISPLAY  ECHANGE ;                                                                                                       : EOPENI ( --> ) EY @ 1+ L/BUF >= ?EXIT                           EY @ E.INDENT @ AND IF                                           ELINE C/L FOR DUP C@ BL <> ?BREAK 1+ NEXT                       ELINE - DUP C/L = IF DROP 0 THEN                                1- DUP 0 < IF 1+ THEN  EX !  ELSE                              0 EX ! THEN  EDOWN EOPEN ;                                    ( SCREEN EDITOR )                                                                                                               : ^ ( --> C ) BL WORD 1+ C@ CHAR @ -                               STATE @ IF [COMPILE] LITERAL THEN ; IMMEDIATE                                                                                : $ ( --> C ) [COMPILE] CHAR ; IMMEDIATE                                                                                        : EINIT ( --> ) 0 EX !  0 EY !  0 EMODI !                         EBUF C/L BLANK  ELAST C/L BLANK  0 EMSG !                       0 E>MARK !  0 E#BUF ! ;                                                                                                       : ESELECT ( --> ) 1 19 CURSOR                                     ." B)REAK  C)UT    Y)ANK  G)OTO  EX)IT  O)PTIONS" CR            ." J)OIN   P)ASTE  M)ARK  S)AVE  Q)UIT  H)ELP"                  KEY >UPPER 1 19 CURSOR CLRLN CR CLRLN ;                                                                                       ( SCREEN EDITOR )                                                                                                               : EBREAK ( --> ) EY @ 1+ L/BUF >=  EX @ 1+ C/L =                  EX @ NOT  OR OR  IF EBELL EXIT THEN                             EOPEN ELINE DUP C/L + SWAP C/L CMOVE                            ELINE EX @ + C/L EX @ - BLANK                                   ELINE C/L + DUP EX @ + SWAP C/L EX @ - CMOVE                    ELINE C/L + C/L + EX @ - EX @ BLANK                             EY @ DISPLAY ;                                                                                                                : EJOIN ( --> ) ELINE C/L + ELEN EX @ + C/L >=                    EY @ 1+ L/BUF >=  EX @ 1+ C/L =                                 OR OR  IF EBELL EXIT THEN                                       ELINE C/L + ELINE EX @ + C/L EX @ - CMOVE                       EDOWN ELCUT EUP ESYNC EREDRAW ;                                                                                               ( SCREEN EDITOR )                                                                                                               : EGOTO ( --> ) E?MODI ?EXIT                                      $" GOTO # " EPOST #IN ?IF ELOAD THEN ;                                                                                        : E#BUF! ( --> ) E>MARK @ EY @ - ABS 1+ E#BUF ! ;                                                                               : EYANK ( --> ) E>MARK @ EY @ 2DUP MIN -ROT MAX                   OVER - 1+ C/L *  SWAP C/L * BUF + SWAP                          E>BUF SWAP CMOVE  E#BUF! ;                                                                                                    : ECUT ( --> ) EYANK  E>MARK @ EY !                               E#BUF @ FOR BUF EY @ 1+ DELETE-LINE NEXT                        EY @ DISPLAY ECHANGE ;                                                                                                                                                                        ( SCREEN EDITOR )                                                                                                               : EPASTE ( --> ) E#BUF @ NOT ?EXIT                                E#BUF @ FOR BUF EY @ INSERT-LINE NEXT                           E>BUF ELINE E#BUF @ C/L * CMOVE                                 EY @ DISPLAY ECHANGE ;                                                                                                        DEFER EDITOPTS                                                                                                                  : E2EDIT ( --> ) E?MODI ?EXIT E^XOK @ IF                           $" PRESS ^X TO EXIT OPTIONS/HELP" EPOST DROP EXIT THEN         1 E^XOK !  EBLK @ SWAP EB0 @ + EDITOPTS DROP ESAVE              EB0 @ 1+ LOAD  ELOAD  0 E^XOK ! ;                                                                                             : E.STK ( --> ) 1 19 CURSOR CLRLN .STACK ;                                                                                      ( SCREEN EDITOR )                                                                                                               : ESTATUS ( --> ) 1 19 CURSOR ." BLOCK #" EBLK ?                  EMODI @ IF $"  MODIFIED" ELSE $"  " THEN                        COUNT TYPE  1 EMSG ! ;                                                                                                        : EEOPTS ( --> ) 1 E2EDIT ;                                                                                                     : EHELP ( --> ) 2 E2EDIT ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ( SCREEN EDITOR )                                                                                                               : EMENU ( N --> ) ESELECT DOCASE                                   DUP $ B = CASE> EBREAK ;;                                       DUP $ J = CASE> EJOIN ;;                                        DUP $ G = CASR> EGOTO ;;                                        DUP $ S = CASE> ESAVE ;;                                        DUP $ M = CASE> EY @ E>MARK ! FRAME ;;                          DUP $ C = CASE> ECUT ;;                                         DUP $ Y = CASE> EYANK ;;                                        DUP $ P = CASE> EPASTE ;;                                       DUP $ O = CASE> EEOPTS ;;                                       DUP $ Q = CASE> EQUIT ;;                                        DUP $ X = CASE> ESAVE EQUIT ;;                                  DUP $ H = CASE> EHELP ;;                                       CASEND  DROP ;                                                ( SCREEN EDITOR )                                                                                                               : DOEDIT ( N --> )                                                BEGIN ESYNC EKEY DOCASE                                          DUP ^ I = CASE> EUP ;;     DUP ^ J = CASE> EBACK ;;             DUP ^ K = CASE> EDOWN ;;   DUP ^ L = CASE> EFWD ;;              DUP ^ D = CASE> EDELCH ;;  DUP ^ C = CASE> ELCUT ;;             DUP ^ O = CASE> EOPEN ;;   DUP ^ P = CASE> ELPASTE ;;           DUP ^ H = CASE> EBKSP ;;   DUP ^ R = CASE> EREFRESH ;;          DUP ^ F = CASE> ENEXT ;;   DUP ^ B = CASE> EPREV ;;             DUP ^ A = CASE> EHOME ;;   DUP ^ E = CASE> EEOLN ;;             DUP ^ M = CASE> EOPENI ;;  DUP ^ [ = CASE> EMENU ;;             DUP ^ Z = CASE> E.STK ;;   DUP ^ G = CASE> ESTATUS ;;           DUP ^ X = CASE> E^XOK @ ?EXIT ;;                                OTHERWISE DUP BL CHAR ~ WITHIN IF DUP EINSERT THEN             CASEND DROP AGAIN ;                                           ( SCREEN EDITOR )                                                                                                               : EDIT ( N --> ) E>BUF B/BUF + MEMTOP @ U>= IF                     ABORT"  NOT ENOUGH MEMORY" THEN                                EINIT PAGE FRAME ELOAD                                          E^XOK @ NOT IF $" PRESS ESC H FOR HELP" EPOST THEN              DOEDIT ;                                                                                                                      ' EDIT IS EDITOPTS  <HIDE                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ( SYSTEM INSTALLATION ) \S                                                                                                      TO COPY SOL TO ANOTHER DISK, FOLLOW THESE STEPS                                                                                 1) SELECT A SOURCE DEVICE s AND A TARGET DEVICE t .                AVAILABLE DEVICES: DX=RX01, DY=RX02, DL=RL02, DD=TU58.                                                                       2) TYPE   ' s SOURCE !  ' t TARGET !                                                                                            3) TYPE   0 tINIT 0 sINIT 2DROP                                                                                                 4) TYPE   INSTALL                                                                                                               5) TYPE   tBOOT                                                                                                                 6) HALT AND REBOOT FROM THE TARGET DEVICE.                      ( SYSTEM INSTALLATION )                                                                                                         : INSTALLER ;                                                                                                                   SRC @ 3 + CONSTANT BOOTBLOCKS                                   VARIABLE SOURCE                                                 VARIABLE TARGET                                                 VARIABLE NBLOCKS                                                                                                                : SELECT ( --> ) I/O-DRIVER 2+ !  I/O-DRIVER ! ;                                                                                : INSTBOOT ( BLK --> ) EMPTY-BUFFERS                              SOURCE @ EXECUTE BLOCK DROP  0 IODESC @ !                       TARGET @ EXECUTE UPDATE SAVE-BUFFERS                            SOURCE @ EXECUTE EMPTY-BUFFERS ;                                                                                              ( SYSTEM INSTALLATION )                                                                                                         : DX ( RX01 ) ['] DXREAD ['] DXWRITE SELECT ;                   : DY ( RX02 ) ['] DYREAD ['] DYWRITE SELECT ;                   : DL ( RL02 ) ['] DLREAD ['] DLWRITE SELECT ;                   : DD ( TU58 ) ['] DDREAD ['] DDWRITE SELECT ;                                                                                   : DLBOOT ( --> ) BOOTBLOCKS INSTBOOT ;                          : DXBOOT ( --> ) BOOTBLOCKS 1+ INSTBOOT ;                       : DYBOOT ( --> ) BOOTBLOCKS 2+ INSTBOOT ;                       : DDBOOT ( --> ) BOOTBLOCKS 3 + INSTBOOT ;                                                                                                                                                                                                                                                                                                                                                      ( SYSTEM INSTALLATION )                                                                                                         ' DD SOURCE !  ( INSTALLATION SOURCE )                          ' DL TARGET !  ( INSTALLATION TARGET )                           81 NBLOCKS !  ( NUMBER OF BLOCKS TO COPY )                                                                                     : INSTALL ( --> ) CR  NBLOCKS @ FOR                                13 EMIT ." COPYING, " I 1- . ."  BLOCKS LEFT "                  SOURCE @ EXECUTE                                                NBLOCKS @ I - BLOCK DROP                                        TARGET @ EXECUTE                                                UPDATE SAVE-BUFFERS                                            NEXT                                                            SOURCE @ EXECUTE  EMPTY-BUFFERS ;                                                                                                                                                                           RL BOOT -  FAILED OK    5 :76  	   ɋ& ɋE? 
7 ɋt n j f ZɋR 	t  ( 	jL w 4                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   	 xz @  ʋKʋ5  ʋԒ

W   
X w                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     xz   5K55 5 55 сe 

W   
Y w |                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          w 5 X7T @	 5  5 7  @	~ 
        * FAILED
 PROTO PART RD MEDIA CKSUM SEEK ???  l 	W! v W! | W!  W!  W!   	>s 	6         
dD~7!  w	% %    	7	~	7	 7P	5 . 	  ^ 	 	 %   		%@  w 	%  % w 
 	j~ 

LOADING ...  OK
  	:		.D w                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   