;	*****************
;	*		*
;	*   GOTO.ASM	*
;	*     v1.1	*
;	*		*
;	*****************
;
; 08/01/83 Mods by Dave Crane, Dallas RCP/M.
; Added LOMEM equate to check callers access level for
; systems using NZCPR and ZCPR2 option for MAXUSR and MAXDRV.
; This version works only for user areas less than 10.
; Based on SECTION 1.0. Renamed GOTO 1.1.
;
; 06/27/82 by Ron Fowler, Westland, Michigan
;
; This program is intended for RCPM systems where
; files are grouped into drive/user area by their
; classification.  This program implements a naming
; convention, whereby a caller can move into another
; USER area by typing its name, rather than the random
; or total searching formerly needed.
;
; Syntax is:  GOTO [<area-name>]
;
; If area-name is omitted, a short list of
; available areas is printed. The special
; form "GOTO ?" prints the detailed description
; of each area.
;
; You have to fill in the areas table
; (located near the end of this program) for your
; particular system.
;
;----< Examples of use: >-----
;
; A0>GOTO REF	;changes drive/user to reference area
; B4>GOTO IBM	;changes drive/user to IBM/PC area
; A6>GOTO	;prints short list of areas available
; A9>GOTO ?	;prints the detailed list
;
false	equ	0	;define truth and falsehood
true	equ	not false
;
; the following equates may be
; customized to your preference
;
descol	equ	15		;column # where description begins
				;(in detailed list) (should be greater
				;than longest area name) (but small
				;enuf so display is not too long)
perlin	equ	4		;names printed per line in short list
tabpos	equ	10		;tab stops (set mod tabpos)
				;should be at least one greater than
				;longest area name.
turbo	equ	false		;set TRUE if you'er running TurboDOS
LOMEM	equ	TRUE		;set true for MAXDRV, MAXUSR in use
;
; o/s conventions
;
LOCDRV	equ	3Dh		;location of MAXDRV (0=A, 5=F, etc)
LOCUSR	equ	3Fh		;location of MAXUSR+1 (16 = user 15)
cpbase	equ	0		;set to 4200H for Heath, 0 for std systems
ccpdrv	equ	cpbase+4	;ccp user/drive storage loc
bdos	equ	cpbase+5	;system entry point
dfcb	equ	cpbase+5CH	;default file control block
dbuf	equ	cpbase+80H	;default buffer
tpa	equ	cpbase+100H	;base of transient program area
coninf	equ	1		;system call, get console char
conotf	equ	2		;system call, console output
printf	equ	9		;system call, print cons string
cstsf	equ	11		;system call, get console status
setdrv	equ	14		;system call, set/drive system call
getdrv	equ	25		;system call, get drive # system call
gsuser	equ	32		;system call, get/set user number
;
; character definitions
;
cr	equ	13		;carriage-return code
lf	equ	10		;linefeed code
;
; code begins....
;
	org	tpa
;
;
pbase:	lxi	h,0		;save system stack
	dad	sp
	shld	spsave
	lxi	sp,stack	;load local stack
;
	if	not turbo	;cp/m, get drive #
	mvi	c,getdrv	;get current drive #
	call	bdos
	push	psw		;save it
	sta	newdrv		;two ways
	endif
;
	call	area		;perform the main function
;
	if	not turbo	;turbodos doesn't need this stuff
	lda	newdrv		;get newly logged drive
	mov	b,a		;save for comparison
	pop	psw		;get old logged drive
	cmp	b		;did logged drive change?
	jnz	cpbase		;then relog with warm boot
	endif
;
	lhld	spsave		;else restore stack
	sphl
	ret			;to system...
;
; scan cmd line...if an arg exists, attempt to
; match it in the table.  If no arg, dump a list
; of available areas.
;
area:	lda	dfcb+1		;is there a cmd-line arg?
	cpi	' '
	jz	prnqk		;then go print areas out
	cpi	'?'		;wants detailed list?
	jz	prntbl		;then go do it
	lxi	h,dbuf		;something there, scan to it
