Subversion Repositories scarts

; Generic Utilities.
; Copyright (C) 2000, 2005, 2006, 2007, 2009 Red Hat, Inc.
; This file is part of CGEN.
; See file COPYING.CGEN for details.
; These utilities are neither object nor cgen centric.
; They're generic, non application-specific utilities.
; There are a few exceptions, keep them to a minimum.
;
; Conventions:
; - the prefix "gen-" comes from cgen's convention that procs that return C
;   code, and only those procs, are prefixed with "gen-"
; Hobbit support code; for when not using hobbit.
; FIXME: eliminate this stuff ASAP.
; Value doesn't matter too much here, just ensure it's portable.
"assertion failure:"; Print to stderr, takes an arbitrary number of objects, possibly nested.
; ??? Audit callers, can we maybe just use "display" here (except that
; we still might want some control over the output).
;; ??? Incorrect for improper lists, later.
"("" "")""("" . "")"; Print a message if the verbosity level calls for it.
; This is a macro as a bit of cpu may be spent computing args,
; and we only want to spend it if the result will be printed.
; Return a string of N spaces.
; Write N spaces to PORT, or the current output port if elided.
; Concatenate all the arguments and make a string.  Symbols are
; converted to strings.
; Often used idiom.
; Collect a flat list of returned sublists from the lambda fn applied over args.
; Map over value entries in an alist.
; 'twould be nice if this were a primitive.
; Like map but accept a proper or improper list.
; An improper list is (a b c . d).
; FN must be a proc of one argument.
; Turn string or symbol STR into a proper C symbol.
; The result is a string.
; We assume STR has no leading digits.
; All invalid characters are turned into '_'.
; FIXME: Turn trailing "?" into "_p".
"gen-c-symbol: not symbol or string:"; Turn string or symbol STR into a proper file name, which is
; defined to be the same as gen-c-symbol except use -'s instead of _'s.
; The result is a string.
"gen-file-name: not symbol or string:"; Turn STR into lowercase.
; Turn STR into uppercase.
; Turn SYM into lowercase.
; Turn SYM into uppercase.
; Symbol sorter.
; Drop N chars from string S.
; If N is negative, drop chars from the end.
; It is ok to drop more characters than are in the string, the result is "".
""; Drop the leading char from string S (assumed to have at least 1 char).
; Return the leading N chars from string STR.
; This has APL semantics:
; N > length: FILLER chars are appended
; N < 0: take from the end of the string and prepend FILLER if necessary
""""; Return the leading char from string S (assumed to have at least 1 char).
; Return the index of char C in string S or #f if not found.
; Cut string S into a list of strings using delimiter DELIM (a character).
; Convert a list of elements to a string, inserting DELIM (a string)
; between elements.
; L can also be a string or a number.
"stringize: can't handle:"; Same as string-append, but accepts symbols too.
; PERF: This implementation may be unacceptably slow.  Revisit.
; Same as symbol-append, but accepts strings too.
; Given a symbol or a string, return the string form.
; Given a symbol or a string, return the symbol form.
; Output routines.
;; Given some state that has a setter function (SETTER NEW-VALUE) and
;; a getter function (GETTER), call THUNK with the state set to VALUE,
;; and restore the original value when THUNK returns.  Ensure that the
;; original value is restored whether THUNK returns normally, throws
;; an exception, or invokes a continuation that leaves the call's
;; dynamic scope.
;; Call THUNK with the current input and output ports set to PORT, and
;; then restore the current ports to their original values.
;; 
;; This ensures the current ports get restored whether THUNK exits
;; normally, throws an exception, or leaves the call's dynamic scope
;; by applying a continuation.
; Extension to the current-output-port.
; Only valid inside string-write.
; Create a print-state object.
; This is written in portable Scheme so we don't use COS objects, etc.
; print-state accessors.
; Special print commands (embedded in args).
;(define /endl (vector 'pstate '/endl)) ; ??? needed?
; Process a pstate command.
"\n""""""unknown pstate command"; Write STRINGS to current-output-port.
; STRINGS is a list of things to write.  Supported types are strings, symbols,
; lists, procedures.  Lists are printed by applying string-write recursively.
; Procedures are thunks that return the string to write.
;
; The result is the empty string.  This is for debugging where this
; procedure is modified to return its args, rather than write them out.
""; Subroutine of string-write and string-write-map.
; not write, we want raw text
"string-write: bad arg:"; Combination of string-map and string-write.
""; Build up an argument for string-write.
; Subroutine of string-list->string.  Does same thing -string-write does.
"string-list->string: bad arg:"; Flatten out a string list.
; Prefix CHARS, a string of characters, with backslash in STR.
; STR is either a string or list of strings (to any depth).
; ??? Quick-n-dirty implementation.
; quick check for any work to do
"""\\"""; must be a list
; Return a boolean indicating if S is bound to a value.
;(define old-symbol-bound? symbol-bound?)
;(define (symbol-bound? s) (old-symbol-bound? #f s))
; Return a boolean indicating if S is a symbol and is bound to a value.
;(module-bound? cgen-module s)
; Return X.
; Test whether X is a `form' (non-empty list).
; ??? Is `form' the right word to use here?
; One can argue we should also test for a valid car.  If so, it's the
; name that's wrong not the code (because the code is what I want).
; Return the number of arguments to ARG-SPEC, a valid argument list
; of `lambda'.
; The result is a pair: number of fixed arguments, varargs indicator (#f/#t).
; Return a boolean indicating if N args is ok to pass to a proc with
; an argument specification of ARG-SPEC (a valid argument list of `lambda').
; Ensure enough fixed arguments.
; If more args than fixed args, ensure varargs.
; Take N elements from list L.
; If N is negative, take elements from the end.
; If N is larger than the length, the extra elements are NIL.
; FIXME: incomplete
; FIXME: list-tail has args reversed (we should conform)
; Drop N elements from list L.
; FIXME: list-tail has args reversed (we should conform)
; Drop N elements from the end of L.
; FIXME: list-tail has args reversed (we should conform)
;; left fold
;; right fold
;; filter list on predicate
; APL's +\ operation on a vector of numbers.
; Remove duplicate elements from sorted list L.
; Currently supported elements are symbols (a b c) and lists ((a) (b) (c)).
; NOTE: Uses equal? for comparisons.
; Return a boolean indicating if each element of list satisfies its
; corresponding predicates.  The length of L must be equal to the length
; of PREDS.
; Remove duplicates from unsorted list L.
; KEY-GENERATOR is a lambda that takes a list element as input and returns
; an equal? key to use to determine duplicates.
; The first instance in a set of duplicates is always used.
; This is not intended to be applied to large lists with an expected large
; result (where sorting the list first would be faster), though one could
; add such support later.
;
; ??? Rename to follow memq/memv/member naming convention.
; Return a boolean indicating if list L1 is a subset of L2.
; Uses memq.
; Return intersection of two lists.
; Return union of two lists.
; Return a count of the number of elements of list L1 that are in list L2.
; Uses memq.
; Remove duplicate elements from sorted alist L.
; L must be sorted by name.
; Return a copy of alist L.
; (map cons (map car l) (map cdr l)) ; simple way
; presumably more efficient way (less cons cells created)
; Return the order in which to select elements of L sorted by SORT-FN.
; The result is origin 0.
; Return ALIST sorted on the name in ascending order.
; Return a boolean indicating if C is a leading id char.
; '@' is treated as an id-char as it's used to delimit something that
; sed will alter.
; Return a boolean indicating if C is an id char.
; '@' is treated as an id-char as it's used to delimit something that
; sed will alter.
; Return the length of the identifier that begins S.
; Identifiers are any of letter, digit, _, @.
; The first character must not be a digit.
; ??? The convention is to use "-" between cgen symbols, not "_".
; Try to handle "-" here as well.
; Return number of characters in STRING until DELIMITER.
; Returns #f if DELIMITER not present.
; FIXME: Doesn't yet support \-prefixed delimiter (doesn't terminate scan).
; Apply FN to each char of STR.
; Return a range.
; It must be distinguishable from a list of numbers.
; Move VALUE of LENGTH bits to position START in a word of SIZE bits.
; LSB0? is non-#f if bit numbering goes LSB->MSB.
; Otherwise it goes MSB->LSB.
; START-LSB? is non-#f if START denotes the least significant bit.
; Otherwise START denotes the most significant bit.
; N is assumed to fit in the field.
; Return a bit mask of LENGTH bits in a word of SIZE bits starting at START.
; LSB0? is non-#f if bit numbering goes LSB->MSB.
; Otherwise it goes MSB->LSB.
; START-LSB? is non-#f if START denotes the least significant bit.
; Otherwise START denotes the most significant bit.
; Extract LENGTH bits at bit number START in a word of SIZE bits from VALUE.
; LSB0? is non-#f if bit numbering goes LSB->MSB.
; Otherwise it goes MSB->LSB.
; START-LSB? is non-#f if START denotes the least significant bit.
; Otherwise START denotes the most significant bit.
;
; ??? bit-extract takes a big-number argument but still uses logand
; which doesn't so we don't use it
; Return a bit mask of size SIZE beginning at the LSB.
; Split VAL into pieces of bit size LENGTHS.
; e.g. (split-bits '(8 2) 997) -> (229 3)
; There are as many elements in the result as there are in LENGTHS.
; Note that this can result in a loss of information.
; Generalized version of split-bits.
; e.g. (split-value '(10 10 10) 1234) -> (4 3 2 1) ; ??? -> (1 2 3 4) ?
; (split-value '(10 10) 1234) -> (4 3)
; There are as many elements in the result as there are in BASES.
; Note that this can result in a loss of information.
; Convert bits to bytes.
; Convert bytes to bits.
; Return a list of integers.
; Usage:
; (.iota count)            ; start=0, incr=1
; (.iota count start)      ; incr=1
; (.iota count start incr)
"iota: wrong number of arguments:""iota: count must be non-negative:"; Return a list of the first N powers of 2.
; Another way: (map (lambda (n) (ash 1 n)) (iota n))
; I'm tired of writing (not (= foo bar)).
; Return #t if BIT-NUM (which is starting from LSB), is set in the binary
; representation of non-negative integer N.
; ??? Quick hack to work around missing bignum support.
;(= 1 (cg-logand (logslr n bit-num) 1))
; Return #t if each element of bools is #t.  Since Scheme considers any
; non-#f value as #t we do too.
; (all-true? '()) is #t since that is the identity element.
; Return #t if any element of BOOLS is #t.
; If BOOLS is empty, return #f.
; Return count of true values.
; Return count of all ones in BITS.
; Convert bits in N #f/#t.
; LENGTH is the length of N in bits.
; Print a C integer.
; ??? GCC complains if not affixed with "U" but that's not k&r.
;(string-append (number->string val) "U"))
"0x""Number too large for gen-integer:"; Return higher/lower part of double word integer.
; Logical operations.
; (logsll val shift) (ash val shift))
; logand, logior, logxor defined by guile so we don't need to
; (define (logand a b) ...)
; (define (logxor a b) ...)
; (define (logior a b) ...)
;
; On the other hand they didn't support bignums, so the cgen-binary
; defines cg-log* that does.  These are just a quick hack that only
; handle what currently needs handling.
; Return list of bit values for the 1's in X.
; Return bit representation of N in LEN bits.
; e.g. (bit-rep 6 3) -> (1 1 0)
; Return list of all bit values from 0 to N.
; e.g. (bit-patterns 3) -> ((0 0 0) (0 0 1) (0 1 0) ... (1 1 1))
; Compute the list of all indices from bits missing in MASK.
; e.g. (missing-bit-indices #xff00 #xffff) -> (0 1 2 3 ... 255)
; Return #t if n is a non-negative integer.
; Convert a list of numbers to a string, separated by SEP.
; The result is prefixed by SEP too.
; Convert a number to a hex string.
; Given a list of numbers NUMS, generate text to pass them as arguments to a
; C function.  We assume they're not the first argument and thus have a
; leading comma.
", "; Given a C expression or a list of C expressions, return a comma separated
; list of them.
; In the case of more than 0 elements the leading ", " is present so that
; there is no edge case in the case of 0 elements when the caller is appending
; the result to an initial set of arguments (the number of commas equals the
; number of elements).  The caller is responsible for dropping the leading
; ", " if necessary.  Note that `string-drop' can handle the case where more
; characters are dropped than are present.
""", """""", "; Return a list of N macro argument names.
"a"; Return C code for N macro argument names.
; (gen-macro-args 4) -> ", a1, a2, a3, a4"
; Return a string to reference an array.
; INDICES is either a (possibly empty) list of indices or a single index.
; The values can either be numbers or strings (/symbols).
"[""]"""; list of indices?
; Return list element N or #f if list L is too short.
; Return list of index numbers of elements in list L that satisfy PRED.
; I is usually 0.
; Return list of elements of L that satisfy PRED.
; Return first element of L that satisfies PRED or #f if there is none.
; Return list of FN applied to elements of L that satisfy PRED.
; Given a list L, look up element ELM and return its index.
; If not found, return #f.
; I is added to the result.
; (Yes, in one sense I is present to simplify the implementation.  Sue me.)
; Given an associative list L, look up entry for symbol S and return its index.
; If not found, return #f.
; Eg: (lookup 'element2 '((element1 1) (element2 2)))
; I is added to the result.
; (Yes, in one sense I is present to simplify the implementation.  Sue me.)
; NOTE: Uses eq? for comparisons.
; Return the index of element ELM in list L or #f if not found.
; If found, I is added to the result.
; (Yes, in one sense I is present to simplify the implementation.  Sue me.)
; NOTE: Uses equal? for comparisons.
; Return #t if ELM is in ELM-LIST.
; NOTE: Uses equal? for comparisons (via `member').
; Return the set of all possible combinations of elements in list L
; according to the following rules:
; - each element of L is either an atom (non-list) or a list
; - each list element is (recursively) interpreted as a set of choices
; - the result is a list of all possible combinations of elements
;
; Example: (list-expand '(a b (1 2 (3 4)) c (5 6)))
; --> ((a b 1 c d 5)
;      (a b 1 c d 6)
;      (a b 2 c d 5)
;      (a b 2 c d 6)
;      (a b 3 c d 5)
;      (a b 3 c d 6)
;      (a b 4 c d 5)
;      (a b 4 c d 6))
; ??? wip
; Given X, a number or symbol, reduce it to a constant if possible.
; Numbers always reduce to themselves.
; Symbols are reduced to a number if they're defined as such,
; or to an enum constant if one exists; otherwise X is returned unchanged.
; Requires: symbol-bound? enum-lookup-val
; A symbol bound to a number?
; An enum value that has a known numeric value?
; Otherwise return X unchanged.
; If OBJ has a dump method call it, otherwise return OBJ untouched.
; Copyright messages.
; Pair of header,trailer parts of copyright.
"\
THIS FILE IS MACHINE GENERATED WITH CGEN.
 
Copyright 1996-2009 Free Software Foundation, Inc.
""\
   This file is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3, or (at your option)
   any later version.
 
   It is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.
 
   You should have received a copy of the GNU General Public License along
   with this program; if not, write to the Free Software Foundation, Inc.,
   51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
"; Pair of header,trailer parts of copyright.
"\
THIS FILE IS MACHINE GENERATED WITH CGEN.
 
Copyright (C) 2000-2009 Red Hat, Inc.
""\
"; Set this to one of copyright-fsf, copyright-red-hat.
; Packages.
"\
This file is part of the GNU Binutils and/or GDB, the GNU debugger.
""\
This file is part of the GNU simulators.
""\
This file is part of the Red Hat simulators.
""\
This file is part of CGEN.
"; Return COPYRIGHT, with FILE-DESC as the first line
; and PACKAGE as the name of the package which the file belongs in.
; COPYRIGHT is a pair of (header . trailer).
"/* ""\n\n""\n""\n""\n*/\n\n"; File operations.
; Delete FILE, handling the case where it doesn't exist.
; This could also use file-exists?, but it's nice to have a few examples
; of how to use `catch' lying around.
; Create FILE, point current-output-port to it, and call WRITE-FN.
; FILE is always overwritten.
; GEN-FN either writes output to stdout or returns the text to write,
; the last thing we do is write the text returned by WRITE-FN to FILE.
"a"; Return the size in bytes of FILE.
; Time operations.
; Return the current time.
; The result is a black box understood only by time-elapsed.
; Return the elapsed time in milliseconds since START.
; Run PROC and return the number of milliseconds it took to execute it N times.
;; Debugging repls.
; Record of arguments passed to debug-repl, so they can be accessed in
; the repl loop.
; Return list of recorded variables for debugging.
; Return value of recorded var NAME.
; A handle on /dev/tty, so we can be sure we're talking with the user.
; We open this the first time we actually need it.
; Return the port we should use for interacting with the user,
; opening it if necessary.
"/dev/tty""r+"; Enter a repl loop for debugging purposes.
; Use (quit) to exit cgen completely.
; Use (debug-quit) or (quit 0) to exit the debugging session and
; resume argument processing.
;
; ENV-ALIST can be anything, but it is intended to be an alist of values
; the caller will want to be able to access in the repl loop.
; It is stored in global `debug-env'.
; indicate error to `make'
; Utility for debug-repl.
; Keep around for later debugging.
;(set! debug-env #f)
; Macro to simplify calling debug-repl.
; Usage: (debug-repl-env var-name1 var-name2 ...)
;
; This is for debugging cgen itself, and is inserted into code at the point
; where one wants to start a repl.