************************************************************************
*							*
*	  	   BASIC Directory				*
*							*
*	   	     Version 1.3				*
*							*
*		    19 March 1989			 	*
*							*
************************************************************************

**	Tabstops : variable
**	Assemble with Macro68

;date 19-Mar-89


;Copyright (C)
;Dr. J. Szajman
;38 Ludbrook Ave
;South Caulfield
;Melbourne, Vic.  3162
;Australia


**	Permission is granted to purchasers of Macro68 to modify this source
**	file.  Permission is further granted to distribute the source code that
**	they have modified subject to the following conditions:
**	1.  That the original, unaltered, source is included with the
**	    distribution.
**	2.  That no charge is made for the distribution, other than the cost of
**	    media.                    (Distribution via Fred Fish is permitted)
**	3.  That my copyright notice remains as part of this and any other
**	    file adapted from this file.
**


;-----------------  Modifications  --------------------------------------

;date 19-Mar-89
;version 1.3
;return number of files in directory on error 140 or 141

;date 23-Dec-88
;Version 1.2a
;correct bug which reports date as future
;address of fib_DateStamp was used for number of days

;date 13-Dec-88
;Version 1.2
;code is now relocatable

;------------------------------------------------------------------------

;Machine language subroutine for BASIC.
;GET DIRECTORY and sort it in ascending order

;On entry, two parameters are on the stack.

;I.  SADD() to the PATH string.
;II. VARPTR() to the interger array.

;String:

;		[NULL] | [PATH]    
;
;If path is not specified (ie., NULL) then the current directory is assumed.
;The string terminator must have value less then $20, ie. 0a 03 0 etc is OK
;
;Long integer array:

*element (0)  dc.l  VARPTR(DIR$(0))    ;pointer to a string stucture
*        (1)         dc.l  MAXFILES&   ;maximum number of files
*        (2)         dc.l  MODE        ;three modes:
*                                      ;  1 allocate 126*MAXFILES& bytes
*                                      ;  2 free memory
*                                      ;  3 get files from the directory
*        (3)         dc.l  m           ;sort starts on mth char
*        (4)         dc.l  0           ;error code (-1 success)
*        (5)         dc.l  0           ;0 or allocated memory address
*        (6)         dc.l  n           ;number of files

;------------------------------------------------------------------------


;Error Codes:

;-1	No errors
;130	This mode is not implemented
;135	Out of memory
;140	Directory has more than NMAX files
;141	Out of buffer space
;142	Can't do directery, memory not allocated

;------------------------------------------------------------------------

;Register usage:

;	d0 = scratch register
;	d1 = scratch register
;	d3 = flag - max files exceeded = 1
;	d4 = lo - sorting routine
;	d5 = hi - sorting routine
;	d6 = lock
;	d7 = file_info_block
;	a0 = scratch register
;	a1 = scratch register
;	a2 = pointer to integer array
;	a3 = current position within string array data
;	a4 = position within string array structure
;	a5 = pointer to _DosBase
;	a6 = pointer to _ExecBase
;	a7 = stack pointer


	SECTION	main,CODE


	ifnd	_AbsExecBase
**********  Exec.lib offsets  **********

_LVOAllocMem	equ	-$C6
_LVOFreeMem	equ	-$D2
_LVOFindTask	equ	-$126
_LVOOldOpenLibrary	equ	-$198
_LVOCloseLibrary	equ	-$19E

**********  DOS.lib offsets   **********

_LVOLock	equ	-$54
_LVOUnLock	equ	-$5A
_LVODupLock	equ	-$60
_LVOExamine	equ	-$66
_LVOExNext	equ	-$6C
_LVODateStamp	equ	-$C0

**********    exec definitions    ****************

_AbsExecBase	equ	4	;exec library base address
MEMF_CHIP	equ	2
MEMF_FAST	equ	4
MEMF_CLEAR	equ	$10000
pr_CurrentDir	equ	$98

**********    DOS definitions    *****************

