Diff for /gforth/Attic/kernel.fs between versions 1.1 and 1.3

version 1.1, 1996/09/19 22:17:34 version 1.3, 1996/09/24 19:15:03
Line 51  HEX Line 51  HEX
 \ labels for some code addresses  \ labels for some code addresses
   
 : docon: ( -- addr )    \ gforth  : docon: ( -- addr )    \ gforth
     \ the code address of a @code{CONSTANT}      \G the code address of a @code{CONSTANT}
     ['] bl >code-address ;      ['] bl >code-address ;
   
 : docol: ( -- addr )    \ gforth  : docol: ( -- addr )    \ gforth
     \ the code address of a colon definition      \G the code address of a colon definition
     ['] docon: >code-address ;      ['] docon: >code-address ;
   
 : dovar: ( -- addr )    \ gforth  : dovar: ( -- addr )    \ gforth
     \ the code address of a @code{CREATE}d word      \G the code address of a @code{CREATE}d word
     ['] udp >code-address ;      ['] udp >code-address ;
   
 : douser: ( -- addr )   \ gforth  : douser: ( -- addr )   \ gforth
     \ the code address of a @code{USER} variable      \G the code address of a @code{USER} variable
     ['] s0 >code-address ;      ['] s0 >code-address ;
   
 : dodefer: ( -- addr )  \ gforth  : dodefer: ( -- addr )  \ gforth
     \ the code address of a @code{defer}ed word      \G the code address of a @code{defer}ed word
     ['] source >code-address ;      ['] source >code-address ;
   
 : dofield: ( -- addr )  \ gforth  : dofield: ( -- addr )  \ gforth
     \ the code address of a @code{field}      \G the code address of a @code{field}
     ['] reveal-method >code-address ;      ['] reveal-method >code-address ;
   
 NIL AConstant NIL \ gforth  NIL AConstant NIL \ gforth
Line 280  Defer source ( -- addr count ) \ core Line 280  Defer source ( -- addr count ) \ core
 : POSTPONE ( -- ) \ core  : POSTPONE ( -- ) \ core
     COMP' swap POSTPONE aliteral compile, ; immediate restrict      COMP' swap POSTPONE aliteral compile, ; immediate restrict
   
 : interpret/compile: ( interp-xt comp-xt "name" -- )  : interpret/compile: ( interp-xt comp-xt "name" -- ) \ gforth
     Create immediate swap A, A,      Create immediate swap A, A,
 DOES>  DOES>
     abort" executed primary cfa of an interpret/compile: word" ;      abort" executed primary cfa of an interpret/compile: word" ;
Line 325  DOES> Line 325  DOES>
 \ number? number                                       23feb93py  \ number? number                                       23feb93py
   
 Create bases   10 ,   2 ,   A , 100 ,  Create bases   10 ,   2 ,   A , 100 ,
 \              16     2    10   Zeichen  \              16     2    10   character
 \ !! this saving and restoring base is an abomination! - anton  \ !! this saving and restoring base is an abomination! - anton
 : getbase ( addr u -- addr' u' )  : getbase ( addr u -- addr' u' )
     over c@ [char] $ - dup 4 u<      over c@ [char] $ - dup 4 u<
Line 464  hex Line 464  hex
  laddr# [ 0 , ] ;   laddr# [ 0 , ] ;
   
 : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception  : catch ( x1 .. xn xt -- y1 .. ym 0 / z1 .. zn error ) \ exception
   >r sp@ r> swap >r       \ don't count xt! jaw      sp@ >r
   fp@ >r      fp@ >r
   lp@ >r      lp@ >r
   handler @ >r      handler @ >r
   rp@ handler !      rp@ handler !
   execute      execute
   r> handler ! rdrop rdrop rdrop 0 ;      r> handler ! rdrop rdrop rdrop 0 ;
   
 : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception  : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
     ?DUP IF      ?DUP IF
         [ here 9 cells ! ]          [ here 9 cells ! ] \ entry point for signal handler
         handler @ rp!          handler @ dup 0= IF
               2 (bye)
           THEN
           rp!
         r> handler !          r> handler !
         r> lp!          r> lp!
         r> fp!          r> fp!
         r> swap >r sp! r>          r> swap >r sp! drop r>
     THEN ;      THEN ;
   
 \ Bouncing is very fine,  \ Bouncing is very fine,
