Jump to content
Sign in to follow this  
TheBF

Fast Simple Combsort in BASIC

Recommended Posts

A long time ago I came across an article in BYTE magazine (April 1991) about some medical doctors (really) who figured out a great improvement to bubble sort by trial and error.

The COMB sort is similar to the Shell Metzner in that is compares items in the array that are separated by a 'GAP'.

The difference is in how you calculate the GAP.

 

Comb sort uses a magic value of 1.3. Each time through the array, the GAP is divided by 1.3.

This gives an amazing improvement over BUBBLE sort with only a couple of extra lines of code

And the bigger the array the better the improvement, but even on 32 chars it is 10X faster. :-)

 

I have provided two simple DEMO programs that sort characters on the screen for anyone who might need a sort routine.

 

Bubble sort demo

 

 

 

100 REM Bubble Sort DEMO
120 REM a simple sort
130 CALL CLEAR
135 CALL SCREEN(12)
140 PRINT "*BUBBLE SORT DEMO*"
150 LET SIZE=31

210 REM write chars to screen
220 C=64+SIZE
230 FOR I=1 TO SIZE
240   CALL HCHAR(10,I,C,1)
250   C=C-1
260 NEXT I

400 REM sort chars on screen
420 LET PASSES=0

430 REM start of loop
440 SORTED=1

450 FOR I=1 TO SIZE-1
452   CALL GCHAR(10,I,X)
454   CALL GCHAR(10,I+1,Y)
460   IF X<Y THEN 530
480   CALL HCHAR(10,I,Y)
490   CALL HCHAR(10,I+1,X)
520   SORTED=0
530 NEXT I
540 PASSES=PASSES+1
550 REM test if sort is finished
560 IF SORTED=1 THEN 600
570 GOTO 440

600 PRINT "Sort completed in";PASSES;"times through the array"
640 END
650 REM 272.5 sec.

 

 

 

 

 

 

100 REM Comb Sort DEMO
120 REM a faster simple sort
130 CALL CLEAR
135 CALL SCREEN(12)
140 PRINT "*COMB SORT DEMO*"
150 LET SIZE=31

210 REM write chars to screen
220 C=64+SIZE
230 FOR I=1 TO SIZE
240   CALL HCHAR(10,I,C,1)
250   C=C-1
260 NEXT I

400 REM sort chars on screen
420 PASSES=0
425 GAP=SIZE
430 REM start of loop
440 SORTED=1
442    GAP=INT(GAP/1.3)
450    FOR I=1 TO SIZE-GAP
452      CALL GCHAR(10,I,X)
454      CALL GCHAR(10,I+GAP,Y)
460      IF X<Y THEN 530
480      CALL HCHAR(10,I,Y)
490      CALL HCHAR(10,I+GAP,X)
520      SORTED=0
530    NEXT I
540 PASSES=PASSES+1
550 REM test if sort is finished
560 IF (GAP=1) THEN 600
570 GOTO 440

600 PRINT "Sort completed in";PASSES;"times through the array"
640 END
650 REM 25.6 sec.

 

 

 

  • Like 6

Share this post


Link to post
Share on other sites

This video sorts 255 chars on the screen.

 

You can really see how each method, COMB, SHELL and Bubble sorting works.

 

At the end you can see how they each perform on the sorted data.

Bubble sort is the fastest on already sorted data, but COMB sort is still good.

Shell Sort not so much on either. :-)

SORTDEMO.mp4

Share this post


Link to post
Share on other sites

A long time ago ...

 

Interesting story.

I also like the demo programs which are short enough for a little article in our TI magazine "Tijdingen" if it is okay with you.

 

Fred ;-)

Share this post


Link to post
Share on other sites

 

Interesting story.

I also like the demo programs which are short enough for a little article in our TI magazine "Tijdingen" if it is okay with you.

 

Fred ;-)

 

Ja zeker.

 

Groeten aan Nederland. :-)

Share this post


Link to post
Share on other sites

 

Interesting story.

