Initial commit

gen/make_custom.f

@@ -0,0 +1,51 @@
+	program make_custom
+
+! make "customized" source files
+
+	character line*1024, id*80
+	integer l, pos, i, j, ll, iostat
+
+	call sys_get_cmdpar(line, l)
+	l=l+1
+	if (l .gt. len(line)) then
+	  print *,'line too long'
+	  goto 90
+	endif
+	line(l:)=' '
+	pos=0
+	
+10	i=index(line(pos+1:), ' ')-1
+	if (i .lt. 0) goto 99
+	if (i .eq. 0) then
+	  pos=pos+1
+	  if (pos .gt. l) goto 99
+	  goto 10
+	endif
+	call sys_open(1, line(pos+1:pos+i), 'r', iostat)
+	if (iostat .ne. 0) then
+	  print *,'cannot open ',line(pos+1:pos+i)
+	  goto 90
+	endif
+	print *,'read ',line(pos+1:pos+i)
+	read(1,'(a)') id
+	if (id .eq. 'mzhelp') then
+	  call make_help(1)
+	else if (id .eq. 'fvi') then
+	  call make_fvi(1)
+	else if (id .eq. 'vers') then
+	  call make_vers(1)
+	else
+	  call str_trim(id, id, ll)
+	  do j=1,ll
+	    if (id(j:j) .lt. '0' .or. id(j:j) .gt. 'z') goto 19
+	  enddo
+	  print *,line(pos+1:pos+i),' has an unknown id: ',id(1:ll)
+	  goto 90
+	  ! probably a binary id: may be custom itself
+19	  print *,line(pos+1:pos+i),' has a strange id, skip it'
+	  close(1)
+	endif
+	pos=pos+i+1
+	goto 10
+90	stop 'error in MAKE_CUSTOM'
+99	end