Line 487  hex Line 490  hex
 : bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) \ gforth  : bounce ( y1 .. ym error/0 -- y1 .. ym error / y1 .. ym ) \ gforth
 \ a throw without data or fp stack restauration  \ a throw without data or fp stack restauration
   ?DUP IF    ?DUP IF
     handler @ rp!        handler @ rp!
     r> handler !        r> handler !
     r> lp!        r> lp!
     rdrop        rdrop
     rdrop        rdrop
   THEN ;    THEN ;
   
 \ ?stack                                               23feb93py  \ ?stack                                               23feb93py
Line 570  Defer interpreter-notfound ( c-addr coun Line 573  Defer interpreter-notfound ( c-addr coun
 : ] ( -- ) \ core       right-bracket  : ] ( -- ) \ core       right-bracket
     ['] compiler     IS parser state on  ;      ['] compiler     IS parser state on  ;
   
 \ locals stuff needed for control structures  
   
 : compile-lp+! ( n -- ) \ gforth        compile-l-p-plus-store  
     dup negate locals-size +!  
     0 over = if  
     else -1 cells  over = if postpone lp-  
     else  1 floats over = if postpone lp+  
     else  2 floats over = if postpone lp+2  
     else postpone lp+!# dup ,  
     then then then then drop ;  
   
 : adjust-locals-size ( n -- ) \ gforth  
     \ sets locals-size to n and generates an appropriate lp+!  
     locals-size @ swap - compile-lp+! ;  
   
   
 here 0 , \ just a dummy, the real value of locals-list is patched into it in glocals.fs  here 0 , \ just a dummy, the real value of locals-list is patched into it in glocals.fs
 AConstant locals-list \ acts like a variable that contains  AConstant locals-list \ acts like a variable that contains
                       \ a linear list of locals names                        \ a linear list of locals names
Line 609  variable backedge-locals Line 596  variable backedge-locals
     dup orig?      dup orig?
     2 pick backedge-locals ! ; immediate      2 pick backedge-locals ! ; immediate
           
 \ locals list operations  
   
 : common-list ( list1 list2 -- list3 ) \ gforth-internal  
 \ list1 and list2 are lists, where the heads are at higher addresses than  
 \ the tail. list3 is the largest sublist of both lists.  
  begin  
    2dup u<>  
  while  
    2dup u>  
    if  
      swap  
    then  
    @  
  repeat  
  drop ;  
   
 : sub-list? ( list1 list2 -- f ) \ gforth-internal  
 \ true iff list1 is a sublist of list2  
  begin  
    2dup u<  
  while  
    @  
  repeat  
  = ;  
   
 : list-size ( list -- u ) \ gforth-internal  
 \ size of the locals frame represented by list  
  0 ( list n )  
  begin  
    over 0<>  
  while  
    over  
    ((name>)) >body @ max  
    swap @ swap ( get next )  
  repeat  
  faligned nip ;  
   
 : set-locals-size-list ( list -- )  
  dup locals-list !  
  list-size locals-size ! ;  
   
 : check-begin ( list -- )  
 \ warn if list is not a sublist of locals-list  
  locals-list @ sub-list? 0= if  
    \ !! print current position  
    ." compiler was overly optimistic about locals at a BEGIN" cr  
    \ !! print assumption and reality  
  then ;  
   
 \ Control Flow Stack  \ Control Flow Stack
 \ orig, etc. have the following structure:  \ orig, etc. have the following structure:
 \ type ( defstart, live-orig, dead-orig, dest, do-dest, scopestart) ( TOS )  \ type ( defstart, live-orig, dead-orig, dest, do-dest, scopestart) ( TOS )
