(FILECREATED " 8-NOV-83 16:42:39" {PHYLUM}<LISP>LIBRARY>SINGLEFILEINDEX.;7 18457
changes to: (FNS MERGEDFILEINDEX INDEXCOPYBYTES SINGLEFILEINDEX INDEXNEWLINE INDEXNEWPAGE)
previous date: " 8-NOV-83 16:23:17" {PHYLUM}<LISP>LIBRARY>SINGLEFILEINDEX.;6)
(PRETTYCOMPRINT SINGLEFILEINDEXCOMS)
(RPAQQ SINGLEFILEINDEXCOMS [(FNS SINGLEFILEINDEX MERGEDFILEINDEX INDEXNEWLINE INDEXNEWPAGE PRINTDOTS
LISTINGHEADER CENTERPRINT FILEINDEXALPHORDER)
(FNS INDEXCOPYBYTES)
(FNS SFILISTFILES1)
[VARS (PRINTER (SELECTQ (SYSTEMTYPE)
(D (QUOTE {LPT}))
(QUOTE LPT:]
[DECLARE: DOCOPY DONTEVAL@LOAD
(P (MOVD? (QUOTE LISTFILES1)
(QUOTE OLDLISTFILES1))
(/MOVD (QUOTE SFILISTFILES1)
(QUOTE LISTFILES1))
(COND ([NOT (FIXP (GETTOPVAL (QUOTE LINESPERPAGE]
(SAVESETQ LINESPERPAGE (SELECTQ (SYSTEMTYPE)
(D 65)
58]
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DefineqList FileMap FnPointer)
(P (SELECTQ (COMPILEMODE)
(PDP-10 (FILESLOAD (SYSLOAD FROM VALUEOF
LISPUSERSDIRECTORIES)
CJSYS))
NIL)))
(BLOCKS (SINGLEFILEINDEXBLOCK SINGLEFILEINDEX MERGEDFILEINDEX
INDEXNEWLINE INDEXNEWPAGE PRINTDOTS
LISTINGHEADER CENTERPRINT INDEXCOPYBYTES
(ENTRIES SINGLEFILEINDEX MERGEDFILEINDEX)
(LOCALFREEVARS LINECOUNT PAGECOUNT CURFN
INUM FULL)
(GLOBALVARS FILELINELENGTH PRINTER
FONTCHANGEFLG DEFAULTFONT
PRETTYCOMFONT])
(DEFINEQ
(SINGLEFILEINDEX
[LAMBDA (INF OUTF NEWPAGEFLG) (* rmk: " 8-NOV-83 12:09")
(* Makes a indexed file (default is the line printer). The index file will have a table of contents which will
list all the functions in alphabetical order and a sequence number of where that function is in the file.
In the listing the index number will be "highlighted" in the right hand margin. -
NOTE: The index file is not "loadable" into LISP.)
(DECLARE (GLOBALVARS FILERDTBL))
(RESETLST
(PROG [MAP (LINECOUNT 0)
(PAGECOUNT 0)
(LINESPERPAGE LINESPERPAGE)
CURFN
(FULL (OPENFILE INF (QUOTE INPUT)
(QUOTE OLD]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
FULL))
(OR [SETQ MAP
(CDR (OR (GETFILEMAP FULL INF)
(AND (EQ (SKIPSEPRS FULL FILERDTBL)
(QUOTE %())
(for C
in (QUOTE (%( F I L E C R E A T E D % ))
always (EQ C (READC FULL)))
(LOADFILEMAP FULL]
(PROGN (printout T "Could not get file map for " FULL T)
(RETURN)))
[RESETSAVE [OUTPUT (SETQ OUTF (OPENFILE (OR OUTF PRINTER)
(QUOTE OUTPUT)
(QUOTE NEW]
(QUOTE (PROGN (CLOSEF? (OUTPUT OLDVALUE]
(SELECTQ (SYSTEMTYPE)
[TENEX (COND
((STRPOS "PARC-MAXC" (HOSTNAME))
(PROG [(J (VAG (OPNJFN OUTF]
(ASSEMBLE NIL (* set the "NAME" parameter to be the name of the file)
(CQ (CONCAT FULL (CHARACTER 0)))
(FASTCALL UPATM)
(PUSHN 3)
[CQ (CONSTANT (CONCAT "NAME" (CHARACTER 0]
(FASTCALL UPATM)
(MOVE 2 , 3)
(POPN 3)
(CQ J)
(JSYS 440Q)
(JFCL))
(SETQ LINESPERPAGE (IDIFFERENCE (BITS 4 10 (JS RFMOD
(LOC J)
NIL NIL 2))
3]
(D (SETQ LINESPERPAGE (OR (GETFILEINFO OUTF (QUOTE PAGEHEIGHT))
LINESPERPAGE)))
NIL)
(RESETSAVE (LINELENGTH 1000 OUTF))
(RESETSAVE (RADIX 10))
(PROGN (CENTERPRINT (CONCAT FULL " " (GETFILEINFO FULL (QUOTE WRITEDATE)))
T)
(CENTERPRINT (CONCAT "-- Listed on " (DATE)
" --"))
(INDEXNEWLINE))
[PROG (ILIST (INUM 0)
(MAXFWIDTH 0))
[SETQ ILIST (for DFQ in MAP join (for FNP in (fetch FnsList of DFQ)
collect [SETQ MAXFWIDTH
(IMAX MAXFWIDTH
(NCHARS (fetch FnName
of FNP]
(CONS (fetch FnName of FNP)
(add INUM 1]
(SORT ILIST (FUNCTION FILEINDEXALPHORDER))
[COND
((NOT ILIST)
(INDEXNEWLINE)
(printout NIL .FONT BOLDFONT "No Functions." .FONT DEFAULTFONT)
(INDEXNEWPAGE))
(T (PROG ((WIDTH (IPLUS MAXFWIDTH (NCHARS INUM)
1))
NCOLUMNS NROWS LEFT SPACING LASTFN)
(SETQ NCOLUMNS (IQUOTIENT FILELINELENGTH (IPLUS WIDTH 2)))
(SETQ LEFT (IDIFFERENCE FILELINELENGTH (ITIMES (IPLUS WIDTH 2)
NCOLUMNS)))
(SETQ WIDTH (IPLUS WIDTH (IQUOTIENT (IQUOTIENT LEFT 2)
NCOLUMNS)))
(SETQ SPACING (IPLUS (IQUOTIENT (IQUOTIENT LEFT 2)
(SUB1 NCOLUMNS))
2))
(while ILIST
do (SETQ NROWS (IDIFFERENCE LINESPERPAGE LINECOUNT))
(for ROW from 1 to NROWS
do [for COLUMN from 1 to NCOLUMNS
do (COND
([SETQ LASTFN (FNTH ILIST
(IPLUS ROW (ITIMES NROWS
(SUB1 COLUMN]
(PRIN1 (CAAR LASTFN))
[PRINTDOTS (IDIFFERENCE
(IDIFFERENCE WIDTH
(NCHARS (CAAR LASTFN)))
(NCHARS (CDAR LASTFN]
(PRIN1 (CDAR LASTFN))
(COND
((NEQ COLUMN NCOLUMNS)
(SPACES SPACING]
(INDEXNEWLINE))
(INDEXNEWPAGE)
(SETQ ILIST (CDR LASTFN]
(PROG ((POS 0)
(INUM 0))
[for DFQ in MAP do (for FNP in (fetch FnsList of DFQ)
do (INDEXCOPYBYTES FULL OUTF POS (SETQ POS
(fetch (FnPointer BeginPoint)
of FNP)))
(COND
(NEWPAGEFLG (INDEXNEWPAGE))
(T (INDEXNEWLINE)))
(SETQ INUM (ADD1 INUM))
(COND
((NOT (ILEQ (IPLUS LINECOUNT 3)
LINESPERPAGE))
(INDEXNEWPAGE)))
(printout NIL .SP (IDIFFERENCE FILELINELENGTH
(IPLUS 2
(NCHARS INUM)))
.FONT BOLDFONT "[" INUM "]" .FONT
DEFAULTFONT .RESET)
(PROG ((CURFN (CAR FNP)))
(INDEXCOPYBYTES FULL OUTF POS
(SETQ POS (fetch (FnPointer
EndPoint)
of FNP]
(INDEXCOPYBYTES FULL OUTF POS (GETEOFPTR FULL]
(RETURN FULL])
(MERGEDFILEINDEX
[LAMBDA (FILES) (* dgb: " 3-NOV-82 00:21")
(* Makes an index to a set of files which have been printed by SINGLEFILEINDEX. The indexis a table of contents
which lists all the functions in alphabetical order, and a fileName -
sequence number pair for where that function is in the file.)
(DECLARE (GLOBALVARS FILERDTBL))
(RESETLST (PROG (MAP ILIST FULL CURFN FULLNAMES (LINECOUNT 0)
(PAGECOUNT 0)
(INUM 0)
(MAXFWIDTH 0)
(LINESPERPAGE LINESPERPAGE))
(for INF in FILES
do (SETQ FULL (INPUT (INFILE INF)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
FULL))
(OR [SETQ MAP (CDR (OR (GETFILEMAP FULL INF)
(AND (EQ (RATOM FULL FILERDTBL)
(QUOTE %())
(EQ (RATOM FULL FILERDTBL)
(QUOTE FILECREATED))
(LOADFILEMAP FULL]
(PROGN (printout T "Could not get file map for " FULL T)
(GO NOFILE)))
(SETQ FULLNAMES (NCONC1 FULLNAMES FULL))
(SETQ INUM 0)
[for DFQ in MAP join (for FNP FNFILE in (fetch FnsList of DFQ)
do (SETQ ILIST
(CONS (LIST (SETQ FNFILE
(fetch FnName of FNP))
INF
(add INUM 1))
ILIST))
(SETQ MAXFWIDTH (IMAX MAXFWIDTH
(IPLUS (NCHARS INF)
(NCHARS FNFILE]
NOFILE)
(SORT ILIST (FUNCTION FILEINDEXALPHORDER))
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(OUTPUT)))
(OUTFILE PRINTER)
(RESETSAVE (LINELENGTH 1000))
(RESETSAVE (RADIX 10))
(PROGN (CENTERPRINT (SETQ FULL (CONCAT "Merged Index of Files: " FILES))
T)
(CENTERPRINT (CONCAT "-- Listed on " (DATE)
" --"))
(INDEXNEWLINE))
[COND
((NOT ILIST)
(INDEXNEWLINE)
(printout NIL .FONT BOLDFONT "No Functions." .FONT DEFAULTFONT)
(INDEXNEWPAGE))
(T (PROG (fn file index (WIDTH (IPLUS MAXFWIDTH 6))
NCOLUMNS NROWS LEFT SPACING LASTFN)
(SETQ NCOLUMNS (IQUOTIENT FILELINELENGTH (IPLUS WIDTH 2)))
(SETQ LEFT (IDIFFERENCE FILELINELENGTH (ITIMES (IPLUS WIDTH 2)
NCOLUMNS)))
(SETQ WIDTH (IPLUS WIDTH (IQUOTIENT (IQUOTIENT LEFT 2)
NCOLUMNS)))
(SETQ SPACING (IPLUS (IQUOTIENT (IQUOTIENT LEFT 2)
(SUB1 NCOLUMNS))
2))
(while ILIST
do (SETQ NROWS (IDIFFERENCE LINESPERPAGE LINECOUNT))
(for ROW from 1 to NROWS
do [for COLUMN from 1 to NCOLUMNS
do (COND
([SETQ LASTFN (FNTH ILIST
(IPLUS ROW
(ITIMES NROWS
(SUB1 COLUMN]
(SETQ fn (CAAR LASTFN))
(SETQ file (CADAR LASTFN))
(SETQ index (CADDAR LASTFN))
(PRIN1 fn)
[PRINTDOTS (IDIFFERENCE WIDTH
(IPLUS 4 (NCHARS fn)
(NCHARS file]
(PRIN1 file)
(PRINTDOTS (IDIFFERENCE 4 (NCHARS index)))
(PRIN1 index)
(COND
((NEQ COLUMN NCOLUMNS)
(SPACES SPACING]
(INDEXNEWLINE))
(INDEXNEWPAGE)
(SETQ ILIST (CDR LASTFN]
(CENTERPRINT "Files Indexed" T)
(for FN in FULLNAMES
do (INDEXNEWLINE)
(CENTERPRINT (CONCAT FN " " (GETFILEINFO FN (QUOTE WRITEDATE)))
T)
(CLOSEF FN))
(CLOSEF PRINTER)
(RETURN FILES])
(INDEXNEWLINE
[LAMBDA NIL (* rmk: " 8-NOV-83 12:18")
(TERPRI)
(COND
((IGREATERP (add LINECOUNT 1)
LINESPERPAGE)
(INDEXNEWPAGE])
(INDEXNEWPAGE
[LAMBDA NIL (* rmk: " 8-NOV-83 12:17")
(PRIN3 (FCHARACTER (CHARCODE FF)))
(POSITION NIL 0)
(SETQ LINECOUNT 0)
(add PAGECOUNT 1)
(LISTINGHEADER])
(PRINTDOTS
[LAMBDA (N) (* lmm "16-DEC-78 19:09")
(FRPTQ (IQUOTIENT N 8)
(PRIN1 "........"))
(FRPTQ (IREMAINDER N 8)
(PRIN1 "."])
(LISTINGHEADER
[LAMBDA NIL (* rrb " 9-JUL-81 12:04")
(PRIN1 FULL)
(COND
(CURFN (printout NIL " (" .P2 CURFN " [" INUM "] cont.)")))
(TAB (IDIFFERENCE FILELINELENGTH 9)
T)
(PRIN1 "Page ")
(PRINTNUM (QUOTE (FIX 4))
PAGECOUNT)
(INDEXNEWLINE)
(INDEXNEWLINE])
(CENTERPRINT
[LAMBDA (STR BOLDFLG) (* lmm " 8-JUN-80 18:10")
(TAB (IQUOTIENT (IDIFFERENCE FILELINELENGTH (NCHARS STR))
2))
(COND
(BOLDFLG (printout NIL .FONT BOLDFONT STR .FONT DEFAULTFONT))
(T (PRIN1 STR)))
(INDEXNEWLINE])
(FILEINDEXALPHORDER
[LAMBDA (A B) (* lmm "24-NOV-81 22:04")
(* does case independent sort on the CAR of two
elements.)
(SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(ASSEMBLE NIL
(CQ (CAR A))
(HLRZ 1 , 2 (1))
(FASTCALL UPATM)
(PUSHNN (3)
(4))
(CQ (CAR B))
(HLRZ 1 , 2 (1))
(FASTCALL UPATM)
(NREF (MOVE 5 , -1))
(NREF (MOVE 6 , 0))
(POPNN 2)
(* At last the basic alphabetizer. Ac6 has NCHARS A; ac5 has byte pointer to A; ac4 has NCHARS
(CAR B) (from this call to UPATM), ac3 has byte pointer to B.)
LP (SOJL 6 , SUCCEED) (* (CAR A) won because shorter)
(SOJL 4 , FAIL) (* (CAR B) won because shorter.)
(ILDB 1 , 5)
(CAIL 1 , (CHCON1 (QUOTE a)))
(CAILE 1 , (CHCON1 (QUOTE z)))
(SKIPA)
(SUBI 1 , 40Q)
(ILDB 2 , 3)
(CAIL 2 , (CHCON1 (QUOTE a)))
(CAILE 2 , (CHCON1 (QUOTE z)))
(SKIPA)
(SUBI 2 , 40Q)
(CAMN 1 , 2)
(JRST LP) (* Chars the same, try again.)
(CAML 1 , 2) (* (CAR A) and (CAR B) have different spellings.
Compare magnitude of character byte and exit with
result.)
FAIL(SKIPA 1 , KNIL)
SUCCEED
(HRRZ 1 , KT)))
(ALPHORDER (U-CASE (CAR A))
(U-CASE (CAR B])
)
(DEFINEQ
(INDEXCOPYBYTES
[LAMBDA (IN OUT START END) (* rmk: " 8-NOV-83 15:32")
(* This is similar to COPYBYTES except that, INDEXNEWLINE is called whenever an EOL is read, and IndexNewPage is
called whenever a form feed is read)
(SETFILEPTR IN START)
(SELECTQ (SYSTEMTYPE)
[(TENEX TOPS20)
(PROG ((IJFN (VAG (OPNJFN IN)))
(OJFN (VAG (OPNJFN OUT)))
NLFLG CH) (* This doesn't really handle EOL conventions properly)
(FRPTQ (IDIFFERENCE END START)
(SELCHARQ (SETQ CH (JS BIN (LOC IJFN)
NIL NIL 2))
(CR (* leave NLFLG)
(JS BOUT (LOC OJFN)
(CHARCODE CR)
NIL 2))
[LF (JS BOUT (LOC OJFN)
(CHARCODE LF)
NIL 2)
(COND
((AND NLFLG (IGREATERP LINECOUNT (IDIFFERENCE
LINESPERPAGE 5)))
(* double cr near end of page)
(INDEXNEWPAGE))
(T (COND
((IGREATERP (add LINECOUNT 1)
LINESPERPAGE)
(INDEXNEWPAGE)))
(SETQ NLFLG T]
(FF (INDEXNEWPAGE)
(SETQ NLFLG NIL))
(PROGN (JS BOUT (LOC OJFN)
CH NIL 2)
(SETQ NLFLG NIL]
[(D VAX)
(PROG ((INSTRM (\GETSTREAM IN))
(OUTSTRM (\GETSTREAM OUT))
EOLC NLFLG LOOKFORLF CH)
(SETQ EOLC (fetch EOLCONVENTION of INSTRM))
(FRPTQ (IDIFFERENCE END START)
(SELCHARQ (SETQ CH (\BIN INSTRM))
[CR (SELECTC EOLC
[CR.EOLC (SETQ LOOKFORLF NIL)
(COND
((AND NLFLG (IGREATERP LINECOUNT
(IDIFFERENCE
LINESPERPAGE 5)
))
(* double cr near end of page)
(INDEXNEWPAGE)
(SETQ NLFLG NIL))
(T (INDEXNEWLINE)
(SETQ NLFLG T]
(CRLF.EOLC
(* Flag says that EOLC is CRLF and we are looking for next char to be LF. Expanded out this way so that we can
keep track of the character counts accurately)
(SETQ LOOKFORLF T))
(PROGN (SETQ LOOKFORLF NIL)
(* Next is copy of \OUTCHAR macro, which isn't exported
from APRINT)
(STREAMOP (QUOTE OUTCHARFN)
OUTSTRM OUTSTRM (CHARCODE CR]
(LF [COND
[(OR LOOKFORLF (EQ EOLC LF.EOLC))
(COND
((AND NLFLG (IGREATERP LINECOUNT (IDIFFERENCE
LINESPERPAGE 5)))
(* double cr near end of page)
(INDEXNEWPAGE)
(SETQ NLFLG NIL))
(T (INDEXNEWLINE)
(SETQ NLFLG T]
(T (STREAMOP (QUOTE OUTCHARFN)
OUTSTRM OUTSTRM (CHARCODE LF))
(* If LF comes thru, it is just a vertical tab.
Want to keep horizontal position the same, but update
line-counts)
(COND
((AND NLFLG (IGREATERP LINECOUNT (IDIFFERENCE
LINESPERPAGE 5)))
(* double cr near end of page)
(INDEXNEWPAGE)
(SETQ NLFLG NIL))
(T (COND
((IGREATERP (add LINECOUNT 1)
LINESPERPAGE)
(INDEXNEWPAGE)))
(SETQ NLFLG T]
(SETQ LOOKFORLF NIL))
(FF (INDEXNEWPAGE)
(SETQ NLFLG NIL)
(SETQ LOOKFORLF NIL))
(PROGN (\BOUT OUTSTRM CH)
(SETQ NLFLG NIL)
(SETQ LOOKFORLF NIL]
(HELP))
T])
)
(DEFINEQ
(SFILISTFILES1
[LAMBDA (FILE) (* rmk: "14-JUN-82 23:58")
(PROG ((INF (INFILEP FILE)))
(RETURN (COND
((SINGLEFILEINDEX INF)
(printout T "indexed version of " INF " => " PRINTER T)
(SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD INF T)
NOTLISTEDFILES))
"")
(T (OLDLISTFILES1 FILE])
)
(RPAQ PRINTER (SELECTQ (SYSTEMTYPE)
(D (QUOTE {LPT}))
(QUOTE LPT:)))
(DECLARE: DOCOPY DONTEVAL@LOAD
(MOVD? (QUOTE LISTFILES1)
(QUOTE OLDLISTFILES1))
(/MOVD (QUOTE SFILISTFILES1)
(QUOTE LISTFILES1))
[COND ([NOT (FIXP (GETTOPVAL (QUOTE LINESPERPAGE]
(SAVESETQ LINESPERPAGE (SELECTQ (SYSTEMTYPE)
(D 65)
58]
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD DefineqList (BeginPoint EndPoint . FnsList))
(RECORD FileMap (NIL . Maps))
(RECORD FnPointer (FnName BeginPoint . EndPoint))
]
(SELECTQ (COMPILEMODE)
(PDP-10 (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
CJSYS))
NIL)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: SINGLEFILEINDEXBLOCK SINGLEFILEINDEX MERGEDFILEINDEX INDEXNEWLINE INDEXNEWPAGE PRINTDOTS
LISTINGHEADER CENTERPRINT INDEXCOPYBYTES (ENTRIES SINGLEFILEINDEX MERGEDFILEINDEX)
(LOCALFREEVARS LINECOUNT PAGECOUNT CURFN INUM FULL)
(GLOBALVARS FILELINELENGTH PRINTER FONTCHANGEFLG DEFAULTFONT PRETTYCOMFONT))
]
(PUTPROPS SINGLEFILEINDEX COPYRIGHT (NONE))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1565 13090 (SINGLEFILEINDEX 1575 . 6468) (MERGEDFILEINDEX 6470 . 10068) (INDEXNEWLINE
10070 . 10281) (INDEXNEWPAGE 10283 . 10526) (PRINTDOTS 10528 . 10729) (LISTINGHEADER 10731 . 11098) (
CENTERPRINT 11100 . 11408) (FILEINDEXALPHORDER 11410 . 13088)) (13091 16930 (INDEXCOPYBYTES 13101 .
16928)) (16931 17335 (SFILISTFILES1 16941 . 17333)))))
STOP