; DDTapeUtilA.asm
; Copyright Xerox Corporation 1981
; Last modified by Tim Diebert,  February 12, 1981  4:15 PM

.ent UBlockEq
.ent BlockEq
.ent UPupChecksum
.ent AsciiXlate
.ent EbcdicXlate
.ent TapeTfsSwatProc

.bext DDTapeVertIntCode
.bext DDTapeVertIntFlag

	.srel
DDTapeVertIntCode:	.DDTapeVertIntCode
DDTapeVertIntFlag:	0
UBlockEq:	.UBlockEq
BlockEq:	.BlockEq
UPupChecksum:	.UPupChecksum
AsciiXlate: .AsciiXlate
EbcdicXlate: .EbcdicXlate
TapeTfsSwatProc: .TapeTfsSwatProc

	.zrel

.tabA:	Atab
.tabE:	Etab
.point:	0
.len:	0

	.nrel

; DDTapeVertIntCode
; Sets DDTapeVertIntFlag on vertical interupt

.DDTapeVertIntCode:
	sta 0 A0
	adc 0 0	; make true 
	sta 0 @lvVertIntFlag
	lda 0 A0
	bri

A0:	0
lvVertIntFlag: DDTapeVertIntFlag


; UBlockEq(adr1,adr2,count) - Microcode version
; Compare the count words starting at adr1 with the corresponding
; words starting at adr2, and return true iff all the corresponding
; words are equal.

.UBlockEq:
	sta 3 1,2
	lda 3 3,2		; get count
	63000			; call microcode
	mov 3 3 szr		; ac3 = 0 if all is well
	sub 0 0 skp
	 adc 0 0
	lda 3 1,2
	jmp 1,3

; BlockEq(adr1,adr2,count) - Assembly language version
; Compare the count words starting at adr1 with the corresponding
; words starting at adr2, and return true iff all the corresponding
; words are equal.

.BlockEq:
	sta 3 1,2
	sta 0 2,2		; Store adr1
	mov 1 3			; ac3 ← adr2

; Compare the first (count mod 8) words one at a time
bleq1:	lda 0 3,2		; See if count mod 8 = 0
	lda 1 c7
	and# 0 1 snr
	 jmp bleq2		; Yes, go to fast loop
	lda 0 @2,2		; No, do slow compare of one word
	lda 1 0,3
	se 0 1
	 jmp bleq5		; Not equal, return false
	isz 2 2			; Equal, increment addresses
	inc 3 3
	dsz 3,2			; Decrement and test count
	 jmp bleq1

; Set up for fast loop
bleq2:	lda 0 3,2		; Compute count/8
	movzr 0 0
	movzr 0 0
	movzr 0 0 snr
	 jmp bleq4		; Less than 8 words in block
	sta 0 3,2		; Store count/8
	lda 0 2,2		; Get current adr1

; Fast loop.  ac0/ adr1, ac3/ adr2, count in frame temp 3.
; The portion inside dir...eir is non-reentrant due to the use
; of save2.
bleq3:	dir			; Interlock non-reentrant portion
	sta 2 save2		; Save frame pointer
	mov 0 2			; ac2 ← adr1

	lda 0 0,2		; Compare 8 words, to bleq6 if fail
	lda 1 0,3
	se 0 1
	 jmp bleq6

	lda 0 1,2
	lda 1 1,3
	se 0 1
	 jmp bleq6

	lda 0 2,2
	lda 1 2,3
	se 0 1
	 jmp bleq6

	lda 0 3,2
	lda 1 3,3
	se 0 1
	 jmp bleq6

	lda 0 4,2
	lda 1 4,3
	se 0 1
	 jmp bleq6

	lda 0 5,2
	lda 1 5,3
	se 0 1
	 jmp bleq6

	lda 0 6,2
	lda 1 6,3
	se 0 1
	 jmp bleq6

	lda 0 7,2
	lda 1 7,3
	se 0 1
	 jmp bleq6

	lda 0 c10
	add 0 3			; Increment adr2 by 8
	add 2 0			; Increment adr1 by 8, move to ac0
	lda 2 save2		; Recover frame pointer
	eir			; Now reentrant
	dsz 3,2			; Decrement and test count
	 jmp bleq3		; More to do