Line 741  variable backedge-locals Line 679  variable backedge-locals
  POSTPONE ?branch >mark ; immediate restrict   POSTPONE ?branch >mark ; immediate restrict
   
 : ?DUP-IF ( compilation -- orig ; run-time n -- n| ) \ gforth   question-dupe-if  : ?DUP-IF ( compilation -- orig ; run-time n -- n| ) \ gforth   question-dupe-if
 \ This is the preferred alternative to the idiom "?DUP IF", since it can be  \G This is the preferred alternative to the idiom "?DUP IF", since it can be
 \ better handled by tools like stack checkers. Besides, it's faster.  \G better handled by tools like stack checkers. Besides, it's faster.
     POSTPONE ?dup-?branch >mark ;       immediate restrict      POSTPONE ?dup-?branch >mark ;       immediate restrict
   
 : ?DUP-0=-IF ( compilation -- orig ; run-time n -- n| ) \ gforth        question-dupe-zero-equals-if  : ?DUP-0=-IF ( compilation -- orig ; run-time n -- n| ) \ gforth        question-dupe-zero-equals-if
     POSTPONE ?dup-0=-?branch >mark ;       immediate restrict      POSTPONE ?dup-0=-?branch >mark ;       immediate restrict
   
 : then-like ( orig -- addr )  Defer then-like ( orig -- addr )
     swap -rot dead-orig =  : cs>addr ( orig/dest -- addr )  drop nip ;
     if  ' cs>addr IS then-like
         drop  
     else  
         dead-code @  
         if  
             set-locals-size-list dead-code off  
         else \ both live  
             dup list-size adjust-locals-size  
             locals-list @ common-list dup list-size adjust-locals-size  
             locals-list !  
         then  
     then ;  
   
 : THEN ( compilation orig -- ; run-time -- ) \ core  : THEN ( compilation orig -- ; run-time -- ) \ core
     dup orig?  then-like  >resolve ; immediate restrict      dup orig?  then-like  >resolve ; immediate restrict
Line 777  immediate restrict Line 704  immediate restrict
     1 cs-roll      1 cs-roll
     POSTPONE then ; immediate restrict      POSTPONE then ; immediate restrict
   
   Defer begin-like ( -- )
   ' noop IS begin-like
   
 : BEGIN ( compilation -- dest ; run-time -- ) \ core  : BEGIN ( compilation -- dest ; run-time -- ) \ core
     dead-code @ if      begin-like cs-push-part dest ; immediate restrict
         \ set up an assumption of the locals visible here.  if the  
         \ users want something to be visible, they have to declare  
         \ that using ASSUME-LIVE  
         backedge-locals @ set-locals-size-list  
     then  
     cs-push-part dest  
     dead-code off ; immediate restrict  
   
 \ AGAIN (the current control flow joins another, earlier one):  Defer again-like ( dest -- addr )
 \ If the dest-locals-list is not a subset of the current locals-list,  ' nip IS again-like
 \ issue a warning (see below). The following code is generated:  
 \ lp+!# (current-local-size - dest-locals-size)  
 \ branch <begin>  
   
 : again-like ( dest -- addr )  
     over list-size adjust-locals-size  
     swap check-begin  POSTPONE unreachable ;  
   
 : AGAIN ( compilation dest -- ; run-time -- ) \ core-ext  : AGAIN ( compilation dest -- ; run-time -- ) \ core-ext
     dest? again-like  POSTPONE branch  <resolve ; immediate restrict      dest? again-like  POSTPONE branch  <resolve ; immediate restrict
   
 \ UNTIL (the current control flow may join an earlier one or continue):  Defer until-like
 \ Similar to AGAIN. The new locals-list and locals-size are the current  : until, ( list addr xt1 xt2 -- )  drop compile, <resolve drop ;
 \ ones. The following code is generated:  ' until, IS until-like
 \ ?branch-lp+!# <begin> (current-local-size - dest-locals-size)  
 : until-like ( list addr xt1 xt2 -- )  
     \ list and addr are a fragment of a cs-item  
     \ xt1 is the conditional branch without lp adjustment, xt2 is with  
     >r >r  
     locals-size @ 2 pick list-size - dup if ( list dest-addr adjustment )  
         r> drop r> compile,  
         swap <resolve ( list adjustment ) ,  
     else ( list dest-addr adjustment )  
         drop  
         r> compile, <resolve  
         r> drop  
     then ( list )  
     check-begin ;  
   
 : UNTIL ( compilation dest -- ; run-time f -- ) \ core  : UNTIL ( compilation dest -- ; run-time f -- ) \ core
     dest? ['] ?branch ['] ?branch-lp+!# until-like ; immediate restrict      dest? ['] ?branch ['] ?branch-lp+!# until-like ; immediate restrict
