(FILECREATED "27-Apr-83 02:13:14" <DDYER>MULTIFILEINDEX..5 36785
previous date: "27-APR-83 02:03:07" <DDYER>MULTIFILEINDEX..4)
(PRETTYCOMPRINT MULTIFILEINDEXCOMS)
(RPAQQ MULTIFILEINDEXCOMS ((* To get function maps of file lists.)
(FNS * MULTIFILEINDEXFNS)
(VARS (MULTIFILEINDEXMAPFLG T)
(MULTIFILEINDEXFILESFLG T)
(MULTIFILEINDEXFNSMSFLG)
(MULTIFILEINDEXVARSMSFLG)
(MULTIFILEINDEXCOLS (QUOTE FLOATCOLS))
(MULTIFILEINDEXNAMECOL 0)
(MULTIFILEINDEXFILECOL 26)
(MULTIFILEINDEXTYPECOL 41)
(MULTIFILEINDEXGETDEFFLG))
[P (OR (BOUNDP (QUOTE LINESPERPAGE))
(RPAQQ LINESPERPAGE 58))
(OR (BOUNDP (QUOTE PRINTER))
(RPAQQ PRINTER LPT:))
(OR (BOUNDP (QUOTE MULTIFILEINDEXLOADVARSFLG))
(RPAQ MULTIFILEINDEXLOADVARSFLG (STREQUAL (SUBSTRING HOSTNAME 1 4)
"PARC"]
(DECLARE: DONTCOPY EVAL@COMPILE (RECORDS FunctionIndexElement FileMap FunctionPointer
FunctionBlock FileComElement FunctionData))
(BLOCKS (MULTIFILEINDEXBLOCK BOLDPRIN1 BYTECOPY CheckMapCols CreateHeading FindFunction
FixMapCols GetFileIndices GetFnList GetIndirectValue
GetPrimaryComsValue GetPrimaryFileName GetSourceFiles
MAKEINDEXNUMBER MAKESPACES MAP.LF.FN MAP.↑L.FN MAPENDLINEUSERFN
MULTIFILEINDEX MapCLOSEF MapFNTYP MapGetArgsForDLAMBDA
MapGetDefinition NEWLINE NEWPAGE PrintFiles PrintMap
PrintMapHeader PrintOneFile PrintVars SayFilesListed
SortSourceFiles TESTPAGE TranslateFileCommands XRefFn
XRefFnPrintPara XRefVar (ENTRIES MULTIFILEINDEX MAPENDLINEUSERFN)
(LOCALFREEVARS CURRENTFNNAME CURRENTINDEX DESTINATIONFILE
fileIndices INDEXFILE INDEXNUMBER LINENUMBER
NEWPAGEFLG PAGENUMBER primaryFiles
MULTIFILEINDEXPRIMARYNAMES)
(SPECVARS COMMENTFLG ENDLINEUSERFN FILELINELENGTH FILERDTBL
LINESPERPAGE MULTIFILEINDEXGETDEFFLG
MULTIFILEINDEXMAPFLG MULTIFILEINDEXFILESFLG
MULTIFILEINDEXFNSMSFLG MULTIFILEINDEXLOADVARSFLG
MULTIFILEINDEXVARSMSFLG MULTIFILEINDEXCOLS
MULTIFILEINDEXFILECOL MULTIFILEINDEXNAMECOL
MULTIFILEINDEXTYPECOL PRINTER)
(GLOBALVARS FILELST MACSCRATCHSTRING NOTLISTEDFILES)
(BLKAPPLYFNS MAP.LF.FN MAP.↑L.FN)))
(DECLARE: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T)))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (SYSLOAD SOURCE)
COMMONFILEINDEX))
(FILES CIALPHORDER)))
(* To get function maps of file lists.)
(RPAQQ MULTIFILEINDEXFNS (CreateHeading CheckMapCols FindFunction FixMapCols GetFileIndices GetFnList
GetIndirectValue GetPrimaryComsValue GetPrimaryFileName
GetSourceFiles MULTIFILEINDEX MAP.LF.FN MAP.↑L.FN MapCLOSEF
MAPENDLINEUSERFN MapFNTYP MapGetArgsForDLAMBDA
MapGetDefinition PrintFiles PrintMap PrintMapHeader
PrintOneFile PrintVars SayFilesListed SortSourceFiles
TranslateFileCommands XRefFn XRefFnPrintPara XRefVar))
(DEFINEQ
(CreateHeading
[LAMBDA (fileList string) (* JimSchmolze: "26-May-80 10:08")
(PROG (subFileList firstLine)
(SETQ subFileList (bind (lengthSoFar ← 0) for file in fileList
while (ILESSP (SETQ lengthSoFar (IPLUS (NCHARS file)
2 lengthSoFar))
(IDIFFERENCE FILELINELENGTH 31))
collect file))
(SETQ firstLine (LIST (COND
((IGREATERP (FLENGTH subFileList)
1)
" for files: ")
(T " for file: "))
string))
[for file on subFileList
do (SETQ firstLine (CONS (CAR file)
firstLine))
(COND
((CDR file)
(SETQ firstLine (CONS ", " firstLine]
[COND
((NOT (EQUAL subFileList fileList))
(SETQ firstLine (CONS " ..." firstLine]
(RETURN (SETQ INDEXFILE (APPLY (QUOTE CONCAT)
(DREVERSE firstLine])
(CheckMapCols
[LAMBDA NIL (* J.Vittal: "28-Aug-78 17:54")
(COND
([NOT (MEMB MULTIFILEINDEXCOLS (QUOTE (T NIL FLOATCOLS FIXCOLS FIXFLOATCOLS]
(ERROR MULTIFILEINDEXCOLS "not a valid MULTIFILEINDEX specifier")))
(COND
((NOT (FIXP MULTIFILEINDEXNAMECOL))
(ERROR (QUOTE MULTIFILEINDEXNAMECOL)
"Not an integer")))
(COND
((NOT (FIXP MULTIFILEINDEXFILECOL))
(ERROR (QUOTE MULTIFILEINDEXFILECOL)
"Not an integer")))
(COND
((NOT (FIXP MULTIFILEINDEXTYPECOL))
(ERROR (QUOTE MULTIFILEINDEXTYPECOL)
"Not an integer")))
(COND
((NOT (AND (ILESSP MULTIFILEINDEXNAMECOL MULTIFILEINDEXFILECOL)
(ILESSP MULTIFILEINDEXFILECOL MULTIFILEINDEXTYPECOL)))
(ERROR "The order for the columns MUST be NAME, FILE and COLUMN"])
(FindFunction
[LAMBDA (primaryFile function) (* J.Vittal: "19-Jan-79 10:00")
(for fileIndex in fileIndices when [AND (EQ primaryFile (fetch FunctionIndexFile of fileIndex))
(EQ function (fetch FunctionName
of (fetch FunctionIndexFnPointer
of fileIndex]
do (RETURN fileIndex])
(FixMapCols
[LAMBDA (fileMap) (* JimSchmolze: "26-May-80 10:14")
(* If MULTIFILEINDEXCOLS is either T or FIXCOLS, then take the values of the column vars as gospel.
Otherwise, we have to munge a little.)
(COND
[(FMEMB MULTIFILEINDEXCOLS (QUOTE (NIL FLOATCOLS FIXFLOATCOLS)))
(PROG ((maxFileNameSize 0)
(maxIndexSize 0)
(maxNameSize 0))
(for file in primaryFiles bind length when (IGREATERP (SETQ length (NCHARS file))
maxFileNameSize)
do (SETQ maxFileNameSize length))
(SETQ maxIndexSize (NCHARS CURRENTINDEX))
(for name in fileMap bind length when (IGREATERP [SETQ length
(COND
((NLISTP (fetch FileComElementName
of name))
(NCHARS (fetch
FileComElementName
of name)))
(T (CONSTANT (NCHARS
"** s-expression **"]
maxNameSize)
do (SETQ maxNameSize length))
(COND
[(ILEQ (IPLUS MULTIFILEINDEXNAMECOL maxNameSize maxIndexSize maxFileNameSize 3)
(FIX (FPLUS (FTIMES .45 FILELINELENGTH)
.5)))
[SETQ MULTIFILEINDEXFILECOL (COND
((EQ MULTIFILEINDEXCOLS (QUOTE FLOATCOLS))
(IPLUS MULTIFILEINDEXNAMECOL maxNameSize maxIndexSize 2))
(T (IMAX (IPLUS MULTIFILEINDEXNAMECOL maxNameSize maxIndexSize 2)
MULTIFILEINDEXFILECOL]
(SETQ MULTIFILEINDEXTYPECOL (COND
((EQ MULTIFILEINDEXCOLS (QUOTE FLOATCOLS))
(IPLUS MULTIFILEINDEXFILECOL maxFileNameSize 1))
(T (IMAX (IPLUS MULTIFILEINDEXFILECOL maxFileNameSize 1)
MULTIFILEINDEXTYPECOL]
(T [SETQ MULTIFILEINDEXTYPECOL (COND
((EQ MULTIFILEINDEXCOLS (QUOTE FLOATCOLS))
(FIX (FTIMES .45 FILELINELENGTH)))
(T (IMAX (FIX (FTIMES .45 FILELINELENGTH))
MULTIFILEINDEXTYPECOL]
(SETQ MULTIFILEINDEXFILECOL (COND
((EQ MULTIFILEINDEXCOLS (QUOTE FLOATCOLS))
(SUB1 (IDIFFERENCE MULTIFILEINDEXTYPECOL maxFileNameSize)))
(T (IMAX (SUB1 (IDIFFERENCE MULTIFILEINDEXTYPECOL maxFileNameSize))
MULTIFILEINDEXFILECOL]
(T (* don't change)
NIL])
(GetFileIndices
[LAMBDA (FileList) (* J.Vittal: "30-Sep-79 12:36")
(bind primaryFile fileMap file for singleFile in FileList
join (SETQ primaryFile (GetPrimaryFileName singleFile))
(RESETLST [RESETSAVE NIL (LIST (QUOTE CLOSEF)
(SETQ file (OPENFILE singleFile (QUOTE INPUT)
(QUOTE OLD]
(SETQ fileMap (GETFILEMAP file)))
(for BLK in (fetch (FileMap Maps) of fileMap)
join (for FNELEMENT in (fetch BlockFunctions of BLK)
collect (create FunctionIndexElement
FunctionIndexFile ← primaryFile
FunctionIndexFnPointer ← FNELEMENT])
(GetFnList
[LAMBDA (fileList) (* J.Vittal: "12-Apr-80 09:09")
(PROG1 (for file in fileList
join [COND
(MULTIFILEINDEXLOADVARSFLG (RESETVARS (PRETTYHEADER)
(LOADVARS (QUOTE VARS)
file T]
(PROG1 (TranslateFileCommands (GetPrimaryFileName file)
(GetPrimaryComsValue file)
file)
(CLOSEF? file)))
(MapCLOSEF fileList])
(GetIndirectValue
[LAMBDA (com file) (* J.Vittal: "26-Sep-79 09:46")
(PROG (comName comValue)
(SETQ comName (SELECTQ (CAR com)
((PROP IFPROP FILES)
(CADDDR com))
(CADDR com)))
Start
(if (NOT (LITATOM comName))
then (if (AND (EQ (CAR comName)
(QUOTE PROGN))
(LITATOM (CADR comName))
(NULL (CDDR comName)))
then (SETQ comName (CADR comName))
(GO Start))
(printout NIL "Can't tell if " comName " should be evaluated -- in file " file T)
(RETURN)) (* we have the name, if it has a value, peturn it.
Otherwise gotta go get it from file.)
(if MULTIFILEINDEXGETDEFFLG
then (printout NIL "Doing a GETDEF of " comName " from " file " ... "))
(SETQ comValue (GETDEF comName (QUOTE VARS)
file
(QUOTE NOERROR)))
(if MULTIFILEINDEXGETDEFFLG
then (printout NIL "done." T))
(RETURN comValue])
(GetPrimaryComsValue
[LAMBDA (realFile) (* DD: "27-APR-83 01:44")
(PROG (primaryFile coms comsName)
(SETQ primaryFile (GetPrimaryFileName realFile))
(SETQ comsName (FILECOMS primaryFile))
(COND
(MULTIFILEINDEXGETDEFFLG (printout NIL "Doing a GETDEF of " comsName " from " realFile
" ... ")))
(SETQ coms (GETDEF comsName (QUOTE VARS)
realFile
(QUOTE NOERROR)))
(COND
(MULTIFILEINDEXGETDEFFLG (printout NIL "done." T)))
(RETURN coms])
(GetPrimaryFileName
[LAMBDA (file) (* J.Vittal: "30-Jan-79 14:01")
(OR (GETPROP file (QUOTE PrimaryName))
(PUTPROP file (QUOTE PrimaryName)
(PROGN (SETQ MULTIFILEINDEXPRIMARYNAMES (CONS file MULTIFILEINDEXPRIMARYNAMES))
(FILENAMEFIELD file (QUOTE NAME])
(GetSourceFiles
[LAMBDA (files) (* J.Vittal: "26-Sep-79 07:13")
(* Makes sure that the filedates property for each file on files exists and corresponds to that name, that the
filecoms exist for that file (indirections need not exist). The filemap need not be loaded. Returns a list of the
real file names (complete with directory, etc.).)
(for file in files
collect (* Make sure file is loadable)
(OR (FINDFILE (PACKFILENAME (QUOTE BODY)
file))
[FINDFILE (PACKFILENAME (QUOTE BODY)
(CDAR (GETP (GetPrimaryFileName file)
(QUOTE FILEDATES]
(ERROR "Can't find file " file])
(MULTIFILEINDEX
[LAMBDA (SOURCEFILES DESTINATIONFILE NEWPAGEFLG) (* DD: "27-APR-83 00:28")
(* Assumes that -
-
1.0 The files in SOURCEFILES are noticed. -
-
2.0 The fileMap and ALL coms for each file are loaded. -
-
If not, then does a LOADFROM on that file.)
(SETQ SOURCEFILES (COND
((EQ SOURCEFILES T)
FILELST)
((AND SOURCEFILES (NLISTP SOURCEFILES))
(LIST SOURCEFILES))
(T SOURCEFILES)))
(COND
((NULL DESTINATIONFILE)
(SETQ DESTINATIONFILE PRINTER)))
(COND
(SOURCEFILES (PROG (fileMap primaryFiles fileIndices (MULTIFILEINDEXNAMECOL
MULTIFILEINDEXNAMECOL)
(MULTIFILEINDEXFILECOL MULTIFILEINDEXFILECOL)
(MULTIFILEINDEXTYPECOL MULTIFILEINDEXTYPECOL)
(ENDLINEUSERFN (QUOTE MAPENDLINEUSERFN))
(INDEXFILE "")
(CURRENTINDEX 0)
(INDEXNUMBER 0)
CURRENTFNNAME
(LINENUMBER 0)
(PAGENUMBER 1)
MULTIFILEINDEXPRIMARYNAMES)
(* Make sure that SOURCEFILES is a LIST and is the short file name, with the filedates property loaded, the file
noticed, and good things like that.)
(COND
((OR MULTIFILEINDEXFNSMSFLG MULTIFILEINDEXVARSMSFLG)
(UPDATECHANGED)))
(CheckMapCols)
[ERSETQ (PROGN (* Get the file maps for the files.)
(SETQ SOURCEFILES (SortSourceFiles (GetSourceFiles
SOURCEFILES)))
(SETQ primaryFiles (for file in SOURCEFILES
collect (GetPrimaryFileName file)))
(SETQ fileIndices (GetFileIndices SOURCEFILES))
[SETQ fileMap (SORT (GetFnList SOURCEFILES)
(FUNCTION (LAMBDA (X Y)
(CIALPHORDER (fetch
FileComElementName
of X)
(fetch
FileComElementName
of Y]
[SETQ DESTINATIONFILE (COND
((OR (EQ DESTINATIONFILE T)
(EQ DESTINATIONFILE (QUOTE TTY:)))
T)
(T (OPENFILE DESTINATIONFILE (QUOTE OUTPUT)
(QUOTE NEW]
(ERSETQ (RESETLST (RESETSAVE (RADIX 10))
(RESETSAVE (OUTPUT DESTINATIONFILE))
(RESETSAVE (LINELENGTH FILELINELENGTH))
(PROGN (PRIN1 (FCHARACTER 12))
(PrintMapHeader SOURCEFILES)
(PrintMap fileMap primaryFiles)
(PrintFiles SOURCEFILES)
(PrintVars primaryFiles)
(SayFilesListed primaryFiles]
(COND
((NEQ DESTINATIONFILE T)
(CLOSEF? DESTINATIONFILE))) (* finally, reset all the reload flags and the
PrimaryName properties)
(* (for file in primaryFiles when
(GETP file (QUOTE ReloadCOMS)) do
(REMPROP file (QUOTE ReloadCOMS))))
(for name in MULTIFILEINDEXPRIMARYNAMES do (REMPROP name (QUOTE PrimaryName))
finally (SETQ MULTIFILEINDEXPRIMARYNAMES NIL])
(MAP.LF.FN
[LAMBDA NIL
(NEWLINE T])
(MAP.↑L.FN
[LAMBDA NIL
(NEWPAGE T])
(MapCLOSEF
[LAMBDA (fileList) (* J.Vittal: "18-Jan-79 11:34")
(for file in fileList when (OPENP file (QUOTE INPUT)) do (CLOSEF file])
(MAPENDLINEUSERFN
[LAMBDA NIL
(NEWLINE T])
(MapFNTYP
[LAMBDA (function sourceFile) (* JimSchmolze: "23-Apr-80 12:46")
(PROG (functionType functionArgs functionBody)
[COND
([SETQ functionBody (COND
(sourceFile (MapGetDefinition function sourceFile))
(T (HELP "Can't find the definition for " function)
(MSGETDEF function NIL T]
(SETQ functionArgs (SELECTQ (CAR functionBody)
(DLAMBDA (MapGetArgsForDLAMBDA functionBody))
(CADR functionBody)))
(SETQ functionType (SELECTQ (CAR functionBody)
[LAMBDA (COND
((OR (NULL functionArgs)
(LISTP functionArgs))
(QUOTE expr))
(T (QUOTE expr*]
[NLAMBDA (COND
((OR (NULL functionArgs)
(LISTP functionArgs))
(QUOTE fexpr))
(T (QUOTE fexpr*]
(CAR functionBody)))
(RETURN (CONS functionType functionArgs]
(ERROR "Can't find the type or args for " function])
(MapGetArgsForDLAMBDA
[LAMBDA (functionBody) (* JimSchmolze: "23-Apr-80 12:39")
(* Returns a printable version of the argument list for
a DLAMBDA)
(for arg in (CADR functionBody) join (if (LITATOM arg)
then (LIST arg)
elseif (LISTP arg)
then (if (NEQ (CAR arg)
(QUOTE RETURNS))
then (if (LISTP (CADR arg))
then (LIST (LIST (CAR arg)
(QUOTE &)))
elseif (CDDR arg)
then (LIST (LIST (CAR arg)
(CADR arg)))
else (LIST arg])
(MapGetDefinition
[LAMBDA (function fileName) (* J.Vittal: "19-Jan-79 10:00")
(* gets the definition of function from FILE.
Finds the location of function in fileName thru
FindFunctionIndex)
(PROG (startPointer)
[SETQ startPointer (fetch FunctionBegin of (fetch FunctionIndexFnPointer
of (FindFunction (GetPrimaryFileName fileName)
function]
[COND
((NOT (OPENP fileName (QUOTE INPUT)))
(SETQ fileName (INPUT (INFILE fileName]
(FILEPOS "
" fileName startPointer NIL NIL T)
(* The RATOM gets rid of character (either left paren or left square bracket) that preceeds the lambda type.
Then read the LAMBDA (or whatever) and the arg list, and return them as a list.)
(RATOM fileName FILERDTBL)
(RETURN (LIST (READ fileName FILERDTBL)
(READ fileName FILERDTBL])
(PrintFiles
[LAMBDA (sourceFileList) (* edited: " 2-OCT-79 17:41")
(COND
(MULTIFILEINDEXFILESFLG (SETQ INDEXNUMBER 0)
(for sourceFile in sourceFileList
do (* INDEXFILE is used free by CREATEFILEHEADING.)
[SETQ INDEXFILE (PACKFILENAME (QUOTE NAME)
(FILENAMEFIELD sourceFile
(QUOTE NAME))
(QUOTE EXTENSION)
(FILENAMEFIELD sourceFile
(QUOTE EXTENSION]
(SETQ CURRENTFNNAME "")
(NEWPAGE)
(PrintOneFile sourceFile])
(PrintMap
[LAMBDA (fileMap fileList) (* JimSchmolze: "23-Apr-80 15:26")
(* Prints the map for the data in filemap.
It assumes that fileMap is already sorted
appropriately.)
(COND
(MULTIFILEINDEXMAPFLG (RESETFORM (LINELENGTH FILELINELENGTH)
(bind position FileNameIndentation maxIndexSize for ele
in fileMap
first (FixMapCols fileMap)
(CreateHeading fileList "Map")
(SETQ maxIndexSize (NCHARS CURRENTINDEX))
(SETQ FileNameIndentation (IDIFFERENCE (SUB1
MULTIFILEINDEXFILECOL)
maxIndexSize))
do (COND
((AND (IGREATERP (NCHARS (fetch FileComElementName
of ele))
(SUB1 FileNameIndentation))
(NOT (TESTPAGE 2)))
(NEWPAGE)))
(COND
((IGREATERP MULTIFILEINDEXNAMECOL 0)
(TAB MULTIFILEINDEXNAMECOL)))
(PRIN1 (COND
((NLISTP (fetch FileComElementName
of ele))
(fetch FileComElementName of ele))
(T "** s-expression **")))
(* Do we have to go to a new line?)
(COND
((IGEQ (IPLUS (SETQ position (POSITION))
(NCHARS (fetch FileComIndex
of ele)))
MULTIFILEINDEXFILECOL)
(NEWLINE)
(SETQ position MULTIFILEINDEXFILECOL)))
[TAB (SUB1 (IDIFFERENCE MULTIFILEINDEXFILECOL
(NCHARS (fetch FileComIndex
of ele]
(PRIN1 (fetch FileComIndex of ele))
(SPACES 1)
(PRIN1 (fetch FileComFile of ele))
(COND
((NULL (fetch FileComElementData of ele))
(NEWLINE))
(T (COND
((IGEQ (POSITION)
MULTIFILEINDEXTYPECOL)
(NEWLINE)))
(TAB MULTIFILEINDEXTYPECOL)
(COND
((NLISTP (fetch FileComElementData of ele))
(PRIN1 (fetch FileComElementData of ele))
(NEWLINE))
(T (PRIN1 (fetch FunctionType
of (fetch FileComElementData
of ele)))
(PRIN1 ": ")
(PRINTDEF (fetch FunctionArgList
of (fetch FileComElementData
of ele))
(POSITION))
(NEWLINE])
(PrintMapHeader
[LAMBDA (fileList) (* J.Vittal: "29-Sep-79 07:33")
(* Prints the header for the map on the primary output
file.)
(PROG ((maxLength 0))
(CreateHeading primaryFiles "Map")
(RPTQ 3 (NEWLINE))
(PRIN1 "Summary for files: ")
(for file in fileList do (SETQ maxLength (IMAX (NCHARS file)
maxLength)))
(bind (position ←(IPLUS maxLength 38)) for file in fileList
first [SETQ position (COND
((IGREATERP position FILELINELENGTH)
(IDIFFERENCE FILELINELENGTH 19))
(T (IDIFFERENCE position 18]
do (PRIN1 file)
(COND
((IGREATERP (POSITION)
(SUB1 position))
(NEWLINE)))
[printout NIL .TAB position (GETFILEINFO file (QUOTE WRITEDATE)
(CONSTANT (CONCAT]
(NEWLINE)
(TAB 19))
(NEWLINE)
(printout NIL "Index made on " (GDATE -1 -788529152))
(NEWLINE)
(NEWLINE])
(PrintOneFile
[LAMBDA (sourceFile) (* J.Vittal: " 2-Oct-79 10:10")
(RESETLST [RESETSAVE NIL (LIST (QUOTE CLOSEF)
(SETQ sourceFile (INPUT (INFILE sourceFile]
(PROG ((filePos 0))
(SETFILEPTR sourceFile 0)
[for BLK in (fetch (FileMap Maps) of (GETFILEMAP sourceFile))
do (bind LAST.ELE NUMBERSTR for FNPTR in (fetch BlockFunctions of BLK)
do (BYTECOPY sourceFile DESTINATIONFILE filePos (SETQ filePos
(fetch FunctionBegin of FNPTR))
(QUOTE MAP.↑L.FN)
(QUOTE MAP.LF.FN))
(SETQ INDEXNUMBER (ADD1 INDEXNUMBER))
(SETQ CURRENTFNNAME (fetch FunctionName of FNPTR))
(if [OR NEWPAGEFLG (NOT (TESTPAGE (if MULTIFILEINDEXFNSMSFLG
then 12
else 4]
then (NEWPAGE))
(SETQ NUMBERSTR (MAKEINDEXNUMBER INDEXNUMBER))
(SPACES (IDIFFERENCE FILELINELENGTH (NCHARS NUMBERSTR)))
(BOLDPRIN1 NUMBERSTR)
(NEWLINE)
(if MULTIFILEINDEXFNSMSFLG
then (BOLDPRIN1 (fetch FunctionName of FNPTR))
(NEWLINE)
(NEWLINE)
(XRefFn (fetch FunctionName of FNPTR))
(NEWLINE))
(NEWLINE)
(SETQ LAST.ELE FNPTR)
finally (BYTECOPY sourceFile DESTINATIONFILE filePos
(SETQ filePos (OR (fetch FunctionEnd of LAST.ELE)
(fetch FnBlockEnd of BLK)))
(QUOTE MAP.↑L.FN)
(QUOTE MAP.LF.FN))
(if NEWPAGEFLG
then (NEWPAGE)
(NEWLINE)
(NEWLINE]
(BYTECOPY sourceFile DESTINATIONFILE filePos (GETEOFPTR sourceFile)
(QUOTE MAP.↑L.FN)
(QUOTE MAP.LF.FN])
(PrintVars
[LAMBDA (fileList) (* J.Vittal: "29-Sep-79 07:32")
(COND
(MULTIFILEINDEXVARSMSFLG (PROG (vars) (* Turn off the printing of index numbers in the page
heading, and create the new header.)
(SETQ INDEXNUMBER 0)
(SETQ CURRENTFNNAME NIL)
(CreateHeading fileList "VARS")
(NEWPAGE) (* first get the vars and sort them)
[SETQ vars (UNION (MASTERSCOPE (QUOTE (WHO IS USED BY ANY)))
(MASTERSCOPE (QUOTE (WHO IS SET BY ANY]
[SETQ vars (SORT (INTERSECTION vars vars)
(FUNCTION (LAMBDA (X Y)
(CIALPHORDER X Y]
(NEWLINE)
(NEWLINE)
(BOLDPRIN1 "Variable Listing")
(NEWLINE)
(NEWLINE)
(for var in vars
do (COND
((NOT (TESTPAGE 5))
(NEWPAGE))
(T (NEWLINE)
(NEWLINE)))
(BOLDPRIN1 var)
(NEWLINE)
(XRefVar var])
(SayFilesListed
[LAMBDA (fileList) (* J.Vittal: " 9-Aug-78 08:37")
(for file in fileList do (/SET (QUOTE NOTLISTEDFILES)
(DREMOVE file NOTLISTEDFILES])
(SortSourceFiles
[LAMBDA (fileList) (* J.Vittal: "18-Jan-79 20:00")
(for file in fileList collect (CONS (GetPrimaryFileName file)
file)
finally (RETURN (for y in (SORT $$VAL T) collect (CDR y])
(TranslateFileCommands
[LAMBDA (file coms wholeFile) (* JimSchmolze: "26-May-80 10:01")
(* Returns a list of stuff for a coms)
(bind comsValue for com in coms
join [SETQ comsValue (COND
((EQ (CAR com)
COMMENTFLG)
NIL)
((EQ (SELECTQ (CAR com)
((PROP IFPROP FILES)
(CADDR com))
(CADR com))
(QUOTE *)) (* an indirection -- go get value)
(GetIndirectValue com wholeFile))
(T (SELECTQ (CAR com)
((PROP IFPROP FILES)
(CDDR com))
(CDR com]
(SELECTQ (CAR com)
(COMS (TranslateFileCommands file comsValue wholeFile))
(DECLARE: (bind temp for comsEle on comsValue
when (AND (COND
((MEMB (CAR comsEle)
(QUOTE (EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN))
)
(SETQ comsEle (CDR comsEle))
NIL)
(T T))
(LISTP (CAR comsEle))
(SETQ temp (TranslateFileCommands file
(LIST (CAR comsEle))
wholeFile)))
join temp))
[FNS (for comsEle in comsValue
collect (create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComIndex ←(SETQ CURRENTINDEX (ADD1 CURRENTINDEX))
FileComElementData ←(PROG (TEMP FT)
(SETQ TEMP (create
FunctionData))
(SETQ FT (MapFNTYP comsEle
wholeFile))
(replace FunctionType
of TEMP
with (CAR FT))
(replace FunctionArgList
of TEMP
with (CDR FT))
(RETURN TEMP]
[(ALISTS ADDVARS)
(for comsEle in comsValue when [NOT (FMEMB (CAR comsEle)
(QUOTE (NLAMA NLAML LAMA LAML]
collect (create FileComElement
FileComElementName ←(CAR comsEle)
FileComFile ← file
FileComElementData ←(CAR com]
[BLOCKS (for comsEle in comsValue when (CAR comsEle)
collect (create FileComElement
FileComElementName ←(CAR comsEle)
FileComFile ← file
FileComElementData ←(CAR com]
[CONSTANTS (for comsEle in comsValue
collect (COND
((NLISTP comsEle)
(create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComElementData ←(QUOTE Constant)))
(T (create FileComElement
FileComElementName ←(CAR comsEle)
FileComFile ← file
FileComElementData ←(QUOTE Constant]
[VARS (for comsEle in comsValue
collect (COND
((NLISTP comsEle)
(create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComElementData ←(QUOTE Saved% Variable)))
(T (create FileComElement
FileComElementName ←(CAR comsEle)
FileComFile ← file
FileComElementData ←(QUOTE Set% Variable]
[RECORDS (for comsEle in comsValue
join (COND
[(AND (LISTP comsEle)
(EQ (CAR comsEle)
(QUOTE ATOMRECORD)))
(for AtomEle in (CADR comsEle)
collect (create FileComElement
FileComElementName ← AtomEle
FileComFile ← file
FileComElementData ←(QUOTE ATOMRECORD]
(T (LIST (create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComElementData ←(COND
((NLISTP comsEle)
(CAR com))
(T (PACK* (QUOTE Unnamed-)
(CAR comsEle]
[(PROP IFPROP)
(bind PR for PX in (COND
((LITATOM (CADR com))
(LIST (CADR com)))
(T (CADR com)))
join (SETQ PR (PACK* [COND
(comsValue (SELECTQ (CAR com)
(PROP (QUOTE prop:% ))
(IFPROP (QUOTE ifprop:% ))
(SHOULDNT]
PX))
(for comsEle in comsValue
collect (create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComElementData ← PR]
((MACROS) (* Ones that require special handling)
(SELECTQ (CAR com)
[MACROS (for comsEle in comsValue
collect (COND
((LITATOM comsEle)
(create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComElementData ←(QUOTE MACROS)))
(T (create FileComElement
FileComElementName ←(CDR comsEle)
FileComFile ← file
FileComElementData ←(CAR comsEle]
NIL))
(COND
[(LITATOM com)
(LIST (create FileComElement
FileComElementName ← com
FileComFile ← file
FileComElementData ←(QUOTE Saved% Variable]
([MEMB (CAR com)
(DEFERREDCONSTANT (CONS COMMENTFLG (QUOTE (E P]
NIL)
(T (for comsEle in comsValue
collect (create FileComElement
FileComElementName ← comsEle
FileComFile ← file
FileComElementData ←(CAR com])
(XRefFn
[LAMBDA (fn) (* J.Vittal: "26-Sep-79 06:40")
(* Prints cross reference information about fn onto file. Note: (UPDATECHANGED) must have been called previous to
any call to this function to have the Masterscope database set up. Also, this function would run much faster if the
relations used in (GETRELATION) were pre-parsed via (PARSERELATION))
(PROG (L (n 3)
(lm 20)
(rm (LINELENGTH)))
(if (SETQ L (GETRELATION fn [CONSTANT (PARSERELATION (QUOTE (CALL]
T))
then (printout NIL .TAB0 n "called by")
(XRefFnPrintPara L lm rm))
(if [SETQ L (GETRELATION fn (CONSTANT (PARSERELATION (QUOTE (CALL]
then (printout NIL .TAB0 n "calls")
(XRefFnPrintPara L lm rm))
(if [SETQ L (GETRELATION fn (CONSTANT (PARSERELATION (QUOTE (REFERENCE FREELY]
then (printout NIL .TAB0 n "freely uses")
(XRefFnPrintPara L lm rm))
(if [SETQ L (GETRELATION fn (CONSTANT (PARSERELATION (QUOTE (REFERENCES LOCALLY]
then (printout NIL .TAB0 n "locally uses")
(XRefFnPrintPara L lm rm))
(if [SETQ L (GETRELATION fn (CONSTANT (PARSERELATION (QUOTE (SETS FREELY]
then (printout NIL .TAB0 n "freely sets")
(XRefFnPrintPara L lm rm))
(if [SETQ L (GETRELATION fn (CONSTANT (PARSERELATION (QUOTE (SETS LOCALLY]
then (printout NIL .TAB0 n "locally sets")
(XRefFnPrintPara L lm rm])
(XRefFnPrintPara
[LAMBDA (list lm rm) (* J.Vittal: "13-Jul-79 09:35")
(* Print the list in paragraph form.)
(bind length pos first (if (ILESSP (SETQ pos (POSITION))
lm)
then (TAB lm 0)
(SETQ pos lm))
for x in list
do (if (IGREATERP (add pos (SETQ length (NCHARS x)))
rm)
then (NEWLINE)
(TAB lm 0)
(SETQ pos (IPLUS length lm)))
(PRIN1 x)
(if (IGREATERP (add pos 1)
rm)
then (NEWLINE)
(TAB lm 0)
(SETQ pos lm)
else (SPACES 1)))
(NEWLINE)
list])
(XRefVar
[LAMBDA (var) (* J.Vittal: "26-Sep-79 06:42")
(* Prints cross reference information about var onto file. Note: (UPDATECHANGED) must have been called previous to
any call to this function to have the Masterscope database set up. Also, this function would run much faster if the
relations used in (GETRELATION) were pre-parsed via (PARSERELATION))
(PROG (L (n 3)
(lm 23)
(rm (LINELENGTH)))
(if (SETQ L (GETRELATION var [CONSTANT (PARSERELATION (QUOTE (BIND]
T))
then (printout NIL .TAB0 n "bound in")
(XRefFnPrintPara L lm rm))
(if (SETQ L (GETRELATION var [CONSTANT (PARSERELATION (QUOTE (USE FREELY]
T))
then (printout NIL .TAB0 n "used freely in")
(XRefFnPrintPara L lm rm))
(if (SETQ L (GETRELATION var [CONSTANT (PARSERELATION (QUOTE (USE LOCALLY]
T))
then (printout NIL .TAB0 n "used locally in")
(XRefFnPrintPara L lm rm))
(if (SETQ L (GETRELATION var [CONSTANT (PARSERELATION (QUOTE (SMASH FREELY]
T))
then (printout NIL .TAB0 n "smashed freely in")
(XRefFnPrintPara L lm rm))
(if (SETQ L (GETRELATION var [CONSTANT (PARSERELATION (QUOTE (SMASH LOCALLY]
T))
then (printout NIL .TAB0 n "smashed locally in")
(XRefFnPrintPara L lm rm])
)
(RPAQQ MULTIFILEINDEXMAPFLG T)
(RPAQQ MULTIFILEINDEXFILESFLG T)
(RPAQQ MULTIFILEINDEXFNSMSFLG NIL)
(RPAQQ MULTIFILEINDEXVARSMSFLG NIL)
(RPAQQ MULTIFILEINDEXCOLS FLOATCOLS)
(RPAQQ MULTIFILEINDEXNAMECOL 0)
(RPAQQ MULTIFILEINDEXFILECOL 26)
(RPAQQ MULTIFILEINDEXTYPECOL 41)
(RPAQQ MULTIFILEINDEXGETDEFFLG NIL)
(OR (BOUNDP (QUOTE LINESPERPAGE))
(RPAQQ LINESPERPAGE 58))
(OR (BOUNDP (QUOTE PRINTER))
(RPAQQ PRINTER LPT:))
(OR (BOUNDP (QUOTE MULTIFILEINDEXLOADVARSFLG))
(RPAQ MULTIFILEINDEXLOADVARSFLG (STREQUAL (SUBSTRING HOSTNAME 1 4)
"PARC")))
(DECLARE: DONTCOPY EVAL@COMPILE
[DECLARE: EVAL@COMPILE
(RECORD FunctionIndexElement (FunctionIndexIndex FunctionIndexFile FunctionIndexFnPointer))
(RECORD FileMap (NIL . Maps))
(RECORD FunctionPointer (FunctionName FunctionBegin . FunctionEnd))
(RECORD FunctionBlock (FnBlockBegin FnBlockEnd . BlockFunctions))
(RECORD FileComElement (FileComElementName FileComFile FileComIndex FileComElementData)
FileComIndex ← CURRENTINDEX)
(RECORD FunctionData (FunctionType FunctionArgList))
]
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: MULTIFILEINDEXBLOCK BOLDPRIN1 BYTECOPY CheckMapCols CreateHeading FindFunction FixMapCols
GetFileIndices GetFnList GetIndirectValue GetPrimaryComsValue GetPrimaryFileName
GetSourceFiles MAKEINDEXNUMBER MAKESPACES MAP.LF.FN MAP.↑L.FN MAPENDLINEUSERFN MULTIFILEINDEX
MapCLOSEF MapFNTYP MapGetArgsForDLAMBDA MapGetDefinition NEWLINE NEWPAGE PrintFiles PrintMap
PrintMapHeader PrintOneFile PrintVars SayFilesListed SortSourceFiles TESTPAGE
TranslateFileCommands XRefFn XRefFnPrintPara XRefVar (ENTRIES MULTIFILEINDEX MAPENDLINEUSERFN)
(LOCALFREEVARS CURRENTFNNAME CURRENTINDEX DESTINATIONFILE fileIndices INDEXFILE INDEXNUMBER
LINENUMBER NEWPAGEFLG PAGENUMBER primaryFiles MULTIFILEINDEXPRIMARYNAMES)
(SPECVARS COMMENTFLG ENDLINEUSERFN FILELINELENGTH FILERDTBL LINESPERPAGE
MULTIFILEINDEXGETDEFFLG MULTIFILEINDEXMAPFLG MULTIFILEINDEXFILESFLG
MULTIFILEINDEXFNSMSFLG MULTIFILEINDEXLOADVARSFLG MULTIFILEINDEXVARSMSFLG
MULTIFILEINDEXCOLS MULTIFILEINDEXFILECOL MULTIFILEINDEXNAMECOL
MULTIFILEINDEXTYPECOL PRINTER)
(GLOBALVARS FILELST MACSCRATCHSTRING NOTLISTEDFILES)
(BLKAPPLYFNS MAP.LF.FN MAP.↑L.FN))
]
(DECLARE: EVAL@COMPILE DONTCOPY
(RESETSAVE DWIMIFYCOMPFLG T)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (SYSLOAD SOURCE)
COMMONFILEINDEX)
)
(FILESLOAD CIALPHORDER)
(DECLARE: DONTCOPY
(FILEMAP (NIL (3027 34262 (CreateHeading 3037 . 3963) (CheckMapCols 3965 . 4800) (FindFunction 4802 .
5195) (FixMapCols 5197 . 7473) (GetFileIndices 7475 . 8195) (GetFnList 8197 . 8663) (GetIndirectValue
8665 . 9747) (GetPrimaryComsValue 9749 . 10345) (GetPrimaryFileName 10347 . 10664) (GetSourceFiles
10666 . 11444) (MULTIFILEINDEX 11446 . 14484) (MAP.LF.FN 14486 . 14531) (MAP.↑L.FN 14533 . 14578) (
MapCLOSEF 14580 . 14782) (MAPENDLINEUSERFN 14784 . 14836) (MapFNTYP 14838 . 15815) (
MapGetArgsForDLAMBDA 15817 . 16543) (MapGetDefinition 16545 . 17569) (PrintFiles 17571 . 18175) (
PrintMap 18177 . 20694) (PrintMapHeader 20696 . 21796) (PrintOneFile 21798 . 23554) (PrintVars 23556
. 24605) (SayFilesListed 24607 . 24830) (SortSourceFiles 24832 . 25122) (TranslateFileCommands 25124
. 30474) (XRefFn 30476 . 32063) (XRefFnPrintPara 32065 . 32782) (XRefVar 32784 . 34260)))))
STOP