;;;   -*-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

