Added support for LISP interpreter and runtime (autoloaded files only).

src/l/gcbib.bug

@@ -0,0 +1,26 @@
+;;;-*-LISP-*-
+;;; At least this bug should be documented, if not fixed.
+;;; 11:53am  Friday, 12 June 1981 -GJC
+
+(SETQ GC-BUG
+      '(
+	(SETQ A (*ARRAY NIL T 1000))
+	(SETQ B (*ARRAY NIL T 1000))
+	(comment For keeping a non-marked pointer to A and B)
+	(ARRAY K NIL 10)
+	(comment Give a pointer to itself)
+	(STORE (ARRAYCALL T A 0) A)
+	(comment Stash the arrays for the experiment)
+	(STORE (K 0) A)
+	(STORE (K 1) B)
+	(SETQ A NIL)
+	(SETQ B NIL)))
+
+
+(DEFUN GC-BUG ()
+  (MAPC 'EVAL GC-BUG)
+  (comment The GC should reclaim both arrays)
+  (comment But look at the contents of k)
+  (comment (K 1) is reclaimed but (K 0) is not)
+  (GC)
+  (LIST (K 0) (K 1)))

src/l/macs.80

@@ -0,0 +1,621 @@
+;;;   -*-MIDAS-*-
+;;;   **************************************************************
+;;;   ***** MACLISP *** RANDOM MIDAS MACROS FOR USE IN LISP SOURCE *
+;;;   **************************************************************
+;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
+;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
+;;;   **************************************************************
+
+SUBTTL	RANDOM MACROS
+
+
+;;; MACRO TO REMOVE SYMBOLS OF THE FORM "GXXXXX"
+
+DEFINE GEXPUN
+DEFFLUSH
+.GSSET 0
+STPFL==0
+.TAG FOO	FLUSH
+IFE STPFL, .GO FOO
+TERMIN
+
+DEFINE DEFFLUSH \SYM
+DEFINE FLUSH \ZZX
+IFSE SYM,ZZX, STPFL==1
+EXPUNGE ZZX
+TERMIN
+TERMIN
+
+
+DEFINE HAOLNG NM,N
+	RADIX 2
+	NM==HAOWNG \N
+	RADIX 8
+TERMIN
+
+DEFINE HAOWNG A
+.LENGTH /A/
+TERMIN
+
+
+DEFINE MAYBE DEF
+IF1,[
+IRPS SYM,,[DEF]
+IFNDEF SYM, DEF
+.ISTOP
+TERMIN
+]
+TERMIN
+
+
+DEFINE TBLCHK START,LENGT
+IFN .-<START>-<LENGT>, WARN [WRONG LENGTH TABLE]
+TERMIN
+
+DEFINE NFFTBCK START
+IFN .-<START>-NFF, WARN START,[-- WRONG LENGTH TABLE]
+TERMIN
+
+
+;;; "POP IMMEDIATE" MACRO TRIES TO DECREMENT A PDL POINTER IN THE BEST WAY.
+
+DEFINE POPI <AC,N>
+;; IFN KL10, ADJSP AC,-<N>		.STOP
+IFDEF R70, IFDEF LR70, IFL <N>-LR70,  SUB AC,R70+<N>	.STOP
+	SUB AC,[<N>,,<N>]
+TERMIN
+
+
+;;; "PUSH N SLOTS" MACRO PUSHES ZERO WORDS ONTO A PDL.
+
+DEFINE PUSHN <AC,N>
+IFE <N>, .STOP
+IFE <N>-1, PUSH AC,R70		.STOP
+IFE AC-P,{
+	PUSHN1 P,N,NPUSH
+.STOP}
+IFE AC-FXP,{
+	PUSHXN N
+.STOP}
+IFE AC-FLP,{
+	PUSHN1 FLP,N,0.0PUSH
+.STOP}
+	WARN [PUSH AC,N   UNKNOWN PDL]
+TERMIN
+
+DEFINE PUSHXN <N>\ZZZ
+ZZZ==<N>-40
+IFGE ZZZ,[
+	JSP T,40PUSH
+	PUSHXN \ZZZ
+]
+IFL ZZZ, PUSHN1 FXP,N,0PUSH
+TERMIN
+
+
+DEFINE PUSHN1 <AC,M,XPUSH>
+IFLE <M>-N!XPUSH,  JSP T,XPUSH-<M>	.STOP
+	JSP T,XPUSH-N!XPUSH
+	PUSHN1 AC,<M-N!XPUSH>,XPUSH
+TERMIN
+
+
+
+SUBTTL $LOSEG, $HISEG, 
+
+IFN D10,[
+
+IFN HISEGMENT,[
+DEFINE $LOSEG	;MACRO TO SWITCH TO LOW SEGMENT FOR 2SEG ASSEMBLY
+IFN %LOSEG+1,[
+%HISEG==.-HILOC
+LOC FIRSTLOC+%LOSEG
+%LOSEG==-1
+CURSTD==STDLO
+]		;END OF IFN %LOSEG+1
+.ELSE WARN [ALREADY IN LOW SEGMENT]
+TERMIN
+
+DEFINE $HISEG	;MACRO TO SWITCH TO HIGH SEGMENT FOR 2SEG ASSEMBLY
+IFN %HISEG+1,[
+%LOSEG==.-FIRSTLOC
+LOC HILOC+%HISEG
+%HISEG==-1
+CURSTD==STDHI
+]		;END OF IFN %HISEG+1
+.ELSE WARN [ALREADY IN HIGH SEGMENT]
+TERMIN
+]	;END IFN HISEGMENT
+IFE HISEGMENT,[
+DEFINE $LOSEG
+TERMIN
+DEFINE $HISEG
+TERMIN
+]	;END IFE HISEGMENT
+]		;END OF IFN D10
+
+
+
+
+SUBTTL PIONAGAIN, PIPAUSE, PION, TICCMAP
+
+IFN ITS,[
+
+DEFINE PISTOP
+	.SUSET PIHOLD
+TERMIN
+DEFINE PIPAUSE			;DISABLE INTERRUPT SYSTEM
+	.SUSET PIHOLD
+TERMIN
+
+DEFINE PIONAGAIN
+	.SUSET PINBL
+TERMIN
+
+DEFINE PION
+	.SUSET PINBL
+TERMIN
+
+]		;END OF IFN ITS
+
+IFN D20,[
+DEFINE PISTOP
+	MOVEI 1,.FHSLF		;DEFER ALL INTERRUPTS
+	SETO 2,
+	DIC
+	SETOM INTALL		;FLAG THAT ALL INTERRUPTS HAVE BEEN DISABLED
+TERMIN
+]	;END IFN D20
+
+IFN D10,[
+DEFINE PISTOP
+SA$	INTMSK R70		;MASK OFF ALL INTERRUPTS
+SA%	SETZ 1,
+SA%	APRENB 1,
+	SETOM INTALL		;FLAG THAT ALL INTERRUPTS HAVE BEEN DISABLED
+TERMIN
+]	;END IFN D10
+
+IFN D10\D20,[
+
+DEFINE PIPAUSE
+	PUSHJ P,DALINT
+TERMIN
+
+DEFINE PIONAGAIN
+	PUSHJ P,REAINT
+TERMIN
+
+DEFINE PION
+	PUSHJ P,ENBINT
+TERMIN
+
+]	;END OF IFN D10\D20
+
+
+IFN D20,[
+;DO THE "BODY' WITH "CODE" SUCCESSIVELY SET TO TERMINAL-INTERRUPT-CONTROL OPTIONS
+DEFINE TICMAP {BODY}
+IRP CODE,,[CB,CD,CG,CW,CX,CZ,CA,CV,CE,CF]
+	BODY
+TERMIN
+TERMIN
+]	;END OF IFN D20
+
+
+
+SUBTTL FUMBLE, STUMBLE, AND GRUMBLE
+
+
+DEFINE FUMBLE FF,RIDER,SPECS		;FOR SPACES
+STUMBLE FUMBLE,FF,RIDER,0,SEGSIZ,[SPECS]
+TERMIN
+
+DEFINE GRUMBLE PDL,RIDER,SPECS	;FOR PDLS
+STUMBLE GRUMBLE,PDL,RIDER,20,100,[SPECS]
+TERMIN
+
+DEFINE STUMBLE NAME,FF,RIDER=[IFE 0],LO,HI,%SPECS
+ZZZ==0
+IRP SPEC,,[%SPECS]
+IRP COND,VALS,[SPEC]
+IFN COND,[
+IRP M,,[MIN,MAX]Q,,[LO,HI]V,,VALS
+RIDER,[
+IFL V-Q, M!!FF==:Q
+.ELSE M!!FF==:V
+]
+.ELSE M!!FF==:0
+TERMIN
+ZZZ==ZZZ+1
+]
+.ISTOP
+TERMIN
+TERMIN
+IFN ZZZ-1, WARN \ZZZ,[ SPECS SUCCEEDED FOR NAME FF]
+EXPUNGE ZZZ
+TERMIN
+
+
+SUBTTL PGBOT, [PGTOP], PAGEUP, SEGUP, SPCBOT, SPCTOP
+
+;;; NOTE THAT PGBOT DEFINES PGTOP FOR THE NEXT USE, WHILE
+;;; PGTOP IS AUTO-EXPUNGING (AND VICE VERSA).
+
+DEFINE DPGBOT
+   DEFINE PGBOT SPC
+      PGTPMK==.
+      DEFINE PGBOT SPC1
+         WARN [ILLEGAL PGBOT SPC1]
+      TERMIN
+      DEFINE PGTOP SPC1,CRUFT
+         IFSN SPC1,SPC, WARN [PGTOP SPC1 DOESN'T MATCH PGBOT SPC]
+         CONC CPG,\NPGTPS,:	CONSTANTS
+         CONC ECPG,\NPGTPS,::
+         PGTOP1 \NPGTPS,\.-PGTPMK,[CRUFT]
+         NPGTPS==NPGTPS+1
+         DPGBOT
+      TERMIN
+   TERMIN
+   DEFINE PGTOP SPC,CRUFT
+      WARN [ILLEGAL PGTOP SPC,CRUFT]
+   TERMIN
+TERMIN
+
+DPGBOT
+
+DEFINE PGTOP1 N,SIZE,STUFF
+PRINTX 	P!N:  SIZE	[STUFF]
+
+TERMIN
+
+.XCREF PGTOP1
+
+DEFINE PAGEUP
+REL$ LOC .RL1+<<.-.RL1+CURSTD+PAGSIZ-1>&PAGMSK>-CURSTD
+REL% LOC <<.-CURSTD+PAGSIZ-1>&PAGMSK>-CURSTD
+TERMIN
+
+DEFINE SEGUP PT
+REL$ LOC .RL1+<<PT-.RL1+CURSTD+SEGSIZ-1>&SEGMSK>-CURSTD
+REL% LOC <<PT+CURSTD+SEGSIZ-1>&SEGMSK>-CURSTD
+TERMIN
+
+
+
+
+DEFINE SPCBOT SPC
+REL$ ZZ==.-.RL1
+REL% ZZ==.
+ZZY==.TYPE B!SPC!SG
+IFN <17-ZZY>*<3-ZZY>*<11-ZZY>,[
+IFN B!SPC!SG-., WARN [FORMERLY B!SPC!SG=]\B!SPC!SG,[, BUT NOW B!SPC!SG=]\ZZ
+]
+IFN <ZZ+CURSTD>&SEGKSM, WARN \ZZ+CURSTD,[=BAD BOUNDARY FOR B!SPC!SG]
+B!SPC!SG==.
+TERMIN
+
+;;; NOTE WELL! ZZW MUST BE SAFE ACROSS THE SPCTOP MACRO
+
+DEFINE SPCTOP SPC,TYP,CRUFT
+ZZ==.
+SEGUP .
+ZZX==<.-B!SPC!SG>/SEGSIZ
+ZZY==.TYPE N!SPC!SG
+IFN <17-ZZY>*<3-ZZY>*<11-ZZY>,[
+IFN N!SPC!SG-ZZX, WARN [FORMERLY N!SPC!SG=]\N!SPC!SG,[, BUT NOW N!SPC!SG=]\ZZX
+]
+N!SPC!SG==ZZX
+IFL ZZX-5, SPCTP1 \ZZX,[CRUFT]\<.-ZZ>
+IFGE ZZX-5, SPCTP2 \ZZX,[CRUFT]\<.-ZZ>
+TERMIN
+
+DEFINE SPCTP1 N,CRUFT,U
+IRP Q,,[0,1,2,3,4]R,,[ZERO,ONE,TWO,THREE,FOUR]
+IFE N-Q,[
+PRINTX 	***** R CRUFT SEGMENT
+IFN N-1, PRINTX \S\
+IFN U, PRINTX \ [U UNUSED WORDS]\
+PRINTX \
+\
+]
+IFE N-Q, .ISTOP
+TERMIN
+TERMIN
+
+DEFINE SPCTP2 N,CRUFT,U
+IRP Q,,[5,6,7,10,11,12,13,14,15,16,17,20,21,22
+23,24,N]R,,[FIVE,SIX,SEVEN,EIGHT,NINE,TEN
+ELEVEN,TWELVE,THIRTEEN,FOURTEEN,FIFTEEN,SIXTEEN,SEVENTEEN
+EIGHTEEN,NINETEEN,TWENTY,N (OCTAL)]
+IFE N-Q,[
+PRINTX 	***** R CRUFT SEGMENT
+IFN N-1, PRINTX \S\
+IFN U, PRINTX \ [U UNUSED WORDS]\
+PRINTX \
+\
+]
+IFE N-Q, .ISTOP
+TERMIN
+TERMIN
+
+
+.XCREF SPCTP1 SPCTP2
+
+
+
+SUBTTL PURTRAP, IOCTRAP, 2DIF, AND INTPRO MACROS
+
+;;; FEATURE FOR AUTOMATIC TRAPOUT ON PURE PAGE VIOLATIONS
+;;; STANDARD USAGE IS TO REPLACE
+;;;		MOVEM X,Y	;COULD CAUSE PURE PAGE TRAP
+;;; WITH
+;;;	PURTRAP PATCH-LOC,AC,	MOVEM X,Y
+;;; IF THE INSTRUCTION CAUSES A PURE PAGE VIOLATION,
+;;; THEN THE PURE PAGE TRAP HANDLER WILL TRANSFER TO FOO,
+;;; WITH ALL ACS, ETC. INTACT (HOPEFULLY), RATHER THAN
+;;; ERRORING OUT, WHICH IS THE DEFAULT. SEE PURPGI.
+;;; FOR DEC-10, THERE IS AN EXPLICIT CHECK FOR TRYING TO CLOBBER 
+;;; THE HISEG.
+
+;;; A SIMILAR FEATURE FOR IOC TRAPS
+;;; STANDARD USAGE IS:
+;;;
+;;;	BAR:	XCT D		;D HAS .IOT
+;;;	   IOCTRAP TT,FOO,N	;N IS OPTIONAL
+;;;		<MORE CODE>
+;;;
+;;; IF THE INSTRUCTION AT BAR CAUSES AN IOC ERROR,
+;;; THEN THE IOC ERROR CODE IS PUT INTO ACCUMULATOR TT,
+;;; AND CONTROL TRANSFERRED TO FOO WITH ALL OTHER ACS INTACT.
+;;; IF N IS GIVEN, ONLY IOC ERROR CODE N IS TRAPPED.
+
+IFN ITS+D20,[
+
+DEFINE PURTRAP X,B-INST
+	INST
+PURTR1 \.-1,\NPURTR,D,X
+NPURTR==NPURTR+1
+TERMIN
+
+DEFINE PURTR1 L,N,AC,X
+	DEFINE ZZP!N
+		CAIN AC,L
+		 HRROI AC,X
+	TERMIN
+TERMIN
+
+;;; FOR COMMENTS ON 2DIF, SEE BELOW
+DEFINE 2DIF INST,X,Y
+	<INST>\<,,<X>-<Y>>
+TERMIN
+]		;END OF IFN ITS+D20
+
+
+DEFINE IOCTRAP AC,X,N
+IOCTR1 \.-1,\NIOCTR,AC,X,N
+NIOCTR=NIOCTR+1
+TERMIN
+
+DEFINE IOCTR1 L,N,AC,X,N
+	DEFINE ZZI!N
+	IFSN [N],[
+		CAIE D,N
+		 JRST .+3
+	]
+		CAIN R,L
+		 MOVE R,[SETZ X(AC)]
+	TERMIN
+TERMIN
+
+
+IFN D10,[
+
+DEFINE PURTRAP X,B-INST
+HS$	CAIL B,HILOC
+HS$	  JRST X
+	INST
+TERMIN
+] ; END -- IFN D10,
+
+
+;Hack for PWIOINT for WITHOUT-INTERRUPTS, in BIND
+;PURTRAP is OK for non-D10, but must check explicitly for PWIOINT in D10
+;I'm not sure if this HS$ is the right thing.  It wants to check in all cases
+;where a pure trap won't happen, such as PLISP at SAIL --RWK
+
+IFE D10,[
+DEFINE BNDTRAP LBL,X,B-INST
+IFSN LBL,,LBL:
+	PURTRAP X,B, INST
+TERMIN
+] ;END -- IFE D10
+
+IFN D10,[
+DEFINE BNDTRAP LBL,X,B-INST
+	CAIN B,PWIOINT
+	  JRST X
+IFSN LBL,,LBL:
+	INST
+TERMIN
+] ;END -- IFN D10,
+
+IFN D10,[
+;;; FEATURE FOR TWO-SEGMENT DEC-10 ASSEMBLIES TO WIN ON THE
+;;; MANY INSTRUCTIONS IN LISP WHICH ARE OF THE FORM
+;;;		JRST FOO-BAR(X)
+;;; WHERE FOO IS IN ONE SEGMENT AND BAR IN THE OTHER.
+;;; THE CORRECT WAY TO WRITE THE ABOVE INSTRUCTION IS
+;;;	2DIF	JRST (X),FOO,BAR
+
+
+DEFINE 2DIF INST,X,Y
+IFN %HISEG+1,	2DIF1 \.-HILOC,HILOC,[X][Y]\N2DIF
+IFE %HISEG+1,	2DIF1 \.-FIRSTLOC,FIRSTLOC,[X][Y]\N2DIF
+N2DIF==N2DIF+1
+	INST
+TERMIN
+
+;;; A COUPLE OF CROCKS:
+;;;	[1] THE .CRFON AND .CRFOFF IN ZZD!N INTERACT WITH
+;;;	    THOSE IN THE MACROLOOP MACRO.
+;;;	[2] THE OFFSETS ALLOW ADDRESSES CONTAINING . IN
+;;;	    THE 2DIF'ED INSTRUCTION (KNOCK PLASTIC).
+;;;	    I.E. THE OFFSET F+L-. IS A HACK SO THAT
+;;;	    ANY .'S IN X OR Y WILL REFER TO THE 2DIF'D
+;;;	    INSTRUCTION AND NOT TO THE PLACE WHERE THE ZZD!N
+;;;	    GETS EXPANDED.
+
+DEFINE 2DIF1 L,F,X,Y,N
+.CRFOFF
+	DEFINE ZZD!N
+	.CRFON
+	OFFSET F+L-.
+		MOVEI T,X
+		SUBI T,Y
+	OFFSET 0
+	.CRFOFF
+		HRRM T,F+L
+	TERMIN
+.CRFON
+TERMIN
+
+;;; THE ZZD MACROS GET EXPANDED IN THE INIT ROUTINE.
+
+]	;END OF IFN D10
+
+
+
+DEFINE INTPRO W
+REL$ PROENT \.-.RL1,W,\NPRO
+REL% PROENT \.,W,\NPRO
+TERMIN
+
+DEFINE PROENT L,W,N
+	DEFINE PRO!N
+REL$		W,,L+.RL1
+REL%		W,,L
+	TERMIN
+	NPRO==NPRO+1
+TERMIN
+
+DEFINE NOPRO		;BEGINS INTERVAL WITH NO INT PROTECTION
+INTPRO INTOK
+TERMIN
+
+DEFINE SFXPRO		;CODE PROMISES TO RETURN THROUGH AN SFX CELL
+INTPRO INTSFX
+TERMIN
+
+DEFINE XCTPRO		;FOLLOWING INSTRS MUST BE XCT'D BEFORE INT
+INTPRO INTXCT
+TERMIN
+
+DEFINE BAKPRO		;MUST BACK UP TO HERE IF INT HAPPENS
+INTPRO INTBAK
+TERMIN
+
+DEFINE SPECPRO H	;USED A SPECIALIZED PROTECTION ROUTINE
+INTPRO H
+TERMIN
+
+;;; NO PROTECTION FOR ABSOLUTE LOCATIONS FROM 0 UP TO NEXT INTERVAL
+DEFINE PRO0
+	INTOK,,0
+TERMIN
+
+;;; THE PRO MACROS ARE EXPANDED AT PROTB (Q.V.)
+
+
+
+SUBTTL ST AND GCST HACKERS
+
+IFN PAGING,[
+
+;;; THESE MACROS ACTUALLY FILL IN THE SEGMENT TABLES, FOR ITS ASSEMBLIES
+
+DEFINE $ST SPC,BITS
+IFN .-ST-<B!SPC!SG/SEGSIZ>,[
+	WARN [SEGMENT TABLE PHASE ERROR - TABLE LOC=]\.-ST,[, B!SPC!SG/SEGSIZ=]\B!SPC!SG/SEGSIZ
+	LOC ST+<B!SPC!SG/SEGSIZ>
+]
+IFN N!SPC!SG, $ST1 SPC,\N!SPC!SG,BITS
+TERMIN
+
+DEFINE $ST1 SPC,N,XBITS
+ST.!SPC:
+ZZ==0
+IRP TYPE,,[LIST,FIXNUM,FLONUM,BIGNUM,SYMBOL,RANDOM,ARRAY]BB,,[LS,FX,FL,BN,SY,RN,SA]
+IFN <XBITS>&BB,[
+REPEAT N, <XBITS>,,Q!TYPE
+ZZ==ZZ+1
+]
+TERMIN
+IFN ZZ-1, WARN [IMPROPER TYPE BITS FOR SPC SPACE: ]\XBITS
+TERMIN
+
+;;; THERE ARE NO INITIAL HUNKS!!!
+;;; THESE MACROS HAVE THEREFORE NOT BEEN HACKED FOR HUNKS!!!
+
+
+DEFINE $GCST SPC,LINK,BTBP,BITS
+IFSE LINK,L, L!SPC!SG==0
+IFN .-GCST-<B!SPC!SG/SEGSIZ>,[
+	WARN [GCST PHASE ERROR - TABLE LOC=]\.-GCST,[, B!SPC!SG/SEGSIZ=]\B!SPC!SG/SEGSIZ
+	LOC GCST+<B!SPC!SG/SEGSIZ>
+]
+IFN N!SPC!SG, 	$GCST1 \N!SPC!SG,SPC,LINK,BTBP,BITS
+TERMIN
+
+DEFINE $GCST1 N,SPC,LINK,BTBP,BITS
+GS.!SPC:
+REPEAT N,[
+ZZ==(BITS)
+IFSE BTBP,B, ZZ==ZZ+BTB._<5-SEGLOG>
+.ALSO BTB.==BTB.+BTBSIZ
+IFSE LINK,L, ZZ==ZZ+L!SPC!SG_<22-<SEGLOG-5>>
+.ALSO L!SPC!SG==.-GCST
+	ZZ
+]
+TERMIN
+
+]		;END OF IFN PAGING
+
+IFE PAGING,[
+
+;;;  THIS MACRO MAKES UP THE CODE THAT INITIALIZES THE SEGMENT TABLES
+DEFINE 10ST SPC,STENT=[$XM,,QRANDOM]GCENT=0,LINK,BITS
+IFN N!SPC!SG,[
+	MOVEI T,B!SPC!SG
+	LSH T,-SEGLOG
+	MOVE TT,[STENT]
+REPEAT N!SPC!SG,	MOVEM TT,ST+.RPCNT(T)
+IFN GCENT,[
+	MOVSI TT,GCENT
+REPEAT N!SPC!SG,[
+IFSN BITS,,[
+	HRRI TT,(AR1)
+	ADDI AR1,1
+]		;END OF IFSN BITS,,
+	MOVEM TT,GCST+.RPCNT(T)
+]		;END OF REPEAT N!SPC!SG
+]		;END OF IFN GCENT
+IFSN LINK,,[
+IFG N!SPC!SG-1,[
+	HRLI T,-N!SPC!SG+1
+	DPB T,[SEGBYT,,GCST+1(T)]
+	AOBJN T,.-1
+]		;END OF IFG N!SPC!SG-1
+	HRRZM T,LINK
+]		;END OF IFSN LINK,,
+]		;END OF IFN N!SPC!SG
+TERMIN
+
+]	;END OF IFE PAGING
+
+;;; $<GS>T IN DDT IS GOOD FOR LOOKING AT GCST
+GS==<777000,,>\<<1_<22-<SEGLOG-5>>>-1>
+
+;;; FOR FETCHING LINK FIELD WITH A LDB
+SEGBYT==<22-<SEGLOG-5>>_14+<22-SEGLOG>_6
+

src/l/ulap.145

@@ -0,0 +1,661 @@
+;;;   -*-MIDAS-*-
+;;;   **************************************************************
+;;;   ***** MACLISP ****** UTAPE, LAP, AND AGGLOMERATED SUBRS ******
+;;;   **************************************************************
+;;;   ** (C) COPYRIGHT 1980 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
+;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
+;;;   **************************************************************
+
+
+
+	PGBOT [UIO]
+
+
+
+SUBTTL	OLD I/O FUNCTIONS IN TERMS OF NEW I/O PRIMITIVES
+
+;;;	(DEFUN UREAD FEXPR (FILENAME)
+;;;	       (UCLOSE)
+;;;	       ((LAMBDA (FILE)
+;;;			(EOFFN UREAD
+;;;			       (FUNCTION
+;;;				  (LAMBDA (EOFFILE EOFVAL)
+;;;					  (UCLOSE)
+;;;					  EOFVAL)))
+;;;			(INPUSH (SETQ UREAD FILE))
+;;;			(DEFAULTF FILE))
+;;;		(OPEN (*UGREAT FILENAME) 'IN)))
+
+UREAD:	PUSH P,A		;FEXPR
+	PUSHJ P,UCLOSE
+	POP P,A
+	PUSHJ P,UGREAT
+	PUSH P,[UREAD2]
+	PUSH P,A
+	MOVNI T,1
+	JRST $EOPEN
+UREAD2:	MOVEM A,VUREAD
+	PUSH P,[UREAD1]
+	PUSH P,A
+	PUSH P,[QUREOF]
+	MOVNI T,2
+	JRST EOFFN
+UREAD1:	HRRZ A,VUREAD
+	PUSHJ P,INPUSH
+	PUSHJ P,DEFAULTF
+	HRRZ A,VUREAD
+	JRST TRUENAME		;RETURN TRUENAME OF FILE TO USER
+
+UREOF:	PUSH P,B		;+INTERNAL-UREAD-EOFFN - SUBR 2
+	PUSHJ P,UCLOSE
+	JRST POPAJ
+
+
+;;;	(DEFUN UCLOSE FEXPR (X)
+;;;	       (COND (UREAD
+;;;		      ((LAMBDA (OUREAD)
+;;;				(AND (EQ OUREAD INFILE) (INPUSH -1))
+;;;				(SETQ UREAD NIL)
+;;;				(CLOSE OUREAD))
+;;;			   UREAD))
+;;;		     (T NIL)))
+
+UCLOSE:	SKIPN A,VUREAD		;FEXPR
+	 POPJ P,
+	CAMN A,VINFILE
+	 PUSHJ P,INPOP		;SAVES A
+	SETZM VUREAD
+	JRST $CLOSE
+
+
+;;;	(DEFUN UWRITE FEXPR (DEVDIR)
+;;;	       (OR DEVDIR (SETQ DEVDIR (CAR (DEFAULTF NIL))))
+;;;	       (*UWRITE (CONS DEVDIR
+;;;			      (COND ((STATUS FEATURE DEC10)
+;;;				     (CONS (STATUS JNAME) '(OUT)))
+;;;				    ((STATUS FEATURE DEC20)
+;;;				     '(MACLISP OUTPUT))
+;;;				    ((STATUS FEATURE ITS)
+;;;				     '(.LISP. OUTPUT))))
+;;;			'OUT
+;;;			(LIST DEVDIR)))
+;;;
+;;;	(DEFUN UAPPEND FEXPR (FILENAME)
+;;;	       (SETQ FILENAME (*UGREAT FILENAME))
+;;;	       (*UWRITE FILENAME 'APPEND FILENAME))
+;;;
+;;;	(DEFUN *UWRITE (NAME MODE NEWDEFAULT)	;INTERNAL ROUTINE
+;;;	       (COND (UWRITE
+;;;		      (SETQ OUTFILES (DELQ UWRITE OUTFILES))
+;;;		      (CLOSE UWRITE)
+;;;		      (SETQ UWRITE NIL)))
+;;;	       ((LAMBDA (FILE)
+;;;			(SETQ OUTFILES
+;;;			      (CONS (SETQ UWRITE FILE)
+;;;				    OUTFILES))
+;;;			(CAR (DEFAULTF NEWDEFAULT)))
+;;;		(OPEN NAME MODE)))
+
+UAPPEND:	PUSHJ P,UGREAT	;FEXPR
+	MOVEI C,(A)
+	MOVEI B,QAPPEND
+	JRST UWRT1
+
+UWRITE:	JUMPN A,UWRT0		;FEXPR
+	PUSHJ P,DEFAULTF
+	HLRZ A,(A)
+UWRT0:	PUSHJ P,NCONS
+IFN ITS+D20,[
+	MOVEI C,(A)
+	HLRZ A,(C)
+	MOVEI B,QLSPOUT
+	PUSHJ P,CONS
+]		;END OF IFN ITS+D20
+IFN D10,[
+	PUSH P,A
+	PUSHJ P,SJNAME
+	MOVEI B,Q$OUT
+	PUSHJ P,CONS
+	POP P,C
+	HLRZ B,(C)
+	PUSHJ P,XCONS
+]		;END OF IFN D10
+	MOVEI B,Q$OUT
+UWRT1:	PUSH P,C		;*UWRITE BEGINS HERE
+	PUSH P,[UWRT2]
+	PUSH P,A
+	PUSH P,B
+	SKIPE VUWRITE
+	 PUSHJ P,UFILE5
+	MOVNI T,2
+	JRST $OPEN
+UWRT2:	MOVEM A,VUWRITE
+	HRRZ B,VOUTFILES
+	PUSHJ P,CONS
+	MOVEM A,VOUTFILES
+	POP P,A
+	PUSHJ P,DEFAULTF
+	JRST $CAR
+
+
+;;;	(DEFUN UFILE FEXPR (SHORTNAME)
+;;;	       (COND ((NULL UWRITE)
+;;;		         (ERROR 'NO/ UWRITE/ FILE
+;;;				(CONS 'UFILE SHORTNAME)
+;;;				'IO-LOSSAGE))
+;;;		     (T (PROG2 NIL
+;;;			       (DEFAULTF (RENAMEF UWRITE (*UGREAT SHORTNAME)))
+;;;			       (SETQ OUTFILES (DELQ UWRITE OUTFILES))
+;;;			       (SETQ UWRITE NIL)
+;;;			       (OR OUTFILES (SETQ ^R NIL))))))
+
+UFILE0:	MOVEI B,QUFILE
+	PUSHJ P,XCONS
+	IOL [NO UWRITE FILE!]
+
+UFILE:	SKIPN VUWRITE		;FEXPR
+	 JRST UFILE0
+	PUSHJ P,UGREAT
+	MOVEI B,(A)
+	SETZ A,
+	EXCH A,VUWRITE
+	PUSH P,A
+	PUSH P,B
+	HRRZ B,VOUTFILES
+	PUSHJ P,.DELQ
+	MOVEM A,VOUTFILES
+	SKIPN VOUTFILES
+	 SETZM TAPWRT
+	POP P,B
+	POP P,A
+	PUSHJ P,$RENAME		;CLOSES THE FILE AS WELL AS RENAMES IT
+	PUSHJ P,DEFAULTF
+	POPJ P,
+
+UFILE5:	HRRZ A,VUWRITE
+	HRRZ B,VOUTFILES
+	PUSHJ P,.DELQ
+	MOVEM A,VOUTFILES
+	HRRZ A,VUWRITE
+	PUSHJ P,$CLOSE
+	SETZM VUWRITE
+	SKIPN VOUTFILES
+	 SETZM TAPWRT
+	POPJ P,
+
+
+;;;	(DEFUN CRUNIT FEXPR (DEVDIR)
+;;;	       (CAR (DEFAULTF (AND DEVDIR (LIST DEVDIR)))))
+
+SCRUNIT:	SETZ A,
+CRUNIT:	SKIPE A			;FEXPR
+	PUSHJ P,NCONS
+	PUSHJ P,DEFAULTF
+	JRST $CAR
+
+
+;;;	(DEFUN *UGREAT (NAME)		;INTERNAL ROUTINE
+;;;	       (MERGEF NAME
+;;;		       (COND ((STATUS FEATURE ITS) '(* . >))
+;;;			     ('(* . LSP)))))
+
+
+
+UGREAT:	PUSH P,[6BTNML]
+UGRT1:	PUSHJ P,FIL6BT
+IFN ITS+D10,[
+REPEAT 3,	PUSH FXP,[SIXBIT \*\]
+IT$	PUSH FXP,[SIXBIT \>\]
+SA$	PUSH FXP,[SIXBIT \___\]
+SA% 10$	PUSH FXP,[SIXBIT \LSP\]
+10$	SETOM -2(FXP)		;FOR D10 DEFAULT PPN IS -1
+]		;END OF IFN ITS+D10
+IFN D20,[
+	PUSHN FXP,L.F6BT
+	MOVE T,[ASCII \LSP\]
+	MOVEM T,-L.6EXT-L.6VRS+1(FXP)
+]		;END OF IFN D20
+	JRST IMRGF
+
+
+;;;	(DEFUN UPROBE FEXPR (FILENAME)
+;;;	       (SETQ FILENAME (MERGEF (*UGREAT FILENAME) NIL))
+;;;	       (PROBEF FILENAME))
+
+UPROBE:	PUSHJ P,UGRT1		;FEXPR
+	JRST PROBF0
+
+
+;;;	(DEFUN UKILL FEXPR (FILENAME)
+;;;		    (DEFAULTF (DELETEF FILENAME))))
+
+UKILL:	PUSHJ P,$DELETEF
+	JRST DEFAULTF
+
+
+
+SUBTTL	SYMBOL MANIPULATION AND SQUOZE FUNCTIONS
+
+;;; (TTSR| <SYMBOL>) GETS THE ARRAY PROPERTY OF <SYMBOL>,
+;;; OR GIVES IT AN ARRAY PROPERTY WITH A DEAD SAR;
+;;; IT MARKS THE SAR AS BEING NEEDED BY COMPILED CODE,
+;;; AND THEN RETURNS THE ADDRESS OF THE TTSAR AS A FIXNUM.
+;;; THIS IS USED PRIMARILY BY LAP.
+
+TTSR:	PUSH P,CFIX1	;SUBR 1 - NCALLABLE (TTSR|)
+	MOVEI C,(A)	;SAVES AR1,R,F - SEE FASLOAD
+	PUSHJ P,ARGET
+	JUMPN A,TTSR1
+	JSP T,SACONS
+	MOVEI T,ADEAD
+	MOVEM T,ASAR(A)
+	MOVE T,[TTDEAD]
+	MOVEM T,TTSAR(A)
+	MOVEI B,(A)
+	MOVEI A,(C)
+	MOVEI C,QARRAY
+	PUSHJ P,PUTPROP
+TTSR1:	MOVSI T,TTS.CN
+	IORM T,TTSAR(A)
+	MOVEI TT,1(A)
+	POPJ P,
+
+;;; BOTH ROUTINES ALWAYS RETURN THE LEFT-JUSTIFIED SQUOZE IN T
+;;;   AND THE SIXBIT IN R
+;;; RSQUEEZE MAY LEAVE RIGHT-JUSTIFIED SQUOZE IN TT
+RSQUEEZE:			;CANONICAL SQUOZE CONVERSION
+IT%	HRROS (P)		;FOR DEC-10, GIVES DEC-10 SQUOZE
+SQUEEZE:			;THIS ALWAYS GIVES LEFT-JUSTIFIED SQUOZE
+	MOVEI AR1,6		;CONVERT PNAME-ATOM TO SQUOZE AND SIXBIT
+	MOVE AR2A,[440600,,SQ6BIT] ;RETURNS SQUOZE IN TT, SIXBIT IN R
+	SETZM SQ6BIT		;CLEAR LOCS USED TO ACCUMULATE
+	SETZM SQSQOZ		; SIXBIT AND SQUOZE
+	HRROI R,SQZCHR
+	PUSHJ P,PRINTA		;"PRINT" OUT CHARS OR PNAME
+IT%	MOVE TT,SQSQOZ
+	SKIPA T,SQSQOZ
+	 IMULI T,50
+	SOJGE AR1,.-1		; MULTIPLY ITS SQUOZE UP TO SIZE
+IT%	MOVE R,(P)
+IT%	TLNN R,1
+	 MOVE TT,T
+	MOVE R,SQ6BIT
+	POPJ P,
+
+SQZCHR:	TLNN AR2A,770000	;IGNORE MORE THAN 6 CHARS
+	 POPJ P,
+	SUBI A,40		;CONVERT TO SIXBIT
+	CAIL A,1		;LOSSAGE IF NOT SIXBIT CHAR
+	 CAILE A,77		; - ALSO, SPACE IS A LOSS
+	  MOVEI A,'.		;LOSING NON-SQUOZE CHAR
+	IDPB A,AR2A		;DEPOSIT SIXBIT CHAR
+	CAIL A,'A		;CHECK FOR LETTER
+	 CAILE A,'Z
+	  JRST SQNOTL
+	SUBI A,'A-13		;CONVERT TO SQUOZE VALUE
+SQOK:	EXCH T,SQSQOZ
+	IMULI T,50
+	ADDI T,(A)
+	EXCH T,SQSQOZ
+	SOJA AR1,CPOPJ		;DECR COUNT AND RETURN TO PRINTA
+
+SQNOTL:	CAIL A,'0		;CHECK FOR DIGIT
+	 CAILE A,'9
+	  JRST SQNOTD
+	SUBI A,'0-1		;CONVERT TO SQUOZE VALUE
+	JRST SQOK
+
+SQNOTD:	CAIE A,'$		;CHECK FOR $ OR %
+	 CAIN A,'%
+	  JRST SQ%$
+	MOVEI A,'.		;ANY CHAR OTHER THAN A-Z, 0-9, $, OR %
+	DPB A,AR2A		; DEFAULTS TO . (E.G. *FOOBAR -> .FOOBA)
+	MOVEI A,45-42
+SQ%$:	ADDI A,42		;SQUOZE VALUE FOR $,%,.
+	JRST SQOK
+
+
+UNSQOZ:	LDB T,[004000,,D]	;HAIRY MESS TO CONVERT
+	SETZM LD6BIT		; SQUOZE TO SIXBIT
+UNSQZ1:	IDIVI T,50		;(THIS IS SEPARATE ROUTINE SO
+	JUMPE TT,UNSQZ2		; LAP LOSERS CAN USE IT)
+	CAIL TT,45		;<1SQUOZE .>
+	JRST UNSQZ3
+	CAIL TT,13		;<1SQUOZ A> IS 13
+	ADDI TT,'A-13		;CONVERT RANGE  A - Z , 
+	CAIGE TT,13		;<1SQUOZ 1>   IS 1
+	ADDI TT,'0-1		;CONVERT RANGE  0 - 9
+UNSQZ2:	IOR TT,LD6BIT
+	ROT TT,-6
+	MOVEM TT,LD6BIT
+	JUMPN T,UNSQZ1
+	MOVE A,[440600,,LD6BIT]	;MAKE SIXBIT INTO AN ATOM
+	JRST READ6C
+
+UNSQZ3:	SUBI TT,46-'$		;[1SQUOZ $] IS 46, [1SQOZ .] IS 45
+	CAIN TT,45-<46-'$>	;CONVERT RANGE $ - % 
+	MOVEI TT,'*		;BUT  .  IS EXCEPTIONAL
+	JRST UNSQZ2
+
+
+
+
+PUTDDTSYM:
+	MOVEI R,0	;PUTDDTSYM| IS FOR LAP - OFFSETS VALUE BY LOAD OFFSET
+PUTDD0:
+IT$	JSP T,SIDDTP		;LOSE IF NO DDT TO GIVE SYMBOL TO
+IT% 20%	SKIPN .JBSYM"
+	 JRST FALSE
+	PUSH FXP,R
+	PUSH P,B
+10$	SKIPL R			;SEE LDPUT1
+	 PUSHJ P,RSQUEEZE	;SQUEEZE ATOM'S PNAME DOWN TO SQUOZ CODE
+	POP P,B
+	PUSHJ P,GETDDG		;L-JUST SQUOZ IN T, CANONICAL-JUST IN TT
+	 JRST PUTDX		;DONT REDEFINE GLOBALSYMS
+IFE ITS,[
+	PUSHJ P,GETDDJ
+	 JRST PUTDD4
+	MOVEI F,(D)
+]		;END OF IFE ITS
+PUTDD2:	JSP T,FXNV2			;GET VALUE OF SECOND ARG
+	POP FXP,R
+	ADDI D,(R)			;ADD IN OFFSET
+IT$	.BREAK 12,[..SSYM,,TT]
+10$	MOVEM D,(F)			;NON-ITS LEAVES IN F A PTR TO SYMTAB 
+	JRST TRUE			; SLOT WHERE ENTRY IS TO BE MADE
+
+IFE ITS,[
+PUTDD4:	SOSGE SYMLO
+	 JRST FALSE
+	MOVE F,R70+2
+	SUBB F,.JBSYM"
+	TLO TT,100000		;LOCAL SYMBOL
+	MOVEM TT,(F)
+	AOJA F,PUTDD2
+]		;END OF IFE ITS
+
+PUTDX:	POPI FXP,1
+	JRST FALSE
+
+
+SUBTTL	LAPSETUP AND FASLAPSETUP
+
+LAPSETUP:
+	JUMPN A,LAPSMH		;ARG = NIL => SETUP SOME SYM PROPERTIES
+	MOVEI T,LAPST2
+LAP5HAK:
+	PUSH P,T		;APPLIES THE ROUTINE FOUND IN T
+				; TO ALL THE GLOBALSYMS
+	PUSH P,[441100,,LAP5P]	;ATOMIC SYMBOL PLACED IN A,
+				; GLOBALSYM INDEX IN TT
+	MOVSI F,-LLSYMS
+L5H1:	ILDB TT,(P)		;HAFTA GET THE GLOBALSYM INDEX FROM
+				; PERMUTATION TABLE
+	CAIL TT,LGSYMS		;IF NOT A GLOBALSYM [BUT AN XTRASYM], SKIP IT
+	JRST L5XIT
+	CAIN TT,3		;****NEVER CHANGE THE GLOBALSYM INDICES FOR:
+	JRST L5SPBND		;  SPECBIND	 3
+	CAIN TT,25		;  ERSETUP	25
+	JRST L5ERSTP		;  MAKUNBOUND	34
+	CAIN TT,34		;  INHIBIT	47
+	JRST L5MKUNBD		;  0*0PUSH	53
+	CAIN TT,47		;  NILPROPS	54
+	JRST L5INHIBI		;THOSE HAVE MORE THAN 6 CHARS IN THEIR PNAME
+	CAIN TT,53		;AND CANT BE RECONSTRUCTED BY UNSQOZ'ING FROM
+	JRST L50.0P		;FROM THE LAPFIV TABLE
+	CAIN TT,54
+	JRST L5NILP
+	MOVE D,LAPFIV(F)
+	PUSHJ P,UNSQOZ
+L5H2:	LDB TT,(P)
+	PUSHJ P,@-1(P)
+L5XIT:	AOBJN F,L5H1
+	JRST POP2J
+
+L5ERSTP:
+	MOVEI A,[SIXBIT \ERSETUP \]
+	JRST L5H3
+L5SPBND:
+	MOVEI A,[SIXBIT \SPECBIND \]
+L5H3:	HRLI A,440600
+	PUSHJ P,READ6C
+	JRST L5H2
+
+L5MKUNBD:
+	MOVEI A,[SIXBIT \MAKUNBOUND \]
+	JRST L5H3
+L5INHIBIT:
+	MOVEI A,[SIXBIT \INHIBIT \]
+	JRST L5H3
+L50.0P:	MOVEI A,[SIXBIT \0*0PUSH \]
+	JRST L5H3
+L5NILP:	MOVEI A,[SIXBIT \NILPROPS\]
+	JRST L5H3
+
+
+LAPSMH:	CAIE A,TRUTH		;(LAPSETUP| T 2) MEANS
+	 JRST LAPSM1		; SET UP THE XCT HACK AREAS
+10$	JSP T,FXNV2		; WITH 2 XCT PAGES
+10$	MOVE TT,D
+10$	JRST LDXHAK
+10%	POPJ P,			;FOR NON TOPS-10, NO NEED TO DO ANY SETUP
+
+LAPSM1:	MOVEI T,(B)		;OTHERWISE, FIRST ARG IS ADDRESS
+	MOVEI R,(A)		; TO HACK, SECOND NON-NIL =>
+	MOVE TT,(R)		;	TRY THE XCT-PAGE HAK
+	PUSHJ P,PRCHAK		;TRY TO SMASH (SKIP ON FAILURE)
+	 JRST TRUE
+	MOVEI A,(AR2A)
+	MOVE B,VPURCLOBRL
+	PUSHJ P,CONS
+	MOVEM A,VPURCLOBRL
+	JRST TRUE
+
+LAPST2:	MOVE TT,LSYMS(TT)	;GET ACTUAL VALUE FROM GLOBALSYM INDEX
+	MOVEI C,QSYM
+LSYMPUT:			;EXPECTS SYMBOL IN A, "SYM" OR "GLOBALSYM"
+	MOVEI B,(A)		; IN C, AND VALUE IN TT
+	JSP T,FXCONS
+	EXCH A,B
+	JRST PUTPROP
+
+FSLSTP:
+	MOVEI T,FSLST2
+	PUSHJ P,LAP5HAK
+	MOVE TT,LDFNM2
+	JRST FIX1
+
+FSLST2:	MOVEI C,(A)	;MAKE UP ATOMIC SYMBOLS AND GIVE THEM SYM PROPERTIES
+	JSP T,FXCONS	; OF THE FORM (0 (NIL <N>))
+	PUSHJ P,NCONS	; WHERE <N> IS THE INDEX OF THE SYMBOL
+	SETZ B,		; (THESE ARE THE "GLOBALSYMS")
+	PUSHJ P,XCONS
+	PUSHJ P,NCONS
+	MOVE B,CIN0
+	PUSHJ P,XCONS
+	MOVEI B,(A)
+	MOVEI A,(C)
+	MOVEI C,Q%GLOBALSYM
+	JRST PUTPROP
+
+
+
+	R70		;GLOBALSYM NUMBER -1
+LSYMS:	GLBSYM A
+LGSYMS==.-LSYMS		;END OF GLOBALSYMS HACKED BY FASLAP
+	XTRSYM A
+LLSYMS==.-LSYMS		;END OF ALL GLOBAL SYMBOLS
+
+;;; SIXBIT FOR LAP SYMBOL NAMES; MUST MATCH IRP LIST OF GLBSYM
+ZZ==0
+LAPSIX:	.BYTE 6
+SIXSYM [
+	IRPC Q,,[A]
+		'Q
+	TERMIN
+		0
+	ZZ==ZZ+1
+]		;END OF SIXSYM ARGUMENT
+	.BYTE
+IFN ZZ-LGSYMS, WARN [LAPSIX OUT OF PHASE]
+EXPUNGE ZZ
+
+LAPFIV:
+GLBSYM [SQUOZE 0,A]
+XTRSYM [SQUOZE 0,A]
+
+	HAOLNG LOG2LL5,<LLSYMS-1>	;CROCK FOR BINARY SEARCH
+	REPEAT <1_LOG2LL5>-LLSYMS, 377777,,777777
+
+LAP5P:	BLOCK <LLSYMS+3>/4	;PERMUTATION, STORED 4/WD, TO GET GLOBALSYMINDEX FROM LAPFIV INDEX
+
+
+GETDDTSYM:
+	PUSHJ P,RSQUEEZE
+	PUSHJ P,GETDDG		;GET GLOBALSYM INDEX, AND NO-SKIP IF WIN
+	 JRST FIX1
+IFN ITS,[
+	MOVE D,TT		;SAVE SQUOZE OVER CALL TO SIDDTP
+	JSP T,SIDDTP		;LOSE IF NO DDT FROM WHICH TO GET SYMBOL
+	 JRST FALSE
+	MOVE TT,D
+	.BREAK 12,[..RSYM,,TT]
+	JUMPE TT,FALSE
+	MOVE TT,TT+1
+	JRST FIX1
+]	;END OF IFN ITS
+IFE ITS,[
+	PUSHJ P,GETDDJ
+	 JRST FALSE
+	JRST FIX1
+
+GETDDJ:	SKIPA D,.JBSYM"		;SQUOZ IN TT - FIND SYMBOL IN JOB SYMBOL TABLE
+GETDD1:	ADD D,R70+2		; SKIP IF FOUND
+	JUMPGE D,CPOPJ
+	MOVE T,(D)
+	TLZ T,540000
+	TLZN T,200000		;SYMBOL MUSTN'T BE KILLED
+	 CAME T,TT		;MUST BE THE ONE WE WANT
+	  JRST GETDD1
+	MOVE TT,1(D)
+	AOJA D,POPJ1
+]	;END OF IFE ITS
+
+
+GETDDG:	MOVEI R,0		;SQUOZ IN T, SEARCH "GLOBALSYM" TABLE, 
+	TLZ T,740000		;  SKIP IF LOSE, LEAVE VALUE IN TT IF WIN
+REPEAT LOG2LL5,[
+	CAML T,LAPFIV+<1_<LOG2LL5-.RPCNT-1>>(R)
+	 ADDI R,1_<LOG2LL5-.RPCNT-1>
+]		;END OF REPEAT LOG2LL5
+	CAME T,LAPFIV(R)	;IF DDTSYM REQUEST IS FOR A GLOBAL SYM
+	 JRST POPJ1		;THEN FIND IT IN THE LAPFIV TABLE, AND GET ITS 
+	LSHC R,-2		;GLOBALSYM INDEX FROM THE PERMUTATION TABLE
+	LSH F,-42
+	LDB TT,LDGET6(F)	;USE TABLE FROM FASLOAD
+	MOVE TT,LSYMS(TT)
+	POPJ P,
+
+
+LGTSPC:	MOVEM TT,GAMNT
+	ADD TT,@VBPORG		;INSURE THAT BPEND-BPORG > (TT)
+	SUB TT,@VBPEND
+	JUMPGE TT,GTSPC1	;MUST RELOCATE, OR GET MORE CORE.
+	MOVE A,VBPEND		;ALREADY OK
+	MOVE TT,(A)
+	POPJ P,
+
+PAGEBPORG:	MOVE A,VBPORG	;MAKE SURE BPORG IS ON PAGE BOUNDRY
+	MOVE TT,(A)		;NUMERIC VALUE OF BPORG
+	TRNN TT,PAGKSM
+	POPJ P,
+	ADDI TT,PAGSIZ-1
+	ANDCMI TT,PAGKSM
+	CAMGE TT,@VBPEND
+	JRST PGBP4
+	PUSH FXP,TT		;NEW VALUE FOR BPORG
+	JSP T,SPECBIND
+	0 VNORET
+	AOS VNORET
+	PUSH P,CUNBIND
+	SUB TT,(A)
+	PUSHJ P,LGTSPC
+	JUMPE TT,[LERR [SIXBIT \NO CORE - PAGEBPORG!\]]
+	POP FXP,TT
+PGBP4:	JSP T,FIX1A
+	MOVEM A,VBPORG		;GIVE BPORG NEW PAGIFIED VALUE
+	POPJ P,
+
+SUBTTL	MAKUNBOUND AND PURIFY 
+
+;NEVER FLUSHES VALUE CELL
+MAKUBE:	%WTA [SIXBIT \UNCHANGEABLE VALUE - MAKUNBOUND!\]
+MAKUNBOUND:			;SUBR 1 - FLUSH VALUE OF ATOMIC SYMBOL
+   BAKPRO
+	JSP D,SETCK		;MAKE SURE IT'S A SYMBOL
+	JUMPE A,MAKUBE
+	CAIN A,TRUTH
+	 JRST MAKUBE
+	HLRZ T,(A)
+	MOVE B,(T)
+IFE 0, NOPRO
+IFN 0,[
+	TLNE B,300		;CAN'T RECLAIM VALUE CELL IF PURE
+	 JRST MAKUN1		; OR IF COMPILED CODE NEEDS IT
+	TLZ B,-1
+	CAIN B,SUNBOUND		;CAN'T RECLAIM SUNBOUND!!!
+	 POPJ P,
+	CAIL B,BXVCSG+NXVCSG*SEGSIZ
+	 JRST MAKUN1		;CAN'T RECLAIM CELL NOT IN VALUE CELL AREA
+	EXCH B,FFVC		;SO RECLAIM THE VALUE CELL ALREADY
+   XCTPRO
+	MOVEM B,@FFVC
+	MOVEI B,SUNBOUND	;USE SUNBOUND FOR A VALUE CELL
+	HRRM B,(T)
+   NOPRO
+	POPJ P,			;THAT'S ALL
+]		;END IFN 0
+
+MAKUN1:	PUSH P,A		;MAKE SURE WE RETURN THE ARGUMENT
+	PUSH P,CPOPAJ
+	MOVEI B,QUNBOUND	;FALL INTO SET WITH "UNBOUND" VALUE
+	JRST SET+1
+
+
+;;;; PURIFY
+
+IFN USELESS,[
+
+$PURIFY:
+IFN D10, POPJ P,
+IFN ITS+D20,[
+	LOCKTOPOPJ
+	SETZ AR1,
+	JSP T,FXNV1		;GET TWO MACHINE NUMBERS
+	JSP T,FXNV2
+	ANDCMI TT,1777		;PAGIFY FIRST DOWNWARD
+	IORI D,1777		;PAGIFY SECOND UPWARD
+	CAMLE TT,D
+	 LERR [SIXBIT \ARG 2 < ARG 1 - PURIFY!\]
+	JUMPE C,FPURF3		;NULL THIRD ARG MEANS DEPURE
+	MOVE T,LDXLPL
+	HRRZ T,LDXPSP(T)	;GET ADR OF POSSIBLY PURE PAGE
+	CAIG TT,(T)
+	 CAIGE D,(T)
+	  SKIPA
+	   SETZM LDXLPC		;FOR PURE PAGE JUST FORCE FREE COUNT TO ZERO
+FPURF0:	CAIE C,QBPORG
+	 JRST FPURF3
+	PUSHJ P,FPURF7
+	JRST FPURF2
+
+FPURF3:	JSP R,IP0
+	POPJ P,
+
+]		;END OF IFN ITS+D20
+]		;END OF IFN USELESS
+
+
+	PGTOP UIO,[UTAPE, LAP, AND AGGLOMERATED SUBRS]
+