.title	life
;+
;
; Life
;
; (John Horton Conway)
;
; Program by John Wilson, 27-Oct-85
;
;-
	.enabl	lc
	.mcall	.print,.ttyout
;
calfip=	emt+0	;hook to file processor
.read=	emt+2	;read a record
opnfq=	2	;func to open a file
.ttnch=	emt+22	;disable echo
.ttddt=	emt+24	;enter ODT mode
.clrfqb=emt+370	;clear out firqb
;
firqb=	402	;file request queue block
xrb=	442	;transfer request block
;
bs=	10	;backspace
lf=	12	;line feed
cr=	15	;carriage return
alt=	33	;escape character, as received from KB
esc=	233	;escape character (high bit set to avoid translation)
;
numrow=	24.	;24 rows/screen
rowlen=	5	;5 words/row (80 bits)
sntim=	10.	;# generations between snapshots (oscillation detection)
;
life:	.clrfqb			;clear the firqb
	movb	#opnfq,firqb+3	;func=open
	movb	#2,firqb+4	;channel 1
	mov	#"KB,firqb+30	;name='KB:'
	mov	#100004,firqb+22 ;MODE 4% (no auto-crlf)
	emt	377
	calfip			;open it
	emt	377
	.ttnch			;disable echo
	.print	#vt52		;put VT100's in VT52 mode
	mov	(pc),snflag	;set snapshot flag
;
restrt:	mov	#env1,src	;set initial ptrs
	mov	#env2,dst
	mov	#rowlen*2+env1,r5 ;ptr
	mov	r5,r4		;copy
	mov	#numrow*rowlen,r3 ;length
10$:	clr	(r4)+		;clear buffer
	sob	r3,10$		;loop
	mov	#100000,r4	;current bit
	.print	#clear		;clear screen
	mov	(pc)+,@(pc)+	;init row, column
	.byte	40,40
	.word	row
	clr	numgen		;generation number
;+
;
; Input editor.
;
;-
input:	jsr	pc,getc		;get a char
	cmpb	r0,#'0		;digit?
	blo	10$		;no
	beq	cellm		;zero, drop a cell
	cmpb	r0,#'9		;hm?
	blos	num		;yes, move
10$:	cmpb	r0,#40		;blank?
	beq	zap		;yes, destructive move
	cmpb	r0,#cr		;car ret?
	beq	crlf		;yes, crlf
	cmp	#alt,r0		;escape sequence?
	bne	input		;no, junk
	jsr	pc,getc		;get another char
	cmp	#alt,r0		;another escape?
	bne	20$		;no
	mov	(pc)+,@(pc)+	;yes, home cursor
	.byte	40,40
	.word	row
	mov	#sntim-1,snpage	;due for another snapshot
	mov	rowlen*2+env1,r0 ;get first word
	com	r0		;make sure SNAP doesn't match
	mov	r0,snap		;whee!
	jmp	gen		;go to it
20$:	bic	#40,r0		;cvt to upper case if lower
	sub	#'A,r0		;arrow key?
	bcs	input		;no
	cmp	r0,#3		;hm?
	bhi	40$		;no
	asl	r0		;yes, cvt to byte offset
	jsr	pc,@30$(r0)	;handle it
	br	input		;loop
30$:	.word	up,down,right,left
40$:	cmp	#'P-'A,r0	;blue key?
	beq	50$		;yes
	cmp	#'Q-'A,r0	;red key?
	bne	input		;no, ignore
	clr	snflag		;no snapshots
	br	input		;loop
50$:	jsr	pc,box		;yes, call box handler
	br	input		;loop
;
cellm:	; drop a cell, move
	bis	r4,(r5)		;set the bit
	.ttyout	#'*		;print a star
	cmpb	col,#rowlen*16.+37 ;did we move?
	beq	input		;no, loop
	incb	col		;yes, bump col
	clc			;clear C
	ror	r4		;move bit
	bcc	input		;no problem, loop
	ror	r4		;move into high bit
	tst	(r5)+		;inc ptr
	br	input		;loop
;
num:	; handle numbers
	sub	#'1,r0		;cvt to [0,8]
	asl	r0		;cvt to byte offset
	jsr	pc,@10$(r0)	;handle it
	br	input		;loop
10$:	.word	dl,down,dr,left,drop,right,ul,up,ur
;
zap:	; kill a cell, move
	bic	r4,(r5)		;set the bit
	.ttyout	#40		;print a space
	cmpb	col,#rowlen*16.+37 ;did we move?
	beq	input		;no, loop
	incb	col		;yes, bump col
	clc			;clear C
	ror	r4		;move bit
	bcc	input		;no problem, loop
	ror	r4		;move into high bit
	tst	(r5)+		;inc ptr
	br	input
