;*************************** AMUS Program Label ******************************
; Filename: DEVCHR.SBR                                      Date: 06/12/89
; Category: DISK         Hash Code: 572-317-373-770      Version: 1.0(103)
; Initials: AMI          Name: AMI BAR-YADIN
; Company: UNITED FASHIONS OF TEXAS                Telephone #: 5126312277
; Related Files:  DEVCHR.BSI
; Min. Op. Sys.: NA                            Expertise Level: BEG
; Special: DEF statements are d/basic only; will have to be edited for use
;	with Alpha's basic.
; Description: Get device characteristics table from basic
;
;
;*****************************************************************************
;* Updated on 12-Jun-89 at 9:03 PM by ; edit time: 0:53:44 *;
;* Created on 23-May-89 at 6:02 PM by Ami Bar-Yadin; edit time: 0:07:02 *;
; DEVCHR.SBR
; get DEVCHR table for a BASIC program
; (C)1989 By Ami Bar-Yadin.	AMUS ID: AMI/AM
;
; usage:
;	xcall devchr,dev,tbl{,nam}
;
;  where:
;	dev,s	string such as "dsk0" (or "dsk0:", "str0:"...)
;	tbl	a table, upto 28 byte, see DEVCHR.BSI
;		may be shorter than full table;
;		only fields that fit will be returned
;	nam,s,8	name of device will be returned if present
;		in "devnnn:" format (ie "DSK3:")
;		NO SIZE CHECKING IS DONE.  8 bytes should be safe.
;
;
;-All commercial rights reserved, etc.
;-No warranties and/or guarranties of any kind, etc.
;-Not responsible for damages resulting from the use of this program, etc.
;-My employer (United Fashions) has nothing to do with this program and
; should not be blamed for it.
;
; I can be reached at:
;		United Fashions of Texas, Inc.
;		200 Ash Ave.
;		McAllen, TX  78501
;		(512) 631-2277
;		8am-6pm
;

VMAJOR=1
VMINOR=0
VEDIT=103.

	SYM
	MAYCREF
	OBJNAM	.SBR
	SEARCH	SYS
	SEARCH	SYSSYM
	RADIX	16.
	DEFAULT	VEDIT,1
	DEFAULT	$$MFLG,PV$RSM
	DEFAULT	$$SFLG,PH$REE!PH$REU
	PHDR	-1,$$MFLG,$$SFLG


	DEFINE	BTYPE N,DEST
1$$	=	2+^D10*<N-1>
	CLR	DEST
	MOVW	1$$(A3),DEST
	ENDM

	DEFINE	BADRS N,DEST
1$$	=	4+^D10*<N-1>
	MOVL	1$$(A3),DEST
	ENDM

	DEFINE	BSIZE N,DEST
1$$	=	8+^D10*<N-1>
	MOVL	1$$(A3),DEST
	ENDM

	.OFINI
	.OFDEF	DDB,D.DDB
	.OFDEF	BUF,512.
	.OFDEF	CHR,DC.SIZ
	.OFSIZ	IMPSIZ


DEVCHR:
	CMPW	@A3,#2		; check for at least 2 parameters
	JLO	ERR1

	BSIZE	2,D2		; check size of output table
	CMP	D2,#4		; at least 4 bytes
	JLO	ERR1

	MOV	A5,A6		; check free memory
	SUB	A4,A6
	CMP	A6,#IMPSIZ
	JLO	ERR2

	MOV	A4,A6		; clear work area
	MOV	#IMPSIZ-1,D6
10$:	CLRB	(A6)+
	DBF	D6,10$
	
	LEA	A6,BUF(A4)	; put buffer right after ddb
	MOV	A6,D.BUF+DDB(A4)
	ORB	#D$INI!D$ERC!D$BYP,D.FLG+DDB(A4) ; set ddb flags

	BADRS	1,A2		; index device name
	LEA	A1,D.DEV+DDB(A4); pack into ddb
	PACK
	GTDEC			; get unit number
	MOVW	D1,D.DRV+DDB(A4); put in ddb

	BADRS	2,A2		; index output table
			; D2 has size already

	LEA	A1,CHR(A4)
	DEVCHR	DDB(A4),@A1	; get device chr tbl
	BNE	50$		; error

	MOVW	#6-1,D6		; upto 6 longs
20$:	SUB	#4,D2		; is there room left?
	BLO	40$
	MOV	(A1)+,D1	; get long
	CALL	PUTB4		; put in basic's format
	DBF	D6,20$

	MOVW	#2-1,D6		; upto 2 words
30$:	SUB	#2,D2		; is there room left?
	BLO	40$
	MOVW	(A1)+,(A2)+	; pass word to basic (same format)
	DBF	D6,30$
	
40$:	CMPW	@A3,#3
	BLO	49$
	TSTW	D.DEV+DDB(A4)	; check for default device
	BNE	45$
	JOBIDX
	MOV	JOBDEV(A6),D.DEV+DDB(A4) ; get logged in device/unit
45$:	BADRS	3,A2
	OFILE	DDB(A4),OT$MEM!OT$OFD
	CLRB	@A2
49$:	RTN

50$:	MOV	#-1,@A2
	RTN


; put a long in basic's format (words swapped)
PUTB4:	SWAP	D1
	MOV	D1,(A2)+
	RTN


ERR1:	TYPE	<?Bad args for >
	BR	ERRX
ERR2:	TYPE	<?No memory left for >
;	BR	ERRX
ERRX:	TYPECR	<XCALL DEVCHR>
	EXIT
;
;
	END

.