I also like the demo programs which are short enough for a little article in our TI magazine "Tijdingen" if it is okay with you.

 

Fred ;-)

 

Hi Fred,

 

I just realized that you might be in Belgium.

My apologies if I got it wrong.

 

BF

Share this post


Link to post
Share on other sites

Hahaha ... no offence, for that matter I could also be from South Africa or Suriname.

But no ... I'm dutch, created in East London, Sout Africa and almost born in London, United Kingdom and almost almost born in Antwerp, Belgium but eventually born in Alkmaar the Netherlands.

 

Made a translation of your post this afternoon inclusive links to this topic and Wikipedea.

 

Fred :P

Edited by F.G. Kaal

Share this post


Link to post
Share on other sites

Nice!

COMB Sort actually rivals quicksort depending on the order your data is in, and it's easy to implement without recursion. I think COMB is better in the worst case and Quicksort is better in the best case... or it was the other way around.

I used a variation of COMB in a VB application back in the 90s.
The programmer that wrote some code I inherited didn't know how to implement a sort (!?), and the program that ran nightly required quite a bit of interaction from the night crew so it could use an external sort utility.
So I threw in a sort. COMB sorted 85,000+ records in about 15 minutes and the program didn't need any interaction once it was kicked off.
FWIW, Bubble sort didn't complete sorting the same data in 12 hours. I threw that in at first when I couldn't find VB code for quicksort.
I implemented COMB by trying to speed up the code, but I didn't know it was a COMB sort until later.

Share this post


Link to post
Share on other sites

Hahaha ... no offence, for that matter I could also be from South Africa or Suriname.

But no ... I'm dutch, created in East London, Sout Africa and almost born in London, United Kingdom and almost almost born in Antwerp, Belgium but eventually born in Alkmaar the Netherlands.

 

Made a translation of your post this afternoon inclusive links to this topic and Wikipedea.

 

Fred :P

Share this post


Link to post
Share on other sites

My wife's family is from Brabant, a couple small villages.

The part of Canada that I live in had thousands of people come here after the war. The land is flat😄

Share this post


Link to post
Share on other sites

Nice!

 

COMB Sort actually rivals quicksort depending on the order your data is in, and it's easy to implement without recursion. I think COMB is better in the worst case and Quicksort is better in the best case... or it was the other way around.

 

I used a variation of COMB in a VB application back in the 90s.

The programmer that wrote some code I inherited didn't know how to implement a sort (!?), and the program that ran nightly required quite a bit of interaction from the night crew so it could use an external sort utility.

So I threw in a sort. COMB sorted 85,000+ records in about 15 minutes and the program didn't need any interaction once it was kicked off.

FWIW, Bubble sort didn't complete sorting the same data in 12 hours. I threw that in at first when I couldn't find VB code for quicksort.

I implemented COMB by trying to speed up the code, but I didn't know it was a COMB sort until later.

Share this post


Link to post
Share on other sites

Did you discover the 1.3 gap ratio independently?

No, as I said, I used a variation. It's not exactly the same but comb was what I thought it was closest to. I could be mistaken... wouldn't be the first time.

 

I actually divided the gap by 2 each change and made multiple passes more like bubble sort, but using a for loop that exits if no swaps take place on a pass.

The for loop executes 1 less time than the amount it was split by.

The data was split in half at first so 2-1 was the end of the loop at first (for i = 1 to 1), then I divided by half again so 4-1, etc...

Maybe that's more like some other sort?

It makes more passes at each level but moves the out of order data further than standard COMB in each pass.

 

Share this post


Link to post
Share on other sites

No, as I said, I used a variation. It's not exactly the same but comb was what I thought it was closest to. I could be mistaken... wouldn't be the first time.

 

I actually divided the gap by 2 each change and made multiple passes more like bubble sort, but using a for loop that exits if no swaps take place on a pass.

The for loop executes 1 less time than the amount it was split by.

The data was split in half at first so 2-1 was the end of the loop at first (for i = 1 to 1), then I divided by half again so 4-1, etc...