;
crlf:	; move to begn of next line
	.ttyout			;print the cr
	movb	col,r0		;get column
	sub	#40,r0		;correct
	bic	#17,r0		;clear out offset in word
	ash	#-3,r0		;cvt to # of bytes from left marg
	sub	r0,r5		;correct
	mov	#100000,r4	;first bit
	movb	#40,col		;fix col
	jsr	pc,getc		;eat the lf (added by RSTS)
	jsr	pc,down		;down a line
	jmp	input
;
dl:	; down and left
	jsr	pc,down		;down a line
	br	left		;left a column
;
down:	; down a row
	cmpb	row,#37+numrow	;at bottom of screen?
	beq	10$		;yes, NOP
	incb	row		;no, down
	.ttyout	#lf		;line feed
	add	#rowlen*2,r5	;inc ptr
10$:	rts	pc
;
dr:	; down and right
	jsr	pc,down		;down a line
	br	right		;right a column
;
left:	; left
	cmpb	col,#40		;at left margin?
	beq	10$		;yes, NOP
	decb	col		;no, left
	.ttyout	#bs		;backspace
	asl	r4		;move bit
	bcc	10$		;not off end, kinky
	rol	r4		;=1
	tst	-(r5)		;back up ptr
10$:	rts	pc
;
drop:	; drop a cell, don't move
	bit	r4,(r5)		;already there?
	bne	10$		;yes, don't bother
	bis	r4,(r5)		;no, set the bit
	.ttyout	#'*		;print a star
	cmpb	col,#rowlen*16.+37 ;need to back up?
	beq	10$		;no
	.ttyout	#bs		;yes, do it
10$:	rts	pc
;
right:	; right a col
	cmpb	col,#rowlen*16.+37 ;at right margin?
	beq	30$		;yes, NOP
	incb	col		;no, fix col
	bit	r4,(r5)		;on a star?
	beq	10$		;no, print a space
	movb	#'*,r0		;print a star
	br	20$		;skip
10$:	movb	#' ,r0		;print a space
20$:	.ttyout			;do it
	clc			;clear C (prolly already clear)
	ror	r4		;move bit right
	bcc	30$		;didn't fall off end, skip
	ror	r4		;=100000 (set high bit)
	tst	(r5)+		;inc ptr
30$:	rts	pc
;
ul:	; up and left
	jsr	pc,up		;go up
	br	left		;and left
;
up:	; up a row
	cmpb	row,#40		;at top of screen?
	beq	10$		;yes, never mind
	decb	row		;no, update
	.print	#goup		;go up a line
	sub	#rowlen*2,r5	;dec ptr
10$:	rts	pc
;
ur:	; up and right
	jsr	pc,up		;go up
	br	right		;and right
;+
;
; Box handler.
;
; Anchor one corner of box to current posn.
;
;-
box:	mov	r4,boxanc	;save bit
	mov	r5,boxanc+2	;and addr
	mov	row,boxanc+4	;and posn
box1:	.ttyout	#'+		;print a corner
	cmpb	col,#rowlen*16.+37 ;need to back up?
	beq	10$		;no
	.ttyout	#bs		;yes, do it
10$:	jsr	pc,getc		;get a char
	cmp	r0,#'0		;zero?
	beq	bagbox		;yes, bag the box
	blos	30$		;not a number, skip
	cmp	r0,#'9		;digit?
	bhi	30$		;no, skip
	sub	#'1,r0		;yes, cvt to [0,8]
	asl	r0		;byte offset
	jsr	pc,@20$(r0)	;call routine
	br	10$		;loop
20$:	.word	boxdl,boxdn,boxdr,boxlf,noop,boxrt,boxul,boxup,boxur
30$:	; handle random commands
	br	10$		;loop
; arrows...
	.word	boxup,boxdn,boxrt,boxlf
;
bagbox:	; bag the box
	cmp	boxanc+4,row	;on anchor?
	beq	40$		;yep, easy
	jsr	pc,zapact	;zap active corner
	movb	col,r3		;save col
	cmpb	r3,boxanc+5	;LLC on active corner?
	beq	20$		;yep, already zapped
	movb	boxanc+5,col	;fix
	cmpb	boxanc+4,row	;on top of anchor?
	beq	10$		;yes, don't zap the '+'
	.print	#dca		;move cursor
	movb	boxanc+4,r0	;get anchor row
	movb	row,r1		;get current row
	sub	r0,r1		;find -<distance to move>
	mul	#rowlen*2,r1	;find # of bytes
	add	boxanc+2,r1	;calc addr
	mov	boxanc,r0	;get bit
	jsr	pc,zapcrn	;zap the corner
