;;; -*-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 .--, WARN [WRONG LENGTH TABLE] TERMIN DEFINE NFFTBCK START IFN .--NFF, WARN START,[-- WRONG LENGTH TABLE] TERMIN ;;; "POP IMMEDIATE" MACRO TRIES TO DECREMENT A PDL POINTER IN THE BEST WAY. DEFINE POPI ;; IFN KL10, ADJSP AC,- .STOP IFDEF R70, IFDEF LR70, IFL -LR70, SUB AC,R70+ .STOP SUB AC,[,,] TERMIN ;;; "PUSH N SLOTS" MACRO PUSHES ZERO WORDS ONTO A PDL. DEFINE PUSHN IFE , .STOP IFE -1, PUSH AC,R70 .STOP IFE AC-P,{ PUSHN1 AC,N,NPUSH .STOP} IFE AC-FXP,{ PUSHN1 AC,N,0PUSH .STOP} IFE AC-FLP,{ PUSHN1 AC,N,0.0PUSH .STOP} WARN [PUSH AC,N UNKNOWN PDL] TERMIN DEFINE PUSHN1 IFLE -N!XPUSH, JSP T,XPUSH- .STOP JSP T,XPUSH-N!XPUSH PUSHN1 AC,,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+<&SEGMSK>-CURSTD REL% LOC <&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 &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 ;;; ;;; ;;; 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 \<,,-> 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-,[ WARN [SEGMENT TABLE PHASE ERROR - TABLE LOC=]\.-ST,[, B!SPC!SG/SEGSIZ=]\B!SPC!SG/SEGSIZ LOC ST+ ] 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 &BB,[ REPEAT N, ,,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-,[ WARN [GCST PHASE ERROR - TABLE LOC=]\.-GCST,[, B!SPC!SG/SEGSIZ=]\B!SPC!SG/SEGSIZ LOC GCST+ ] 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-> .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 ;;; $T IN DDT IS GOOD FOR LOOKING AT GCST GS==<777000,,>\<<1_<22->>-1> ;;; FOR FETCHING LINK FIELD WITH A LDB SEGBYT==<22->_14+<22-SEGLOG>_6