pro wrt_ld_cmd, lun, segment, offset, buf
;
; Creates a control file to load data contained in "buf".
;     Parameters:
;        lun     - logical unit on which the output file is open
;        segment - DEP Load Address Segment
;        offset  - DEP Load Address Offset
;        buf     - An array containing data to be loaded
;

bufinf = size (buf)
len = bufinf(bufinf(0)+2)
op_buf = buf
op_len = len 
if ((op_len mod 4) ne 0) then begin
    op_len = ((len / 4) + 1) * 4
    filbuf = intarr(op_len - len)
    op_buf = [buf(*), filbuf]
endif
print, len, op_len
;stop

n = 1l
while (n le op_len) do begin
    if ((n mod 24) eq 1) then begin
        printf, lun, segment, offset, format = $
            '(/"tcb mbdpml ", 2("0x",z4.4, 1x), "\")
    endif 
    ;;printf, lun, op_buf(n-1), format = '($, "0x", z4.4, " ")'
    printf, lun, op_buf(n-1) and 'ffff'x, format = '($, "0x", z4.4, " ")'
    if ((n mod 8) eq 0) and (n lt op_len) and ((n mod 24) ne 0) then $
        printf, lun, '\'
    offset = offset + 2 
    n = n + 1
endwhile
printf, lun, ' '

return
end
;--------------------------------------------------------------------
pro mk_mdi_load, type, addr, outfil, list0, offset, infil=infil, $
		loi_v=loi_v, loi_c=loi_c, lrdxfr=lrdxfr0, descr=descr, $
		part_load=part_load, append=append, comment=comment, $
		nowarn=nowarn
;+
;NAME:
;	mk_mdi_load
;PURPOSE:
;	TO take a 1-D vector and a start address and make the .src load 
;	file (telecommands)
;	For list loads, the contents are altered to reflect the 
;	address where the list is loaded
;SAMPLE CALLING SEQUENCE:
;	mk_mdi_load, type, addr, outfil, list
;	mk_mdi_load, 'list', '70034000'x, 'loi_v_7005.src', list, /loi_v
;	mk_mdi_load, 'list', '70034000'x, 'loi_v_7005_part.src', list(0:1599), /loi_v, part_load=15312
;	mk_mdi_load, 'GEN_TABLE', '80028000'x, 'ld_lookup_vel2.src', infil='/mdisw/dbase/ops/lists/lookup_velocity2.fits'
;RESTRICTIONS:
;	There are several portions of the IP table load command which
;	are hard-wired and they need to be paramters or need to be
;	found in a different file.  (all of the LRDXFR parameters)
;HISTORY:
;	Written 3-Apr-96 (MDM) by M.Morrison (using MK_LIST_LOAD as starting point)
;	 9-Apr-96 (MDM) - Modified to make all fields be hex (so that MAKE_LOAD will work)
;			- Changed nwords_load to be N-1
;	10-Apr-96 (MDM) - Changed all format words to be in hex
;			- Added /APPEND option
;	11-Apr-96 (MDM) - Added comment option
;	11-Apr-96 (MDM) - Changed nwords_load to be N (back from N-1)
;	12-Apr-96 (MDM) - Added GEN_DATA
;			- Added "and 'ffff'x" to the formatting of the output
;			- Protect the input from being changed
;	18-Apr-96 (MDM) - added depaddr option
;			- print warning if the number of elements of the list is not
;			  (mod 8) eq 0
;	14-May-96 (MDM) - Added /NOWARN option
;	22-May-96 (MDM) - Added capability to set the LOI DPC low word by parameter
;-
;
if (n_elements(infil) ne 0) then list0 = rfits(infil, h=h)
list = unsign(list0, 16)
;
if ((n_elements(list) mod 8) ne 0) and (not keyword_set(nowarn)) then begin
    tbeep, 3
    print, 'WARNING. Number of elements of the list is not MOD 8 == 0'
