.TITLE	DBSFRM ... DBSMNG form definition macros
.IDENT	/200783/
.enabl	lc
;
;
;	Written by	Ray Di Marco
;			7-Jun-83.
;
;
;	Version		070683/02.
;
;
;----------------------------------------------------------------------------
;
;
; This file contains the definition of the FORM macro needed to define a
; DBSMNG template. The FORM macro is used to initialize variables needed for
; the definition process and to define the subsiduary macros needed. Refer to
; DBSMNG documentation for a description of the macros.
; 
; 
; 
; 
; 

.SBTTL	Modifications
;
; 20-Jul-83	correct RADIX problem
;

.MACRO	FORM	NAME,BLOCK,ENTRIES=100.,DEVICE=DBS
.enabl	lc
.nchr	zzzzzz,NAME
.iif	ne,zzzzzz-6,.error zzzzzz ; NAME not 6 letters long!
.iif	ndf,BASE.X	BASE.X	= 0
.iif	ndf,BASE.Y	BASE.Y	= 5.
.iif	ndf,.PROT.	.PROT.	= ^O100000
			.ASC.	= 1
			.ALP.	= 2
			.NUM.	= 3
			.DAT.	= 4
			NUMFDB	= 0				
			NUMKDB	= 0				
			RECOFS	= 0		
			KEYOFS	= 0		
			NUMPAG	= 0
			SPCFLG	= 0
			CASFLG	= 0
	.psect	frmhdr
FORM$$:	.psect	frmfdt		
FDT:	.psect	frmkdt		
KDT:	.psect	frmrcd		
RECADD:	.psect	frmkey		
KEYADD:	.psect	frmlbf
LABELF:	.psect	frmlbk
LABELK:	.psect	frmfil
	.psect	frmmes

.MACRO	$$NAME	NAME
	.nchr	zzzzzz,<name>
	.if	eq,zzzzzz-2
		.iif	eq,"NAME-^O067162	spcflg = spcflg!1
		.iif	eq,"NAME-^O067143	spcflg = spcflg!2
		.iif	eq,"NAME-^O072163	spcflg = spcflg!4
		.iif	eq,"NAME-^O062143	spcflg = spcflg!8.
		.iif	eq,"NAME-^O062145	spcflg = spcflg!16.
		.iif	eq,"NAME-^O062144	spcflg = spcflg!32.
	.endc
	.psect	frmmes
	$$$SON	= .
		.irpc	X,<NAME>
		 .byte	''X!casflg
		.endr
		.byte	^O200
.ENDM	$$NAME
.MACRO	$$DATA	DATA,TYPE,PROTEC,PSECT
	.psect	psect
	$$$SOD	= .
	$$$SIZ	= 0
	.if	le,TYPE-2
		.ascii	/DATA/
		$$$SIZ	= .-$$$SOD
	.endc
	.if	eq,TYPE-3
		.even
		$$$SOD	= .
		.byte	0,0
		.nchr	$$$SIZ,<DATA>
	.endc
	.if	eq,TYPE-4
		.even
		$$$SOD	= .
		.byte	8.,0
		$$$SIZ	= 8.
	.endc
	.iif	eq,$$$SIZ .error TYPE ; illegal field t y p e
	.iif	ne,PROTEC	$$$TYP=TYPE+.PROT.
	.iif	eq,PROTEC	$$$TYP=TYPE
.ENDM	$$DATA

.MACRO FIELD X,Y,TYPE,DATA,XN=0,NAME,LD='[,RD='],CHECK=-1,PROTEC=0,PAGE=0,KEY
	$$name	<NAME>
	$$data	<DATA>,TYPE,PROTEC,frmrcd
		RECOFS = $$$SOD-RECADD
	.psect	frmfdt
	.word	$$$TYP,$$$SIZ,RECOFS,X+BASE.X,Y+BASE.Y,CHECK,PAGE,0
	.byte	XN+BASE.X,Y+BASE.Y
	.word	$$$SON
	.byte	X+BASE.X-1,Y+BASE.Y,LD,X+BASE.X+$$$SIZ,Y+BASE.Y,RD
	.if	eq,NUMFDB
	 .ift
		.word	0,0,LABELF-FDT
	 .iff
		.word	0,0,0
	.endc
	NUMFDB	= NUMFDB+1
	.iif	lt,NUMPAG-PAGE,	NUMPAG	= PAGE
	.if	nb,key
		$$name	<NAME>
		$$data	<DATA>,TYPE,0,frmkey
			KEYOFS = $$$SOD-KEYADD
		.psect	frmkdt
		.word	$$$TYP,$$$SIZ,KEYOFS
		.word	31.,5.+NUMKDB
		.word	CHECK,0000,0
		.byte	10.,5.+NUMKDB
		.word	$$$SON
		.byte	30.,5.+NUMKDB,'[
		.byte	31.+$$$SIZ,5.+NUMKDB,']
		.if	eq,NUMKDB
		 .ift
			.word	0,0,LABELK-KDT
		 .iff
			.word	0,0,0
		.endc
		NUMKDB	= NUMKDB+1
	 .endc