10$:	movb	r3,col		;restore
20$:	movb	row,r3		;save row
	cmpb	r3,boxanc+4	;URC on active corner?
	beq	40$		;yes, already zapped
	movb	boxanc+4,row	;fix
	cmpb	boxanc+5,col	;on top of anchor?
	beq	30$		;yes, it'll buy it in just a sec
	.print	#dca		;move cursor
	movb	row,r1		;get current row
	sub	r3,r1		;find distance to anchor
	mul	#rowlen*2,r1	;find # of bytes
	add	r5,r1		;calc addr
	mov	r4,r0		;get bit
	jsr	pc,zapcrn	;zap the corner
30$:	movb	r3,row		;restore
40$:	mov	boxanc,r4	;get bit of anchored corner
	mov	boxanc+2,r5	;address
	mov	boxanc+4,row	;cursor posn
	.print	#dca		;move cursor
	jsr	pc,zapact	;zap it
	beq	50$		;at right marg
	.ttyout	#bs		;back up (^H)
50$:	rts	pc
;
boxdl:	; down and left
	cmpb	col,#40		;at left marg?
	beq	boxdn		;yes, just go down
	cmpb	row,#numrow+37	;at bottom of screen?
	bne	1$		;no
	jmp	boxlf		;yes, just go left
1$:	jsr	pc,llcd		;lower left corner down a line
	jsr	pc,urcl		;upper right left a column
	jsr	pc,corner	;on another corner?
	beq	10$		;yes, don't zap
	.print	#dca		;move
	jsr	pc,zapact	;zap the corner
	jsr	pc,boxd		;update ptr
	jsr	pc,boxl		;update
	mov	#40$+1,r0	;point at bs,lf
	cmpb	col,#rowlen*16.+36 ;at right marg?
	sbc	r0		;add another ^H if not
	.print			;either way, print it
	br	20$		;skip
10$:	jsr	pc,boxd		;update
	jsr	pc,boxl
	.print	#dca		;move
20$:	.ttyout	#'+		;new +
	cmpb	col,#rowlen*16.+37 ;right marg?
	beq	30$		;yes, no ^H
	.ttyout	#bs
30$:	rts	pc
40$:	.byte	bs,bs,lf,200	;back two cols, down a row
;
boxdn:	; down a row
	cmpb	row,#numrow+37	;at bottom of screen?
	beq	40$		;yes, NOP
	jsr	pc,llcd		;LLC down a row
	jsr	pc,corner	;on another corner?
	beq	20$		;yes, don't zap
	.print	#dca		;move
	jsr	pc,zapact	;cover up the '+'
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	10$		;yes, no ^H needed
	.ttyout	#bs		;back up a col
10$:	.ttyout	#lf		;line feed
	jsr	pc,boxd		;update ptr
	br	30$		;skip
20$:	jsr	pc,boxd		;update
	.print	#dca		;move cursor
30$:	.ttyout	#'+		;'+'
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	40$		;yes, no ^H needed
	.ttyout	#bs		;move cursor
40$:	rts	pc
;
boxdr:	; down and right
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	boxdn		;yes, just move down
	cmpb	row,#numrow+37	;at bottom of screen?
	beq	boxrt		;yes, just move right
	jsr	pc,llcd		;LLC down a line
	jsr	pc,urcr		;URC right a col
	jsr	pc,corner	;on a corner?
	beq	10$		;yes, don't zap
	.print	#dca		;print
	jsr	pc,zapact	;zap the corner
	jsr	pc,boxd		;fix ptr
	jsr	pc,boxr
	.ttyout	#lf		;down a line
	br	20$		;skip
10$:	jsr	pc,boxd		;move
	jsr	pc,boxr
	.print	#dca		;place cursor
20$:	.ttyout	#'+		;print +
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	30$		;yes, no ^H
	.ttyout	#bs		;move cursor