end
;
if (n_elements(offset) eq 0) then offset = 0L
segment = '2000'x
version		= 0
list_length	= n_elements(list)
case strupcase(type) of
    'LIST': begin
		set_list_addr, addr mod '100000'x, list
		;
		list_type 	= 9
		i_code		= list(0)
		list_load	= n_elements(list)	;should actually be -16 ?? or -24?
		;
		if (keyword_set(part_load)) then begin
		    list_length = part_load		;the full list length
		    list_load = list_load - 16		;don't include the header portion
		end
		;
		lrdxrf = intarr(11)
		if (n_elements(lrdxfr0) eq 11) then lrdxfr = lrdxfr0
		;
		if (keyword_set(loi_v)) then begin
			lrdxfr = [416, 1, $			;IP reg, and ??
				'4740'x, '3811'x, 0, 0, 180, $	;data product destination addr (l,h), ??, ??, ndp
				'ffff'x, '7005'x, 180, 0]	;dpc (h,l), ndp, ??
			if (loi_v ne 1) then lrdxfr(8) = loi_v	;set dpc(l)
		end
		if (keyword_set(loi_c)) then begin
			lrdxfr = [430, 1, $			;IP reg, and ??
				'4920'x, '2811'x, 0, 0, 180, $	;data product destination addr (l,h), ??, ??, ndp
				'ffff'x, '7004'x, 180, 0]	;dpc (h,l), ndp, ??
			if (loi_c ne 1) then lrdxfr(8) = loi_c	;set dpc(l)
		end
	    end
    'GEN_TABLE': begin
		list_type	= 8
	    end
    'GEN_LIST': begin
		list_type	= 10
	    end
    'GEN_DATA': begin
		list_type	= 11
	    end
    else: message, 'Unrecognized type: ' + type
endcase
;
fmt = '(11x, '
fmt = fmt + '2("0x", z4.4, 1x), '
fmt = fmt + '" 4  4 ", '
fmt = fmt + '2("0x", z4.4, 1x), '
fmt = fmt + '" 64  0x000F")'

break_file, outfil, dsk_log, dir000, filnam
if (n_elements(descr) eq 0) then descr = 'Load something to address ' + string(addr, format='(z8.8)')

if (keyword_set(append)) then begin
    openu, lun, outfil, /get_lun, /append
    printf, lun, ' '
    printf, lun, '##--------------------------------------------------------------
    printf, lun, ' ' 
end else begin
    openw, lun, outfil, /get_lun
    printf, lun, '# File: ' + outfil
    printf, lun, '# Created: ' + !stime
    for i=0,n_elements(comment)-1 do printf, lun, '# ' + comment(i)
    printf, lun, '#'
    printf, lun, 'program "%Z% MODULE: %M% RELEASE: %R%.%L% CREATED: %G% %U%"'
    printf, lun, 'source "' + outfil + '"'
    printf, lun, 'descr "' + filnam + ' - ' + descr + '"'
end

segment0 = segment
offset0  = offset		;save because it is changed within the routine
wrt_ld_cmd, lun, segment0, offset0, list

fmt1 = '(a, 6(" 0x",z4.4), " \")'
fmt2 = '(11x, 5(" 0x",z4.4), " \")'
fmt2b= '(11x, 5(" 0x",z4.4))'
fmt4 = '(11x,  (" 0x",z4.4))'
printf, lun, '#'
printf, lun, 'tcb mbiptbl', list_type, (addr mod '10000'x)  and 'ffff'x, (addr/'10000'x)  and 'ffff'x, $
			version, offset, segment, format=fmt1
case strupcase(type) of
    'LIST': begin
		printf, lun, i_code, list_length, list_load, lrdxfr(0:1), format=fmt2
		printf, lun, lrdxfr(2:6), format=fmt2
		printf, lun, lrdxfr(7:10), format=fmt2b
	    end
    else: printf, lun, list_length, format=fmt4
endcase

free_lun, lun
end