Maybe that's more like some other sort?

It makes more passes at each level but moves the out of order data further than standard COMB in each pass.

 

 

I think you found a similar mechanism independently, but with a different GAP ratio.

 

There is another sort called Shell-Metzner or Shellsort that is described here: https://en.wikipedia.org/wiki/Shellsort

I think you might have done that.

 

The Combsort is a strange variation that changes the GAP by this magic ratio and it just works well.

https://en.wikipedia.org/wiki/Comb_sort

 

I didn't realize until I read the Wikipedia on Shellsort that it is "fair game" to use different GAPs, even using a list of GAPs.

 

All that to say I think you discovered Shellsort. :)

 

B

Share this post


Link to post
Share on other sites

 

I think you found a similar mechanism independently, but with a different GAP ratio.

 

There is another sort called Shell-Metzner or Shellsort that is described here: https://en.wikipedia.org/wiki/Shellsort

I think you might have done that.

 

The Combsort is a strange variation that changes the GAP by this magic ratio and it just works well.

https://en.wikipedia.org/wiki/Comb_sort

 

I didn't realize until I read the Wikipedia on Shellsort that it is "fair game" to use different GAPs, even using a list of GAPs.

 

All that to say I think you discovered Shellsort. :)

 

B

Shellsort was my 2nd guess... but I thought shellsort was a gapped insertion sort.

The animations look very different than what my sort does, and it looks much more like comb.

I think the best and worst case are probably the same.

 

Share this post


Link to post
Share on other sites

Shellsort was my 2nd guess... but I thought shellsort was a gapped insertion sort.

The animations look very different than what my sort does, and it looks much more like comb.

I think the best and worst case are probably the same.

 

 

Do you still have any code lying around?

 

It sounds then like you made the comb sort independently with a 1/2 GAP which works but may be just slightly sub-optimal compared to 1/1.3

 

Pretty cool work by you.

Share this post


Link to post
Share on other sites

 

Do you still have any code lying around?

 

It sounds then like you made the comb sort independently with a 1/2 GAP which works but may be just slightly sub-optimal compared to 1/1.3

 

Pretty cool work by you.

Code from 1993... ish? Nope. Not that I know of.

 

Whether or not it's sub optimal would depend on the data. Since the GAP doesn't change every pass, it has the potential to move very out of order items really quickly, and anything moved way too far in the initial passes quickly moves back towards it's final location.

I think it's biggest flaw was the gap change was too large once you got below a certain gap # and there were an excessive number of swaps in the final passes.

It probably should have used a table of GAP values derived from examining the source data. New data was added, but the order didn't change much from one time to the next.

 

Edited by JamesD

Share this post


Link to post
Share on other sites

Code from 1993... ish? Nope. Not that I know of.

 

Whether or not it's sub optimal would depend on the data. Since the GAP doesn't change every pass, it has the potential to move very out of order items really quickly, and anything moved way too far in the initial passes quickly moves back towards it's final location.

I think it's biggest flaw was the gap change was too large once you got below a certain gap # and there were an excessive number of swaps in the final passes.

It probably should have used a table of GAP values derived from examining the source data. New data was added, but the order didn't change much from one time to the next.

 

 

 

I will have to play with the 1/2 value to see what happens.

I remember in the Byte Magazine article where I found this sort, they showed a graph where these two guys experimented with gap size s and found this magic 1.3 value. There was a switch as you say when the GAP got below a certain size that they claimed was better but my tests didn't give me an speedup because testing for the condition took more time.

 

So your name needs to go up there in Wikipedia as one of the independent discoverers of this algorithm.

Share this post


Link to post
Share on other sites

 

 

I will have to play with the 1/2 value to see what happens.

I remember in the Byte Magazine article where I found this sort, they showed a graph where these two guys experimented with gap size s and found this magic 1.3 value. There was a switch as you say when the GAP got below a certain size that they claimed was better but my tests didn't give me an speedup because testing for the condition took more time.

 

