; Assembly code for machine-independent part of Midas

.bext PrepareCharInv
.bext CallSwat

.bext VertIntFlag
.bext Zero
.bextz BHsize
.bext NwdsPerScanLine
.bext FontP
.bext OverlayZone
.bext KillOverlays

.ent ErrorProtect
.ent DummyCall
.ent Mag
.ent Max
.ent Min
.ent StrSize
.ent SearchBlock
.ent MoveUp
.ent VertIntCode
.ent ClearAndScanConvert
.ent AbortFrame
.ent AbortLabel
.ent SymbKeyComp
.ent BinScan
.ent GetBodySize
.ent FindBlock
.ent BlockTable

.zrel

AbortFrame:		0
AbortLabel:		0
BlockTable:		0

.srel

ErrorProtect:		.Protect
DummyCall:		.DummyCall
Mag:			.Mag
Max:			.Max
Min:			.Min
StrSize:		.StrSize
SearchBlock:		.SearchBlock
MoveUp:			.MoveUp
VertIntCode:		.VertIntCode
ClearAndScanConvert:	.ClearAndScanConvert
SymbKeyComp:		.SymbKeyComp
BinScan:		.BinScan
GetBodySize:		.GetBodySize
FindBlock:		.FindBlock

.nrel

GetFrame = 370
StArgs = 367
Return = 366

; Calls @p1 with p2 arguments p3, p4, p5, ...
; The circumlocution is so that if the call fails due to an overlay
; fault, it can be reexecuted later.

.DummyCall:
	sta 3 1 2
	jsr @GetFrame
	 24			; 4 fixed + 20 formals
	jsr @StArgs
	lda 0 4 2		; first formal
	sta 0 localPStatic
	lda 0 5 2
	sta 0 NParams
	lda 3 Three
	lda 1 Five		; third formal-1 (frame-relative)
	sub# 0 3 snr
	lda 1 10 2		; three args -> fifth formal
	sta 1 3 2		; extra args for this call
	lda 0 6 2
	lda 1 7 2
	jsrii localPStatic
NParams:
	 0
	jmp @Return

Three:	3
Five:	5
Four:	4
Eight:	10
localPStatic:
	0

.StrSize:
	sta 3 1 2
	mov 0 3
	lda 0 0 3
	lda 1 S77400		; Sign bit is a flag
	ands 1 0
	movzr 0 0
	inc 0 0
	lda 3 1 2
	jmp 1 3

S77400:	77400

AddrSymb:	3		; Symbol type eq AddrSymb
SB177400:	177400
SB377:		377

; SearchBlock(Block,BOffset,BName,Addr,MemX)
.SearchBlock:
	sta 3 1 2
	jsr @GetFrame
	 22
	jsr @StArgs
	lda 3 4 2
	lda 3 3 3
	sta 3 11 2		; Block>>BH.LastPntr
	lda 0 BHsize
	sta 0 14 2		; I
SBllp:	lda 3 4 2
	neg 3 1
	add 0 3
	lda 3 0 3		; Block!I
	adc 1 3
	sta 3 12 2		; Block+Block!I-1
	lda 0 1 3
	lda 1 S77400		; (Sign bit is a flag)
	ands 1 0		; String length in bytes
	movzr 0 0
	sta 0 13 2		; Save number of words in string - 1
	add 0 3			; Pointer to 1st non-text word - 2
	lda 0 2 3
	lda 1 SB177400
	ands 1 0		; L.H. of 0th word is type
	lda 1 AddrSymb
	sub# 1 0 szr		; Skip if type eq AddrSymb
	jmp SBend		; No, loop
	lda 0 2 3
	lda 1 SB377
	and 1 0			; Get MemX of symbol
	lda 1 10 2
	sub# 1 0 szr		; Desired MemX?
	jmp SBend		; No, loop
	lda 0 7 2		; Get Addr being sought
	lda 3 3 3		; 1st word is address
	sub 3 0
	lda 3 @5 2		; Get best offset so far
	subl# 3 0 szc		; Better than best?
	movl# 0 0 szc		; Yes, greater than 0?
	jmp SBend		; No, loop
	sta 0 @5 2		; Yes, save new best offset
	lda 3 13 2		; Symbol size-1 = word count-1
	lda 1 6 2		; Pointer to name buffer
	add 3 1			; Last
	com 3 3			; - word count
	lda 0 12 2		; From-1 = pointer to text-1
	blt
