+TITLE CORE
+
+RELOCATABLE
+
+.INSRT MUDDLE >
+
+SYSQ
+
+IF1,[
+IFE ITS,.INSRT STENEX >
+]
+
+.GLOBAL P.CORE,P.TOP,PHIBOT,PURBOT,FRETOP,SQKIL,GCFLG,KILBUF
+.GLOBAL MULTSG
+
+; .CORE AND .SUSET [.RMEMT,,---] FOR PAGED ENVIRONMENT
+
+IFN ITS,[
+
+P.CORE: PUSH P,0
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,E
+ SKIPN GCFLG
+ PUSHJ P,SQKIL
+ MOVE A,-4(P)
+ ASH A,10. ; CHECK IT
+ CAMLE A,PURBOT ; A CAML HERE IS OBSERVED TO LOSE
+ FATAL BAD ARG TO GET CORE
+ MOVE A,-4(P) ; RESTORE A
+ HRRZ B,P.TOP ; GET FIRST ADDRESS ABOVE TOP
+ ASH B,-10. ; TO BLOCKS
+ CAIG A,(B) ; SKIP IF GROWING
+ JRST P.COR1
+ SUBM B,A ; A/ -NUMBER OF BLOCKS TO GET
+ HRLI B,(A) ; AOBJN TO BLOCKS
+
+ .CALL P.CORU ; TRY
+ JRST POPBJ ; LOSE
+ MOVE A,B
+P.COR2: ASH B,10. ; TO WORDS
+ MOVEM B,P.TOP ; NEW TOP
+POPBJ1: AOS -6(P) ; SKIP RETURN ON SUCCESS
+POPBJ: POP P,E
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POP P,0
+ POPJ P,
+
+; HERE TO CORE DOWN
+
+P.COR1: SUBM A,B
+ JUMPE B,POPBJ1 ; SUCCESS, YOU ALREADY HAVE WHAT YOU WANT
+ HRLI A,(B)
+ MOVEI B,(A)
+ .CALL P.CORD
+ JRST POPBJ
+ JRST P.COR2
+
+P.CORU: SETZ
+ SIXBIT /CORBLK/
+ 1000,,100000
+ 1000,,-1
+ B
+ 401000,,400001
+
+P.CORD: SETZ
+ SIXBIT /CORBLK/
+ 1000,,0
+ 1000,,-1
+ SETZ A
+]
+
+IFE ITS,[
+
+MFORK==400000
+
+P.CORE: JRST @[.+1]
+ ASH A,10. ; CHECK IT
+ CAMLE A,PURBOT
+ FATAL BAD ARG TO GET CORE
+ ASH A,-9. ; TO PAGES
+ PUSH P,D
+ PUSH P,A
+ SKIPN GCFLG
+ PUSHJ P,SQK
+ SETOM A ; FLUSH PAGES
+ HRRZ B,P.TOP ; GET P.TOP
+ ASH B,-9. ; TO PAGES
+ CAMLE B,(P)
+ SOJA B,P.CORD ; CORING DOWN
+ HRLI B,MFORK ; SET UP FORK POINTER
+P.COR2: HRRZ D,B
+ CAML D,(P) ; SEE IF DONE
+ JRST P.COR1
+ PMAP ; MAP OUT PAGE
+ ADDI B,1 ; NEXT PAGE
+ JRST P.COR2 ; LOOP BACK
+P.COR1: POP P,A ; RESTORE NEW P.TOP
+ POP P,D
+ ASH A,9. ; TO WORDS
+ MOVEM A,P.TOP
+ AOS (P)
+POPJA: ASH A,-10.
+ SKIPN MULTSG
+ POPJ P,
+ POP P,21
+ SETZM 20
+ JRST 5,20
+
+P.CORD: HRLI B,400000
+ PMAP
+ MOVEI D,-1(B)
+ CAMLE D,(P)
+ SOJA B,.-3
+ JRST P.COR1
+
+SQK: PUSH P,0
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,E
+ PUSHJ P,SQKIL
+ POP P,E
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POP P,0
+ POPJ P,
+
+]
+
+IMPURE
+
+P.TOP==FRETOP
+
+PURE
+
+END