\ 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 to Bring up Standard System 07Apr84map 2 LOAD ( Utilities ) 9 LOAD ( STRINGS ) 12 LOAD ( EDITING ) 28 LOAD ( DUMPING ) 31 LOAD ( SEEING ) 43 LOAD ( SHOWING ) 49 LOAD ( BUGGING ) 52 LOAD ( TASKING ) CR .( Standard System Loaded ) \ Basic Utilities Load Screen 04Apr84mapONLY FORTH ALSO DEFINITIONS VARIABLE FUDGE 100 FUDGE ! : MS (S n -- ) 0 ?DO FUDGE @ 0 ?DO LOOP LOOP ; : 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 \ Output Formatting 22Feb84mapVARIABLE LMARGIN 0 LMARGIN ! VARIABLE RMARGIN 70 RMARGIN ! : ?LINE (S n -- ) #OUT @ + RMARGIN @ > IF CR LMARGIN @ SPACES THEN ; : ?CR (S -- ) 0 ?LINE ; \ Managing Source Screens 22Mar84map: .SCR (S -- ) ." Scr # " SCR ? 8 SPACES FILE? ; : LIST (S n -- ) 1 ?ENOUGH CR DUP SCR ! .SCR L/SCR 0 DO CR I 3 .R SPACE DUP BLOCK I C/L * + C/L -TRAILING >TYPE KEY? ?LEAVE LOOP DROP CR ; : TRIAD (S n -- ) 12 EMIT ( form feed ) 3 / 3 * 3 BOUNDS DO I LIST LOOP ; : .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 ; : IND (S n -- ) BEGIN DUP .LINE0 1+ KEY? UNTIL DROP ; \ Display the WORDS in the Context Vocabulary 07Feb84map: LARGEST (S addr n -- addr' val ) OVER 0 SWAP ROT 0 DO 2DUP @ U< IF -ROT 2DROP DUP @ OVER THEN 2+ LOOP DROP ; : WORDS (S -- ) CR LMARGIN @ SPACES CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE DUP L>NAME DUP C@ 31 AND ?LINE .ID SPACE SPACE @ SWAP ! KEY? IF EXIT THEN REPEAT 2DROP ; ROOT DEFINITIONS : WORDS WORDS ; FORTH DEFINITIONS \ Iterated Interpretation 03Apr84mapVARIABLE #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 ; \ : WHEN (S f -- ) \ PAUSE NOT IF R> 4 - >R THEN ; : :: (S -- ) HIDE HERE >R [ ' : @ ] LITERAL , !CSP ] R@ EXECUTE R> DP ! ; \ Managing Source Screens 09Apr84map: N (S -- ) 1 SCR +! DISK-ERROR OFF ; : B (S -- ) -1 SCR +! DISK-ERROR OFF ; : L (S -- ) SCR @ LIST ; : ESTABLISH (S n -- ) FILE @ SWAP 1 BUFFER# 2! ; : (COPY) ( from to -- ) OFFSET @ + SWAP IN-BLOCK DROP ESTABLISH UPDATE ; : COPY FLUSH (COPY) FLUSH ; : @VIEW (S code-field -- scr file# ) >VIEW @ DUP 4095 AND DUP 0= ABORT" entered at terminal." SWAP 4096 / 15 AND ; : VIEW (S -- ) [ DOS ] ' @VIEW ?DUP IF 2* VIEW-FILES + @ ." is in " 2DUP >BODY .FILE ." screen " . EXECUTE OPEN-FILE ELSE ." may be in current file: " FILE? ." screen " DUP . THEN LIST ; \ Disk copy utility 08APR83HHLVARIABLE HOPPED ( # screens copy is offset ) VARIABLE U/D DEFER CONVEY-COPY ' (COPY) IS CONVEY-COPY : 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 ; \ String Functions Load Screen 07Feb84map 1 2 +THRU CR .( Strings Loaded ) \S The String manipulation primitives include string comparison andsearching. The string search implemented is used in the editor to find the desired string. The only unusual thing about it is the presence of a variable called CAPS, which determines whether or not to ignore the case of the subject and pattern strings. If case is ignored then A-Z = a-z. The default is ignore case. \ String Functions SEARCH 10Mar84mapVARIABLE FOUND : SCAN-1ST (S a n c -- a n ) CAPS @ IF DROP ELSE SCAN THEN ; : SEARCH ( sadr slen badr blen -- n f ) FOUND OFF SWAP >R 2DUP U<= IF OVER - 1+ 2 PICK C@ R@ -ROT >R BEGIN R@ SCAN-1ST DUP IF >R 3DUP SWAP COMPARE 0= IF FOUND ON R> DROP 0 >R THEN R> THEN DUP WHILE 1 /STRING REPEAT R> 2DROP -ROT THEN 2DROP R> - FOUND @ ; \ String operators 04Apr84map: DELETE (S buffer size count -- ) OVER MIN >R R@ - ( left over ) DUP 0> IF 2DUP SWAP DUP R@ + -ROT SWAP CMOVE THEN + R> BLANK ; : INSERT (S string length buffer size -- ) ROT OVER MIN >R R@ - ( left over ) OVER DUP R@ + ROT CMOVE> R> CMOVE ; : REPLACE (S string length buffer size -- ) ROT MIN CMOVE ; \ Load Screen for the Editor 23Apr84map 1 15 +THRU DUMB CR .( Editor Loaded ) ONLY FORTH ALSO DEFINITIONS \S The Following editor is compatible with the editor described in Starting Forth. For details on the various commands, see the book Starting Forth by Leo Brodie. There are a few extensions that have been implemented. Most notably, the word NEW which allows you to replace multiple lines. Also, this editor has the ability to display the screen that is being edited continuously. You may need to modify the cursor addressing commands in order to take advantage of this feature. You can edit without using the full screen feature simply by invoking the EDITOR vocabulary and entering commands as usual. Use the L command to see what has happened. \ Terminal Dependant deferred words 13Apr84mapDEFER BLOT (S col -- ) DEFER -LINE (S -- ) : AT (S col row -- ) ( 0 0 is upper left ) DOES> -ROT 2DUP #LINE ! #OUT ! ROT PERFORM ; AT : DARK (S -- ) DOES> PERFORM #LINE OFF #OUT OFF ; DARK VOCABULARY EDITOR EDITOR ALSO DEFINITIONS DEFER .SCREEN (S -- ) 2VARIABLE AUTO VARIABLE EDITING? VARIABLE CHANGED : INSTALL (S -- ) EDITING? @ NOT IF ['] .SCREEN AUTO @ ! ALSO EDITING? ON CHANGED OFF THEN DISK-ERROR OFF ; \ Move the Editor's cursor around 16Oct83mapB/BUF CONSTANT C/SCR : TOP (S -- ) R# OFF ; : C (S n -- ) R# @ + C/SCR MOD R# ! ; : T (S n -- ) TOP C/L * C ; : CURSOR (S -- n ) R# @ ; : LINE# (S -- n ) CURSOR C/L / ; : COL# (S -- n ) CURSOR C/L MOD ; : +T (S n -- ) LINE# + T ; : 'START (S -- adr ) SCR @ BLOCK ; : 'CURSOR (S -- adr ) 'START CURSOR + ; : 'LINE (S -- adr ) 'CURSOR COL# - ; : #AFTER (S -- n ) C/L COL# - ; : #REMAINING (S -- n ) B/BUF CURSOR - ; : #END (S -- n ) #REMAINING COL# + ; \ buffers 11Mar84map: MODIFIED (S -- ) CHANGED ON UPDATE ; ASCII ^ CONSTANT EOS : ?TEXT (S adr -- adr+1 n ) >R EOS PARSE DUP IF R@ C/L 1+ BLANK R@ PLACE ELSE 2DROP THEN R> COUNT ; 84 CONSTANT C/PAD : 'INSERT (S -- insert-buffer ) PAD C/PAD + ; : 'FIND (S -- find-buffer ) 'INSERT C/PAD + ; : 'VIDEO (S -- video-buffer ) 'FIND C/PAD + ; : .FRAMED (S adr -- ) ." '" COUNT TYPE ." '" ; : .BUFS (S -- ) CR ." I " 'INSERT .FRAMED CR ." F " 'FIND .FRAMED ; : ?MISSING (S n f -- n | ) 0= IF DROP 'FIND .FRAMED ." not found " QUIT THEN ; : KEEP (S -- ) 'LINE C/L 'INSERT PLACE ; \ buffers 11Mar84map: K (S -- ) 'FIND PAD C/PAD CMOVE 'INSERT 'FIND C/PAD CMOVE PAD 'INSERT C/PAD CMOVE ; : W (S -- ) SAVE-BUFFERS ; : 'C#A (S -- 'cursor #after ) 'CURSOR #AFTER MODIFIED ; : (I) (S -- len 'insert len 'cursor #after ) 'INSERT ?TEXT TUCK 'C#A ; : (TILL) (S -- n ) 'FIND ?TEXT 'C#A SEARCH ?MISSING ; : 'F+ (S n1 -- n2 ) 'FIND C@ + ; 11 CONSTANT ID-LEN CREATE ID ID-LEN ALLOT ID ID-LEN BLANK : STAMP (S -- ) ID 'START C/L + ID-LEN 1- - ID-LEN 1- CMOVE ; : ?STAMP (S -- ) CHANGED @ IF STAMP CHANGED OFF THEN ; \ line editing 01Apr84map: I (S -- ) (I) INSERT C ; : O (S -- ) (I) REPLACE C ; : P (S -- ) 'INSERT ?TEXT DROP 'LINE C/L CMOVE MODIFIED ; : U (S -- ) C/L C 'LINE C/L OVER #END INSERT P ; : X (S -- ) KEEP 'LINE #END C/L DELETE MODIFIED ; : SPLIT (S -- ) PAD C/L 2DUP BLANK 'CURSOR #REMAINING INSERT MODIFIED ; : JOIN (S -- ) 'LINE C/L + C/L 'C#A INSERT ; : WIPE (S -- ) 'START B/BUF BLANK MODIFIED ; : M (S -- ) TRUE ABORT" Use G !" ; : G (S screen line -- ) C/L * SWAP IN-BLOCK + C/L 'INSERT PLACE C/L NEGATE C U C/L C ; : BRING (S screen first last -- ) 1+ SWAP DO DUP [ FORTH ] I G LOOP DROP ; \ find and replace 10Mar84map: FIND? (S - n f ) 'FIND ?TEXT 'CURSOR #REMAINING SEARCH ; : F (S -- ) FIND? ?MISSING 'F+ C ; : S (S n - ) 1 ?ENOUGH FIND? IF 'F+ C EXIT THEN DROP FALSE OVER SCR @ DO N TOP 'FIND COUNT 'CURSOR #REMAINING SEARCH IF 'F+ C DROP TRUE LEAVE ELSE DROP THEN KEY? ABORT" Break!" LOOP ?MISSING ; : E (S -- ) 'FIND C@ DUP NEGATE C 'C#A ROT DELETE ; : D (S -- ) F E ; : R (S -- ) E I ; : TILL (S -- ) 'C#A (TILL) 'F+ DELETE ; : J (S -- ) 'C#A (TILL) DELETE ; : KT (S -- ) 'CURSOR (TILL) 'F+ 'INSERT PLACE ; \ screen display 22Mar84map3 CONSTANT DX 1 CONSTANT DY : .LINE (S -- ) LINE# 2 .R SPACE 'LINE COL# >TYPE ASCII ^ EMIT 'CURSOR #AFTER >TYPE ; : REDISPLAY (S line# -- ) 0 OVER DY + AT DUP 2 .R SPACE DUP C/L * 'START + C/L TYPE SPACE . #OUT @ BLOT ; : CHANGED? (S line# -- f ) C/L * DUP 'START + SWAP 'VIDEO + C/L COMP ; : .ALL (S -- ) DISK-ERROR @ 0= IF DX 0 AT .SCR #OUT @ BLOT [ FORTH ] ?STAMP L/SCR 0 DO I CHANGED? IF I REDISPLAY THEN LOOP 'START 'VIDEO B/BUF CMOVE 0 18 AT .LINE 0 19 AT -LINE 0 23 AT #OUT OFF THEN ; \ screen editing 11Mar84map: EDIT-AT ( -- ) CURSOR C/L /MOD SWAP DX + SWAP DY + AT ; : NEW (S n -- ) L/SCR SWAP DO [ FORTH ] I [ EDITOR ] T EDIT-AT >IN OFF QUERY SPAN @ IF P ELSE [ FORTH ] I REDISPLAY LEAVE THEN .SCREEN LOOP .SCREEN ; : GET-ID (S -- ) ID ID-LEN -TRAILING NIP 0= IF CR ." Enter your ID: " ID-LEN 0 DO ASCII . EMIT LOOP ID-LEN BACKSPACES ID ID-LEN EXPECT THEN ; \ entering and exiting the editor 23Apr84mapFORTH DEFINITIONS : DONE (S -- ) [ EDITOR ] EDITING? @ IF PREVIOUS EDITING? OFF CR SCR ? >UPDATE @ 0< NOT IF ." Un" THEN ." modified" ?STAMP W THEN DISK-ERROR OFF AUTO 2@ ! ; : ED (S -- ) [ EDITOR ] GET-ID INSTALL EDITOR 'VIDEO B/BUF ERASE DARK .ALL ; : EDIT (S scr -- ) 1 ?ENOUGH SCR ! [ EDITOR ] TOP ED ; : FIX (S -- ) [ DOS ] >IN @ ' @VIEW ?DUP IF 2* VIEW-FILES + PERFORM OPEN-FILE THEN EDIT >IN ! [ EDITOR ] F ; : (WHERE) (S pos scr -- ) DISK-ERROR @ 0= IF EDIT [ EDITOR ] 1- C 'WORD COUNT 'FIND PLACE THEN ; \ ' (WHERE) IS WHERE \ Shadow Screen Support 02Apr84mapVOCABULARY SHADOW ALSO SHADOW DEFINITIONS : DISPLACEMENT (S fcb -- disp ) [ DOS ] MAXREC# @ 1+ 0 [ 8 2* ] LITERAL UM/MOD NIP ; : (>SHADOW) (S scr# fcb -- scr#' ) DISPLACEMENT 2DUP < IF + ELSE - THEN ; : >SHADOW (S scr# -- scr#' ) FILE @ (>SHADOW) ; : >IN-SHADOW (S scr# -- scr#' ) IN-FILE @ (>SHADOW) ; ONLY FORTH ALSO DEFINITIONS : A (S -- ) SCR @ [ SHADOW ] >SHADOW SCR ! ; \ Shadow Screen Editing 19Apr84mapONLY FORTH ALSO EDITOR ALSO SHADOW ALSO DEFINITIONS : COPY (S from to -- ) FLUSH 2DUP (COPY) >SHADOW SWAP >IN-SHADOW SWAP (COPY) FLUSH ; : CONVEY (S first last -- ) 2DUP CONVEY >IN-SHADOW SWAP >IN-SHADOW SWAP 0 >SHADOW 0 >IN-SHADOW - HOPPED +! CONVEY ; : G (S scr# line -- ) 2DUP G A C/L NEGATE C SWAP >IN-SHADOW SWAP G STAMP A ; : BRING (S scr# l1 l2 -- ) 1+ SWAP DO DUP [ FORTH ] I [ SHADOW ] G LOOP DROP ; ONLY FORTH ALSO EDITOR DEFINITIONS \ Cursor Routines for DUMB Terminals 10Mar84map: (AT) (S col row -- ) 2DROP CR ; : (BLOT) (S col -- ) C/L SWAP - SPACES ; : (DARK) (S -- ) 24 0 DO CR LOOP ; : .DUMB (S -- ) CR .LINE CR ; : DUMB (S -- ) ['] CR ['] STATUS >BODY AUTO 2! ['] .DUMB IS .SCREEN ['] (AT) IS AT ['] (BLOT) IS BLOT ['] NOOP IS -LINE ['] (DARK) IS DARK ; DUMB \ Cursor Routines for ANSI Standard Terminals 1010Mar84map: SMART (S -- ) ['] CRLF ['] CR >BODY AUTO 2! ['] .ALL IS .SCREEN ; : ANSI-AT (S col row -- ) BASE @ -ROT DECIMAL 27 EMIT ASCII [ EMIT 1+ 0 .R ASCII ; EMIT 1+ 0 .R ASCII H EMIT BASE ! ; : ANSI-BLOT (S col -- ) DROP 27 EMIT ." [K" ; : ANSI-DARK (S -- ) 27 EMIT ." [2J" ; : ANSI--LINE (S -- ) 27 EMIT ." [1M" ; : ANSI (S -- ) SMART ['] ANSI-AT IS AT ['] ANSI-DARK IS DARK ['] ANSI--LINE IS -LINE ['] ANSI-BLOT IS BLOT ; \ Heathkit H19 / Zenith Z19 cursor routines 10Mar84map: H19-AT (S x y --- ) 27 EMIT ASCII Y EMIT 32 + EMIT 32 + EMIT ; : H19-DARK (S -- ) 27 EMIT ASCII E EMIT ; : H19-BLOT (S n --- ) DROP 27 EMIT ASCII K EMIT ; : H19--LINE (S n --- ) 27 EMIT ASCII M EMIT ; : HEATH (S -- ) SMART ['] H19-AT IS AT ['] H19-DARK IS DARK ['] H19--LINE IS -LINE ['] H19-BLOT IS BLOT ; \ Televideo 912 Terminal Drivers 10Mar84map: TVI-AT (S x y -- ) 27 EMIT 61 EMIT ( ESC = ) 32 + EMIT 32 + EMIT ; : TVI-BLOT (S n -- ) DROP 27 EMIT 84 EMIT ( ESC T ) ; : TVI-DARK (S -- ) 26 EMIT ( CTRL Z ) ; : TVI--LINE (S -- ) 27 EMIT ASCII R EMIT ; : TELEVIDEO (S -- ) SMART ['] TVI-AT IS AT ['] TVI-DARK IS DARK ['] TVI--LINE IS -LINE ['] TVI-BLOT IS BLOT ; : QUME TELEVIDEO ; : FALCO TELEVIDEO ; \ Load Screen for Dumping Utility 07Feb84map 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. \ General Dump Utility - Output 10Mar84map: .2 (S n -- ) 0 <# # # #> TYPE SPACE ; : D.2 (S addr len -- ) BOUNDS ?DO I C@ .2 LOOP ; : EMIT. (S char -- ) 127 AND DUP BL 126 BETWEEN NOT IF DROP ASCII . THEN EMIT ; : 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@ EMIT. LOOP ; : ?.N (S n1 n2 -- n1 ) 2DUP = IF ." \/" DROP ELSE 2 .R THEN SPACE ; : ?.A (S n1 n2 -- n1 ) 2DUP = IF ." V" DROP ELSE 1 .R THEN ; \ Dump and Fill Memory Utility 02Apr84map: .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 ; \ 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 15Mar83map: .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) ; \ Load Screen for PRINT Utility 23Feb84mapONLY FORTH ALSO DEFINITIONS 1 5 +THRU CR .( Print Utility Loaded ) ONLY FORTH ALSO DEFINITIONS \S The Print Utility allows you to print a range of screens on your printer. If your printer allows it, you can print 6 screens per page. The top level word is SHOW which takes a starting and ending screen number and prints all the non blank screens within the range. SHOW in the EDITOR prints the screens and their shadows. The print utility is initialized by INIT-PR, which defaults to NOOP. If you have an EPSON MX-80 set INIT-PR to EPSON. If your printer cannot print 132 columns per line, then you should use TRIAD instead. \ Variables and Setup 22May84map: EPSON (S -- ) CONTROL O EMIT ( EPSON Condensed ) ; DEFER INIT-PR ' NOOP IS INIT-PR DEFER FOOTING 66 CONSTANT L/PAGE 0 CONSTANT LOGO VARIABLE #PAGE : PAGE (S -- ) DOES> PERFORM 1 #PAGE +! #LINE OFF #OUT OFF ; PAGE : FORM-FEED (S -- ) CONTROL M EMIT CONTROL L EMIT ; : (PAGE) (S -- ) L/PAGE #LINE @ OVER MIN ?DO CR LOOP ; ' (PAGE) IS PAGE : (SEMIT) (S c -- ) PRINTING @ IF (PRINT) ELSE (CONSOLE) THEN ; HIDDEN DEFINITIONS CREATE SCR#S 14 ALLOT ( enough room for 6 Screens ) \ Print 2 screens across on a page 10Apr84map: TEXT? (S Scr# -- f ) BLOCK DUP C@ BL ASCII ~ BETWEEN ( printable ) IF B/BUF -TRAILING NIP 0<> ( and not empty ) ELSE FALSE THEN ; : PR (S scr -- ) DUP CAPACITY >= IF DROP LOGO THEN 1 SCR#S +! SCR#S DUP @ 2* + ! ; : 2PR (S Scr1# Scr2# line# -- ) CR DUP 2 .R SPACE C/L * >R PAD 129 BLANK SWAP BLOCK R@ + PAD C/L CMOVE BLOCK R> + PAD C/L + 1+ C/L CMOVE PAD 129 -TRAILING TYPE ; : 2SCR (S Scr1 Scr2 --- ) CR CR 4 SPACES OVER 4 .R 61 SPACES DUP 4 .R 16 0 DO 2DUP I 2PR LOOP 2DROP ; \ Prints 6 screen on a page 22May84map: P-HEADING (S -- ) CR CR 5 SPACES ." Page# " #PAGE ? 8 SPACES FILE? CR ; : P-FOOTING (S -- ) CR CR 58 SPACES ." Forth 83 Model" PAGE ; ' P-FOOTING IS FOOTING \ Prints 6 screen on a page 11Apr84map: PR-START (S -- ) PRINTING ON #LINE OFF ['] (SEMIT) IS EMIT SCR#S OFF 1 #PAGE ! INIT-PR ; : PR-STOP (S -- ) ['] (EMIT) IS EMIT PRINTING OFF ; : PR-PAGE (S -- ) P-HEADING SCR#S OFF SCR#S 2+ 3 0 DO DUP @ OVER 6 + @ 2SCR 2+ LOOP DROP FOOTING ; : PR-S-PAGE (S -- ) P-HEADING SCR#S OFF SCR#S 2+ 3 0 DO DUP @ OVER 2+ @ 2SCR 4 + LOOP DROP FOOTING ; : PR-FLUSH (S -- f ) SCR#S @ DUP ( Any screens left over? ) IF BEGIN SCR#S @ 5 < WHILE 0 PR REPEAT LOGO PR THEN 0<> ; \ Print Page with Shadows 03Apr84mapFORTH DEFINITIONS : SHOW (S first last -- ) [ HIDDEN ] PR-START 1+ SWAP ?DO I TEXT? IF I PR THEN SCR#S @ 6 = IF PR-PAGE THEN LOOP PR-FLUSH IF PR-PAGE THEN PR-STOP ; SHADOW DEFINITIONS : SHOW (S first last -- ) [ HIDDEN ALSO ] PR-START 1+ SWAP ?DO I TEXT? IF I PR I [ SHADOW ] >SHADOW PR THEN SCR#S @ 6 = IF PR-S-PAGE THEN LOOP PR-FLUSH IF PR-S-PAGE THEN PR-STOP ; ONLY FORTH ALSO DEFINITIONS : LISTING (S -- ) 0 CAPACITY 2/ 1- [ SHADOW ] SHOW ; \ Load Screen for Debugger Utility 07Feb84mapONLY FORTH ALSO DEFINITIONS 1 2 +THRU CR .( Debugger Hi Level Loaded ) ONLY FORTH ALSO DEFINITIONS \S The debugger is designed to let the user single step the execution of a high level definition. To invoke the debugger, type DEBUG XXX where XXX is the name of the word you wish to trace. When XXX executes, you will get a single step trace showing you the word within XXX that is about to execute, and the contents of the parameter stack. If you wish to poke around, type F and you can interpret Forth commands until you type RESUME, and execution of XXX will continue where it left off. This debugger works by patching the NEXT routine, so it is highly machine and implementation dependent. The same idea should work however on any Forth system with a centralized NEXT routine. \ Print a High Level Trace 08JAN84MAPBUG ALSO DEFINITIONS : L.ID (S nfa len -- ) SWAP DUP .ID DUP NAME> 1- - + SPACES ; VARIABLE SLOW VARIABLE RES : (DEBUG) (S low-adr hi-adr -- ) 1 CNT ! IP> ! <IP ! PNEXT ; : 'UNNEST (S Pfa -- Pfa' ) BEGIN 1+ DUP @ ['] UNNEST = UNTIL ; \ Enter and Leave the Debugger 06Oct83map: TRACE (S Ip - ) >R .S R> CR @ >NAME 10 L.ID SLOW @ NOT KEY? OR IF SLOW OFF RES OFF ." --> " KEY UPC ASCII C OVER = IF SLOW @ NOT SLOW ! THEN ASCII F OVER = IF DROP BEGIN QUERY RUN RES @ UNTIL THEN ASCII Q OVER = ABORT" Unbug" DROP THEN PNEXT ; ' TRACE 'DEBUG ! FORTH DEFINITIONS : DEBUG (S -- ) ' 2- DUP [ BUG ] 'UNNEST (DEBUG) ; : RESUME (S -- ) [ BUG ] RES ON 0 PNEXT ; ONLY FORTH ALSO DEFINITIONS \ Load Screen for the MultiTasker 07Feb84mapONLY FORTH ALSO DEFINITIONS 1 2 +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 17Oct83map: TASK: (S size -- ) CREATE TOS HERE #USER @ CMOVE ( Copy the USER Area ) @LINK UP @ -ROT HERE UP ! !LINK ( I point where he did) DUP HERE + DUP RP0 ! 100 - SP0 ! SWAP UP ! HERE ENTRY LOCAL !LINK ( He points to me) HERE #USER @ + HERE DP LOCAL ! HERE SLEEP ALLOT ; : SET-TASK (S ip task -- ) DUP SP0 LOCAL @ ( Top of Stack ) 2- ROT OVER ! ( Initial IP ) 2- OVER RP0 LOCAL @ OVER ! ( Initial RP ) SWAP TOS LOCAL ! ; : ACTIVATE (S task -- ) R> OVER SET-TASK WAKE ; \ Create a Background Task 10Mar84map: BACKGROUND: (S -- ) 400 TASK: HERE @LINK 2- ( get address of new task ) SET-TASK !CSP ] ; \S background: spooler 1 capacity show stop ; : spool-this spooler activate 3 15 [ shadow ] show stop ; variable counts background: counter begin pause 1 counts +! again ; \ The Rest is Silence 04Apr84mapDon't be fooled by the screen on the left. There is more to come. This is the LOGO screen which will be printed in your listings as the very last screen, if space permits. ( Load Screen to Bring up Standard System 03Apr84map) STRINGS Character manipulation and case conversions EDITING The Starting Forth Editor, adapted to split screen DUMPING Formatted Hex dump of memory SEEING A decompiler utility SHOWING A print utility for screens with/without shadows BUGGING The High Level Trace Utility TASKING is a simple MultiTasker, believe it or not. These are the machine independant utilities that are loaded when you want to bring up a standard system. There are no machine dependancies in this file. Even the decompiler is written in a machine independant manner. You may need to add some code to the CPUxx.BLK file to make this possible. \ Basic Utilities Load Screen 03Apr84mapSet FUDGE to adjust period of MS. MS delays about n MilliSeconds. This clearly depends on your system clock speed. Adjust FUDGE until the delay is right. U<= Unsigned less than or equal. U>= Unsigned greater than or equal. <= Less than or equal. >= Greater than or equal. 0<= Less than or equal to zero. 0>= Greater than or equal to zero. HIDDEN is a vocabulary for internal routines to avoid cluttering up FORTH with all manner of junk. Used by the decompiler and print utilities. \ Output Formatting 03Apr84mapLMARGIN is the column number of the left margin. RMARGIN is the column number of the right margin. ?LINE Move to left margin on next line if we will be past the right margin after printing n characters. ?CR Move to left margin on next line if we are past the right margin. These words are useful for a variety of output formatting needs. Only WORDS uses the margins currently. See chapter 12 of Starting Forth for more ideas. \ LIST INDEX 22Mar84map.SCR (S -- ) Print current screen number and file name. LIST (S n -- ) List the specified screen as 16 lines with 64 characters each. Pressing a key aborts the listing. LIST also makes the specified screen the current screen. TRIAD (S n -- ) Lists three screens per page. For 80 column printers. .LINE0 (S n -- ) print line 0 of block n. INDEX (S n1 n2 -- ) Lists the first line of every screen, from n1 through n2. This is very useful for getting a quick idea of what is in a file if you use the first line of every screen as a global screen comment. IND (S n -- ) is a single argument INDEX. Use INDEX for background printing. \ Display the WORDS in the Context Vocabulary 03Apr84mapLARGEST (S addr n -- addr' val ) Given a address and a number of words to examine, return the address and the value of the largest entry in the array. WORDS (S -- ) List the words in the context vocabulary. This can be interrupted any time by pressing any key. Add WORDS to ROOT. \ Iterated Interpretation 03Apr84map#TIMES A variable that keeps track of how many times. TIMES ( n -- ) Re-execute the input stream a specified number of times. MANY (S -- ) Re-execute the input stream until the user presses a key. \ WHEN (S f -- ) \ Re-execute the previous word until it returns true. \ NOTE: WHEN is slightly magic. \ Usage: : TEST READY WHEN BEEP ; \ Where READY returns a flag. :: compile and execute nameless FORTH code, then forget it. \ Managing Source Screens 07Apr84mapN Make the Next screen the current one. B Make the previous (Before) screen the current one. L List the current screen. ESTABLISH Sets the block number of the most recently referenced block. (COPY) The primitive that copies one screen to another. COPY Copies and screen and flushes it to disk. @VIEW pick up the given view-field and partition it into screen number and file number. File number indexes VIEW-FILES.VIEW <name> will display the name of the file and number of the screen containing the source code for <name>. The file will be opened if possible and the screen listed. \ Disk copy utility 23MAY83HHLHOPPED The number of screens to skip when copying U/D the direction of the copy, to prevent overlap. CONVEY-COPY deferred so that it can be used in different contextHOP Specifies the number of screens to hop over. .TO Prints a message to keep the user happy. (CONVEY) (S blk n -- blk+-n ) Moves a set of screens in the direction of the copy. CONVEY (S first last -- ) Moves a set of screens by first determining the direction to prevent overlap, and then moving them as a set whose size is determined by the number of available buffers. TO ( #1st-source #last-source -- #1st-source #last-source ) You can use TO instead of HOP if you know the destination screen number instead of the number of screens to skip. \ String Functions Case Conversions 10Mar84mapFOUND A local variable to make life easier. SCAN-1ST SCAN for first character of a string if ignoring case otherwise do nothing. This makes SEARCH much faster when case is significant. SEARCH ( sadr slen badr blen -- n f ) Search for the s string inside of the b string. If found f is true and n is the offset from the beginning of the string to where the pattern was found. If not found, f is false and n is meaningless. \ String operators 10Mar84map The following parameters are input to the string operators: sa string-address sl string-length ba buffer-address bl buffer-length ba bl sl DELETE deletes sl characters from the start of the buffer, filling the end with spaces. sa sl ba bl INSERT inserts the minimum of sl or bl characters into ba from sa. sa sl ba bl REPLACE overwrites the minimum of sl or bl characters onto ba from sa. Editor 06Oct83map Defaults to DUMB terminal. \ Terminal Dependant deferred words 04Apr84mapBLOT Delete the rest of the current line. n is the x pos. -LINE Delete the current line, causing the rest to scroll up. AT Position the cursor at the given x and y co-ordinate DARK Clear the screen and home the cursor. Do not be deceived, DARK is indeed a DEFERed word, and can be redirected EDITOR The vocabulary for the editor words. .SCREEN Display the entire screen, or whatever makes sense. AUTO will contain the address of the vector to patch: CR for CRTs and STATUS for TTYs. CHANGED indicates whether the screen being edited has been. EDITING? is a flag which indicates whether you are editing. INSTALL turns on scrolling. \ Move the Editor's cursor around 16Oct83mapC/SCR may not be B/BUF on some machines. TOP Go to the TOP of the screen C Move n characters, right or left. T Go to beginning of line n. CURSOR Return the current cursor position. LINE# The current line number. COL# The current column number. +T Go the beginning of line relative to current line. 'START The memory address of the start of the screen 'CURSOR The memory address of the current position. 'LINE The memory address of the beginning of current line. #AFTER Number of character behind cursor on current line. #REMAINING Number of characters behind cursor on screen. #END Number of characters between line start & screen end. \ buffers 11Mar84mapMODIFIED marks the screen as changed, and sets the update flag. EOS is the character used to denote end of string on input. It allows multiple commands per line. Default is ^. ?TEXT will accept a string to an address, if any input exists. C/PAD characters/pad. Standard requires 84 minimum. 'INSERT, 'FIND, and 'VIDEO are the text buffers. They float above PAD, so their contents change when HERE moves. The alternative is to permanently allocate space for them, which is rather wasteful. .BUFS displays the contents of the insert and find buffers. ?MISSING aborts if flag is false. KEEP places the current line in the insert buffer. \ buffers 11Mar84mapK exchanges the contents of the insert and find buffers. W is a terse way to ensure that all changes are written to disk'C#A is used often. (I) leaves buffer data for insert or overwrite. (TILL) leaves distance to delimiter string. 'F+ adds the length of the found string. ID-LEN is the length of the id buffer. ID contains the user name and date stamp. STAMP places the id into the upper right hand corner of the screen. ?STAMP update id if screen has changed, and clear flag. \ line editing 17Mar83map<text> represents the text following the command. If <text> is null, the contents of the insert buffer are used. I <text> inserts text on the current line at the cursor. O <text> overwrites text on the current line. P <text> replaces the current line with <text> and blanks. U <text> inserts a line under the current line. X deletes the current line and puts it into the insert buffer. SPLIT breaks the current line in two at the cursor. JOIN puts a copy of the next line after the cursor. WIPE clears the screen to blanks. M has been neutralized. It moved a copy of the current line to some other screen. The editor should not affect other screens.G gets a line from another screen, and inserts it in front of the current line. BRING gets several lines. \ find and replace 10Mar84map<text> represents the text following the command. If <text> is null, the contents of the find buffer are used. F <text> finds the text and leaves the cursor just past it. n S <text> searches for the text thru all screens from the current up to n. Each time a match is found, n remains on the stack until screen n is reached. E erases the text just found with F or S. D <text> finds and deletes the text. R <itext> replaces the text just found with <itext> or with the insert buffer. TILL <text> deletes all text on the line from the cursor up to and including <text>. J <text> deletes up to, but not including, <text>. 'Justify' KT <text> puts all text between the cursor and <text> inclusive into the insert buffer. 'Keep-Till' \ screen display 11Mar84map Provided that your terminal supports the four routines AT, DARK, BLOT, and -LINE, this code will give a continuous display of the screen being edited. The display is updated automaticallyas each command line finishes ( just before 'OK' is typed ). DX and DY are offsets which allow room for screen number and line numbers. .LINE displays the current line, with the cursor shown as an up-arrow or caret. n REDISPLAY updates the image of line n. n CHANGED? indicates whether line n has changed since last displayed. It is sensitive to case changes. .ALL redisplays all lines which have changed, the screen number, the cursor line, and scrolls the command region. ***NOTE*** Assumes 24 line 80 column display. \ screen editing 10Mar84mapEDIT-AT displays the terminal's cursor at the editor's cursor. n NEW moves the terminal's cursor to the start of line n, and overwrites lines until a line is begun with null input ( a Carraige Return). GET-ID checks ID, and if it is empty, prompts for the user's id and date. ***NOTE*** If you are fortunate enough to have a CompuPro or similar system with a clock, you can have the editor id supplied automatically on boot. You will love it! \ entering and exiting the editor 04Apr84mapDONE If editing, exits the editor, updates the id stamp, tells you if the screen was modified, and writes the screen to disk. Always clears errors and removes automatic re-display. ED re-enters the editor. It clears and re-initializes the display, and begins automatic re-display of the screen. n EDIT sets SCR to n, then uses ED to start editing. FIX <name> VIEWs the source screen for <name> and enters the editor. (WHERE) uses EDIT to display the screen where an error occurred while loading. WHERE is an execution vector used by ABORT" to locate errors. Setting WHERE to (WHERE) will cause errors to invoke the editor,with the cursor pointing just after the offending word, which will be in the find buffer, ready to be replaced. \ Shadow Screen Support 02Apr84map DISPLACEMENT offset from a screen to its shadow. (>SHADOW) convert screen number in given file to or from its shadow. >SHADOW convert a screen number in FILE to or from its shadow. >IN-SHADOW convert a screen number in IN-FILE to or from its shadow. A toggle between a screen and its shadow. ( Alternate ) \ Shadow Screen Editing 13Apr84map COPY copy a screen and its shadow. CONVEY copy a range of screens and their shadows. G Get a line and its shadow. BRING Get a range of lines and their shadows. \ Terminal dependent routines 04Apr84map These were kept few in number to ease the task of adapting the editor to new terminals. If your terminal is different, replace this screen. Routines for several common terminals are included following the editor. The only terminal dependent words are: col row AT direct cursor positioning DARK clear screen and home cursor col BLOT clear to end of line ( from column n ) -LINE delete the current line, causing those below to scroll upwards. DUMB selects the dumb terminal mode. \ Terminal dependent routines 04Apr84map These were kept few in number to ease the task of adapting the editor to new terminals. If your terminal is different, replace this screen. Routines for several common terminals are included following the editor. The only terminal dependent words are: col row AT direct cursor positioning DARK clear screen and home cursor col BLOT clear to end of line ( from column n ) -LINE delete the current line, causing those below to scroll upwards. SMART is common to all smart terminals. ANSI selects the ANSI standard terminal drivers. \ Terminal dependent routines 04Apr84map These were kept few in number to ease the task of adapting the editor to new terminals. If your terminal is different, replace this screen. Routines for several common terminals are included following the editor. The only terminal dependent words are: col row AT direct cursor positioning DARK clear screen and home cursor col BLOT clear to end of line ( from column n ) -LINE delete the current line, causing those below to scroll upwards. HEATH selects the H-19 or Z-19 terminal drivers. \ Terminal dependent routines 04Apr84map These were kept few in number to ease the task of adapting the editor to new terminals. If your terminal is different, replace this screen. Routines for several common terminals are included following the editor. The only terminal dependent words are: col row AT direct cursor positioning DARK clear screen and home cursor col BLOT clear to end of line ( from column n ) -LINE delete the current line, causing those below to scroll upwards. TELEVIDEO selects the TVI-912 terminal drivers. QUME 102 and FALCO ?? are the same as the TVI. \ General Dump Utility - Output 06Oct83map.2 Display a 2 digit number followed by a space. D.2 Display a line of 2 digit numbers. EMIT. Emit the character if it is displayable. Otherwise display it as a period. DLN (S addr --- ) Dump 16 bytes worth of data starting at the specified address. First the address is displayed, then 2 sets of 8 bytes, followed by the Ascii equivalent. ?.N If the two numbers match, display a downwards pointer, otherwise display the number. ?.A If the two numbers match, display a downwards pointer, otherwise display the number. \ Dump and Fill Memory Utility 23JUN83HHL.HEAD (S -- ) Display the header field of a dump, making it easy to index into the data portion of the display. DUMP (S addr len -- ) Dump memory in the range specified. The dump is always in hex, but the current base is unaltered. DU (S addr -- addr+64 ) Dump 64 bytes at the specified address, and increment it. DL (S line# -- ) Dump the specified line number on the current screen. \ Positional case defining word 23JUN83HHL OUT ( # apf -- ) ( report out of range error ) Display an error message if the index is out of range as pointed to by the parameter field. MAP ( # apf -- a ) ( convert subscript # to address a ) Map a subscript and a pfa into an actual address. CASE: (S n -- ) ( define positional case defining word ) A positional case statement. The number of cases is specified for error checking. At runtime, the nth word is executed, depending upon the value on the stack. \ ASSOCIATIVE: Table Lookup Def. Word 23JUN83HHL ASSOCIATIVE: An associative memory word. It must be followed by a set of values to be looked up. At Runtime, the values stored in the parameter field are searched for a match. If one if found, the index to that value is returned. If no match is made, then the number of entries, ie max index + 1 is returned. This is the inverse of an array. \ Decompile each type of word 29Sep83map(SEE) Forward reference to decompile deferred words The following are used only by the decompiler: .WORD (S IP -- IP' ) Display the name of a word, and bump the simulated IP by 2. .INLINE (S IP -- IP' ) Display a word that contains an inline literal value. .BRANCH (S IP -- IP' ) Dispaly a word that contains an inline branch. .QUOTE (S IP -- IP' ) Handles the special case of COMPILE xxx. .STRING (S IP -- IP' ) Displays a word with an inline string arguement. \ Decompile each type of word 23JUN83HHLDOES? (S IP -- IP' F ) Increments simulated IP and returns true if call dodoes there.(;CODE) (S IP -- IP' ) Perhaps continue to decompile a defining word. .FINISH (S IP -- IP' ) Display current word and quit. \ Classify each word in a definition 15Mar83mapEXECUTION-CLASS This table lists all of the special cases that must be decompiled differently from ordinary Forth words like DUP and + etc. At runtime, if the simulated IP points to a word in this group, the corresponding index from this table will be returned, and placed upon the stack. If there is no match, then the last index + 1 is returned. \ Classify each word in a definition 23JUN83HHL.EXECUTION-CLASS This giant case statement handles the special case decompiling needed. Each entry corresponds to an entry in the previous EXECUTION-CLASS associative table. The function of each of these words is to decompile the current word that the simulated IP is pointing to, and advance the simulated IP accordingly. If no match in the table, .WORD is used. \ Decompile a : definition 23JUN83HHL.PFA (S CFA -- ) This decompiles a parameter field which contains a list of code fields, as is found in : definitions. .IMMEDIATE (S CFA -- ) This indicates whether the current word is Immediate or not. \ Display category of word 09SEP83HHL.CONSTANT (S CFA -- ) Decompile a Constant, and prints its value. .VARIABLE (S CFA -- ) Decompile a Variable, giving its location and value. .: (S CFA -- ) Decompile a high level : definition. .DOES> (S CFA -- ) Decompile a word defined by a CREATE DOES> word. .USER-VARIABLE (S CFA -- ) Decompile a USER variable, giving the offset from the base of the user area and the current value. \ Display category of word 29Sep83map.DEFER Tell the user that this is a deferred word and decompile its current definition. .USER-DEFER Tell the user that this is a USER deferred word and decompile its current definition. .OTHER (S CFA -- ) This decompiles words whose category was is not known. Code words are recognized, as are words defined by defining words. The runtime portion of a word defined by a defining word is decompiled, since the parameter field is determined by the CREATE portion and cannot be deciphered. If all else fails, the word is listed as UNKNOWN. \ Classify a word based on its CFA 23JUN83HHL DEFINITION-CLASS This categorizes the different classes of words that the decompiler will handle. For each class, determined by the type of defining word used, the code field is identical. Thus the standard classes are recognized. .DEFINITION-CLASS These are the routines that handle the decompilation of each class. The most useful, and of course most common one is .: which decompiles : definitions. If the class is not recognized, we check to see if it is a CODE word or perhaps defined by a high level CREATE DOES> word. \ Top level of the Decompiler SEE 09SEP83HHL((SEE)) (S Cfa -- ) Takes an arbitrary code field address and decompiles it based upon its definition class. Upon completion, it indicates whether or not the word is immediate. SEE (S -- ) The user interface. To decompile something type SEE xxx \ Variables and Setup 10Apr84mapEPSON sets EPSON MX-80 printer to 132 column mode. INIT-PR sets printer to 132 column. Default is EPSON. FOOTING Print a message at the bottom of the page. LOGO The Screen number of your LOGO screen L/PAGE The number of lines per page. PAGE# The current page number as we are printing. PAGE Printer dependent. Get to a new page. Increment the page number and reset the line number and the column number. FORM-FEED Print a form feed character. (PAGE) Print enough linefeeds to get to next page. (SEMIT) send a character to either the printer or the console, but not both. The following words are used only in this utility: SCR#S An array to hold a count and 6 screen numbers. \ Print 2 screens across on a page 09Apr84mapTEXT? (S Scr# -- f ) Given a screen number, returns true if the first character in the screen is printable and the screen is not blank. PR (S scr -- ) Add the screen to the array and increment the pointers. If it is out of range, replace it with the logo screen. 2PR (S Scr1# Scr2# line# -- ) Print the specified line from the two screens given on the stack. The line from scr2 is copied to pad and the line from scr1 is appended, and the result is printed. 2SCR (S Scr1 Scr2 --- ) Print 2 screens across on a page. Calls 2PR on a line by line basis. \ Prints 6 screen on a page 22Feb84mapP-HEADING (S -- ) Prints the heading for each new page. P-FOOTING (S -- ) Prints the footing for each new page. Assumes form feed works \ Prints 6 screen on a page 22Feb84mapPR-START Initialize everything. PR-STOP Resets the deferred word EMIT to send to terminal. PR-PAGE (S -- ) Prints a page worth of screens without shadows. The screens are printed in vertical columns, 6 up on a page. PR-S-PAGE (S -- ) Prints a page worth of screens with shadows. The source code appears in the left column, and the associated shadow on the right column. PR-FLUSH (S -- f ) Fills the SCR#S array if a page is partially filled. Returns true if there is more to print, otherwise false. \ Print Page with Shadows 05Oct83mapSHOW is the used to print a range of screens, from first to last. Screens are printed six to each page. This requires a printer capable of 132 columns per line. Some printers, like the Epson, must be put into a mode where 132 columns per line are available. Blank screens are not printed. SHADOW SHOW is similar, but prints three screens and their three shadows on each page. Typical usage: 1 20 SHOW or 1 20 SHADOW SHOW See the multi-tasker for an example of print spooling. LISTING print entire file, with shadows. 12Oct83map For example, DEBUG WORDS will trace the execution of WORDS the next time it is used. \ Print a High Level Trace 10Mar84mapPut component words in BUG vocabulary. L.ID print the name of a word left justified in a field of least len characters. SLOW when true, step continuously. RES when true, resume debugging. See TRACE. (DEBUG) sets the upper and lower limits of the tracing window to the given values, and patches next. 'UNNEST find end of word to debug. \ Enter and Leave the Debugger 12Oct83mapTRACE is executed every other pass thru NEXT. It displays the contents of the parameter stack and the name of the next word to be executed in the routine being debugged. TRACE then waits for a key unless SLOW is true. If the key is C, F, or Q, special action is taken, otherwise a single step is performed. C turns on continuous running ( and SLOW). F re-enters Forth and interprets commands until RESUME is executed. Q aborts the trace and restores NEXT with FIX. DEBUG patches NEXT to the debugging version of NEXT. DEBUG also sets the upper and lower limits of the tracing region to the ends of the parameter field of the specified word. RESUME turns on RES, which enables tracing to continue. \ Examples 10Mar84mapSee BACKGROUND: and its shadow for spooler and counter tasks. To enable spooler, once defined, type MULTI. MULTI starts the multi-tasker loop running. SINGLE stops it. Then type SPOOLER WAKE to start the spooler task. To put the spooler on hold, use SPOOLER SLEEP To restart it, use SPOOLER WAKE In general, executing the name of a task leaves the address of its user area on the stack. Words like sleep and wake use that address. \ Activate a Task 30Sep83mapTASK: Name, initialize, and allocate a new task. Copy the USER Area. I point to where he pointed. He points to me. Set initial stack pointers. Set dictionary pointer. Make task ready to execute. Allocate task in host dictionary. SET-TASK assigns an existing task to the code at ip. Get top of stack of the task to be used. Put IP and RP values on its stack. Set its saved stack pointer. ACTIVATE assigns an existing task to the following code, and makes it ready to execute. \ Create a Background Task 10Mar84mapBACKGROUND: Create a new task of default size. Initialize it to execute the following code. Examples: This creates a task named spooler which lists the current file. STOP is needed at the end of a task. Assigns existing task named spooler to show screens 3 thru 15, and their shadows. The task named counter executes an infinite loop, so STOP is notrequired. Note that you MUST use PAUSE, or no other tasks will be executed. PAUSE is built in to all words which do I/O, so tasks which do I/O ( like spooler ) do not need to use PAUSE explicitly.
