; CPU implementation description.
; Copyright (C) 2000 Red Hat, Inc.
; This file is part of CGEN.
; See file COPYING.CGEN for details.

; A model is an implementation of a mach.
; NOTE: wip [with all the caveats that implies].
; The intent here is to define the aspects of a CPU that affect performance,
; usable by any tool (but for the immediate future a simulator).

; Pipeline specification.

(define <pipeline>
  (class-make '<pipeline> nil '(name comment atlist elms) nil))

(define (pipeline:length p) (length (elm-xget p 'elms)))

; Function unit specification.

; FIXME: Might wish to record which pipeline element(s) the unit is associated
; with.  At the moment pipeline data isn't used, but later.

(define <unit>
  (class-make '<unit>
	      '(<ident>)
	      '(
		; wip
		issue done
		; Lists of (name mode) pairs that record unit state.
		state
		; Lists of (name mode [default-value]).
		inputs outputs
		; RTL of code to invoke to do profiling.
		; `nil' means use the default
		; ??? Not currently used since all profiling handlers
		; are user-written.
		profile
		; Model this unit is associated with.
		model-name
		)
	      nil))

; ??? Rather than create a circularity, we record the model's symbol in
; the `model' element.
; FIXME: Shouldn't use current-model-lookup.  Guile is better at printing
; things with circularities now, so should probably put back the circularity
; and delete the current-model-lookup reference.
(define (unit:model u) (current-model-lookup (elm-xget u 'model-name)))
(define unit:issue (elm-make-getter <unit> 'issue))
(define unit:done (elm-make-getter <unit> 'done))
(define unit:state (elm-make-getter <unit> 'state))
(define unit:inputs (elm-make-getter <unit> 'inputs))
(define unit:outputs (elm-make-getter <unit> 'outputs))
(define unit:profile (elm-make-getter <unit> 'profile))

; Create a copy of unit U with new values for ISSUE and DONE.
; This is used when recording an instruction's timing information.
; ??? This might be better recorded in a different class from UNIT
; since we're not creating a new unit, we're just special casing it for
; one instruction.
; FIXME: No longer used.

(define (unit:make-insn-timing u issue done)
  (let ((result (object-copy-top u)))
    (elm-xset! result 'issue issue)
    (elm-xset! result 'done done)
    result)
)

(define (unit:enum u)
  (gen-c-symbol (string-append "UNIT_"
			       (string-upcase (obj:name (unit:model u)))
			       "_"
			       (string-upcase (obj:name u))))
)

; The `<model>' class.
;
; FETCH is the instruction fetch process as it relates to the implementation.
; e.g.
; - how many instructions are fetched at once
; - how those instructions are initially processed for delivery to the
;   appropriate pipeline
; RETIRE is used to specify any final processing needed to complete an insn.
; PIPELINES is a list of pipeline objects.
; UNITS is a list of function units.
; STATE is a list of (var mode) pairs.
;
; For the more complicated cpus this can get really complicated really fast.
; No intent is made to get there in one day.

(define <model>
  (class-make '<model>
	      '(<ident>)
	      '(mach prefetch retire pipelines state units)
	      nil))

(define model:mach (elm-make-getter <model> 'mach))
(define model:prefetch (elm-make-getter <model> 'prefetch))
(define model:retire (elm-make-getter <model> 'retire))
(define model:pipelines (elm-make-getter <model> 'pipelines))
(define model:state (elm-make-getter <model> 'state))
(define model:units (elm-make-getter <model> 'units))

(define (model:enum m)
  (gen-c-symbol (string-append "MODEL_" (string-upcase (obj:name m))))
)

; Parse a `prefetch' spec.

(define (-prefetch-parse errtxt expr)
  nil
)

; Parse a `retire' spec.

(define (-retire-parse errtxt expr)
  nil
)

; Parse a `pipeline' spec.
; ??? Perhaps we should also use name/value pairs here, but that's an
; unnecessary complication at this point in time.

(define (-pipeline-parse errtxt model-name spec) ; name comments attrs elements)
  (if (not (= (length spec) 4))
      (parse-error errtxt "pipeline spec not `name comment attrs elements'" spec))
  (apply make (cons <pipeline> spec))
)

; Parse a function `unit' spec.
; ??? Perhaps we should also use name/value pairs here, but that's an
; unnecessary complication at this point in time.

(define (-unit-parse errtxt model-name spec) ; name comments attrs elements)
  (if (not (= (length spec) 9))
      (parse-error errtxt "unit spec not `name comment attrs issue done state inputs outputs profile'" spec))
  (apply make (append (cons <unit> spec) (list model-name)))
)

; Parse a model definition.
; This is the main routine for building a model object from a
; description in the .cpu file.
; All arguments are in raw (non-evaluated) form.

(define (-model-parse errtxt name comment attrs mach-name prefetch retire pipelines state units)
  (logit 2 "Processing model " name " ...\n")
  (let ((name (parse-name name errtxt))
	; FIXME: switch to `context' like in cver.
	(errtxt (string-append errtxt " " name))
	(mach (current-mach-lookup mach-name)))
    (if (null? units)
	(parse-error errtxt "there must be at least one function unit" name))
    (if mach ; is `mach' being "kept"?
	(let ((model-obj
	       (make <model>
		     name
		     (parse-comment comment errtxt)
		     (atlist-parse attrs "cpu" errtxt)
		     mach
		     (-prefetch-parse errtxt prefetch)
		     (-retire-parse errtxt retire)
		     (map (lambda (p) (-pipeline-parse errtxt name p)) pipelines)
		     state
		     (map (lambda (u) (-unit-parse errtxt name u)) units))))
	  model-obj)
	(begin
	  ; MACH wasn't found, ignore this model.
	  (logit 2 "Nonexistant mach " mach-name ", ignoring " name ".\n")
	  #f)))
)

; Read a model description.
; This is the main routine for analyzing models in the .cpu file.
; ERRTXT is prepended to error messages to provide context.
; ARG-LIST is an associative list of field name and field value.
; -model-parse is invoked to create the `model' object.

(define (-model-read errtxt . arg-list)
  (let (; Current mach elements:
	(name nil)      ; name of model
	(comment nil)   ; description of model
	(attrs nil)     ; attributes
	(mach nil)      ; mach this model implements
	(prefetch nil)  ; instruction prefetch handling
	(retire nil)    ; instruction completion handling
	(pipelines nil) ; list of pipelines
	(state nil)     ; list of (name mode) pairs to record state
	(units nil)     ; list of function units
	)
    (let loop ((arg-list arg-list))
      (if (null? arg-list)
	  nil
	  (let ((arg (car arg-list))
		(elm-name (caar arg-list)))
	    (case elm-name
	      ((name) (set! name (cadr arg)))
	      ((comment) (set! comment (cadr arg)))
	      ((attrs) (set! attrs (cdr arg)))
	      ((mach) (set! mach (cadr arg)))
	      ((prefetch) (set! prefetch (cadr arg)))
	      ((retire) (set! retire (cadr arg)))
	      ((pipeline) (set! pipelines (cons (cdr arg) pipelines)))
	      ((state) (set! state (cdr arg)))
	      ((unit) (set! units (cons (cdr arg) units)))
	      (else (parse-error errtxt "invalid model arg" arg)))
	    (loop (cdr arg-list)))))
    ; Now that we've identified the elements, build the object.
    (-model-parse errtxt name comment attrs mach prefetch retire pipelines state units)
    )
)

; Define a cpu model object, name/value pair list version.

(define define-model
  (lambda arg-list
    (let ((m (apply -model-read (cons "define-model" arg-list))))
      (if m
	  (current-model-add! m))
      m))
)

; Instruction timing.

; There is one of these for each model timing description per instruction.

(define <timing> (class-make '<timing> nil '(model units) nil))

(define timing:model (elm-make-getter <timing> 'model))
(define timing:units (elm-make-getter <timing> 'units))

; timing:units is a list of these.
; ARGS is a list of (name value) pairs.

(define <iunit> (class-make '<iunit> nil '(unit args) nil))

(define iunit:unit (elm-make-getter <iunit> 'unit))
(define iunit:args (elm-make-getter <iunit> 'args))

; Return the default unit used by MODEL.
; ??? For now this is always u-exec.

(define (model-default-unit model)
  (object-assq 'u-exec (model:units model))
)

; Subroutine of parse-insn-timing to parse the timing spec for MODEL.
; The result is a <timing> object.

(define (-insn-timing-parse-model context model spec)
  (make <timing> model
	(map (lambda (unit-timing-desc)
	       (let ((type (car unit-timing-desc))
		     (args (cdr unit-timing-desc)))
		 (case type
		   ((unit) ; syntax is `unit name (arg1 val1) ...'
		    (let ((unit (object-assq (car args)
					     (model:units model))))
		      (if (not unit)
			  (parse-error context "unknown function unit" args))
		      (make <iunit> unit (cdr args))))
		   (else (parse-error context "bad unit timing spec"
				      unit-timing-desc)))))
	     spec))
)

; Given the timing information for an instruction return an associative
; list of timing objects (one for each specified model).
; INSN-TIMING-DESC is a list of
; (model1 (unit unit1-name ...) ...) (model2 (unit unit1-name ...) ...) ...
; Entries for models not included (because the machine wasn't selected)
; are returned as (model1), i.e. an empty unit list.

(define (parse-insn-timing context insn-timing-desc)
  (map (lambda (model-timing-desc)
	 (let* ((model-name (car model-timing-desc))
		(model (current-model-lookup model-name)))
	   (cons model-name
		 (if model
		     (-insn-timing-parse-model context model
					       (cdr model-timing-desc))
		     ()))))
       insn-timing-desc)
)

; Called before a .cpu file is read in.

(define (model-init!)

  (reader-add-command! 'define-model
		       "\
Define a cpu model, name/value pair list version.
"
		       nil 'arg-list define-model
  )

  *UNSPECIFIED*
)

; Called after a .cpu file has been read in.

(define (model-finish!)
  *UNSPECIFIED*
)