.TITLE	DBSTPL - Make a template file
.IDENT	/150883/
.ENABL	LC
;
;
;	Written by	Bruce McClenahan
;			15-Aug-83
;
;	Version		230583/05
;
;
;----------------------------------------------------------------------------
;
; This module is used to produce a data-base template definition file from a
; screen image file.
;
; The program takes as input a ".TPL" file containing screen images of the 
; desired template pages and produces as output a ".MAC" file containing the 
; macro calls required to define the template for DBSMNG. 
;
; The user is asked for the name of the data-base and the number of records to
; be created. The program reproduces this in the ".MAC" file .
;
;
.SBTTL	Modifications
;
;  6-Jul-83	Improve handling of <FF> characters in .TPL file.
;
; 15-Aug-83	Fix up problem in copying .TPL page to .MAC file.
;		Was adding an extra <CR> on blank lines.
;
;

.SBTTL	Documentation		...	User requirements
;
; DBSTPL expects the input file to contain one or more 24-line pages of 80-
; column lines with a form-feed character between pages.
; The first 24 lines of each page will generate a database template page. 
; The first page will be called page 0 and fields on this page will appear 
; on all other pages when the DBSEDT program is used. 
;
; The program recognises the following constructions in the input file:
;
; (1)	string:			Define a LABEL with name "string"
; (2)	string<dataspec>	Define a KEY   with name "string"
; (3)	string[dataspec]	Define a FIELD with name "string"
; (4)	<dataspec>		Define a KEY   and generate a name for it.
; (5)	[dataspec]		Define a FIELD and generate a name for it.
;
; where
;
;	string		is any ASCII string not	containing  :  <  or  [
;			The string may contain spaces.
;
;	dataspec 	defines the type of data to be stored.
;			It is any string beginning with:
;
;				.,a,A	ASCII
;				d,D	date
;				l,L	letter (alphabetic)
;				n,N	number
;
;			If the lower case character is used, the field  will 
;			be PROTECTed.
;	
; Some examples:
;
;	NAME1:			defines a LABEL called NAME1.
;
;	NAME2	[....]		defines an ASCII FIELD called NAME2.
;
;	NAME3	<nnnnn>		defines a protected numeric KEY called NAME3.
;
;

.SBTTL	Declarations
;
.MCALL	.GTLIN,.PRINT,.TTYOUT,.EXIT	; RT-11
.MCALL	.DATE				; RT-11
.MCALL	FILSPT,CNAF,.PUSH,.POP		; DBSLIB
;
	FILSPT				; Include File-support MACROS
;
;
.GLOBL	RPTINT,RPTEND,RPTNME,RPTOUC	; RPTIO
.GLOBL	FRMINT,FRMINC,FRMNME,FRMRST	; FRMFIO
.GLOBL	FRMMRK				; FRMFIO
.GLOBL	ASCNUM				; DBSLIB
;
;
.SBTTL	Definitions	...	Constants
;
PAGLEN	= 24.				;	Lines per page
LINLEN	= 80.				;	Characters per line
;
TAB	= 11				;	TAB character
LF	= 12				;	Line feed character
FF	= 14				;	Form feed character
CR	= 15				;	Carriage return character
SPACE	= 40				;	Space character
;
;

.SBTTL	Definitions	...	MACROS
;
.MACRO	OUTSTR	STRING,BYTE,NEWLIN=NO
	JSR	R1,STROUT
	.ASCII	|STRING|BYTE
	.IIF	IDN,NEWLIN,YES,	.BYTE	15,12
	.BYTE	0
	.EVEN
.ENDM	OUTSTR
;
;
.MACRO	OUTCHR	VAL=R0
	.IIF	DIF,VAL,R0	MOV	VAL,R0
	CALL	RPTOUC
.ENDM	OUTCHR
;
;
.MACRO	OUTRPT	VAL=R0,NUM=R2,?LA,?LB
	.IIF	DIF,VAL,R0,	MOV	VAL,R0
	.IIF	DIF,NUM,R2,	MOV	NUM,R2
LB':	CALL	RPTOUC
	SOB	R2,'LB
.ENDM	OUTRPT
;
;
.MACRO	OUTCHS	STRING=R1,?LA,?LB
	.IIF	DIF,STRING,R1,	MOV	STRING,R1
LA:	MOVB	(R1)+,R0
	BEQ	'LB
	CALL	RPTOUC
	BR	'LA
LB:
.ENDM	OUTCHS
;
;
.MACRO	OUTNUM	FLD,NUM=R2
	.IIF	DIF,NUM,R2,	MOV	NUM,R2
	MOV	#NUMBUF,R1
	CNAF	FLD
	CLRB	(R1)
	OUTCHS	STRING=#NUMBUF
.ENDM	OUTNUM
;
;
.MACRO	ABORT	STRING,COND,?LA,?LB,?LC
	.IF	NB,COND
		B'COND	LB
		BR	LC
LB:	.ENDC
	JSR	R1,ABORT
	.ASCII	|'STRING'|<200>
	.EVEN
	.IIF	NB,COND,	LC:
.ENDM	ABORT
;
;

.SBTTL	Entry point	START
;
START:	.PRINT	#M.IDNT			;	Print identity message
;
	.GTLIN	#DBSNAM,#P.DNAM		;	Get database name
	TSTB	DBSNAM			;	Null string ?
	BEQ	9900$			;	 Yes -> exit
;
	MOV	#DBSNAM,R0		; R0 ->	Database name
	MOV	#FRMNME,R1		; R1 ->	Input file name
;
	MOV	#6,R2			;	Only want 6 characters
100$:	MOVB	(R0)+,(R1)+		;	Copy dbs name to file name
	BEQ	200$			;	 End -> skip
	SOB	R2,100$			;	Loop till done
	BR	210$			;	Enough characters -> skip
;
200$:	DEC	R1			;	Backup filename null
210$:	CLRB	(R0)			;	Terminate database name
	MOVB	#'.,(R1)+		;	Add ".TPL"
	MOVB	#'T,(R1)+		;	 extension
	MOVB	#'P,(R1)+		;	  to
	MOVB	#'L,(R1)+		;	   filename
	CLRB	(R1)			;	Terminate file name
;
	CALL	FRMINT			;	Set up input file
;
	MOV	#DBSNAM,R0		; R0 ->	Database name
	MOV	#RPTNME,R1		; R1 ->	Output file name
;
300$:	MOVB	(R0)+,(R1)+		;	Copy dbs name to file name
	BNE	300$			;	Loop till done
	DEC	R1			;	Backup character
	MOVB	#'.,(R1)+		;	Add
	MOVB	#'M,(R1)+		;	 extension
	MOVB	#'A,(R1)+		;	  to
	MOVB	#'C,(R1)+		;	   file name
	CLRB	(R1)+			;	Terminate file name
;
	CALL	RPTINT			;	Set up output file
;
	.GTLIN	#NUMREC,#P.NREC		;	Get no of entries
	MOV	#NUMREC,R1		; R1 ->	Input string
	CALL	ASCNUM			; R0 =	Number
	MOV	R0,NUMENT		;	Save number of entries
;
;

.SBTTL	Main Loop
;
	CALL	HEADER			;	Produce output file header
	CLR	PAGE			;	Clear page counter
	CLR	NAMCNT			;	Clear internal name count
;
500$:	CLR	LINE			;	Clear line counter
	CALL	FRMMRK			;	Mark point in input file
	CALL	OUTPAG			;	Copy page image to output
	CALL	FRMRST			;	Rewind input file to mark
;
1000$:	CLR	COLUMN			;	Reset column count
	CALL	FRMMRK			;	Mark point in input file
;
2000$:	CALL	INCHAR			; R0 =	Next character in input file
	BCS	9000$			;	End-of-file -> exit
	BEQ	4000$			;	End-of-line -> skip
	CMPB	R0,#SPACE		;	Space or control character ?
	BLOS	2000$			;	 Yes -> loop
;
	CALL	NAME			;	Read in name
;
	CMPB	R0,#':			;	Label ?
	BNE	3000$			;	 No --> skip
	CALL	OUTLBL			;	 Yes -> list label data
	BR	2000$			;	Loop back
;
3000$:	CALL	FIELD			;	Scan field
;
	CALL	OUTFLD			;	Produce FIELD description
	BR	2000$			;	Loop back
;
4000$:	CMPB	R0,#FF			;	End of page ?
	BEQ	8000$			;	 Yes -> skip
	INC	LINE			;	Up line count
	CMP	LINE,#PAGLEN		;	End of page ?
	BLO	1000$			;	 No --> loop
;
8000$:	INC	PAGE			;	Up page count
8100$:	CMPB	R0,#FF			;	New page ?
	BEQ	500$			;	 Yes -> start new page
	CALL	INCHAR			; R0 =	Next character
	BCS	9000$			;	End-of-file -> exit
	BR	8100$			;	 No --> loop
;
9000$:	CALL	FINISH			;	Finish output file
;
	CALL	RPTEND			;	Close output file
9900$:	.EXIT				; Exit
;
;

.SBTTL	Routine		ABORT	Error handling
;
ABORT:	.PRINT	#M.ERR			;	Display error header
	.PRINT	R1			;	Display error message
;
	CNAF	FD,NUMBER=LINE,STRING=#LINEID ; Line number
	.PRINT	#M.LINE			;	Display line number
;
	CALL	FRMRST			;	Rewind input to start of line
;
100$:	CALL	FRMINC			; R0 =	Next character
	BCS	900$			;	End-of-file -> skip
	CMPB	R0,#CR			;	End-of-line ?
	BEQ	900$			;	 Yes ->	skip
	.TTYOUT	R0			;	 No --> echo character
	BR	100$			;	Loop
;
900$:	.TTYOUT	#CR			;	Terminate line
	.TTYOUT	#LF			;
;
	MOV	COLUMN,R2		; R2 =	Position of error
	DEC	R2			;	Back one
	BLE	2000$			;	Start of line -> skip
1000$:	.TTYOUT	#SPACE			;	Output space
	SOB	R2,1000$		;	Loop till done
;
2000$:	.TTYOUT	#'^			;	Indicate position of error
	.TTYOUT	#CR			;	Terminate line
	.TTYOUT	#LF			;
;
	.EXIT				; Exit
;
;

.SBTTL	Routine		NAME	Read label or field name
;
NAME:	MOV	COLUMN,NAMST		;	Save start of name
	DEC	NAMST			;	Back one since start from 0
	CLR	KEYFLG			;	Clear key flag
	MOV	#NAMBUF,R1		; R1 ->	Name buffer
;
1000$:	CMPB	R0,#'<			;	Start of key ?
	BEQ	2000$			;	 Yes -> skip
	CMPB	R0,#'[			;	Start of field ?
	BEQ	2100$			;	 Yes -> skip
	CMPB	R0,#':			;	End of label ?
	BEQ	4000$			;	 Yes -> skip
	MOVB	R0,(R1)+		;	Save character
	CALL	INCHAR			; R0 =	Next character
	BNE	1000$			;	Not end-of-line -> loop
	ABORT	<Unterminated label>	;	 End-of-line -> ABORT
;
2000$:	MOV	#1,KEYFLG		;	Key -> set flag
2100$:	CMP	R1,#NAMBUF		;	Read in any characters ?
	BEQ	3000$			;	 No --> supply name
	CMPB	-(R1),#SPACE		;	Kill trailing control chars
	BLOS	2100$			;	Loop back
	INC	R1			;	Forward to EOS
	BR	4000$			;	Skip
;
3000$:	INC	NAMCNT			;	Increment internal name count
	MOVB	#'!,(R1)+		;	Don't display label
	MOVB	#'!,(R1)+		;	Name is ..
	CNAF	DD,NUMBER=NAMCNT	;	 !nn
	CLR	R0			;	Ensure not mistaken for label
;
4000$:	CLRB	(R1)			;	Terminate name string
	RETURN				; Done
;
;

.SBTTL	Routine		FIELD	Read in field description
;
FIELD:	MOV	COLUMN,FLDST		;	Save start of field
	CLR	PRTFLG			;	Clear protect flag
	CALL	INCHAR			; R0 =	Next character
	BEQ	9000$			;	End-of-line -> ABORT
;
	MOV	#TYPTAB,R4		; R4 ->	Type table
1000$:	CMPB	R0,(R4)			;	Match current entry ?
	BEQ	3010$			;	 Yes -> skip
	CMPB	R0,1(R4)		;	Match alternate entry ?
	BEQ	3000$			;	 Yes -> skip
	ADD	#4,R4			; R4 ->	Next entry
	TST	(R4)			;	End of table ?
	BNE	1000$			;	 No --> loop
	ABORT	<Illegal field type>	;	 Yes -> ABORT
;
3000$:	MOV	#1,PRTFLG		;	Flag protected field
3010$:	MOV	2(R4),FLDTYP		;	Save address of type string
3100$:	CALL	INCHAR			; R0 =	character
	BEQ	9000$			;	End-of-line -> ABORT
	CMPB	R0,#']			;	End of field ?
	BEQ	4000$			;	 Yes -> skip
	CMPB	R0,#'>			;	End of key ?
	BNE	3100$			;	 No --> loop
;
4000$:	MOV	COLUMN,FLDLEN		;	Save end of field
	SUB	FLDST,FLDLEN		;	Calculate field length
	DEC	FLDLEN			;	Subtract one
	RETURN				; Done
;
;
9000$:	ABORT	<Unterminated field>	;	Unexpected EOL
;
;

.SBTTL	Routine		HEADER	Output Template file header
;
HEADER:	OUTSTR	<.TITLE	>		;	TITLE message
	OUTCHS	#DBSNAM			;
	OUTSTR	<	Database template> ;
	OUTSTR	NEWLIN=YES		;
;
	OUTSTR	<.IDENT	/>		;	IDENT message
;
	.DATE				;	Display date
	MOV	R0,R3			;
	ASH	#-5,R0			;
	BIC	#^C37,R0		;
	OUTNUM	DD,NUM=R0		;	Day
;
	MOV	R3,R0			;
	ASH	#-10.,R0		;
	BIC	#^C17,R0		;
	OUTNUM	DD,NUM=R0		;	Month
;
	BIC	#^C37,R3		;
	ADD	#72.,R3			;
	OUTNUM	DD,NUM=R3		;	Year
	OUTSTR	</>,NEWLIN=YES		;	Terminate
;
	OUTSTR	<.ENABL	LC>,NEWLIN=YES	;	Option
	OUTSTR	<.RADIX	10>,NEWLIN=YES	;	Option
;
	OUTSTR	<;>,NEWLIN=YES		;
	OUTSTR	<; Produced by:	> ;
	OUTCHS	#M.IDNT			;
;
	OUTSTR	<;>,NEWLIN=YES		;
	OUTSTR	<BASE.X	= 0>,NEWLIN=YES	;	Set parameters
	OUTSTR	<BASE.Y	= 0>,NEWLIN=YES	;
	OUTSTR	<;>,NEWLIN=YES		;
;
	OUTSTR	<.MCALL	FORM>,NEWLIN=YES ;	MCALL	messge
;
	OUTSTR	<	FORM	>	;	FORM definition
	OUTSTR	<NAME=>			;	Name
	OUTCHS	#DBSNAM			;
	OUTSTR	<,ENTRIES=>		;	Number of entries
	OUTNUM	FFFFD,NUM=NUMENT	;
	OUTSTR	<.>,NEWLIN=YES		;
;
	RETURN				; Done
;
;

.SBTTL	Routine		OUTPAG	Copy page from input to output
;
OUTPAG:	OUTSTR	,<<FF>>			;	New page
	OUTSTR	<.IF	Z,1	;>	;	Header
	OUTSTR	<		Page >	;
	OUTNUM	FD,NUM=PAGE		;
	OUTSTR	NEWLIN=YES		;
	OUTRPT	#'-,NUM=#80.		;
	OUTSTR	NEWLIN=YES		;
;
	CLR	R2			;	Clear line count
1000$:	CALL	FRMINC			; R0 =	Character from input file
	BCS	2000$			;	End of file -> done
	CMPB	R0,#FF			;	End of page ?
	BEQ	2000$			;	 Yes -> done
	CMPB	R0,#CR			;	End-of-line ?
	BEQ	1100$			;	 No --> loop
	CALL	RPTOUC			;	Place character in output file
	BR	1000$			;
;
1100$:	CALL	FRMINC			;	Input LF character
	OUTSTR	NEWLIN=YES		;	Start new line
	INC	R2			;	Up line count
	CMP	R2,#PAGLEN		;	End of page ?
	BLO	1000$			;	 No --> loop
;
2000$:	OUTRPT	#'-,NUM=#80.		;	Trailer
	OUTSTR	NEWLIN=YES		;
	OUTSTR	<.ENDC>,NEWLIN=YES	;
	OUTSTR	<;>,NEWLIN=YES		;
;
	RETURN				; Done
;
;

.SBTTL	Routine		FINISH	Finish off template file
;
FINISH:	OUTSTR	,<<FF>>			;	New page
	OUTSTR	<;>,NEWLIN=YES		;
;
	OUTSTR	<KEYEND>,NEWLIN=YES	;	Terminating macro
	OUTSTR	<;>,NEWLIN=YES		;
;
	OUTSTR	<.END>,NEWLIN=YES	;	END message
;
	RETURN				; Done
;		
;

.SBTTL	Routine		OUTFLD	Output FIELD call
;
OUTFLD:	OUTSTR	<FIELD	>		;	FIELD
;
	OUTNUM	DD,NUM=FLDST		;	X-position
	OUTSTR	<.,>			;
	OUTNUM	DD,NUM=LINE		;	Y-position
2000$:	OUTSTR	<. >			;
;
	OUTCHS	FLDTYP			;	Field TYPE
	OUTSTR	<,>			;
;
	OUTCHR	#'<			;	Length
	OUTRPT	#'.,NUM=FLDLEN		;
	OUTCHR	#'>			;
;
	MOV	#30.,R2			;	Pad to line up next field
	SUB	FLDLEN,R2		;
	BLE	3000$			;
	OUTRPT	#SPACE,NUM=R2		;
;
3000$:	OUTCHR	#40			;	X-position of name
	OUTNUM	SD,NUM=NAMST		;
	OUTSTR	<.,>			;
;
	CALL	OUTNAM			;	Output name
;
	TST	PRTFLG			;	Protected ?
	BEQ	5000$			;	 No --> skip
	OUTSTR	<,PROTECT=1>		;	Set protect on
;
5000$:	TST	KEYFLG			;
	BEQ	6000$			;
	OUTSTR	<,KEY=YES>		;
;
6000$:	OUTSTR	NEWLIN=YES		;	End line
	RETURN				;
;
;
.SBTTL	Routine		OUTLBL
;
OUTLBL:	OUTSTR	<LABEL	>		;	LABEL
;
	OUTNUM	DD,NUM=NAMST		;	X-position
	OUTSTR	<.,>			;
;
	OUTNUM	DD,NUM=LINE		;	Y-position
	OUTSTR	<. >			;
;
	CALL	OUTNAM			;	Name
;
4000$:	OUTSTR	NEWLIN=YES		;
;
	RETURN				; Done
;
;

.SBTTL	Routine		OUTNAM	Output field name
;
OUTNAM:	OUTCHR	#'<			;	Delimiter
;
	MOV	#NAMBUF,R1		; R1 -> Field name
1000$:	MOVB	(R1)+,R0		; R0 =	Next character	
	BEQ	2000$			;	End-of-string -> skip
	OUTCHR	R0			;	Output name
	BR	1000$			;	Loop
;
2000$:	OUTCHR	#'>			;	Delimiter
	SUB	#NAMBUF,R1		; R1 =	Length of name
	MOV	#15.,R2			; R2 =	Pad length
	SUB	R1,R2			;    =	Number of spaces
	BLE	3000$			;	None to output -> skip
;
	OUTRPT	#SPACE,R2		;	Output padding spaces
;
3000$:	TST	PAGE			;	Page 0
	BEQ	4000$			;	 Yes -> skip
	OUTSTR	<,PAGE=>		;	Output page
	OUTNUM	FD,NUM=PAGE		;	 number
;
4000$:	RETURN				; Done
;
;

.SBTTL	Routine		INCHAR	Input next character in R0
;
;	Return with	CS	if EOF
;			ZS	if EOLN or EOPG
;
INCHAR:	CALL	FRMINC			; R0 =	Next character
	BCC	1000$			;	Got one -> skip
	INC	COLUMN			;	Up column count
	BR	9100$			;	Exit
;
1000$:	CMPB	R0,#SPACE		;	Control code ?
	BHIS	2000$			;	 No --> skip
;
	CMPB	R0,#TAB			;	<TAB> ?
	BNE	3000$			;	 No --> skip 
	BIS	#7,COLUMN		;	Move to next tab stop
;
2000$:	INC	COLUMN			;	Up column count
	CMP	COLUMN,#LINLEN		;	Past end of line ?
	ABORT	<Too many characters>,HIS ;	 Yes -> ABORT
	BR	9000$			;	Exit
;
3000$:	CMPB	R0,#CR			;	<CR> ?
	BNE	3100$			;	 No --> skip
	CALL	FRMINC			;	Input <LF>
	BR	3200$			;	Skip
;
3100$:	CMPB	R0,#FF			;	<FF> ?
	BNE	3300$			;	 No --> skip
3200$:	INC	COLUMN			;	Up column number
	BR	9100$			;	Exit
;
3300$:	ABORT	<Unrecognised character> ;
;
;
9000$:	TST	(PC)+			;	Clear EOF/EOLN flag & skip
9100$:	SEZ				;	Set EOLN flag
	RETURN				; Done
;
;
.SBTTL	Routine		STROUT	Output string @R1
;
STROUT:	MOVB	(R1)+,R0		; R0 =	Character to output
	BEQ	1000$			;	End of string -> skip
	CALL	RPTOUC			;	Output character
	BR	STROUT			;	Loop
;
1000$:	INC	R1			;	Even up
	BIC	#1,R1			;	 return address
	RTS	R1			; Done
;
;

.SBTTL	Data		...	Variables, messages
;
TYPTAB:	.WORD	"Aa,.ASC.		;	ASCII
	.WORD	"Ll,.ALP.		;	Letter = alphabetic
	.WORD	"Dd,.DAT.		;	Date
	.WORD	"Nn,.NUM.		;	Number
	.WORD	"..,.ASC.		;	ASCII
	.WORD	0			;
;
PAGE:	.WORD	0			;	Page number
LINE:	.WORD	0			;	Line number
COLUMN:	.WORD	0			;	Column number
;
NAMCNT:	.WORD	0			;
;
NUMENT:	.WORD	0			;
;
NAMST:	.WORD	0			;
FLDST:	.WORD	0			;
FLDLEN:	.WORD	0			;
FLDTYP:	.WORD	0			;
PRTFLG:	.WORD	0			;
KEYFLG:	.WORD	0			;
;
;
NAMBUF:	.BLKB	80.			;
;
DBSNAM:	.BLKB	8.			;
NUMBUF:	.BLKB	8.			;
NUMREC:	.BLKB	8.			;
;
.NLIST	BEX				;
;
.ALP.:	.ASCIZ	/.ALP./			;
.ASC.:	.ASCIZ	/.ASC./			;
.DAT.:	.ASCIZ	/.DAT./			;
.NUM.:	.ASCIZ	/.NUM./			;
;
M.IDNT:	.ASCIZ	/DBSTPL    Database Template Compiler    BMC150883/<CR><LF>
P.DNAM:	.ASCII	/Database name: /<200>	;
P.NREC:	.ASCII	/Number of records: /<200> ;
;
M.ERR:	.ASCII	<15><12>/DBSTPL-error-/<200> ;
;
M.LINE:	.ASCII	/ on line /		;
LINEID:	.ASCIZ	/  /			;
;
;
.END	START