aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer connman)
  #:use-module (gnu installer utils)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:export (<technology>
            technology
            technology?
            technology-name
            technology-type
            technology-powered?
            technology-connected?

            <service>
            service
            service?
            service-name
            service-type
            service-path
            service-strength
            service-state

            &connman-error
            connman-error?
            connman-error-command
            connman-error-output
            connman-error-status

            &connman-connection-error
            connman-connection-error?
            connman-connection-error-service
            connman-connection-error-output

            &connman-password-error
            connman-password-error?

            &connman-already-connected-error
            connman-already-connected-error?

            connman-state
            connman-technologies
            connman-enable-technology
            connman-disable-technology
            connman-scan-technology
            connman-services
            connman-connect
            connman-disconnect
            connman-online?
            connman-connect-with-auth))

;;; Commentary:
;;;
;;; This module provides procedures for talking with the connman daemon.
;;; The best approach would have been using connman dbus interface.
;;; However, as Guile dbus bindings are not available yet, the console client
;;; "connmanctl" is used to talk with the daemon.
;;;


;;;
;;; Technology record.
;;;

;; The <technology> record encapsulates the "Technology" object of connman.
;; Technology type will be typically "ethernet", "wifi" or "bluetooth".

(define-record-type* <technology>
  technology make-technology
  technology?
  (name            technology-name) ; string
  (type            technology-type) ; string
  (powered?        technology-powered?) ; boolean
  (connected?      technology-connected?)) ; boolean


;;;
;;; Service record.
;;;

;; The <service> record encapsulates the "Service" object of connman.
;; Service type is the same as the technology it is associated to, path is a
;; unique identifier given by connman, strength describes the signal quality
;; if applicable. Finally, state is "idle", "failure", "association",
;; "configuration", "ready", "disconnect" or "online".

(define-record-type* <service>
  service make-service
  service?
  (name            service-name) ; string or #f
  (type            service-type) ; string
  (path            service-path) ; string
  (strength        service-strength) ; integer
  (state           service-state)) ; string


;;;
;;; Condition types.
;;;

(define-condition-type &connman-error &error
  connman-error?
  (command connman-error-command)
  (output connman-error-output)
  (status connman-error-status))

(define-condition-type &connman-connection-error &error
  connman-connection-error?
  (service connman-connection-error-service)
  (output  connman-connection-error-output))

(define-condition-type &connman-password-error &connman-connection-error
  connman-password-error?)

(define-condition-type &connman-already-connected-error
  &connman-connection-error connman-already-connected-error?)


;;;
;;; Procedures.
;;;

