duskos

commit c5c622ead3273e110a08353e5f2500c0aba379f5
parent 0f39b1c1051bda20bb00dc1806da7b7c116ebc9a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Wed, 26 Oct 2022 08:11:41 -0400

cc: turn debugging off by default

Diffstat:
M
fs/cc/ast.fs
 | 
2
+-
M
fs/cc/cc.fs
 | 
10
+++++-----
M
fs/cc/gen.fs
 | 
16
++++++++--------
M
fs/cc/vm/i386.fs
 | 
4
++--
M
fs/tests/cc/cc.fs
 | 
1
+

5 files changed, 17 insertions(+), 16 deletions(-)
diff --git a/fs/cc/ast.fs b/fs/cc/ast.fs
@@ -534,4 +534,4 @@ current to parseStatement
 : parseast ( -- )
   newparseunit
   begin ( unode ) nextt? ?dup while over swap parseUnit repeat drop
-  _debug if nl> ." used pad space for AST: " _pad :usedsz .x nl> then ;
+  _ccdebug if nl> ." used pad space for AST: " _pad :usedsz .x nl> then ;
diff --git a/fs/cc/cc.fs b/fs/cc/cc.fs
@@ -1,5 +1,5 @@
 \ C compiler
-1 value _debug
+0 value _ccdebug
 ?f<< /cc/vm/vm.fs
 ?f<< /cc/ttr.fs
 ?f<< /cc/gen.fs
@@ -11,14 +11,14 @@
 \ result to here. Aborts on error.
 : cc1, ( -- )
   cctypes$ ccast$
-  parseast _debug if curunit printast nl> then
-  curunit trnode _debug if curunit printast nl> then
+  parseast _ccdebug if curunit printast nl> then
+  curunit trnode _ccdebug if curunit printast nl> then
   curunit gennode ;
 
 : :c
   newparseunit nextt parseUnit
   curunit Node firstchild ?dup if
-    _debug if dup printast nl> then
-    dup trnode _debug if dup printast nl> then gennode then ;
+    _ccdebug if dup printast nl> then
+    dup trnode _ccdebug if dup printast nl> then gennode then ;
 
 : cc<< ( -- ) ['] cc1, word with-stdin-file ;
diff --git a/fs/cc/gen.fs b/fs/cc/gen.fs
@@ -147,7 +147,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
   then ;
 'w genchildren ( Unit )
 :w ( Function )
-  _debug if ." debugging: " dup Function name stype nl> then
+  _ccdebug if ." debugging: " dup Function name stype nl> then
   ops$
   dup Function flags 1 and not if \ not static
     sysdict over Function name entry then ( fnode )
@@ -158,7 +158,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
   \ emit implicit vmret, if needed
   dup Function :stmts Node :lastchild
   dup if Node id AST_RETURN = then not if vmret, then ( fnode )
-  _debug if Function address here over - spit nl> else drop then ;
+  _ccdebug if Function address here over - spit nl> else drop then ;
 :w ( Return ) genchildren vmret, ;
 :w ( Constant ) Constant value const>op ;
 :w ( Statements )
@@ -167,7 +167,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
     ?dup while dup gennode$ Node nextsibling repeat ( snode ) ;
 'w drop ( ArgSpecs )
 :w ( Ident )
-  _debug if ." ident: " dup printast nl> then
+  _ccdebug if ." ident: " dup printast nl> then
   dup Ident :finddecl ?dup if ( inode dnode-or-fnode )
     nip dup Node id AST_FUNCTION = if
       \ Sometimes, we get a Function as dnode. In these cases, it's a global
@@ -176,18 +176,18 @@ ASTIDCNT wordtbl gentbl ( node -- )
     else Declare ctype ctype>op then
   else ( inode )
     Ident name sysdict @ find ?dup _assert TYPE_VOID to vmop type const>op then
-  _debug if .ops then ;
+  _ccdebug if .ops then ;
 :w ( UnaryOp )
-  _debug if ." unaryop: " dup printast nl> then
+  _ccdebug if ." unaryop: " dup printast nl> then
   dup genchildren
   Op opid uopgentbl swap wexec
-  _debug if .ops then ;
+  _ccdebug if .ops then ;
 :w ( PostfixOp )
   dup genchildren
   Op opid popgentbl swap wexec ;
 \ See "Binary op resolution strategy" in opening comment
 :w ( BinaryOp )
-  _debug if ." binop: " dup printast nl> .ops then
+  _ccdebug if ." binop: " dup printast nl> .ops then
   dup >r \ V1=node
   Node firstchild dup Node nextsibling swap ( n2 n1 )
   over needs2ops? if \ n2 == 2ops
@@ -259,7 +259,7 @@ ASTIDCNT wordtbl gentbl ( node -- )
   Node nextsibling ( loop' node ) dup _assert gennode \ control
   vmjnz, ops$ r> resolvebreaks ;
 :w ( Arrow )
-  _debug if ." arrow: " dup printast nl> then
+  _ccdebug if ." arrow: " dup printast nl> then
   dup Node firstchild dup _assert gennode Arrow name ( fieldname )
   vmop type dup ctype? _assert dup type*lvl 1 = _assert ( name type )
   ctype' dup CType :struct? _assert ( name ctype )
diff --git a/fs/cc/vm/i386.fs b/fs/cc/vm/i386.fs
@@ -17,10 +17,10 @@ $cb const USABLEREGS \ 11001011 = di si bx cx ax
 : regallot ( -- regid )
   8 >r 0 begin ( regid )
     dup regusable? if dup regused? not if ( regid )
-      rdrop regused over bit1! to regused ( regid ) ." allot " dup . nl> exit then then
+      rdrop regused over bit1! to regused ( regid ) exit then then
     1+ next ( regid ) \ all used
   abort" TODO: support deeper expressions" ;
-: regfree ( regid -- ) ." free " dup . nl>
+: regfree ( regid -- )
   regused over bit? not if abort" register allocation imbalance" then
   regused swap bit0! to regused ;
 : pushregs
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -1,5 +1,6 @@
 ?f<< tests/harness.fs
 ?f<< cc/cc.fs
+1 to _ccdebug
 testbegin
 \ Tests for the C compiler
 cc<< tests/cc/test.c