;-*-MODE:LISP; BASE:8; PACKAGE:SYSTEM-INTERNALS -*- ; ** (c) Copyright 1980 Massachusetts Institute of Technology ** ;LOADING THIS WITH A BASE OF OTHER THAN 8 CAN REALLY CAUSE BIZARRE EFFECTS (OR (= IBASE 8) (BREAK IBASE-NOT-8)) (SETQ AREA-LIST '( RESIDENT-SYMBOL-AREA ;T AND NIL SYSTEM-COMMUNICATION-AREA ;USED BY PAGING, CONSOLE, PDP10 I/O, ETC. SCRATCH-PAD-INIT-AREA ;LOAD MICRO CODE VARIABLES UPON STARTUP MICRO-CODE-SYMBOL-AREA ;600 QS MISC DISPATCH, UCODE ENTRY DISPATCH PAGE-TABLE-AREA ;PAGE HASH TABLE PHYSICAL-PAGE-DATA ;GC DATA,,PHT INDEX ;-1 IF OUT OF SERVICE ;PHT-INDEX=-1 IF FIXED-WIRED (NO PHT ENTRY) ;GC-DATA=0 IF NOT IN USE REGION-ORIGIN ;FIXNUM BASE ADDRESS INDEXED BY REGION # REGION-LENGTH ;FIXNUM LENGTH INDEXED BY REGION # REGION-BITS ;FIXNUM, SEE %%REGION- SYMS FOR FIELDS ADDRESS-SPACE-MAP ;SEE %ADDRESS-SPACE-MAP-BYTE-SIZE BELOW ;END WIRED AREAS REGION-FREE-POINTER ;FIXNUM, RELATIVE ALLOCATION POINT. REGION-GC-POINTER ;GC USE, MAINLY RELATIVE DIRTY/CLEAN BOUNDARY REGION-LIST-THREAD ;NEXT REGION# IN AREA, OR 1_23.+AREA# ; THREADS FREE REGION SLOTS, TOO. AREA-NAME ;ATOMIC NAME INDEXED BY AREA # AREA-REGION-LIST ;FIRST REGION# IN AREA AREA-REGION-SIZE ;RECOMMENDED SIZE FOR NEW REGIONS AREA-MAXIMUM-SIZE ;APPROXIMATE MAXIMUM #WDS ALLOWED IN THIS AREA AREA-SWAP-RECOMMENDATIONS ;FIXNUM, SEE %%AREA-SWAP- SYMS FOR FIELDS GC-TABLE-AREA ;GARBAGE COLLECTOR TABLES SUPPORT-ENTRY-VECTOR ;CONSTANTS NEEDED BY BASIC MICROCODE CONSTANTS-AREA ;COMMON CONSTANTS USED BY MACROCODE EXTRA-PDL-AREA ;SEPARATELY GC-ABLE AREA, MAINLY EXTENDED NUMS ; MUST BE RIGHT BEFORE MICRO-CODE-ENTRY-AREA MICRO-CODE-ENTRY-AREA ;MICRO ENTRY ADDRESS ;OR LOCATIVE INDIRECT MICRO-CODE-SYMBOL-AREA MICRO-CODE-ENTRY-NAME-AREA ;MICRO ENTRY NAME MICRO-CODE-ENTRY-ARGS-INFO-AREA ;MICRO ENTRY %ARGS-INFO MICRO-CODE-ENTRY-MAX-PDL-USAGE ;MICRO ENTRY PDL DEPTH INCL MICRO-MICRO CALLS ;AREAS AFTER HERE ARE NOT "INITIAL", NOT KNOWN SPECIALLY BY MICROCODE MICRO-CODE-ENTRY-ARGLIST-AREA ;VALUE FOR ARGLIST FUNCTION TO RETURN MICRO-CODE-SYMBOL-NAME-AREA ;NAMES OF MICRO-CODE-SYMBOL-AREA ENTRIES LINEAR-PDL-AREA ;MAIN PDL LINEAR-BIND-PDL-AREA ;CORRESPONDING BIND PDL INIT-LIST-AREA ;LIST CONSTANTS CREATED BY COLD LOAD ;END FIXED AREAS, WHICH MUST HAVE ONLY ONE REGION WORKING-STORAGE-AREA ;ORDINARY CONSING HAPPENS HERE PERMANENT-STORAGE-AREA ;PUT "PERMANENT" DATA STRUCTURES HERE PROPERTY-LIST-AREA ;EXISTS FOR PAGING REASONS P-N-STRING ;PRINT NAMES AND STRINGS CONTROL-TABLES ;OBARRAY, READTABLE (SEMI-OBSOLETE) OBT-TAILS ;OBARRAY BUCKET CONSES (SEMI-OBSOLETE) NR-SYM ;SYMBOLS NOT IN RESIDENT-SYMBOL-AREA MACRO-COMPILED-PROGRAM ;MACRO CODE LOADED HERE PDL-AREA ;PUT STACK-GROUP REGULAR-PDLS HERE FASL-TABLE-AREA ;FASLOAD'S TABLE IS HERE FASL-TEMP-AREA ;FASLOAD TEMPORARY CONSING FASL-CONSTANTS-AREA ;FASLOAD LOADS CONSTANTS HERE )) ;Assuming no more than 256 regions (SETQ %ADDRESS-SPACE-MAP-BYTE-SIZE 8 %ADDRESS-SPACE-QUANTUM-SIZE 40000) ;Each quantum has a byte in the ADDRESS-SPACE-MAP area, ;which is the region number, or 0 if free or fixed area. ;INIT-LIST-AREA is the last fixed area. ;THESE AREAS ARE ENCACHED IN THE PDL BUFFER. (SETQ PDL-BUFFER-AREA-LIST '( LINEAR-PDL-AREA ;MAIN PDL PDL-AREA ;PDLS FOR MISC STACK GROUPS )) ;NOTE THAT AT PRESENT ALL AREAS UP THROUGH ADDRESS-SPACE-MAP MUST BE WIRED. ;THE REASON IS THAT WHEN THE MICROCODE STARTS UP IT STRAIGHT-MAPS THAT ;AMOUNT OF VIRTUAL MEMORY, WITHOUT CHECKING SEPARATELY FOR EACH PAGE. ;IT WOULD LOSE BIG IF ONE OF THOSE STRAIGHT-MAPPED PAGES GOT SWAPPED OUT. ;EXCEPT, UNUSED PORTIONS OF PAGE-TABLE-AREA AND PHYSICAL-PAGE-DATA GET UNWIRED (SETQ WIRED-AREA-LIST '( ;AREAS THAT MAY NOT BE MOVED NOR SWAPPED OUT RESIDENT-SYMBOL-AREA ;NO GOOD REASON SYSTEM-COMMUNICATION-AREA ;FOR CONSOLE, PDP10, MICRO INTERRUPT, ETC. SCRATCH-PAD-INIT-AREA ;LOAD MICRO CODE VARIABLES UPON STARTUP MICRO-CODE-SYMBOL-AREA ;NO GOOD REASON, ACTUALLY PAGE-TABLE-AREA ;USED BY PAGE FAULT HANDLER PHYSICAL-PAGE-DATA ;USED BY PAGE FAULT HANDLER REGION-ORIGIN ;USED BY PAGE FAULT HANDLER REGION-LENGTH ;USED BY PAGE FAULT HANDLER REGION-BITS ;USED BY PAGE FAULT HANDLER ADDRESS-SPACE-MAP ;USED BY PAGE FAULT HANDLER )) ;THIS LIST ISN'T NECESSARILY UP TO DATE. FEATURE ISN'T REALLY USED YET. (SETQ READ-ONLY-AREA-LIST '( ;AREAS TO BE SET UP READ ONLY BY COLD LOAD SCRATCH-PAD-INIT-AREA MICRO-CODE-SYMBOL-AREA SUPPORT-ENTRY-VECTOR CONSTANTS-AREA INIT-LIST-AREA MICRO-CODE-SYMBOL-NAME-AREA )) (SETQ COLD-LOAD-AREA-SIZES ;DEFAULT AREA SIZE IS ONE PAGE '(P-N-STRING 600 OBT-TAILS 100 NR-SYM 500 MACRO-COMPILED-PROGRAM 1000 PAGE-TABLE-AREA 128. ;ENOUGH FOR 2 MEGAWORDS OF MAIN MEMORY PHYSICAL-PAGE-DATA 32. ;ENOUGH FOR 2 MEGAWORDS OF MAIN MEMORY ADDRESS-SPACE-MAP 1 ;ASSUMING 8-BIT BYTES GC-TABLE-AREA 400 ;64K LINEAR-PDL-AREA 100 LINEAR-BIND-PDL-AREA 10 PDL-AREA 300 WORKING-STORAGE-AREA 400 PERMANENT-STORAGE-AREA 200 PROPERTY-LIST-AREA 100 CONTROL-TABLES 13 INIT-LIST-AREA 64 MICRO-CODE-ENTRY-AREA 2 MICRO-CODE-ENTRY-NAME-AREA 2 MICRO-CODE-ENTRY-ARGS-INFO-AREA 2 MICRO-CODE-ENTRY-ARGLIST-AREA 2 MICRO-CODE-ENTRY-MAX-PDL-USAGE 2 MICRO-CODE-SYMBOL-NAME-AREA 2 MICRO-CODE-SYMBOL-AREA 2 FASL-TABLE-AREA 201 ;3 TIMES LENGTH-OF-FASL-TABLE PLUS 1 PAGE FASL-CONSTANTS-AREA 600 EXTRA-PDL-AREA 10 FASL-TEMP-AREA 40)) (SETQ COLD-LOAD-REGION-SIZES ;DEFAULT REGION SIZE IS 16K '(WORKING-STORAGE-AREA 400000 MACRO-COMPILED-PROGRAM 200000 P-N-STRING 200000 NR-SYM 200000 FASL-CONSTANTS-AREA 200000 PROPERTY-LIST-AREA 200000)) ;In the cold-load, areas have only one region, so you can only use one ;representation type per area. These are the list areas, the rest are structure areas. (SETQ LIST-STRUCTURED-AREAS '( SYSTEM-COMMUNICATION-AREA SCRATCH-PAD-INIT-AREA MICRO-CODE-SYMBOL-AREA PAGE-TABLE-AREA PHYSICAL-PAGE-DATA REGION-ORIGIN REGION-LENGTH REGION-BITS REGION-FREE-POINTER REGION-GC-POINTER REGION-LIST-THREAD AREA-NAME AREA-REGION-LIST AREA-REGION-SIZE AREA-MAXIMUM-SIZE AREA-SWAP-RECOMMENDATIONS SUPPORT-ENTRY-VECTOR CONSTANTS-AREA MICRO-CODE-ENTRY-AREA MICRO-CODE-ENTRY-NAME-AREA MICRO-CODE-ENTRY-ARGS-INFO-AREA MICRO-CODE-ENTRY-MAX-PDL-USAGE MICRO-CODE-ENTRY-ARGLIST-AREA MICRO-CODE-SYMBOL-NAME-AREA INIT-LIST-AREA PROPERTY-LIST-AREA OBT-TAILS FASL-CONSTANTS-AREA )) (SETQ STATIC-AREAS '( ;not including Fixed areas INIT-LIST-AREA PERMANENT-STORAGE-AREA P-N-STRING CONTROL-TABLES NR-SYM MACRO-COMPILED-PROGRAM FASL-TABLE-AREA FASL-TEMP-AREA FASL-CONSTANTS-AREA )) ; Numeric values of data types, shifted over into the data type field, ; suitable for being added to the pointer to produce the contents of a Q. ; These do NOT go into the cold load. ; What are these used for nowadays? They are not used in UCADR. -- RMS (SETQ DATA-TYPES '(QZTRAP QZNULL QZFREE ;ERRORS QZSYM QZSYMH QZFIX QZXNUM ;ORDINARY ATOMS QZHDR QZGCF QZEVCP QZ1QF QZHF QXBF ;FORWARDS QZLOC ;LOCATIVES QZLIST ;LISTS QZUENT ;FUNCTIONS, ETC... QZFEFP QZARYP QZARYH ;... QZSTKG QZCLOS QZSFLO QZSMTH QZINST QZINSH QZENTY QZSCLS )) ; Numeric values of data types, suitable for being DPB'd into the ; data type field, or returned by (%DATA-TYPE ...). (SETQ Q-DATA-TYPES '(DTP-TRAP DTP-NULL DTP-FREE DTP-SYMBOL DTP-SYMBOL-HEADER DTP-FIX DTP-EXTENDED-NUMBER DTP-HEADER DTP-GC-FORWARD DTP-EXTERNAL-VALUE-CELL-POINTER DTP-ONE-Q-FORWARD DTP-HEADER-FORWARD DTP-BODY-FORWARD DTP-LOCATIVE DTP-LIST DTP-U-ENTRY DTP-FEF-POINTER DTP-ARRAY-POINTER DTP-ARRAY-HEADER DTP-STACK-GROUP DTP-CLOSURE DTP-SMALL-FLONUM DTP-SELECT-METHOD DTP-INSTANCE DTP-INSTANCE-HEADER DTP-ENTITY DTP-STACK-CLOSURE )) ; Numeric values of CDR codes, right-justified in word for %P-CDR-CODE, etc. (SETQ Q-CDR-CODES '(CDR-NORMAL CDR-ERROR CDR-NIL CDR-NEXT)) ; Byte pointers at the parts of a Q or other thing, and their values. ; Q-FIELD-VALUES does NOT itself go into the cold load. (SETQ Q-FIELD-VALUES '(%%Q-CDR-CODE 3602 %%Q-FLAG-BIT 3501 %%Q-DATA-TYPE 3005 %%Q-POINTER 0030 %%Q-POINTER-WITHIN-PAGE 0007 %%Q-TYPED-POINTER 0035 %%Q-ALL-BUT-TYPED-POINTER 3503 %%Q-ALL-BUT-POINTER 3010 %%Q-ALL-BUT-CDR-CODE 0036 %%Q-HIGH-HALF 2020 %%Q-LOW-HALF 0020 ;USE THESE FOR REFERENCING MACRO INSTRUCTIONS %%CH-FONT 1010 %%CH-CHAR 0010 ;FIELDS IN A 16-BIT CHARACTER %%KBD-CHAR 0010 %%KBD-CONTROL-META 1004 %%KBD-CONTROL 1001 %%KBD-META 1101 %%KBD-SUPER 1201 %%KBD-HYPER 1301 %%KBD-MOUSE 1701 %%KBD-MOUSE-BUTTON 0003 %%KBD-MOUSE-N-CLICKS 0303)) ; Assign the byte pointers their values. Q-FIELDS becomes a list of just names. ; It goes into the cold load, along with the names and their values. (ASSIGN-ALTERNATE Q-FIELD-VALUES) (SETQ Q-FIELDS (GET-ALTERNATE Q-FIELD-VALUES)) (SETQ %Q-FLAG-BIT (DPB -1 %%Q-FLAG-BIT 0)) ;USED BY QLF IN COLD MODE ;;; Stuff in the REGION-BITS array, some of these bits also appear in the ;;; map in the same orientation. (SETQ Q-REGION-BITS-VALUES '( %%REGION-MAP-BITS 1612 ;10 bits to go into the map (access/status/meta) ;2404 ;access and status bits %%REGION-OLDSPACE-META-BIT 2301 ;0=old or free, 1=new or static or fixed. ;0 causes transport-trap for read of ptr to here %%REGION-EXTRA-PDL-META-BIT 2201 ;0=extra-pdl, 1=normal. ;0 traps writing of ptr to here into "random" mem %%REGION-REPRESENTATION-TYPE 2002 ;Data representation type code: %REGION-REPRESENTATION-TYPE-LIST 0 %REGION-REPRESENTATION-TYPE-STRUCTURE 1 ;2 and 3 reserved for future ;1602 spare meta bits ;1501 spare (formerly unimplemented compact-cons flag) %%REGION-SPACE-TYPE 1104 ;Code for type of space: %REGION-SPACE-FREE 0 ;0 free region slot %REGION-SPACE-OLD 1 ;1 oldspace region of dynamic area %REGION-SPACE-NEW 2 ;2 permanent newspace region of dynamic area %REGION-SPACE-NEW1 3 ;3 temporary space, level 1 %REGION-SPACE-NEW2 4 ;4 .. %REGION-SPACE-NEW3 5 ;5 .. %REGION-SPACE-NEW4 6 ;6 .. %REGION-SPACE-NEW5 7 ;7 .. %REGION-SPACE-NEW6 10 ;10 .. %REGION-SPACE-STATIC 11 ;11 static area %REGION-SPACE-FIXED 12 ;12 fixed, static+not growable+no consing allowed %REGION-SPACE-EXTRA-PDL 13 ;13 An extra-pdl for some stack-group %REGION-SPACE-COPY 14 ;14 Like newspace, stuff copied from oldspace goes ; here while newly-consed stuff goes to newspace ; This is for permanent data ;15-17 [not used] %%REGION-SCAVENGE-ENABLE 1001 ;If 1, scavenger touches this region ;0503 spare bits. %%REGION-SWAPIN-QUANTUM 0005 ;swap this +1 pages in one disk op on swapin ; if possible. )) (ASSIGN-ALTERNATE Q-REGION-BITS-VALUES) (SETQ Q-REGION-BITS (GET-ALTERNATE Q-REGION-BITS-VALUES)) (SETQ Q-AREA-SWAP-BITS-VALUES '( %%AREA-SWAP-SWAPIN-TRANSFER-SIZE 0006 ;# of pages to bring in with single disk ; op if possible. 0 says always 1. ; Otherwise this is a base number which ; may be further increased in ; context-switch mode. )) (ASSIGN-ALTERNATE Q-AREA-SWAP-BITS-VALUES) (SETQ Q-AREA-SWAP-BITS (GET-ALTERNATE Q-AREA-SWAP-BITS-VALUES)) (SETQ SYSTEM-COMMUNICATION-AREA-QS '( ;LOCATIONS RELATIVE TO 400 IN CADR ;locations 400-437 are miscellaneous Qs declared below ;locations 440-477 are the reverse first level map ;locations 500-511 are the keyboard buffer header (buffer is 200-377) ;locations 600-637 are the disk-error log ;locations 700-777 are reserved for disk CCW's (only 777 used now) ;In CADR, location 777 is used (for now) by the disk code for the CCW. ; --actually it seems to use locations 12-377 for the CCW most of the time. %SYS-COM-AREA-ORIGIN-PNTR ;ADDRESS OF AREA-ORIGIN AREA %SYS-COM-VALID-SIZE ;IN A SAVED BAND, NUMBER OF WORDS USED %SYS-COM-PAGE-TABLE-PNTR ;ADDRESS OF PAGE-TABLE-AREA %SYS-COM-PAGE-TABLE-SIZE ;NUMBER OF QS %SYS-COM-OBARRAY-PNTR ;CURRENT OBARRAY, COULD BE AN ARRAY-POINTER ;BUT NOW IS USUALLY A SYMBOL WHOSE VALUE ;IS THE CURRENTLY-SELECTED OBARRAY (PACKAGE) ;Ether net interrupt-handler variables %SYS-COM-ETHER-FREE-LIST %SYS-COM-ETHER-TRANSMIT-LIST %SYS-COM-ETHER-RECEIVE-LIST %SYS-COM-BAND-FORMAT ;In a saved band, encodes format number. ; 1000 -> new compressed format ; otherwise old expanded format. ;In old bands, this is not really initialized ; but is usually 410. %SYS-COM-GC-GENERATION-NUMBER ;reserved for value of %GC-GENERATION-NUMBER %SYS-COM-UNIBUS-INTERRUPT-LIST ;SEE LMIO;UNIBUS (LIST OF UNIBUS CHANNELS) %SYS-COM-TEMPORARY ;MICROCODE BASHES THIS AT EXTRA-PDL-PURGE %SYS-COM-FREE-AREA/#-LIST ;THREADED THROUGH AREA-REGION-LIST, END=0 %SYS-COM-FREE-REGION/#-LIST ;THREADED THROUGH REGION-LIST-THREAD, END=0 %SYS-COM-MEMORY-SIZE ;NUMBER OF WORDS OF MAIN MEMORY %SYS-COM-WIRED-SIZE ;# WORDS OF LOW MEMORY WIRED DOWN ;NOT ALL OF THESE WORDS ARE WIRED, THIS ;IS REALLY THE VIRTUAL ADDRESS OF THE START ;OF NORMAL PAGEABLE MEMORY ;Chaos net interrupt-handler variables %SYS-COM-CHAOS-FREE-LIST %SYS-COM-CHAOS-TRANSMIT-LIST %SYS-COM-CHAOS-RECEIVE-LIST ;Debugger locations (*** these seem not to be used ***) %SYS-COM-DEBUGGER-REQUESTS ;REQUEST TO POWER CONTROL/DEBUGGER %SYS-COM-DEBUGGER-KEEP-ALIVE ;KEEP ALIVE FLAG WORD %SYS-COM-DEBUGGER-DATA-1 ;FOR INTERCOMMUNICATION %SYS-COM-DEBUGGER-DATA-2 ;*** This does not appear to be initialized or used %SYS-COM-MAJOR-VERSION ;MAJOR COLD LOAD VERSION AS FIXNUM. AVAILABLE TO ; MICROCODE FOR DOWNWARD COMPATIBILITY. %SYS-COM-DESIRED-MICROCODE-VERSION ;Microcode version this world expects ;TO BE ADDED: ;SWAP OUT SCHEDULER AND DISK STUFF ;EVENTUALLY THIS MAY REPLACE SCRATCH-PAD-INIT-AREA ;THOSE OF THESE THAT DON'T NEED TO SURVIVE WARM BOOT COULD BE IN A-MEMORY %SYS-COM-HIGHEST-VIRTUAL-ADDRESS ;In new band format. You better have this amt of ; room in the paging partition. %SYS-COM-POINTER-WIDTH ;Either 24 or 25, as fixnum, or DTP-FREE in old sys. ;; 6 left )) (AND (> (LENGTH SYSTEM-COMMUNICATION-AREA-QS) 40) (ERROR '|SYSTEM COMMUNICATION AREA OVERFLOW|)) (SETQ NEW-ARRAY-INDEX-ORDER NIL) ;;; Next three symbols are treated bletcherously, because there isnt the right kind of ;;; LDB available ;VIRTUAL ADDRESS OF 0@A. MUST AGREE WITH VALUE IN UCADR. ;(unfortunately called LOWEST-A-MEM-VIRTUAL-ADDRESS). (SETQ A-MEMORY-VIRTUAL-ADDRESS (%P-LDB-OFFSET 0030 76776000 1)) ;Virtual address of X-BUS IO space. ;Must agree with LOWEST-IO-SPACE-VIRTUAL-ADDRESS in UCADR. (SETQ IO-SPACE-VIRTUAL-ADDRESS (%P-LDB-OFFSET 0030 77000000 1)) ;Virtual address of UNIBUS IO space. ;Must agree with LOWEST-UNIBUS-VIRTUAL-ADDRESS in UCADR. (SETQ UNIBUS-VIRTUAL-ADDRESS (%P-LDB-OFFSET 0030 77400000 1)) (SETQ %INITIALLY-DISABLE-TRAPPING NIL) ;THIS NON-NIL INHIBITS LISP-REINITIALIZE FROM ; DOING AN (ENABLE-TRAPPING) (SETQ INHIBIT-SCHEDULING-FLAG NIL) ;THIS NON-NIL INHIBITS CLOCK & SCHEDULING (SETQ HEADER-FIELD-VALUES '(%%HEADER-TYPE-FIELD 2305 %%HEADER-REST-FIELD 0023)) (SETQ HEADER-FIELDS (GET-ALTERNATE HEADER-FIELD-VALUES)) ; These are the values that go in the %%HEADER-TYPE-FIELD of a Q of ; data type DTP-HEADER. (SETQ Q-HEADER-TYPES '(%HEADER-TYPE-ERROR %HEADER-TYPE-FEF %HEADER-TYPE-ARRAY-LEADER %HEADER-TYPE-unused %HEADER-TYPE-FLONUM %HEADER-TYPE-COMPLEX %HEADER-TYPE-BIGNUM %HEADER-TYPE-RATIONAL-BIGNUM)) ; These are the header types, shifted so they can be added directly into a Q. ; These do NOT go in the cold load. (SETQ HEADER-TYPES '(HEADER-TYPE-ERROR HEADER-TYPE-FEF HEADER-TYPE-ARRAY-LEADER HEADER-TYPE-unused HEADER-TYPE-FLONUM HEADER-TYPE-COMPLEX HEADER-TYPE-BIGNUM HEADER-TYPE-RATIONAL-BIGNUM)) ; These three lists describing the possible types of "argument descriptor info" (SETQ ADI-KINDS '(ADI-ERR ADI-RETURN-INFO ADI-RESTART-PC ADI-FEXPR-CALL ADI-LEXPR-CALL ADI-BIND-STACK-LEVEL ADI-UNUSED-6 ADI-USED-UP-RETURN-INFO)) (SETQ ADI-STORING-OPTIONS '(ADI-ST-ERR ADI-ST-BLOCK ADI-ST-LIST ADI-ST-MAKE-LIST ADI-ST-INDIRECT)) (SETQ ADI-FIELD-VALUES '(%%ADI-TYPE 2403 %%ADI-RET-STORING-OPTION 2103 %%ADI-RET-SWAP-SV 2001 %%ADI-RET-NUM-VALS-EXPECTING 0006 %%ADI-RPC-MICRO-STACK-LEVEL 0006)) (ASSIGN-ALTERNATE ADI-FIELD-VALUES) (SETQ ADI-FIELDS (GET-ALTERNATE ADI-FIELD-VALUES)) ; LINEAR-PDL-QS and LINEAR-PDL-FIELDS, and their elements, go in the real machine. (SETQ LINEAR-PDL-QS '(%LP-FEF %LP-ENTRY-STATE %LP-EXIT-STATE %LP-CALL-STATE)) ;THESE ARE ASSIGNED VALUES STARTING WITH 0 AND INCREMENTING BY -1 (ASSIGN-VALUES-INIT-DELTA LINEAR-PDL-QS 0 0 -1) (SETQ %LP-CALL-BLOCK-LENGTH (LENGTH LINEAR-PDL-QS)) (SETQ LLPFRM 4) ;# FIXED ALLOC QS IN LINAR PDL BLOCK (OBSOLETE, USE ABOVE) (SETQ %LP-INITIAL-LOCAL-BLOCK-OFFSET 1) (SETQ LINEAR-PDL-FIELDS-VALUES '( ;LPCLS (%LP-CALL-STATE). Stored when this call frame is created. ;bits 27', 25' not used in LPCLS %%LP-CLS-TRAP-ON-EXIT 2601 ;If set, get error before popping this frame. %%LP-CLS-ADI-PRESENT 2401 ;ADI words precede this call-block %%LP-CLS-DESTINATION 2004 ;Where in the caller to put this frame's value %%LP-CLS-DELTA-TO-OPEN-BLOCK 1010 ;Offset back to previous open or active block %%LP-CLS-DELTA-TO-ACTIVE-BLOCK 0010 ;Offset back to previous active block ;An active block is one that is executing ;An open block is one whose args are being made ;LPEXS (%LP-EXIT-STATE). Stored when this frame calls out. ;bits 22'-27' not used in LPEXS %%LP-EXS-MICRO-STACK-SAVED 2101 ;A microstack frame exists on special pdl %%LP-EXS-PC-STATUS 2001 ;Same as below %%LP-EXS-BINDING-BLOCK-PUSHED 2001 ;M-QBBFL STORED HERE IN MACRO EXIT OPERATION %%LP-EXS-EXIT-PC 0017 ;LC as offset in halfwords from FEF ;Meaningless if %LP-FEF not a fef. ;; Don't change %%LP-EXS-EXIT-PC, the numerical value is known by UCADR ;LPENS (%LP-ENTRY-STATE). Stored when this frame entered. ;bits 16'-27' not used in LPENS ; %%LP-ENS-SPECIALS 2601 %%LP-ENS-BINDING-ARROW-DIRECTION 2501 %%LP-ENS-ENVIRONMENT-POINTER-POINTS-HERE 1601 %%LP-ENS-NUM-ARGS-SUPPLIED 1006 %%LP-ENS-MACRO-LOCAL-BLOCK-ORIGIN 0010)) (ASSIGN-ALTERNATE LINEAR-PDL-FIELDS-VALUES) (SETQ LINEAR-PDL-FIELDS (GET-ALTERNATE LINEAR-PDL-FIELDS-VALUES)) ;; MICRO-STACK-FIELDS and its elements go in the real machine. (SETQ MICRO-STACK-FIELDS-VALUES '( %%US-RPC 1600 ;RETURN PC %%US-MACRO-INSTRUCTION-RETURN 1601 ;TRIGGERS INSTRUCTION-STREAM STUFF %%US-PPBMIA 1701 ;ADI ON MICRO-TO-MICRO-CALL %%US-PPBSPC 2101)) ;BINDING BLOCK PUSHED (ASSIGN-ALTERNATE MICRO-STACK-FIELDS-VALUES) (SETQ MICRO-STACK-FIELDS (GET-ALTERNATE MICRO-STACK-FIELDS-VALUES)) ; M-FLAGS-FIELDS and M-ERROR-SUBSTATUS-FIELDS and their elements go in the real machine. (SETQ M-FLAGS-FIELDS-VALUES '( ;MUST AGREE WITH DEFS IN UCONS %%M-FLAGS-QBBFL 0001 ;BIND BLOCK OPEN FLAG %%M-FLAGS-CAR-SYM-MODE 0102 ;CAR OF SYMBOL GIVES: ERROR, ERROR EXCEPT ; (CAR NIL) -> NIL, NIL, P-NAME POINTER %%M-FLAGS-CAR-NUM-MODE 0302 ;CAR OF NUMBER GIVES: ERROR, NIL, "WHATEVER IT IS" %%M-FLAGS-CDR-SYM-MODE 0502 ;CDR OF SYMBOL GIVES: ERROR, ERROR EXCEPT ; (CDR NIL) -> NIL, NIL, PROPERTY-LIST %%M-FLAGS-CDR-NUM-MODE 0702 ;CDR OF NUMBER GIVES: ERROR, NIL, "WHATEVER IT IS" %%M-FLAGS-DONT-SWAP-IN 1101 ;MAGIC FLAG FOR CREATING FRESH PAGES %%M-FLAGS-TRAP-ENABLE 1201 ;1 ENABLE ERROR TRAPPING %%M-FLAGS-MAR-MODE 1302 ;1-BIT = READ-TRAP, 2-BIT = WRITE-TRAP %%M-FLAGS-PGF-WRITE 1501 ;FLAG USED BY PAGE FAULT ROUTINE %%M-FLAGS-INTERRUPT 1601 ;IN MICROCODE INTERRUPT %%M-FLAGS-SCAVENGE 1701 ;IN SCAVENGER %%M-FLAGS-TRANSPORT 2001 ;IN TRANSPORTER %%M-FLAGS-STACK-GROUP-SWITCH 2101 ;SWITCHING STACK GROUPS %%M-FLAGS-DEFERRED-SEQUENCE-BREAK 2201 ;SEQUENCE BREAK PENDING BUT INHIBITED %%M-FLAGS-METER-ENABLE 2301 ;METERING ENABLED FOR THIS STACK GROUP %%M-FLAGS-TRAP-ON-CALL 2401 ;TRAP ON ATTEMPTING TO ACTIVATE NEW FRAME. )) (ASSIGN-ALTERNATE M-FLAGS-FIELDS-VALUES) (SETQ M-FLAGS-FIELDS (GET-ALTERNATE M-FLAGS-FIELDS-VALUES)) (SETQ M-ERROR-SUBSTATUS-FIELDS-VALUES '( ;MUST AGREE WITH DEFS IN UCONS %%M-ESUBS-TOO-FEW-ARGS 0001 %%M-ESUBS-TOO-MANY-ARGS 0101 %%M-ESUBS-BAD-QUOTED-ARG 0201 %%M-ESUBS-BAD-EVALED-ARG 0301 %%M-ESUBS-BAD-DT 0401 %%M-ESUBS-BAD-QUOTE-STATUS 0501 )) (ASSIGN-ALTERNATE M-ERROR-SUBSTATUS-FIELDS-VALUES) (SETQ M-ERROR-SUBSTATUS-FIELDS (GET-ALTERNATE M-ERROR-SUBSTATUS-FIELDS-VALUES)) ;A "Numeric Argument Description" is what %ARGS-INFO and ARGS-INFO return. ;Such descriptors can also be hung on symbols' Q-ARGS-PROP properties. ;The "fast option Q" of a FEF is stored in this format. ;These symbols go in the real machine. (SETQ NUMERIC-ARG-DESC-INFO '( %ARG-DESC-QUOTED-REST 10000000 ;HAS QUOTED REST ARGUMENT %%ARG-DESC-QUOTED-REST 2501 %ARG-DESC-EVALED-REST 4000000 ;HAS EVALUATED REST ARGUMENT %%ARG-DESC-EVALED-REST 2401 %%ARG-DESC-ANY-REST 2402 ;NON-ZERO IF HAS EITHER KIND OF REST ARG %ARG-DESC-FEF-QUOTE-HAIR 2000000 ;MACRO COMPILED FCN WITH HAIRY QUOTING, %%ARG-DESC-FEF-QUOTE-HAIR 2301 ; CALLER MUST CHECK A-D-L FOR FULL INFO %ARG-DESC-INTERPRETED 1000000 ;THIS IS INTERPRETED FUNCTION, %%ARG-DESC-INTERPRETED 2201 ; NO INFORMATION AVAILABLE (VAL=1000077) %ARG-DESC-FEF-BIND-HAIR 400000 ;MACRO COMPILED FCN WITH HAIRY BINDING, %%ARG-DESC-FEF-BIND-HAIR 2101 ; LINEAR ENTER MUST CHECK A-D-L %%ARG-DESC-MIN-ARGS 0606 ;MINIMUM NUMBER OF REQUIRED ARGS %%ARG-DESC-MAX-ARGS 0006)) ;MAXIMUM NUMBER OF REQUIRED+OPTIONAL ; ARGS. REST ARGS NOT COUNTED. (ASSIGN-ALTERNATE NUMERIC-ARG-DESC-INFO) (SETQ NUMERIC-ARG-DESC-FIELDS (GET-ALTERNATE NUMERIC-ARG-DESC-INFO)) (SETQ ARG-DESC-FIELD-VALUES '(%FEF-ARG-SYNTAX 160 %FEF-QUOTE-STATUS 600 %FEF-DES-DT 17000 %FEF-INIT-OPTION 17 %FEF-SPECIAL-BIT 1_16 %FEF-NAME-PRESENT 1_20 ;***UNFORTUNATELY, ASSIGN-COMP-VALUES KNOWS ABOUT THESE TOO**** %%FEF-NAME-PRESENT 2001 %%FEF-SPECIAL-BIT 1601 %%FEF-SPECIALNESS 1602 %%FEF-FUNCTIONAL 1501 %%FEF-DES-DT 1104 %%FEF-QUOTE-STATUS 0702 %%FEF-ARG-SYNTAX 0403 %%FEF-INIT-OPTION 0004 )) (ASSIGN-ALTERNATE ARG-DESC-FIELD-VALUES) (SETQ ARG-DESC-FIELDS (GET-ALTERNATE ARG-DESC-FIELD-VALUES)) ;ARG-DESC-FIELDS GETS SET TO A LIST CONSISTING OF THE ALTERNATING MEMBERS OF ;ARG-DESC-FIELD-VALUES (SETQ FEF-NAME-PRESENT '(FEF-NM-NO FEF-NM-YES)) (SETQ FEF-SPECIALNESS '(FEF-LOCAL FEF-SPECIAL FEF-SPECIALNESS-UNUSED FEF-REMOTE)) (SETQ FEF-FUNCTIONAL '(FEF-FUNCTIONAL-DONTKNOW FEF-FUNCTIONAL-ARG)) (SETQ FEF-DES-DT '(FEF-DT-DONTCARE FEF-DT-NUMBER FEF-DT-FIXNUM FEF-DT-SYM FEF-DT-ATOM FEF-DT-LIST FEF-DT-FRAME)) (SETQ FEF-QUOTE-STATUS '(FEF-QT-DONTCARE FEF-QT-EVAL FEF-QT-QT)) (SETQ FEF-ARG-SYNTAX '(FEF-ARG-REQ FEF-ARG-OPT FEF-ARG-REST FEF-ARG-AUX FEF-ARG-FREE FEF-ARG-INTERNAL FEF-ARG-INTERNAL-AUX)) (SETQ FEF-INIT-OPTION '(FEF-INI-NONE FEF-INI-NIL FEF-INI-PNTR FEF-INI-C-PNTR FEF-INI-OPT-SA FEF-INI-COMP-C FEF-INI-EFF-ADR FEF-INI-SELF)) (SETQ ARRAY-FIELD-VALUES '( %%ARRAY-TYPE-FIELD 2305 %%ARRAY-LEADER-BIT 2101 %%ARRAY-DISPLACED-BIT 2001 %%ARRAY-FLAG-BIT 1701 %%ARRAY-NUMBER-DIMENSIONS 1403 %%ARRAY-LONG-LENGTH-FLAG 1301 %%ARRAY-NAMED-STRUCTURE-FLAG 1201 %%ARRAY-INDEX-LENGTH-IF-SHORT 0012 %ARRAY-MAX-SHORT-INDEX-LENGTH 1777)) (SETQ ARRAY-LEADER-FIELD-VALUES '(%ARRAY-LEADER-LENGTH 777777 %%ARRAY-LEADER-LENGTH 0022)) (SETQ ARRAY-MISC-VALUES '(ARRAY-DIM-MULT 1_14 ARRAY-DIMENSION-SHIFT -14 ARRAY-TYPE-SHIFT -23 ARRAY-LEADER-BIT 1_21 ARRAY-DISPLACED-BIT 1_20 ARRAY-LONG-LENGTH-FLAG 1_13 ARRAY-NAMED-STRUCTURE-FLAG 1_12)) (SETQ ARRAY-FIELDS (GET-ALTERNATE ARRAY-FIELD-VALUES)) (SETQ ARRAY-LEADER-FIELDS (GET-ALTERNATE ARRAY-LEADER-FIELD-VALUES)) (SETQ ARRAY-MISCS (GET-ALTERNATE ARRAY-MISC-VALUES)) (SETQ ARRAY-TYPES '(ART-ERROR ART-1B ART-2B ART-4B ART-8B ART-16B ART-32B ART-Q ART-Q-LIST ART-STRING ART-STACK-GROUP-HEAD ART-SPECIAL-PDL ART-HALF-FIX ART-REG-PDL ART-FLOAT ART-FPS-FLOAT ART-FAT-STRING)) (SETQ ARRAY-ELEMENTS-PER-Q '((ART-Q . 1) (ART-STRING . 4) (ART-1B . 40) (ART-2B . 20) (ART-4B . 10) (ART-8B . 4) (ART-16B . 2) (ART-32B . 1) (ART-Q-LIST . 1) (ART-STACK-GROUP-HEAD . 1) (ART-SPECIAL-PDL . 1) (ART-HALF-FIX . 2) (ART-REG-PDL . 1) (ART-FLOAT . -2) (ART-FPS-FLOAT . 1) (ART-FAT-STRING . 2))) ;NIL for Q-type arrays (SETQ ARRAY-BITS-PER-ELEMENT '((ART-Q . NIL) (ART-STRING . 8) (ART-1B . 1) (ART-2B . 2) (ART-4B . 4) (ART-8B . 8) (ART-16B . 16.) (ART-32B . 24.) (ART-Q-LIST . NIL) (ART-STACK-GROUP-HEAD . NIL) (ART-SPECIAL-PDL . NIL) (ART-HALF-FIX . 16.) (ART-REG-PDL . NIL) (ART-FLOAT . 32.) (ART-FPS-FLOAT . 32.) (ART-FAT-STRING . 16.))) ;FEF HEADER FIELDS (SETQ FEFH-CONSTANT-VALUES '(%FEFH-PC 177777 ;There are 19 available bits in this word! %FEFH-NO-ADL 1_18. %FEFH-FAST-ARG 1_17. %FEFH-SV-BIND 1_16. %%FEFH-PC 0020 %%FEFH-PC-IN-WORDS 0117 %%FEFH-NO-ADL 2201 %%FEFH-FAST-ARG 2101 %%FEFH-SV-BIND 2001)) (ASSIGN-ALTERNATE FEFH-CONSTANT-VALUES) (SETQ FEFH-CONSTANTS (GET-ALTERNATE FEFH-CONSTANT-VALUES)) ;FEF HEADER Q INDEXES (SETQ FEFHI-INDEXES '(%FEFHI-IPC %FEFHI-STORAGE-LENGTH %FEFHI-FCTN-NAME %FEFHI-FAST-ARG-OPT %FEFHI-SV-BITMAP %FEFHI-MISC %FEFHI-SPECIAL-VALUE-CELL-PNTRS)) (SETQ IFEFOFF (1- (LENGTH FEFHI-INDEXES))) ;Q'S IN FIXED ALLOC PART OF FEF (SETQ %FEF-HEADER-LENGTH IFEFOFF) ;BETTER NAME FOR ABOVE (SETQ FEFHI-VALUES '(%%FEFHI-FSO-MIN-ARGS 0606 %%FEFHI-FSO-MAX-ARGS 0006 %%FEFHI-MS-LOCAL-BLOCK-LENGTH 0007 %%FEFHI-MS-ARG-DESC-ORG 0710 %%FEFHI-MS-BIND-DESC-LENGTH 1710 %%FEFHI-MS-DEBUG-INFO-PRESENT 2701 %%FEFHI-SVM-ACTIVE 2601 %FEFHI-SVM-ACTIVE 1_26 %%FEFHI-SVM-BITS 0026 %%FEFHI-SVM-HIGH-BIT 2501)) (SETQ FEFHI-FIELDS (GET-ALTERNATE FEFHI-VALUES)) ;PAGE TABLE STUFF ETC. (SETQ PAGE-VALUES '( ; DEFINITIONS OF FIELDS IN PAGE HASH TABLE ;WORD 1 %%PHT1-SCAVENGER-WS-FLAG %%Q-FLAG-BIT ;IF SET, PAGE IN SCAVENGER WORKING SET. %%PHT1-VIRTUAL-PAGE-NUMBER 1020 ;ALIGNED SAME AS VMA %PHT-DUMMY-VIRTUAL-ADDRESS 177777 ;ALL ONES MEANS THIS IS DUMMY ENTRY ;WHICH JUST REMEMBERS A FREE CORE PAGE %%PHT1-SWAP-STATUS-CODE 0003 %PHT-SWAP-STATUS-NORMAL 1 ;ORDINARY PAGE %PHT-SWAP-STATUS-FLUSHABLE 2 ;SAFELY REUSABLE TO SWAP PAGES INTO ;MAY NEED TO BE WRITTEN TO DISK FIRST %PHT-SWAP-STATUS-PREPAGE 3 ;SAME AS FLUSHABLE, BUT CAME IN VIA PREPAGE %PHT-SWAP-STATUS-AGE-TRAP 4 ;LIKE NORMAL BUT TRYING TO MAKE FLUSHABLE %PHT-SWAP-STATUS-WIRED 5 ;NOT SWAPPABLE %%PHT1-AGE 0302 ;NUMBER OF TIMES AGED %%PHT1-MODIFIED-BIT 0501 ;1 IF PAGE MODIFIED, BUT THE FACT NOT RECORDED ; IN THE MAP-STATUS, BECAUSE IT IS NOMINALLY READ-ONLY ; OR NOMINALLY READ-WRITE-FIRST. %%PHT1-VALID-BIT 0601 ;1 IF THIS HASH TABLE SLOT IS OCCUPIED. ;PHT WORD 2. THIS IS IDENTICAL TO THE LEVEL-2 MAP %%PHT2-META-BITS 1606 ;SEE %%REGION-MAP-BITS %%PHT2-MAP-STATUS-CODE 2403 %PHT-MAP-STATUS-MAP-NOT-VALID 0 ;LEVEL 1 OR 2 MAP NOT SET UP %PHT-MAP-STATUS-META-BITS-ONLY 1 ;HAS META BITS BUT NO PHYSICAL ADDRESS %PHT-MAP-STATUS-READ-ONLY 2 ;GARBAGE COLLECTOR CAN STILL WRITE IN IT %PHT-MAP-STATUS-READ-WRITE-FIRST 3 ;READ/WRITE BUT NOT MODIFIED %PHT-MAP-STATUS-READ-WRITE 4 ;READ/WRITE AND MODIFIED %PHT-MAP-STATUS-PDL-BUFFER 5 ;MAY RESIDE IN PDL BUFFER %PHT-MAP-STATUS-MAR 6 ;MAR SET SOMEWHERE ON THIS PAGE %%PHT2-MAP-ACCESS-CODE 2602 %%PHT2-ACCESS-STATUS-AND-META-BITS 1612 %%PHT2-ACCESS-AND-STATUS-BITS 2404 %%PHT2-PHYSICAL-PAGE-NUMBER 0016 )) (ASSIGN-ALTERNATE PAGE-VALUES) (SETQ PAGE-HASH-TABLE-FIELDS (GET-ALTERNATE PAGE-VALUES)) ;;; See LISPM2;SGDEFS (SETQ STACK-GROUP-HEAD-LEADER-QS '(SG-NAME SG-REGULAR-PDL SG-REGULAR-PDL-LIMIT SG-SPECIAL-PDL SG-SPECIAL-PDL-LIMIT SG-INITIAL-FUNCTION-INDEX SG-UCODE ;END STATIC SECTION, BEGIN DEBUGGING SECTION SG-TRAP-TAG ;SYMBOLIC TAG CORRESPONDING TO SG-TRAP-MICRO-PC. GOTTEN VIA ; MICROCODE-ERROR-TABLE, ETC. PROPERTIES OFF THIS SYMBOL ; DRIVE VARIOUS STAGES IN ERROR RECOVERY, ETC. SG-RECOVERY-HISTORY ;AVAILABLE FOR HAIRY SG MUNGING ROUTINES TO LEAVE TRACKS IN ; FOR DEBUGGING PURPOSES. SG-FOOTHOLD-DATA ;STRUCTURE WHICH SAVES DYNAMIC SECTION OF "REAL" SG WHEN ; EXECUTING IN THE FOOTHOLD. ; LOCATIONS BELOW HERE ARE ACTUALLY LOADED/STORED ON SG-ENTER/SG-LEAVE ;END DEBUGGING SECTION, BEGIN "HIGH LEVEL" SECTION SG-STATE SG-PREVIOUS-STACK-GROUP SG-CALLING-ARGS-POINTER SG-CALLING-ARGS-NUMBER ;SG-FOLLOWING-STACK-GROUP SG-TRAP-AP-LEVEL ;END HIGH-LEVEL SECTION, BEGIN "DYNAMIC" SECTION --BELOW HERE IS SAVED IN ; SG-FOOTHOLD-DATA WHEN %%SG-ST-FOOTHOLD-EXECUTING IS SET. SG-REGULAR-PDL-POINTER SG-SPECIAL-PDL-POINTER SG-AP SG-IPMARK SG-TRAP-MICRO-PC ;PC SAVED FROM OPCS AT MICRO-LOCATION TRAP ; SG-ERROR-HANDLING-SG SG-INTERRUPT-HANDLING-SG ; HAVING THESE BE PART OF THE SG IS BASICALLY A GOOD IDEA, BUT IT ; DOESNT BUY ANYTHING FOR THE TIME BEING AND COSTS A COUPLE OF MICROINSTRUCTIONS SG-SAVED-QLARYH SG-SAVED-QLARYL SG-SAVED-M-FLAGS SG-AC-K SG-AC-S SG-AC-J SG-AC-I SG-AC-Q SG-AC-R SG-AC-T SG-AC-E SG-AC-D SG-AC-C SG-AC-B SG-AC-A SG-AC-ZR SG-AC-2 SG-AC-1 SG-VMA-M1-M2-TAGS SG-SAVED-VMA SG-PDL-PHASE)) ;FIELDS IN SG-STATE Q (SETQ SG-STATE-FIELD-VALUES '(%%SG-ST-CURRENT-STATE 0006 %%SG-ST-FOOTHOLD-EXECUTING 0601 %%SG-ST-PROCESSING-ERROR 0701 %%SG-ST-PROCESSING-INTERRRUPT-REQUEST 1001 %%SG-ST-SAFE 1101 %%SG-ST-INST-DISP 1202 %%SG-ST-IN-SWAPPED-STATE 2601 %%SG-ST-SWAP-SV-ON-CALL-OUT 2501 %%SG-ST-SWAP-SV-OF-SG-THAT-CALLS-ME 2401)) (SETQ SG-STATE-FIELDS (GET-ALTERNATE SG-STATE-FIELD-VALUES)) (SETQ SG-INST-DISPATCHES '( SG-MAIN-DISPATCH ;MAIN INSTRUCTION DISPATCH SG-DEBUG-DISPATCH ;DEBUGGING DISPATCH SG-SINGLE-STEP-DISPATCH ;DISPATCH ONCE, AND THEN BREAK SG-SINGLE-STEP-TRAP ;FOR SEQUENCE BREAKS OUT OF TRAPPING INSTRUCTIONS )) (SETQ SG-STATES '( SG-STATE-ERROR ;0 SHOULD NEVER GET THIS SG-STATE-ACTIVE ;ACTUALLY EXECUTING ON MACHINE. SG-STATE-RESUMABLE ;REACHED BY INTERRUPT OR ERROR RECOVERY COMPLETED ; JUST RESTORE STATE AND DO A UCODE POPJ TO RESUME. SG-STATE-AWAITING-RETURN ;AFTER DOING A "LEGITIMATE" SG-CALL. TO RESUME THIS ; RELOAD SG THEN RETURN A VALUE BY TRANSFERRING TO ; QMEX1. SG-STATE-INVOKE-CALL-ON-RETURN ;TO RESUME THIS, RELOAD SG, THEN SIMULATE ; A STORE IN DESTINATION-LAST. THE ERROR ; SYSTEM CAN PRODUCE THIS STATE WHEN IT WANTS ; TO ACTIVATE THE FOOTHOLD OR PERFORM A RETRY. SG-STATE-INTERRUPTED-DIRTY ;GET THIS IF FORCED TO TAKE AN INTERRUPT AT AN ; INOPPORTUNE TIME. SG-STATE-AWAITING-ERROR-RECOVERY ;IMMEDIATEDLY AFTER ERROR, BEFORE RECOVERY SG-STATE-AWAITING-CALL SG-STATE-AWAITING-INITIAL-CALL SG-STATE-EXHAUSTED)) (SETQ SPECIAL-PDL-LEADER-QS '(SPECIAL-PDL-SG-HEAD-POINTER)) (SETQ REG-PDL-LEADER-QS '(REG-PDL-SG-HEAD-POINTER)) (SETQ PAGE-SIZE 400) (SETQ LENGTH-OF-FASL-TABLE 37773) (SETQ LENGTH-OF-ATOM-HEAD 5) (SETQ SIZE-OF-OB-TBL 177) ;USED BY PRE-PACKAGE INTERN KLUDGE (SETQ SIZE-OF-AREA-ARRAYS 377) ;SIZE OF VARIOUS HARDWARE MEMORIES IN "ADDRESSIBLE LOCATIONS" (SETQ SIZE-OF-HARDWARE-CONTROL-MEMORY 40000) (SETQ SIZE-OF-HARDWARE-DISPATCH-MEMORY 4000) (SETQ SIZE-OF-HARDWARE-A-MEMORY 2000) (SETQ SIZE-OF-HARDWARE-M-MEMORY 40) (SETQ SIZE-OF-HARDWARE-PDL-BUFFER 2000) (SETQ SIZE-OF-HARDWARE-MICRO-STACK 40) (SETQ SIZE-OF-HARDWARE-LEVEL-1-MAP 4000) (SETQ SIZE-OF-HARDWARE-LEVEL-2-MAP 2000) (SETQ SIZE-OF-HARDWARE-UNIBUS-MAP 20) (SETQ A-MEMORY-LOCATION-NAMES '( ;LIST IN ORDER OF CONTENTS OF A-MEMORY STARTING AT 40 %MICROCODE-VERSION-NUMBER ;SECOND FILE NAME OF MICROCODE SOURCE FILE AS A NUMBER %NUMBER-OF-MICRO-ENTRIES ;NUMBER OF SLOTS USED IN MICRO-CODE-ENTRY-AREA DEFAULT-CONS-AREA ;DEFAULT AREA FOR CONS, LIST, ETC. NUMBER-CONS-AREA ;FOR BIGNUMS, BIG-FLOATS, ETC. CAN BE ; EXTRA-PDL-AREA OR JUST REGULAR AREA. %INITIAL-FEF ;POINTER TO FEF OF FUNCTION MACHINE STARTS UP IN %ERROR-HANDLER-STACK-GROUP ;SG TO SWITCH TO ON TRAPS %CURRENT-STACK-GROUP ;CURRENT STACK-GROUP %INITIAL-STACK-GROUP ;STACK-GROUP MACHINE STARTS UP IN %CURRENT-STACK-GROUP-STATE ;SG-STATE Q OF CURRENT STACK GROUP %CURRENT-STACK-GROUP-PREVIOUS-STACK-GROUP ; %CURRENT-STACK-GROUP-CALLING-ARGS-POINTER ; %CURRENT-STACK-GROUP-CALLING-ARGS-NUMBER ; ; %CURRENT-STACK-GROUP-FOLLOWING-STACK-GROUP ; %TRAP-MICRO-PC ;PC GOTTEN OUT OF OPCS BY TRAP %COUNTER-BLOCK-A-MEM-ADDRESS ;LOC OF BEGINNING OF COUNTER BLOCK RELATIVE TO ; A MEMORY AS A FIXNUM. %CHAOS-CSR-ADDRESS ;XBUS ADDRESS %MAR-LOW ;FIXNUM MAR LOWER BOUND (INCLUSIVE) %MAR-HIGH ;FIXNUM MAR UPPER BOUND (INCLUSIVE) ;%%M-FLAGS-MAR-MODE CONTROLS THE ABOVE SELF ;SELF POINTER FOR DTP-INSTANCE, ETC %METHOD-SEARCH-POINTER ;Method list element were last method found. INHIBIT-SCHEDULING-FLAG ;NON-NIL SUPPRESSES SEQUENCE BREAKS INHIBIT-SCAVENGING-FLAG ;NON-NIL TURNS OFF THE SCAVENGER %DISK-RUN-LIGHT ;ADDRESS OF DISK RUN LIGHT, THAT+2 IS PROC RUN LIGHT %LOADED-BAND ;LOW 24 BITS (FIXNUM) OF BOOTED BAND NAME (E.G. "OD3") %DISK-BLOCKS-PER-TRACK ;(FROM LABEL) BLOCKS PER TRACK, USUALLY 17. %DISK-BLOCKS-PER-CYLINDER ;(FROM LABEL) 85. ON T-80, 323. ON T-300 ;THE GARBAGE-COLLECTOR PROCESS HANGS ON THESE VARIABLES %REGION-CONS-ALARM ;COUNTS NEW REGIONS CREATED %PAGE-CONS-ALARM ;COUNTS PAGES ALLOCATED TO REGIONS %GC-FLIP-READY ;If non-NIL, there are no pointers to oldspace %INHIBIT-READ-ONLY ;If non-NIL, you can write in read-only %SCAVENGER-WS-ENABLE ;If non-NIL, scavenger working set hack enabled %METHOD-SUBROUTINE-POINTER ;Continuation point for SELECT-METHOD subroutine ; or NIL. %QLARYH ;Header of last array ref'ed as function %QLARYL ;Element # of last array ref'ed as function %SCHEDULER-STACK-GROUP ;Force call to this on sequence-break. This ;stack group must bind on INHIBIT-SCHEDULING-FLAG as ;part of the stack-group switch for proper operation. %CURRENT-SHEET ;Sheet or screen currently selected by microcode %DISK-SWITCHES ;Fixnum: 1 r/c after read, 2 r/c after write ; 4 enables multiple page swapouts ; was called %READ-COMPARE-ENABLES %MC-CODE-EXIT-VECTOR ;Exit vector used by microcompiled code to ref Q ; quantities. ALPHABETIC-CASE-AFFECTS-STRING-COMPARISON ;If T, upper and lower case are not equal ZUNDERFLOW ;If non-NIL, floating pointer underflow yields zero %GC-GENERATION-NUMBER ;Increments whenever any new oldspace is created. ; Thus if this has changed, objects' addresses ; may have changed. %METER-GLOBAL-ENABLE ;NIL means metering on per stack group basis ;T means all stack groups %METER-BUFFER-POINTER ;Pointer to the buffer as a fixnum %METER-DISK-ADDRESS ;disk address to write out the meter info %METER-DISK-COUNT ;count of disk blocks to write out CURRENTLY-PREPARED-SHEET ;Error checking for the TV:PREPARE-SHEET macro MOUSE-CURSOR-STATE ;0 disabled, 1 open, 2 off, 3 on MOUSE-X ;Relative to mouse-sheet MOUSE-Y MOUSE-CURSOR-X-OFFSET ;From top-left of pattern MOUSE-CURSOR-Y-OFFSET ;to the reference point MOUSE-CURSOR-WIDTH MOUSE-CURSOR-HEIGHT MOUSE-X-SPEED ;100ths per second, time averaged MOUSE-Y-SPEED ;with time constant of 1/6 second MOUSE-BUTTONS-BUFFER-IN-INDEX MOUSE-BUTTONS-BUFFER-OUT-INDEX MOUSE-WAKEUP ;Set to T when move or click LEXICAL-ENVIRONMENT AMEM-EVCP-VECTOR ;Value is an array as long as this list plus 40, ;which holds the EVCP when one of these vars ;is bound by a closure. BACKGROUND-CONS-AREA ;Used for conses that are not explicitly requested ;and shouldn't go in a temp area. )) (SETQ A-MEMORY-COUNTER-BLOCK-NAMES '( %COUNT-FIRST-LEVEL-MAP-RELOADS ;# FIRST LEVEL MAP RELOADS %COUNT-SECOND-LEVEL-MAP-RELOADS ;# SECOND LEVEL MAP RELOADS %COUNT-PDL-BUFFER-READ-FAULTS ;# TOOK PGF AND DID READ FROM PDL-BUFFER %COUNT-PDL-BUFFER-WRITE-FAULTS ;# TOOK PGF AND DID WRITE TO PDL-BUFFER %COUNT-PDL-BUFFER-MEMORY-FAULTS ;# TOOK PGF FOR PDL-BUF, BUT DATA IN MAIN MEM. %COUNT-DISK-PAGE-READS ;COUNT OF PAGES READ FROM DISK %COUNT-DISK-PAGE-WRITES ;COUNT OF PAGES WRITTEN TO DISK %COUNT-DISK-ERRORS ;COUNT OF RECOVERABLE ERRS %COUNT-FRESH-PAGES ;COUNT OF FRESH PAGES ; GENERATED IN CORE INSTEAD OF READ FROM DISK %COUNT-AGED-PAGES ;NUMBER OF TIMES AGER SET AGE TRAP %COUNT-AGE-FLUSHED-PAGES ;NUMBER OF TIMES AGE TRAP -> FLUSHABLE %COUNT-DISK-READ-COMPARE-REWRITES ;COUNT OF WRITES REDONE DUE TO FAILURE TO READ-COMPARE %COUNT-DISK-RECALIBRATES ;DUE TO SEEK ERRORS %COUNT-META-BITS-MAP-RELOADS ;# SECOND LEVEL MAP RELOADS TO META-BITS-ONLY %COUNT-CHAOS-TRANSMIT-ABORTS ;Number of transmit aborts in microcode %COUNT-DISK-READ-COMPARE-DIFFERENCES ;Number of read-compare differences without ; accompanying disk read error %COUNT-CONS-WORK ;GC parameter %COUNT-SCAVENGER-WORK ;.. %TV-CLOCK-RATE ;TV frame rate divided by this is seq brk clock %AGING-DEPTH ;Number of laps to age a page. Don't make > 3!! %COUNT-DISK-ECC-CORRECTED-ERRORS ;Number of soft ECC errors %COUNT-FINDCORE-STEPS ;Number of iterations finding mem to swap out %COUNT-FINDCORE-EMERGENCIES ;Number of times FINDCORE had to age all pages %COUNT-DISK-READ-COMPARE-REREADS ;Reads done over due to r/c diff or error %COUNT-DISK-PAGE-READ-OPERATIONS ;Read operations (count once even if multipage) %COUNT-DISK-PAGE-WRITE-OPERATIONS ;Write operations (count once even if multipage) %COUNT-DISK-PAGE-WRITE-WAITS ;Waiting for a page to get written, to reclaim core %COUNT-DISK-PAGE-WRITE-BUSYS ;Waiting for a page to get written, to use disk %COUNT-DISK-PREPAGES-USED ;Counts prepaged pages that were wanted %COUNT-DISK-PREPAGES-NOT-USED ;Counts prepaged pages that were reclaimed %DISK-ERROR-LOG-POINTER ;Address of next 4-word block in 600-637 %DISK-WAIT-TIME ;Microseconds of waiting for disk time %COUNT-DISK-PAGE-WRITE-APPENDS ;Pages appended to swapout operations. %COUNT-DISK-PAGE-READ-APPENDS ;Pages appended to swapin operations. )) (SETQ M-MEMORY-LOCATION-NAMES ;M-MEM LOCNS ARE ASSIGNED PIECEMEAL.. '(%MODE-FLAGS %SEQUENCE-BREAK-SOURCE-ENABLE %METER-MICRO-ENABLES)) (PUTPROP '%MODE-FLAGS (+ A-MEMORY-VIRTUAL-ADDRESS 26) 'FORWARDING-VIRTUAL-ADDRESS) (PUTPROP '%SEQUENCE-BREAK-SOURCE-ENABLE (+ A-MEMORY-VIRTUAL-ADDRESS 34) 'FORWARDING-VIRTUAL-ADDRESS) (PUTPROP '%METER-MICRO-ENABLES (+ A-MEMORY-VIRTUAL-ADDRESS 35) 'FORWARDING-VIRTUAL-ADDRESS) (SETQ DISK-RQ-LEADER-QS '(%DISK-RQ-LEADER-N-HWDS ;NUMBER HALFWORDS REALLY USED ; ON FIRST PAGE BEFORE CCW LIST. %DISK-RQ-LEADER-N-PAGES ;NUMBER OF BUFFER PAGES ALLOCATED %DISK-RQ-LEADER-BUFFER ;DISPLACED ART-16B ARRAY TO BUFFER PGS %DISK-RQ-LEADER-THREAD ;LINK TO NEXT FREE RQB %DISK-RQ-LEADER-8-BIT-BUFFER) ;DISPLACED ART-8B ARRAY. DISK-RQ-HWDS '(%DISK-RQ-DONE-FLAG ;0 RQ ENTERED, -1 COMPLETED %DISK-RQ-DONE-FLAG-HIGH ;; These are set up by the requester %DISK-RQ-COMMAND ;DISK COMMAND REGISTER %DISK-RQ-COMMAND-HIGH %DISK-RQ-CCW-LIST-POINTER-LOW ;CLP LOW 16 %DISK-RQ-CCW-LIST-POINTER-HIGH ;CLP HIGH 6 %DISK-RQ-SURFACE-SECTOR ;DISK ADDRESS REG LOW %DISK-RQ-UNIT-CYLINDER ;DISK ADDRESS REG HIGH ;; These are stored when the operation completes %DISK-RQ-STATUS-LOW ;DISK STATUS REG LOW 16 %DISK-RQ-STATUS-HIGH ;DISK STATUS REG HIGH 16 %DISK-RQ-MEM-ADDRESS-LOW ;LAST MEM REF ADDR LOW 16 %DISK-RQ-MEM-ADDRESS-HIGH ;LAST MEM REF ADDR HIGH 6 %DISK-RQ-FINAL-SURFACE-SECTOR ;DISK ADDRESS REG LOW %DISK-RQ-FINAL-UNIT-CYLINDER ;DISK ADDRESS REG HIGH %DISK-RQ-ECC-POSITION %DISK-RQ-ECC-PATTERN %DISK-RQ-CCW-LIST) ;CCW list customarily starts here DISK-HARDWARE-VALUES '( %%DISK-STATUS-HIGH-BLOCK-COUNTER 1010 %%DISK-STATUS-HIGH-INTERNAL-PARITY 0701 %%DISK-STATUS-HIGH-READ-COMPARE-DIFFERENCE 0601 %%DISK-STATUS-HIGH-CCW-CYCLE 0501 %%DISK-STATUS-HIGH-NXM 0401 %%DISK-STATUS-HIGH-MEM-PARITY 0301 %%DISK-STATUS-HIGH-HEADER-COMPARE 0201 %%DISK-STATUS-HIGH-HEADER-ECC 0101 %%DISK-STATUS-HIGH-ECC-HARD 0001 %DISK-STATUS-HIGH-ERROR 237 ;Mask for bits which are errors normally %%DISK-STATUS-LOW-ECC-SOFT 1701 %%DISK-STATUS-LOW-OVERRUN 1601 %%DISK-STATUS-LOW-TRANSFER-ABORTED 1501 %%DISK-STATUS-LOW-START-BLOCK-ERROR 1401 %%DISK-STATUS-LOW-TIMEOUT 1301 %%DISK-STATUS-LOW-SEEK-ERROR 1201 %%DISK-STATUS-LOW-OFF-LINE 1101 %%DISK-STATUS-LOW-OFF-CYLINDER 1001 %%DISK-STATUS-LOW-READ-ONLY 0701 %%DISK-STATUS-LOW-FAULT 0601 %%DISK-STATUS-LOW-NO-SELECT 0501 %%DISK-STATUS-LOW-MULTIPLE-SELECT 0401 %%DISK-STATUS-LOW-INTERRUPT 0301 %%DISK-STATUS-LOW-SEL-UNIT-ATTENTION 0201 %%DISK-STATUS-LOW-ATTENTION 0101 %%DISK-STATUS-LOW-READY 0001 %DISK-STATUS-LOW-ERROR 177560 ;Mask for bits which are errors normally %DISK-COMMAND-DONE-INTERRUPT-ENABLE 1_11. %DISK-COMMAND-ATTENTION-INTERRUPT-ENABLE 1_10. ;Trident only %DISK-COMMAND-RECALIBRATE 10001005 %DISK-COMMAND-FAULT-CLEAR 10000405 ;Recalibrate on Marksman %DISK-COMMAND-DATA-STROBE-LATE 200 ;These are all different on Marksman %DISK-COMMAND-DATA-STROBE-EARLY 100 ;.. %DISK-COMMAND-SERVO-OFFSET 40 ;.. %DISK-COMMAND-SERVO-OFFSET-FORWARD 20 ;.. %DISK-COMMAND-READ 0 %DISK-COMMAND-READ-COMPARE 10 %DISK-COMMAND-WRITE 11 %DISK-COMMAND-READ-ALL 2 %DISK-COMMAND-WRITE-ALL 13 %DISK-COMMAND-SEEK 20000004 %%DISK-COMMAND-SEEK-CYLINDER 3010 ;Only used by Marksman %DISK-COMMAND-AT-EASE 5 ;Get status on Marksman %DISK-COMMAND-OFFSET-CLEAR 6 ;NOP on marksman %DISK-COMMAND-RESET-CONTROLLER 16)) ;Marksman also has get-status commands, not listed here. (ASSIGN-VALUES DISK-RQ-LEADER-QS 0) (ASSIGN-VALUES DISK-RQ-HWDS 0) (ASSIGN-ALTERNATE DISK-HARDWARE-VALUES) (SETQ DISK-HARDWARE-SYMBOLS (GET-ALTERNATE DISK-HARDWARE-VALUES)) ;;; Definitions for interrupt-driven Unibus input channels ;;; Note that these start at 1 rather than at 0, to leave room for an array header (SETQ UNIBUS-CHANNEL-QS '( %UNIBUS-CHANNEL-LINK ;Address of next or 0 to end list %UNIBUS-CHANNEL-VECTOR-ADDRESS ;Interrupt vector address of device %UNIBUS-CHANNEL-CSR-ADDRESS ;Virtual address of status register %UNIBUS-CHANNEL-CSR-BITS ;Bits which must be on in CSR %UNIBUS-CHANNEL-DATA-ADDRESS ;Virtual address of data register(s) ;The %%Q-FLAG bit means there are 2 data regs %UNIBUS-CHANNEL-BUFFER-START ;Start address of buffer %UNIBUS-CHANNEL-BUFFER-END ;End address+1 of buffer %UNIBUS-CHANNEL-BUFFER-IN-PTR ;Address of next word to store ;The flag bit enables seq breaks per channel. %UNIBUS-CHANNEL-BUFFER-OUT-PTR ;Address of next word to extract ;**this last does not really exist now. It should be carried thru on the next cold load. ; It is required for the non-local unibus hack to work in general, altho we can get along ; without it for the time being since the keyboard is always interrupt enabled.** %UNIBUS-CHANNEL-INTERRUPT-ENABLE-BITS ;Bit(s) in CSR which enable interrupts. %UNIBUS-CHANNEL-OUTPUT-TURNOFF-ADDRESS ;Address to write to shut down output channel %UNIBUS-CHANNEL-OUTPUT-TURNOFF-BITS)) ;Value to write into that address (ASSIGN-VALUES-INIT-DELTA UNIBUS-CHANNEL-QS 0 1 1) ;;; Definitions for Chaos net hardware and microcode ;;; Command/Status register fields (SETQ CHAOS-HARDWARE-VALUES '( %%CHAOS-CSR-TIMER-INTERRUPT-ENABLE 0001 %%CHAOS-CSR-LOOP-BACK 0101 %%CHAOS-CSR-RECEIVE-ALL 0201 %%CHAOS-CSR-RECEIVER-CLEAR 0301 %%CHAOS-CSR-RECEIVE-ENABLE 0401 %%CHAOS-CSR-TRANSMIT-ENABLE 0501 %%CHAOS-CSR-INTERRUPT-ENABLES 0402 %%CHAOS-CSR-TRANSMIT-ABORT 0601 %%CHAOS-CSR-TRANSMIT-DONE 0701 %%CHAOS-CSR-TRANSMITTER-CLEAR 1001 %%CHAOS-CSR-LOST-COUNT 1104 %%CHAOS-CSR-RESET 1501 %%CHAOS-CSR-CRC-ERROR 1601 %%CHAOS-CSR-RECEIVE-DONE 1701 ;;; Offsets of other registers from CSR ;;; These are in words, not bytes %CHAOS-MY-NUMBER-OFFSET 1 %CHAOS-WRITE-BUFFER-OFFSET 1 %CHAOS-READ-BUFFER-OFFSET 2 %CHAOS-BIT-COUNT-OFFSET 3 %CHAOS-START-TRANSMIT-OFFSET 5)) ;;; Leader of a wired Chaos buffer (SETQ CHAOS-BUFFER-LEADER-QS '( %CHAOS-LEADER-WORD-COUNT ;Fill pointer for ART-16B array %CHAOS-LEADER-THREAD ;Next buffer in wired list (free, rcv, xmt) ;NIL for end of list %CHAOS-LEADER-CSR-1 ;Receive stores CSR before reading out here %CHAOS-LEADER-CSR-2 ;Receive stores CSR after reading out here ;Get lost-count from here %CHAOS-LEADER-BIT-COUNT)) ;Receive stores bit-count before reading out (ASSIGN-VALUES CHAOS-BUFFER-LEADER-QS 0) (ASSIGN-ALTERNATE CHAOS-HARDWARE-VALUES) (SETQ CHAOS-HARDWARE-SYMBOLS (GET-ALTERNATE CHAOS-HARDWARE-VALUES)) ;;; Ethernet ;;; Offsets from the base of the ether registers to the specific registers (setq ether-register-offsets '( %ether-mode-offset ;0 %ether-int-source-offset ;1 %ether-int-mask-offset ;2 %ether-ipgt-offset ;3 %ether-ipgr1-offset ;4 %ether-ipgr2-offset ;5 %ether-packetlen-offset ;6 %ether-collconf-offset ;7 %ether-tx-bd-num-offset ;8 %ether-ctrlmode-offset ;9 %ether-mii-mode-offset ;10 %ether-mii-command-offset ;11 %ether-mii-address-offset ;12 %ether-mii-tx-data-offset ;13 %ether-mii-rx-data-offset ;14 %ether-mii-status-offset ;15 %ether-mac-address0-offset ;16 %ether-mac-address1-offset ;17 %ether-hash0-offset ;18 %ether-hash1-offset ;19 %ether-txctrl-offset ;20 )) (si:assign-values ether-register-offsets 0) ;;; Offsets of the leader elements (setq ether-buffer-leader-qs '( %ether-leader-thread ;0 %ether-leader-active-length ;1 )) (si:assign-values ether-buffer-leader-qs 0) (setq ether-hardware-values '( %%ether-desc-length 2020 %%ether-desc-tx-ready 1701 %%ether-desc-tx-irq 1601 %%ether-desc-tx-wrap 1501 %%ether-desc-tx-pad 1401 %%ether-desc-tx-crc 1301 %%ether-desc-rx-empty 1701 %%ether-desc-rx-irq 1601 %%ether-desc-rx-wrap 1501 %%ether-mode-recsmall 2001 %%ether-mode-pad 1701 %%ether-mode-hugen 1601 %%ether-mode-crc-enable 1501 %%ether-mode-fullduplex 1201 %%ether-mode-promiscuous 0501 %%ether-mode-no-preamble 0201 %%ether-mode-tx-enable 0101 %%ether-mode-rx-enable 0001 %%ether-int-rxc 0601 %%ether-int-txc 0501 %%ether-int-busy 0401 %%ether-int-rxe 0301 %%ether-int-rxb 0201 %%ether-int-txe 0101 %%ether-int-txb 0001 )) (si:assign-alternate ether-hardware-values) (setq ether-hardware-symbols (si:get-alternate ether-hardware-values)) (SETQ A-MEMORY-ARRAY-LOCATIONS '( MOUSE-CURSOR-PATTERN 1600 MOUSE-BUTTONS-BUFFER 1640 MOUSE-X-SCALE-ARRAY 1700 MOUSE-Y-SCALE-ARRAY 1720)) (SETQ A-MEMORY-ARRAY-SYMBOLS (GET-ALTERNATE A-MEMORY-ARRAY-LOCATIONS)) ;Use of DTP-INSTANCE. Points to a structure whose header is of ;type DTP-INSTANCE-HEADER; the pointer field of that header points ;to a structure (generally an array) which contains the fields described ;below. This structure is called an instance-descriptor and contains ;the constant or shared part of the instance. The instance structure, ;after its DTP-INSTANCE-HEADER, contains several words used as value ;cells of instance variables, which are the variable or unshared ;part of the instance. ;Note that these are offsets, not indices into the array. They ;are defined here this way because microcode uses them. This could ;be a cdr-coded list or an instance rather than an array. (SETQ INSTANCE-DESCRIPTOR-OFFSETS '( %INSTANCE-DESCRIPTOR-HEADER ;The array header. %INSTANCE-DESCRIPTOR-RESERVED ;e.g. for named-structure symbol %INSTANCE-DESCRIPTOR-SIZE ;The size of the instance; this is one more ;than the number of instance-variable slots. ;This is looked at by the garbage collector. %INSTANCE-DESCRIPTOR-BINDINGS ;Describes bindings to perform when the instance ;is called. If this is a list, then SELF is bound ;to the instance and the elements of the list are ;locatives to cells which are bound to EVCP's ;to successive instance-variable slots of the ;instance. If this is not a list, it is something ;reserved for future facilities based on the same ;primitives. NIL is a list. ;Note that if this is a list, it must be CDR-CODED! ;The microcode depends on this for a little extra speed. %INSTANCE-DESCRIPTOR-FUNCTION ;Function to be called when the instance ; is called. Typically a DTP-SELECT-METHOD %INSTANCE-DESCRIPTOR-TYPENAME ;A symbol which is returned by TYPEP )) ;Additional slots may exist, defined by the particular class system employed. ;If the instance-descriptor is an array, it must not be so long as to ;contain a long-length Q. (ASSIGN-VALUES INSTANCE-DESCRIPTOR-OFFSETS 0) (SETQ METER-ENABLES-VALUES '( %%METER-PAGE-FAULT-ENABLE 0001 ;Page fault metering %%METER-CONS-ENABLE 0101 ;Cons metering %%METER-FUNCTION-ENTRY-EXIT-ENABLE 0201 ;Function call metering %%METER-STACK-GROUP-SWITCH-ENABLE 0301 ;Stack group metering ) METER-EVENTS '( %METER-PAGE-IN-EVENT %METER-PAGE-OUT-EVENT %METER-CONS-EVENT %METER-FUNCTION-ENTRY-EVENT %METER-FUNCTION-EXIT-EVENT %METER-FUNCTION-UNWIND-EVENT %METER-STACK-GROUP-SWITCH-EVENT )) (ASSIGN-ALTERNATE METER-ENABLES-VALUES) (SETQ METER-ENABLES (GET-ALTERNATE METER-ENABLES-VALUES)) (ASSIGN-VALUES METER-EVENTS 0 1) (DEFUN ASSIGN-QCOM-VALUES NIL (ASSIGN-VALUES ADI-KINDS 0) (ASSIGN-VALUES ADI-STORING-OPTIONS 0) (ASSIGN-ALTERNATE ARG-DESC-FIELD-VALUES) (ASSIGN-ALTERNATE ARRAY-FIELD-VALUES) (ASSIGN-ALTERNATE ARRAY-LEADER-FIELD-VALUES) (ASSIGN-ALTERNATE ARRAY-MISC-VALUES) (ASSIGN-VALUES ARRAY-TYPES 19.) (ASSIGN-VALUES DATA-TYPES 24.) (ASSIGN-VALUES FEF-ARG-SYNTAX 4) (ASSIGN-VALUES FEF-DES-DT 11) (ASSIGN-VALUES FEF-FUNCTIONAL 15) (ASSIGN-VALUES FEF-INIT-OPTION 0) (ASSIGN-VALUES FEF-NAME-PRESENT 20) (ASSIGN-VALUES FEF-QUOTE-STATUS 7) (ASSIGN-VALUES FEF-SPECIALNESS 16) (ASSIGN-VALUES FEFHI-INDEXES 0) (ASSIGN-ALTERNATE FEFHI-VALUES) (ASSIGN-ALTERNATE HEADER-FIELD-VALUES) (ASSIGN-VALUES HEADER-TYPES 23) (ASSIGN-VALUES Q-CDR-CODES 0) (ASSIGN-VALUES Q-DATA-TYPES 0) (ASSIGN-VALUES Q-HEADER-TYPES 0) (ASSIGN-ALTERNATE SG-STATE-FIELD-VALUES) (ASSIGN-VALUES SG-STATES 0) (ASSIGN-VALUES SG-INST-DISPATCHES 0) (ASSIGN-VALUES SPECIAL-PDL-LEADER-QS 0) (ASSIGN-VALUES STACK-GROUP-HEAD-LEADER-QS 0) (ASSIGN-VALUES SYSTEM-COMMUNICATION-AREA-QS 0) (ASSIGN-VALUES REG-PDL-LEADER-QS 0) ) (ASSIGN-QCOM-VALUES) ;FOO. ASSIGN-VALUES, ETC HAD BETTER BE DEFINED.