Compucolor.org – Virtual Media

Listing of file='SMSORT.SRC;01' on disk='vmedia/chip_53-sector.ccvf'

	PAGE	60
;	ASSEMBLY LANGUAGE SORT ROUTINE CALLABLE FROM BASIC
;
;	Alan D. Matzger
;	960 Guerrero St.
;	San Francisco, CA 94110


;	Establish run-time linkages
;		START is entered when the PRG file is RUN by FCS

	ENTRY	START
START:
	PUSH	PSW	;save regs at entry
	PUSH	H
	LXI	H,MAIN	;set up CALL vector with address,
	SHLD	33283
	MVI	A,(JMP)	;  and JMP op-code
	STA	33282
	LXI	H,START-1
	SHLD	32940	;set top limit of BASIC to below us
	POP	H	;restore regs
	MVI	B,0	;(except B, a 0 in which indicates OK to FCS)
	POP	PSW
	RET		;and leave.
;	Shell sort of BASIC's string arrays
;		MAIN is entered when BASIC program executes a CALL
;

MAIN:	PUSH	H	;Save BASIC address
	CALL	FNDAR	;Subrtn to find list to sort
	CALL	MKNDX	;Initialize pointer array
	CALL	SHSRT	;The actual sort
	LXI	D,INDX0	;Return the address of ptr. array
EXIT:	POP	H	;Retrieve return address
	RET		;Back to BASIC

;---------------------------------------------------------------
V678	EQU	1	;Select version by setting aprop. V to 1
V879	EQU	0	;  and others to 0
V980	EQU	0
;---------------------------------------------------------------


BGARR	EQU	32984	;POINTER to start of arrays
NDARR	EQU	32986	;Pointer to end of arrays
	IF 	V879 OR V980
OSTR	EQU	182AH	;Puts out string to screen
NEGH	EQU	195AH	;Negates HL
	ENDIF
	IF	V678
OSTR	EQU	33F4H
NEGH	EQU	3524H
	ENDIF

	PAGE
;	FNDAR - Find array subroutine
;	   DE contain array name as 256*first ch + second ch + 128
;	   e.g. if array name is AL$, then D = x'41', C = x'CC'
;
;	   on exit, NAME0 --> ARRAY
;		    NELEM has # elements


FNDAR:
	LHLD	BGARR	;HL points to first array
	MOV	B,D	;Keep name in BC
	MOV	C,E
	PUSH	H
FNDR1:	POP	H
	MOV	A,M	;look at first byte
	INX	H	;point to second
	CMP	C	;lobytes the same?
	JNZ	FNDR2	;   IF NOT, look at next entry
	MOV	A,M	;look at second
	CMP	B	;hibytes the same?
	JZ	FOUND	;yes.
FNDR2:	INX	H	;point to next byte
	MOV	E,M	;these contain offset to next entry
	INX	H
	MOV	D,M
	INX	H
	DAD	D	;add offset
	PUSH	H
	XCHG		;but maybe we're
	DCX	D
	LHLD	NDARR	;beyond last entry
	MOV	A,H
	CMP	D
	JM	FNDER	;we are - show error
	JNZ	FNDR1	;we're not - look at next
	MOV	A,L	;compare lobytes
	CMP	E
	JNC	FNDR1	;we're not = look again
FNDER:	LXI	H,FNEMG
	CALL	OSTR	;display error msg
	POP	H
	POP	H
	JMP	EXIT	;nothing more to do
FOUND:	LXI	B,4	;in a one dimension list,
	DAD	B	;  # elements is 4 bytes away
	MOV	E,M
	INX	H	;get that number
	MOV	D,M
	XCHG
	SHLD	NELEM	;and store it away
	XCHG
	INX	H	;next byte is first for #0
	SHLD	NAME0	;save that away
	RET
	PAGE
;	MKNDX - Make index array subroutine
;	    	During the sort, the strings themselves are not
;		changed; their indices in a pointer array (INDX0)
;		are switched. This subrtn initializes that array.

MKNDX:
	LXI	H,INDX0	;addr of 0th element
	LXI	D,0	;index and value start the same
	LXI	B,1280	;there are 640 entries MAX
MKNX1:	MOV	M,E	;  2 bytes each
	INX	H
	MOV	M,D	;value stashed
	INX	H	;prepare for next
	INX	D	;  value is one more
	DCX	B	;are we all done?
	MOV	A,C	;  we'll see
	ORA	B	;not if result is <>0
	JNZ	MKNX1	;  nope
	RET		;yup
	PAGE
;	SHSRT - The actual sort routine
;	   	INN01 & INN02 are the pointer array indices
;		NSTR1 & NSTR2 are the values in the index
;		  and are themselves the indices to the two
;		  strings in their own array.

SHSRT:
	LHLD	NELEM	;the number of strings
SSLP1:	ANA	A	;clear array
	MOV	A,H
	RAR		;we are dividing by two
	MOV	H,A	;to get the partition factor
	MOV	A,L
	RAR
	MOV	L,A
	ORA	H	;if it is zero
	RZ		;  we're all done
	SHLD	PARTN	;but we aren't
	CALL	NEGH	;this # is used
	SHLD	NGPTN	;  in many subtractions
	XCHG
	LHLD	NELEM	;as here
	DAD	D
	SHLD	LPLIM	;this is loop limit
	LXI	D,0	;start with first string
