!
!	MAKSRC	Generate ANDI equivalent file i/o statements
!	Copyright 1989, 1990 by Jim-Barry Behar
!	ALL RIGHTS RESERVED
!
	program maksrc,1.0(2)
!
!	Created on 28-Aug-89 at 10:49 AM by Jim-Barry Behar [001]
!	Updated on 31-Jan-90 at  7:18 PM by Jim-Barry Behar [002]
!
!	All commercial rights are reserved.
!    	This program is placed in the public domain without any
!	warranties, or guarranties of any kind.
!	Neither the author, nor Florida Datatek, Inc. shall be held
!	responsible for damages resulting from the use of this program.
!	Florida Datatek, Inc. has nothing to do with this program.
!	
! Edit History:
!
! [001] Created
! [002] Cleaned up for d/STUFF release
!
! Future enhancements:  Read ".DEF" file and generate code based on contents
!			Generate "FETCH'KEY" routine using d/BASIC for 
!			  right justification, and zero filling etc.
!			
!
!
def main'dbs'name="xxxxxx"	! replace xxxxxx with main file name
!
def max'slots=32		! replace with maximum number of 
				! data or key files
!
map1 dbs(max'slots),s,32
map1 key(max'slots),s,32	! packet name
map1 kyn(max'slots),s,32	! key file name
map1 kyf(max'slots),s,32	! data file key is index for
map1 loop,f
!
def num'dbs=			! insert number of active dbs files
def num'key=			! insert number of active key files
!
!
! dbs() slots hold data file names
! kyn() slots hold key file names
! kyf() slots hold the name of the owner data base that kyn() references
!
!
dbs( 1)="      " : kyn( 1)="      " : kyf( 1)="      "
dbs( 2)="      " : kyn( 2)="      " : kyf( 2)="      "
dbs( 3)="      " : kyn( 3)="      " : kyf( 3)="      "
dbs( 4)="      " : kyn( 4)="      " : kyf( 4)="      "
dbs( 5)="      " : kyn( 5)="      " : kyf( 5)="      "
dbs( 6)="      " : kyn( 6)="      " : kyf( 6)="      "
dbs( 7)="      " : kyn( 7)="      " : kyf( 7)="      "
dbs( 8)="      " : kyn( 8)="      " : kyf( 8)="      "
dbs( 9)="      " : kyn( 9)="      " : kyf( 9)="      "
dbs(10)="      " : kyn(10)="      " : kyf(10)="      " 
dbs(11)="      " : kyn(11)="      " : kyf(11)="      " 
dbs(12)="      " : kyn(12)="      " : kyf(12)="      " 
dbs(13)="      " : kyn(13)="      " : kyf(13)="      " 
dbs(14)="      " : kyn(14)="      " : kyf(14)="      " 
dbs(15)="      " : kyn(15)="      " : kyf(15)="      " 
dbs(16)="      " : kyn(16)="      " : kyf(16)="      " 
dbs(17)="      " : kyn(17)="      " : kyf(17)="      "
dbs(18)="      " : kyn(18)="      " : kyf(18)="      "
dbs(19)="      " : kyn(19)="      " : kyf(19)="      "
dbs(20)="      " : kyn(20)="      " : kyf(20)="      "
dbs(21)="      " : kyn(21)="      " : kyf(21)="      " 
dbs(22)="      " : kyn(22)="      " : kyf(22)="      " 
dbs(23)="      " : kyn(23)="      " : kyf(23)="      " 
dbs(24)="      " : kyn(24)="      " : kyf(24)="      " 
dbs(25)="      " : kyn(25)="      " : kyf(25)="      " 
dbs(26)="      " : kyn(26)="      " : kyf(26)="      " 
dbs(27)="      " : kyn(27)="      " : kyf(27)="      "
dbs(28)="      " : kyn(28)="      " : kyf(28)="      "
dbs(29)="      " : kyn(29)="      " : kyf(29)="      "
dbs(30)="      " : kyn(30)="      " : kyf(30)="      "
dbs(31)="      " : kyn(31)="      " : kyf(31)="      " 
dbs(32)="      " : kyn(32)="      " : kyf(32)="      " 
!
	for loop=1 to num'key
		key(loop)=main'dbs'name+"'KEY'"+str(loop)
	next loop
!
	open #1,main'dbs'name+".fio",output
	print #1,"!"
	print #1,"!!!!!	All Key File Manipulation Calls"
	print #1,"!"
 
	print #1,"!"
	print #1,"!!!!!	Retrieve next key from key file KEY'FIL"
	print #1,"!"
	print #1,"NXT'KEY:"
 
	when num'key>1
		print #1,"	on KEY'FIL goto ";
		for loop=1 to num'key-1
			print #1,"T"+str(loop)+",";
		next loop
		print #1,"T"+str(num'key)
		print #1,"	W'STR="+chr(34)+"NXT'KEY"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'key
		if num'key>1 print #1,"T"+str(loop)+":	"; else print #1,chr(9);
		print #1,"next.key in "+rtrim(key(loop))+" using KEY'STR"
		print #1,"	FLAG(1)="+rtrim(key(loop))+"_FLAG1"
		print #1,"	return"
	next loop

	print #1,"!"
	print #1,"!!!!!	Find key KEY'STR in key file KEY'FIL"
	print #1,"!"
	print #1,"FND'KEY:"

	when num'key>1
		print #1,"	on KEY'FIL goto ";
		for loop=1 to num'key-1
			print #1,"U"+str(loop)+",";
		next loop
		print #1,"U"+str(num'key)
		print #1,"	W'STR="+chr(34)+"FND'KEY"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'key
		if num'key>1 print #1,"U"+str(loop)+":	"; else print #1,chr(9);
		print #1,"find.key in "+rtrim(key(loop))+" using KEY'STR"
		print #1,"	FLAG(1)="+rtrim(key(loop))+"_FLAG1"
		print #1,"	return"
	next loop

	print #1,"!"
	print #1,"!!!!!	Add key KEY'STR to key file KEY'FIL"
	print #1,"!"
	print #1,"ADD'KEY:"

	when num'key>1
		print #1,"	on KEY'FIL goto ";
		for loop=1 to num'key-1
			print #1,"V"+str(loop)+",";
		next loop
		print #1,"V"+str(num'key)
		print #1,"	W'STR="+chr(34)+"ADD'KEY"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'key
		if num'key>1 print #1,"V"+str(loop)+":	"; else print #1,chr(9);
		print #1,"add.key to "+rtrim(key(loop))+" using KEY'STR";
		print #1," of "+rtrim(kyf(loop))
		print #1,"	FLAG(1)="+rtrim(key(loop))+"_FLAG1"
		print #1,"	return"
	next loop

	print #1,"!"
	print #1,"!!!!!	Delete key KEY'STR from key file KEY'FIL"
	print #1,"!"
	print #1,"DEL'KEY:"

	when num'key>1
		print #1,"	on KEY'FIL goto ";
		for loop=1 to num'key-1
			print #1,"X"+str(loop)+",";
		next loop
		print #1,"X"+str(num'key)
		print #1,"	W'STR="+chr(34)+"DEL'KEY"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'key
		if num'key>1 print #1,"X"+str(loop)+":	"; else print #1,chr(9);
		print #1,"delete.key from "+rtrim(key(loop))+" using KEY'STR";
		print #1," of "+rtrim(kyf(loop))
		print #1,"	FLAG(1)="+rtrim(key(loop))+"_FLAG1"
		print #1,"	return"
	next loop

	print #1,"!"
	print #1,"!!!!!	Retrieve previouskey from key file KEY'FIL"
	print #1,"!"
	print #1,"PRE'KEY:"

	when num'key>1
		print #1,"	on KEY'FIL goto ";
		for loop=1 to num'key-1
			print #1,"W"+str(loop)+",";
		next loop
		print #1,"W"+str(num'key)
		print #1,"	W'STR="+chr(34)+"PRE'KEY"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'key
		if num'key>1 print #1,"W"+str(loop)+":	"; else print #1,chr(9);
		print #1,"previous.key in "+rtrim(key(loop))+" using KEY'STR"
		print #1,"	FLAG(1)="+rtrim(key(loop))+"_FLAG1"
		print #1,"	return"
	next loop

	print #1,"!"
	print #1,"!!!!!	All File Manipulation Calls"
	print #1,"!"
	print #1,"!"
	print #1,"!!!!!	Fetch a field for display"
	print #1,"!"
	print #1,"FET'FLD:"
	print #1,"	call RET'FLD"
	print #1,"	if FLAG(4)=3 FIL'STR=str(FIL'FLT)"
	print #1,"	if FLAG(4)=6 FIL'STR=str(FIL'BIN)"
	print #1,"	return"
	print #1,"!"
	print #1,"!!!!!	Prepare a field for writing to file"
	print #1,"!"
	print #1,"SET'FLD:"
	print #1,"	call FLD'PAR"
	print #1,"	if FLAG(4)=3 FIL'FLT=val(FIL'STR)"
	print #1,"	if FLAG(4)=6 FIL'BIN=val(FIL'STR)"
	print #1,"	call PUT'FLD"
	print #1,"	return"

	print #1,"!"
	print #1,"!!!!!	Read record without locking it"
	print #1,"!"
	print #1,"READ'REC:"
	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"J"+str(loop)+",";
		next loop
		print #1,"J"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"READ'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"J"+str(loop)+":	"; else print #1,chr(9);
		print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
		print #1,"	read.record from "+dbs(loop)
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Extract record from file"
	print #1,"!"
	print #1,"EXT'REC:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"K"+str(loop)+",";
		next loop
		print #1,"K"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"EXT'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"K"+str(loop)+":	"; else print #1,chr(9);
		print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
		print #1,"	lock.record from "+dbs(loop)
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Read record only if it's unlocked"
	print #1,"!"
	print #1,"RIU'REC:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"L"+str(loop)+",";
		next loop
		print #1,"L"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"RIU'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"L"+str(loop)+":	"; else print #1,chr(9);
		print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
		print #1,"	read.unlocked from "+dbs(loop)
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Write record"
	print #1,"!"
	print #1,"WRITE'REC:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"M"+str(loop)+",";
		next loop
		print #1,"M"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"WRITE'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"M"+str(loop)+":	"; else print #1,chr(9);
		print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
		print #1,"	write.record to "+dbs(loop)
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Add record to file"
	print #1,"!"
	print #1,"ADD'REC:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"N"+str(loop)+",";
		next loop
		print #1,"N"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"ADD'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"N"+str(loop)+":	"; else print #1,chr(9);
		print #1,"add.record to "+dbs(loop)
		print #1,"	RECDNO("+str(loop)+")="+dbs(loop)+"_RECDNO"
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Delete record from file"
	print #1,"!"
	print #1,"DEL'REC:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"O"+str(loop)+",";
		next loop
		print #1,"O"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"DEL'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"O"+str(loop)+":	"; else print #1,chr(9);
		print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
		print #1,"	delete.record from "+dbs(loop)
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Release lock on record"
	print #1,"!"
	print #1,"REL'REC:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"P"+str(loop)+",";
		next loop
		print #1,"P"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"REL'REC"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"P"+str(loop)+":	"; else print #1,chr(9);
		print #1,dbs(loop)+"_RECDNO=RECDNO("+str(loop)+")"
		print #1,"	unlock.record of "+dbs(loop)
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Retrieve field named "+chr(34)+"FLD'STR"+chr(34)
	print #1,"!"
	print #1,"RET'FLD:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"Q"+str(loop)+",";
		next loop
		print #1,"Q"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"RET'FLD"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"Q"+str(loop)+":	"; else print #1,chr(9);
		print #1,"FIL'BIN=0"
		print #1,"	get.field of "+dbs(loop)+" named FLD'STR into FIL'STR"
		print #1,"	if "+dbs(loop)+"_FLAG2=0 goto FLD'NOT'FND"
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Put field named "+chr(34)+"FLD'STR"+chr(34)+" to record"
	print #1,"!"
	print #1,"PUT'FLD:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"R"+str(loop)+",";
		next loop
		print #1,"R"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"PUT'FLD"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"R"+str(loop)+":	"; else print #1,chr(9);
		print #1,"put.field to "+dbs(loop)+" named FLD'STR from FIL'STR"
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Retrieve field parameters"
	print #1,"!"
	print #1,"FLD'PAR:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"Z"+str(loop)+",";
		next loop
		print #1,"Z"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"FLD'PAR"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"Z"+str(loop)+":	"; else print #1,chr(9);
		print #1,"field.info in "+dbs(loop)+" about FLD'STR "
		print #1,"	goto SET'FLAGS"
	next loop

	print #1,"!"
	print #1,"!!!!!	Set status flags"
	print #1,"!"
	print #1,"SET'FLAGS:"

	when num'dbs>1
		print #1,"	on DBS'FIL goto ";
		for loop=1 to num'dbs-1
			print #1,"S"+str(loop)+",";
		next loop
		print #1,"S"+str(num'dbs)
		print #1,"	W'STR="+chr(34)+"SET'FLAGS"+chr(34)+" : goto I'ERR"
		print #1
	wend

	for loop=1 to num'dbs
		if num'dbs>1 print #1,"S"+str(loop)+":";
		print #1,"	FLAG(1)="+dbs(loop)+"_FLAG1"
		print #1,"	FLAG(2)="+dbs(loop)+"_FLAG2"
		print #1,"	FLAG(3)="+dbs(loop)+"_FLAG3"
		print #1,"	FLAG(4)="+dbs(loop)+"_FLAG4"
		print #1,"	FLAG(5)="+dbs(loop)+"_FLAG5"
		print #1,"	return"
	next loop
	close #1

	open #2,main'dbs'name+".str",output
	
	print #2,"structure dbms'packet"
	print #2,"	1 BUFFER"
	print #2,"		2 RECDNO,b,4"
	print #2,"		2 FLAG1,b,4"
	print #2,"		2 FLAG2,b,4"
	print #2,"		2 FLAG3,b,4"
	print #2,"		2 FLAG4,b,4"
	print #2,"		2 FLAG5,b,4"
	print #2,"		2 ERTN,b,4"
	print #2,"		2 PORT,b,2"
	print #2,"		2 FILLER,x,330"
	print #2,"		2 FIELDS(128)"
	print #2,"			3 FNAME,x,6"
	print #2,"			3 FTYPE,x,1"
	print #2,"			3 FSIZE,b,1"
	print #2,"end structure"
	print #2
	print #2,"structure key'packet"
	print #2,"	1 BUFFER"
	print #2,"		2 RECDNO,b,4"
	print #2,"		2 FLAG1,b,4"
	print #2,"		2 FLAG2,b,4"
	print #2,"		2 FLAG3,b,4"
	print #2,"		2 FLAG4,b,4"
	print #2,"		2 FLAG5,b,4"
	print #2,"		2 ERTN,b,4"
	print #2,"		2 PORT,b,2"
	print #2,"		2 FILLER,x,330"
	print #2,"end structure"
	print #2
	for loop=1 to num'dbs
		print #2,"dbms'packet "+dbs(loop)
	next loop
	for loop=1 to num'key
		print #2,"key'packet "+key(loop)
	next loop
	print #2,"!"
	for loop=1 to num'dbs
		print #2,"map1 "+dbs(loop)+",@"+dbs(loop)+"_BUFFER"
	next loop
	for loop=1 to num'key
		print #2,"map1 "+key(loop)+",@"+key(loop)+"_BUFFER"
	next loop
	close #2
	
	open #3,main'dbs'name+".opn",output
	for loop=1 to num'dbs
		print #3,"	open.file "+dbs(loop)+" named ";
		print #3,chr(34)+lcs(dbs(loop))+chr(34)
	next loop
	print #3,"!"
	for loop=1 to num'key
		print #3,"	open.key.file "+key(loop)+" named ";
		print #3,chr(34)+lcs(kyn(loop))+chr(34)
	next loop
	close #3