github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-20 09:55:52 +00:00
Code Issues Releases Wiki Activity

Fix 8748 assembler to compile with Maclisp.

Browse Source
This commit is contained in:
Lars Brinkhoff 2018-10-05 20:19:12 +02:00
parent 5bb6cd6c2e
commit c9c872e7c5
2 changed files with 42 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
build/lisp.tcl
View File

@ -1124,3 +1124,9 @@ respond ":" "t\r"
respond ":" "t\r"
respond "\n" ":vk\r"
respond "*" ":kill\r"
# AS8748
respond "*" ":complr\r"
respond "_" "lmio1;as8748\r"
respond "_" "\032"
type ":kill\r"

53
src/lmio1/as8748.38 → src/lmio1/as8748.39
View File

@ -2,6 +2,11 @@
;;; Assemble for 8x48 series of microprocessors
;;; Modified 2018-10-05 by EJS to work on MacLisp as well as LISPM
(eval-when (compile)
(load '((lisp) umlmac)))
(declare (special as-pc as-labels as-assignments as-pass as-must-be-assigned as-form as-code
as-known-new-pc))
@ -35,6 +40,16 @@
(putprop program program 'USER:LOCATION)
program)
(defmacro as-make-array (size)
#+LISPM `(make-array ,size ':TYPE 'ART-Q)
#+(or Maclisp Franz) `(*ARRAY NIL T ,SIZE)
#+NIL `(make-vector ,size))
(defmacro as-set-array (val array idx)
#+LISPM `(aset ,val array ,idx)
#+(or Maclisp Franz) `(store (arraycall t array ,idx) ,val)
#+NIL `(vset array ,idx ,val))
(defun as-convert-to-prom-image (code)
(let ((pc -1)
(high -1)
@ -47,14 +62,14 @@
(t (setq pc (1+ pc))))
(and (> pc high)
(setq high pc)))
(setq array (make-array nil 'art-q (1+ high)))
(setq array (as-make-array (1+ high)))
(fillarray array '(0))
(setq pc -1)
(dolist (elt code)
(cond ((and (listp elt)
(eq (car elt) '=))
(setq pc (cadr elt)))
(t (aset elt array pc)
(t (as-set-array elt array pc)
(setq pc (1+ pc)))))
array))
@ -63,6 +78,12 @@
(and (eq as-pass 'PASS-2)
(setq as-code (cons (logand value 377) as-code))))
(defun as-error (error-string &rest args)
(lexpr-funcall #'format t error-string args)
(format t " while assembling ~A~%" as-form)
(and as-known-new-pc (setq as-pc as-known-new-pc))
(*throw 'AS-ERROR nil))
(defun as-compile-form (as-form)
(setq as-known-new-pc nil)
(*catch 'AS-ERROR
@ -80,7 +101,7 @@
((listp as-form)
(let ((dispatch (get (car as-form) 'AS-DISPATCH)))
(cond (dispatch (funcall dispatch as-form))
(( (length as-form) 1)
((not (=(length as-form) 1))
(as-error "Undefined operation in form ~A" as-form))
(t (as-generate-8-bits (as-hack-expression (car as-form)))))))
((numberp as-form)
@ -95,29 +116,27 @@
(putprop '@R0 '(REGISTER-INDIRECT 0) 'AS-REGISTER)
(putprop '@R1 '(REGISTER-INDIRECT 1) 'AS-REGISTER)
(defmacro as-return (v1 v2)
#+LISPM `(return ,v1 ,v2)
#-LISPM `(return (values ,v1 ,v2)))
(defun as-parse-arg (arg)
(prog (tem)
(cond ((numberp arg) (return arg 'ADDRESS))
(cond ((numberp arg) (as-return arg 'ADDRESS))
((symbolp arg)
(cond ((setq tem (get arg 'AS-REGISTER))
(return (cadr tem) (car tem)))
((eq arg 'A) (return 'A 'A))
((eq arg 'T) (return 'T 'T))
((eq arg 'PSW) (return 'PSW 'PSW))
(t (return (as-hack-expression arg) 'ADDRESS))))
(as-return (cadr tem) (car tem)))
((eq arg 'A) (as-return 'A 'A))
((eq arg 'T) (as-return 'T 'T))
((eq arg 'PSW) (as-return 'PSW 'PSW))
(t (as-return (as-hack-expression arg) 'ADDRESS))))
((listp arg)
(cond ((eq (car arg) '/#)
(setq as-known-new-pc (+ as-pc 2))
(return (as-hack-expression (cadr arg)) 'IMMEDIATE))
(t (return (as-hack-expression arg) 'ADDRESS))))
(as-return (as-hack-expression (cadr arg)) 'IMMEDIATE))
(t (as-return (as-hack-expression arg) 'ADDRESS))))
(t (as-error "~A is illegal arg" arg)))))
(defun as-error (error-string &rest args)
(lexpr-funcall #'format t error-string args)
(format t " while assembling ~A~%" as-form)
(and as-known-new-pc (setq as-pc as-known-new-pc))
(*throw 'AS-ERROR nil))
;;; "Pseduo-ops"
(defun as-set-pc (form &aux (old-pc as-pc))