(define (connman-run command env arguments)
  "Run the given COMMAND, with the specified ENV and ARGUMENTS.  The error
output is discarded and &connman-error condition is raised if the command
returns a non zero exit code."
  (let* ((command `("env" ,env ,command ,@arguments "2>" "/dev/null"))
         (command-string (string-join command " "))
         (pipe (open-input-pipe command-string))
         (output (read-lines pipe))
         (ret (close-pipe pipe)))
    (case (status:exit-val ret)
      ((0) output)
      (else (raise (condition (&connman-error
                               (command command)
                               (output output)
                               (status ret))))))))

(define (connman . arguments)
  "Run connmanctl with the specified ARGUMENTS. Set the LANG environment
variable to C because the command output will be parsed and we don't want it
to be translated."
  (connman-run "connmanctl" "LANG=C" arguments))

(define (parse-keys keys)
  "Parse the given list of strings KEYS, under the following format:

     '((\"KEY = VALUE\") (\"KEY2 = VALUE2\") ...)

Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2)
...)  elements."
  (let ((key-regex (make-regexp "([^ ]+) = ([^$]+)")))
    (map (lambda (key)
           (let ((match-key (regexp-exec key-regex key)))
             (cons (match:substring match-key 1)
                   (match:substring match-key 2))))
         keys)))

(define (connman-state)
  "Return the state of connman. The nominal states are 'offline, 'idle,
'ready, 'oneline.  If an unexpected state is read, 'unknown is
returned. Finally, an error is raised if the connman output could not be
parsed, usually because the connman daemon is not responding."
  (let* ((output (connman "state"))
         (state-keys (parse-keys output)))
    (let ((state (assoc-ref state-keys "State")))
      (if state
          (cond ((string=? state "offline") 'offline)
                ((string=? state "idle") 'idle)
                ((string=? state "ready") 'ready)
                ((string=? state "online") 'online)
                (else 'unknown))
          (raise (condition
                  (&message
                   (message "Could not determine the state of connman."))))))))

(define (split-technology-list technologies)
  "Parse the given strings list TECHNOLOGIES, under the following format:

	'((\"/net/connman/technology/xxx\")
          (\"KEY = VALUE\")
          ...
          (\"/net/connman/technology/yyy\")
          (\"KEY2 = VALUE2\")
          ...)
 Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...))
list so that each keys of a given technology are gathered in a separate list."
  (let loop ((result '())
             (cur-list '())
             (input (reverse technologies)))
    (if (null? input)
        result
        (let ((item (car input)))
          (if (string-match "/net/connman/technology" item)
              (loop (cons cur-list result) '() (cdr input))
              (loop result (cons item cur-list) (cdr input)))))))

(define (string->boolean string)
  (equal? string "True"))

(define (connman-technologies)
  "Return a list of available <technology> records."

  (define (technology-output->technology output)
    (let ((keys (parse-keys output)))
      (technology
       (name (assoc-ref keys "Name"))
       (type (assoc-ref keys "Type"))
       (powered? (string->boolean (assoc-ref keys "Powered")))
       (connected? (string->boolean (assoc-ref keys "Connected"))))))

  (let* ((output (connman "technologies"))
         (technologies (split-technology-list output)))
    (map technology-output->technology technologies)))

(define (connman-enable-technology technology)
  "Enable the given TECHNOLOGY."
  (let ((type (technology-type technology)))
    (connman "enable" type)))

(define (connman-disable-technology technology)
  "Disable the given TECHNOLOGY."
  (let ((type (technology-type technology)))
    (connman "disable" type)))

(define (connman-scan-technology technology)
  "Run a scan for the given TECHNOLOGY."
  (let ((type (technology-type technology)))
    (connman "scan" type)))

(define (connman-services)
  "Return a list of available <services> records."

  (define (service-output->service path output)
    (let* ((service-keys
            (match output
              ((_ . rest) rest)))
           (keys (parse-keys service-keys)))
      (service
       (name (assoc-ref keys "Name"))
       (type (assoc-ref keys "Type"))
       (path path)
       (strength (and=> (assoc-ref keys "Strength") string->number))
       (state (assoc-ref keys "State")))))

  (let* ((out (connman "services"))
         (out-filtered (delete "" out))
         (services-path (map (lambda (service)
                               (match (string-split service #\ )
                                 ((_ ... path) path)))
                             out-filtered))
         (services-output (map (lambda (service)
                                 (connman "services" service))
                               services-path)))
    (map service-output->service services-path services-output)))

(define (connman-connect service)
  "Connect to the given SERVICE."
  (let ((path (service-path service)))
    (connman "connect" path)))

(define (connman-disconnect service)
  "Disconnect from the given SERVICE."
  (let ((path (service-path service)))
    (connman "disconnect" path)))

(define (connman-online?)
  (let ((state (connman-state)))
    (memq state '(ready online))))

(define (connman-connect-with-auth service password-proc)
  "Connect to the given SERVICE with the password returned by calling
PASSWORD-PROC. This is only possible in the interactive mode of connmanctl
because authentication is done by communicating with an agent.

As the open-pipe procedure of Guile do not allow to read from stderr, we have
to merge stdout and stderr using bash redirection. Then error messages are
extracted from connmanctl output using a regexp. This makes the whole
procedure even more unreliable.

Raise &connman-connection-error if an error occurred during connection. Raise
&connman-password-error if the given password is incorrect."

  (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n"))

  (define (match-connman-error str)
    (let ((match-error (regexp-exec connman-error-regexp str)))
      (and match-error (match:substring match-error 1))))

  (define* (read-regexps-or-error port regexps error-handler)
    "Read characters from port until an error is detected, or one of the given
REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error
string as argument. Raise an error if the eof is reached before one of the
regexps is matched."
    (let loop ((res ""))
      (let ((char (read-char port)))
        (cond
         ((eof-object? char)
          (raise (condition
                  (&message
                   (message "Unable to find expected regexp.")))))
         ((match-connman-error res)
          =>
          (lambda (match)
            (error-handler match)))
         ((or-map (lambda (regexp)
                    (and (regexp-exec regexp res) regexp))
                  regexps)
          =>
          (lambda (match)
            match))
         (else
          (loop (string-append res (string char))))))))

  (define* (read-regexp-or-error port regexp error-handler)
    "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP."
    (read-regexps-or-error port (list regexp) error-handler))

  (define (connman-error->condition path error)
    (cond
     ((string-match "Already connected" error)
      (condition (&connman-already-connected-error
                  (service path)
                  (output error))))
     (else
      (condition (&connman-connection-error
                  (service path)
                  (output error))))))

  (define (run-connection-sequence pipe)
    "Run the connection sequence using PIPE as an opened port to an
interactive connmanctl process."
    (let* ((path (service-path service))
           (error-handler (lambda (error)
                            (raise
                             (connman-error->condition path error)))))
      ;; Start the agent.
      (format pipe "agent on\n")
      (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler)

      ;; Let's try to connect to the service. If the service does not require
      ;; a password, the connection might succeed right after this call.
      ;; Otherwise, connmanctl will prompt us for a password.
      (format pipe "connect ~a\n" path)
      (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path)))
             (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*"))
             (regexps (list connected-regexp passphrase-regexp))
             (result (read-regexps-or-error pipe regexps error-handler)))

        ;; A password is required.
        (when (eq? result passphrase-regexp)
          (format pipe "~a~%" (password-proc))

          ;; Now, we have to wait for the connection to succeed. If an error
          ;; occurs, it is most likely because the password is incorrect.
          ;; In that case, we escape from an eventual retry loop that would
          ;; add complexity to this procedure, and raise a
          ;; &connman-password-error condition.
          (read-regexp-or-error pipe connected-regexp
                                (lambda (error)
                                  ;; Escape from retry loop.
                                  (format pipe "no\n")
                                  (raise
                                   (condition (&connman-password-error
                                               (service path)
                                               (output error))))))))))

  ;; XXX: Find a better way to read stderr, like with the "subprocess"
  ;; procedure of racket that return input ports piped on the process stdin and
  ;; stderr.
  (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH)))
    (dynamic-wind
      (const #t)
      (lambda ()
        (setvbuf pipe 'line)
        (run-connection-sequence pipe)
        #t)
      (lambda ()
        (format pipe "quit\n")
        (close-pipe pipe)))))
href='#n448'>448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581
`default_nettype none

module stack_machine_new
  (
   /* Those 2 are supposed to be common for both wishbone interfaces */
   input wire 	     CLK_I,
   input wire 	     RST_I,

   /* Instruction reading interface */
   input wire 	     I_ACK_I,
   output reg [19:0] I_ADR_O,
   input wire [15:0] I_DAT_I,
   output reg [15:0] I_DAT_O, /* Not used, interface read-only */
   output reg 	     I_STB_O,
   output reg 	     I_CYC_O,
   output reg 	     I_WE_O, /* Always 0, interface read-only */
   input wire 	     I_STALL_I,

   /* Data interface */
   input wire 	     D_ACK_I,
   input wire 	     D_ERR_I, /* We'll start using it soon */
   output reg [20:0] D_ADR_O,
   input wire [31:0] D_DAT_I,
   output reg [31:0] D_DAT_O,
   output reg [3:0]  D_SEL_O, /* We'll start using it soon */
   output reg 	     D_STB_O,
   output reg 	     D_CYC_O,
   output reg 	     D_WE_O,
   input wire 	     D_STALL_I,

   /* non-wishbone */
   output wire 	     finished
   );

   /* TODO: get back to the good old habit of using wires for all ports */
   always @* begin
      if (CLK_I || !CLK_I) begin /* avoiding "found no sensitivities" warning */
	 I_DAT_O = 16'bx;
	 I_WE_O = 1'b0;

	 D_SEL_O = 4'hF; /* This one is temporary */
      end
   end

   reg [20:0] 	      pc;
   reg [20:0] 	      sp;

   always @* begin /* pc and sp should always be word-aligned */
      if (CLK_I || !CLK_I) begin
	 pc[0] = 0;
	 sp[0] = 0;
      end
   end
`define SET_PC(address) if (1) begin pc[20:1] <= (address) / 2; end else
`define SET_SP(address) if (1) begin sp[20:1] <= (address) / 2; end else

   reg [31:0] 	      r0;
   reg [31:0] 	      r1;
   reg [31:0] 	      im;

   reg 		      im_initialized;

   parameter STEP_LOADING_INSTRUCTION = 1'b0;
   parameter STEP_EXECUTING = 1'b1;
   reg  	      step;
   reg 		      first_execution_tick;

   reg [15:0] 	      instruction;

   /* Results of instruction parsing */

   /*
    * This flag informs us, that this is the special instruction used solely
    * for setting im (it uses 15-bit payload instead of 7-bit one)
    */
   wire 	      set_im;
   assign set_im = instruction[15];

   /*
    * This flag informs us whether instruction uses immediate (all instructions
    * that use it must contain a 7-bit payload)
    */
   wire 	      use_im;
   assign use_im = instruction[14] && !set_im;

   /* Payloads for both kinds of instructions, that modify im */
   wire [6:0] 	      short_payload;
   assign short_payload = instruction[6:0];

   wire [14:0] 	      long_payload;
   assign long_payload = instruction[14:0];

   /* Sign-extending payload when setting im */
   wire 	      payload_msb;
   assign payload_msb = set_im ? long_payload[14] : short_payload[6];

   wire [31:0] 	      sign_extended_payload;
   assign sign_extended_payload = set_im ? {{17{payload_msb}}, long_payload} :
				  use_im ? {{25{payload_msb}}, short_payload} :
				  32'bx;

   /* Shifting payload into im that was already partially initialized */
   wire [31:0] 	      im_shifted_payload;
   assign im_shifted_payload = set_im ? {im[16:0], long_payload} :
			       use_im ? {im[24:0], short_payload} :
			       32'bx;

   /*
    * If im has already been partially initialized, we'll just shift our
    * payload into it. Otherwise, we sign-extend our payload and put it in im.
    */
   wire [31:0] 	      im_effective;
   assign im_effective = im_initialized ?
			 im_shifted_payload :
			 sign_extended_payload;

   /* Upon instruction stack can grow, shrink or remain the same size */
   wire 	      stack_shrinks;
   assign stack_shrinks = instruction[13] == 1'b1 && !set_im;

   wire 	      stack_shrinks_by_1;
   assign stack_shrinks_by_1 = stack_shrinks && instruction[12] == 1'b1;

   wire 	      stack_shrinks_by_2;
   assign stack_shrinks_by_2 = stack_shrinks && instruction[12] == 1'b0;

   wire 	      stack_grows;
   assign stack_grows = instruction[13:12] == 2'b01 && !set_im;

   wire 	      stack_same_size;
   assign stack_same_size = instruction[13:12] == 2'b00 || set_im;

   /* If instruction[11:10] == 2'b11, we have some load or store */
   wire 	      store;
   assign store = stack_shrinks && use_im && instruction[11:10] == 2'b11;

   wire 	      load;
   assign load = (stack_grows || stack_same_size) && use_im &&
		 instruction[11:10] == 2'b11;

   /*
    * Loads and stores can use either im or r1+im (r0+im) as address. Obviously,
    * a variant of load/store that uses r1 (r0), consumes one more operand.
    */
   wire 	      addressing_with_operand;
   assign addressing_with_operand = (load && stack_same_size) ||
				    (store && stack_shrinks_by_2);

   wire [20:0] 	      address_operand;
   assign address_operand = load ? r1[20:0] : r0[20:0];

   wire [20:0] 	      addr_to_use;
   assign addr_to_use = addressing_with_operand ?
			im_effective + address_operand : im_effective;

   /*
    * Those tell us, how many bytes are load'ed or store'd. We might also later
    * use those flags with instructions (e.g. type promotion).
    */
   wire 	      byte_operation;
   wire 	      word_operation;
   wire 	      dword_operation;
   wire 	      qword_operation; /* We won't implement these in hw */

   assign byte_operation  = instruction[9:8] == 2'b00;
   assign word_operation  = instruction[9:8] == 2'b01;
   assign dword_operation = instruction[9:8] == 2'b10;
   assign qword_operation = instruction[9:8] == 2'b11;

   /* Flag mainly meant for load instructions, but not exclusively */
   wire 	      sign_extend;
   assign sign_extend = instruction[7];

   /* Instructions other than load and store go here */

   /* Instructions, that do not change stack size */
   wire 	      instr_halt;
   assign instr_halt = !set_im && !use_im && stack_same_size &&
		       instruction[11:0] == 12'd0;

   wire 	      instr_nop;
   assign instr_nop = !set_im && !use_im && stack_same_size &&
		      instruction[11:0] == 12'd1;

   wire 	      instr_swap;
   assign instr_swap = !set_im && !use_im && stack_same_size &&
		      instruction[11:0] == 12'd2;

   wire 	      instr_set_sp;
   assign instr_set_sp = use_im && stack_same_size &&
			 instruction[11:7] == 5'd0;

   wire 	      instr_jump;
   assign instr_jump = use_im && stack_same_size &&
		       instruction[11:7] == 5'd1;

   /* Instructions, that grow stack */
   wire 	      instr_tee;
   assign instr_tee = !set_im && !use_im && stack_grows &&
		      instruction[11:0] == 12'd0;

   wire 	      instr_const;
   assign instr_const = use_im && stack_grows &&
			instruction[11:7] == 5'd0;

   /* Instructions, that shrink stack */
   wire 	      instr_add;
   assign instr_add = !set_im && !use_im && stack_shrinks_by_1 &&
		      instruction[11:0] == 12'd0;

   wire 	      instr_sub;
   assign instr_sub = !set_im && !use_im && stack_shrinks_by_1 &&
		      instruction[11:0] == 12'd1;

   wire 	      instr_udiv;
   assign instr_udiv = !set_im && !use_im && stack_shrinks_by_1 &&
		       instruction[11:0] == 12'd2;

   wire 	      instr_mul;
   assign instr_mul = !set_im && !use_im && stack_shrinks_by_1 &&
		      instruction[11:0] == 12'd3;

   wire 	      instr_cond_jump;
   assign instr_cond_jump = use_im && stack_shrinks_by_1 &&
			    instruction[11:7] == 5'd1;


   reg 		      halt; /* Set once a halt instruction is encountered */
   assign finished = halt;


   /* module for division */
   wire [31:0] 	      div_quotient;
   wire [31:0] 	      div_remainder;
   wire 	      div_done;

   div
     #(
       .WIDTH(32)
       ) div
   (
    .clock(CLK_I),
    .start(step == STEP_EXECUTING && first_execution_tick),
    .dividend(r0),
    .divisor(r1),

    .quotient(div_quotient),
    .remainder(div_remainder),
    .done(div_done)
    );


   reg 		      arithmetic_uncompleted;
   wire 	      arithmetic_completes;
   assign arithmetic_completes = instr_udiv ? div_done :
				 instr_halt ? 0 :
				 1;


   always @*
     I_ADR_O = pc / 2;

   reg 		      instruction_requested;

   reg [31:0] 	      stack_put_value;

   reg 		      load_store_unrequested;
   reg [1:0] 	      stack_transfer_unrequested;

   wire 	      data_request_happens;
   wire [1:0] 	      stack_transfer_request_happens;
   assign data_request_happens = D_STB_O && !D_STALL_I;
   assign stack_transfer_request_happens[0] = !load_store_unrequested &&
					      data_request_happens;
   assign stack_transfer_request_happens[1] = !load_store_unrequested &&
					      !stack_transfer_unrequested[0] &&
					      data_request_happens;

   reg 		      load_store_uncompleted;
   reg [1:0] 	      stack_transfer_uncompleted;

   wire 	      data_command_completes;
   wire [1:0] 	      stack_transfer_completes;
   assign data_command_completes = D_ACK_I && D_CYC_O;
   assign stack_transfer_completes[0] = !load_store_uncompleted &&
					data_command_completes;
   assign stack_transfer_completes[1] = !load_store_uncompleted &&
					!stack_transfer_uncompleted[0] &&
					data_command_completes;

   always @ (posedge CLK_I) begin
      if (RST_I) begin
	 `SET_PC(0);
	 `SET_SP(21'h0FFFFF);

	 I_STB_O <= 0;
	 I_CYC_O <= 0;

	 step <= STEP_LOADING_INSTRUCTION;
	 instruction_requested <= 0;

	 stack_put_value <= 31'bx;

	 D_ADR_O <= 21'bx;
	 D_DAT_O <= 32'bx;
	 D_SEL_O <= 4'bx;
	 D_STB_O <= 0;
	 D_CYC_O <= 0;
	 D_WE_O <= 0;

	 halt <= 0;
      end else begin // if (RST_I)
	 case (step)
	   STEP_LOADING_INSTRUCTION : begin
	      instruction <= I_DAT_I;

	      if (I_STB_O && !I_STALL_I)
		instruction_requested <= 1;

	      I_STB_O <= !instruction_requested && !(I_STB_O && !I_STALL_I);
	      I_CYC_O <= 1;

	      if (I_CYC_O && I_ACK_I) begin
		 instruction_requested <= 0;

		 `SET_PC(pc + 2);

		 step <= STEP_EXECUTING;
		 I_CYC_O <= 0;
	      end

	      arithmetic_uncompleted <= 1;

	      first_execution_tick <= 1;
	      load_store_unrequested <= 0;
	      stack_transfer_unrequested <= 2'b0;
 	      load_store_uncompleted <= 0;
	      stack_transfer_uncompleted <= 2'b0;
	   end // case: STEP_LOADING_INSTRUCTION
	   STEP_EXECUTING : begin
	      first_execution_tick <= 0;

	      if (arithmetic_completes)
		arithmetic_uncompleted <= 0;

	      if (((stack_grows || stack_shrinks || load || store) &&
		   first_execution_tick) ||
		  (load_store_uncompleted &&
		   !data_command_completes) ||
		  (stack_transfer_uncompleted[1] &&
		   !stack_transfer_completes[1]) ||
		  (arithmetic_uncompleted &&
		   !arithmetic_completes)) begin
		 step <= STEP_EXECUTING; /* Remain where we are */
	      end else begin
		 step <= STEP_LOADING_INSTRUCTION;

		 I_STB_O <= 1;
		 I_CYC_O <= 1;

		 D_CYC_O <= 0;
		 D_STB_O <= 0;
		 D_WE_O <= 0;
	      end

	      if (first_execution_tick) begin
		 if (load || store) begin
		    load_store_unrequested <= 1;
		    load_store_uncompleted <= 1;
		 end

		 if (stack_shrinks_by_2) begin
		    stack_transfer_unrequested <= 2'b11;
		    stack_transfer_uncompleted <= 2'b11;
		 end else if (stack_grows || stack_shrinks) begin
		    stack_transfer_unrequested <= 2'b10;
		    stack_transfer_uncompleted <= 2'b10;
		 end
	      end

	      if (first_execution_tick) begin
		 if (load) begin
		    D_ADR_O <= addr_to_use;
		    D_DAT_O <= 32'bx;
		    /* D_SEL_O <= ????; */ /* We'll later set this one */
		    D_STB_O <= 1;
		    D_CYC_O <= 1;
		    D_WE_O <= 0;
		 end else if (store) begin
		    D_ADR_O <= addr_to_use;
		    D_DAT_O <= r1;
		    /* D_SEL_O <= ????; */ /* We'll later set this one */
		    D_STB_O <= 1;
		    D_CYC_O <= 1;
		    D_WE_O <= 1;
		 end else if (stack_shrinks) begin
		    `SET_SP(sp + 4);
		    D_ADR_O <= sp;
		    D_DAT_O <= 32'bx;
		    /* D_SEL_O <= 4'hF; */
		    D_STB_O <= 1;
		    D_CYC_O <= 1;
		    D_WE_O <= 0;
		 end else if (stack_grows) begin
		    `SET_SP(sp - 4);
		    D_ADR_O <= sp - 4;
		    D_DAT_O <= r0;
		    /* D_SEL_O <= 4'hF; */
		    D_STB_O <= 1;
		    D_CYC_O <= 1;
		    D_WE_O <= 1;
		 end

		 /*
		  * If we want to offload value to memory because of stack
		  * growth, we may need to wait for load or store to complete
		  * first. In such case we need to back up the stack value.
		  */
		 stack_put_value <= r0;
	      end // if (first_execution_tick)

	      if (data_request_happens) begin
		 if (load_store_unrequested) begin
		    load_store_unrequested <= 0;
		 end else begin
		    stack_transfer_unrequested
		      <= {stack_transfer_unrequested[0], 1'b0};
		 end

		 if (load_store_unrequested ||
		     stack_transfer_unrequested[0]) begin
		    if (stack_shrinks) begin
		       `SET_SP(sp + 4);
		       D_ADR_O <= sp;
		       D_DAT_O <= 32'bx;
		       /* D_SEL_O <= 4'hF; */
		       D_STB_O <= 1;
		       D_WE_O <= 0;
		    end else if (stack_grows) begin
		       `SET_SP(sp - 4);
		       D_ADR_O <= sp - 4;
		       D_DAT_O <= stack_put_value;
		       /* D_SEL_O <= 4'hF; */
		       D_STB_O <= 1;
		       D_WE_O <= 1;
		    end
		 end else begin // if (load_store_unrequested ||...
		    D_ADR_O <= 21'bx;
		    D_DAT_O <= 32'bx;
		    /* D_SEL_O <= 4'bx; */
		    D_STB_O <= 0;
		    D_WE_O <= 0;
		 end // else: !if(load_store_unrequested ||...
	      end // if (data_request_happens)

	      if (data_command_completes) begin
		 if (load_store_uncompleted) begin
		    load_store_uncompleted <= 0;
		 end else begin
		    stack_transfer_uncompleted
		      <= {stack_transfer_uncompleted[0], 1'b0};
		 end

		 if (!(load_store_uncompleted ||
		       stack_transfer_uncompleted[0]))
		   D_CYC_O <= 0;
	      end

	      if (stack_shrinks && stack_transfer_completes)
		r0 <= D_DAT_I;

	      if (store)
		r1 <= r0;

	      if (stack_grows && first_execution_tick)
		r0 <= r1;

	      if (load && load_store_uncompleted)
		r1 <= D_DAT_I;

	      if (!first_execution_tick && use_im)
		im <= 32'bx;

	      im_initialized <= set_im;

	      if (set_im || use_im)
		im <= im_effective;
	      else
		im <= 32'bx;

	      /* Instructions, that do not change stack size */
	      if (instr_halt)
		halt <= 1;

	      if (instr_nop)
		r1 <= r1;

	      if (instr_swap)
		{r0, r1} <= {r1, r0};

	      if (instr_set_sp)
		`SET_SP(im_effective);

	      if (instr_jump)
		`SET_PC(im_effective);

	      /* Instructions, that grow stack */
	      if (instr_tee)
		r1 <= r1;

	      if (instr_const && first_execution_tick)
		r1 <= im_effective;

	      /* Instructions, that shrink stack */
	      if (instr_add && arithmetic_uncompleted)
		r1 <= r0 + r1;

	      if (instr_sub && arithmetic_uncompleted)
		r1 <= r0 - r1;

	      if (instr_udiv && arithmetic_uncompleted)
		r1 <= div_quotient;

	      if (instr_mul && arithmetic_uncompleted)
		r1 <= r0 * r1;

	      if (instr_cond_jump && arithmetic_uncompleted) begin
		 r1 <= r0;

		 if (r1)
		   `SET_PC(im_effective);
	      end
	   end // case: STEP_EXECUTING
	 endcase // case (step)
      end // else: !if(RST_I)
   end // always @ (posedge CLK_I)

`ifdef SIMULATION
   /*
    * RST should still be used when powering up, even in benches;
    * this is just to avoid undefined values
    */
   initial begin
      I_ADR_O <= 0;
      I_STB_O <= 0;
      I_CYC_O <= 0;

      D_ADR_O <= 0;
      D_DAT_O <= 0;
      D_STB_O <= 0;
      D_CYC_O <= 0;
      D_WE_O <= 0;

      `SET_PC(0);
      `SET_SP(0);

      r0 <= 0;
      r1 <= 0;
      im <= 0;

      im_initialized <= 0;

      step <= 0;
      first_execution_tick <= 0;

      instruction <= 0;

      halt <= 0;

      instruction_requested <= 0;

      stack_put_value <= 0;

      load_store_unrequested <= 0;
      stack_transfer_unrequested <= 2'b0;

      load_store_uncompleted <= 0;
      stack_transfer_uncompleted <= 2'b0;
   end // initial begin
`endif
endmodule // stack_machine_new