So your name needs to go up there in Wikipedia as one of the independent discoverers of this algorithm.

Well, I was dealing with 85,000+ records with over a hundred added per month. so the large moves probably made a huge difference.

And remember, my variation used multiple passes like a bubble sort.

 

If you have 1000 items and just use 1/2 during the first 4 passes, that should get really out of order data within something like 75 or less distance from it's final location.

If your data is almost in order, you may waste 4 passes... but then that's probably true with the regular comb sort with a data set that size.

Instead of multiple passes like my variation, I think the ideal would use a table of data that follows a curve rather than a linear drop.

I'm sure some math whiz could come up with a theoretical formula you could use but I'm not sure there is a one size fits all formula.

Maybe start with half and then have a multiplier that gradually alters the multiplier.

It would be interesting to play with.

Edited by JamesD

Share this post


Link to post
Share on other sites

...

So your name needs to go up there in Wikipedia as one of the independent discoverers of this algorithm.

I didn't catch that until after I posted.

 

There is a simple rule to getting credit for discovering something. You have to publish to get credit.

 

Share this post


Link to post
Share on other sites

I didn't catch that until after I posted.

 

There is a simple rule to getting credit for discovering something. You have to publish to get credit.

 

 

Well at least we all know. :-)

Share this post


Link to post
Share on other sites

Went down the rabbit hole playing with this combsort and the Dutch Flag Problem.

https://en.wikipedia.org/wiki/Dutch_national_flag_problem

(no, there is no problem with the Dutch flag) :)

 

This is not an optimal way to solve it, but it makes an interesting way to view how the sort works.

The sort is using the screen memory as an array of data and sorting in place.

There are 4 different scenarios. (I apologize that the screen fillers are not all perfect.)

 

I did a version with sprites pointing to where the sort is comparing, but it was too fast and not very helpful.

 

 

 

\ Dutch flag problem DEMO using combsort
\ *SORTS IN PLACE FROM VDP MEMORY*

GRAPHICS