ACCESS_READ	equ	-2
fib_DirEntryType	equ	4
fib_FileName	equ	8
fib_DateStamp	equ	132
fib_Comment	equ	144

**********    ERROR definitions    ***************

ERROR_INVALID_LOCK	equ	211
	endc

NO_ERROR	equ	-1
ERROR_MEM_NOT_ALLOC equ	142
ERROR_ILLEGAL_MODE	equ	130
ERROR_NO_MEMORY	equ	135
ERROR_NUM_FILES	equ	140
ERROR_OUT_OF_BUFFER equ	141

**********    Definitions     **********

BASIC_opt	equ	5	;AMIGA BASIC
;BASIC_opt	equ	6	;AC-BASIC compiler

**************************************************
	exeobj
	errfile	'ram:assem.output'
	objfile	'ram:ab-d'
	strict
**************************************************

	movem.l	d0-d7/a0-a6,-(a7)

	movea.l	(_AbsExecBase),a6

	movea.l	(16*4,a7),a4	;pointer to string path
	movea.l	(17*4,a7),a2	;pointer to integer array

	move.l	#NO_ERROR,($10,a2)	;no errors
	clr.l	d3		;clear max files flag
	move.l	($4,a2),d0	;max number of files
	bgt.b	buffer_size
	move.l	#500,d0	;default number of file
buffer_size	mulu.w	#(30+12+80)+4,d0	;file+date+file note+LF+0003
	lea	(string_size,pc),a0
	move.l	d0,(a0)
	cmpi.l	#2,($8,a2)	;free memory call?
	bne.b	alloc_mem
	move.l	#ERROR_MEM_NOT_ALLOC,($10,a2)
	tst.l	($14,a2)
	beq	exit2
	movea.l	(a2),a0	;get pointer string structure
	move.l	($4,a2),d0	;no of elements
	mulu.w	#BASIC_opt,d0	;length + 3 byte address
	subq.l	#1,d0
	blt.w	exit4
free_mem_lp1	clr.b	(a0)+	;clear data structure
	dbf	d0,free_mem_lp1
exit4	move.l	(string_size,pc),d0
	movea.l	($14,a2),a1	;alloc mem pointer
	jsr	(_LVOFreeMem,a6)
	move.l	#NO_ERROR,($10,a2)	;no errors
	clr.l	($14,a2)	;delete pointer
	bra.w	exit2	;go free memory

alloc_mem	cmpi.l	#3,($8,a2)	;do not allocate memory?
	bne.b	alloc_mem1
	movea.l	($14,a2),a3	;allready allocated memory
	tst.l	($14,a2)	;memory pointer or 0
	bne.b	get_lock
	move.l	#ERROR_MEM_NOT_ALLOC,($10,a2)
	bra.w	exit2
alloc_mem1	cmpi.l	#1,($8,a2)
	beq.b	alloc_mem2
	move.l	#ERROR_ILLEGAL_MODE,($10,a2) ;illegal mode
	bra.w	exit2
alloc_mem2	move.l	(string_size,pc),d0	;bytes
	move.l	#MEMF_CLEAR,d1
	jsr	(_LVOAllocMem,a6)	;any memory for buffer
	movea.l	d0,a3
	move.l	d0,($14,a2)	;save start address
	bne.w	exit2
	move.l	#ERROR_NO_MEMORY,($10,a2) ;out of mem error
	bra.w	exit2

get_lock	lea	(file_info_block,pc),a0
	exg	a0,d7
	bclr.l	#1,d7	;align on long word
	lea	(doslib,pc),a1	;dos.library
	clr.l	d0		;any version
	jsr	(_LVOOldOpenLibrary,a6)	;open Dos Library
	movea.l	d0,a5	;save

	cmpa.l	#0,a4	;no dir path?
	bne.b	get_lock2
	suba.l	a1,a1
	jsr	(_LVOFindTask,a6)
	exg	d0,a0
	move.l	(pr_CurrentDir,a0),d1
	exg	a5,a6
	jsr	(_LVODupLock,a6)
	move.l	d0,d6
	bra.b	examine