30$:	rts	pc
;
boxlf:	; left
	cmpb	col,#40		;at left margin?
	beq	noop		;yes, NOP
	jsr	pc,urcl		;move corner
	decb	col		;back up
	.print	#dca		;move cursor
	incb	col		;correct
	.ttyout	#'+		;print new +
	jsr	pc,corner	;on another corner?
	bne	10$		;no, skip
	cmpb	col,#rowlen*16.+37 ;right marg?
	beq	30$		;yes, good
	br	20$		;no, ^H
10$:	jsr	pc,zapact	;zap old +
	beq	20$		;at right marg
	.ttyout	#bs		;back up
20$:	.ttyout	#bs		;twice
30$:	jsr	pc,boxl		;fix ptr
noop:	rts	pc
;
boxrt:	; right a col
	cmpb	col,#rowlen*16.+37 ;at right margin?
	beq	30$		;yes, NOP
	jsr	pc,urcr		;move corner
	jsr	pc,corner	;on another corner?
	beq	10$		;yes
	.print	#dca		;replace
	jsr	pc,zapact	;zap
	jsr	pc,boxr		;fix ptr
	br	20$		;skip
10$:	jsr	pc,boxr		;move ptr
	.print	#dca		;move cursor
20$:	.ttyout	#'+		;new +
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	30$		;yes, no need for ^H
	.ttyout	#bs		;move cursor
30$:	rts	pc
;
boxul:	; up and left
	cmpb	col,#40		;at left marg?
	beq	boxup		;yes, just go up
	cmpb	row,#40		;at top of screen?
	beq	boxlf		;yes, just go left
	jsr	pc,llcu		;LLC up a row
	jsr	pc,urcl		;URC left a col
	jsr	pc,corner	;on another corner?
	beq	10$		;yes, don't zap old +
	.print	#dca		;move cursor
	jsr	pc,zapact	;zap old +
10$:	jsr	pc,boxu		;fix ptrs
	jsr	pc,boxl
	.print	#dca		;move
	.print	#plusbs		;print new +
	rts	pc	
;
boxup:	; up a row
	cmpb	row,#40		;at top of screen?
	beq	20$		;yes, never mind
	jsr	pc,llcu		;LLC up a row
	jsr	pc,corner	;on another corner?
	beq	10$		;yes, don't zap old +
	.print	#dca		;move
	jsr	pc,zapact	;zap old +
10$:	jsr	pc,boxu		;move ptrs
	.print	#dca		;move
	.ttyout	#'+		;new +
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	20$		;yes, no ^H
	.ttyout	#bs		;back up
20$:	rts	pc
;
boxur:	; up and right
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	boxup		;yes, just go up
	cmpb	row,#40		;at top of screen?
	beq	boxrt		;yes, just go left
	jsr	pc,llcu		;LLC up a row
	jsr	pc,urcr		;URC right a col
	jsr	pc,corner	;on another corner?
	beq	10$		;yes, don't zap old +
	.print	#dca		;move cursor
	jsr	pc,zapact	;zap old +
	jsr	pc,boxu		;fix ptrs
	jsr	pc,boxr
	.print	#goup		;move cursor
	br	20$		;skip
10$:	jsr	pc,boxu		;move
	jsr	pc,boxr
	.print	#dca		;place cursor
20$:	.ttyout	#'+		;print new +
	cmpb	col,#rowlen*16.+37 ;at right marg?
	beq	30$		;yes, cursor didn't move
	.ttyout	#bs		;move cursor
30$:	rts	pc	
;
llcu:	; lower left corner up a line
	cmpb	row,#40		;at top of screen?
	beq	60$		;yes, NOP
	movb	col,r3		;save col
	movb	boxanc+5,col	;fix
	cmpb	boxanc+4,row	;on top of anchor?
	beq	30$		;yes, don't zap the '+'
	.print	#dca		;move cursor
	movb	boxanc+4,r0	;get anchor row
	movb	row,r1		;get current row
	sub	r0,r1		;find -<distance to move>
	mul	#rowlen*2,r1	;find # of bytes
	add	boxanc+2,r1	;calc addr
	mov	boxanc,r0	;get bit
	jsr	pc,zapcrn	;zap the corner
	beq	20$		;skip if at right margin
	.ttyout	#bs		;back up
20$:	movb	row,r0		;get row
	dec	r0		;add 1
	cmpb	r0,boxanc+4	;is the anchor there?
	beq	50$		;yes, so we don't need a new '+'
	.print	#goup		;move down a row
	br	40$		;skip
30$:	decb	row		;down a line
	.print	#dca		;move the cursor
	incb	row		;correct