bleq4:	mkminusone 0 0 skp	; Here to return true
bleq5:	 mkzero 0 0		; Here to return false
	lda 3 1,2
	jmp 1,3

bleq6:	lda 2 save2		; Here to return false when
	eir			;  inside fast loop
	jmp bleq5

c7:	7
c10:	10
save2:	0

; PupChecksum microcode interface
; microcoded replacement for PupChecksum procedure in PupAl1a.asm

.UPupChecksum:
	sta 3 1,2
	mov 0 1			; address in AC1 for microcode
	mov 0 3
	lda 3 0,3		; get pup length in bytes
	neg 3 3			; compute # words exclusive of checksum
	comzr 3 3		;  = (# bytes -1)/2
	mkzero 0 0		; init checksum
	63400			; call microcode
	lda 3 1,2
	jmp 1,3
	


; translates the buffer pointed to by the first parm in place, two bytes per word
; second parameter is buffer length
; two 8-bit EBCDIC bytes of the argument (word packed)
; into two 7-bit ASCII bytes (word packed).  ** NON REENTRANT **	

; AsciiXlate(buffer, len)

.AsciiXlate:
	sta 3 1 2		;save away ac3 in BCPL provided rat-hole
	sta	0 .point	;arg1 arg represents the buffer pointer
	sta 1 .len		;arg2 represents the buffer length
	mov 1 1 snr	;skip if length is non-zero
	jmp axend		;length is zero, quit
axloop:
	lda 0 @.point	;get first (nth) word in ac0
	movs 0 1		;move (while swapping) ac0 (wordArg) to ac1
	lda 3 .MaskA	;load 8-bit mask value
	and 3 0		;mask low byte
	and 3 1		;mask high byte
	lda 3 .tabA	;table base
	add 0 3		;add offset in ac3
	lda 0 0 3		;translated char in ac0
	lda 3 .tabA	;table base
	add 1 3		;add offset in ac3
	lda 1 0 3		;translated char in ac1
	movs 1 1		;swap it into the high byte
	add 1 0		;OR together
	sta 0 @.point	;and put it back
;
	isz .point		;bump the pointer (should never skip, unless pointer = 0)
	dsz .len		;decrement remaining word count, skip if zero (done)
	jmp axloop	;not done, do some more
axend:
	lda 3 1 2		;restore original value of ac3
	jmp 1 3		;return to the caller

.MaskA: #377
Atab:
000.	; nul
001.	; soh
002.	; stx
003.	; etx
004.	; eot
009.	; ht
006.	; ack
007.	; bel
008.	; bs
005.	; enq
021.	; nak
011.	; vt
012.	; ff
013.	; cr
014.	; so
015.	; si
;
016.	; dle
017.	; dc one
018.	; dc two
019.	; dc three
020.	; dc four
010.	; lf
022.	; syn
023.	; etb
024.	; can
025.	; em
026.	; sub
027.	; esc
028.	; fs
029.	; gs
030.	; rs
031.	; us
;
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
032.	; sp
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
096.	; cent sign	// becomes an accent grave
046.	; period
060.	; <
040.	; (
043.	; +
124.	; |
;
038.	; &
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
033.	; !
036.	; $
042.	; *
041.	; )
059.	; ;
126.	; not sign	// becomes a ~ (tilde)
;
045.	; -
047.	; slash
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
094.	; circumflex ↑
044.	; ,
037.	; %
095.	; underscore
062.	; >
063.	; ?
;
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
058.	; :
035.	; #
064.	; @
039.	; '
061.	; =
034.	; "
;
000.	;null
097.	; a
098.	; b
099.	; c
100.	; d
101.	; e
102.	; f
103.	; g
104.	; h
105.	; i
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
106.	; j
107.	; k
108.	; l
109.	; m
110.	; n
111.	; o
112.	; p
113.	; q
114.	; r
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
000.	;null
115.	; s
116.	; t
117.	; u
118.	; v
119.	; w
120.	; x
121.	; y
122.	; z
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
092.	; back slash \
123.	; left curly bracket {
125.	; right curly bracket }
091.	; left square bracket [
093.	; right square bracket ]
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
065.	; A
066.	; B
067.	; C
068.	; D
069.	; E
070.	; F
071.	; G
072.	; H
073.	; I
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
074.	; J
075.	; K
076.	; L
077.	; M
078.	; N
079.	; O
080.	; P
081.	; Q
082.	; R
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
000.	;null
000.	;null
083.	; S
084.	; T
085.	; U
086.	; V
087.	; W
088.	; X
089.	; Y
090.	; Z
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
;
048.	; zero
049.	; one
050.	; two
051.	; three
052.	; four
053.	; five
054.	; six
055.	; seven
056.	; eight
057.	; nine
000.	;null
000.	;null
000.	;null
000.	;null
000.	;null
127.	; del


; EbcdicXlate.asm -- Assembly code to translate INTO EBCDIC

; translates the two 7-bit ASCII bytes of the argument (word packed)
; into two 8-bit EBCDIC bytes (word packed).  ** NON REENTRANT **	

; EbcdicXlate(wordArg,length)

.EbcdicXlate:
	sta 3 1 2		;save away ac3 in BCPL provided rat-hole
	sta	0 .point	;arg1 arg represents the buffer pointer
	sta 1 .len		;arg2 represents the buffer length
	mov 1 1 snr	;skip if length is non-zero
	jmp exend		;length is zero, quit
exloop:
	lda 0 @.point	;get first (nth) word in ac0
	movs 0 1		;move (while swapping) ac0 (wordArg) to ac1
	lda 3 .MaskE	;load 7-bit mask value
	and 3 0		;mask low byte
	and 3 1		;mask high byte
	lda 3 .tabE	;table base
	add 0 3		;add offset in ac3
	lda 0 0 3		;translated char in ac0
	lda 3 .tabE	;table base
	add 1 3		;add offset in ac3
	lda 1 0 3		;translated char in ac1
	movs 1 1		;swap it into the high byte
	add 1 0		;OR together
	sta 0 @.point	;and put it back
;
	isz .point		;bump the pointer (should never skip, unless pointer = 0)
	dsz .len		;decrement remaining word count, skip if zero (done)
	jmp exloop	;not done, do some more
exend:
	lda 3 1 2		;restore original value of ac3
	jmp 1 3		;return to the caller

.MaskE: #177
Etab:
0.
1.
2.
3.
4.
9.
6.
7.
8.
5.
21.
11.
12.
13.
14.
15.
;
16.
17.
18.
19.
20.
10.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
;
64.
90.
127.
123.
91.
108.
80.
125.
77.
93.
92.
78.
107.
96.
75.
97.
;
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
122.
94.
76.
126.
110.
111.
;
124.
193.
194.
195.
196.
197.
198.
199.
200.
201.
209.
210.
211.
212.
213.
214.
;
215.
216.
217.
226.
227.
228.
229.
230.
231.
232.
233.
180.
177.
181.
106.
109.
;
74.
129.
130.
131.
132.
133.
134.
135.
136.
137.
145.
146.
147.
148.
149.
150.
;
151.
152.
153.
162.
163.
164.
165.
166.
167.
168.
169.
178.
79.
179.
95.
255.

.TapeTfsSwatProc:
	snz 0 0		; entering Swat?
kwait:	inc 0 0 snr	; yes, wait for no Trident commands pending
	 jmp 1 3
	lda 1 @.KBLK
	sz 1 1
	 jmp kwait
	inc 1 1 szr	; wait a while longer for things to settle
	 jmp .-1
; Now let the tape drive settle, wait ~.5 secs.
; in the future, more elegant techniques ought to be substituted for the code below
	subz 1 1	;zero ac1 and carry
tloop:
	lda 0 @1,3	;waste some time
	lda 0 @1,3
	lda 0 @1,3
	lda 0 @1,3
	isz 1			;increment ac1, skip if zero
	jmp tloop

	jmp 1 3

.KBLK:	640

	.end