get_lock2	exg	a6,a5	;DOSBase in a6
	move.l	a4,d1
	move.l	#ACCESS_READ,d2
	jsr	(_LVOLock,a6)
	move.l	d0,d6
	bne.b	examine
exit6	move.l	#ERROR_INVALID_LOCK,($10,a2) ;can't get file lock
	bra.w	exit1	;close library then quit

examine	move.l	d6,d1
	move.l	d7,d2
	jsr	(_LVOExamine,a6)	;fill file_info structure
	tst.l	d0
	bge.w	exit6

	move.l	d7,d1
	add.l	#date_now-file_info_block,d1
	jsr	(_LVODateStamp,a6)	;get current time
	clr.l	($18,a2)	;clear number of files count
	movea.l	(a2),a4	;pointer to string structure
ex_lp1	move.l	d6,d1	;lock
	move.l	d7,d2
	jsr	(_LVOExNext,a6)
	tst.l	d0
	bge.w	sort_array
	movea.l	d7,a0
	tst.l	(fib_DirEntryType,a0)
	bge.b	ex_lp1	;not a file
	addq.l	#1,($18,a2)	;no of files
	tst.l	d3
	bne.b	ex_lp1
	adda.l	#fib_FileName,a0

	IFEQ	BASIC_opt-5
	clr.b	(a4)
	clr.b	(1,a4)	;clear char count
	move.l	a3,d0	;store 3 byte address
	move.b	d0,(4,a4)
	asr.l	#8,d0
	move.b	d0,(3,a4)
	asr.l	#8,d0
	move.b	d0,(2,a4)
	ENDC

	IFEQ	BASIC_opt-6
	clr.w	(a4)	;clear char count
	move.l	a3,(2,a4)	;string pointer - long word
	ENDC

	move.l	a3,d2	;save address
ex_lp2	tst.b	(a0)	;end?
	beq.b	get_date
	move.b	(a0)+,(a3)+
	bra.b	ex_lp2

get_date	move.l	#28,d0
	add.l	d2,d0
	sub.l	a3,d0	;29 - (a3-d2)
	ble.b	get_date1
get_date_lp1	move.b	#' ',(a3)+
	dbf	d0,get_date_lp1
get_date1	move.b	#' ',(a3)+
	exg	a0,a3
	movea.l	d7,a1
	move.l	(fib_DateStamp,a1),d0
	bsr.w	date	;date
	move.b	#' ',(a0)+
	exg	a3,a0	;buffer pointer in a3

	movea.l	d7,a0
	adda.l	#fib_Comment,a0
ex_lp3	tst.b	(a0)	;end?
	beq.b	set_LF
	move.b	(a0)+,(a3)+
	bra.b	ex_lp3
set_LF	move.b	#$A,(a3)+
	move.l	a3,d0

	IFEQ	BASIC_opt-5
	sub.l	d2,d0	;count
	move.b	d0,(1,a4)
	asr.l	#8,d0
	move.b	d0,(a4)
	ENDC

	IFEQ	BASIC_opt-6
	btst.b	#0,d0	;odd?
	beq.b	even
	move.b	#0,(a3)+	;pad 00
even	move.w	#3,(a3)+
	move.l	a3,d0
	sub.l	d2,d0	;count
	move.w	d0,(a4)
	ENDC

	addq.l	#BASIC_opt,a4	;next element
	move.l	($4,a2),d0
	cmp.l	($18,a2),d0	;<=max number of files?
	bge.b	check_elements
	move.l	#ERROR_NUM_FILES,($10,a2)
	addq.l	#1,d3
	bra.w	ex_lp1

check_elements	move.l	(string_size,pc),d0
	add.l	($14,a2),d0
	sub.l	a3,d0	;size of remining buffer
	cmpi.l	#(30+12+80)+4,d0	;max size of file
	bge.w	ex_lp1
	move.l	#ERROR_OUT_OF_BUFFER,($10,a2) ;out of buffer space
	moveq	#1,d3	;error occured
	bra.w	ex_lp1