SBend:	isz 14 2		; I = I+1
	lda 0 14 2
	lda 3 11 2		; LastPntr
	adcl# 3 0 szc
	jmp SBllp
	jmp @Return

; Calls @p1 with args p2, p3, ..., pN after establishing
; AbortLabel and AbortFrame to capture DisplayError calls.
; Also fixes up state of overlay stuff on returns and errors.
.Protect:
	sta 3 1 2
	sta 0 lvFcn		; Set function name for call
	lda 0 AbortFrame	; Old AbortFrame in place of arg1
	sta 2 AbortFrame	; AbortFrame = CallersFrame(MyFrame())
	jsr @GetFrame
	 24			; 4 fixed + 16 formals
	jsr @StArgs		; Returns nargs in ac0
	neg 0 0
	com 0 0
	sta 0 NArgs		; Nargs for protected call = nargs-1
	lda 3 Three
	lda 0 NArgs
	lda 1 Four		; Second formal -1 (frame relative)
	sub# 0 3 snr		; Skip if Nargs for call unequal to 3
	lda 1 7 2		; Exactly three--save third
	sta 1 3 2		; else save number extra args for call
	lda 0 5 2		; Second arg = 1st for call
	lda 1 6 2		; 3rd arg = 2nd for call
	lda 3 @.OverlayZone
	sta 3 5 2		; Save old OverlayZone at arg2 (now a temp)
	lda 3 AbortLabel
	sta 3 6 2		; Save old AbortLabel at arg3 (now a temp)
	jsr Erp4
EProtL:	mkzero 0 0		; Return 0 if aborted
	jmp Erp5

Erp4:	sta 3 AbortLabel	; Set AbortLabel to EProtL
	jsrii lvFcn		; Call the function
NArgs:	 0
Erp5:	lda 1 6 2
	sta 1 AbortLabel	; Restore AbortLabel
	lda 1 5 2		; Get old OverlayZone
	add# 1 1 szr		; Skip if wasn't in overlay
	jmp Erp6
	sta 0 6 2		; Preserve result
	jsrii .KillOverlays
	 0
	lda 0 6 2
Erp6:	lda 1 4 2		; Old AbortFrame in pos. of arg1
	sta 1 AbortFrame	; Restore AbortFrame
	jmp @Return

lvFcn:	0
.OverlayZone:	OverlayZone
.KillOverlays:	KillOverlays


; Mag(X) = (X < 0 ? -X,X)
.Mag:	movl# 0 0 szc
	neg 0 0
	jmp 1 3


.Max:	adcl# 1 0 szc	; Skip if AC0 > AC1
	mov 1 0
	jmp 1 3


.Min:	adcl# 1 0 snc	; Skip if AC0 le AC1
	mov 1 0
	jmp 1 3

Count:	0

