heap profiler for linux using I/O 0.8

ShowHeapProfile08/Help.dcl

+definition module Help
+
+import	deltaIOSystem
+from	deltaEventIO	import ::IOState
+from	StdFile			import ::Files
+
+/*	General utility for handling the AboutDialog of a Clean application.
+	This module uses the 0.8 I/O library.
+*/
+
+MakeAboutDialog	:: String String (*s -> *((IOState *s) -> (*s,IOState *s))) *Files
+											 -> (DialogDef *s (IOState *s), *Files)
+ShowHelp		:: String (IOState s) -> IOState s

ShowHeapProfile08/Help.icl

+implementation module Help
+
+import	StdString, StdInt, StdChar, StdBool, StdFile, StdArray, StdTuple, StdList
+import	deltaSystem, deltaEventIO, deltaIOSystem, deltaWindow, deltaPicture, deltaFont, deltaIOState
+    
+::	InfoDef		:== (Int,Int,[InfoLine])
+::	InfoLine	:== (InfoFontDef,Int,Int,String)
+::	InfoFontDef	=	InfoFont Font Centred
+				|	NoFont	 Centred
+::	Centred		:== Bool
+::	Fonts		:== (Font,Font,Font,Font)
+::	Heights		:== (Int,Int)
+
+HelpWdID		:== 30000
+InfoFontName1	:== "Geneva"
+InfoFontName2	:== "Helvetica"
+InfoFontName3	:== "Times"
+NormalSize1		:== 9
+NormalSize2		:== 12
+LargeSize1		:== 12
+LargeSize2		:== 14
+NormalStyle		:== []
+BoldStyle		:== ["Bold"]
+Margin			:== 8
+AboutBegin		:== "\\About"
+AboutEnd		:== "\\EndAbout"
+HelpBegin		:== "\\Help"
+HelpEnd			:== "\\EndHelp"
+About			:== False
+Help			:== True
+
+//
+//	General AboutDialog construction.
+//
+
+MakeAboutDialog :: String String (*s -> *((IOState *s) -> (*s,IOState *s))) *Files
+				-> (DialogDef *s (IOState *s), *Files)
+MakeAboutDialog appname infofile helpf files
+	# ((xmax,ymax,text),files)	= ReadInfo About fonts AboutBegin AboutEnd infofile files
+	  picture					= DrawAboutInfo nft (xmax,ymax,text)
+	  aboutDialog				= AboutDialog appname ((0,0),(xmax,ymax)) picture (AboutHelp "Help" helpf)
+	= (aboutDialog,files)
+where
+	fonts						= InfoFonts
+	(nft,_,_,_)					= fonts
+
+InfoFonts :: Fonts
+InfoFonts
+	= (	selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] NormalStyle
+	  ,	selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] NormalStyle
+	  ,	selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] BoldStyle
+	  ,	selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] BoldStyle
+	  )
+where
+	selectfont :: ![(String,Int)] ![FontStyle] -> Font
+	selectfont [(fontname,size):preffonts] style
+		# (found,font)	= SelectFont fontname style size
+		| found
+		= font
+		| otherwise
+		= selectfont preffonts style
+	selectfont _ style
+		= snd (SelectFont InfoFontName3 style NormalSize2)
+
+/*	Reading and pre-processing of the file containing the about- and help-info. */
+
+ReadInfo :: Bool Fonts String String String *Files -> ((Int,Int,[InfoLine]),*Files)
+ReadInfo help fonts begin end filename files
+	# (succes,file,files)	= fopen (ApplicationPath filename) FReadText files
+	| not succes && help
+	= ((x,y,lines),files)
+	with
+		(x,y,lines)		= ProcessInfoStrings fonts [errpref+++"could not be found."]
+	| not succes
+	= ((defaultx,defaulty,defaultlines),files)
+	# (found,info,file)	= ReadInfoFile begin end file
+	  (_,files)			= fclose file files
+	| not found && help
+	= ((x,y,lines),files)
+	with
+		(x,y,lines)		= ProcessInfoStrings fonts [errpref+++"does not contain help information."]
+	| not found
+	= ((defaultx,defaulty,defaultlines),files)
+	| otherwise
+	= ((x,y,lines),files)
+	with
+		(x,y,lines)		= ProcessInfoStrings fonts info
+where
+	(defaultx,defaulty,defaultlines)
+						= ProcessInfoStrings fonts ["\\DThis is a Clean program."]
+	errpref				= "The help file \'"+++filename+++"\' " 
+
+ProcessInfoStrings :: Fonts [String] -> InfoDef
+ProcessInfoStrings fonts=:(nft,lft,_,_) lines
+	= (maxx1,maxy+Margin-lat,lines2)
+where
+	heights				= (nat+ndt+nld,lat+ldt+lld)
+	(maxx,maxy,lines1)	= AddFontToInfoLines fonts heights 0 (Margin+lat) lines
+	maxx1				= Margin+maxx+Margin
+	lines2				= map (CenterInfoLine nft maxx1) lines1
+	(nat,ndt,_,nld)		= FontMetrics nft
+	(lat,ldt,_,lld)		= FontMetrics lft
+	
+	AddFontToInfoLines :: Fonts Heights Int Int [String] -> InfoDef
+	AddFontToInfoLines fonts heights maxx maxy [line:rest]
+		= (maxx1,maxy1,[(font,Margin,maxy,line1):rest1])
+	where
+		(font,wid,hgt,line1)= ParseInfoLine fonts heights line
+		(maxx1,maxy1,rest1)	= AddFontToInfoLines fonts heights (max maxx wid) (maxy+hgt) rest
+		
+		ParseInfoLine :: Fonts Heights String -> (InfoFontDef,Int,Int,String)
+		ParseInfoLine fonts=:(nft,lft,bft,dft) heights=:(nhgt,lhgt) line
+			| linelen<2 || line.[0]<>'\\'
+			= (NoFont False, FontStringWidth line nft, nhgt,line )
+			| otherwise
+			= (infofont, FontStringWidth line1 font, height,line1)
+			with
+				line1					= line%(2,linelen-1)
+				(infofont,font,height)	= case (line.[1]) of
+												'L' -> (InfoFont lft False, lft, lhgt)
+												'b' -> (InfoFont bft False, bft, nhgt)
+												'B' -> (InfoFont dft False, dft, lhgt)
+												'c' -> (NoFont True       , nft, nhgt)
+												'C' -> (InfoFont lft True , lft, lhgt)
+												'd' -> (InfoFont bft True , bft, nhgt)
+												'D' -> (InfoFont dft True , dft, lhgt)
+												_   -> (NoFont False      , nft, nhgt)
+		where
+			linelen						= size line
+	AddFontToInfoLines _ _ maxx maxy _
+		= (maxx,maxy,[])
+	
+	CenterInfoLine :: Font Int InfoLine -> InfoLine
+	CenterInfoLine nft maxx info=:(inft=:NoFont centered,x,y,line)
+		| centered	= (inft,(maxx-FontStringWidth line nft)/2,y,line)
+		| otherwise	= info
+	CenterInfoLine nft maxx info=:(inft=:InfoFont font centered,x,y,line)
+		| centered	= (inft,(maxx-FontStringWidth line font)/2,y,line)
+		| otherwise	= info
+
+ReadInfoFile :: String String *File -> (Bool,[String],*File)
+ReadInfoFile begin end file
+	# (begin_found,file)= FindInfoBegin begin file
+	| not begin_found
+	= (False,[],file)
+	# (lines,file)		= ReadInfoUntil end file
+	| otherwise
+	= (True,lines,file)
+
+FindInfoBegin :: String *File -> (Bool,*File)
+FindInfoBegin begin file
+	| sfend file	= (False,file)
+	# (line,file)	= freadline file
+	| isPrefixOf begin line
+	= (True,file)
+	| otherwise
+	= FindInfoBegin begin file
+
+ReadInfoUntil :: String *File -> ([String],*File)
+ReadInfoUntil end file
+	| sfend file
+	= ([],file)
+	# (line,file)	= freadline file
+	| isPrefixOf end line
+	= ([],file)
+	# (lines,file)	= ReadInfoUntil end file
+	| otherwise
+	= ([StripNewline line:lines],file)
+
+
+/*	The drawing of the about/help info. */
+
+DrawAboutInfo :: Font InfoDef -> [DrawFunction]
+DrawAboutInfo nft (xmax,ymax,lines)
+	= [	SetFont		nft
+	  ,	DrawInfo	nft 0 ymax lines
+	  ]
+
+DrawInfo :: Font Int Int [InfoLine] Picture -> Picture
+DrawInfo nft top bot [(InfoFont font c,x,y,line):rest] pic
+	| y>bot		= pic
+	| y<top		= DrawInfo nft top bot rest pic
+	| otherwise	= DrawInfo nft top bot rest (SetFont nft (DrawString line (SetFont font (MovePenTo (x,y) pic))))
+DrawInfo nft top bot [(NoFont c,x,y,line):rest] pic
+	| y>bot		= pic
+	| y<top		= DrawInfo nft top bot rest pic
+	| otherwise	= DrawInfo nft top bot rest (DrawString line (MovePenTo (x,y) pic))
+DrawInfo _ _ _ _ pic
+	= pic
+
+//
+//	The Help function.
+//
+
+ShowHelp :: String (IOState s) -> IOState s
+ShowHelp infofile io
+	# ((xmax,ymax,text),io)	= accFiles (ReadInfo Help fonts HelpBegin HelpEnd infofile) io
+	  window				= FixedWindow HelpWdID (0,0) "Help" ((0,0),(xmax,ymax)) (UpdateHelpWd nft text) []
+	= OpenWindows [window] io
+where
+	fonts					= InfoFonts
+	(nft,_,_,_)				= fonts
+	
+	UpdateHelpWd :: Font [InfoLine] UpdateArea *s -> (*s,[DrawFunction])
+	UpdateHelpWd nft lines areas s
+		= (	s
+		  ,	[	SetFont		nft
+		  	,	RedrawAreas	nft lines areas
+		  	]
+		  )
+	where
+		RedrawAreas :: Font [InfoLine] UpdateArea Picture -> Picture
+		RedrawAreas nft lines [area=:((l,t),(r,b)):rest] pic
+			= RedrawAreas nft lines rest (DrawInfo nft (t-1) (b+40) lines pic)
+		RedrawAreas _ _ _ pic
+			= pic
+
+/*	Support functions for the AboutDialog construction. */
+
+isPrefixOf :: String String -> Bool
+isPrefixOf prefix string
+	| prefixlen>size string	= False
+	| otherwise				= prefix==string%(0,prefixlen-1) 
+where
+	prefixlen				= size prefix
+
+StripNewline :: String -> String
+StripNewline string
+	| string==""			= string
+	| string.[last]<>'\n'	= string
+	| otherwise				= string%(0,last-1)
+where
+	last					= size string-1

