4,887,235
433 434
(start-memory write physical %disk-command-address)
(assign memory-data disk-command-stop))
;; Switch disk over to write operation, then feed first word without dismissing
(parallel
(start-memory write physical %disk-command-address)
(assign memory-data disk-command-val2)
(jump disk-write-startup)))
;For first DnA transfer when writing, must not check state machine aliveness since
;it hasn’t sent us any wakeups yet. Must decide whethmr this is last (and first) DAP.
(defucode disk-write-startup
;; Increment MA, start memory to fetch first word of write data
(parallel
(start-memory read physical disk-memory-address dma iob 3)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if (minus-fixnum obus)
(goto disk-write-loop-1)
(goto disk-write-loop-last-1))))
;DMA transfer boo, not last DAP
(defucode disk-write-loop
;; First cycle: increment MA, start memory
(parallel
(start-memory read physical disk-memory-address dma iob 3)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(goto disk-write-loop-1))))
(defucode disk-write-loop-1
;; Second cycle: count down LIC.
(parallel
(assign disk-word-count (1- disk-word-count))
(if (minus-fixnum obus)
(parallel
;; Transfer last word and fetch new DAP
(start-memory read physical disk-memory-address dma iob 1)
(assign disk-memory-address (1+ disk-memory-address))
(call-and-return-skip disk-new-dap disk-write-loop-last disk-write-loop))
(goto disk-write-loop))))
;DMA transfer loop, last DAP
(defucode disk-write-loop-last
;; First cycle: increment MA, start memory
(parallel
(start-memory read physical disk-memory-address dma iob 3)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(goto disk-write-loop-last-1))))
(defucode disk-write-loop-last-1
;; Second cycle: count down WC.
(parallel
(assign disk-word-count (1- disk-word-count))
(if (minus-fixnum obus)
(goto disk-write-drain)
(goto disk-write-loop-last))))
;Transfer last two words in sector with end flag
(defucode disk-write-drain
(parallel (start-memory read physical disk-memory-address dma iob 7)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(drop-through)))
(nop)
(parallel (start-memory read physical disk-memory-address dma iob 7)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(drop-through)))
(nop)
;; Wake up here when state machine has swallowed last word
(dismiss-disk-task)
(nop)
;; Wake up here when state machine stops, after writing ECC
(terminate-disk-dma %disk-micro-status-end-write))
;Read-compare routine. Use this for both 32-bit and 36-bit reads.
;This is a hybrid of read and write
(define-disk-search-ucode disk-read-compare
;; Stop the disk state machine
(parallel
(start-memory write physical %disk-command-address)
(assign memory-data disk-command-stop))
;; Switch disk over to read/compare operation, then feed first word without dismissing
(parallel
4,887,235
435 436
(start-memory write physical %disk-command-address)
(assign memory-data disk-command-val2)
(jump disk-read-compare-startup)))
;For first DMA transfer, must not check state machine aliveness since
;it hasn’t sent us any wakeups yet. riust decide whether this is last (and first) DAP.
(defucode disk-read-compare-startup
;; Increment MA, start memory to fetch first word of data
(parallel
(start-memory read physical disk-memory-address dma iob 3)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if (minus-fixnum obus)
(goto disk-read-compare-loop-1)
(goto disk-read-compare-loop-last-1))))
;DMA transfer loop, not last DAP
(defucode disk-read-compare-loop
;; First cycle: increment MA, start memory
(parallel
(start-memory read physical disk-memory-address dma iob 3)
(assion disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(goto disk-read-compare-loop-1))))
(defucode disk-read-compare-loop-1
;; Second cycle: count down WC.
(parallel
(assign disk-word-count (1- disk-word-count))
(if (minus-fixnum obus)
(parallel
;; Transfer last word and fetch new DAP
(start-memory read physical disk-memory-address dma iob 1)
(assign disk-memory-address (1+ disk-memory-address))
(call-and-return-skip disk-new-dap
disk-read-compare-loop-last disk-read-compare-loop))
(goto disk-read-compare-loop))))
;DMA transfer loop, last DAP
(defucode disk-read-compare-loop-last
;; First cycle: increment MA. start memory
(parallel
(start-memory read physical disk-memory-address dma iob 3)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(goto disk-read-compare-loop-last-1))))
(defucode disk-read-compare-loop-last-1
;; Second cycle: count down WC.
(parallel
(assign disk-word-count (1- disk-word-count))
(if (minus-fixnum obus)
(goto disk-read-compare-drain)
(goto disk-read-compare-loop-last))))
;Transfer last two words in sector with end flag
(defucode disk-read-compare-drain
(parallel
(start-memory read physical disk-memory-address dma iob 7)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(drop-through)))
(nop)
(parallel
(start-memory read physical disk-memory-address dma iob 7)
(assign disk-memory-address (1+ disk-memory-address))
(dismiss)
(if lbus-dev-cond
(terminate-disk-dma %disk-micro-status-disk-error)
(drop-through)))
(nop)
;; Wake up here when state machine has swallowed last word
(dismiss-disk-task)
(nop)
;; Wake up here when state machine stops, after reading ECC
(terminate-disk-dma %disk-micro-status-end-read-compare))
;Write-all command. Wait for’ an index pulse then go start writing.
(defucode disk-write-a;;
(call-and-return-to start-read-or-write-all disk-write-startup))
;Read-all command. Wait for an index pulse then start reading.
(defucode disk-read-all
(call start-read-or-write-all)
(dismiss-disk-task)
(if (minus-fixnum disk-memory-address)
4,887,235
438
(goto disk-read-loop)
(goto disk-read-loop-last)))
;Since index pulse is narrow, we actually loop in this high-priority task
(defucode start-read-or-write-all
;; Loop until Index is true
(read-disk-status-to-val1)
(if (field-bit disk-command-val1 %%dsr-index)
(drop-through)
(goto start-read-or-write-all))
:; Start up the disk state machine. By the time it gets going we should
;; be near the trailing edge of Index.
(parallel
(start-memory write physical %disk-command-address)
(assign memory-data disk-command-val2)
(return)))
;Sector-wait command (used for seek-wait)
;Service task starts hardware in Sector Wait command. We wakeup immediately
;and then again at the beginning of the next sector
(defucode disk-sector-wait
(dismiss-disk-task)
(nop)
;; Wake up here when state machine sees sector pulse
(terminate-disk-dma %disk-micro-status-end-sector-wait))
;Read-header command
;Service task starts hardware in Read command, we awaken immediately
;and then again when sector header found
;--- This is pretty much guaranteed to cause an overrun...what to do?
(defucode disk-read-header
(dismiss-disk-task)
(nop)
;; Do a DMA write of the header into the DCW list (in the immediate arg of the read-header)
(start-memory write physical disk-dap-address dma iob 1)
(terminate-disk-dma %disk-micro-status-end-write))
;;; Service task
;--- for now, only serves the disk. Add the network later.
(defucode device-service-loop
;; Scan requests for service
(if (bit %%service-disk)
;; Disk service (DMA task not running now)
(dispatch-after-this disk-micro-status
(assign %%service-disk (b-constant 0))
((%disk-micro-status-idle %disk-micro-status-in-sector %disk-micro-status-stop)
(jump device-service-end)) ;Use jump rather than goto to save space
((%disk-micro-status-search-error %disk-micro-status-disk-error
%disk-micro-status-ecc-done)
(parallel (wakeup-driver)
(jump device-service-end)))
((%disk-micro-status-start)
(goto fetch-disk-dcw))
((%disk-micro-status-end-sector-wait)
(jump disk-seek-wait)) ;Use jump rather than goto to save space
((%disk-micro-status-end-write)
(call-and-return-to check-disk-status next-disk-dcw))
((%disk-micro-status-end-read)
(call check-disk-status)
(parallel
(trap-if (not (field-bit disk-command-val1 %%dsr-ecc-ok)) disk-error-detected)
(jump next-disk-dcw)))
((%disk-micro-status-end-read-compare)
(call check-disk-status)
(trap-if (field-bit disk-command-val1 %%dsr-compare-error) disk-error-detected)
(parallel
(trap-if (not (field-bit disk-command-val1 %%dsr-ecc-ok)) disk-error-detected)
(jump next-disk-dcw)))
(otherwise
(goto device-service-end))) ;Ignore any garbage status
;; No requests for service
(goto net-service-loop)))
;; If no requests, dismiss. If more requests have come in, go do them without
;; dismissing. Check must be in same cycle as dismiss to avoid hazard.
(defucode device-service-end
(parallel
(trap-if (not-zero-fixnum service-task-requests)
device-service-loop)
(dismiss))
(nop) ;Wait two cycles for dismiss
(jump device-service-loop))
;Read disk status register. Die if error, and return status in disk-command-vali.
;Note that the control stack can remain pushed spuriously if an error is detected.
;This is not a problem since there are no magic locations in this task's control stack.
(defucode check-disk-status
(read-disk-status-to-val1)
(parallel
4,887,235
439 440
(trap-if (bit-test (a-constant (get '%dsr-error-mask 'sysconstant)) disk-command-val1)
disk-error-detected)
(return)))
(defucode disk-error-detected
(assign %disk-micro-status (set-type %disk-micro-status-disk-error dtp-fix))
(parallel (wakeup-driver)
(jump device-service-end)))
;; Do next DCW after the one we just did
(defucode next-disk-dcw
(parallel
(assign %disk-dcw-address (+ %disk-dcw-address (ldb-field current-disk-dcw %%dcw-length)))
(jump fetch-disk-dcw)))
;; Do DCLI whose address has been set up
(defucode fetch-disk-dcw
;; Start fetch of first word
(parallel (start-memory read physical %disk-dcw-address)
(assign disk-dap-address (1+ %disk-dcw-address)))
;; Start fetch of second word
(parallel (start-memory read physical disk-dap-address)
(assign disk-dap-address (1+ disk-dap-address)))
;; Store the DCW away. Cannot be overlapped with dispatch due to damnable field conflicts
(assign current-disk-dcw memory-data)
(assign current-disk-dcw2 memory-data)
;; Decode the DCW
(dispatch-after-this (ldb-field current-disk-dcw %%dcw-micro-command)
;; Initialize micro status
(assign %disk-micro-status (set-type %disk-micro-status-in-sector dtp-fix))
((%dcw-u-nop)
(goto next-disk-dcw))
((%dcw-u-stop)
(sequential
(assign %disk-micro-status (set-type %disk-micro-status-stop dtp-fix))
(parallel (wakeup-driver)
(jump device-service-end))))
((%dcw-u-wakeup)
(parallel (wakeup-driver)
(jump next-disk-dcw)))
((%dcw-u-goto)
(parallel
(assign %disk-dcw-address current-disk-dcw2)
(jump fetch-disk-dcw)))
((%dcw-u-head)
(goto disk-head-select))
((%dcw-u-seek-wait)
(goto disk-seek-wait))
((%dcw-u-read-header)
(start-disk-dma disk-read-header)
(parallel (start-memory write physical %disk-command-address)
(assign memory-data current-disk-dcw2)
(jump device-service-end)))
((%dcw-u-read)
(parallel (start-disk-dma disk-read)
(jump start-disk-transfer)))
((%dcw-u-write)
(parallel (start-disk-dma disk-write)
(jump start-disk-transfer)))
((%dcw-u-read-compare)
(parallel (start-disk-dma disk-read-compare)
(jump start-disk-transfer)))
((%dcw-u-read-all)
(parallel (start-disk-dma disk-read-all)
(jump start-disk-transfer)))
((%dcw-u-write-all)
(parallel (start-disk-dma disk-write-all)
(jump start-disk-transfer)))
((%dcw-u-ecc)
(start-disk-dma disk-ecc)
(parallel (start-memory write physical %disk-command-address)
(assign memory-data current-disk-dcw2)
(jump device-service-end)))
(otherwise ;Die if garbage seen
(sequential
(assign %disk-micro-status (set-type %disk-micro-status-stop dtp-fix))
(parallel (wakeup-driver)
(jump device-service-end))))))
;Transfer DCWs come here. The state of the DMA task has been set.
(defucode start-disk-transfer
;; Start fetch of third word (command)
(parallel (start-memory read physical disk-dap-address)
(assign disk-dap-address (1+ disk-dap-address)))
;; Start fetch of first DAP
(parallel (start-memory read physical disk-dap-address)
(assign disk-dap-address (1+ disk-dap-address)))
;; Stash command
(assign disk-command-val1 memory-data)
;; Complete fetch cf first DAP
(assign disk-word-count memory-data)
4,887,235
441 442
(parallel (start-memory read physical disk-dap-address)
(assign disk-dap-address (1+ disk-dap-address)))
(assign disk-command-stop (logand disk-command-val1
(a-constant (lognot (field-mask %%dcr-busy)))))
(assign disk-memory-address memory-data)
;; Screw around for 2 extra cycles because of conflicts for AMWA
(assign disk-sector-tries (ldb-field current-disk-dcw %%dcw-dcr-command))
(assign disk-sector-tries (dpb-field disk-sector-tries %%dcr-command disk-command-val1))
(assign disk-command-val2 disk-secter-tries)
(assign disk-sector-tries %disk-sector-max-tries)
(parallel (start-memory write physical %disk-command-address)
(assign memory-data disk-command-stop) ;Wake up and go to sleep
(jump device-service-end)))
;Check whether seek has completed immediately and at every sector pulse thereafter
(defucode disk-seek-wait
(parallel (assign %disk-micro-status (set-type %disk-micro-status-in-sector dtp-fix))
(call check-disk-status))
(if (field-bit disk-command-val1 %%dsr-on-cylinder)
(goto next-disk-dcw)
(drop-through))
(start-disk-dma disk-sector-wait)
(parallel (start-memory write physical %disk-command-address)
(assign memory-data current-disk-dcw2)
(jump device-service-end)))
;Head select -- need to twiddle tog bit up end down
(defucode disk-head-select
;; Write bus, with tag bit turned off
(parallel (start-memory write physical %disk-command-address)
(assign memory-data current-disk-dcw2))
;; Write again, with tag bit turned on
(assign disk-command-val1 (logior (a-constant (field-mask %%dcr-head-tag))
current-disk-dcw2))
(parallel (start-memory write physical %disk-command-address)
(assign memory-data disk-command-val1)
;; Delay a microsecond or so by checking for error status
(call check-disk-status))
;; Clear tag bit, leaving same value on bus
(parallel (start-memory write physical %disk-command-address)
(assign memory-data current-disk-dcw2)
(jump next-disk-dcw)))
;Error correction computation. We have to do the word counting here.
;Do it in %disk-memory-add’ess so when we’re done the macrocode can read it.
;First, have to take 335-72 wakeups to rec~cle the ecc code (335 is the
;ecc code field size of 42987 divided by 128. 72 is the sector size
;divided by 128). The state machine takes care of the extra bits for
;the remainder of 42987/128, minus the 32 bits already clocked when the
;ecc was read at the end of the sector and the 64 bits already clocked
;when the prefix was read.
;The -4 is because if %disk-memory-address starts out negative the state
;machine will still process 3 128-bit chunks before it sees the end flag.
(defucode disk-ecc
(parallel (assign %disk-memory-address (set-type (b-constant (- 335. 72. 4)) dtp-fix))
(dismiss-disk-task)
(jump disk-ecc-loop-1)))
(defucode disk-ecc-loop-1
(if (minus-fixnum %disk-memory-address)
;; Finished recycling code, start counting words of data field
;; Start at -3 because we will wake up twice while two more 128-bit
;; chunks are passed over, and if we stop after the first word, that
;; is word 0
(parallel (assign %disk-memory-address (set-type (b-constant -3) dtp-fix))
(dismiss-disk-task-and-ack end-flag)
(jump disk-ecc-loop-2))
(drop-through))
;; Wakes up here
(parallel (assign %disk-memory-address (set-type (1- %disk-memory-address) dtp-fix))
(dismiss-disk-task-and-ack)
(jump disk-ecc-loop-1)))
;Now run and count words until state machine stops or full sector size has been scanned.
(defucode disk-ecc-loop-2
(if (greater-or-equal-fixnum %disk-memory-address (b-constant 290.))
(terminate-disk-dma %disk-micro-status-ecc-done) ;Uncorrectable error
(drop-through))
;; Wakes up here
(parallel (assign %disk-memory-address (set-type (1+ %disk-memory-address) dtp-fix))
(dismiss-disk-task-and-ack)
(if lbus-dev-cond ;Was this a complete word, or did at mach stop?
(terminate-disk-dma %disk-micro-status-ecc-done) ;Correctable error
(goto disk-ecc-loop-2))))
;;; Initialization--maybe some day the microcode loader can take care of this?
;;; In the meantime the startup microcode should call this subroutine
(defucode disk-initialize
(parallel
(write-task-state %device-service-task
;XXXbrad - missing...
)))
4,887,235
443 444
;;; -*- Mode:Lisp; Package:Micro; Base:8; Lowercase:yes -*-
;;; (c) Copyright 1982, Symbolics, Inc.
;;; Microcode for master control
;Get defmicro and all his hosts
#M
(declare (cond ((not (status feature lmucode))
(load 'udcls))))
(define-sysconstant main-stack-buffer-address)
(define-sysconstant auxiliary-stack-buffer-address)
(reserve-scratchpad-memory 2514 2520)
(defareg current-dp-control) ;Copy of dp-control register (can’t read back)
(defareg a-page-fault-address) ;VMA of last page fault (for debugging)
(defareg a-page-fault-micro-pc) ;Micro-PC of last page fault (for debugging)
;If this register is non-zero and we pclsr, save-bitblt-buffer must be
;called after restoring the stack pointer.
(defareg bitblt-buffer-active 0)
;Start the machine here
(defucode-at-loc start 1 ;105 FOOBAR
(assign b-quote-t quote-t) ;These are needed on the B side
(parallel
(assign b-quote-nil quote-nil)
(call disk-initialize)) ;Initialize other tasks
;; Initialize virtual address map
(parallel (assign vma (a-constant 0))
(call clear-map-cache))
;; Initialize flags
(assign a-pclsr-top-of-stack (set-type (b-constant 0) dtp-null))
(assign bitblt-buffer-active (b-constant 0))
(assign stack-load-started (b-constant 0))
(assign current-dp-control (b-constant 0))
(assign a-stack-group-lock quote-nil)
(assign b-cached-mapping-table quote-nil)
(assign %stack-buffer-low (set-type (b-constant 0) dtp-fix)) ;do this in macrocode later...
(assign %stack-buffer-limit (set-type (b-constant 0) dtp-fix))
(call switch-to-auxiliary-stack-buffer)
(parallel (pushval function-system-startup) ;Call this function to start up
(call funcall-0-ignore)) ;Build frame header, set PC
;; Mark this frame as the bottom frame so we trap if it tries to return
(parallel
(assign frame-misc-data (logior frame-misc-data ;Cause trap on return
(b-constant (+ (byte-mask frame-buffer-underflow-bit)
(byte-mask frame-bottom-bit)))))
(call initialize-net)) ;Initialize the network
(parallel
(assign frame-previous-frame quote-nil) ;No back-pointer in this frame
(jump pclsr))) ;Adjust CSP and take instruction dispatch
;;; Pclsr
;Come here with new PC (to escape to) loaded. Clear the micro stack, reset the
;main stack, and return to the main loop (eventually the IFU dispatch address)
(defucode pclsr-restore-stack
(call-and-return-to restore-stack-pointer pclsr))
(defucode pclsr
;; Pop stack until clear. If not in emulator task. halt.
;; Don’t pop control-stack simultaneous with test, it would cause SQ NEXT INST
;; to come on spuriously if stack uas already clear.
(if (not-zero-fixnum (read-cur-task))
;; Not in emulator task
(halt pclsr-in-io-task)
;; In emulator task, check csp left In b-temp as bi-product
(if (equal-fixnum (ldb b-temp 4 16.) (a-constant 17))
;; Stack is empty, exit
(parallel (assign a-pclsr-top-of-stack (set-type (a-constant 0) dtp-null))
(jump pclsr-done)) ;Must make sure above flag is clear
;; Stack not empty, pop and try again
(parallel
(for-effect (pop-control-stack))
(jump pclsr)))))
(defucode pclsr-done
(if (not-zero-fixnum bitblt-buffer-active)
(goto save-bitblt-buffer)
(next-instruction)))
;Restore stack-pointer to its value at the start of thio macroinstruction,
;clobbering top-of-stack (but no temporaries!)
(defucode restore-stack-pointer
(assign top-of-stack (logior (a-constant -1_4) stack-adjustment))
(if (ldb-bit-test top-of-stack 3)
4,887,235
445 446
(assign stack-pointer (- stack-pointer top-of-stack))
(assign stack-pointer (- stack-pointer (ldb top-of-stack 3 0))))
(if (not (data-type? a-pclsr-top-of-stack dtp-null))
(parallel (assign top-of-stack-a a-pclsr-top-of-stack)
(return))
(return)))
;;; Multiple stack-buffer primitives
;Discard the state of the auxiliary stack buffer and resume the saved state
;of the main stack buffer. If %sequence-break-pending is set, trap imeadiately.
(definst %resume-main-stack-buffer no-operand
(error-if (not (equal-pointer %current-stack-buffer auxiliary-stack-buffer-address))
illegal-instruction)
(if (not-data-type? %sequence-break-pending dtp-nil)
(parallel (assign %sequence-break-pending quote-nil)
(call set-sequence-break))
(drop-through))
(assign %control-stack-low %other-control-stack-low)
(assign %control-stack-limit %other-control-stack-limit)
(assign %binding-stack-low %other-binding-stack-low)
(assign %binding-stack-limit %other-binding-stack-limit)
(assign %binding-stack-pointer %other-binding-stack-pointer)
(assign %catch-block-list %other-catch-block-list)
(assign %current-stack-group-status-bits %other-stack-group-status-bits)
(assign pc %other-pc) ;No instruction fetch since page fault muat be deferred
(assign frame-pointer %other-frame-pointer)
(assign stack-pointer %other-stack-pointer)
(parallel
(assign %current-stack-buffer (set-type main-stack-buffer-address dtp-fix))
(assign b-temp obus)
(call set-stack-buffer))
(parallel
(assign top-of-stack top-of-stack-a)
(jump set-stack-buffer-limit)))
;Explicit switch to aux sb.
;Stack contains function, args, count of args. All popped upon return, no values
;returned unless they are pushed "by hand" before resuming,
(definst %funcall-in-auxiliary-stack-buffer (no-operand needs-stack)
;; Perform context switch and pop our arguments
(assign a-temp (- stack-pointer top-of-stack 1)) ;Address of the function
(parallel
(assign vma (ldb a-temp 10. 0 main-stack-buffer-address)) ;Translate to physical address
(decrement-stack-pointer)
(call switch-to-auxiliary-stack-buffer))
(parallel
(assign %other-stack-pointer (- %other-stack-pointer top-of-stack 1))
(jump %funcall-in-auxiliary-stack-buffer1)))
(defucode %funcall-in-auxiliary-stack-buffer1
;; Copy function, args, count into new stack, then perform a function call
(parallel
(start-memory read block)
(assign top-of-stack (1- top-of-stack)))
(if (greater-fixnum top-of-stack (a-constant -2))
(sequential
(parallel
(assign (amem (stack-pointer 1)) memory-data)
(increment-stack-pointer))
(parallel
(assign vma (ldb vma 10. 0 main-stack-buffer-address))
(jump %funcall-in-auxiliary-stack-buffer1)))
(parallel
(assign (amem (stack-pointer 1)) memory-data)
(increment-stack-pointer)
(assign top-of-stack memory-data)
(call funcall-n-ignore)))
;; Mark this frame as the bottom frame so we trap if it tries to return
(assign frame-misc-data (logior frame-misc-data ;Cause trap on return
(b-constant (+ (byte-mask frame-buffer-underflow-bit)
(byte-mask frame-bottom-bit)
(byte-mask frame-trace-bit)))))
(parallel
(assign frame-previous-frame quote-nil) ;No back-pointer in this frame
(next-instruction)))
;Subroutine to save the main stack buffer’s context and select the auxiliary buffer,
;giving it a freshly-created small control stack, and no binding stack
;This control stack resides in virtual-physical space.
(defucode switch-to-auxiliary-stack-buffer
;; State save
(assign %other-pc pc)
(assign %other-frame-pointer frame-pointer)
(assign %other-stack-pointer stack-pointer)
(assign %other-control-stack-low %control-stack-low)
(assign %other-control-stack-limit %control-stack-limit)
(assign %other-binding-stack-low %binding-stack-low)
(assign %other-binding-stack-limit %binding-stack-limit)
(assign %other-binding-stack-pointer %binding-stack-pointer)
(assign %other-catch-block-list %catch-block-list)
4,887,235
447 448
(assign %other-stack-group-status-bits %current-stack-group-status-bits)
;; Setup new state
(assign %control-stack-low (set-type auxiliary-stack-buffer-address dtp-locative))
(assign %control-stack-limit (set-type (+ %control-stack-low (b-constant 1400))
dtp-locative))
(assign %binding-stack-low (set-type (b-constant 0) dtp-locative))
(assign %binding-stack-limit %binding-stack-low)
(assign %binding-stack-pointer %binding-stack-low)
(assign %catch-block-list quote-nil)
(assign %current-stack-group-status-bits
(set-type (a-constant (field-mask sg-halt-on-error)) dtp-fix))
(assign frame-pointer (set-type (b-constant 0) dtp-null)) ;I guess...
(assign stack-pointer (1- %control-stack-low))
(assign stack-limit %control-stack-limit)
(parallel
(assign %current-stack-buffer (set-type auxiliary-stack-buffer-address dtp-fix))
(assign b-temp obus)
(jump set-stack-buffer)))
;Tell the hardware to use the stack buffer whose address is in b-temp
(defucode set-stack-buffer
(parallel
(write-dp-control (ldb b-temp 2 10. current-dp-control))
(assign current-dp-control obus)
(return)))
;;; Sequence Break
;Set the sequence break flag in the hardware. This is usually called in an I/O task.
(defucode set-sequence-break
(parallel
(write-dp-control (dpb (b-constant 1) 1 2 current-dp-control))
(assign current-dp-control obus)
(return)))
;Sequence break is deferred if we are already in the auxiliary stack buffer.
;Otherwise switch stack buffers and call the function SEQUENCE-BREAK with no args.
;There is guaranteed always to be enough extra room in the main stack buffer
;to do the necessary pushes for this. We don’t use an escape function because
;there are no pclsring issues, we want to store the real pc in %other-pc,
;and it would save at most one control-memory location.
;Note that the harduare ensures that the EPC is not incremented past the
;instruction that would have been executed next were it not for the sequence break.
;In the TMC5 the DPC gets incremented, however.
(defucode-at-loc sequence-break 16000
;; Clear the flag in the hardware
(parallel
(write-dp-control (dpb (b-constant 0) 1 2 current-dp-control))
(assign current-dp-control obus))
;; Defer if already on aux buffer
(if (equal-pointer %current-stack-buffer auxiliary-stack-buffer-address)
(parallel (assign %sequence-break-pending quote-t)
(jump ifu-empty-trap)) ;Recycle fake IFU by loading PC
(drop-through))
;; Go call the sequence-break handler
(machine-version-case
((tmc5 ifu) ;Function call will advance the return PC
(assign pc (pc-plus-number pc (b-constant -1)))) ;so decrement it to cancel that cut
(otherwise nil))
(pushval function-sequence-break)
(parallel
(pushval (set-type (a-constant 0) dtp-fix)) ;No arguments
(jump %funcall-in-auxiliary-stack-buffer)))
;;;; Page fault trap-out
;Come here if there is a page fault, with the referencing address in VI’IA,
;and the fault tyom (%page-pht-miss or %page-write-fault) in a-temp.
;We will do a "take-pre-trap restore-stack" then call PAGE-FAULT with two
;arguments, on the auxiliary stack buffer, whether or not we were already there.
;The macrocode is in charge of figuring our whether this was a "recursive" page fault.
;There is guaranteed always to be enough extra room in the main stack buffer
;to do the necessary pushes for this.
(defucode page-fault
;; Save debugging information. Storing micro-pc takes two cycles because of
;; AMWA conflict and also because valid NPC needed for following call.
(assign b-temp (logand (pop-control-stack) (b-constant 37777)))
(assign a-page-fault-micro-pc (set-type b-temp dtp-fix))
(parallel
(assign a-page-fault-address vma)
;; Restore sp to its state at the start of the instruction
(call restore-stack-pointer))
;; Push funcall block for entering the page-fault macrocode
(pushval function-page-fault)
(pushval (set-type vma dtp-fix))
(pushval (set-type a-temp dtp-fix))
(pushval (set-type (a-constant 2) dtp-fix)) ;2 args
;; Restore pc to its state at start of instruction (now that vma is saved)
(machine-version-case
((ifu tmc5) nil) ;Hardware takes care of it
4,887,235
449 450
((tmc)
(if (equal-pointer a-page-fault-micro-pc
(b-constant '(build-task-state cpc ifu-empty-trap-1 npc 0 csp 0)))
(drop-through) ;Kludge: don’t back up PC if fault on inst fetch
(assign pc (pc-plus-number pc (b-constant -1))))))
;; Call the function, switching to auxiliary stack buffer if not already there
(call-select-and-return-to
(equal-pointer %current-stack-buffer auxiliary-stack-buffer-address)
funcall-n-ignore %funcall-in-auxiliary-stack-buffer
pclsr))
;Temporary for debugging. If you see this, it isn’t here.
(definst %hack no-operand
(nop)
(nop)
(nop)
(next-instruction))
F:>lmach>ucode>CATCH.LISP.10
;;; -*- Mode:Lisp; Package:Micro; Base:8; Lowercase:yes -*-
;;; (c) Copyright 1982, Symbolics, Inc.
; Microcode for catch/throw/unwind-protect instructions
;Get defmicro and all his hosts
#M
(declare (cond ((not (status feature lmucode))
(load 'udcls))))
;Initialize %catch-block-list to nil (temporary kludge)
; This is now done by >lmach>sysdfl
;(defareg %catch-block-list *nil*)
;Temporaries
(reserve-scratchpad-memory 2424 2430)
(defareg a-catch-pc)
(defareg a-catch-nwords)
;:PUSHVAL without setting the top-of-stack register
(defmicro pushval1 (val)
`(parallel (assign (amem (stack-pointer 1)) (set-cdr ,val cdr-next))
(increment-stack-pointer)))
;This micro writes the code for the catch-block-creation instructions
(defmicro catch-open (value-disposition &optional unwind-protect-hair)
(setq value-disposition (find-position-in-list value-disposition
'(ignore stack return multiple)))
`(sequential
;; The tag is already in the stack. Now push the PC, BSP, and thread.
(if (not-zero-fixnum macro-unsigned-immediate)
(pushval1 (pc-add pc macro-unsigned-immediate))
;; Offset of zero means pop offset off the stack, and push PC back on.
,(if (not unwind-protect-hair)
`(newtop (pc-add pc top-of-stack))
;; hairy case for unwind-protect, twiddle the stack
`(sequential
(parallel
(assign b-temp next-on-stack)
(assign next-on-stack top-of-stack))
(newtop (pc-add pc b-temp)))))
(pushval %binding-stack-pointer)
(pushval-with-cdr (set-ccr %catch-block-list ,value-disposition))
;; Now link up to the list and set the flag bit in the frame
(assign %catch-block-list
(set-type (- stack-pointer (b-constant 3)) dtp-locative))
(parallel (assign frame-catch-bit (b-constant 1))
(next-instruction))))
(definst catch-open-ignore (unsigned-pc-relative needs-stack)
(catch-open ignore))
(definst catch-open-stack (unsigned-pc-relative needs-stack)
(catch-open stack))
(definst catch-open-return (unsigned-pc-relative needs-stack)
(catch-open return))
(definst catch-open-multiple (unsigned-pc-relative needs-stack)
(catch-open multiple))
;---This uses T as the magic tag meaning unwind-protect, This is temporary.
(definst unwind-protect-open unsigned-pc-relative
(sequential (pushval quote-t)
(catch-open ignore t)))
;Closing off the current catch block. We are given a number of words at
;the top of the stack to be preserved. Everything between them and the
;base of the catch block is recoved from the stack, the binding stack
4,887,235
451 452
;is unwound if necessary, the block is unthreaded, bits in the frame
;header are cleared as necessary. Now if the catch block was an unwind-protect,
;the cleanup handler is pushj’ed to; otherwise the instruction simply returns.
(definst catch-close unsigned-immediate-operand
(parallel (assign a-catch-nwords macro-unsigned-immediate)
(jump catch-close-1)))
(definst catch-close-multiple no-operand
(parallel (check-arg-type top-of-stack top-of-stack-a dtp-fix)
;;XXXbrad (1+?
(assign b-catch-nwords (1- top-of-stack-a))
(jump catch-close-1)))
;a-catch-nwords has the number of words to be preserved at the top of the stack
(defucode catch-close-1
;; Make the catch block addressable. Assume it resides in the current frame.
(assign xbas %catch-block-list)
;; --- First we should fcol around with unsafe pointer-s to the stack
;; Pop tho binding stack since that can pclsr
(assign b-temp (amem (xbas 2)))
(if (not-equal-pointer b-temp %binding-stack-pointer)
(call pop-binding-stack-to-b-temp)
;restore xbas?
(drop-through))
;; Copy Out the parts of the catch block that we will need
(assign b-temp (amem (xbas 0))) ;Catch tag
(if (equal-typed-pointer b-temp quote-t) ;unwind-protect
(sequential
(parallel
(assign a-catch-pc (amem (xbas 1))) ;Cleanup handler address
(call catch-close-2))
(pushval pc) ;Now pushj to cleanup handler
(assign pc a-catch-pc) ;Don’t use set-pc. We must not pclsr
(nop) ;and try to close the catch over again.
(next-instruction)) ;Set the PC first. then take any page foult.
(goto catch-close-2)))
;Blt down the stack (cannot pclsr after this point)
(defucode catch-close-2
(assign b-temp frame-pointer) ;Save FP used as a temporary
(assign b-temp-2 stack-pointer) ;Last word to save
(assign frame-pointer (- b-temp-2 a-catch-nwords)) ;First word to save-1
(assign stack-pointer (1- %catch-block-list)) ;Flush stack down to base of block
(parallel
(assign %catch-block-list (amem (xbas 3))) ;Unthread this catch block
(call blt-stack))
(parallel
(assign frame-pointer b-temp) ;Restore FP
(if (data-type? %catch-block-list dtp-locative)
(if (greater-or-equal-pointer %catch-block-list b-temp)
(return) ;Still some catch blocks in this frame
(drop-through))
(drop-through)))
(parallel
(assign frame-catch-bit (b-constant 0)) ;No more blocks this frame, clear bit
(return)))
F:>lmach>ucode>
; -*- Mode:Lisp; Base:8; Lowercase:yes -*-
; Bogus Microcode for testing that various things are possible
; Not all of this will work in the simulator
;Get defmicro and all his hosts
(declare (cond ((not (status feature lmucode))
(load 'udcls))))
;Micro for the first cycle of a trap handler.
;Finishes the state save by calling for a PUSHJ. which saves
;the original CPC (now in NPC) onto the stack. The original NPC
;is already on the stack.
(defmicro trap-save ()
'(microinstruction control-stack pushj))
;Micro for the last two cycles of a trap handler.
;Takes arguments of what else to do in those cycles, that
;seeming clear-er- than throwino a parallel around the sequence.
;We restore the NPC and the CPC by twice popping the control
;stack into NPC. In the second cycle we also use NPC as
;as the source for CPC. Thus the push order is NPC, CPC and
;the pop order is CPC, NPC.
(defmicro trap-restore (cycle-1 cycle-2)
`(sequential
(parallel
,cycle-1
(microinstruction control-stack popj npc ctos))
(parallel
,cycle-2
(microinstruction control-stack popj npc ctos cpc npc))))