40$:	.ttyout	#'+		;mark new posn
50$:	movb	r3,col		;replace col
60$:	rts	pc
;
llcd:	; lower left corner down a line
	cmpb	row,#37+numrow	;at bottom of screen?
	beq	60$		;yes, NOP
	movb	col,r3		;save col
	movb	boxanc+5,col	;fix
	cmpb	boxanc+4,row	;on top of anchor?
	beq	30$		;yes, don't zap the '+'
	.print	#dca		;move cursor
	movb	boxanc+4,r0	;get anchor row
	movb	row,r1		;get current row
	sub	r0,r1		;find -<distance to move>
	mul	#rowlen*2,r1	;find # of bytes
	add	boxanc+2,r1	;calc addr
	mov	boxanc,r0	;get bit
	jsr	pc,zapcrn	;zap the corner
	beq	20$		;skip if at right margin
	.ttyout	#bs		;back up
20$:	movb	row,r0		;get row
	inc	r0		;add 1
	cmpb	r0,boxanc+4	;is the anchor there?
	beq	50$		;yes, so we don't need a new '+'
	.ttyout	#lf		;move down a row
	br	40$		;skip
30$:	incb	row		;down a line
	.print	#dca		;move the cursor
	decb	row		;correct
40$:	.ttyout	#'+		;mark new posn
50$:	movb	r3,col		;replace col
60$:	rts	pc
;
urcr:	; upper right corner right a col
	movb	row,r3		;save row
	movb	boxanc+4,row	;fix
	cmpb	boxanc+5,col	;on top of anchor?
	beq	10$		;yes, don't zap the '+'
	.print	#dca		;move cursor
	movb	row,r1		;get current row
	sub	r3,r1		;find distance to anchor
	mul	#rowlen*2,r1	;find # of bytes
	add	r5,r1		;calc addr
	mov	r4,r0		;get bit
	jsr	pc,zapcrn	;zap the corner
	movb	col,r0		;get col
	inc	r0		;add 1
	cmpb	r0,boxanc+5	;is the anchor there?
	beq	30$		;yes, so we don't need a new '+'
	br	20$		;skip
10$:	incb	col		;over a col
	.print	#dca		;move the cursor
	decb	col		;correct
20$:	.ttyout	#'+		;mark new posn
30$:	movb	r3,row		;replace row
	rts	pc
;
urcl:	; upper right corner left a col
	movb	row,r3		;save row
	movb	boxanc+4,row	;fix
	decb	col		;fix column
	.print	#dca		;move cursor
	.ttyout	#'+		;put in new +
	incb	col		;correct
	cmpb	boxanc+5,col	;on top of anchor?
	beq	10$		;yes, don't zap the '+'
	movb	row,r1		;get current row
	sub	r3,r1		;find distance to anchor
	mul	#rowlen*2,r1	;find # of bytes
	add	r5,r1		;calc addr
	mov	r4,r0		;get bit
	jsr	pc,zapcrn	;zap the corner
10$:	movb	r3,row		;replace row
	rts	pc
;
zapact:	; zap active corner
	mov	r4,r0		;get bit
	mov	r5,r1		;get addr
	;br	zapcrn		;do it, return
;
zapcrn:	; zap corner (bit in r0, addr in r1)
	bit	r0,(r1)		;is there a cell there?
	beq	10$		;no
	movb	#'*,r0		;yes
	br	20$		;skip
10$:	movb	#' ,r0		;blank
20$:	.ttyout			;yep
	cmpb	col,#rowlen*16.+37 ;did the cursor move?
	rts	pc		;(flags set)
;
boxu:	; up
	sub	#rowlen*2,r5	;fix ptr
	decb	row		;yep
	rts	pc
;
boxd:	; down
	add	#rowlen*2,r5	;fix ptr
	incb	row		;yep
	rts	pc
;
boxl:	; left
	decb	col		;move cursor
	asl	r4		;move bit
	bcc	10$		;skip
	rol	r4		;=1
	tst	-(r5)		;dec ptr
10$:	rts	pc
;
boxr:	; right
	incb	col		;move cursor
	clc			;no randomness
	ror	r4		;move bit
	bcc	10$		;skip
	ror	r4		;=100000
	tst	(r5)+		;inc ptr
10$:	rts	pc
;
corner:	; set Z if active corner is on another corner
	cmpb	row,boxanc+4	;on upper right?
	beq	10$		;yes
	cmpb	col,boxanc+5	;on lower left?