sort_array	move.l	d6,d1	;lock
	jsr	(_LVOUnLock,a6)
	tst.l	d3
	bne.b	exit1	;exceeded max no of files
	movea.l	(a2),a4	;pointer to string array
	clr.l	d0
	bsr.w	string_address
	cmpa.l	#0,a0	;no files?
	beq.b	exit1
	tst.l	($C,a2)	;sort position
	bne.b	sort_array1
	move.l	#1,($C,a2)	;must be 1st column!
sort_array1	clr.l	d0		;lo - first element
	move.l	($18,a2),d1	;number of elements	
	subq.l	#1,d1	;hi - last element
	bsr.w	quick_sort

exit1	exg	a5,a6
	exg	a5,a1	;DOSBase
	jsr	(_LVOCloseLibrary,a6)

exit2	movem.l	(a7)+,d0-d7/a0-a6
	rts

;Extract the date
;entry - a0 = pointer to the buffer
;        d0 = number of days since 1-Jan-1978
;exit  - a0 = last byte of date + 1

date	movem.l	d0-d3/a1,-(a7)
	movea.l	d7,a1
	move.l	(date_now-file_info_block,a1),d1
	beq.b	date_jmp1	;current date is not set
	cmp.l	d0,d1
	bgt.b	past_jmp1
	blt.b	future_jmp1
	lea	(today,pc),a1
	bra.b	date_jmp2	;today
future_jmp1	lea	(future,pc),a1
	bra.b	date_jmp2	;future
past_jmp1	subq.l	#7,d1	;backoff 7 days
	cmp.l	d0,d1
	bge.b	date_jmp1
	lea	(day_of_week,pc),a1
	divu.w	#7,d0
	swap	d0		;no of days since sunday
past_lp1	subq.b	#1,d0
	blt.b	date_jmp2
past_lp2	tst.b	(a1)+
	bne.b	past_lp2
	bra.b	past_lp1
date_jmp2	move.b	(a1)+,d1
	beq.w	date_exit
	move.b	d1,(a0)+
	bra.b	date_jmp2
date_jmp1	sub.l	#2251,d0
	move.l	d0,d1
	asl.l	#2,d1	;*4
	addq.l	#3,d1	;+3
	divu.w	#1461,d1	;/1461
	ext.l	d1
	move.l	#1984,d3
	add.l	d1,d3	;year
	mulu.w	#1461,d1	;*1461
	asr.l	#2,d1	;/4
	sub.l	d1,d0
	move.l	d0,d1
	mulu.w	#5,d1	;*5
	addq.l	#2,d1	;+2
	divu.w	#153,d1	;/153
	ext.l	d1
	move.l	d1,d2
	mulu.w	#153,d1
	addq.l	#2,d1
	divu.w	#5,d1
	ext.l	d1
	sub.l	d1,d0
	addq.l	#1,d0
	exg	d0,d1	;day in d1
	add.l	#3,d2
	cmpi.l	#12,d2
	ble.b	date_convert
	sub.l	#12,d2	;month
	addq.l	#1,d3	;year + 1
date_convert	sub.l	#1900,d3	;last two digits only
	move.l	d1,d0	;day
	bsr.b	convert_to_A	;ASCII day
	lea	(month,pc),a1
	move.l	d2,d0
	subq.l	#1,d0
	mulu.w	#3,d0
	adda.l	d0,a1
	move.b	#'-',(a0)+
	move.b	(a1)+,(a0)+	;ASCII month (3 alpha chars)
	move.b	(a1)+,(a0)+
	move.b	(a1)+,(a0)+
	move.b	#'-',(a0)+
	move.l	d3,d0
	bsr.b	convert_to_A	;ASCII year
date_exit	movem.l	(a7)+,d0-d3/a1
	rts	