SSLP2:	INX	D	;get next index
	XCHG
	SHLD	INN01	;store it
	XCHG
	LHLD	LPLIM	;is it > limit?
	CALL	NEGH
	DAD	D	;compare them
	LHLD	PARTN	;but load this before the test
	JC	SSLP1	;it is greater, goto loop1
SSLP3:	DAD	D	;it's not, add partition factor
	SHLD	INN02	;  to get second index
	CALL	DTSTR	;sr to get string indexes
	CALL	GT2ST	;this gets their len and address
	CALL	COMPR	;sr to compare two strings
	LHLD	INN01	;load first index in case
	XCHG
	CPI	DOSWT	;  the two must be switched
	JNZ	SSLP2	;they don't, go back for more
	CALL	SWTCH	;they do
	LHLD	INN01
	XCHG		;INN01 now in DE
	LHLD	NGPTN	;1st str of next comparison is
	DAD	D	;INN0 - PARTN, if that's
	MOV	A,H	;   not zero or less
	ANA	A
	JM	SSLP2
	JZ	MRTST
	JP	RTT03
MRTST:	ORA	L	;is L zero too?
	JNZ	RTT03	;if not, goto LP3
	LHLD	PARTN	;  if so, goto LP2
	JMP	SSLP2
RTT03:	SHLD	INN01	;stash new str1 index
	XCHG		;put in DE
	LHLD	PARTN
	JMP	SSLP3

;	DTSTR - Obtain NSTR's from INN0's
DTSTR:
	LXI	D,INDX0	;start of index
	LHLD	INN01
	LXI	B,NSTR1	;address, not the value
	CALL	NFRIN	;this gets and inserts the value
	LHLD	INN02	;repeat for second
	LXI	B,NSTR2
	CALL	NFRIN
	RET

NFRIN:	DAD	H	;HL*2, each entry is 2 bytes
	DAD	D	;points to value in index
	MOV	A,M
	STAX	B	;store lobyte
	INX	H
	INX	B
	MOV	A,M
	STAX	B	;store hibyte
	RET
	PAGE
;	GT2ST - Get length and starting addresses of the 2 strings
GT2ST:
	LHLD	NAME0	;addr of ptr to string # 0
	XCHG		;put in DE
	LHLD	NSTR1
	CALL	GLNAD	;this gets 'em
	MOV	B,C	;len1 now in B, len2 will be in C
	SHLD	ASTR1	;addr returned in HL
	LHLD	NSTR2
	CALL	GLNAD
	SHLD	ASTR2	;do same for 2nd str
	RET

GLNAD:	DAD	H	;each entry is 4 bytes
	DAD	H	;  so mult nstr by 4
	DAD	D	;add to NAME0
	PUSH	D	;this byte is len of str
	MOV	C,M	;this one is filler
	INX	H	;lobyte of addr in string space
	INX	H
	MOV	E,M
	INX	H	;stash this addr in DE
	MOV	D,M
	XCHG		;put it in HL
	POP	D	;retrieve NAME0
	RET

;	COMPR - The comparison routine
;	  	If 1st <= second, A returns FFH, else 00H
COMPR:
	LHLD	ASTR2	;Point to its first byte
	XCHG		;In DE
	LHLD	ASTR1	;addr of 1st string
COMP1:	LDAX	D	;get the byte
	CMP	M	;is str2 > str1?
	JM	OGT2	;no, it's less
	JZ	OEQ2	;no, it's equal
OLT2:	XRA	A	;yes -- put 00 in A
	RET
OGT2:	MVI	A,0FFH	;tell caller to switch
	RET
OEQ2:	DCR	B	;end of str1?
	JZ	OLT2	;yes, so 2nd > 1st
	DCR	C	;end of str2?
	JZ	OGT2	;yes, 1st > 2nd
	INX	D	;point to next byte
	INX	H	;  ditto
	JMP	COMP1
	PAGE
;	SWTCH - Switch values in index array
;
SWTCH:
	LXI	D,INDX0
	LHLD	NSTR2	;this value will go
	PUSH	H	;  where NSTR1 was
	LHLD	INN01	; but we have to find
	DAD	H	;  original address
	DAD	D	;here it is
	POP	B	;  now the value is in BC
	MOV	M,C
	INX	H
	MOV	M,B	;all moved, now for other
	LHLD	NSTR1
	PUSH	H
	LHLD	INN02
	DAD	H
	DAD	D	;here's the address
	POP	B
	MOV	M,C
	INX	H
	MOV	M,B	;switch completed
	RET

;	VARIABLES
;
NELEM:	DS	2
INN01:	DS	2
INN02:	DS	2
NSTR1:	DS	2
NSTR2:	DS	2
ASTR1:	DS	2
ASTR2:	DS	2
PARTN:	DS	2
NGPTN:	DS	2
LPLIM:	DS	2
NAME0:	DS	2
DOSWT	EQU	0FFH
FNEMG:	DB	6,1,3,20,5,237,50
	DB	'LIST NOT FOUND',11,238,239
INDX0:	DS	1280	;THERE ARE 620 2-BYTE ENTRIES
	END     START