; PupAl1a.asm -- Pup level 1 assembly code (Alto-specific)
; Assembly routines to facilitate computing Pup checksums
; Plus level 1 utility routines
; Copyright Xerox Corporation 1979, 1980

;	Last modified March 7, 1980  2:23 PM by Taft


.ent PupChecksum
.ent OnesComplementAdd
.ent OnesComplementSubtract
.ent LeftCycle
.ent MultEq
.ent DoubleIncrement
.ent DoubleSubtract
.ent DoubleDifference
.ent HLookup
.ent HInsert
.ent HDelete
.ent HEnumerate

	.srel

PupChecksum:		.PupChecksum
OnesComplementAdd:	.OnesComplementAdd
OnesComplementSubtract:	.OnesComplementSubtract
LeftCycle:		.LeftCycle
MultEq:			.MultEq
DoubleIncrement:	.DoubleIncrement
DoubleSubtract:		.DoubleSubtract
DoubleDifference:	.DoubleDifference
HLookup:		0		;Call0
HInsert:		0		;Call1
HDelete:		0		;Call2
HEnumerate:		0		;Call3

	.nrel


; PupChecksum(pup)
; Computes and returns the ones-complement add-and-cycle checksum
; over the block starting at pup and containing pup!0 bytes.
; Let count = (pup!0-1)/2.  Then
; Timing:  24 + 8.5*(count mod 8) + 42*(count/8) memory cycles
;	  = 1486 cycles for a maximum-length Pup (276 words)

