title	SETLST utility
	name	('SETLST')

; The AMSTRAD SETLST utility for PCW machines

; Disassembled by W.Cirsovius

; Call: SETLST file

BDOS	equ	0005h
FCB	equ	005ch

_Conout	equ	 2
_Lstout	equ	 5
_String	equ	 9
_Open	equ	15
_RdSeq	equ	20
_SetDMA	equ	26

_OSerr	equ	255

_cr	equ	32

RecLng	equ	128

ASCmask	equ	00011111b
LoMask	equ	00001111b
MSB	equ	7

lf	equ	0ah
cr	equ	0dh
eot	equ	'$'
eof	equ	'Z'-'@'
eos	equ	-1		; End of list indicator

_EO	equ	5
_EX	equ	4
_NM	equ	3
_HX	equ	2
_IG	equ	0

	jr	SETLST

	db	'SETLST #116',cr,lf
	db	'Developed by Locomotive Software Ltd.',cr,lf
	db	'Copyright (C) 1985 '
	db	'Amstrad Consumer Electronics PLC',cr,lf
;
; %%%%%%%%%%%%%%%%%%%%
; %%% START SETLST %%%
; %%%%%%%%%%%%%%%%%%%%
;
SETLST:
	ld	(UsrStk),sp	; Save callers stack
	ld	sp,LocStk	; Get local one
	call	PrepFile	; Prepare file
	call	c,ProcLst	; Process list file
	ld	sp,(UsrStk)	; Get back caller
	ret
;
; Process the list file
;
ProcLst:
	jr	LstLoop
LstDef:
	ld	e,a
	ld	c,_Lstout
	call	BDOS		; Put to printer
LstLoop:
	call	GetStrVal	; Get string value
	jr	nz,LstDef	; .. put to printer
	call	FixNL		; Test end of line
	ld	de,$BAD.VAL
	call	z,ProcErr	; .. error if not
	call	.EOF?		; Test end of file
	jr	z,LstLoop	; .. nope
	ret
$BAD.VAL:
	db	'Bad value',cr,lf,eot
;
; Process error
; ENTRY	Reg DE points to error message
;
ProcErr:
	push	bc
	push	af
	call	String		; Print error
	call	GetAttr		; Test EOL or EOF
	jr	nz,PE.ex	; .. yeap
	ld	de,$IGNORE
	call	String		; Tell ignoring
	jr	PE.go
PE.loop:
	ld	a,c
	call	Conout		; Print character
PE.go:
	call	GetChr		; Get character and attribute
	call	GetAttr		; Test EOL or EOF
	call	Get		; Get character from file
	jr	z,PE.loop	; .. there is more to print
	ld	de,$CRLF
	call	String		; .. close line
PE.ex:
	pop	af
	pop	bc
	ret
$IGNORE:
	db	'Ignoring rest of line: ',eot
$CRLF:
	db	cr,lf,eot
;
; Tell file not found
;
OpenErr:
	push	de
	ld	de,$CANNOT
	call	String		; Print error
	pop	de
	ret
$CANNOT:
	db	'Cannot open file',cr,lf,eot
;
; Print string on console
; ENTRY	Reg DE points to string closed by '$'
;
String:
	push	hl
	push	de
	push	bc
	push	af
	ld	c,_String
	call	BDOS		; .. print
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Print character on console
; ENTRY	Accu holds character
;
Conout:
	push	hl
	push	de
	push	bc
	push	af
	ld	e,a
	ld	c,_Conout
	call	BDOS		; .. print
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Get string value
; EXIT	Accu holds value
;	Zero flag set on end
;
GetStrVal:
	push	hl
	push	de
	push	bc
	jr	GSV.go
GSV.loop:
	call	Get		; Get character from file
GSV.go:
	call	GetChr		; Get character and attribute
	ld	a,b
	or	NOT (1 SHL _EO)	; Check for EOL or EOF
	inc	a
	jr	z,GSV.ex	; .. yeap
	ld	a,c
	cp	' '
	jr	c,GSV.loop	; .. skip control
	cp	'"'		; Test empty string
	jr	z,GSV.ex
	cp	'^'
	call	Get		; Get next character from file
	call	z,GetStrByte	; Process prefix
	call	z,UnGet		; Unget character