10$:	rts	pc
;+
;
; Drag mode.
;
;-
drag:	jsr	pc,getc		;get a char
	cmpb	r0,#'0		;zero?
	beq	30$		;yes, back to box
	blo	20$		;not a digit
	cmpb	r0,#'9		;eh?
	bhi	20$		;nope
	sub	#'1,r0		;cvt to [0,8]
	asl	r0		;byte offset
	jsr	pc,@10$(r0)	;call routine
	br	drag		;loop
10$:	;.word	ddl,ddn,ddr,dlf,noop,drt,dul,dup,dur
20$:	cmpb	r0,#alt		;escape?
	bne	drag		;no
; ... check for arrow keys ... later
	br	drag		;NOP
30$:	rts	pc		;return to box mode
;
ddl:	; down and left
	cmpb	boxanc+5,#40	;at left marg?
;	beq	ddn		;yes, just go down
	cmpb	row,#numrow+37	;at bottom?
;	beq	dlf		;yes, just go left

;+
;
; Rotate the box left one place.
; Enter with r5 and r4 pointing at the curr loc.
;
;-
;dleft:	tst	rowoff		;nonzero height?
;	beq	...		;no
;	cmpb	col,boxanc+5	;nonzero width?
;	beq	...		;no
;regs:
;src,src
;dst,dst
;loopcnt



90$:	bic	r2,(r3)		;clear a space if not already clear
	bit	r4,(r5)		;what should go there?
	beq	100$		;nothing, skip
	bis	r2,(r3)		;set it
100$:	clc
	ror	r2		;whassup?
	bcc	110$		;nothing
	ror	r2		;=100000
	tst	(r3)+		;bump ptr
110$:	ror	r4		;eh?
	bcc	120$		;still within word
	ror	r4		;=100000
	tst	(r5)+		;skip
120$:	bic	r2,(r3)		;clear right end
	sob	r1,90$		;do entire row
;	add	#rowlen*2,... ptr





;+
;
; Compute next generation.
;
;-
gen:	mov	dst,ptr		;copy pointer
	add	#rowlen*2,ptr	;correct
	mov	src,r0		;point at source world (dummy row)
	mov	r0,r1		;copy
	add	#rowlen*2,r1	;current row
	mov	r1,r2
	add	#rowlen*2,r2	;next row
	mov	#numrow,r5	;# of rows
10$:	mov	r5,-(sp)	;save
	mov	#buf,r5		;point at buffer
	mov	#rowlen,r4	;# of words/row
20$:	mov	r4,-(sp)	;save
	mov	(r2)+,r3	;get word
	mov	r2,-(sp)	;save
	mov	(r1)+,r2
	mov	r1,-(sp)
	mov	(r0)+,r1
	mov	r0,-(sp)
	mov	#16.,r0		;# bits/word
30$:	clr	r4		;init
	rol	r1		;count bits
	adc	r4
	rol	r2
	adc	r4
	rol	r3
	adc	r4
	mov	r4,(r5)+	;put in buffer
	sob	r0,30$		;loop
	mov	(sp)+,r0	;restore
	mov	(sp)+,r1
	mov	(sp)+,r2
	mov	(sp)+,r4
	sob	r4,20$		;do whole row
	mov	#buf,r5		;point at neighbor list
	sub	#rowlen*2,r1	;pt at begn of row
	mov	r0,-(sp)	;save
	mov	r2,-(sp)
	mov	#rowlen,r0	;length of row
40$:	mov	r0,-(sp)	;save loop count
	mov	(r1)+,r2	;get a word
	mov	#16.,r4		;bits/word
50$:	mov	-2(r5),r0	;get # of neighbors to left
	add	(r5)+,r0	;add current batch
	add	(r5),r0		;and next batch
	cmp	r0,#3		;3 neighbors, or 2+alive?
	beq	70$		;yep, start a cell
	tst	r2		;alive?
	bpl	60$		;no
	cmp	r0,#4		;yes, 3 neighbors?
	beq	70$		;yep (C=0)
60$:	sec			;set the bit
70$:	rol	r3		;rotate it in
	asl	r2		;move
	sob	r4,50$		;loop
	com	r3		;flip
	mov	r3,@ptr		;poke
	add	#2,ptr		;inc
	mov	(sp)+,r0	;get loop index
	sob	r0,40$		;do whole row
	mov	(sp)+,r2	;restore
	mov	(sp)+,r0
	mov	(sp)+,r5	;restore
	dec	r5		;done?
	bne	10$		;do all rows
;
	jsr	pc,upd		;update
;
	mov	dst,r0		;swap
	mov	src,dst
	mov	r0,src