scanbk: inx	h		;  ignoring blanks
	mov	a,m
	cpi	' '
	jz	scanbk
	lxi	d,table 	;point de to the AREA table
loop:	push	h		;save cmd line arg pointer
eloop:	ldax	d		;test entry against table
	cpi	1		;end of entry marker?
	jnz	noend		;jump if not
	mov	a,m		;yes, did user cmd terminate also?
	ora	a
	jz	match		;then declare a match
	jmp	nomat		;else declare a mismatch
noend:	cmp	m
	jnz	nomat		;skip if no match
	inx	h		;continue with comparison
	inx	d
	jmp	eloop
;
; here when an entry didn't match
;
nomat:	ldax	d
	ora	a		;entry terminator?
	inx	d
	jnz	nomat		;scan through it
	pop	h		;restore cmd line arg pntr
	inx	d		;end of entry, skip over user #
	inx	d		;and drive
	ldax	d		;end of table?
	ora	a		;(terminated by 0)
	jnz	loop		;go scan another if not
;
; here when no match can be found
;
	lxi	d,matmsg	;print out no-match message
	mvi	c,printf
	call	bdos
	jmp	prnqk		;go give short list
;
; here when a match is found
HLSAVE	DS	2
DESAVE	DS	2
;
match:	SHLD	HLSAVE		;Need to restore if LOMEM test fails
	xchg			;hl==> user #
	SHLD	DESAVE		;Needed if LOMEM test fails
scmat:	inx	h		;scan past description
	mov	a,m		;looking for terminating null
	ora	a
	jnz	scmat
	inx	h		;skip over terminator
	mov	a,m		;fetch user #
	sui	'0'		;subtract ascii bias
	mov	e,a
	inx	h		;point hl to drive #
;
	IF	LOMEM
	LDA	LOCUSR		;Look for USER authorization
	SUI	1
	CMP	E		;compare to DE
	JM	NG		;failed
	LDA	LOCDRV
	ACI	'A'		;add ASCII bias
	CMP	M
	JM	NG		;failed
	JMP	OK
NG:	LHLD	DESAVE		;RESTORE
	XCHG
	LHLD	HLSAVE
	JMP	NOMAT		;never mind!
OK:	ENDIF	;LOMEM
;
	push	d		;save user #
	push	h		;and pointer
	mvi	c,gsuser	;set user number
	call	bdos
	pop	h		;restore pointer to drive
	mov	a,m		;fetch drive
	sui	'A'		;subtract ascii bias
	sta	newdrv		;set new logged drive
	pop	d		;restore user number in e
	mov	d,a		;save drive #
	mov	a,e		;fetch user number
	rlc			;rotate to high nybble
	rlc
	rlc
	rlc
	ora	d		;"or" in the drive
	sta	ccpdrv		;save for ccp use
;
	if	turbo		;if turbodos...
	mvi	c,setdrv	;...have to set drive explicitly
	mov	e,d		;get drive in e
	call	bdos		;set the drive
	endif
;
	pop	h		;clear garbage from stack
	ret			;all done
;
; message printed when match failed
;
matmsg: db	cr,lf,'++ Entry not found ++'
	db	cr,lf,cr,lf,'$'
matms2: db	cr,lf,'Type "GOTO ?" for detailed list'
	db	cr,lf,'      of available areas.',cr,lf
	db	cr,lf,'Type "GOTO <area-name>" to log'
	db	cr,lf,'      into a particular area.'
	db	cr,lf,'$'
;
; print "quick list"
;
prnqk:	lxi	d,tblmsg
	mvi	c,printf
	call	bdos
	lxi	h,table 	;print abbreviated list
qloop:	mvi	b,perlin	;get names-per-line counter
qloop2: mov	a,m		;end of table?
	ora	a
	jz	qkend		;then go print end msg
;
	IF	LOMEM		;see if we want to print this entry
	SHLD	HLSAVE		;park it
