-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathTOOLS
executable file
·1 lines (1 loc) · 42 KB
/
TOOLS
1
\ The Rest is Silence 04Apr84map************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for tools and utilities \ 20:21 15Jun89 b0b 11 LOAD ( H. B. print hex or binary #s ) 2 LOAD ( Utilities ) 10 LOAD ( bconout .CHAR ) 12 LOAD ( DUMP tool ) 18 LOAD ( Laxon & Perry's SEE decompiler ) \ 36 LOAD ( Hi level multitasking words ) CR .( Standard System Loaded ) \ Basic Utilities Load Screen \ 26Apr87 b0b ONLY FORTH ALSO DEFINITIONS : U<= (S u1 u2 -- f ) U> NOT ; : U>= (S u1 u2 -- f ) U< NOT ; : <= (S n1 n2 -- f ) > NOT ; : >= (S n1 n2 -- f ) < NOT ; : 0>= (S n1 n2 -- f ) 0< NOT ; : 0<= (S n1 n2 -- f ) 0> NOT ; VOCABULARY HIDDEN 1 6 +THRU \ LIST \ 26Apr87 b0b : LIST ( n -- ) 1 ?ENOUGH CR DUP SCR ! ." Scr # " SCR ? 8 SPACES FILE? L/SCR 0 DO CR I 3 .R SPACE DUP BLOCK I C/L * + C/L -TRAILING >TYPE KEY? ?LEAVE LOOP DROP CR ; \ INDEX \ 22:56 28Oct87 b0b : .LINE0 (S n -- ) DUP 3 MOD 0= IF CR THEN CR DUP 3 .R SPACE BLOCK C/L -TRAILING >TYPE ; : INDEX (S n1 n2 -- ) 2 ?ENOUGH 1+ SWAP DO I .LINE0 LOOP CR ; : ?LINE ( n -- ) #OUT @ + 5 + 78 > IF CR THEN ; : ?CR ( -- ) 0 ?LINE ; : TAB20 20 #OUT @ 20 MOD - SPACES ; \ WORDS \ 23:14 28Oct87 b0b : LARGEST ( addr n -- addr' val ) OVER 0 SWAP ROT 0 DO 2DUP @ U< IF -ROT 2DROP DUP @ OVER THEN 2+ LOOP DROP ; : WORDS ( -- ) CR SPACE CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE DUP L>NAME ( DUP C@ 31 AND ?LINE) OVER LINK> H. .ID TAB20 SPACE @ SWAP ! KEY? IF EXIT THEN REPEAT 2DROP ; ROOT DEFINITIONS : WORDS WORDS ; FORTH DEFINITIONS \S \ 23:17 28Oct87 b0b \ Iterated Interpretation 31May84map VARIABLE #TIMES ( # times already performed ) 1 #TIMES ! : TIMES (S n -- ) 1 #TIMES +! #TIMES @ < IF 1 #TIMES ! ELSE >IN OFF THEN ; : MANY (S -- ) KEY? NOT IF >IN OFF THEN ; : :: (S -- ) HERE >R [ ' : @ ] LITERAL , !CSP ] R@ EXECUTE R> DP ! ; \ Managing Source Screens \ 23:16 28Oct87 b0b : ESTABLISH (S n -- ) FILE @ SWAP 1 BUFFER# 2! ; : (COPY) ( from to -- ) OFFSET @ + SWAP IN-BLOCK DROP ESTABLISH UPDATE ; : COPY FLUSH (COPY) FLUSH ; DEFER CONVEY-COPY ' (COPY) IS CONVEY-COPY \ Disk copy utility \ 23:15 28Oct87 b0b VARIABLE HOPPED ( # screens copy is offset ) VARIABLE U/D : HOP ( n -- ) ( specifies n screens to skip ) HOPPED ! ; : .TO ( #1 #2 -- #1 #2 ) CR OVER . ." to " DUP . ; : (CONVEY) (S blk n -- blk+-n ) 0 ?DO KEY? ?LEAVE DUP DUP HOPPED @ + .TO CONVEY-COPY U/D @ + LOOP FLUSH ; : CONVEY (S first last -- ) FLUSH HOPPED @ 0< IF 1+ OVER - 1 ELSE DUP 1+ ROT - -1 THEN U/D ! #BUFFERS /MOD >R (CONVEY) R> 0 ?DO #BUFFERS (CONVEY) LOOP DROP ; : TO ( #1st-source #last-source -- #1st-source #last-source ) ( #1st-dest must follow TO ) SWAP BL WORD NUMBER DROP OVER - HOP SWAP ; \ 26Apr87 b0b \ bconout \ 21:32 11Oct87 b0b CODE bconout (S char dev -- ) 3 # SP -) MOVE 13 TRAP LONG 6 SP ADDQ WORD \ cleanup stack NEXT END-CODE : .CHAR (S char -- ) \ prints a char "as is" 5 bconout ; \ H. B. \ 21:27 6Nov87 b0b : H. ( n -- ) BASE @ >R HEX 0 <# # # # # #> TYPE SPACE R> BASE ! ; : B. ( n -- ) BASE @ >R 2 BASE ! 0 <# 16 0 DO # LOOP #> TYPE SPACE R> BASE ! ; \ Load Screen for Dumping Utility \ 21:54 11Oct87 b0b 1 2 +THRU CR .( Dumping Utility Loaded ) \S The dump utility gives you a formatted hex dump with the ascii text corresponding to the bytes on the right hand side of the screen. In addition you can use the SM word to set a range of memory locations to desired values. SM displays an address and its contents. You can go forwards or backwards depending upon which character you type. Entering a hex number changes the contents of the location. DL can be used to dump a line of text from a screen. \ 07Feb84map I've taken advantage of the ability to display all chars on the Atari ST screen via BIOS function 3 (see screen 10). \ 11Oct87 b0b \ General Dump Utility - Output \ 22:07 11Oct87 b0b : D.2 (S addr len -- ) BOUNDS ?DO I C@ 0 <# # # #> TYPE SPACE LOOP ; : DLN (S addr --- ) CR DUP 4 U.R 2 SPACES 8 2DUP D.2 SPACE OVER + 8 D.2 SPACE 16 BOUNDS ?DO I C@ .CHAR LOOP ; : ?.N (S n1 n2 -- n1 ) 2DUP = IF DROP 14 .CHAR 15 .CHAR ELSE 2 .R THEN SPACE ; : ?.A (S n1 n2 -- n1 ) 2DUP = IF 2 .CHAR DROP ELSE 1 .R THEN ; \ DUMP Utility \ 21:59 11Oct87 b0b : .HEAD (S addr len -- addr' len' ) SWAP DUP -16 AND SWAP 15 AND CR 6 SPACES 8 0 DO I ?.N LOOP SPACE 16 8 DO I ?.N LOOP SPACE 16 0 DO I ?.A LOOP ROT + ; : DUMP (S addr len -- ) BASE @ -ROT HEX .HEAD BOUNDS DO I DLN KEY? ?LEAVE 16 +LOOP BASE ! ; : DU (S addr -- addr+64 ) DUP 64 DUMP 64 + ; : DL (S line# -- ) C/L * SCR @ BLOCK + C/L DUMP ; \ 26Apr87 b0b \ 26Apr87 b0b \ 26Apr87 b0b \ Load Screen for Decompiler 07Feb84map 1 11 +THRU CR .( Decompiler Loaded ) \S A Forth decompiler is a utility program that translates executable forth code back into source code. Normally this is impossible, since traditional compilers produce more object code than source, but in Forth it is quite easy. The decompileris almost one to one, failing only to correctly decompile the various Forth control stuctures and special compiling words. It was written with modifiability in mind, so if you add your own special compiling words, it will be easy to change the decompiler to include them. This code is highly implementation dependant, and will NOT work on other Forth system. To invoke the decompiler, use the word SEE <name> where <name> is the name of a Forth word. \ Positional case defining word 28AUG83HHL( Subscripts start FROM 0 ) : OUT ( # apf -- ) ( report out of range error ) CR ." Subscript out of range on " DUP BODY> >NAME .ID ." Max is " ? ." tried " . QUIT ; : MAP ( # apf -- a ) ( convert subscript # to address a ) 2DUP @ U< IF 2+ SWAP 2* + ELSE OUT THEN ; : CASE: (S n -- ) ( define positional case defining word ) CONSTANT HIDE ] DOES> ( #subscript -- ) ( executes #'th word ) MAP PERFORM ; \ ASSOCIATIVE: Table Lookup Def. Word 01MAR82HHL : ASSOCIATIVE: CONSTANT DOES> (S N -- INDEX ) DUP @ ( N PFA CNT ) -ROT DUP @ 0 ( CNT N PFA CNT 0 ) DO 2+ 2DUP @ = ( CNT N PFA' BOOL ) IF 2DROP DROP I 0 0 LEAVE THEN ( CLEAR STACK AND RETURN INDEX THAT MATCHED ) LOOP 2DROP ; \ Decompile each type of word 02Nov83mapDEFER (SEE) HIDDEN DEFINITIONS : .WORD (S IP -- IP' ) DUP @ >NAME .ID 2+ ; : .INLINE (S IP -- IP' ) .WORD DUP @ . 2+ ; : .BRANCH (S IP -- IP' ) .WORD DUP @ OVER - . 2+ ; : .QUOTE (S IP -- IP' ) .WORD .WORD ; : .STRING (S IP -- IP' ) .WORD COUNT 2DUP TYPE SPACE + EVEN ; \ Decompile each type of word 28Feb84map: .(;CODE) (S IP -- IP' ) .WORD DOES? IF ." DOES> " ELSE DROP FALSE THEN ; : .UNNEST (S IP -- IP' ) ." ; " DROP 0 ; : .FINISH (S IP -- IP' ) .WORD DROP 0 ; \ Classify each word in a definition 23JUN83HHL14 ASSOCIATIVE: EXECUTION-CLASS ( 0 ) ' (LIT) , ( 1 ) ' ?BRANCH , ( 2 ) ' BRANCH , ( 3 ) ' (LOOP) , ( 4 ) ' (+LOOP) , ( 5 ) ' (DO) , ( 6 ) ' COMPILE , ( 7 ) ' (.") , ( 8 ) ' (ABORT") , ( 9 ) ' (;CODE) , ( 10 ) ' UNNEST , ( 11 ) ' (") , ( 12 ) ' (?DO) , ( 13 ) ' (;USES) , \ Classify each word in a definition 23JUN83HHL15 CASE: .EXECUTION-CLASS ( 0 ) .INLINE ( 1 ) .BRANCH ( 2 ) .BRANCH ( 3 ) .BRANCH ( 4 ) .BRANCH ( 6 ) .BRANCH ( 6 ) .QUOTE ( 7 ) .STRING ( 8 ) .STRING ( 9 ) .(;CODE) ( 10 ) .UNNEST ( 11 ) .STRING ( 12 ) .BRANCH ( 13 ) .FINISH ( 14 ) .WORD ; \ Decompile a : definition \ 26Apr87 b0b : .PFA (S CFA -- ) >BODY BEGIN ?CR DUP @ EXECUTION-CLASS .EXECUTION-CLASS DUP 0= KEY? OR UNTIL DROP ; : .IMMEDIATE (S CFA -- ) >NAME C@ 64 AND IF ." IMMEDIATE" THEN ; \ Display category of word 24Apr84map: .CONSTANT (S CFA -- ) DUP >BODY ? ." CONSTANT " >NAME .ID ; : .VARIABLE (S CFA -- ) DUP >BODY . ." VARIABLE " DUP >NAME .ID ." Value = " >BODY ? ; : .: (S CFA -- ) ." : " DUP >NAME .ID 2 SPACES .PFA ; : .DOES> (S CFA -- ) ." DOES> " BODY> .PFA ; : .USER-VARIABLE (S CFA -- ) DUP >BODY ? ." USER VARIABLE " DUP >NAME .ID ." Value = " >IS ? ; \ Display category of word 24Apr84map: .DEFER (S CFA -- ) ." DEFERRED " DUP >NAME .ID ." IS " >IS @ (SEE) ; : .USER-DEFER (S cfa -- ) ." USER DEFERRED " DUP >NAME .ID ." IS " >IS @ (SEE) ; : .OTHER (S CFA -- ) DUP >NAME .ID DUP @ OVER >BODY = ( cfa points to the pfa in code words ) IF DROP ." is Code" EXIT THEN DUP @ DOES? IF .DOES> DROP EXIT THEN 2DROP ." is Unknown" ; \ Classify a word based on its CFA 09SEP83HHL6 ASSOCIATIVE: DEFINITION-CLASS ( 0 ) ' QUIT @ , ( 1 ) ' 0 @ , ( 2 ) ' SCR @ , ( 3 ) ' BASE @ , ( 4 ) ' KEY @ , ( 5 ) ' EMIT @ , 7 CASE: .DEFINITION-CLASS ( 0 ) .: ( 1 ) .CONSTANT ( 2 ) .VARIABLE ( 3 ) .USER-VARIABLE ( 4 ) .DEFER ( 5 ) .USER-DEFER ( 6 ) .OTHER ; \ Top level of the Decompiler SEE 29Sep83map: ((SEE)) (S Cfa -- ) CR DUP DUP @ DEFINITION-CLASS .DEFINITION-CLASS .IMMEDIATE ; ' ((SEE)) IS (SEE) FORTH DEFINITIONS : SEE (S -- ) ' (SEE) ; \ 22:27 28Oct87 b0b \ 22:27 28Oct87 b0b \ 22:27 28Oct87 b0b \ 26Apr87 b0b \ 26Apr87 b0b \ 26Apr87 b0b \ Load Screen for the MultiTasker 07Feb84mapONLY FORTH ALSO DEFINITIONS 1 3 +THRU CR .( MultiTasker Hi Level Loaded ) ONLY FORTH ALSO DEFINITIONS \S The MultiTasker is loaded as an application on top of the regular Forth System. There is support for it in the nucleus in the form of USER variables and PAUSEs inserted inside of KEY EMIT and BLOCK. The Forth multitasking scheme is co-operative instead of interruptive. All IO operations cause a PAUSE to occur, and the multitasking loop looks around at all of the current tasks for something to do. \ Activate a Task 22jan86plm : TASK: (S size -- ) CREATE TOS HERE #USER @ CMOVE ( Copy the USER Area ) @LINK UP @ >R HERE UP ! !LINK ( I point where he did ) DUP HERE + DUP RP0 ! 100 - SP0 ! R> UP ! HERE ENTRY LOCAL ADD-BASE !LINK ( He points to me ) HERE #USER @ + HERE DP LOCAL ! HERE SLEEP ALLOT ; \ Activate a Task 22jan86plm : SET-TASK (S ip task -- ) DUP SP0 LOCAL @ ( Top of Stack ) 4 - ROT ADD-BASE 2 PICK 2! ( Initial IP ) 4 - OVER RP0 LOCAL @ ADD-BASE 2 PICK 2! ( Initial RP ) ADD-BASE ROT TOS LOCAL 2! ; : ACTIVATE (S task -- ) R> OVER SET-TASK WAKE ; \ Create a Background Task \ 26Apr87 b0b : BACKGROUND: (S -- ) 600 TASK: HERE @LINK 0 ADD-BASE D- 4. D- DROP SET-TASK !CSP ] ; \S background: spooler 1 capacity show stop ; : spool-this spooler activate 3 15 show stop ; variable counts background: counter begin pause 1 counts +! again ; \ 26Apr87 b0b \ 26Apr87 b0b