;;;; 	Copyright (C) 1995 Free Software Foundation, Inc.
;;;; 
;;;; This program 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 2, or (at your option)
;;;; any later version.
;;;; 
;;;; This program 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 software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;; 


;;; Various handy test cases for the bytecode engine and 
;;; macro assembler.
;;;




(load "Inx.scm")




(begin
  (define ret-23-code `((load 23)
			(ireturn)))
  (define ret-23-bytes (string->symbol (li-assemble ret-23-code #f #f)))
  (define ret-23 (intern-bytecode (make-vector 1 #f) 'ret-23 '#{()i}# 10 10 ret-23-bytes))
  (or (eq? 23 (ret-23))
      (error 'ret-23-failed)))



(begin
  (define int-id-code `((load (ilocal 0))
			(ireturn)))
  (define int-id-bytes (string->symbol (li-assemble int-id-code #f #f)))
  (define int-id (intern-bytecode (make-vector 1 #f) 'int-id '#{(i)i}# 10 10 int-id-bytes))
  (or (and (eq? 100 (int-id 100))
	   (eq? 99 (int-id 99)))
      (error 'int-id-failed)))



(begin
  (define fib-code
    '(
      (decl x   	(ilocal 0))
      (decl tn-2	(ilocal 1))
      (decl tn-1	(ilocal 2))
      (decl tn		(ilocal 3))

      (iinc	x -2)

      (load 	1)
      (store 	tn-2)

      (load 	1)
      (store 	tn-1)

      fib_loop

      (load	0)
      (load	x)
      (if_icmpge break)
      
      (load	tn-2)
      (load	tn-1)
      (iadd)
      (store	tn)

      (load	tn-1)
      (store	tn-2)

      (load	tn)
      (store	tn-1)

      (iinc	x -1)
      (goto 	fib_loop)

      break
      (load	tn-1)
      (ireturn)))

  (define fib-bytes (string->symbol (li-assemble fib-code #f #f)))
  (define fib (intern-bytecode (make-vector 1 #f) 'fib '#{(i)i}# 10 10 fib-bytes)))
  




(begin
  (define fib-loop-code
    '(
      (decl x   	(ilocal 0))
      (decl loop-count	(ilocal 1))
      (decl tn-2	(ilocal 2))
      (decl tn-1	(ilocal 3))
      (decl tn		(ilocal 4))
      (decl saved-x	(ilocal 5))

      (load	x)
      (store	saved-x)
      (iinc	saved-x -2)


      main-loop
      (load	0)
      (load	loop-count)
      (if_icmpge break)
      (iinc	loop-count -1)

      (load 	1)
      (store 	tn-2)

      (load 	1)
      (store 	tn-1)

      (load	saved-x)
      (store	x)

      fib-loop_loop

      (load	0)
      (load	x)
      (if_icmpge main-loop)
      
      (load	tn-2)
      (load	tn-1)
      (iadd)
      (store	tn)

      (load	tn-1)
      (store	tn-2)

      (load	tn)
      (store	tn-1)

      (iinc	x -1)
      (goto 	fib-loop_loop)

      break
      (load	tn-1)
      (ireturn)))

  (define fib-loop-bytes (string->symbol (li-assemble fib-loop-code #f #f)))
  (define fib-loop (intern-bytecode (make-vector 1 #f) 'fib-loop '#{(i)i}# 10 10 fib-loop-bytes)))



;;; (begin
;;;  (define ret-200000-code `((ldc1	(Integer 200000))
;;;			    (ireturn)))
;;;  (define ret-200000-ctab (make-vector 1 #f))
;;;  (define ret-200000-bytes (string->symbol (li-assemble ret-200000-code #f ret-200000-ctab)))
;;;  (define ret-200000 (intern-bytecode ret-200000-ctab 'ret-200000 '#{()i}# 10 10 ret-200000-bytes))
;;;  (or (eq? 200000 (ret-200000))
;;;      (error 'ret-200000-failed)))
;;; 