ZSCAN:	MOV	A,M		;assume this is end of string
	INX	H		;point to next location 
	CPI	0		;was it really end of string?
	JNZ	ZSCAN		;loop until found
	LDA	LOCUSR		;HL points to user/drive
	ACI	30H-1		;add ASCII bias less 1
	CMP	M		;compare to MAXUSR
	INX	H		;point to drive
	JM	QX		; failed
	LDA	LOCDRV		;get MAXDRV
	ACI	'A'		;ASCII BIAS
	CMP	M		;compare to MAXDRV
QX:	INX	H		;point to next parameter field
	JM	QLOOP2		; failed
OKPQ:	LHLD	HLSAVE		;restore pointer - passed both tests
	ENDIF	;LOMEM
;
	call	prathl		;else print the name
qscan:	mov	a,m		;scan to description terminator
	inx	h		;(this effectively ignores
	ora	a		; the description)
	jnz	qscan
	inx	h		;skip over user #
	inx	h		;and drive #
	dcr	b		;count down line entry counter
	jnz	qtab		;go tab if line not full
	call	crlf		;else turn up new line
	jmp	qloop		;and continue
;
; tab between entry names
;
qtab:	mvi	a,' '		;seperate names with tabs
	call	type
	lda	column		;get column #
qsub:	sui	tabpos		;test tab position
	jz	qloop2		;continue if at a tab position
	jnc	qsub		;convert mod tabpos
	jmp	qtab		;keep tabbing
;
qkend:	call	crlf		;do newline
	lxi	d,matms2	;print ending message
	mvi	c,printf
	call	bdos
	call	crlf
	ret
;
; here to print out a list of available area numbers
;
prntbl: lxi	d,tblmsg	;print heading message
	mvi	c,printf
	call	bdos
	call	crlf		;turn up new line
	lxi	h,table
prloop: mov	a,m		;end-of-table?
	ora	a
	rz			;then all done
;
	IF	LOMEM		;see if we want to print this entry
	SHLD	HLSAVE		;park it
ZSCAN2: MOV	A,M		;assume this is end of string
	INX	H		;point to next location 
	CPI	0		;was it really end of string?
	JNZ	ZSCAN2		;loop until found
	LDA	LOCUSR		;HL points to user/drive
	ACI	30H-1		;add ASCII bias less 1
	CMP	M		;compare to MAXUSR
	INX	H		;point to drive
	JM	QX2		; failed
	LDA	LOCDRV		;get MAXDRV
	ACI	'A'		;ASCII BIAS
	CMP	M		;compare to MAXDRV
QX2:	INX	H		;point to next parameter field
	JM	PRLOOP		; failed
OKPQ2:	LHLD	HLSAVE		;restore pointer - passed both tests
	ENDIF	;LOMEM
;
	call	prathl		;print the name
tab:	mvi	a,'.'		;tab over with leader
	call	type
	lda	column		;get column
	cpi	descol		;at description column yet?
	jc	tab		;then keep tabbing
	call	prathl		;print description
	inx	h		;skip over user #
	inx	h		;and drive number
	call	crlf		;turn up new line
	jmp	prloop		;and continue
;
; print message @hl until null or 01 binary
;
prathl: mov	a,m		;fetch char
	inx	h		;point past it
	ora	a		;null?
	rz			;then done
	cpi	1		;1 also terminates
	rz
	call	type		;nope, print it
	call	break		;check for console abort
	jmp	prathl
;
; test for request from console to stop (^C)
;
break:	push	h		;save 'em all
	push	d
	push	b
	mvi	c,cstsf 	;get console sts request
	call	bdos
	ora	a		;anything waiting?
	jz	brback		;exit if not
	mvi	c,coninf	;there, is, get it
	call	bdos
	cpi	'S'-64		;got pause request?
	mvi	c,coninf
	cz	bdos		;then wait for another character
	cpi	'C'-64		;got abort request?
	jz	quit		;then go abort
brback: pop	b		;else restore and return
	pop	d
	pop	h
	ret
