Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "23-SEP-81 21:10:19" <LISPUSERS>CJSYS.;60 14582
changes to: CJSYSCOMS CONSTANTP BITS
previous date: "23-SEP-81 21:05:24" <LISPUSERS>CJSYS.;58)
(PRETTYCOMPRINT CJSYSCOMS)
(RPAQQ CJSYSCOMS [(FNS JS XWD JSYSERROR BIT BITS)
(FNS CJSYS CJS1 JSC SAVEACS RESTOREACS CJSCONST PPOCTAL CONSTANTP)
(ALISTS (JSYSES ASND ATPTY BIN BKJFN BOUT CFOBF CHFDB CLOSF CNDIR CVSKT DELDF DELF DELNF
DIRST DOBE DTACH DTI FFFFP FFORK FFUFP FLIN FLOUT GDSKC GDSTS GET GETAB GEVEC
GFRKH GJINF GNJFN GPJFN GTAD GTDAL GTFDB GTJFN GTSTS HALTF HFORK IDTIM IDTNC
KFORK LGOUT MTOPR NIN NOUT ODCNV ODTIM OPENF PBIN PBOUT PMAP PUPI PUPO RELD
RFACS RFBSZ RFCOC RFMOD RFORK RFPOS RFPTR RFSTS RIN RLJFN SDSTS SFACS SFBSZ
SFCOC SFMOD SFORK SFPTR SIN SIZEF SOUT SPJFN STPAR SYSGT TLINK WFORK RTIW RCM
EPCAP RIR DEBRK AIC STIW DIC RPACS RMAP GETJI)
(PRETTYPRINTMACROS JSYS XWD JS))
(ADDVARS (JSYSERRORCODES))
(PROP VARTYPE JSYSES)
(DECLARE: EVAL@COMPILE (IFPROP (BYTEMACRO MACRO ARGNAMES AMAC)
JS BIT BITS JSYSERROR)
(PROP AMAC CV CV2 NREF)
(ADDVARS (SIMPLEFNS EQ PROGN PROG1 AND OR BIT BITS)))
(FNS FINDJSYS FINDJSYSERROR SCANSYSTEMDEFS)
(ADDVARS (JSYSOURCES <SUBSYS>STENEX.MAC <SUBSYS>MONSYM.MAC <SUBSYS>MONSYMS.MAC))
(LOCALVARS . T)
(BLOCKS (CJSYS CJSYS JSC CJS1 SAVEACS RESTOREACS (LOCALFREEVARS CODELST)
CJSCONST
(NOLINKFNS . T)))
(TEMPLATES JS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML JSYSERROR JS)
(LAMA BIT])
(DEFINEQ
(JS
[NLAMBDA (JSYSNAME AC1 AC2 AC3 RESULT)
(* lmm "10-MAY-78 18:05")
(PROG ((A1 (COND
(AC1 (EVAL AC1 (QUOTE INTERNAL)))
(T -800572073)))
(A2 (COND
(AC2 (EVAL AC2 (QUOTE INTERNAL)))
(T 560383548)))
(A3 (COND
(AC3 (EVAL AC3 (QUOTE INTERNAL)))
(T 932972753)))
(OP (FINDJSYS JSYSNAME)))
(RETURN (COND
((EQ RESULT T)
(IGREATERP (ASSEMBLE NIL
(CV (CADR OP))
(PUSHN)
(CV A3)
(PUSHN)
(CV A2)
(PUSHN)
(CV A1)
(POPN 2)
(POPN 3)
(MOVEI 7 , 4)
(POPN 5)
(JSYS 0 (5))
(SUBI 7 , 1)
(SUBI 7 , 1)
(SUBI 7 , 1)
(MOVEI 1 , ASZ (7)))
(OR (CADDR OP)
0)))
(T (ASSEMBLE NIL
(CV (OR RESULT 0))
(PUSHN)
(CV (CADR OP))
(PUSHN)
(CV A3)
(PUSHN)
(CV A2)
(PUSHN)
(CV A1)
(POPN 2)
(POPN 3)
(POPN 4)
(JSYS 0 (4))
(JFCL)
(JFCL)
(NREF (MOVE 1 , @ 0))
(VAR (HRRZ 2 , RESULT))
(CAMN 2 , ' NIL)
(SKIPA 1 , '"garbage result from JS")
(FASTCALL MKN)
(POPNN 1])
(XWD
[LAMBDA (N1 N2)
(LOGOR (LLSH N1 18)
(LOGAND 262143 N2])
(JSYSERROR
[NLAMBDA (ERRORNAME)
(FINDJSYSERROR ERRORNAME])
(BIT
[LAMBDA N (* lmm " 2-JUN-78 16:19")
(COND
((EQ N 1)
(LRSH -34359738368 (ARG N 1)))
(T (NOT (ZEROP (LOGAND (ARG N 2)
(BIT (ARG N 1])
(BITS
[LAMBDA (BIT1 BITN ARG) (* lmm " 1-JUN-78 17:18")
(LOGAND [SUB1 (LLSH 1 (ADD1 (IDIFFERENCE BITN BIT1]
(LLSH ARG (IDIFFERENCE BITN 35])
)
(DEFINEQ
(CJSYS
[LAMBDA (X) (* lmm "21-APR-78 03:09")
(PROG (CODELST R OP SAVE)
(JSC (QUOTE ASSEMBLE))
(JSC NIL)
[COND
((CADR X)
(CJS1 1 (CADR X))
(SETQ SAVE (LIST 1]
[COND
((CADDR X)
(CJS1 2 (CADDR X)
SAVE)
(SETQ SAVE (NCONC1 SAVE 2]
(COND
((CADDDR X)
(CJS1 3 (CADDDR X)
SAVE)))
[JSC (LIST (QUOTE JSYS)
(CADR (SETQ OP (FINDJSYS (CAR X]
(SETQ R (CAR (CDDDDR X)))
[COND
((CADDR OP)
[RPTQ (SUB1 (CADDR OP))
(JSC (QUOTE (JFCL]
(JSC (COND
((EQ R T)
(QUOTE (SKIPA 1 , KNIL)))
(T (QUOTE (JFCL]
[COND
[(EQ R T)
(JSC (QUOTE (MOVE 1 , KT]
((EQ R 1))
(R (JSC (LIST (QUOTE MOVE)
1
(QUOTE ,)
R]
(SETQ CODELST (DREVERSE CODELST))
(RETURN (COND
((AND R (NEQ R T))
(LIST (QUOTE LOC)
CODELST))
(T CODELST])
(CJS1
[LAMBDA (AC VAL SAVEACS) (* lmm "27-APR-78 01:49")
(PROG (TEM)
(OR VAL (RETURN))
[COND
((SETQ TEM (CJSCONST VAL))
(RETURN (JSC (LIST (QUOTE LDN2)
TEM AC]
(SELECTQ (CAR (LISTP VAL))
[LOC (AND (LITATOM (CADR VAL))
(RETURN (JSC (LIST (QUOTE VAR)
(LIST (QUOTE HRRZ)
AC
(QUOTE ,)
(CADR VAL]
(XWD [RETURN (COND ((SETQ TEM (CJSCONST (CADR VAL)))
(CJS1 AC (CADDR VAL)
SAVEACS)
(JSC (LIST (QUOTE HRLI)
AC
(QUOTE ,)
TEM)))
[(NULL SAVEACS)
(CJS1 AC (CADDR VAL))
(CJS1 (ADD1 AC)
(CADR VAL)
(LIST AC))
(JSC (LIST (QUOTE HRLI)
AC
(QUOTE ,)
0
(LIST (ADD1 AC]
[(SETQ TEM (CJSCONST (CADDR VAL)))
(CJS1 AC (CADR VAL)
SAVEACS)
(JSC (LIST (QUOTE HRL)
AC
(QUOTE ,)
AC))
(JSC (LIST (QUOTE HRRI)
AC
(QUOTE ,)
(LOGAND TEM 777777Q]
(T (RESTOREACS (PROG1 (CONS (LIST (QUOTE POPN)
AC)
(SAVEACS SAVEACS))
(CJS1 1 (CADDR VAL))
(JSC (QUOTE (PUSHN 1)))
(CJS1 1 (CADR VAL))
(JSC (QUOTE (NREF (HRLM 1 , 0])
NIL)
(RETURN (COND
[(NULL SAVEACS)
(JSC (LIST (QUOTE CV)
VAL))
(OR (EQ AC 1)
(JSC (LIST (QUOTE MOVE)
AC
(QUOTE ,)
1]
(T (RESTOREACS (PROG1 (SAVEACS SAVEACS)
(CJS1 AC VAL])
(JSC
[LAMBDA (X) (* lmm "11-OCT-78 18:56")
(PROG (TEM)
(SELECTQ (CAR X)
(PUSHN (OR (CDDR X)
(SELECTQ (CAAR CODELST)
(POPN (SETQ TEM (CADAR CODELST))
(SETQ CODELST (CDR CODELST))
[COND
((EQ (CADR X)
TEM)
(* (POPN X) (PUSHN X) => NIL)
NIL)
(T
(* (POPN X) (PUSHN Y) -> (NREF (MOVEM Y , 0)))
(JSC (LIST (QUOTE NREF)
(LIST (QUOTE MOVEM)
(CADR X)
(QUOTE ,)
0]
(RETURN))
[MOVE (COND
((AND (EQ (CADAR CODELST)
(CADR X))
(EQ (CADDR (CAR CODELST))
(QUOTE ,)))
(RETURN (JSC (PROG1 (CONS (QUOTE PUSHN)
(CDDDR (CAR CODELST)))
(SETQ CODELST (CDR CODELST]
NIL)))
NIL)
(SETQ CODELST (CONS X CODELST])
(SAVEACS
[LAMBDA (ACS) (* lmm "27-APR-78 01:52")
(PROG (INSTRS AC)
LP [COND
((NULL ACS)
(RETURN INSTRS))
((SELECTQ (CAAR CODELST)
((HRRZ MOVEI)
(FMEMB (SETQ AC (CADAR CODELST))
ACS))
(LDN2 (FMEMB (SETQ AC (CADDR (CAR CODELST)))
ACS))
NIL)
(SETQ INSTRS (CONS (CAR CODELST)
INSTRS))
(SETQ ACS (REMOVE AC ACS))
(SETQ CODELST (CDR CODELST)))
(T (JSC (LIST (QUOTE PUSHN)
(CAR ACS)))
(SETQ INSTRS (CONS (LIST (QUOTE POPN)
(CAR ACS))
INSTRS))
(SETQ ACS (CDR ACS]
(GO LP])
(RESTOREACS
[LAMBDA (X) (* lmm "21-APR-78 02:08")
(MAPC X (FUNCTION JSC])
(CJSCONST
[LAMBDA (X) (* lmm "21-APR-78 02:41")
(OR (FIXP X)
(AND (LISTP X)
(SELECTQ (CAR X)
(CONSTANT (EVAL (CADR X)))
(XWD [PROG [(TM (CJSCONST (CADR X]
(COND ([AND TM (SETQ X (CJSCONST (CADDR X]
(RETURN (XWD TM X)])
NIL])
(PPOCTAL
[LAMBDA (X) (* lmm "27-DEC-78 13:43")
(PROGN (PRIN1 (QUOTE %())
(RESETFORM (RADIX 8)
(PRINTDEF X NIL NIL T))
(PRIN1 (QUOTE %))))
NIL])
(CONSTANTP
[LAMBDA (A) (* lmm "23-SEP-81 21:03")
(OR (NULL A)
(EQ A T)
(NUMBERP A)
(FMEMB (CAR (LISTP A))
(QUOTE (CONSTANT QUOTE CHARCODE)))
(FMEMB A COMPILE.TIME.CONSTANTS])
)
(ADDTOVAR JSYSES (ASND 56 1)
(ATPTY 188 1)
(BIN 40)
(BKJFN 34 1)
(BOUT 41)
(CFOBF 65)
(CHFDB 52)
(CLOSF 18 1)
(CNDIR 36 1)
(CVSKT 189 1)
(DELDF 55)
(DELF 22 1)
(DELNF 207 1)
(DIRST 33 1)
(DOBE 68)
(DTACH 77)
(DTI 96)
(FFFFP 25)
(FFORK 108)
(FFUFP 137 1)
(FLIN 154 1)
(FLOUT 155 1)
(GDSKC 140)
(GDSTS 101)
(GET 128)
(GETAB 8 1)
(GEVEC 133)
(GFRKH 116 1)
(GJINF 11)
(GNJFN 15 1)
(GPJFN 134)
(GTAD 151)
(GTDAL 197)
(GTFDB 51)
(GTJFN 16 1)
(GTSTS 20)
(HALTF 120)
(HFORK 114)
(IDTIM 145 1)
(IDTNC 153 1)
(KFORK 107)
(LGOUT 3)
(MTOPR 63)
(NIN 149 1)
(NOUT 148 1)
(ODCNV 146)
(ODTIM 144)
(OPENF 17 1)
(PBIN 59)
(PBOUT 60)
(PMAP 46)
(PUPI 289 1)
(PUPO 290 1)
(RELD 57 1)
(RFACS 113)
(RFBSZ 37 1)
(RFCOC 74)
(RFMOD 71)
(RFORK 109)
(RFPOS 73)
(RFPTR 35 1)
(RFSTS 110)
(RIN 44)
(RLJFN 19 1)
(SDSTS 102)
(SFACS 112)
(SFBSZ 38 1)
(SFCOC 75)
(SFMOD 72)
(SFORK 111)
(SFPTR 23 1)
(SIN 42)
(SIZEF 30 1)
(SOUT 43)
(SPJFN 135)
(STPAR 143)
(SYSGT 14)
(TLINK 142 1)
(WFORK 115)
(RTIW 123)
(RCM 92)
(EPCAP 105)
(RIR 100)
(DEBRK 94)
(AIC 89)
(STIW 124)
(DIC 91)
(RPACS 47)
(RMAP 49)
(GETJI 327 3))
(ADDTOVAR PRETTYPRINTMACROS (JSYS . PPOCTAL)
(XWD . PPOCTAL)
(JS . PPOCTAL))
(ADDTOVAR JSYSERRORCODES )
(PUTPROPS JSYSES VARTYPE ALIST)
(DECLARE: EVAL@COMPILE
(PUTPROPS JS BYTEMACRO PUNT)
(PUTPROPS JS MACRO (X (CJSYS X (FUNCTION ASSEMBLE))))
(PUTPROPS BIT MACRO [X (PROG [(MASK (LIST (QUOTE LRSH)
-34359738368
(CAR X]
(RETURN (COND
((CADR X)
(LIST (QUOTE NEQ)
(LIST (QUOTE LOGAND)
(CADR X)
MASK)
0))
(T MASK])
(PUTPROPS BITS MACRO [X (PROG [(BIT1 (CAR X))
(BITN (CADR X))
(WORD (CADDR X))
[MASK (QUOTE (SUB1 (LLSH 1 (ADD1 (IDIFFERENCE BITN BIT1]
(SHIFT (QUOTE (IDIFFERENCE BITN 35]
[COND
((CONSTANTP BITN)
(SETQ SHIFT (EVAL SHIFT))
(COND
((CONSTANTP BIT1)
(SETQ MASK (EVAL MASK]
(RETURN (SUBPAIR (QUOTE (BIT1 BITN))
(LIST BIT1 BITN)
(LIST (QUOTE LOGAND)
MASK
(COND
((ZEROP SHIFT)
WORD)
(T (LIST (QUOTE LLSH)
WORD SHIFT])
(PUTPROPS JSYSERROR MACRO (X (FINDJSYSERROR (CAR X))))
(PUTPROPS JS ARGNAMES (JSYSNAME AC1 AC2 AC3 RESULT))
(PUTPROPS BITS ARGNAMES (BIT1 BITN ARG))
(PUTPROPS JS AMAC [LAMBDA (JSYSNAME)
(LIST (LIST (QUOTE JSYS)
(CADR (FINDJSYS JSYSNAME])
(PUTPROPS CV AMAC [(X)
(CQ (VAG (FIX X])
(PUTPROPS CV2 AMAC [(X)
(E (CNEXP2 (QUOTE (VAG (FIX X])
(PUTPROPS NREF AMAC [NLAMBDA (I F)
[SETQ F (LAST (SETQ I (COPY I]
(RPLACA F (IDIFFERENCE
(OR [CAR (NTH NN (ADD1 (IMINUS (EVAL (CAR F]
(PROGN (COMPEM (QUOTE (BAD NREF)))
(CAR NN)))
(CAR NN)))
[RPLACD F (QUOTE ((CP]
(STORIN I)
NIL])
(ADDTOVAR SIMPLEFNS EQ PROGN PROG1 AND OR BIT BITS)
)
(DEFINEQ
(FINDJSYS
[LAMBDA (JSYSNAME) (* lmm "26-APR-78 00:14")
(COND
((FIXP JSYSNAME)
(LIST JSYSNAME JSYSNAME))
((FASSOC JSYSNAME JSYSES))
(T (CAR (SETQ JSYSES (CONS (LIST JSYSNAME [OR (SCANSYSTEMDEFS JSYSNAME)
(ERROR JSYSNAME (QUOTE (NOT JSYS NAME]
3)
JSYSES])
(FINDJSYSERROR
[LAMBDA (ERRORCODE) (* lmm "25-APR-78 23:24")
(IPLUS 196608 (CADR (OR (FASSOC ERRORCODE JSYSERRORCODES)
(CAR (SETQ JSYSERRORCODES (CONS (LIST ERRORCODE (OR (SCANSYSTEMDEFS
ERRORCODE T)
(ERROR ERRORCODE)))
JSYSERRORCODES])
(SCANSYSTEMDEFS
[LAMBDA (NAME FLG) (* edited: "28-FEB-79 15:17")
(RESETLST (PROG (SYMBOLFILE VALUE)
(COND
([NOT (SOME JSYSOURCES (FUNCTION (LAMBDA (X)
(SETQ SYMBOLFILE (FINDFILE X T]
(ERROR "cannot find any of the files" JSYSOURCES)))
[RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(SETQ SYMBOLFILE (INPUT (INFILE SYMBOLFILE]
(PRIN1 "Scanning " T)
(PRIN2 SYMBOLFILE T T)
(PRIN1 (COND
(FLG " for error ")
(T " for JSYS "))
T)
(PRIN2 NAME T T)
(COND
[(FFILEPOS (CONCAT (COND
(FLG "...QQQ (")
(T "
DEFJS "))
NAME ",")
SYMBOLFILE NIL NIL NIL T)
(SETQ VALUE 0)
(bind CH while (NUMBERP (SETQ CH (READC SYMBOLFILE)))
do (SETQ VALUE (IPLUS (ITIMES VALUE 8)
CH]
(T (PRIN1 "... not found" T)))
(TERPRI T)
(RETURN VALUE])
)
(ADDTOVAR JSYSOURCES <SUBSYS>STENEX.MAC <SUBSYS>MONSYM.MAC <SUBSYS>MONSYMS.MAC)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: CJSYS CJSYS JSC CJS1 SAVEACS RESTOREACS (LOCALFREEVARS CODELST)
CJSCONST
(NOLINKFNS . T))
]
(SETTEMPLATE (QUOTE JS)
(QUOTE (TYPE .. EVAL)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML JSYSERROR JS)
(ADDTOVAR LAMA BIT)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1601 3661 (JS 1613 . 3116) (XWD 3120 . 3197) (JSYSERROR 3201 . 3275) (BIT 3279 . 3483)
(BITS 3487 . 3658)) (3663 9004 (CJSYS 3675 . 4768) (CJS1 4772 . 6457) (JSC 6461 . 7465) (SAVEACS 7469
. 8134) (RESTOREACS 8138 . 8248) (CJSCONST 8252 . 8561) (PPOCTAL 8565 . 8769) (CONSTANTP 8773 . 9001))
(12439 14048 (FINDJSYS 12451 . 12790) (FINDJSYSERROR 12794 . 13107) (SCANSYSTEMDEFS 13111 . 14045))))
)
STOP