HEX
83C0 CONSTANT SEED   \ RAM where TI has a number incrementing in main menu
1045 CONSTANT GEN#   \ GForth uses $10450405, we take the 1st 16 bits
: RNDW      ( -- n )   SEED @ GEN# UM* DROP 1+ DUP SEED ! ;
: RANDOMIZE ( n -- )   SEED ! ;
: RND       ( n -- n') RNDW ABS SWAP MOD ;

\ 83D6 CONSTANT SCRTMO  \ clear screen time-out

VARIABLE GAP
VARIABLE ITEMS
VARIABLE ADR
VARIABLE SFLAG

FFFF FFFF FFFF FFFF PATTERN: SQUARE
0F07 0F1D 3870 E0C0 PATTERN: ARROW

\ define colors and characters

DECIMAL
24 32 *  CONSTANT SIZE     \ flag will fill GRAPHICS screen
SIZE 3 / CONSTANT #256     \ 256 chars per segment of flag
1        CONSTANT REDSQR   \ red character
9        CONSTANT WHTSQR   \ white character
19       CONSTANT BLUSQR   \ blue character
28       CONSTANT PTR1

\ color constants
1        CONSTANT TRANS
7        CONSTANT RED
5        CONSTANT BLU
16       CONSTANT WHT

SQUARE REDSQR CHARDEF
SQUARE BLUSQR CHARDEF
SQUARE WHTSQR CHARDEF
SQUARE PTR1   CHARDEF

\ charset  FG    BG
  0        RED TRANS COLOR
  1        WHT TRANS COLOR
  2        BLU TRANS COLOR

\ screen fillers
: RNDI    ( -- n ) SIZE 1+ RND ; \ return a random VDP screen address

: NOTRED    (  -- n ) \ return rnd index that is not RED
           BEGIN  RNDI DUP [email protected] REDSQR = WHILE DROP  REPEAT ;

: RNDRED  (  -- ) \ Random RED on VDP screen
          #256  0 DO  REDSQR NOTRED VC!  LOOP ;

: NOTREDWHT    ( -- n ) \ return rnd index that is not RED or BLU
           BEGIN  RNDI DUP
              [email protected]  DUP REDSQR =  SWAP WHTSQR = OR
           WHILE
              DROP
           REPEAT ;

: RNDWHT (  -- ) \ place white where there is no red or white
          #256 0 DO  WHTSQR NOTREDWHT VC!  LOOP ;

: BLUSCREEN ( -- )  0 768 BLUSQR VFILL ;
        \  SIZE 0 DO
        \      I [email protected] BL =
        \      IF  BLUSQR I VC!   THEN
        \  LOOP ;

\ load the screen with random red,white&blue squares
: RNDSCREEN   ( -- )  BLUSCREEN  RNDRED  RNDWHT ;

: BLUWHTRED  ( -- )
         SIZE 0
         DO
              BLUSQR I VC!
              WHTSQR I 1+ VC!
              REDSQR I 2+ VC!
         3 +LOOP ;

: RUSSIAN  \ Russian flag
            0  0 WHTSQR 256 HCHAR
            0  8 BLUSQR 256 HCHAR
            0 16 REDSQR 256 HCHAR ;

: FRENCH  \ kind of French flag
           0  0 BLUSQR 256 VCHAR
          10 15 WHTSQR 256 VCHAR
          21  7 REDSQR 256 VCHAR ;

\ These macros remove a call to this code
: /1.3  ( n -- n/1.35 ) \ 100/135 is fastest GAP  ratio for this sort
        S" 100 135 */ 1 MAX " EVALUATE ;  IMMEDIATE

: XCHG  ( adr1 adr2 CHAR1 CHAR2 -- ) 
        S" SWAP ROT VC! SWAP VC!" EVALUATE ;  IMMEDIATE

: COMBSORT (  -- )
    SIZE DUP  GAP !
    BEGIN
        GAP @  /1.3  GAP !  \ calc. new gap
        SFLAG ON
        DUP GAP @ -  0
        DO                   ( **stack state**)
           I DUP GAP @ +     ( -- adr1 adr2)
           OVER [email protected] OVER [email protected] ( -- adr1 adr2 c1 c2)
           2DUP >            ( -- adr1 adr2 c1 c2)
           IF
              XCHG           ( -- )
              SFLAG OFF
           ELSE
              2DROP 2DROP    ( -- )
           THEN
        LOOP
        SFLAG @  GAP @ 1 = AND            \ additional conditional
    UNTIL
    DROP ;

: BEEPS   0 ?DO  BEEP 1000 MS  LOOP ;

: RUN ( -- )
         RNDSCREEN  3 BEEPS COMBSORT HONK
         BLUWHTRED  3 BEEPS COMBSORT HONK
         RUSSIAN    3 BEEPS COMBSORT HONK
         FRENCH     3 BEEPS COMBSORT HONK
         CR ." Completed"  ;


 

 

 

 

post-50750-0-15235100-1516745116.gif

Edited by TheBF
  • Like 1

Share this post


Link to post
Share on other sites

Update to the Dutch Flag demo.

 

I have a more complete version on Github now and I took the time to wait for the Bubble sort to finish, for a comparison.

 

The sorted pattern is 11.33 secs with Bubble sort and 11.38 with Comb sort so comparable.

 

All non-sorted input patterns take over 6 minutes with Bubble sort and the Comb sort takes a maximum of 12.5 secs.

 

So if you ever need to sort some data in TI BASIC don't use Bubble sort, use Comb sort which is only a couple of lines bigger.

  • Like 1

Share this post


Link to post
Share on other sites

Decompiling Camel Forth

Last week I asked the author of Camel Forth, Brad Rodriguez, if he had decompiler code for Camel Forth.
He told me he had never written a de-compiler for any Forth that he had written but he was sure "you can handle it".
So I took a run at it.
Forth has a "dictionary" which is a linked list that contains the names of all the words in the language.
Along with the name there are a couple of extra fields that let the system find the code that goes with the word name.
Camel Forth, like FB Forth and Turbo Forth is a "threaded code" system.
This means that the compiler does not generate machine code, but rather creates lists of addresses.
These addresses can point to other routine addresses but eventually they point to real machine code.
So to decompile this kind of Forth means you have to read through each list and find the name of the
word associated with the address, print the name and move ahead two bytes and read the next address.
You continue doing this until you get to the address of the routine called EXIT, which is the Forth
equivalent of "RETURN" or RT in assembler.
Each Forth word begins with the address of a machine code routine that is the actual "interpreter" for that kind of word.
There is a special routine for variables, constants, new routine definitions (colon definitions) and one for something
called USER variables that are used when tasks need their own copy of some variables. These special
routines let you identify the "type" of each Forth word even though Forth is not a "typed" language.
Armed with that "type" information you can figure out how to print out the info for any given Forth word.
There are three different "decompilers" in this implementation:
One for the "primitves" which are real machine code.
When I encounter a "CODE" word in this decompiler I resorted to simply printing our the machine code since
making a dis-assembler would be a whole other project. The printed CODE word could actually be pasted
into the CAMEL Forth and used as is so that has some benefit.
Another decompiler is for variables, constants and USER variables so you see what there value is.
This is a little bit frivolous because you can do that with the Forth interpreter anytime you want but it makes
the thing consistent for the end user.
And a final decompiler is for "colon" definitions. (Forth words)
For some language constructs I elected to show what is compiled in the Forth routine rather than re-creating
the exact source code. This can be a difficult thing for newbies to grok about Forth.
The IF ELSE THEN and BEGIN UNTIL words actually compile little code routines called BRANCH and
?BRANCH which are like assembler B @xxx and JEQ @xxxx instructions. In fact the word BEGIN doesn't
compile anything into a program, It's just a general purpose label for loops to branch back too! So BEGIN
disappears when you decompile Forth code. The branching words are always followed by a number
which is the how many bytes the program has to jump. Positive numbers jump forward and negative numbers
cause the program to jump back.
I also take this approach for ." and DO/LOOP constructs. You see what the compiler did rather than the
de-compiler re-creating pretty source code.
The traditional name for a decompiler in Forth is "SEE".
Here are the example routines we will de-compile:
*EDIT* Corrected TEST2 per Lee's observation. GIF is still erroneous. Thou hast been warned.
\ Examples to DE-COMPILE

: TEST1  1 2 3 + + . ;

: TEST2  100 0 DO  I .  LOOP ;

: TEST3  BEGIN  ." HELLO WORLD!"  SPACE  AGAIN ;

: TEST4  TEST1 TEST2 TEST3 ;

The de-compiler code is in the spoiler and the GIF shows the decompiler in action.

\ see.fth a decompiler for CAMEL99
\
HEX
INCLUDE DSK1.CASE.F
INCLUDE DSK1.TOOLS.F

\ Getting back from the CFA to the NFA is tricky in CAMEL Forth
: CFA>NFA  ( cfa -- nfa | 0 )
            2-           \ cfa-2 gets to end of name text
            BEGIN
              2- DUP [email protected]  \ dect the address and fetch the byte
              0FE AND    \ mask out immediate bit and check byte count
            0= UNTIL     \ 0 means we found immediate field address
            1+ ;         \ +1 byte puts us at nfa

\ determine if a memory cell contains a word
\ if not it must be a number.
: VALIDWORD? ( nfa -- nfa | 0 )
            LATEST @
            BEGIN
              NFA>LFA @
              2DUP = OVER 0= OR
            UNTIL
            NIP ;


: LOOKUP    ( <text> -- cfa)
            BL WORD FIND  0= ABORT" Not a word" ;


     VARIABLE IMMFLAG      \ set if decompiled word is immediate
HEX
 045A    CONSTANT $NEXT  \ machine code for CAMEL99 NEXT (B *R10)

( lookup XTs of special words at compile time) 
( declare constants for speed)
' EXIT   CONSTANT 'EXIT
' (S")   CONSTANT '(S")
' DOVAR  CONSTANT 'DOVAR
' DOCON  CONSTANT 'DOCON
' DOUSER CONSTANT 'DOUSER

: TAB       ( -- ) 4 SPACES ;
: ?NEWLINE  ( -- ) OUT @ 5 + C/[email protected] > IF CR TAB THEN ;

: IMMED?    ( nfa -- f ) 1- [email protected] 1 AND NEGATE ;

: CLEANSTK  ( -- )  SP0 SP!  CR QUIT ;

: .VARIABLE ( nfa cfa -- nfa)
            CR  ." VARIABLE " OVER .ID ."  = "  >BODY @ U.
            CLEANSTK ;

: .CONSTANT ( nfa cfa -- nfa)
            CR  DUP >BODY @ U. ." CONSTANT " OVER .ID
            CLEANSTK ;

: .USER     ( nfa cfa -- nfa)
            CR  DUP >BODY @ DUP  U. ." USER " ROT .ID
            ."  = " 8300 + @ U.
            CLEANSTK ;

: .EXIT     ( cfa -- )
            ."  ; "
            IMMFLAG @ IF CR TAB ." IMMEDIATE" THEN  
            CR  ;

CHAR " CONSTANT '"'

: .SQUOTE   ( addr -- addr' )
            CR TAB
            [CHAR] S EMIT '"' EMIT SPACE
            CELL+ COUNT 2DUP TYPE '"' EMIT SPACE     \ emit closeing quote
            + ALIGNED  2-    \ compute address past the string
            NIP ;             \ remove old address
\
: ?CODE ( cfa -- ) DUP @ 2- = ;
: ?COLON ( cfa -- ) @  ['] DOCOL @ OVER = ;

: .CODEWORD ( NFA CFA -- )
            CR ." CODE "  OVER .ID
            CR TAB
            BEGIN
              DUP @  ?NEWLINE .#### ."  , "
              CELL+ DUP @ $NEXT =
            UNTIL
            DROP
            CR TAB ." NEXT,"
            CR ." ENDCODE"  ;

: .COLONWORD  ( cfa -- )
            CFA>NFA              \ -- nfa
            DUP  VALIDWORD?      \ -- nfa ?
            IF
              ?NEWLINE .ID SPACE
            ELSE
              SWAP  \ not a word so drop the nfa
                    \ fetch the contents and print it
              DUP @ .  SPACE
            THEN ;

: DECOMPILE ( nfa cfa -- )
            CR ." : "  OVER .ID
            CR TAB
            BEGIN
              CELL+    \ move to next cell in the thread
              DUP @              \ -- cell XT
              DUP 'EXIT = 0=  \ not the end of word?
            WHILE
              DUP '(S") =       \ is it a string?
              IF   
                   ( cfa) DROP
                   .SQUOTE
              ELSE
                   .COLONWORD    \ it's a colon def.
              THEN ?BREAK
            REPEAT
           .EXIT  SP0 SP! CR ;   \ print the ending

: DATA-DECODER ( cfa -- ) \ show single data types correctly
            DUP @     ( -- xt)
            CASE
              'DOVAR  OF  .VARIABLE     ENDOF
              'DOCON  OF  .CONSTANT     ENDOF
              'DOUSER OF  .USER         ENDOF
            ENDCASE ;

: SEE       (  -- <string> )
            IMMFLAG OFF
            LOOKUP DUP CFA>NFA SWAP  ( -- nfa cfa)
            DUP ?CODE IF .CODEWORD DROP EXIT THEN
            OVER IMMED?  IMMFLAG !  \ set a flag if the word is immediate
            DATA-DECODER
            DECOMPILE
;

 

 

post-50750-0-70397800-1532785062.gif

Edited by TheBF
  • Like 3

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
Sign in to follow this  

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...