;
; request from console to abort
;
quit:	lxi	d,qmesg 	;tell of quit
	mvi	c,printf
	call	bdos
	lhld	spsave		;get stack pointer
	sphl
	ret
;
qmesg:	db	cr,lf,'++ Aborted ++',cr,lf,'$'
;
; turn up a new line on display
;
crlf:	mvi	a,cr		;print a return
	call	type
	mvi	a,lf		;get lf, fall into type
;
; Routine to print char in A on console,
; while maintaining column number. 
;
type:	push	h		;save everybody
	push	d
	push	b
	mov	e,a		;align char for printing
	push	psw		;save char
	mvi	c,conotf
	call	bdos		;print it
	pop	psw		;restore char
	lxi	h,column	;bump column counter
	cpi	lf		;linefeed doesn't chang column
	jz	nochg
	inr	m
	cpi	cr		;carriage-return zeroes it
	jnz	nochg		;skip if not cr
	mvi	m,0		;is, zero column
nochg:	pop	b		;restore & return
	pop	d
	pop	h
	ret
;
; dump heading message
;
tblmsg: db	cr,lf,'Available areas are:',cr,lf,'$'

;
; variables
;
spsave: dw	0		;stack-pointer save
column: db	0		;current column #
newdrv: db	0		;new drive # to log
	ds	20		;the stack
;
stack	equ	$		;define it
;
; SECTIONS TABLE (located at end for easy patching with DDT)
;
; This is the table that defines the areas.  Entry format is:
;
;	<name>,sep,<description>,null,user,drive
;
; where <name>	       is the area name
;	sep	       is a binary 1 used to terminate the match test
;	<description>  is a one-line-or-less comment printed when
;		       the list is dumped.  Match testing terminates
;		       before this field.
;	null	       is a binary 0 used to terminate the description
;	user	       is the user number (0-15) of the area (ascii)
;	drive	       is the drive (A-P) number of the area (ascii)
;
; the table ends with a <name> of zero (binary).
;
; Note: be sure to make area names ALL-CAPS, because the
;	CCP converts command-line arguments to capitals. The
;	description may be in lower case, since it has nothing
;	to do with the matching process.
; Also: although the drive and user # is in ascii (for convenience
;	in setting up the table), be sure to use caps for the
;	drive designation.  No error checking is done on the values.
;
table:
	db	'CPM80',1,'C2: Miscellaneous CP/M-80 programs',0
	db	'2C'	;user 2, drive C
;
	db	'ENGG',1,'B0: Programs for Engineers',0
	db	'0B'	;user 0, drive B
;
	db	'GEN',1,'C0: Business programs, calculators, etc.',0
	db	'0C'	;user 0, drive C
;
	db	'GEOL',1,'B1: Programs for Geologists',0
	db	'1B'	;user 1, drive B
;
	db	'IBM',1,'B2: Programs related to the IBM Personal Computer',0
	db	'2B'	;user 2, drive B
;
	db	'KITS',1,'A1: Starter Kits for new callers',0
	db	'1A'	;user 1, drive A
;
	db	'MISC',1,'C3: Miscellaneous unclassified',0
	db	'3C'	;user 3, drive C
;
	db	'MODEM',1,'C1: Modem/communications programs',0
	db	'1C'	;user 1, drive C
;
	db	'OTHERSYS',1,'A3: Telephone numbers of other systems',0
	db	'3A'	;user 3, drive A
;
	db	'REF',1,'A2: Catalogs, pgm descriptions, references, etc.',0
	db	'2A'	;user 2, drive A
;
	db	'SYSTEM',1,'A0: System programs, information and NEWS',0
	db	'0A'	;user 0, drive A
;
	db	'16BIT',1,'B3: 68000, 8086/8088 Assembler and CP/M-86',0
	db	'3B'	;user 3, drive B
;
	db	0		;<<== end of table
;
; -----< end of SECTIONS table>-----
;
	end	pbase		;that's all.
	db	'3B'	;user 3, drive B
;
	db	0		;<<== end of tab