.ENDM	FIELD
.MACRO	LABEL	X,Y,NAME,PAGE=0
	.if	dif,page,key
	 .ift
		.psect	frmlbf
		.byte	PAGE,base.y+Y,base.x+X
		.ascii	/'NAME'/<^O200>
	 .iff
		.psect	frmlbk
		.byte	0,base.y+Y,base.x+X
		.ascii	/'NAME'/<^O200>
	.endc
.ENDM	LABEL
.MACRO	SPARE	X,Y,TYPE,DATA,XN=0,NAME,LD='[,RD='],CHECK=-1,PROTEC=0,PAGE=0
	$$data	<DATA>,TYPE,PROTEC,frmrcd
		RECOFS = $$$SOD-RECADD
	.psect	frmfdt
.ENDM	SPARE
.MACRO	FORMEND
.ENDM	FORMEND

.MACRO	KEY	X,Y,TYPE,DATA,XN=0,NAME,LD='[,RD='],CHECK=-1,PROTEC=0
	$$name	<NAME>
	$$data	<DATA>,TYPE,0,frmkey
		KEYOFS = $$$SOD-KEYADD
	.psect	frmkdt
	.word	$$$TYP,$$$SIZ,KEYOFS,X+BASE.X,Y+BASE.Y,CHECK,0000,0
	.byte	XN+BASE.X,Y+BASE.Y
	.word	$$$SON
	.byte	X+BASE.X-1,Y+BASE.Y,LD,X+BASE.X+$$$SIZ,Y+BASE.Y,RD
	.if	eq,NUMKDB
	 .ift
		.word	0,0,LABELK-KDT
	 .iff
		.word	0,0,0
	.endc
	NUMKDB	= NUMKDB+1
.ENDM	KEY

.MACRO	KEYEND
	.if	eq,spcflg
casflg	= ^O40
field	03.-base.x,23.-base.y .NUM.,<.....>	00.-base.x,rn,PROTEC=1,KEY=Y
field	14.-base.x,23.-base.y .NUM.,<.....>	11.-base.x,cn,PROTEC=1,KEY=Y
field	25.-base.x,23.-base.y .ASC.,<..>	22.-base.x,st,PROTEC=1,KEY=Y
field	42.-base.x,23.-base.y .DAT.,<........>	39.-base.x,cd,PROTEC=1
field	56.-base.x,23.-base.y .DAT.,<........>	53.-base.x,ed,PROTEC=1
field	70.-base.x,23.-base.y .DAT.,<........>	67.-base.x,dd,PROTEC=1
casflg	= 00
	.endc
;
	.psect	frmrcd
RECEND:	.psect	frmkey
KEYEND:	.psect	frmlbf
	.byte	^O200
	.psect	frmlbk
	.byte	^O200
;
	zzzzzz	= RECEND-RECADD
	.if	ge,zzzzzz-512.
	 .ift
		BLK = <<<zzzzzz+^O777>&^O177777>/^O1000>
	 .iff
		BLK = -1.
		.iif	le,zzzzzz-256.,	BLK=-2
		.iif	le,zzzzzz-128.,	BLK=-3
		.iif	le,zzzzzz-064.,	BLK=-4
		.iif	le,zzzzzz-032.,	BLK=-5
		.iif	le,zzzzzz-016.,	BLK=-6
		.iif	le,zzzzzz-008.,	BLK=-7
		.iif	le,zzzzzz-004.,	BLK=-8.
		.iif	le,zzzzzz-002.,	BLK=-9.
	.endc
	.if	nb,BLOCK
		.iif	lt,BLOCK-BLK .error ; require blocking factor of BLK
		.iif	gt,BLOCK-BLK .print BLK ; can reduce blocking factor
		BLK	= BLOCK
	.endc		
	BUFBLK = BLK
;
	.iif	lt,BUFBLK,	BUFBLK=1
	.iif	eq,NUMPAG,	NUMPAG=1
	.iif	eq,NUMFDB	.error ; no fields defined
	.iif	eq,NUMKDB	.error ; no keys defined
;
	.psect	frmfil			
FDBPAR:	.word	10$,20$,^O10,0,0,^O400,0,0,BUFPAR	
   10$:	.rad50	/DEVICE'NAME'PAR/
   20$:	.ascii	/DEVICE':'NAME'.PAR/<^O200>>	<0>
FDBDAT:	.word	10$,20$,^O11,0,0,<BUFBLK*^O400>,0,0,BUFDAT
   10$:	.rad50	/DEVICE'NAME'DAT/
   20$:	.ascii	/DEVICE':'NAME'.DAT/<^O200>>	<0>
FDBKEY: .word	10$,20$,^O12,0,0,^O2000,0,0,BUFKEY	
   10$:	.rad50	/DEVICE'NAME'KEY/
   20$:	.ascii	/DEVICE':'NAME'.KEY/<^O200>>	<0>
BUFPAR:	.blkw	^O400			
BUFDAT:	.blkw	<BUFBLK*^O400>
BUFKEY:	.blkw	^O2000			
	.psect	frmhdr
NAME::	.word	RECADD,FDT,NUMFDB,RECEND-RECADD
	.word	NUMPAG,BLK,ENTRIES,FDBPAR
	.word	FDBDAT,FDBKEY,0,0
	.word	KEYADD,KDT,NUMKDB,KEYEND-KEYADD
	.asciz	/'NAME'/<0>
.ENDM	KEYEND
;
.ENDM	FORM
.END