; see if we have stopped changing...
stoppd:	tst	snflag		;taking snapshots?
	beq	80$		;nope
	inc	numgen		;bump generation #
	tst	nzero		;dead?
	beq	20$		;yep
	inc	snpage		;age of snapshot
	add	#rowlen*2,r0	;skip border
	mov	#snap,r1	;snapshot
	mov	#numrow*rowlen,r2 ;number of words
10$:	cmp	(r0)+,(r1)+	;same?
	bne	60$		;no, skip
	sob	r2,10$		;loop
; we've been here before...
20$:	.print	#line24		;go to line 24
	tst	nzero		;dead?
	beq	40$		;yes
	cmp	snpage,#1	;how old is the snapshot?
	bne	30$		;more than one generation, skip
	.print	#static		;one gen, we weren't changing
	br	50$		;skip
30$:	.print	#osc		;oscillating
	mov	snpage,r0	;get age
	jsr	pc,prnum	;print it
	br	50$		;skip
40$:	.print	#dead		;dead!
50$:	.print	#atgen		;' at generation number '
	mov	numgen,r0	;get it
	jsr	pc,prnum	;print
	jsr	pc,getc		;get a char
	jmp	restrt		;start all over
60$:	cmp	snpage,#sntim	;time for a new snapshot?
	blo	80$		;nope, skip
	mov	src,r0		;yep, get source
	add	#rowlen*2,r0	;skip border
	mov	#snap,r1	;dest
	mov	#numrow*rowlen,r2 ;length
70$:	mov	(r0)+,(r1)+	;copy a word
	sob	r2,70$		;loop
	clr	snpage		;brand new
80$:	jmp	gen		;loop
;+
;
; Return next character from KB: in r0.
;
;-
getc:	emt	377
	.ttddt			;no delimiters
	mov	#xrb,r0		;pt at xrb
	mov	#1,(r0)+	;COUNT 1%
	clr	(r0)+		;nothing read yet
	mov	#cbuf,(r0)+	;buffer
	mov	#2,(r0)+	;channel 1
	clr	(r0)+		;next block
	clr	(r0)+		;indefinite wait
	clr	(r0)		;RECORD 0%
	emt	377
	.read
	movb	cbuf,r0
	rts	pc
;+
;
; Print number in r0 (unsigned).
;
;-
prnum:	mov	#move+5,r5	;point at buffer
10$:	mov	r0,r1		;copy
	clr	r0		;zero-extend
	div	#10.,r0		;/10
	add	#'0,r1		;cvt rem to ascii
	movb	r1,-(r5)	;put in buffer
	tst	r0		;done?
	bne	10$		;loop if not
	mov	r5,r0		;copy ptr
	.print			;print the num
	rts	pc
;+
;
; Update the screen (currently in SRC)
; to match DST.
;
;-
upd:	clr	nzero		;assume it's zero
	mov	src,r5		;point at current screen
	add	#rowlen*2,r5	;skip over border
	mov	dst,r4		;point at what we want
	add	#rowlen*2,r4	;...
	mov	#100000,r3	;bit under consideration
	movb	#40,row1	;start of screen
	mov	#numrow,-(sp)	;loop ptr
10$:	movb	#40,col1	;starting a row
	mov	#rowlen,-(sp)	;# words/row
20$:	mov	(r5),r2		;get current word
	mov	(r4),r0		;get what we want
	beq	30$		;skip if zero
	mov	(pc),nzero	;non-zero
30$:	xor	r0,r2		;find the difference
	beq	230$		;no difference, don't waste time
40$:	bit	r3,r2		;has this bit changed?
	beq	220$		;no, skip
	movb	row1,r1		;get the row we want
	movb	row,r0		;get current row
	sub	r0,r1		;find the difference
	mov	#move,r0	;ptr to buffer
	tst	r1		;whassup?
	beq	70$		;already there, hip
	bmi	60$		;need to move up
	cmp	r1,#3		;3 or less?
	bhi	180$		;no, not worth it
50$:	movb	#lf,(r0)+	;yes, do it
	sob	r1,50$		;yep.
	br	70$		;skip
60$:	cmp	r1,#-1		;one line?
	bne	180$		;no, use DCA
	mov	#esc+<'A*400>,(r0)+ ;yes, '$A'