; Subroutine to move a block of words from its current position to an
; overlapping position at a larger address (i.e., MoveBlock won't work).
; Arg1 = "To", Arg2 = "From", Arg3 = word count.
.MoveUp:
	inc 3 3
	sta 3 1 2	; Save return
	lda 3 3 2	; Arg3 = word count
	add# 3 3 snr	; Skip if word count ne 0
	jmp @1 2	; else return
	sta 3 Count
	mov 1 3		; 3_"From"
	mov 2 1		; Preserve stack pointer in AC1
	mov 0 2		; 2_"To"
MUpLp:	lda 0 0 3
	sta 0 0 2
	neg 3 3
	com 3 3		; Subtract 1 from "From"
	neg 2 2
	com 2 2		; Subtract 1 from "To"
MUp1:	dsz Count
	jmp MUpLp
	mov 1 2		; Restore stack pointer
	jmp @1 2	; Return to caller

; Vertical interrupt routine
.VertIntCode:
	sta 0 A0
	adc 0 0		; -1 = true
	sta 0 @lvVertIntFlag
	lda 0 A0
	bri

A0:	0
lvVertIntFlag: VertIntFlag


; Clear and scan convert bit buffer
; 4,2 = Arg1 = BitBuffer
; 5,2 = Arg2 = StringVec
; 6,2 set to NwdsPerScanLine
; 7,2 DBA
; 10,2 DWA
; 11,2 loop count for StringVec
; 12,2 StringVec>>lh for end test
.ClearAndScanConvert:
	sta 3 1 2
	jsr @GetFrame
	 20		; Not sure about this-- = 4+nargs+Ntemps??
	jsr @StArgs
	lda 0 @lvNwdsPerScanLine
	sta 0 6 2
	lda 3 c2
	sub 0 3
	lda 0 4 2
	add 3 0
	sta 0 10 2	; BitBuffer+2-NWDS = initial DWA
	lda 0 c20
	sta 0 7 2	; DBA initially 20
	lda 3 4 2	; BitBuffer
	lda 0 c2
	add 3 0
	lda 1 1 3	; BitBuffer!1
	jsrii lvZero	; Zero(BitBuffer+2,BitBuffer!1)
	 2
	subzl 0 0	; 1 (in for I = 1 to StringVec>>lh do)
	lda 3 @5 2
	lda 1 c177400
	ands 1 3
	sta 3 12 2	; StringVec>>lh
	jmp CASCet

DispC3:	lda 1 c177	; Inverting black for white
	and 1 0
	add 3 0
	jsrii lvPrepareCharInv
	 1
	mov 0 3
	jmp DispC2

CASClp:	lda 1 5 2	; StringVec
	movl# 0 0 szc	; Skip if even byte
	movor 0 3 skp
	movzr 0 3 skp
	addc 1 3 skp
	add 1 3
	lda 0 0 3	; Get the word containing the char
	lda 1 c377
	mov# 0 0 snc
	movs 0 0
	and 1 0
	lda 1 c200
	lda 3 @lvFontP
	and# 1 0 szr	; Skip if not inverting black for white
	jmp DispC3
	lda 1 c177
	and 1 0
	add 0 3
; Have char loc. in font in ac3
DispC2:	lda 0 10 2	; Dest. word address-NWDS
	convert +6
	jmp DispC1
	subz 3 1 szc	; Decrement DBA
	jmp DispC0	; Jump if doesn't overflow a word
	isz 10 2
	lda 3 c20
	add 3 1
DispC0:	sta 1 7 2	; Store new DBA
	lda 0 11 2
	inc 0 0
CASCet:	sta 0 11 2	; I
	lda 1 12 2	; StringVec>>lh
	adcl# 1 0 szc	; Skip if AC0 gr AC1
	jmp CASClp
	jmp @Return

DispC1:	isz 10 2	; Increment word loc and loop
	jmp DispC2
	jmp DispC2


lvZero:	Zero
lvPrepareCharInv:	PrepareCharInv
c200:	200
c177:	177
c20:	20
c2:	2
c377:	377
lvNwdsPerScanLine:	NwdsPerScanLine
lvFontP:		FontP
c177400: 177400


SKC1z:	ands 3 0 szr		; resultis 0 if both null strings
	mkminusone 0 0		; K2 not null, resultis -1
	jmp @SKCRtn

SKC2z:	mkone 0 0		; resultis +1 if K2 null & K1 not null
	jmp @SKCRtn

; SymbKeyComp(K1,K2) = valof "K1" = "K2"
; **Non-reentrant**
.SymbKeyComp:
	inc 3 3
	sta 3 SKCRtn		; Save return
	sta 0 K1
	sta 1 K2
	mov 0 3
	lda 1 0 3		; K1!0
	lda 3 K2
	lda 0 0 3		; K2!0
	lda 3 c177400
	ands 3 1 snr
	jmp SKC1z		; K1 is null string
	ands 3 0 snr
	jmp SKC2z		; K2 is null string
; Both strings are non-null
	sta 1 N1		; (K1!0)<<lh = K1 length
	sta 0 N2		; (K2!0)<<lh = K2 length
	lda 3 K1
	lda 0 0 3
	lda 3 K2
	lda 1 0 3
	lda 3 c377
	and 3 1
	and 3 0
	sub 1 0	 szr		; (K1!0)<<rh - (K2!0)<<rh
	jmp @SKCRtn		; result if non-zero
; 1st chars are equal
	lda 0 N1
	lda 3 N2
	subl# 3 0 snc		; Skip if ac3 ge ac1
	mov 3 0
	sta 0 Nmin		; Nmin = min(N1,N2)
	mkone 3 3
	sub 3 0
	movzr 0 0
	sta 0 Xmax		; Xmax = (Nmin-1) rshift 1
	sta 3 X			; for X = 1 to ...
	jmp Lp1

N1:	0
N2:	0
K1:	0
K2:	0
Xmax:	0
Nmin:	0
X:	0
SKCRtn:	0

Lp:	lda 3 K1
	add 1 3
	lda 0 0 3
	lda 3 K2
	add 1 3
	lda 1 0 3
	sub 1 0 szr
	jmp @SKCRtn		; Return with dif if unequal
	isz X
Lp1:	lda 1 X
	lda 0 Xmax
	adcl# 0 1 szc		; Fall out of loop when X > Xmax
	jmp Lp

	lda 0 Nmin		; Nmin
	mkone 1 1
	and 1 0 szr		; Skip if Nmin is even
	jmp Xit
	lda 1 Xmax		; Pointer to last full word of strings
	lda 3 K1
	add 1 3
	lda 0 1 3		; Last char of K1 in l.h.
	lda 3 K2
	add 1 3
	lda 1 1 3		; Last char of K2 in l.h.
	lda 3 c177400
	ands 3 0
	ands 3 1
	sub 1 0 szr
	jmp @SKCRtn
Xit:	lda 0 N1
	lda 1 N2
	sub 1 0			; Length(K1)-length(K2)--longer greater
	jmp @SKCRtn

; BinScan(Block,Key) returns index of greatest record in Block with key
; le Key.  If eq, returns +index, else -index.
.BinScan:
	inc 3 3
	sta 3 1 2		; Save return address
	sta 0 Block
	sta 1 Key
	lda 3 BHsize
	sta 3 K
	mov 0 3
	lda 1 3 3		; Block>>BH.LastPntr
	sta 1 L
	add 1 3
	lda 1 0 3		; Block!L
	add 0 1			; AC1_Block+Block!L
	lda 0 Key
	jsr .SymbKeyComp
	 2
	movl# 0 0 szc		; Skip if compared ge
	jmp BinBeg
	mov 0 1
	lda 0 L
	add# 1 1 szr		; Skip if compared eq
	neg 0 0			; resultis -L if unequal
	jmp @1 2		; resultis L if equal

Block:	0
Key:	0
K:	0
L:	0
M:	0

; Loop here with K in 0, L in 3 and K < L
BinLp:	add 3 0
	movzr 0 0
	sta 0 M			; M = (K+L) rshift 1
	lda 3 Block
	mov 3 1
	add 0 3
	lda 0 0 3		; Block!M
	add 0 1			; Block+Block!M
	lda 0 Key
	jsr .SymbKeyComp
	 2
	mov 0 1			; AC1_compare result
	lda 0 M
	mov# 1 1 snr		; if compare eq 0 then
	jmp @1 2		; resultis M
	movl# 1 1 snc		; Skip if C < 0
	jmp .+3
	sta 0 L
	jmp BinBeg
	lda 1 K
	sub# 1 0 szr		; if K eq M then
	jmp .+3
	neg 1 0
	jmp @1 2		; resultis -K
	sta 0 K
BinBeg:	lda 0 K
	lda 3 L
	adcl# 0 3 snc		; Skip if AC3 le AC0 (L le K)
	jmp BinLp
	neg 0 0
	jmp @1 2

; GetBodySize(PtrToBody)
.GetBodySize:
	sta 3 1 2
	mov 0 3
	lda 0 0 3		; Have symbol type in l.h. of 0
	lda 1 c3400
	ands 1 0		; Get symbol type in 0
	jsr GBS1
	 1			; Undefined--null string only
	 4			; MemSymb
	 2			; RegSymb
	 2			; AddrSymb
	 3			; LAddrSymb
	 170000			; Undefined
	 170000			; Undefined
	 170000			; Undefined
GBS1:	add 0 3
	lda 0 0 3		; Get body size for this type from table
	lda 3 1 2
	jmp 1 3

c3400:	3400


; FindBlock(BlockAddr) = valof
; [	for I = 1 to BlockTable!0 do
;	[ if (BlockTable!I)>>BH.BlockAddr eq BlockAddr do
;		resultis BlockTable!I
;	]
;	resultis 0
; ]
.FindBlock:
	inc 3 3
	sta 3 1 2
	lda 3 BlockTable
	lda 1 0 3		; BlockTable!0 = number of core blocks
	sta 1 NBlocks
FindB:	lda 1 @1 3		; Block>>BH.BlockAddr = rv BlockTable!I
	sub# 0 1 snr
	jmp FoundB
	inc 3 3
	dsz NBlocks
	jmp FindB
	sub 0 0 skp		; Not found--return 0
FoundB:	lda 0 1 3		; Found--return pointer to block
	jmp @1 2

NBlocks:	0


.end