GSV.ex:
	pop	bc
	pop	de
	pop	hl
	ret
;
; Get byte from string
; EXIT	Accu holds byte
;	Zero flag set on invalid control
;
GetStrByte:
	call	GetChr		; Get character and attribute
	ld	a,c
	cp	'^'		; Test control prefix
	jr	z,GSB.skp
	cp	'"'		; .. test string prefix
	jr	z,GSB.skp
	cp	'@'		; Test control
	jr	c,GSB.Numb?
	and	ASCmask		; .. mask what we got
GSB.skp:
	call	Get		; Get character from file
	jr	GSB.ex
GSB.Numb?:
	cp	''''		; Test numeric value
	jr	z,GSB.Numb		; .. yeap
	xor	a		; Set error
	ret
GSB.Numb:
	call	Get		; Get character from file
	call	GetNum		; Get number
	call	z,GetKeyWrd	; .. nope, try key word
	jp	z,UnGet		; Unget character if invalid
	call	GetChr		; Get character and attribute
	ld	a,c
	cp	''''
	call	z,Get		; Get character from file
	ld	a,l		; Get byte
GSB.ex:
	ld	b,0
	inc	b		; Fix success
	ret
;
; Get control keyword
; EXIT	Reg L holds code on success
;	Zero flag set on error
;
GetKeyWrd:
	ld	hl,$KEYWRD
	call	FindStr		; Find keyword
	ld	a,h
	inc	a		; .. fix for result
	ret
;
; Keywords of control strings
; On success	reg L holds control code
;		reg H holds 0
; Otherwise	reg L holds 0
;		reg H holds -1
;
$KEYWRD:
	db	'NUL',eos,'@'-'@',0
	db	'SOH',eos,'A'-'@',0
	db	'STX',eos,'B'-'@',0
	db	'ETX',eos,'C'-'@',0
	db	'EOT',eos,'D'-'@',0
	db	'ENQ',eos,'E'-'@',0
	db	'ACK',eos,'F'-'@',0
	db	'BEL',eos,'G'-'@',0
	db	'BS',eos,'H'-'@',0
	db	'HT',eos,'I'-'@',0
	db	'LF',eos,'J'-'@',0
	db	'VT',eos,'K'-'@',0
	db	'FF',eos,'L'-'@',0
	db	'CR',eos,'M'-'@',0
	db	'SO',eos,'N'-'@',0
	db	'SI',eos,'O'-'@',0
	db	'DLE',eos,'P'-'@',0
	db	'DC1',eos,'Q'-'@',0
	db	'DC2',eos,'R'-'@',0
	db	'DC3',eos,'S'-'@',0
	db	'DC4',eos,'T'-'@',0
	db	'NAK',eos,'U'-'@',0
	db	'SYN',eos,'V'-'@',0
	db	'ETB',eos,'W'-'@',0
	db	'CAN',eos,'X'-'@',0
	db	'EM',eos,'Y'-'@',0
	db	'SUB',eos,'Z'-'@',0
	db	'ESC',eos,'['-'@',0
	db	'FS',eos,'\'-'@',0
	db	'GS',eos,']'-'@',0
	db	'RS',eos,'^'-'@',0
	db	'US',eos,'_'-'@',0
	db	'SP',eos,' ',0
	db	'DEL',eos,7fh,0
	db	'XON',eos,'Q'-'@',0
	db	'XOFF',eos,'S'-'@',0
	db	eos,0,eos
;
; >>> NEVER CALLED ROUTINE <<<
;
; Test current character a string indicator
; EXIT	Zero set if not string indicator
;
STRING?:
	push	bc
	call	GetChr		; Get character and attribute
	ld	a,c
	sub	'"'		; Test string
	cp	1
	sbc	a,a
	call	nz,Get		; Get character from file if so
	pop	bc
	ret
