Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "15-JUN-82 00:07:20" <LISPUSERS>SINGLEFILEINDEX.;5 13036
changes to: (VARS SINGLEFILEINDEXCOMS)
previous date: "15-JUN-82 00:00:25" <LISPUSERS>SINGLEFILEINDEX.;4)
(PRETTYCOMPRINT SINGLEFILEINDEXCOMS)
(RPAQQ SINGLEFILEINDEXCOMS [(FNS SINGLEFILEINDEX 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]
(SETQ 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 (SINGLEFILEINDEX SINGLEFILEINDEX INDEXNEWLINE INDEXNEWPAGE
PRINTDOTS LISTINGHEADER CENTERPRINT
INDEXCOPYBYTES (LOCALFREEVARS LINECOUNT
PAGECOUNT CURFN
INUM FULL)
(GLOBALVARS FILELINELENGTH PRINTER FONTCHANGEFLG
DEFAULTFONT PRETTYCOMFONT])
(DEFINEQ
(SINGLEFILEINDEX
[LAMBDA (INF OUTF NEWPAGEFLG) (* rmk: "26-FEB-82 11:25")
(* 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 (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)
(RETURN)))
(OUTFILE (OR OUTF PRINTER))
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(OUTPUT)))
(SELECTQ (SYSTEMTYPE)
[TENEX (COND
((STRPOS "PARC-MAXC" (HOSTNAME))
(PROG [(J (VAG (OPNJFN (OUTPUT]
(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))
(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 (OUTPUT)
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 (OUTPUT)
POS
(SETQ POS (fetch (FnPointer
EndPoint)
of FNP]
(INDEXCOPYBYTES FULL (OUTPUT)
POS
(GETEOFPTR FULL]
(RETURN FULL])
(INDEXNEWLINE
[LAMBDA (NOPRINTFLG) (* lmm " 8-JUN-80 18:10")
(COND
((NOT NOPRINTFLG)
(TERPRI)))
(COND
((IGREATERP (SETQ LINECOUNT (ADD1 LINECOUNT))
LINESPERPAGE)
(INDEXNEWPAGE])
(INDEXNEWPAGE
[LAMBDA (DONTPRINTFLG) (* lmm " 6-FEB-80 10:06")
(OR DONTPRINTFLG (PRIN1 (FCHARACTER 12)))
(POSITION NIL 0)
(SETQ LINECOUNT 0)
(SETQ PAGECOUNT (ADD1 PAGECOUNT))
(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: "26-FEB-82 23:32")
(* This is similar to COPYBYTES except that, whenever a line feed is read (12q) INDEXNEWLINE is called after the
byte is output and IndexNewPage is called similarly whenever a form feed (octal 14q) is read and printed)
(SETFILEPTR IN START)
(SELECTQ (SYSTEMTYPE)
[(TENEX TOPS20)
(PROG ((IJFN (VAG (OPNJFN IN)))
(OJFN (VAG (OPNJFN OUT)))
NLFLG)
(FRPTQ (IDIFFERENCE END START)
(SELCHARQ (JS BOUT (LOC OJFN)
(JS BIN (LOC IJFN)
NIL NIL 2)
NIL 2)
(CR (* leave NLFLG)
NIL)
[LF (COND
((AND NLFLG (IGREATERP LINECOUNT (IDIFFERENCE
LINESPERPAGE 5)))
(* double cr near end of page)
(INDEXNEWPAGE))
(T (INDEXNEWLINE T)
(SETQ NLFLG T]
(FF (INDEXNEWPAGE T)
(SETQ NLFLG NIL))
(SETQ NLFLG NIL]
[D (PROG ((INOFD (\GETOFD IN))
(OUTOFD (\GETOFD OUT))
NLFLG CH)
(FRPTQ (IDIFFERENCE END START)
(PROGN (\BOUT OUTOFD (SETQ CH (\BIN INOFD)))
(* Avoid assuming that char is the value of \BOUT)
(SELCHARQ CH
[(CR LF) (* CR should be EOL but CHARCODE doesn't work in machine
dependent mode when compiling in ABC.)
(COND
((AND NLFLG (IGREATERP LINECOUNT (IDIFFERENCE
LINESPERPAGE 5)))
(* double cr near end of page)
(INDEXNEWPAGE)
(SETQ NLFLG NIL))
(T (INDEXNEWLINE T)
(SETQ NLFLG T]
(FF (INDEXNEWPAGE T)
(SETQ NLFLG NIL))
(SETQ NLFLG 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]
(SETQ 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: SINGLEFILEINDEX SINGLEFILEINDEX INDEXNEWLINE INDEXNEWPAGE PRINTDOTS LISTINGHEADER CENTERPRINT
INDEXCOPYBYTES (LOCALFREEVARS LINECOUNT PAGECOUNT CURFN INUM FULL)
(GLOBALVARS FILELINELENGTH PRINTER FONTCHANGEFLG DEFAULTFONT PRETTYCOMFONT))
]
(DECLARE: DONTCOPY (PUTPROPS SINGLEFILEINDEX COPYRIGHT (NONE)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1444 9472 (SINGLEFILEINDEX 1456 . 6403) (INDEXNEWLINE 6407 . 6644) (INDEXNEWPAGE 6648 .
6889) (PRINTDOTS 6893 . 7100) (LISTINGHEADER 7104 . 7481) (CENTERPRINT 7485 . 7774) (
FILEINDEXALPHORDER 7778 . 9469)) (9474 11518 (INDEXCOPYBYTES 9486 . 11515)) (11520 11935 (
SFILISTFILES1 11532 . 11932)))))
STOP