Coding style change: No code after stack comment for multi-line defin…

…itions (not completely through; some code will stay in the original format, like the one-screen codes

Makefile.in

@@ -172,9 +172,7 @@ KERN_SRC = \
 	kernel/aliases0.fs \
 	kernel/aliases.fs \
 	kernel/args.fs \
-	kernel/cloop.fs \
 	kernel/cond.fs \
-	kernel/cond-old.fs \
 	cross.fs \
 	kernel/errore.fs \
 	kernel/files.fs \

ansi.fs

@@ -75,16 +75,18 @@ decimal
 
 User Attr   $660 Attr !
 
-: (Attr!)       ( attr -- ) dup Attr @ = IF drop EXIT THEN
-                dup Attr !
-                ESC[    0 pn
-                        dup FG> ?dup IF $F xor 30 + ;pn THEN
-                        dup BG> ?dup IF $F xor 40 + ;pn THEN
-                        dup Bold and IF 1 ;pn THEN
-                        dup Underline and IF 4 ;pn THEN
-                        dup Blink and IF 5 ;pn THEN
-                        Invers and IF 7 ;pn THEN
-                        [char] m emit ;
+: (Attr!) ( attr -- )
+    \G set attribute
+    dup Attr @ = IF drop EXIT THEN
+    dup Attr !
+    ESC[    0 pn
+    dup FG> ?dup IF $F xor 30 + ;pn THEN
+    dup BG> ?dup IF $F xor 40 + ;pn THEN
+    dup Bold and IF 1 ;pn THEN
+    dup Underline and IF 4 ;pn THEN
+    dup Blink and IF 5 ;pn THEN
+    Invers and IF 7 ;pn THEN
+    [char] m emit ;
 
 ' (Attr!) IS Attr!
 
@@ -96,7 +98,8 @@ User Attr   $660 Attr !
     default-out op-vector !
 [THEN]
 
-: BlackSpace    Attr @ dup BG> Black =
-                IF drop space
-                ELSE 0 attr! space attr! THEN ;
+: BlackSpace ( -- )
+    Attr @ dup BG> Black =
+    IF drop space
+    ELSE 0 attr! space attr! THEN ;
 

assert.fs

@@ -71,11 +71,12 @@ variable assert-level ( -- a-addr ) \ gforth
 
 : debug-does>  DOES>  @
     IF ['] noop assert-canary  ELSE  postpone (  THEN ;
-: debug: ( -- ) Create false ,
-    debug-does>
+: debug: ( -- )
+    Create false , debug-does>
 comp:  >body
     ]] Literal @ IF [[ [: ]] THEN [[ ;] assert-canary ;
-: )else(  ]] ) ( [[ ; \ )
+: )else( ( --)
+    ]] ) ( [[ ; \ )
 comp: drop 2>r ]] ELSE [[ 2r> ;
 : else( ['] noop assert-canary ; immediate
 
@@ -85,8 +86,8 @@ comp: drop 2>r ]] ELSE [[ 2r> ;
 
 Variable debug-eval
 
-: +-? ( addr u -- flag )  0= IF  drop false  EXIT  THEN
-    c@ ',' - abs 1 = ; \ ',' is in the middle between '+' and '-'
+: +-? ( addr u -- flag )
+    0<> swap c@ ',' - abs 1 = and ; \ ',' is in the middle between '+' and '-'
 
 : +debug ( -- )
     BEGIN  argc @ 1 > WHILE
@@ -127,7 +128,8 @@ Variable timer-list
 
 : !time ( -- ) ntime timer-tick 2! ;
 : @time ( -- delta-f ) ntime timer-tick 2@ d- d>f 1n f* ;
-: .time ( -- ) @time
+: .time ( -- )
+    @time
     fdup 1e f>= IF  13 9 0 f.rdp ." s "   EXIT  THEN  1000 fm*
     fdup 1e f>= IF  10 6 0 f.rdp ." ms "  EXIT  THEN  1000 fm*
     fdup 1e f>= IF   7 3 0 f.rdp ." µs "  EXIT  THEN  1000 fm*

complex.fs

@@ -110,15 +110,17 @@ previous
 : zln      ( z -- ln[z] ) >polar fswap fln fswap ;
 
 : z0=      ( z -- flag ) f0= >r f0= r> and ;
-: zsqrt    ( z -- sqrt[z] ) zdup z0= 0= IF
-    fdup f0= IF  fdrop fsqrt 0e  EXIT  THEN
-    zln z2/ zexp  THEN ;
+: zsqrt    ( z -- sqrt[z] )
+    zdup z0= 0= IF
+	fdup f0= IF  fdrop fsqrt 0e  EXIT  THEN
+	zln z2/ zexp  THEN ;
 : z**      ( z1 z2 -- z1**z2 ) zswap zln z* zexp ;
 \ Test: Fibonacci-Zahlen
 1e 5e fsqrt f+ f2/ fconstant g  1e g f- fconstant -h
-: zfib     ( z1 -- fib[z1] ) zdup z>r g 0e zswap z**
-  zr> zswap z>r -h 0e zswap z** znegate zr> z+
-  [ g -h f- 1/f ] FLiteral zscale ;
+: zfib     ( z1 -- fib[z1] )
+    zdup z>r g 0e zswap z**
+    zr> zswap z>r -h 0e zswap z** znegate zr> z+
+    [ g -h f- 1/f ] FLiteral zscale ;
 
 \ complexe Operationen                                 02mar05py
 
@@ -139,8 +141,8 @@ previous
 \ complexe Operationen                                 02mar05py
 
 : zasinh    ( z -- asinh[z] ) zdup 1e f+   zover 1e f-   z* zsqrt z+ pln ;
-: zacosh    ( z -- acosh[z] ) zdup 1e x- z2/ zsqrt  zswap 1e x+ z2/ zsqrt z+
-  pln z2* ;
+: zacosh    ( z -- acosh[z] )
+    zdup 1e x- z2/ zsqrt  zswap 1e x+ z2/ zsqrt z+ pln z2* ;
 : zatanh    ( z -- atanh[z] ) zdup  1e x+ zln  zswap 1e x- znegate pln  z- z2/ ;
 : zacoth    ( z -- acoth[z] ) znegate zdup 1e x- pln  zswap 1e x+ pln   z- z2/ ;
 

cross.fs

@@ -1553,23 +1553,31 @@ variable constflag constflag off
 
 bigendian
 [IF]
-   : DS!  ( d addr -- )  tcell bounds swap 1-
-     DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
-   : DS@  ( addr -- d )  >r 0 0 r> tcell bounds
-     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP ;
-   : Sc!  ( n addr -- )  >r s>d r> tchar bounds swap 1-
-     DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
-   : Sc@  ( addr -- n )  >r 0 0 r> tchar bounds
-     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
+    : DS!  ( d addr -- )
+	tcell bounds swap 1-
+	DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
+    : DS@  ( addr -- d )
+	>r 0 0 r> tcell bounds
+	DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP ;
+    : Sc!  ( n addr -- )
+	>r s>d r> tchar bounds swap 1-
+	DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
+    : Sc@  ( addr -- n )
+	>r 0 0 r> tchar bounds
+	DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
 [ELSE]
-   : DS!  ( d addr -- )  tcell bounds
-     DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
-   : DS@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
-     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP ;
-   : Sc!  ( n addr -- )  >r s>d r> tchar bounds
-     DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
-   : Sc@  ( addr -- n )  >r 0 0 r> tchar bounds swap 1-
-     DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
+    : DS!  ( d addr -- )
+	tcell bounds
+	DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
+    : DS@  ( addr -- n )
+	>r 0 0 r> tcell bounds swap 1-
+	DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP ;
+    : Sc!  ( n addr -- )
+	>r s>d r> tchar bounds
+	DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
+    : Sc@  ( addr -- n )
+	>r 0 0 r> tchar bounds swap 1-
+	DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
 [THEN]
 
 : S! ( n addr -- ) >r s>d r> DS! ;
@@ -2010,8 +2018,7 @@ variable ResolveFlag
 
 \ ?touched                                             11may93jaw
 
-: ?touched ( ghost -- flag ) dup forward? swap >link @
-                               0 <> and ;
+: ?touched ( ghost -- flag ) dup forward? swap >link @ 0<> and ;
 
 : .forwarddefs ( ghost -- )
   ."  appeared in:"
@@ -2106,9 +2113,10 @@ $20 constant restrict-mask
 
 >TARGET
 X has? f83headerstring [IF]
-: name,  ( "name" -- )  bl word count ht-header, X cfalign ;
+    : name,  ( "name" -- )  bl word count ht-header, X cfalign ;
 [ELSE]
-    : name,  ( "name" -- )  bl word count
+    : name,  ( "name" -- )
+	bl word count
 	dup T cell+ cfoddalign H ht-nlstring, X cfalign ;
 [THEN]
 : view,   ( -- ) ( dummy ) ;
@@ -2906,7 +2914,8 @@ Cond: DOES>
   Ghost do:ghost!
   :noname postpone gdoes> ;
 
-: vtghost:  ( ghost -- )  Ghost >r
+: vtghost:  ( ghost -- )
+    Ghost >r
     :noname r> postpone Literal postpone addr, postpone ;
     built >do:ghost @ >exec2 ! ;
 
@@ -3007,7 +3016,8 @@ End-Struct vtable-struct
 	I @ ,
     cell +LOOP ;
 
-:noname ( -- )  vttemplate @ 0= IF EXIT THEN
+:noname ( -- )
+    vttemplate @ 0= IF EXIT THEN
     gvtable-list
     BEGIN  @ dup  WHILE
 	    dup vttemplate vt= IF

date.fs

@@ -4,8 +4,7 @@
 : /mod3 ( n1 n2 -- r q )
     dup >r /mod dup 4 = IF  drop r@ + 3  THEN  rdrop ;
 
-: day2dow ( day -- dow )
-    2 + 7 mod ;
+: day2dow ( day -- dow )  2 + 7 mod ;
 
 \ julian calendar
 
@@ -16,28 +15,30 @@
     >r 2 + dup 12 > IF  12 - swap 1+ swap  THEN
     r> 1+ ;
 
-: (ymd2day) ( y m d -- day year/4 )  1- -rot
+: (ymd2day) ( y m d -- day year/4 )
+    1- -rot
     2 - dup 0<= IF  12 + swap 1- swap  THEN
     153 5 */ 31 - swap
     4 /mod swap 365 * swap >r + + r> ;
 
-: j-ymd2day ( y m d -- day )  (ymd2day)
-    1461 * + ;
+: j-ymd2day ( y m d -- day )  (ymd2day) 1461 * + ;
 
 \ gregorian calendar
 
 1582 10 15 (ymd2day) 2Constant gregorian.
 1582 10 5 j-ymd2day Constant gregorian
 
-: day2ymd ( day -- y m d ) dup gregorian >= IF
+: day2ymd ( day -- y m d )
+    dup gregorian >= IF
 	1 - 146097 /mod 400 * swap
 	36524 /mod3 100 * rot + swap
 	j-day2ymd 2>r + 2r>
     ELSE
 	1 + j-day2ymd
     THEN ;
 
-: ymd2day ( y m d -- day )  (ymd2day)
+: ymd2day ( y m d -- day )
+    (ymd2day)
     2dup gregorian. d< 0= IF
 	25 /mod swap 1461 * swap
 	4 /mod swap 36524 * swap

debug.fs

@@ -48,7 +48,8 @@ get-current also see-voc definitions
 
 : .n ( n -- )    0 <# # # # # #S #> ctype bl cemit ;
 
-: d.s   ( .. -- .. )  ." [ " depth . ." ] "
+: d.s   ( .. -- .. )
+    ." [ " depth . ." ] "
     depth 4 min dup 0 ?DO dup i - pick .n LOOP drop ;
 
 : NoFine ( -- )

fft-bench.fs

@@ -9,7 +9,8 @@ require fft.fs
 : main setup fft rfft normalize ;
 
 Variable pass
-: test ( -- )  main pass on
+: test ( -- )
+    main pass on
     #points 0 ?DO
 	i values z@ fround f>s fround f>s
 	I $aa and I $55 and d<> IF i . i values z@ z. cr pass off THEN

fft.fs

@@ -25,28 +25,33 @@ require complex.fs
 Carray values
 Carray expix
 
-: r+ BEGIN 2dup xor -rot and dup WHILE 1 rshift REPEAT  drop ;
-: reverse  ( n -- )  2/ dup dup 2* 1
-  DO  dup I < IF  dup values I values 2dup z@ z@ z! z! THEN
-      over r+  LOOP  2drop ;
+: r+ ( x1 x2 -- x3 )
+    BEGIN 2dup xor -rot and dup WHILE 1 rshift REPEAT  drop ;
+: reverse  ( n -- )
+    2/ dup dup 2* 1
+    DO  dup I < IF  dup values I values 2dup z@ z@ z! z! THEN
+	over r+  LOOP  2drop ;
 
 \ reverse carry add                                    23sep05py
 8 Value #points
 : realloc ( n addr -- )
     dup @  IF  dup @ free throw  THEN  swap allocate throw swap ! ;
-: points  ( n --- )  dup to #points dup complex' dup
-  ['] values >body realloc  2/
-  ['] expix  >body realloc
-  dup 0 DO  0e 0e I values z!  LOOP
-  1e 0e 0 expix z! 2/ dup 2/ dup 2/ dup 1+ 1
-  ?DO  pi I I' 1- 2* 2* fm*/ fsincos fswap   I expix z!  LOOP
-  ?DO  I' I - 1- expix z@ fswap    I 1+ expix z!  LOOP  dup 2/
-  ?DO  I' I -    expix z@ fswap fnegate fswap
-                                    I    expix z!  LOOP ;
-: .values  ( -- )  precision  4 set-precision
-  #points 0 DO  I values z@ z. cr  LOOP  set-precision ;
-: .expix  ( -- )   precision  4 set-precision
-  #points 2/ 0 DO  I expix z@ z. cr  LOOP  set-precision ;
+: points  ( n --- )
+    dup to #points dup complex' dup
+    ['] values >body realloc  2/
+    ['] expix  >body realloc
+    dup 0 DO  0e 0e I values z!  LOOP
+    1e 0e 0 expix z! 2/ dup 2/ dup 2/ dup 1+ 1
+    ?DO  pi I I' 1- 2* 2* fm*/ fsincos fswap   I expix z!  LOOP
+    ?DO  I' I - 1- expix z@ fswap    I 1+ expix z!  LOOP  dup 2/
+    ?DO  I' I -    expix z@ fswap fnegate fswap
+	I    expix z!  LOOP ;
+: .values  ( -- )
+    precision  4 set-precision
+    #points 0 DO  I values z@ z. cr  LOOP  set-precision ;
+: .expix  ( -- )
+    precision  4 set-precision
+    #points 2/ 0 DO  I expix z@ z. cr  LOOP  set-precision ;
 ' .values ALIAS .rvalues
 
 \ FFT                                                  23sep05py
@@ -65,17 +70,19 @@ Carray expix
 
 \ FFT                                                  23sep05py
 
-: (fft ( n flag -- )  swap dup reverse 1
-  BEGIN  2dup >  WHILE  dup 2* swap fft-step
-  REPEAT  2drop drop ;
+: (fft ( n flag -- )
+    swap dup reverse 1
+    BEGIN  2dup >  WHILE  dup 2* swap fft-step
+    REPEAT  2drop drop ;
 
 : fftscale ( r -- )
-  #points 0 DO  I values dup z@ 2 fpick zscale z!  LOOP  fdrop ;
+    #points 0 DO  I values dup z@ 2 fpick zscale z!  LOOP  fdrop ;
 : normalize ( -- )  #points s>f 1/f  fftscale ;
 
 : fft  ( -- )  #points  true (fft ;
 : rfft ( -- )  #points false (fft ;
 
-: hamming ( -- )  #points 0 DO
+: hamming ( -- )
+    #points 0 DO
 	I values dup z@ pi I #points fm*/ fsin f**2 f2* zscale z!
     LOOP ;