ShowHeapProfile08/ShowHeapProfile.prj

+Version:	1.3
+Global
+	Built:	True
+	CodeGen
+		CheckStacks:	False
+		CheckIndexes:	False
+		KeepABC:	False
+		TargetProcessor:	CurrentProcessor
+	Application
+		HeapSize:	12582912
+		StackSize:	1048576
+		ExtraMemory:	256000
+		IntialHeapSize:	1048576
+		HeapSizeMultiplier:	5120
+		ShowExecutionTime:	False
+		ShowGC:	False
+		ShowStackSize:	False
+		MarkingCollector:	True
+		Profile
+			Memory:	False
+			MemoryMinimumHeapSize:	0
+			Time601:	False
+			Time:	False
+		Output
+			Output:	NoConsole
+			Font:	950
+			FontSize:	6
+			WriteStdErr:	False
+	Project
+		Verbose:	False
+	Link
+		DefaultSystemObjects:	True
+		DefaultLibraries:	True
+	Paths
+		Path:	{Project}
+		Path:	{Application}:Clean 2.0.2 Sources:CleanTools:IOInterface 0.8.1 plus diff
+		Path:	{Application}:IOInterface 0.8.1
+MainModule
+	Name:	ShowHeapProfile
+	Dir:	{Project}
+	IclOpen:	True
+	Compiler
+		NeverMemoryProfile:	False
+		NeverTimeProfile:	False
+		StrictnessAnalysis:	True
+		ListTypes:	NoTypes
+		ListAttributes:	True
+		Warnings:	False
+		Verbose:	False
+		ReadableABC:	False
+		ReuseUniqueNodes:	False
+	Dcl
+		Editor
+			TabSize:	4
+			Font:	Monaco
+			FontSize:	9
+			AutoIndent:	True
+		WindowPosition
+			X:	164
+			Y:	195
+			SizeX:	912
+			SizeY:	445
+	DclOpen:	False
+	Icl
+		Editor
+			TabSize:	4
+			Font:	Monaco
+			FontSize:	9
+			AutoIndent:	True
+		WindowPosition
+			X:	105
+			Y:	42
+			SizeX:	887
+			SizeY:	610
+	IclOpen:	True
+	LastModified:	Yes 2002 7 1 16 6 11
+	Dependencies
+		Module:	Help
+		Module:	Picture
+		Module:	ShowHeapProfile
+		Module:	StdArray
+		Module:	StdBool
+		Module:	StdChar
+		Module:	StdClass
+		Module:	StdEnum
+		Module:	StdFile
+		Module:	StdFunc
+		Module:	StdInt
+		Module:	StdList
+		Module:	StdMisc
+		Module:	StdOrdList
+		Module:	StdOverloaded
+		Module:	StdReal
+		Module:	StdString
+		Module:	Window1
+		Module:	Window2
+		Module:	_SystemArray
+		Module:	_SystemEnum
+		Module:	commonDef
+		Module:	controls
+		Module:	deltaDialog
+		Module:	deltaEventIO
+		Module:	deltaFileSelect
+		Module:	deltaFont
+		Module:	deltaIOState
+		Module:	deltaIOSystem
+		Module:	deltaMenu
+		Module:	deltaPicture
+		Module:	deltaPrint
+		Module:	deltaSystem
+		Module:	deltaWindow
+		Module:	dialogDef
+		Module:	dialogLayout
+		Module:	event
+		Module:	events
+		Module:	files
+		Module:	font
+		Module:	ioState
+		Module:	mac_types
+		Module:	menuDef
+		Module:	osPrint08
+		Module:	quickdraw
+		Module:	timerDef
+		Module:	windowDef
+OtherModules

ShowHeapProfile08/file_exists.c

+
+#include <sys/stat.h>
+#include <unistd.h>
+
+int file_exists (char *file_name)
+{
+	struct stat stat_buffer;
+
+	file_name+=4;
+	if (stat (file_name,&stat_buffer)==0)
+		if ((stat_buffer.st_mode & S_IFMT)==S_IFREG && 
+			(stat_buffer.st_mode & S_IRUSR)==S_IRUSR)
+			return 1;
+
+	return 0;
+}