Line 830  immediate restrict Line 731  immediate restrict
     POSTPONE again      POSTPONE again
     POSTPONE then ; immediate restrict      POSTPONE then ; immediate restrict
   
   
 \ counted loops  \ counted loops
   
 \ leave poses a little problem here  \ leave poses a little problem here
Line 947  Avariable leave-sp  leave-stack 3 cells Line 847  Avariable leave-sp  leave-stack 3 cells
   
 \ Structural Conditionals                              12dec92py  \ Structural Conditionals                              12dec92py
   
   Defer exit-like ( -- )
   ' noop IS exit-like
   
 : EXIT ( compilation -- ; run-time nest-sys -- ) \ core  : EXIT ( compilation -- ; run-time nest-sys -- ) \ core
     0 adjust-locals-size      exit-like
     POSTPONE ;s      POSTPONE ;s
     POSTPONE unreachable ; immediate restrict      POSTPONE unreachable ; immediate restrict
   
Line 1011  Avariable leave-sp  leave-stack 3 cells Line 914  Avariable leave-sp  leave-stack 3 cells
     \ aborts if the last defined word was headerless      \ aborts if the last defined word was headerless
     last @ dup 0= abort" last word was headerless" cell+ ;      last @ dup 0= abort" last word was headerless" cell+ ;
   
 : immediate     immediate-mask lastflags cset ;  : immediate ( -- ) \ core
 : restrict      restrict-mask lastflags cset ;      immediate-mask lastflags cset ;
   : restrict ( -- ) \ gforth
       restrict-mask lastflags cset ;
   ' restrict alias compile-only ( -- ) \ gforth
   
 \ Header                                               23feb93py  \ Header                                               23feb93py
   
Line 1025  defer header ( -- ) \ gforth Line 931  defer header ( -- ) \ gforth
 ' (header) IS header  ' (header) IS header
   
 : string, ( c-addr u -- ) \ gforth  : string, ( c-addr u -- ) \ gforth
     \ puts down string as cstring      \G puts down string as cstring
     dup c, here swap chars dup allot move ;      dup c, here swap chars dup allot move ;
   
 : header, ( c-addr u -- ) \ gforth  : header, ( c-addr u -- ) \ gforth
Line 1039  defer header ( -- ) \ gforth Line 945  defer header ( -- ) \ gforth
 : input-stream-header ( "name" -- )  : input-stream-header ( "name" -- )
     name name-too-short? header, ;      name name-too-short? header, ;
 : input-stream ( -- )  \ general  : input-stream ( -- )  \ general
 \ switches back to getting the name from the input stream ;      \G switches back to getting the name from the input stream ;
     ['] input-stream-header IS (header) ;      ['] input-stream-header IS (header) ;
   
 ' input-stream-header IS (header)  ' input-stream-header IS (header)
Line 1121  Create ???  0 , 3 c, char ? c, char ? c, Line 1027  Create ???  0 , 3 c, char ? c, char ? c,
   
 : (Constant)  Header reveal docon: cfa, ;  : (Constant)  Header reveal docon: cfa, ;
 : Constant ( w "name" -- ) \ core  : Constant ( w "name" -- ) \ core
       \G Defines constant @var{name}
       \G  
       \G @var{name} execution: @var{-- w}
     (Constant) , ;      (Constant) , ;
 : AConstant ( addr "name" -- ) \ gforth  : AConstant ( addr "name" -- ) \ gforth
     (Constant) A, ;      (Constant) A, ;
Line 1229  end-struct interpret/compile-struct Line 1138  end-struct interpret/compile-struct
     (name>x) (x>int) ;      (name>x) (x>int) ;
   
 : name?int ( nfa -- xt ) \ gforth  : name?int ( nfa -- xt ) \ gforth
     \ like name>int, but throws an error if compile-only      \G like name>int, but throws an error if compile-only
     (name>x) restrict-mask and      (name>x) restrict-mask and
     if      if
         compile-only-error \ does not return          compile-only-error \ does not return