;
; Get number from input
; EXIT	Zero set if no number
;	Reg HL holds number
;
GetNum:
	push	bc
	call	ChrGet		; Get valid character
	bit	_NM,b		; Test number
	jr	z,GN.hex	; .. nope
	call	GetDec
	jr	GN.ex
GN.hex:
	bit	_EX,b		; Test hex prefix
	jr	z,GN.ex		; .. nope
	call	GetHex		; .. get it
GN.ex:
	pop	bc
	ret
;
; Get decimal number
; EXIT	Reg HL holds number
;
GetDec:
	push	de
	push	bc
	call	ChrGet		; Get valid character
	bit	_NM,b		; Test number
	jr	z,GD.ex		; .. no
	ld	hl,0		; Init result
	jr	GD.go
GD.loop:
	ld	e,l		; Copy number
	ld	d,h
	add	hl,hl		; *  2
	add	hl,hl		; *  4
	add	hl,de		; *  5
	add	hl,hl		; * 10
GD.go:
	ld	a,c
	sub	'0'		; Strip off offset
	add	a,l
	ld	l,a		; .. add to old number
	adc	a,h
	sub	l
	ld	h,a
	call	Get		; Get character from file
	call	GetChr		; .. and attribute
	bit	_NM,b		; Test still number
	jr	nz,GD.loop	; .. yeap
	or	1		; .. set success
GD.ex:
	pop	bc
	pop	de
	ret
;
; Get hex number
; EXIT	Reg HL holds number
;
GetHex:
	push	bc
	call	ChrGet		; Get valid character
	bit	_EX,b		; Test expansion prefix
	jr	z,GH.ex		; .. nope
	call	Get		; Get character from file
	call	GetChr		; .. and attribute
	bit	_HX,b		; Test hex
	call	z,UnGet		; Unget character if not
	jr	z,GH.ex		; .. and exit
	ld	hl,0		; Init result
	jr	GH.go
GH.loop:
	add	hl,hl		; *  2
	add	hl,hl		; *  4
	add	hl,hl		; *  8
	add	hl,hl		; * 16
GH.go:
	ld	a,c		; Get character
	and	LoMask		; Mask lower part
	bit	_NM,b		; Test 0..9
	jr	nz,GH.dec	; .. yeap
	add	a,9		; Fix for hex
GH.dec:
	or	l
	ld	l,a		; Put into result
	call	Get		; Get character from file
	call	GetChr		; .. and attribute
	bit	_HX,b		; Test still hex
	jr	nz,GH.loop	; .. yeap
	or	1		; Set success
GH.ex:
	pop	bc
	ret
;
; Look for end of line
; EXIT	Zero set if not end
;
FixNL:
	call	GetAttr
	call	nz,Get
	ret
;
; Test current character end of file
; EXIT	Zero set if not EOF
;
.EOF?:
	jp	EOF?
;
; Find string from table
; ENTRY	Reg HL points to table
; EXIT	Reg L holds 1st operand
;	Reg H holds 2nd operand or -1 if not found
;
FindStr:
	push	de
	push	bc
	push	af
	call	ChrGet		; Get valid character
	ld	d,b		; Save attribute
	dec	hl		; .. fix list
	jr	FS.go
FS..unget:
	inc	e
FS.unget:
	dec	e
	call	nz,UnGet	; Unget character
	jr	nz,FS.unget
FS.skip:
	ld	a,(hl)		; Get character
	inc	hl
	inc	a
	jr	nz,FS.skip	; .. skip item
	inc	hl
FS.go:
	ld	e,0		; Init counter
	jr	FS.cmp
FS.loop:
	call	CmpChr		; Compare character
	jr	nz,FS..unget	; .. not found
	call	Get		; Get character from file
	inc	e
FS.cmp:
	call	GetChr		; Get character and attribute
	inc	hl
	ld	a,(hl)
	cp	eos		; Test end of string
	jr	nz,FS.loop	; .. nope
	inc	e
	dec	e		; Test total end
	jr	z,FS.end	; .. yeap
	ld	a,b
	xor	d		; Test same attribute
	and	00101011b	; Test result
	jr	z,FS..unget	; .. still searching