;Convert hex number < 100 to ASCII
;Entry - a0 = buffer pointer
;	 d0 = number
;Exit  - a0 = last byte +1
;	 d0 = used

convert_to_A	divu.w	#10,d0
	add.l	#$300030,d0	;top half = units
	move.b	d0,(a0)+
	swap	d0
	move.b	d0,(a0)+
	rts

;Sort array in ascending order using quick sort
;Entry  - a2 = pointer to integer array
;	  a3 = position of last elemet (data) + 1
;	  d0 = lo
;	  d1 = hi

quick_sort	movem.l	d0-d7/a0-a6,-(a7)	;save registers
	cmp.l	d1,d0	;lo<hi ?
	bge.w	quick_end1
	move.l	d0,d2	;d2 = i
	move.l	d1,d3	;d3 = j
	exg	d0,d4	;lo in d4
	exg	d1,d5	;hi in d5
	move.l	d3,d6	;d6 = pivline
quick_lp1	cmp.l	d3,d2	;i<j
	bge.b	quick_lp2
	move.l	d2,d0
	bsr.w	compare
	bgt.b	quick_lp2
	addq.l	#1,d2	;i+1
	bra.b	quick_lp1
quick_lp2	cmp.l	d2,d3
	ble.b	quick_jmp2
	move.l	d3,d0
	bsr	compare
	blt.b	quick_jmp2
	subq.l	#1,d3	;j=j-1
	bra.b	quick_lp2
quick_jmp2	cmp.l	d2,d3	;i>=j
	ble.b	quick_jmp3	;out of order pair
	move.l	d2,d0
	move.l	d3,d1
	bsr.w	exchange
quick_jmp3	cmp.l	d2,d3
	bgt.b	quick_lp1
	move.l	d2,d0
	move.l	d5,d1
	bsr.w	exchange	;move pivot to i
	move.l	d5,d0	;hi
	sub.l	d2,d0	;hi-i
	add.l	d4,d0	;hi-i+lo
	sub.l	d2,d0	;(hi-i)-(i-lo)
	ble.b	quick_jmp4
	move.l	d4,d0	;lo
	move.l	d2,d1
	subq.l	#1,d1	;i-1
	bsr.b	quick_sort
	move.l	d2,d0
	addq.l	#1,d0	;i+1
	move.l	d5,d1	;hi
	bsr.b	quick_sort
	bra.b	quick_end1
quick_jmp4	move.l	d2,d0
	addq.l	#1,d0	;i+1
	move.l	d5,d1	;hi
	bsr.b	quick_sort
	move.l	d4,d0	;lo
	move.l	d2,d1
	subq.l	#1,d1	;i-1
	bsr.w	quick_sort
quick_end1	movem.l	(a7)+,d0-d7/a0-a6
	rts

;Compares two strings i and p (pivot).  Return flags only.
;Entry  - a4 = pointer to the string structure
;	  d0 = offset in the string structure - element number
;	  a2 = pointer to the integer array
;	  d6 = pivot offset
;Exit	- Flags set according to i cmp p
;Used	- CCR

compare	movem.l	d0-d3/a0-a1,-(a7)
	bsr.w	string_address	;pointer to data
	exg	a0,a1	;pointer in a1
	exg	d0,d1	;no of chars
	move.l	d6,d0	;pivot
	bsr.w	string_address	;pivot pointer in a0
	move.l	($C,a2),d3	;sort position
	subq.l	#1,d3
	cmp.l	d0,d3	;offset must be < length
	bge.b	compare_exit
	cmp.l	d1,d3
	bge.b	compare_exit
	adda.l	d3,a0
	adda.l	d3,a1
	sub.l	d3,d0
	sub.l	d3,d1	;adjust count by pos. offset
	move.l	d0,d2
	cmp.b	d0,d1
	bge.b	compare_jmp1
	move.l	d1,d2