Line 1237  end-struct interpret/compile-struct Line 1146  end-struct interpret/compile-struct
     (cfa>int) ;      (cfa>int) ;
   
 : name>comp ( nfa -- w xt ) \ gforth  : name>comp ( nfa -- w xt ) \ gforth
     \ get compilation semantics of name      \G get compilation semantics of name
     (name>x) >r dup interpret/compile?      (name>x) >r dup interpret/compile?
     if      if
         interpret/compile-comp @          interpret/compile-comp @
Line 1310  Variable warnings ( -- addr ) \ gforth Line 1219  Variable warnings ( -- addr ) \ gforth
 G -1 warnings T !  G -1 warnings T !
   
 : check-shadow  ( addr count wid -- )  : check-shadow  ( addr count wid -- )
 \ prints a warning if the string is already present in the wordlist  \G prints a warning if the string is already present in the wordlist
  >r 2dup 2dup r> (search-wordlist) warnings @ and ?dup if   >r 2dup 2dup r> (search-wordlist) warnings @ and ?dup if
    ." redefined " name>string 2dup type     ." redefined " name>string 2dup type
    compare 0<> if     compare 0<> if
Line 1423  Defer key ( -- c ) \ core Line 1332  Defer key ( -- c ) \ core
   swap #tib ! 0 >in ! ;    swap #tib ! 0 >in ! ;
   
 : Query  ( -- ) \ core-ext  : Query  ( -- ) \ core-ext
     \ obsolescent      \G obsolescent
     loadfile off  blk off  refill drop ;      loadfile off  blk off  refill drop ;
   
 \ File specifiers                                       11jun93jaw  \ File specifiers                                       11jun93jaw