FS.end:
	inc	hl
	ld	e,(hl)		; Get operands
	inc	hl
	ld	d,(hl)
	ex	de,hl		; .. into right reg
	pop	af
	pop	bc
	pop	de
	ret
;
; Compare characters
; ENTRY	Accu and reg C hold characters
; EXIT	Zero set if same
;
CmpChr:
	sub	c		; Compare
	ret	z		; .. found
	cp	-' '		; Test blank ????
	ret	nz		; .. nope
	ld	a,b
	or	11111101b	; Fix attribute
	inc	a		; .. fix result
	ret
;
; Get valid definition character from file
;
ChrGet:
	jr	.ChrGet		; .. skip reading from file
CG.loop:
	call	Get		; Get character from file
.ChrGet:
	call	GetChr		; Get character and attribute
	bit	_EO,b		; Test end of file or line
	ret	nz		; .. exit
	bit	_IG,b		; Test valid character
	jr	nz,CG.loop	; .. nope
	ret
;
; Prepare the key file
; EXIT	Carry set if file found
;
PrepFile:
	push	hl
	push	de
	push	bc
	xor	a
	ld	(RecPtr),a	; Clear pointer
	ld	hl,Buff1	; Init buffer
	ld	(BufPtr),hl
	xor	a
	ld	(FCB+_cr),a	; Clear current record
	ld	de,FCB
	ld	c,_Open
	call	BDOS		; Find file
	cp	_OSErr		; Test file here
	call	nc,OpenErr	; .. nope
	pop	bc
	pop	de
	pop	hl
	ret	nc		; .. exit on error
;
; Get character from file
; Put result into memory
;
Get:
	push	hl
	push	de
	push	bc
	push	af
	ld	a,(RecPtr)	; Get pointer
	or	a
	jr	nz,Get.Buff	; .. not empty
	ld	hl,(BufPtr)	; Get pointer
	ld	de,Buff1	; Test position
	sbc	hl,de
	jr	nz,Get.mem	; .. not at start
	xor	a
	ld	(FCB+_cr),a
	ld	de,Buff1
	ld	c,_SetDMA
	call	BDOS		; Set disk buffer
	ld	de,FCB
	ld	c,_RdSeq
	call	BDOS		; Read record
	or	a		; Test more
	jr	z,Get.more1	; .. yeap
	ld	a,eof
	ld	(Buff1),a	; Set end of file
Get.more1:
	ld	a,RecLng
	ld	(RecPtr),a	; Set buffer filled
	jr	Get.Buff
Get.mem:
	ld	a,l
	cp	RecLng		; Test at start of 2nd buffer
	jr	z,Get.at2nd	; .. yeap
	ld	bc,RecLng
	ld	de,Buff1
	ld	hl,Buff2
	ldir			; Unpack record
Get.at2nd:
	ld	de,Buff2
	ld	c,_SetDMA
	call	BDOS		; Set 2nd buffer
	ld	de,FCB
	ld	c,_RdSeq
	call	BDOS		; .. read it
	or	a		; Test end of file
	jr	z,Get.more2	; .. nope
	ld	a,eof
	ld	(Buff2),a	; Set end of file
Get.more2:
	ld	a,RecLng
	ld	(RecPtr),a	; Set buffer filled
	ld	hl,Buff2
	ld	(BufPtr),hl	; Set other buffer
Get.Buff:
	ld	hl,(BufPtr)	; Get buffer
	ld	c,(hl)		; .. fetch character
	ex	de,hl
	call	PutChr		; Save character and attribute
	ld	a,c
	cp	eof		; Test end of file
	jr	z,Get.eof	; .. yeap
	ld	a,(RecPtr)
	dec	a		; Fix pointers if not
	ld	(RecPtr),a
	ex	de,hl
	inc	hl
	ld	(BufPtr),hl
