deskthority

Code: Select all

;;; -*- Mode: Lisp; Base: 8; Package: User -*-

(defun complement (x)
  (logxor 377 x))

(setq bitmap 60)	;60-77 Bit map.  0 if key up, 1 if key down.
;To read from keyboard, P1<4:1> gets column number, then P1<0> gets 0,
;then read back keys from P2, then P1<1> gets 1 again.

;P1<7> = pin 5 on the connector
;P1<6> = pin 3 on the connector	(used for data)
;P1<5> = pin 1 on the connector
;T1    = pin 2 on the connector (used for clock)

;The following are the bit numbers of the keys which are specially
;known about for shifting purposes:
;  mode lock	3
;  caps lock	125
;  alt lock	15
;  repeat	115
;  top		104 / 155
;  greek	44 / 35
;  shift	24 / 25
;  hyper	145 / 175
;  super	5 / 65
;  meta		45 / 165
;  control	20 / 26

; For booting, we know that rubout is 23 and return is 136

(putprop 'ukbd '(
	(= 0)
	(jmp beg)

	(= 100)
beg	(mov a (/# 377))
	(outl p1 a)			;Mainly turn off data out
	(outl p2 a)			;Enable input
	(mov r0 (/# bitmap))		;Clear the bitmap
	(mov r1 (/# 20))
	(clr a)
clear-bitmap-loop
	(mov @r0 a)
	(inc r0)
	(djnz r1 clear-bitmap-loop)
;Scanning Loop.
;R2 is bitmap index in bytes, plus 1
;R0,R1 temporary as usual

scan-keyboard
	(mov r2 (/# 20))
scan-loop
	(mov a (/# (1- bitmap)))
	(add a r2)			;Address of bitmap byte
	(mov r0 a)
	(mov a r2)
	(dec a)
	(orl p1 (/# 37))		;P1<4:1>  R2-1, and disable decoder
	(jb0 scan-loop-p1out-0)
	(anl p1 (/# (complement 2_0)))
scan-loop-p1out-0
	(jb1 scan-loop-p1out-1)
	(anl p1 (/# (complement 2_1)))
scan-loop-p1out-1
	(jb2 scan-loop-p1out-2)
	(anl p1 (/# (complement 2_2)))
scan-loop-p1out-2
	(jb3 scan-loop-p1out-3)
	(anl p1 (/# (complement 2_3)))
scan-loop-p1out-3
	(anl p1 (/# (complement 1)))	;Strobe the decoder
	(in a p2)			;Get row of keys
	(xrl a @r0)			;A  changed bits
	(jnz scan-found)		;Jump if key state changed
	(djnz r2 scan-loop)
	;
	(jmp scan-keyboard)

;R0 address of bit map entry
;R2 bit number
;R3 changed bits
;R4 bit mask
scan-found
	(mov r3 a)
	(mov r4 (/# 1))
	(mov a r2)			;Bit number is byte number times 8
	(dec a)
	(rl a)
	(rl a)
	(rl a)
	(mov r2 a)
scan-bits-loop
	(mov a r4)
	(anl a r3)
	(jnz scan-found-key)
	(inc r2)
	(mov a r4)			;Shift left one bit, A  0 when done
	(add a r4)
	(mov r4 a)
	(jnz scan-bits-loop)
	(jmp scan-keyboard)		;wtf? should have found something

scan-found-key
	(mov a r4)			;Bit mask
	(xrl a @r0)			;Change bitmap bit
	(mov @r0 a)			;Put back in bitmap
	(anl a r4)			;0 if key now up, non-0 if key now down
	(mov r3 (/# 0))			;Assume key down
	(jnz scan-found-key-down)
	(inc r3)			;Key up, middle byte is 1
	;; If this is a shifting key, don't send all-keys-up, send this-key-up.
	;; This is so that with paired shifting keys we know which it is.
	(mov a r0)
	(add a (/# (- 200 bitmap)))	;Point to mask of non-shifting keys
	(movp3 a @a)
	(anl a r4)			;A gets bit from table (0 => shifting)
	(jz scan-found-key-down)	;Shifting => don't send all-keys-up
	;; Look through the bit map and see if all non-shifting keys are now
	;; up.  If so, send an all-keys-up instead.
	(mov r0 (/# bitmap))
	(mov r1 (/# 200))		;P3 table at 1600
	(mov r4 (/# 20))
check-for-all-up
	(mov a r1)
	(movp3 a @a)
	(anl a @r0)
	(jnz scan-found-key-down)
	(inc r0)
	(inc r1)
	(djnz r4 check-for-all-up)
	(call compute-all-up-code)
scan-found-key-down
	(mov r4 (/# 371))		;Source ID 1 (new keyboard)
	(call send)			;Transmit character
	(call check-boot)		;See if request to boot machine
	(jmp scan-keyboard)

;Subroutine to transmit like old-type Knight keyboard
;Send a 24-bit character from R2, R3, R4
;T1    = pin 2 on the connector	(used for clock)
;P1<6> = pin 3 on the connector	(used for data)
;Data output is normally high, we make it low to get the attention of the keyboard
; multiplexor.
;Clock input is normally high, its low-going transition is when we send the next bit.
;A 1 bit is a high.
;R0 has a count

;Timing:	(1 cycle = about 4 microseconds)
;Clock-low to data-change: 4 to 6 cycles
;Data-change to await-clock-high: 1 cycle
;Clock-high to await-clock-low: 6 cycles best case, 15 cycles worst case
;Start-bit to await-clock-low: 7 cycles
;If clock is symmetric, minimum period is 22 cycles (88 microseconds).

send	(anl p1 (/# (complement 1_6)))	;Send a 0 to start
	(mov a r2)
	(call send-byte)
	(mov a r3)
	(call send-byte)
	(mov a r4)
	(call send-byte)
send-1	(jnt1 send-1)			;Await clock high (idle)
	(orl p1 (/# 1_6))		;Restore line to high
	(ret)

send-byte
	(mov r0 (/# 10))
send-byte-1
	(jb0 send-a-1)
send-a-0
	(jt1 send-a-0)			;Await clock low
	(anl p1 (/# (complement 1_6)))	;Send a 0
send-next-bit-0
	(rrc a)
send-await-clock-high-0
	(jnt1 send-await-clock-high-0)
	(djnz r0 send-byte-1)
	(ret)

send-a-1
	(jt1 send-a-1)			;Await clock low
	(orl p1 (/# 1_6))		;Send a 1
send-next-bit-1
	(rrc a)
send-await-clock-high-1
	(jnt1 send-await-clock-high-1)
	(djnz r0 send-byte-1)
	(ret)

	(= 400)
;Return in R2 and R3 the low 16 bits of an all-up key-code.
;This works by checking through the bitmap looking for shift keys
;that are down, and OR'ing in the bits.
compute-all-up-code
	(mov r2 (/# 0))
	(mov r3 (/# 200))		;Start with only bit 15 set
	(mov r5 (/# 0))			;R5 address in P3
	(mov r0 (/# bitmap))		;R0 address in bitmap
cauc-0	(mov r4 (/# 1))			;R4 bit mask
cauc-1	(mov a r5)
	(movp3 a @a)			;Get table entry
	(jb7 cauc-9)			;Jump if this key not a shifter
	(mov r6 a)			;Save bit number
	(mov a r4)			;Check bit in bit map
	(anl a @r0)
	(jz cauc-9)			;Key not pressed
	(mov a r6)			;See if bit number 8 or more
	(add a (/# -8))
	(jb7 cauc-4)			;Jump if less than 8
	(mov r6 a)			;Save bitnumber within middle byte
	(call cauc-sh)
	(orl a r3)
	(mov r3 a)
	(jmp cauc-9)

cauc-4	(call cauc-sh)
	(orl a r2)
	(mov r2 a)
;Done with this key, step to next
cauc-9	(inc r5)			;Advance P3 address
	(mov a r4)			;Shift bit mask left 1
	(add a r4)
	(mov r4 a)
	(jnz cauc-1)			;Jump if more bits this word
	(inc r0)			;Advance bitmap address
	(mov a r0)			;See if done
	(add a (/# (- (+ bitmap 20))))
	(jnz cauc-0)			;Jump if more words in bitmap
	(ret)				;Result is in R2,R3

;Produce in A a bit shifted left by amount in R6
cauc-sh	(inc r6)			;Compensate for DJNZ
	(mov a (/# 200))
cauc-sh-1
	(rl a)
	(djnz r6 cauc-sh-1)
	(ret)

;Is request to boot machine if both controls and both metas are held
;down, along with rubout or return.  We have just sent the key-down codes
;for all of those keys.  We now send a boot character, then delay for 3 seconds
;to give the machine time to load microcode and read the character to see whether
;it is a warm or cold boot, before sending any other characters, such as up-codes.
;  meta		45 / 165
;  control	20 / 26
;  rubout	23
;  return	136
; The locking keys are in bytes 1, 3, and 12, conveniently out of the way
;A boot code:
;  15-10	1
;  9-6		0
;  5-0		46 (octal) if cold, 62 (octal) if warm.

check-boot
	(mov r0 (/# 64))		;Check one meta key
	(mov a @r0)
	(xrl a (/# 1_5))
	(jnz not-boot)
	(mov r0 (/# 76))		;Check other meta key
	(mov a @r0)
	(xrl a (/# 1_5))
	(jnz not-boot)
	(mov r0 (/# 62))		;Check byte containing controls and rubout
	(mov a @r0)
	(xrl a (/# (+ 1_0 1_6 1_3)))
	(jz cold-boot)			;Both controls and rubout => cold-boot
	(xrl a (/# 1_3))
	(jnz not-boot)
	(mov r0 (/# 73))		;Check for return
	(mov a @r0)
	(xrl a (/# 1_6))
	(jnz not-boot)
warm-boot
	(mov r2 (/# 62))
	(jmp send-boot)

cold-boot
	(mov r2 (/# 46))
send-boot
	(mov r3 (/# 374))		;1's in bits 15-10
	(mov r4 (/# 371))		;Source ID 1 (new keyboard)
	(call send)			;Transmit character
	(mov r4 (/# 6))			;Delay 3 seconds
boot-delay-1
	(mov r3 (/# 0))			;Delay 1/2 second
boot-delay-2
	(mov r2 (/# 0))			;Delay 2 milliseconds
boot-delay-3
	(djnz r2 boot-delay-3)
	(djnz r3 boot-delay-2)
	(djnz r4 boot-delay-1)
not-boot
	(ret)

;In P3 (1400-1577) we have a table, indexed by key number, of shifting
;keys.  The byte is 200 for ordinary keys, or the bit number in the
;all-keys-up message for locking and shifting keys.
	(= 1400)
	200	;0
	200
	200
	9.	;3 mode lock
	200
	6.	;5 super
	200
	200

	200	;10
	200
	200
	200
	200
	8.	;15 alt lock
	200
	200

	4.	;20 control
	200
	200
	200
	0.	;24 shift
	0.	;25 shift
	4.	;26 control
	200

	200	;30
	200
	200
	200
	200
	1.	;35 greek
	200
	200

	200	;40
	200
	200
	200
	1.	;44 greek
	5.	;45 meta
	200
	200

	200	;50
	200
	200
	200
	200
	200
	200
	200

	200	;60
	200
	200
	200
	200
	6.	;65 super
	200
	200

	200	;70
	200
	200
	200
	200
	200
	200
	200

	200	;100
	200
	200
	200
	2.	;104 top
	200
	200
	200

	200	;110
	200
	200
	200
	200
	10.	;115 repeat
	200
	200

	200	;120
	200
	200
	200
	200
	3.	;125 caps lock
	200
	200

	200	;130
	200
	200
	200
	200
	200
	200
	200

	200	;140
	200
	200
	200
	200
	7.	;145 hyper
	200
	200

	200	;150
	200
	200
	200
	200
	2.	;155 top
	200
	200

	200	;160
	200
	200
	200
	200
	5.	;165 meta
	200
	200

	200	;170
	200
	200
	200
	200
	7.	;175 hyper
	200
	200

	(= 1600)
;Locations 1600-1617 contain a mask which has 1's for bit-map positions
;which contain non-shifting keys.
	327	;3 and 5
	337	;15
	216	;20, 24, 25, 26
	337	;35
	317	;44, 45
	377
	337	;65
	377	;70
	357	;104
	337	;115
	337	;125
	377
	337	;145
	337	;155
	337	;165
	337	;175

	)
'code)

;Look at kbd and print out any characters that come in
(defun test ()
  (let ((tv-more-processing-global-enable nil))
     (do ((ch)) (nil)
       (process-allow-schedule)
       (and (setq ch (si:kbd-tyi-raw-no-hang))
	    (print (ldb 0027 ch))))))

;This version isn't stoppable, because it just gets it right out of the hardware
;Prevents you from getting screwed by call-processing and the like.
(defun supertest ()
  (let ((tv-more-processing-global-enable nil))
     (do ((ch)) (nil)
       (or si:kbd-buffer (si:kbd-get-hardware-char-if-any))
       (and si:kbd-buffer
	    (progn (setq ch si:kbd-buffer si:kbd-buffer nil)
		   (print (ldb 0027 ch)))))))