.PupChecksum:
	sta 3 1 2	; Store BCPL return
	mov 0 3		; Put pup address in 3
	lda 1 0 3	; Get Pup length (bytes)
	neg 1 1		; Compute # words -1
	comzr 1 1	;  = (# bytes -1)/2
	movzr 1 0	; Compute count/8
	movzr 0 0
	movzr 0 0
	inc 0 0		; Add 1 since end test is done first
	sta 0 2 2	; Store loop count in frame temp
	lda 0 C7	; Compute (count rem 8)
	and 1 0 snr
	 jmp ELoop8	; Start 8-at-a-time loop if no remainder
	sta 0 3 2  	; Remainder in another frame temp
	sub 0 0		; Init checksum to zero
CLoop1:	lda 1 0 3	; Fetch a word
	addz 1 0 szc	; Ones-complement add
	 inc 0 0	; Carry
	cycle 1		; Left cycle 1
	inc 3 3		; Increment pointer
	dsz 3 2  	; Decrement and test count
	 jmp CLoop1	; Repeat slow loop
	jmp ELoop8	; Done, begin fast loop

; This is the main loop of the add-and-cycle checksum computation.
; It checksums 8 words before incrementing and testing the pointer
; and count.

CLoop8:	lda 1 0 3	; Fetch a word
	addz 1 0 szc	; Ones-complement add
	 inc 0 0	; Carry
	cycle 1		; Left cycle 1

	lda 1 1 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 2 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 3 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 4 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 5 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 6 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 7 3
	addz 1 0 szc
	 inc 0 0
	cycle 1

	lda 1 C10	; Advance pointer to next group of 8
	add 1 3
ELoop8:	dsz 2 2		; Test loop count
	 jmp CLoop8	; Loop

	lda 3 1 2	; Done, prepare to return
	jmp TestM0	; Test for -0 and return

C7:	7
C10:	10

; OnesComplementSubtract(a, b)

.OnesComplementSubtract:
	com 1 1		; Negate b (ones-complement)
			; Fall into OnesComplementAdd

; OnesComplementAdd(a, b)

.OnesComplementAdd:
	addz 1 0 snc	; Add, skip if carry
TestM0:	 inc# 0 0 snr	; No carry, test for -0
	 inc 0 0	; Carry or turn -0 into +0
	jmp 1 3

; LeftCycle(word, count)

.LeftCycle:
	cycle 0		; Left-cycle ac0 by number in ac1
	jmp 1 3


; MultEq(adr1, adr2, nWords) - Multiple word equal predicate.
; Compares the nWords words starting at address adr1 with the ones
; starting at adr2, returns true if equal, false if unequal.
; If nWords is omitted, it is defaulted to 2.

.MultEq:
	sta 0 1 2		; Save adr1 in frame
	sta 1 2 2		; Save adr2 in frame
	lda 0 0 3		; Get number of args in call
	lda 1 c2
	sgt 0 1			; More than 2?
	 sta 1 3 2		; No, default nWords to 2
eqloop:	lda 0 @1 2		; Get word from adr1
	lda 1 @2 2		; Get word from adr2
	se 0 1			; Compare
	 jmp eqfail		; Not equal, return false
	isz 1 2			; Equal, increment adr1
	isz 2 2			; Increment adr2
	dsz 3 2			; Decrement and test word count
	 jmp eqloop		; More words to check
	mkminusone 0 0 skp	; That's all, return true
eqfail:	 mkzero 0 0		; Here to return false
	jmp 1 3			; Return

c2:	2

; DoubleIncrement(adr, offset)
; Add offset to the 32-bit number pointed to by adr.
; If offset is omitted, it is defaulted to 1.
; Offset is treated as a SIGNED 16-bit integer.

.DoubleIncrement:
	sta 3 1 2		; Save return
	mov 0 3			; Pointer to 32-bit number
	lda 0 @1 2		; Get number of args in call
	movzr# 0 0 snr		; Less than 2?
	 mkone 1 1		; Yes, default offset to 1
	movl# 1 1 szc		; Skip if offset positive
	 dsz 0 3		; Negative, effectively extend sign
	  nop
	lda 0 1 3		; Get low 16 bits of number
	addz 1 0 szc		; Add offset
	 isz 0 3		; Carry out, increment high part
	  nop
	sta 0 1 3		; Update low 16 bits
	lda 3 1 2		; Return
	jmp 1 3

; DoubleDifference(adrA, adrB) = 16-bit number
; Returns A-B as a signed 16-bit number, where adrA and adrB point
; to 32-bit numbers A and B.  If A and B differ by more than 2^15,
; the result is 2^15-1 or -2^15 as appropriate.

.DoubleDifference:
	sta 3 1 2		; Save return
	sta 1 2 2		; Save adrB
	mov 1 3			; adrB
	lda 1 1 3		; Get low 16 bits of B
	mov 0 3			; adrA
	lda 0 1 3		; Get low 16 bits of A
	subz 1 0		; Compute low part of A-B
	lda 1 @2 2		; Get high 16 bits of B
	lda 3 0 3		; Get high 16 bits of A
	mov# 0 0 szc		; Test carry from low difference
	 sub 1 3 skp		; No borrow, just compute high A-B
	 adc 1 3		; Borrow first before subtracting
	movl 0 1		; Get sign of low result
	subcl 1 1		; 0 if positive, 1 if negative
	add 3 1 snr		; Test for high = sign extension
	 jmp diffok		; Yes, return the low difference
	movl# 3 3 snc		; Overflow, test sign of result
	 adczr 0 0 skp		; Positive, return +2^35-1
	 subzr 0 0		; Negative, return -2^35
diffok:	lda 3 1 2		; Return
	jmp 1 3


; DoubleSubtract(adrA, adrB)
; Does A _ A-B, where adrA and adrB point to 32-bit numbers A and B

.DoubleSubtract:
	sta 3 1 2		; Save return
	sta 1 2 2		; Save adrB
	mov 1 3			; adrB
	lda 1 1 3		; Get low 16 bits of B
	mov 0 3			; adrA
	lda 0 1 3		; Get low 16 bits of A
	subz 1 0		; Compute low part of A-B
	sta 0 1 3		; Store result back into low A
	lda 0 0 3		; Get high 16 bits of A
	lda 1 @2 2		; Get high 16 bits of B
	mov# 0 0 szc		; Test carry from low difference
	 sub 1 0 skp		; No borrow, just compute high A-B
	 adc 1 0		; Borrow first before subtracting
	sta 0 0 3		; Store result back into high A
	lda 3 1 2		; Return
	jmp 1 3

	.end