Get.eof:
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Unget current character
;
UnGet:
	push	hl
	push	de
	push	bc
	push	af
	ld	a,(Char)	; Get character
	cp	eof		; Test end of file
	ld	hl,(BufPtr)
	jr	z,UG.dummy	; .. yeap, skip
	ld	hl,RecPtr
	inc	(hl)		; Fix pointers if not
	ld	hl,(BufPtr)
	dec	hl
	ld	(BufPtr),hl
UG.dummy:
	dec	hl
	ld	c,(hl)
	call	PutChr		; Save character and attribute
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret
;
; Put character and attribute into memory
; ENTRY	Reg C holds character
;
PutChr:
	bit	MSB,c		; Test 80..FF
	ld	b,01h
	jr	nz,.PutChr	; .. yeap, set standard
	ld	b,0
	ld	hl,AttrTable
	add	hl,bc
	ld	b,(hl)		; Fetch attribute
.PutChr:
	ld	(Char),bc	; Save character and attribute
	ret
;
; Get current character and attribute
; EXIT	Reg C holds character
;	Reg B holds attribute
;
GetChr:
	ld	bc,(Char)	; Get character and attribute
	ret
;
; Get EOL or EOF state of current character
; EXIT	Zero set if not EOL or EOF
;
GetAttr:
	ld	a,(Attr)	; Get attribute
	and	1 SHL _EO	; .. test bit
	ret
;
; Test current character end of file
; EXIT	Zero set if not EOF
;
EOF?:
	ld	a,(Char)	; Get character
	sub	eof		; Fix for end of file
	cp	1
	sbc	a,a
	ret
;
; Attribute table of all ASCII characters
; Bit definitions:
;
;    7    6    5    4    3    2    1    0
; +----+----+----+----+----+----+----+----+
; | xx | xx | EO | EX | NM | HX | AN | IG |
; +----+----+----+----+----+----+----+----+
;
; xx	N.C.
; EO	EOL or EOF
; EX	Extension string
; NM	Numeric 0..9
; HX	Hex range A..F
; AN	Alphanumeric prefix
; IG	Ignore for definition
;
AttrTable:
;
; Control characters
;
	db	01h,01h,01h,01h,01h,01h,01h	; 00..06
	db	01h,01h,01h,01h,01h,01h,21h	; 07..0D
	db	01h,01h,01h,01h,01h,01h,01h	; 0E..14
	db	01h,01h,01h,01h,01h,21h,01h	; 15..1B
	db	01h,01h,01h,01h			; 1C..1F
;
; ASCII characters
;
	db	01h,01h,00h,10h,01h,01h,10h	;  !"#$%&
	db	01h,01h,01h,01h,01h,01h,01h	; '()*+,\
	db	00h,01h,0ch,0ch,0ch,0ch,0ch	; ./01234
	db	0ch,0ch,0ch,0ch,0ch,01h,01h	; 56789:;
	db	01h,01h,01h,01h,01h,06h,06h	; <=>?@AB
	db	06h,06h,06h,06h,02h,02h,02h	; CDEFGHI
	db	02h,02h,02h,02h,02h,02h,02h	; JKLMNOP
	db	02h,02h,02h,02h,02h,02h,02h	; QRSTUVW
	db	02h,02h,02h,01h,01h,01h,01h	; XYZ[\]^
	db	01h,01h,06h,06h,06h,06h,06h	; _`abcde
	db	06h,02h,02h,02h,02h,02h,02h	; fghijkl
	db	02h,02h,02h,02h,02h,02h,02h	; mnopqrs
	db	02h,02h,02h,02h,02h,02h,02h	; tuvwxyz
	db	01h,01h,01h,01h,01h		; {|}~DEL

	db	eof

	ds	838,0

UsrStk	equ	1100h
LocStk	equ	UsrStk+258
BufPtr	equ	UsrStk+258
RecPtr	equ	BufPtr+2
Char	equ	RecPtr+1
Attr	equ	Char+1
Buff1	equ	Attr+1
Buff2	equ	Buff1+RecLng

	end