compare_jmp1	cmpm.b	(a0)+,(a1)+
	dbne	d2,compare_jmp1
	bne.b	compare_exit
	cmp.w	d0,d1	;if EQ shorter goes first
compare_exit	movem.l	(a7)+,d0-d3/a0-a1
	rts
	

;Get address and no of characters from string structure
;Entry  - a4 = pointer to string structure
;	  d0 = offset - element number
;Exit	  a0 = address
;	  d0 = no of characters in the string
;Used	  d0,a0,d1

	IFEQ	BASIC_opt-5
string_address	move.l	d1,-(a7)
	mulu.w	#5,d0	;5 bytes per element
	clr.l	d1
	move.b	(2,a4,d0.w),d1
	asl.l	#8,d1	;make room for next byte
	move.b	(3,a4,d0.w),d1
	asl.l	#8,d1
	move.b	(4,a4,d0.w),d1	;last byte
	exg	d1,a0	;address in a0
	clr.l	d1
	move.b	(0,a4,d0.w),d1
	asr.l	#8,d1
	move.b	(1,a4,d0.w),d1
	exg	d1,d0
	move.l	(a7)+,d1
	ENDC

	IFEQ	BASIC_opt-6
string_address	mulu.w	#6,d0	;6 bytes per element
	movea.l	(2,a4,d0.w),a0	;address in a0
	move.w	(0,a4,d0.w),d0	;count in d0
	ENDC

	rts	
 

;Exchange i and j elements of array structure
;Entry  - a4 = pointer to string array structure
;	  d0 = element i
;	- d1 = element j
;Exit   - VOID
;Used	- NONE

	IFEQ	BASIC_opt-5	;move byte by byte
exchange	movem.l	d0-d3,-(a7)
	mulu.w	#5,d0	;point to i data
	mulu.w	#5,d1	;point to j data
	move.w	#4,d3
exchange_lp1	move.b	(0,a4,d0.w),d2
	move.b	(0,a4,d1.w),(0,a4,d0.w)
	move.b	d2,(0,a4,d1.w)
	addq.l	#1,d0
	addq.l	#1,d1
	dbf	d3,exchange_lp1
	movem.l	(a7)+,d0-d3
	ENDC

	IFEQ	BASIC_opt-6	;if word aligned
exchange	movem.l	d0-d2,-(a7)
	mulu.w	#6,d0	;point to i data
	mulu.w	#6,d1	;point to j data
	move.w	(0,a4,d0.w),d2
	move.w	(0,a4,d1.w),(0,a4,d0.w)	;length
	move.w	d2,(0,a4,d1.w)
	move.l	(2,a4,d0.w),d2	;address
	move.l	(2,a4,d1.w),(2,a4,d0.w)
	move.l	d2,(2,a4,d1.w)
	movem.l	(a7)+,d0-d2
	ENDC

	rts

string_size	dc.l	0

doslib	dc.b	'dos.library',0

today	dc.b	'Today    ',0
future	dc.b	'Future   ',0
day_of_week	dc.b	'Sunday   ',0
	dc.b	'Monday   ',0
	dc.b	'Tuesday  ',0
	dc.b	'Wednesday',0
	dc.b	'Thursday ',0
	dc.b	'Friday   ',0
	dc.b	'Saturday ',0
month	dc.b	'JanFebMarAprMayJunJulAugSepOctNovDec'

	dc.l	0	;to ensure long word alignement
	dc.b	'AB Version 1.3a',0

;STRUCTURE FileInfoBlock

file_info_block	dc.l	0	;fib_DiskKey
	dc.l	0	;fib_DirEntryType
	dcb.b	108,0	;fib_FileName
	dc.l	0	;fib_Protection
	dc.l	0	;fib_EntryType
	dc.l	0	;fib_Size
	dc.l	0	;fib_NumBlocks
	dc.l	0	;ds_Days
	dc.l	0	;ds_Minute
	dc.l	0	;ds_Tick
	dcb.b	116,0	;fib_Comment

date_now	dc.l	0,0,0	;current date

	end