Line 1502  create pathfilenamebuf 256 chars allot \ Line 1411  create pathfilenamebuf 256 chars allot \
 \   THEN ;  \   THEN ;
   
 : absolut-path? ( addr u -- flag ) \ gforth  : absolut-path? ( addr u -- flag ) \ gforth
     \ a path is absolute, if it starts with a / or a ~ (~ expansion),      \G a path is absolute, if it starts with a / or a ~ (~ expansion),
     \ or if it is in the form ./* or ../*, extended regexp: [/~]|./|../      \G or if it is in the form ./* or ../*, extended regexp: ^[/~]|./|../
     \ Pathes simply containing a / are not absolute!      \G Pathes simply containing a / are not absolute!
     over c@ '/ = >r      over c@ '/ = >r
     over c@ '~ = >r      over c@ '~ = >r
     2dup 2 min S" ./" compare 0= >r      2dup 2 min S" ./" compare 0= >r
Line 1513  create pathfilenamebuf 256 chars allot \ Line 1422  create pathfilenamebuf 256 chars allot \
 \   [char] / scan nip 0<> ;      \   [char] / scan nip 0<> ;    
   
 : open-path-file ( c-addr1 u1 -- file-id c-addr2 u2 ) \ gforth  : open-path-file ( c-addr1 u1 -- file-id c-addr2 u2 ) \ gforth
     \ opens a file for reading, searching in the path for it (unless      \G opens a file for reading, searching in the path for it (unless
     \ the filename contains a slash); c-addr2 u2 is the full filename      \G the filename contains a slash); c-addr2 u2 is the full filename
     \ (valid until the next call); if the file is not found (or in      \G (valid until the next call); if the file is not found (or in
     \ case of other errors for each try), -38 (non-existant file) is      \G case of other errors for each try), -38 (non-existant file) is
     \ thrown. Opening for other access modes makes little sense, as      \G thrown. Opening for other access modes makes little sense, as
     \ the path will usually contain dirs that are only readable for      \G the path will usually contain dirs that are only readable for
     \ the user      \G the user
     \ !! use file-status to determine access mode?      \ !! use file-status to determine access mode?
     2dup absolut-path?      2dup absolut-path?
     if \ the filename contains a slash      if \ the filename contains a slash
Line 1550  create image-included-files  1 , A, ( po Line 1459  create image-included-files  1 , A, ( po
 \ points to ALLOTed objects, so it survives a save-system  \ points to ALLOTed objects, so it survives a save-system
   
 : loadfilename ( -- a-addr )  : loadfilename ( -- a-addr )
     \ a-addr 2@ produces the current file name ( c-addr u )      \G a-addr 2@ produces the current file name ( c-addr u )
     included-files 2@ drop loadfilename# @ 2* cells + ;      included-files 2@ drop loadfilename# @ 2* cells + ;
   
 : sourcefilename ( -- c-addr u ) \ gforth  : sourcefilename ( -- c-addr u ) \ gforth
     \ the name of the source file which is currently the input      \G the name of the source file which is currently the input
     \ source.  The result is valid only while the file is being      \G source.  The result is valid only while the file is being
     \ loaded.  If the current input source is no (stream) file, the      \G loaded.  If the current input source is no (stream) file, the
     \ result is undefined.      \G result is undefined.
     loadfilename 2@ ;      loadfilename 2@ ;
   
 : sourceline# ( -- u ) \ gforth         sourceline-number  : sourceline# ( -- u ) \ gforth         sourceline-number
     \ the line number of the line that is currently being interpreted      \G the line number of the line that is currently being interpreted
     \ from a (stream) file. The first line has the number 1. If the      \G from a (stream) file. The first line has the number 1. If the
     \ current input source is no (stream) file, the result is      \G current input source is no (stream) file, the result is
     \ undefined.      \G undefined.
     loadline @ ;      loadline @ ;
   
 : init-included-files ( -- )  : init-included-files ( -- )
Line 1572  create image-included-files  1 , A, ( po Line 1481  create image-included-files  1 , A, ( po
     image-included-files 2@ nip included-files 2! ;      image-included-files 2@ nip included-files 2! ;
   
 : included? ( c-addr u -- f ) \ gforth  : included? ( c-addr u -- f ) \ gforth
     \ true, iff filename c-addr u is in included-files      \G true, iff filename c-addr u is in included-files
     included-files 2@ 0      included-files 2@ 0
     ?do ( c-addr u addr )      ?do ( c-addr u addr )
         dup >r 2@ 2over compare 0=          dup >r 2@ 2over compare 0=
Line 1585  create image-included-files  1 , A, ( po Line 1494  create image-included-files  1 , A, ( po
     2drop drop false ;      2drop drop false ;
   
 : add-included-file ( c-addr u -- ) \ gforth  : add-included-file ( c-addr u -- ) \ gforth
     \ add name c-addr u to included-files      \G add name c-addr u to included-files
     included-files 2@ 2* cells 2 cells extend-mem      included-files 2@ 2* cells 2 cells extend-mem
     2/ cell / included-files 2!      2/ cell / included-files 2!
     2! ;      2! ;
Line 1594  create image-included-files  1 , A, ( po Line 1503  create image-included-files  1 , A, ( po
 \    2* cells + 2! ;  \    2* cells + 2! ;
   
 : included1 ( i*x file-id c-addr u -- j*x ) \ gforth  : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
     \ include the file file-id with the name given by c-addr u      \G include the file file-id with the name given by c-addr u
     loadfilename# @ >r      loadfilename# @ >r
     save-mem add-included-file ( file-id )      save-mem add-included-file ( file-id )
     included-files 2@ nip 1- loadfilename# !      included-files 2@ nip 1- loadfilename# !
Line 1606  create image-included-files  1 , A, ( po Line 1515  create image-included-files  1 , A, ( po
     open-path-file included1 ;      open-path-file included1 ;
   
 : required ( i*x addr u -- j*x ) \ gforth  : required ( i*x addr u -- j*x ) \ gforth
     \ include the file with the name given by addr u, if it is not      \G include the file with the name given by addr u, if it is not
     \ included already. Currently this works by comparing the name of      \G included already. Currently this works by comparing the name of
     \ the file (with path) against the names of earlier included      \G the file (with path) against the names of earlier included
     \ files; however, it would probably be better to fstat the file,      \G files; however, it would probably be better to fstat the file,
     \ and compare the device and inode. The advantages would be: no      \G and compare the device and inode. The advantages would be: no
     \ problems with several paths to the same file (e.g., due to      \G problems with several paths to the same file (e.g., due to
     \ links) and we would catch files included with include-file and      \G links) and we would catch files included with include-file and
     \ write a require-file.      \G write a require-file.
     open-path-file 2dup included?      open-path-file 2dup included?
     if      if
         2drop close-file throw          2drop close-file throw

Removed from v.1.1  
changed lines
  Added in v.1.3


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>