;;; CDMACS -*-LISP-*- ;;; ************************************************************** ;;; ***** MACLISP ** (Declarations and Macros for COMPLR) ******** ;;; ************************************************************** ;;; ** (C) Copyright 1981 Massachusetts Institute of Technology ** ;;; ****** This is a Read-Only file! (All writes reserved) ******* ;;; ************************************************************** (SETQ CDMACSVERNO '#.(let* ((file (caddr (truename infile))) (x (readlist (exploden file)))) (setq |verno| (cond ((fixp x) file) ('/40))))) (EVAL-WHEN (COMPILE) (AND (OR (NOT (GET 'COMPDECLARE 'MACRO)) (NOT (GET 'OUTFS 'MACRO))) (LOAD `(,(cond ((status feature ITS) '(DSK COMLAP)) ('(LISP))) CDMACS FASL))) ) (COMMENT MACROS WHICH DO DECLARATIONS FOR COMPLR ITSELF) (EVAL-WHEN (COMPILE) (MACROS 'T)) (DEFUN COMPDECLARE MACRO (L) (SPECIAL ACSMODE ARGLOC ARGNO ARITHP ARRAYOPEN ASSEMBLE ATPL ATPL1 BVARS CAAGL CARCDR CCLOAD:INITIAL-PROPS CDMACSVERNO CDUMP CFVFL CHOMPHOOK CL CLEANUPSPL CLOSED CLPROGN CMSGFILES CNT COBARRAY COMAL COMAUXVERNO COMP COMPILATION-FLAGCONVERSION-TABLE COMPILER-STATE COMPLRVERNO CONDP CONDPNOB CONDTYPE CONDUNSF CREADTABLE CTAG DATA DISOWNED EFFS EOC-EVAL EOF-COMPILE-QUEUE EOF-SEEN ERRFL EXIT EXITN EXLDL EXPAND-OUT-MACROS EXPR-HASH EXTEND-FILES-TO-LOAD FASL FASLPUSH FBARP FILEPOSIBLE FILESCLOSEP FIXSW FLOSW FLPDL FXPDL GAG-ERRBREAKS GENPREFIX GFYC GL GOBRKL GOFOO GONE2 HLAC HUNK2-TO-CONS IDENTITY IGNOREVARS IMOSAR INFILE INITIALIZE INITIAVERNO INMLS INSTACK IOBARRAY IREADTABLE KTYPE L-END-CNT LAP-INSIGNIF LAPLL LAPOF LDLST LERSTP+1 LINEL LINEMODEP LMBP LOCVARS LOUT LOUT1 LPASST-FXP LPASST-P+1 LPRSL MACROLIST MACROS MAKLAP-DEFAULTF-STYLE MAKLAPVERNO MAKUNBOUND MAPEX MAPSB MCX-TRACE MODELIST MSDEV MSDIR MUZZLED NEW-EXTEND-FILES-TO-LOAD NLNVS NLNVTHTBP NOLAP NULFU NUMACS OLVRL ONMLS OPSYS OPVRL OUTFILES P1CCX P1CSQ P1GFY P1LL P1LLCEK P1LSQ P1PCX P1PSQ P1SPECIALIZEDVS P2P PHAS1VERNO PKTYP PNOB PRATTSTACK PROGN PROGP PROGTYPE PROGUNSF PRSSL PVR PVRL QSM QUIT-ON-ERROR READ RECOMPL REGACS REGPDL RNL ROSENCEK RUNTIME-LIMIT RUNTIME-LIMITP SAIL-MORE-SYSFUNS SAVED-ERRLIST SFLG SLOTX SOBARRAY SPECIAL SPECIALS SPECVARS SPLDLST SPLITFILE-HOOK SQUID SREADTABLE STATE STSL SWITCHLIST SWITCHTABLE SYMBOLS TAKENAC1 TOPFN TTYNOTES TYO UNDFUNS UNFASLCOMMENTS UNSFLST UREAD USE-STRT7 USERATOMS-HOOKS USERATOMS-INTERN USERATOMS-INTERN-FROB USER-STRING-MARK-IN-FASL UWRITE VGO VGOL VL YESWARNTTY ) (*FEXPR *EXPR *FEXPR *LEXPR ARRAY* CGOL EREAD EVAL-WHEN FIXNUM FLONUM INITIALIZE MAKLAP NOTYPE SPECIAL UNSPECIAL ) (FIXNUM AC ARGNO BASE BESTCNT BESTLOC CNT HLAC IBASE I II LINEL M N NARGS NLARG NOACS P1CNT RSTNO TAKENAC1 VALAC ) (FIXNUM (COM-AREF) (CC0) (CLLOC) (COML1) (COMLC) (COMARRAY) (CONVNUMLOC FIXNUM) (FRAC) (FRAC1) (FRAC5) (FRACB) (FREENUMAC0) (FREENUMAC1) (FREENUMAC) (FREEREGAC) (LOADINREGAC) (LOADINSOMENUMAC) (LOADINNUMAC NOTYPE FIXNUM) (OUTFUNCALL) (P1TRESS) (ZTYI) ) (*EXPR CARCDR CC0 CLEANUPSPL COMP COMPLRVERNO MCX-TRACE NARGS P1GFY P1SPECIALIZEDVS SPECIALS UNSAFEP ELOAD UGREAT1 ) (*LEXPR PNAMECONC CDUMP EOPEN) (APPLY 'ARRAY* (SUBST () () '((NOTYPE (BOLA 9 7) (STGET 10.) (CBA 16.) (PVIA 3 17.) (A1S1A ? 4) (AC-ADDRS 11.) (PDL-ADDRS 3 193.))))) (FIXSW 'T) (CLOSED () ) (GENSYM 0) (SETQ USE-STRT7 'T) '(COMMENT COMPDECLARE)) (DEFUN FASLDECLARE MACRO (L) (SPECIAL ALLATOMS AMBIGSYMS ATOMINDEX BINCT CURRENTFN CURRENTFNSYMS DDTSYMP DDTSYMS ENTRYNAMES EXPR FASLEVAL FASLPUSH FASLVERNO FILOC FSLFLD IMOBFL IMOSAR IMOUSR LASTENTRY LDFNM LITCNT LITERALP LITERALS LITLOC *LOC MAINSYMPDL MAKUNBOUND MESSIOC MSDIR SQUIDP SYMBOLSP SYMPDL UFFIL UNDEFSYMS UNFASLCOMMENTS UNFASLSIGNIF ) (*EXPR *DDTSYM ARGSINFO ATOMINDEX BLOBLENGTH BUFFERBIN COLLECTATOMS FASLDEFSYM FASLDIFF FASLEVAL FASLINIT FASLMAIN FASLMINUS FASLNEGLIS FASLPASS1 FASLPASS2 FASLPLUS FASLVERNO INDENT-TO-INSTACK LAPCONST LISTOUT LREMPROP MAKEWORD MESOUT MOBYSYMPOP MSOUT MUNGEABLE REMPROPL SUBMATCH ) (FIXNUM (BLOBLENGTH) (ATOMINDEX) (ARGSINFO) (RECLITCOUNT) FILOC *LOC LITLOC LITCNT BINCT) (ARRAY* (NOTYPE (LCA 16.) (BSAR 9.) (NUMBERTABLE 127.)) (FIXNUM (BTAR 9.) (BXAR 9.))) (MAPEX T) '(COMMENT FASLDECLARE)) (COMMENT MACROS THAT COULD BE IN-LINEABLE-EXPRS) (DECLARE (MACROS () ) (SETQ DEFMACRO-CHECK-ARGS () ) (SETQ DEFMACRO-DISPLACE-CALL () ) (SETQ DEFMACRO-FOR-COMPILING 'T)) (DEFMACRO OUTFS (a1 a2 a3 &optional a4 a5) (cond ((null a4) `(OUT3FIELDS ,a3 ,a2 ,a1)) ((null a5) `(OUT4FIELDS ,a4 ,a3 ,a2 ,a1)) ('t `(OUT5FIELDS ,a5 ,a4 ,a3 ,a2 ,a1)))) (DEFMACRO NCDR (l n) `(NTHCDR ,n ,l)) (DEFMACRO EQUIV (a1 a2) `(COND (,a1 ,a2) ((NULL ,a2)))) (DEFMACRO /2^N-P (n) `(ZEROP (BOOLE 4 ,n (- ,n)))) (DEFMACRO INVERSE-ASCII (char) `(GETCHARN ,char 1)) (DEFMACRO |Oh, FOO!| () `(OUTPUT 'FOO)) (DEFMACRO ITSP () `(EQ OPSYS 'ITS)) (DEFMACRO SAILP () `(EQ OPSYS 'SAIL)) (DEFMACRO DEC10P () `(EQ OPSYS 'DEC10)) (DEFMACRO DEC20P () `(EQ OPSYS 'DEC20)) (DEFMACRO BARF (item msg &OPTIONAL a1 a2) `(MSOUT ,item ',msg 'BARF ,a1 ,a2)) (DEFMACRO DBARF (item msg &OPTIONAL a1 a2) `(MSOUT ,item ',msg 'DATA ,a1 ,a2)) (DEFMACRO WARN (item msg &OPTIONAL a1 a2) `(MSOUT ,item ',msg 'WARN ,a1 ,a2)) (DEFMACRO PDERR (item msg) `(MSOUT ,item ',msg 'ERRFL 4 6)) (DEFMACRO KNOW-ALL-TYPES (a1) `(COND ((NULL ,a1) () ) ((MEMQ ,a1 '(FIXNUM FLONUM))) ((NOT (MEMQ '() ,a1))))) (DEFMACRO INITIALSLOTS () `'((() () () () () ) ;REGACS (() () () ) ;NUMACS (() () () ) ;ACSMODE () ;REGPDL () ;FXPDL () ;FLPDL )) (DEFMACRO ERL-SET () `(OR (MEMBER '(COMPLRVERNO) (SETQ ERRLIST SAVED-ERRLIST)) (PUSH '(COMPLRVERNO) ERRLIST))) (DEFMACRO SETUP-CATCH-PDL-COUNTS () `(SETQ LERSTP+1 13. LPASST-P+1 6. LPASST-FXP 11.)) (DEFMACRO CLEARALLACS () `(CLEARACS0 'T)) (DEFMACRO NO-DELAYED-SPLDS () `(CSLD (SETQ CCSLD 'T) 'T ())) (DEFMACRO MAX-NPUSH () `'16.) (DEFMACRO MAX-0PUSH () `'8) (DEFMACRO MAX-0*0PUSH () `'8) (DEFMACRO NACS () `'5) (DEFMACRO NUMVALAC () `'7) (DEFMACRO NUMNACS () `'3) (DEFMACRO NACS+1 () `'#.(1+ (NACS))) (DEFMACRO FXP0 () `'-2048.) ;2^11. Bit implies REGPDL (DEFMACRO FLP0 () `'-4096.) ;2^12. Bit (with 2^11. off) implies FXPDL (DEFMACRO NPDL-ADDRS () `'192.) (DEFMACRO REGADP-N (n) `(LESSP #.(FXP0) ,n #.(NUMVALAC))) (DEFMACRO REGACP (x) `(AND (SIGNP G ,x) (< ,x #.(NUMVALAC)))) (DEFMACRO REGACP-N (n) `(LESSP 0 ,n #.(NUMVALAC))) (DEFMACRO REGPDLP-N (n) `(LESSP #.(FXP0) ,n 1)) (DEFMACRO REGPDLP (x) `(AND (SIGNP LE ,x) (> ,x #.(FXP0)))) (DEFMACRO PDLLOCP (x) `(SIGNP LE ,x)) (DEFMACRO PDLLOCP-N (n) `(NOT (> ,n 0))) (DEFMACRO ACLOCP (x) `(SIGNP G ,x)) (DEFMACRO ACLOCP-N (n) `(> ,n 0)) (DEFMACRO NUMACP (x) `(AND (SIGNP G ,x) (NOT (< ,x #.(NUMVALAC))))) (DEFMACRO NUMACP-N (n) `(NOT (< ,n #.(NUMVALAC)))) (DEFMACRO NUMPDLP (x) `(AND (SIGNP LE ,x) (NOT (> ,x #.(FXP0))))) (DEFMACRO NUMPDLP-N (n) `(NOT (> ,n #.(FXP0)))) (DEFMACRO FLPDLP-N (n) `(NOT (> ,n #.(FLP0)))) (DEFMACRO PDLAC (mode) `(COND ((EQ ,mode 'FIXNUM) 'FXP) ((NULL ,mode) 'P) ('FLP))) (DEFMACRO PDLGET (mode) `(COND ((EQ ,mode 'FIXNUM) FXPDL) ((NULL ,mode) REGPDL) (FLPDL))) (DEFMACRO ACSGET (mode) `(COND (,mode NUMACS) (REGACS))) (DEFMACRO ACSSLOT (n) `(COND ((= ,n #.(NUMVALAC)) NUMACS) ((= ,n #.(1+ (NUMVALAC))) (CDR NUMACS)) ('T (CDDR NUMACS)))) (DEFMACRO ACSMODESLOT (n) `(COND ((= ,n #.(NUMVALAC)) ACSMODE) ((= ,n #.(1+ (NUMVALAC))) (CDR ACSMODE)) ('T (CDDR ACSMODE)))) (DEFMACRO NACSGET (mode) `(COND ((NULL ,mode) #.(1+ (NACS))) ('T #.(1+ (NUMNACS))))) (DEFMACRO NULLIFY-NUMAC () `(PROG2 (RPLACA NUMACS () ) () (RPLACA ACSMODE () ))) (DEFMACRO ILOCREG (x acx) `(ILOCMODE ,x ,acx '(() FIXNUM FLONUM))) (DEFMACRO ILOCNUM (x acx) `(ILOCMODE ,x ,acx '(FIXNUM FLONUM))) (DEFMACRO ILOCF (x) `(ILOCMODE ,x 'FRACF '(() FIXNUM FLONUM))) (DEFMACRO ILOCN (x) `(ILOCMODE ,x 'ARGNO '(() FIXNUM FLONUM))) (DEFMACRO FREACB () `(FREEREGAC 'FRACB)) (DEFMACRO FREAC () `(FREEREGAC 'FRAC))