70$:	mov	r0,-(sp)	;copy ptr
	sub	#move,(sp)	;find length of string
	movb	col,r1		;get curr col
	mov	r1,-(sp)	;save
	movb	col1,r1		;get desired col
	sub	(sp)+,r1	;find difference
	beq	160$		;already there, yahoo!
	bcs	140$		;have to back up
	add	r1,(sp)		;find total # of chars
	cmp	(sp)+,#4	;4 or more?
	bhis	180$		;yes, use DCA
	mov	r1,-(sp)	;no, save col count
80$:	asl	r3		;move bit left
	bcc	90$		;skip if not off end of word
	rol	r3		;back in right end
	tst	-(r4)		;back up ptr
90$:	sob	r1,80$		;loop
	mov	(sp)+,r1	;get count back
100$:	bit	r3,(r4)		;set or clear?
	beq	110$		;clear
	movb	#'*,(r0)+	;set
	br	120$		;skip
110$:	movb	#' ,(r0)+	;clear
120$:	ror	r3		;move bit (C is already clear)
	bcc	130$		;skip
	ror	r3		;back in left end
	tst	(r4)+		;inc ptr
130$:	sob	r1,100$		;loop
	br	170$		;go to it!
140$:	; back up
	neg	r1		;make positive
	add	r1,(sp)		;find total # of chars
	cmp	(sp)+,#4	;4 or more?
	bhis	180$		;yes, use DCA
150$:	movb	#bs,(r0)+	;put in buffer
	sob	r1,150$		;loop
	br	170$		;skip
160$:	tst	(sp)+		;clear stack
170$:	; print stored string
	cmp	r0,#move	;did we move?
	beq	190$		;no, skip
	movb	#200,(r0)	;mark end for .print
	.print	#move		;whee!
	mov	row1,row	;update
	br	190$		;skip
180$:	; use direct cursor addressing
	mov	row1,row	;update
	.print	#dca		;move cursor
190$:	bit	r3,(r4)		;what goes here?
	beq	200$		;a space
	movb	#'*,r0		;a cell
	br	210$		;skip
200$:	movb	#' ,r0		;blank
210$:	.ttyout			;print it
	cmpb	col,#rowlen*16.+37 ;did the cursor move?
	adcb	col		;update if so
220$:	; continue here
	incb	col1		;bump column
	clc			;clear C
	ror	r3		;move the bit
	bcc	40$		;loop
	ror	r3		;back in through high end
	br	240$		;skip
230$:	add	#10000,row1	;advance 16 columns
240$:	tst	(r4)+		;inc ptrs
	tst	(r5)+
	dec	(sp)		;finished row?
	bne	20$		;loop if not
	tst	(sp)+		;clear stack
	incb	row1		;move to next line
	dec	(sp)		;finished screen?
	beq	250$		;skip if so
	jmp	10$		;loop if not
250$:	tst	(sp)+		;clear stack
	rts	pc
;
numgen:	.word			;current generation number
;
src:	.word			;ptr to source environment
dst:	.word			;destination
ptr:	.word			;pointer
;
nzero:	.word			;set by UPD if DST is alive
snpage:	.word			;age of last SNAPshot
snflag:	.word			;if zero, don't do snapshots
;
boxanc:	.blkw	3		;anchored corner of box (bit, addr, posn)
;
	.word	0		;border
buf:	.blkw	16.*rowlen	;1 word/bit
	.word	0
;
env1:	.blkw	numrow+2*rowlen	;buffers
env2:	.blkw	numrow+2*rowlen
snap:	.blkw	numrow*rowlen	;snapshot buffer
;
dca:	.ascii	<esc>'Y'	;VT52 direct cursor addressing
row:	.byte			;current row on screen +37
col:	.byte			;same as above, column
char:	.byte	200
	.byte	200
;
row1:	.byte			;row, column (+37) under consideration
col1:	.byte
;
move:	.blkb	5		;buffer for relative cursor movement
	.byte	200		;(used by PRNUM)
;
vt52:	.ascii	<esc>'[?2l'<esc>'\'<200> ;VT52 mode for VT100
clear:	.ascii	<esc>'>'<esc>'H'<esc>'J'<200> ;VT setup
;
goup:	.ascii	<esc>'A'<200>	;up a line (VT52)
;
plusbs:	.ascii	'+'<bs><200>	;plus, backspace
;
line24:	.ascii	<esc>'Y7 '<200>	;move to line 24
static:	.ascii	'Static'<200>
osc:	.ascii	'Oscillating with period '<200>
dead:	.ascii	'Dead'<200>
atgen:	.ascii	' at generation number '<200>
;
cbuf:	.byte			;char buffer for getc
;
	.even
;
	.end	life