perm filename ALLOC[NEW,LSP]1 blob sn#388724 filedate 1978-10-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00022 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   -*-MIDAS-*-
C00004 00003
C00007 00004
C00010 00005
C00016 00006
C00019 00007	IFN D10,[
C00020 00008
C00021 00009
C00024 00010
C00026 00011
C00027 00012
C00032 00013
C00035 00014
C00038 00015
C00049 00016
C00051 00017
C00053 00018
C00054 00019
C00056 00020
C00061 00021
C00062 00022
C00066 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** INITIALIZATION AND ALLOCATION ROUTINES **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


CONSTANTS	;LITERALS USED PREVIOUSLY MUST BE OUT OF BPS

SUBTTL	INITIALIZATION CODE

;;; THIS CODE IS IN BINARY PROGRAM SPACE

.CRFOFF
OBTL:	REPEAT KNOB, CONC OB,\.RPCNT
.CRFON

INITIALIZE:
IFN D10,[
	SETZ FREEAC,
	SETUWP FREEAC,			;FREEAC HAS OLD STATE OF HISEG-PURE BIT
	.VALUE
]		;END OF IFN D10
IFN ITS,[
	MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
	MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
	MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
]		;END OF IFN ITS
	MOVE P,C2
	MOVE SP,SC2
	MOVE FXP,FXC2

;;; (SETPLIST '*PRINT (PLIST 'PRINT)), ETC.
IFE QIO,[
    IRP A,,[PRINT,PRIN1,PRINC,%TERPRI,%TYO]B,,[PRT,PR1,PRC,TRP,TYO]
	HRRZ F,Q!A
	HRRM F,Q!B!$
    TERMIN
]		;END OF IFE QIO

;;; FALLS THROUGH



;;; FALLS IN

INIBS:	MOVEI F,0		;BUBBLE-SORT THE LAPFIV TABLE, WHILE
	MOVEI C,LLSYMS-1	;SORTING THE BSP TABLE AS SUBSIDIARY RECORDS
INIBS1:	MOVE D,LAPFIV(C)
	CAML D,LAPFIV-1(C)
	JRST INIBS2
	MOVEI F,1		;FLAG TO NOTE THAT A BUBBLING OCCURED THIS PASS
	EXCH D,LAPFIV-1(C)
	MOVEM D,LAPFIV(C)	;INTERCHANGE KEYS
	MOVE D,INIBSP(C)
	EXCH D,INIBSP-1(C)	;INTERCHANGE RECORDS
	MOVEM D,INIBSP(C)
INIBS2:	SOJG C,INIBS1
	JUMPN F,INIBS
	MOVNI C,LLSYMS-1
	MOVE AR2A,[441100,,LAP5P]
	MOVE TT,INIBSP+LLSYMS-1(C)
	IDPB TT,AR2A
	AOJLE C,.-2


;;; INITIALIZE THE SEGMENT-LINK COUNTERS FOR ITS & D20

IFN PAGING,[
IRP A,,[FS,FX,FL,SY,SA,S2]B,,[IFS,IFX,IFL,SYM,SAR,IS2]
	MOVEI T,L!B!SG
	MOVEM T,A!SGLK
TERMIN
BG$	MOVEI T,LBNSG
BG$	MOVEM T,BNSGLK
IRPC Q,,[AB]
IFN NXX!Q!SG,[
	MOVE T,IMSGLK
	MOVE TT,[-NXX!Q!SG,,BXX!Q!SG←-SEGLOG]
	DPB T,[SEGBYT,,GCST(TT)]
	MOVEI T,(TT)
	AOBJN TT,.-2
	MOVEM T,IMSGLK
]		;END OF IFN NXX!Q!SG
TERMIN
	MOVEI T,<<<ENDLISP+PAGSIZ-1>&PAGMSK>-BBPSSG>←-PAGLOG
	MOVEI D,BBPSSG←-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[450200,,PURTBL]
	MOVEI TT,3
INIT5:	TLNN D,730000
	TLZ D,770000
	IDPB TT,D
	SOJG T,INIT5
	MOVE T,[-<<<<ENDLISP+PAGSIZ-1>&PAGMSK>-BBPSSG>←-SEGLOG>,,ST+<BBPSSG←-SEGLOG>]
	MOVE TT,[$XM,,QRANDOM]
	MOVEM TT,(T)
	AOBJN T,.-1
]	;END OF IFN PAGING

IFE PAGING,[

;;; INITIALIZE THE SEGMENT TABLES, AND LINK COUNTERS FOR DEC-10 

    BZERSG==FIRSTLOC	;CROCK - BEWARE RELOCATION!
    BSYSSG==HILOC

IN10ST:	SETZ A,			;INIBD SETS NON-ZERO ON ERROR
	MOVEI T,FIRSTLOC
	MOVEI TT,FIRSTLOC	;DO NOT ATTEMPT TO PERFORM
	SUBI TT,STDLO		; THIS ARITHMETIC AT ASSEMBLY
	JSP F,INIBD		; TIME! WOULD USE WRONG
	   ASCIZ \LOW\		; RELOCATION QUANTITIES
	MOVEI T,HILOC
	MOVEI TT,HILOC
	SUBI TT,STDHI
	MOVEM TT,MAXNXM
	SOS MAXNXM
	JSP F,INIBD
	   ASCIZ \HIGH\
	SKIPE A
	 EXIT			;LOSE LOSE
	MOVE T,[$NXM,,QRANDOM]	;INITIALIZE SEGMENT TABLES
	MOVEM T,ST
	MOVE T,[ST,,ST+1]
	BLT T,ST+NSEGS-1
	SETZM GCST
	MOVE T,[GCST,,GCST+1]
	BLT T,GCST+NSEGS-1
	MOVEI AR1,BTBLKS		;AR1 ACTS AS BTB. [BIT-BLOCK COUNTER]
	LSH AR1,5-SEGLOG
	10ST ZER
	10ST ST
	10ST SAR,[SA,,QARRAY][GCBMRK+GCBSAR]SASGLK
	10ST VC,[LS+VC,,QLIST][GCBMRK+GCBVC]
	10ST IS2,,,S2SGLK
	10ST SYM,[SY,,QSYMBOL][GCBMRK+GCBSYM]SYSGLK
	10ST IFS,[LS+$FS,,QLIST][GCBMRK+GCBCDR+GCBCAR]FSSGLK,BITS
	10ST IFX,[FX,,QFIXNUM][GCBMRK]FXSGLK,BITS
	10ST IFL,[FL,,QFLONUM][GCBMRK]FLSGLK,BITS
BG$	10ST BN,[BN,,QBIGNUM][GCBMRK+GCBCDR]BNSGLK,BITS
	10ST BIT
	10ST FXP,[FX+$PDLNM,,QFIXNUM]
	10ST FLP,[FL+$PDLNM,,QFLONUM]
	10ST P
	10ST SP
	10ST BPS

	10ST SYS,[$XM+PUR,,QRANDOM]
	10ST SY2
	10ST PFS,[LS+$FS+PUR,,QLIST]
	10ST PFX,[FX+PUR,,QFIXNUM]
	10ST PFL,[FL+PUR,,QFLONUM]

IN10S5:	HRRM AR1,BTBAOB
	LSH AR1,SEGLOG-5
	CAIN AR1,BFBTBS
	 JRST IN10S8
	OUTSTR [ASCIZ \LOST WHILE INITIALIZING BIT BLOCKS
\]
	EXIT 1,
IN10S8:

EXPUNGE BZERSG BSYSSG

]		;END OF IFE PAGING



ININTR:	MOVE A,[-KNOB+1-10,,OBTFS+1]	;SET UP OBLIST-LINKING CONSING AREAS
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVEI F,OBTFS
	MOVEM F,FFS
	MOVE F,[-KNOB,,OBTL]
	HRRZ A,(F)
	PUSHJ P,INTERN
	AOBJN F,.-2

INIRND:	JSP F,IRAND		;INITIALIZE RANDOM NUMBER GENERATOR

;INITIALIZE INTERRUPT MASKS IN MEMORY
10$	MOVE T,[STDMSK]
10%	MOVE T,[DBGMSK]
	MOVEM T,IMASK
IT$ Q$	MOVE T,[DBGMS2]
IT$ Q$	MOVEM T,IMASK2

IFN ITS,[
  	MOVE A,[SETO AR1,]
	MOVEM A,PURIFY
	MOVE A,BINIT9		;CLOBBER INIT, SINCE ONLY NEED DO ONCE
	MOVEM A,INITIALIZE
	.BREAK 12,[..SSTA,,[LISPGO]]	;SET START ADDRESS
  	.CORE <ENDLISP+PAGSIZ-1>←-PAGLOG	;FLUSH PDL PAGES
	 .VALUE
BINIT9:	.VALUE [ASCIZ \:≠INITIALIZED≠
\]
]	;END OF IFN ITS
IFN D10,[
	MACROLOOP N2DIF,ZZD,*
	MOVE C,[LVRNO]
	SETZ A,
INIT2A:	SETZ B,
	LSHC B,6
	JUMPE B,INIT2B
	IMULI A,10.
	ADDI A,-'0(B)
	JRST INIT2A
INIT2B:	LSH A,30		;VERSION NUMBER STORED IN LOC 137 AS
	MOVEM A,137		;0XXX00,,0
	MOVEI A,LISPGO
	HRRM A,.JBSA"
	MOVEM A,INIT
;SA$	MOVEI FREEAC,1	;SAIL SETUWP DOES NOT RETURN OLD VALUE IN AC AS DEC10
SA%	SETUWP FREEAC,	;RESTORE WRITE PROTECT STATUS
SA%	.VALUE
IFE SAIL,[
	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	EXIT 1,
]		;END OF IFE SAIL
IFN SAIL,[
	SETZ T,
	GETNAM T,
	MOVEM T, SGANAM
;	 JRST INIT7B
	PUSHJ P,SAVHGH		;SAVE HIGH SEGMENT AS SYS:MACLSP.SHR
	 JRST INIT7A
	OUTSTR [ASCIZ \:$INITIALIZED; HIGH SEGMENT SAVED$
\]
	SETZ T,			;RECALL THAT A CRUFTY CODE 15 MAKES PTLOAD HAPPY
	MOVE TT,[440700,,[ASCIZ \SAVE SYS:MACLSP
\]]
	PTLOAD T		;STICK SAVE COMMAND IN LINE EDITOR
	MOVEI T,INIT99
	HRRM T,RETHGH
	JRST KILHGH		;FLUSH HIGH SEGMENT

INIT7A:	OUTSTR [ASCIZ \:$FAILED TO SAVE HIGH SEGMENT$
\]
INIT7B:	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	SETZ T,			;RECALL THAT A CRUFTY CODE 15 MAKES PTLOAD HAPPY
	MOVE TT,[440700,,[ASCIZ \SSAVE SYS:MACLSP
\]]
	PTLOAD T		;STICK SAVE COMMAND IN LINE EDITOR
	EXIT 1,
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN D20,[
  	MOVE A,[SETO AR1,]
	MOVEM A,PURIFY
	MOVE A,BINIT9		;CLOBBER INIT, SINCE ONLY NEED DO ONCE
	MOVEM A,INITIALIZE
	MOVEI 1,.FHSLF
	MOVE 2,[1,,ENTVEC]
	SEVEC
	HRROI 1,[ASCIZ \
;Initialized
\]
	PSOUT
	SKIPN <.JBSYM==:116>	;ANY SYMBOL TABLE?
	 HALTF			;NOPE, DONE WITH INITIALIZATION
	HRROI 1,[ASCIZ \;Dump symbol table to file \]
	PSOUT
	MOVEI 1,.PRIIN		;CLEAR TTY INPUT BUFFER
	CFIBF
	HRLZI 1,(GJ%SHT\GJ%CFM\GJ%FOU\GJ%MSG\GJ%FNS)
	MOVE 2,[.PRIIN,,.PRIOU]
	GTJFN			;GET JFN FOR THE SYMBOL FILE
	 HALTF			;OH WELL, WE WERE GONNA STOP ANYWAY
	MOVE TT,1		;REMEMBER THE FILE HANDLE FOR LATER USE
	MOVE 2,[<44←36>+OF%WR]	;36 BIT BYTES, WRITE ACCESS
	OPENF
	 HALTF
	HRRZ 1,TT		;RESTORE JFN
	MOVE 2,.JBSYM		;OUTPUT THE SYMBOL TABLE POINTER
	BOUT			;OUTPUT THE AOBJN POINTER FIRST
	HRRZ 1,TT		;RESTORE JFN
	HRRZ 2,.JBSYM		;SYMBOL TABLE ADDRESS MINUS ONE
	HRLI 2,444400		;36 BIT BYTES
	HLRE 3,.JBSYM		;GET NEGATIVE LENGTH OF SYMBOL TABLE
	SOUT			;OUTPUT THE SYMBOL TABLE TO THE FILE
	HRROI 1,SYMFIL		;BLOCK TO GET NAME OF SYMBOL FILE
	HRRZ 2,TT		;GET JFN (LH ZERO)
	SETZ 3,			;GETS A SPEC TO GET BACK TO THE FILE LATER
	JFNS			;REMEMBER THE SYMBOL FILESEPC
	HRRZ 1,TT		;CLOSE THE FILE
	CLOSF
	 HALTF			;IGNORE FAILURE
	HALTF			;RETURN TO SUPERIOR

BINIT9:	JRST .+1
	HRROI 1,[ASCIZ \
;Already initialized
\]
	PSOUT
	HALTF
]		;END IFN D20
INIT99:	JRST LISPGO

;;; NOTE THAT THE SECOND $ IN THE MESSAGE HERE IS A REAL DOLLAR SIGN,
;;; WHILE THE OTHER TWO ARE ALTMODES; THUS DDT WON'T GET SCREWED!

IFN ITS,[
NOTINIT: .VALUE [ASCIZ \:≠LISP NOT INITIALIZED (USE INIT$G)≠
\]
]		;END OF IFN ITS

INIBSP:	REPEAT LLSYMS, .RPCNT

IFN D10,[

;;; ROUTINE TO CHECK SEGMENT BOUNDARIES, AND IF LOSING,
;;; TELL LOSER HOW TO WIN WITH LINK-10.

INIBD:	TRNN TT,SEGKSM
	 JRST 1(F)		;WIN
	SETO A,
	OUTSTR (F)
	OUTSTR [ASCIZ \ SEGMENT ON BAD BOUNDARY. TELL LINK "/SET:.\]
	OUTSTR (F)
	OUTSTR [ASCIZ \.:\]
	ANDI TT,SEGKSM
	ADDI T,SEGSIZ
	SUBI T,(TT)
	HRLZ TT,T
	MOVEI D,6
INIBD1:	SETZ T,
	LSHC T,3
	ADDI T,"0
	OUTCHR T
	SOJG D,INIBD1
	OUTSTR [ASCIZ \"
\]
	JRST 1(F)

]		;END OF IFN D10

IFN ITS,[
IFE SEGLOG-11,[		;VARIOUS PARAMETERS BUILT INTO UCODE
IFLE HNKLOG-5,[

;;; KL-10 INIT ROUTINE

KLINIT:	MOVE T,[-NSEGS,,GCST]
KLINI1:	MOVE TT,(T)
IFN HNKLOG,	TLNN TT,GCBFOO+GCBHNK
.ELSE		TLNN TT,GCBFOO
	 JRST KLINI2
	SETO D,
	TLNE TT,GCBSYM
	 MOVEI D,0
	TLNE TT,GCBVC
	 MOVEI D,1
	TLNE TT,GCBSAR
	 MOVEI D,2
IFN HNKLOG,[
	HRRZ R,ST(T)
	TLNE TT,GCBHNK
    2DIF [MOVEI D,(R)]3,QHUNK1
]		;END OF IFN HNKLOG
	SKIPGE D
	 .VALUE
IFN HNKLOG,	TLZ TT,GCBFOO+GCBHNK
.ELSE		TLZ TT,GCBFOO
	TLO TT,200000
	DPB D,[330300,,TT]
	MOVEM TT,(T)
KLINI2:	AOBJN T,KLINI1
	MOVE T,[JRST KLGCM1]
	MOVEM T,GCMRK0
	MOVE T,[JRST KLGCSW]
	MOVEM T,GCSWP
	.VALUE [ASCIZ \:≠INITIALIZED FOR KL-10≠
\]

]		;END OF IFLE HNKLOG-5
]		;END OF IFE SEGLOG-11
]		;END OF IFN ITS
IFN D10,[
LOPDL==200
LOFXPDL==100
LOSPDL==40
LOFLPDL==10
ALBPS==7000
SA$ ALBPS==ALBPS+4000
]		;END OF IFN D10

SUBTTL	HAIRY ALLHACK MACRO

DEFINE AMASC A,B
	ASCIZ \
A!B	\
TERMIN

DEFINE ALLHACK XLABEL,TP,NAME,STDALC,MINALC,EXTRA,WHERE,NWHERE
	SKIPE ALLF
	JRST XLABEL
	PUSHJ P,ALLTYO
	AMASC [TP! !NAME = ]\STDALC
	MOVE AR1,[ASCII \NAME\]
	PUSHJ P,ALLNUM
	SKIPGE A
XLABEL:	MOVEI A,STDALC
	CAIGE A,MINALC
	MOVEI A,MINALC
IFSN EXTRA,,	ADDI A,EXTRA
	HRRM A,WHERE
IFSN NWHERE,,[
	MOVN B,A
	HRRM B,NWHERE
]
	PUSHJ P,ALLECO
TERMIN

SUBTTL	ALLOC I/O ROUTINES

10% ALLJCL:	BLOCK 80.	;BUFFER UP JOB COMMAND LINE IF THERE WAS ONE.
10% ALJCLP:	-1	;ALLOW ONLY ONE TRY FOR JCL (JOB COMMAND LINE)
FAKJCL:	0	;NON-ZERO MEANS LOOKING FOR INIT FILE, 0 MEANS JCL FILE
ALLF:	0	;NON-ZERO FOR STANDARD ALLOCATION
AINFIL:	0	;NON-NIL MEANS LOAD .LISP. (INIT) FILE AFTER ALLOCING
ATYF:	0	;TTYOFF FOR ALLOC
LICACR:	0	;LAST INPUTED CHAR TO ALLOC WAS A CR   -1 ==> YES
ALERR:	STRT [SIXBIT \GC CALLED FROM ALLOC - LOSE, LISP IS DEAD!\]
	.VALUE


;;;	PUSHJ P,ALLTYO		;PRINT ASCIZ STRING FOR ALLOC
;;;	   ASCIZ \TEXT...\	;NOTE: ASCIZ IS NOT IN [ ... ] !

ALLTYO:	HRLI A,440700
	HLLM A,(P)
ATYOI:	ILDB A,(P)
	JUMPE A,POPJ1
	SKIPN ATYF
	PUSHJ P,ALLTYC
	JRST ATYOI

ALLECO:	SKIPL AFILRD
	SKIPE ATYF
	POPJ P,
	PUSH P,A
	MOVE TT,A
	HRROI R,TYO
	PUSHJ P,PRINL4
	POP P,A
	POPJ P,
IFN SAIL,[
SAILP4:	CAIN C,32		;A TILDE?
	JRST SAIP1
	CAIN C,176		;A }
	JRST SAIP2
	CAIE C,175		;AN ALTMODE
	JRST SAIP3
	MOVEI C,33
	JRST SAIP3
SAIP1:	MOVEI C,176
	JRST SAIP3
SAIP2:	MOVEI C,175
SAIP3:	TRZE C,600	;CTRL/META/BOTH?
	TRZ C,140
	CAIN C,121
	MOVEI C,21
	CAIN C,161
	MOVEI C,21
	CAIN C,127
	MOVEI C,27
	CAIN C,167
	MOVEI C,27
	POPJ P,
]	;END OF IFN SAIL

ALLTYI:
IFN ITS,[
Q%	.IOT TYIC,C
Q$	.IOT 0,C		;CHANNEL NUMBER FILLED IN
]	;END OF IFN ITS
IFN D10,[
	INCHRW C
SA$	PUSHJ P,SAILP4
	AOSG LICACR
	 JRST ATI1
ATI2:	CAIN C,↑M
	SETOM LICACR
]	;END OF IFN D10
IFN D20,[
	PUSH P,1
	PBIN
	MOVEI C,(1)
	POP P,1
]		;END IFN D20
	CAIN C,↑G
	 JRST ALLOC1
	POPJ P,

IFN D10,[
ATI1:	CAIN C,↑J		;FLUSH A SYSTEM-SUPPLIED LINE-FEED
	INCHRW C		;FOLLOWING A CR
SA$	PUSHJ P,SAILP4
	JRST ATI2
]	;END OF IFN D10

ALLTYC:
IFN ITS,[
	CAIE A,↑J
 ALOIOT:
 Q%	.IOT TYOC,A
 Q$	.IOT 0,A		;QIO WILL CLOBBER CHANNEL HERE
]	;END OF IFN ITS
10$	OUTCHR A
20$	PBOUT			;OUTPUT TO PRIMARY OUTPUT JFN
	POPJ P,

ALLRUB:	PUSHJ P,ALLTYO
	ASCIZ \XX
\
ALLNUM:	SKIPGE C,AFILRD	;GETS A NUMBER FOR SOME STORAGE AREA SIZE
	JRST ALNM1
ALNM2:	JUMPN C,ALNM27
	SETO A,
	POPJ P,
ALNM27:	HLRZ A,(C)	;SEARCH THE READ IN LIST TO SEE
	HRRZ C,(C)	;WHETHER LOSER HAS TRIED TO SPECIFY
	JUMPE C,ALLNER	;ALLOCATION FOR THIS QUANTITY
  	SKOTT A,SY
	 JRST ALSYER
  	HLRZ A,(A)
  	HRRZ A,1(A)
	HLRZ AR2A,(A)
	HLRZ A,(C)
	CAMN AR1,(AR2A)
	 JRST ALNM3
	HRRZ C,(C)
	JRST ALNM2

ALNM3:	MOVE TT,(A)		;GET NUMBER INTO TT
	SKOTT A,FL		;IF FLOATING CONVERT TO FIXNUM
	 SKIPA
	  PUSHJ P,FIX2
  	SKOTT A,FX		;IS IT FIXNUM?
	 JRST ALNMER
ALNMOK:	MOVE A,(A)
	POPJ P,

ALSYER:	MOVEI D,[SIXBIT \NON-SYMBOL ALLOCATION AREA!\]
	JRST ALCLZ1

ALNMER:	MOVEI D,[SIXBIT \NON-FIXNUM/FLONUM ALLOCATION QUANTITY!\]
	JRST ALCLZ1

ALLNER:	MOVEI D,[SIXBIT \ODD LENGTH ALLOCATION COMMENT!\]
	JRST ALCLZ1

ALNM1:	MOVSI B,400000
	MOVSI A,400000	;GET VALUE FROM TTY
ALNM1A:	PUSHJ P,ALLTYI
	CAIE C,12
	CAIN C,15
	POPJ P,
	CAIE C,33	;ALT MODE SAYS "DONE ALLOCING"
	JRST .+3
	SETOM ALLF
	POPJ P,
	CAIN C,".
	MOVE A,B
	MOVE D,RCT0(C)
	TLNE D,170000
	POPJ P,
	CAIL C,"0
	CAILE C,"9
	JRST ALLRUB
	TLZ A,400000
	TLZ B,400000
	IMULI A,10
	ADDI A,-"0(C)
	IMULI B,10.
	ADDI B,-"0(C)
	JRST ALNM1A

IFN D10,[
DECDIG:	SKIPE ATYF
	POPJ P,
	JUMPN T,DDIG1
	OUTCHR [ASCII \0\]
DDIG1:	JUMPE T,CPOPJ
	IDIVI T,10
	PUSH P,TT
	PUSHJ P,DECDIG
	POP P,TT
	ADDI TT,"0
	OUTCHR TT
	POPJ P,
]		;END OF IFN D10

SUBTTL	ALLOC (INIT) FILE ROUTINES

;SETUP DEAFULT JCL
IFN D10,[
ALFDEF:	SETOM FAKJCL		;JCL IS REALLY FAKE
	MOVE TT,[ASCII\LISP \]	;DEFAULT JCL: LISP <CR>
	MOVEM TT,SJCLBUF+1
	MOVE TT,[ASCII\
\]
	MOVEM TT,SJCLBUF+2
	POPJ P,
]	;END IFN D10
IFE QIO,[

ALOFIL:
IFN ITS,[MOVEI C,(SIXBIT \DSK\)	 ;STANDARD FILE NAMES
	MOVE A,[SIXBIT \.LISP.\] ; FOR INIT FILE
	MOVE B,[SIXBIT \(INIT)\]
	TDZA F,F		;F=0 => INIT REQUESTED VIA ↑Q OR ↑W
ALOFL1:	MOVNI F,1		;F<0 => INIT REQUESTED VIA JCL
ALOFL2:	MOVEM A,UTIN+1
	HRLI C,2
	MOVEM C,UTIN
	MOVEM B,UTIN+2
	.OPEN UTIC,UTIN		;SO TRY TO OPEN INIT FILE
	JRST ALFLER		;FILE NAMES ARE STILL IN A AND B
	SKIPLE F		;F>0 => WERE TRYING (INIT) DIRECTORY
	.SUSET [.SSNAM,,A]	; - WE WANT TO RESTORE OUR SNAME
]		;END OF IFN ITS
IFN D10,[
	MOVE A,[SIXBIT \LISP\]
	MOVSI B,(SIXBIT \INI\)
	MOVSI C+1,(SIXBIT \DSK\)
ALOFL1:	MOVEI C+2,UTIHED
	MOVEI C,0
	OPEN UTIC,C		;OPEN THE CHANNEL
	JRST ALFLER
	SETZB C,AR1		;USE NO PPN
SA$	DSKPPN=047000,,400071
SA$	DSKPPN AR1,
	LOOKUP UTIC,A
	JRST ALFLER		;FILE NAMES ARE STILL IN A AND B
	MOVEI T,UTIB-3
	EXCH T,.JBFF"
	INBUF UTIC,NIOBFS
	EXCH T,.JBFF"
]		;END OF IFN D10
	LOCKI			;UREAD2 WILL UNLOCKI
	MOVEM A,URFN1
IT$	MOVEM B,URFN2
10$	HLLZM B,URFN2
20$	WARN [WHAT THE HECK? IN ALOFIL]
	SETOM ALGCF		;TELLS UREAD NOT TO TRY TO CONS
	PUSHJ P,UREAD2		;DOES AN UNLOCKI
	SETZM ALGCF
	MOVEI A,TRUTH
	MOVEM A,TAPRED
	SETOM AFILRD
	POPJ P,
]		;END OF IFE QIO

IFN QIO,[
IFN ITS,[
ALOFL2:	CAMN A,[SIXBIT /*/]	;ALREADY TRIED **?
	 JRST ALFLER		;YUP, GIVE UP
	MOVE A,@ALOFL2		;ELSE TRY **
	JRST ALOINI
]	;END IFN ITS
ALOFIL:
IFN ITS,[
	MOVSI C,(SIXBIT \DSK\)
	.SUSET [.RXUNAME,,A]
	MOVE B,[SIXBIT \LISP\]
	.SUSET [.RHSNAME,,F]
ALOINI:	.CALL ALOFL6		;DOES INIT FILE EXIST?
	 JRST ALOFL2
	JRST ALOIN1		;ELSE PROCEED NORMALLY
ALOJCL:	.CALL ALOFL6		;DOES JCL FILE EXIST?
	 JRST ALFLER		;NOPE, ERROR
ALOIN1:	MOVEM C,INIIF2+F.DEV	;YES, SAVE FILE NAMES
	MOVEM F,INIIF2+F.SNM
	MOVEM A,INIIF2+F.FN1
	MOVEM B,INIIF2+F.FN2
ALOFL4:	.CLOSE TMPC,
]		;END IFN ITS
IFN D10,[
	HRLZI C+1,(SIXBIT/DSK/)
	MOVE A,[SIXBIT/LISP/]
	HRLZI B,(SIXBIT/INI/)
ALOFL1:	SETZB C,C+2
	OPEN TMPC,C
	 JRST ALFLER		;NO DISK?
	MOVEM C+1,INIIF2+F.DEV
	SETZI C,
	MOVE C+1,R		;GET SPECIFIED PPN
	MOVEM C+1,INIIF2+F.PPN
	LOOKUP TMPC,A
	 JRST ALFLER
	MOVEM A,INIIF2+F.FN1
	HLLZM B,INIIF2+F.FN2
	CLOSE TMPC,
];END IFN D10
	PUSH P,[ALOFL5]
	PUSH P,[INIIFA]
	PUSH P,[QNODEFAULT]	;DON'T MEREGE WITH DEFAULT FILENAMES
	MOVNI T,2
	JRST $EOPEN		;OPEN INIT FILE ARRAY
ALOFL5:	MOVEM A,VINFILE
	MOVEI A,TRUTH
	MOVEM A,TAPRED
	SETOM AFILRD
	POPJ P,

IFN ITS,[
ALOFL6:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	  5000,,2		;MODE (ASCII BLOCK INPUT)
	  1000,,TMPC		;CHANNEL #
	      ,,C		;DEVICE
	      ,,A		;FILE NAME 1
	      ,,B		;FILE NAME 2
	400000,,F		;SNAME
];END IFN ITS
]		;END OF IFN QIO

ALLFIL:	PUSHJ P,ALOFIL		;OPEN INIT FILE
ALLFL1:
Q%	SETOM RRDF
Q$	SETZM BFPRDP
	PUSHJ P,READ		;READ IN ALLOCATIONS "COMMENT"
	SETZM ALGCF
	HLRZ B,(A)
	CAIE B,Q$COMMENT
	JRST ALCLUZ
ALLFL2:	HRRZ A,(A)
	MOVEM A,AFILRD		;SAVE IT (ACTUALLY, ITS CDR)
	JRST ALLOCC

ALCLUZ:	MOVEI D,[SIXBIT \ALLOC COMMENT MISSING IN INIT FILE!\]
ALCLZ1:
Q%	MOVE A,URFN1
Q%	MOVE B,URFN2
IFN QIO,[
	HRRZ A,VINFILE
	SETZM VINFILE
	PUSH FXP,D
	PUSHJ P,$CLOSE
	POP FXP,D
20%	MOVE A,INIIF2+F.FN1
20%	MOVE B,INIIF2+F.FN2
IT$	MOVE F,INIIF2+F.SNM
10$	MOVE F,INIIF2+F.PPN
20$	WARN [WHAT TO DO FOR FILE NOT FOUND ERROR FOR D20 ALLOC]
]		;END OF IFN QIO
	SETZM FAKJCL		;FORCE ERROR MESSAGE THROUGH EVEN IF FAKING JCL
	JRST ALCERR

IFN ITS,[
ALLTTS:	SETZ		;TTYSET FOR ALLOC - NO INTERRUPT CHARS!
	SIXBIT \TTYSET\		;SET TTY VARIABLES
Q%	  1000,,TYIC		;CHANNEL #
Q$	      ,,TTYIF2+F.CHAN	;CHANNEL #
	      ,,[STTYA1]	;TTYST1
Q%	      ,,[STTYA2]	;TTYST2
Q$	400000,,[STTYA2]
Q%	400000,,STTYSS		;TTYSTS
]		;END OF IFN ITS

ALHELP:	PUSHJ P,ALLTYO
	ASCIZ \
N = DON'T ALLOCATE (I.E. USE DEFAULTS)
Y = ALLOC FROM TTY
↑Q = READ INIT FILE AND ALLOC FROM IT
↑S = ALLOC FROM TTY, THEN READ INIT FILE
↑W = SAME AS ↑Q, BUT NO ECHO ON TTY
ALTMODE, TYPED AT ANY TIME, TERMINATES ALLOCATION PHASE, 
   TAKING REMAINING PARAMETERS AS DEFAULTS.
↑G RESTARTS ALLOC.
LINES PROMPTED BY A "#" CANNOT BE RE-ALLOCATED AFTER RUNNING.
   OTHERS CAN BE RE-ALLOCATED AT ANY TIME
   WITH THE LISP FUNCTION "ALLOC".
TERMINATE EACH NUMERIC ENTRY WITH CR OR SPACE.
A CR OR SPACE TYPED WITHOUT A PRECEDING NUMBER
   ASSUMES THE DEFAULT FOR THAT ENTRY.
RUBOUT RESTARTS THE CURRENT ENTRY.
NUMBERS ARE TYPED IN BASE EIGHT, UNLESS SUFFIXED BY ".",
   IN WHICH CASE BASE TEN IS USED.
ALL ENTRIES ARE IN UNITS OF PDP-10 WORDS.
\
	JRST ALLOC1

ALFLER:
IFE D10\QIO,[
	JUMPG F,ALFLE3		;LOSE IF WE ALREADY TRIED (INIT);
	CAME B,[SIXBIT \(INIT)\]
	JRST ALFLE3		;LOSE IF SECOND NAME NOT (INIT)
	MOVE B,A		;ELSE PERMUTE  FOO;BAR (INIT)  TO BE
	.SUSET [.RSNAM,,A]	;  (INIT);FOO BAR  INSTEAD
	.SUSET [.SSNAM,,[SIXBIT \(INIT)\]]
	MOVEI F,1		;WE CAN ONLY TRY THIS HACK ONCE
	JRST ALOFL2

ALFLE3:	JUMPL F,ALFLE4		;IF WE WERE LOOKING AT THE (INIT)
	.SUSET [.SSNAM,,A]	; DIRECTORY, MUST RESTORE THINGS
	MOVE A,B
	MOVE B,[SIXBIT \(INIT)\]
ALFLE4:
]		;END OF IFE D10\QIO
	MOVEI D,[SIXBIT \   INIT FILE NOT FOUND!\]
ALCERR:	SETZM TAPRED
	SETZM TTYOFF
	SETZM TAPWRT
	AOSN FAKJCL		;DID WE FAKE JCL?
	 JRST POPJ1		;YUP, THEN SKIP RETURN SO CAN DO ALLOC
	STRT [SIXBIT \    !\]
IFN ITS,[
Q%	.SUSET [.RSNAM,,AR1]
Q$	MOVE AR1,F
	MOVEI T,";
	PUSHJ P,ALFL6
]		;END OF IFN ITS
	MOVE AR1,A
10%	MOVEI T,40
10$	MOVEI T,".
	PUSHJ P,ALFL6
	MOVE AR1,B
	MOVEI T,40
	PUSHJ P,ALFL6
	STRT (D)
SA$	CLRBFI			;CLEAR INPUT BUFFER FOR SAIL
	MOVNI T,0		;SETUP FOR NO ARG LSUBR CALL
	JRST QUIT		; (VANILLA-FLAVORED QUIT)

ALFL6:	SETZ AR2A,
	MOVE TT,[440600,,AR1]
ALFL6A:	ILDB R,TT
	JUMPE R,ALFL6B
	ADDI R,40
IT$ Q%	.IOT TYOC,R
IT$ Q$	ALFL6C:	.IOT 0,R	;CHANNEL # FILLED IN
10$	OUTCHR R
10X WARN [TTY OUTPUT]
	JRST ALFL6A
ALFL6B:
IT$ Q%	.IOT TYOC,T
IT$ Q$	.IOT 0,T		;CHANNEL # FILLED IN
10$	OUTCHR T
10X WARN [TTY OUTPUT]
	POPJ P,

SUBTTL	MAIN ALLOC INTERACTION CODE

%ALLOC:
IFN D10,[
	SETZM LICACR		;LAST INPUT CHAR TO ALLOC WAS? CR - NO!
IFE SAIL,[
	MOVEM 0,SGANAM		;SAVE MAGIC STUFF FOR GETHGH
	MOVEM 11,SGADEV
	MOVEM 7,SGAPPN
	MOVE A,[%CNMNT]		;GET MONITOR TYPE WORD
	GETTAB A,
	 MOVEI A,010000		;ASSUME TOPS-10 IF GETTAB ENTRY NOT THERE
	LDB A,[.BP CN%MNT,A]	;1 = TOPS-10, 2 = ITS, 3 = TENEX, ...
	CAIE A,1		;REAL TOPS-10 SYSTEM, RATHER THAN SIMULATOR?
	 SETZB A,SGANAM		; ON VARIOUS SIMULATIONS, DONT KILL HISEG
]		;END OF IFE SAIL
Q$	MOVEI A,ENDLISP+PAGSIZ-1;MUST DO CRUFTY CALCULATION BY HAND AS INVOLVES
Q$	ANDI A,PAGMSK		;BOOLEAN OPS AND RELOCATABLE SYMBOLS (BARF!!)
Q$	SUBI A,EINIFA
Q$	MOVEM A,IGCFX1
]		;END OF IFN D10
	MOVE A,[RCT0,,RCT]
	BLT A,RCT+LRCT-1
IFN ITS,[
	MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<FLPORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
]		;END OF IFN ITS
	MOVE P,C2
	MOVE SP,SC2
	MOVE FXP,FXC2
	MOVE FLP,FLC2
	MOVE A,[-LFSALC+1,,FSALC+1]	;SET UP ALLOC CONSING AREAS
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-LFWSALC+1+NIFWAL,,FWSALC+1+NIFWAL]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-LSYALC+1,,SYALC+1]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-NIS2SG*SEGSIZ/2+1,,SY2ALC+2]
	HRRZM A,-2(A)
	ADDI A,1
	AOBJN A,.-2
	MOVE A,[-INFVCS+1,,BFVCS+1]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVEI A,FSALC		;SET UP PHONY FREELISTS
	MOVEM A,FFS
	MOVEI A,FWSALC+NIFWAL
	MOVEM A,FFX
  	MOVEI A,SYALC
  	MOVEM A,FFY
	SETOM ALGCF		;ERROR OUT ON GC (UNTIL FURTHER NOTICE)
	SETZB NIL,ATYF
	SETOM AFILRD
IFE QIO\<ITS-1>,[
	MOVSI TT,(ASCII \@\)
	MOVEM TT,UFN1
	MOVEM TT,UFN2
	MOVE TT,[STTYW1]
	MOVEM TT,STTYS1
	MOVE TT,[STTYW2]
	MOVEM TT,STTYS2
	PUSHJ P,TTYOPN
]		;END OF IFE QIO\<ITS-1>
IFN QIO,[
IT$	.SUSET [.RSNAM,,T]
10$ SA%	GETPPN T,
10$ SA%	 JFCL
10$ SA$	SETZ T,
10$ SA$	DSKPPN T,		;AS SET BY ALIAS COMMAND
IRP FIL,,[TTYIF2,TTYOF2]
IT$	MOVEM T,FIL+F.SNM
10$	MOVEM T,FIL+F.PPN
TERMIN
IFE D20,[
	PUSH FXP,[SIXBIT \DSK\]
	PUSH FXP,T
REPEAT 2, PUSH FXP,[SIXBIT \@\]
]		;END IFE D20
IFN D20,[
	PUSH FXP,[ASCIZ \DSK\]
REPEAT L.6DEV-1, PUSH FXP,R70
	MOVE TT,FXP
REPEAT L.6DIR, PUSH FXP,R70
	GJINF			;GET JOB INFORMATION, AC2 GETS CONNECTED DIR
	HRROI 1,PNBUF		;USE PNBUF TO READ BACK STRING
	DIRST			;GET EQUIVALENT ASCII STRING
	 HALT			;HMMM.....
	DPB NIL,1		;FORCE A NULL BYTE
	HRROI 1,1(TT)		;WHERE TO WRITE STRING
	HRROI 2,PNBUF		;SOURCE STRING
	HRLZI 3,010000+JS%PTR	;RETURN DIRECTORY FIELD ONLY
	SETZ 4,			;IGNORED
	JFNS			;READ BACK DIRECTORY ON STACK
	SETZB 1,2
	SETZB 3,4
	PUSH FXP,[ASCIZ \FOO\]
REPEAT L.6FNM-1, PUSH FXP,R70
	PUSH FXP,[ASCIZ\LISP\]
REPEAT L.6EXT-1, PUSH FXP,R70
REPEAT L.6VRS, PUSH FXP,0
]		;END IFN D20
	PUSHJ P,6BTNML
	MOVEM A,VDEFAULTF
	PUSHJ P,OPNTTY		;OPEN TTY INPUT AND OUTPUT
	 .VALUE			;MUST HAVE TTY TO DO ALLOC
IFN ITS,[
	MOVE T,TTYOF2+F.CHAN	;INITIALIZE CHANNEL NUMBER FOR
	DPB T,[270400,,ALOIOT]	; ALLOC'S OUTPUT .IOT TO TTY
	DPB T,[270400,,ALFL6B]
	DPB T,[270400,,ALFL6C]
	MOVE T,TTYIF2+F.CHAN	;NOW DO THE SAME FOR
	DPB T,[270400,,ALLTYI]	; THE INPUT .IOT
]	;END IFN ITS
]		;END OF IFN QIO
IFN ITS,[
	AOSE ALJCLP
	 JRST ALJ3
	.SUSET [.ROPTION,,TT]
	SETZM FAKJCL		;NOT FAKE JCL
	TLNE TT,20000		;NOT DDT ABOVE LISP
	 TLZN TT,40000		;IF THERE IS JCL, TURN IT OFF AFTER READING
	  SOSA FAKJCL		;NO JOB COMMAND LINE, FLAG AS FAKE JCL
	.BREAK 12,[..RJCL,,ALLJCL]
ALFDE1:	SETZB A,C
	SETZB D,F
	SETZ B,
	MOVE AR1,[440700,,ALLJCL]
ALJ1:	MOVE AR2A,[440600,,T]
	SETZ T,
ALJ1A:	ILDB TT,AR1
	JUMPE TT,ALJ2
	CAIGE TT,"!
	 JRST ALJ1B
	CAIE TT,":
	 JRST ALJ1A1
Q%	HLRZ C,T
Q$	MOVE C,T
	AOJA D,ALJ1

ALJ1A1:	CAIE TT,";
	 JRST ALJ1A2
	MOVE F,T
	AOJA D,ALJ1

ALJ1A2:	CAIL TT,"a	;LOWER-CASE
	 CAILE TT,"z
	  ADDI TT,40
	ANDI TT,77
	TLNE AR2A,770000
	 IDPB TT,AR2A
	JRST ALJ1A

ALJ1B:	JUMPE T,ALJ1B2
	JUMPE A,ALJ1B1
	MOVEM T,B
	JRST ALJ1B2
ALJ1B1:	MOVEM T,A
ALJ1B2:	CAIN TT,33		;ALTMODE MEANS INIT FILE CAN GET JCL
	 JRST ALJ2Q
	CAIE TT,↑M
	 JRST ALJ1
ALJ2:	.SUSET [.ROPTION,,TT]
	TLZ TT,OPTCMD		;TURN OFF JCL
	.SUSET [.SOPTION,,TT]
ALJ2Q:	SKIPN C
Q%	 MOVEI C,(SIXBIT \DSK\)
Q$	 MOVSI C,(SIXBIT \DSK\)
	JUMPN A,ALJ2A
	SKIPN FAKJCL		;IF JCL FAKED, ALWAYS READ INIT
	 JUMPE D,ALJ3		;IF WAS REALLY NULL THEN DON'T TRY TO READ INIT
	MOVE B,[SIXBIT \LISP\]	;ASSUME FN2 OF LISP
	SKIPN F			;SNAME SPECIFIED?
	 .SUSET [.RHSNAME,,F]	;NOPE, USE THE HSNAME
	.SUSET [.RXUNAME,,A]	;XUNAME IS FIRST TRY AT FN1
	SETOM ATYF		;TURN OF TTY OUTPUT
	PUSHJ P,ALOINI		;TRY TO FIND FILE, USE INIT FILE ALGORITHM
	 JRST ALLFL1		;FILE FOUND
	JRST ALJ2A1
ALJ2A:
	SKIPN F			;DEFAULT SNAME?
	 .SUSET [.RSNAM,,F]
	SKIPN B			;DEFAULT FN2?
	 MOVSI B,(SIXBIT />/)
	SETOM ATYF
	PUSHJ P,ALOJCL
	JRST ALLFL1

ALJ2A1:	SETZM ATYF		;TURN ON TTY I/O
ALJ3:	.CALL ALLTTS
	.VALUE
]		;END OF IFN ITS

IFN D10,[
	SETZM FAKJCL		;NOT FAKE JCL YET
	JSP F,JCLSET
	SKIPN SJCLBUF+1		;ANY JCL?
	 PUSHJ P,ALFDEF		;SETUP DEFAULT JCL
	SETZB D,R		;D IS FLAG FOR . SEEN, R IS PPN
	SETZB A,C
	MOVSI B,(SIXBIT \INI\)
	MOVE AR1,[440700,,SJCLBUF+1]
ALJ1:	MOVE AR2A,[440600,,T]
	SETZ T,
ALJ1A:	ILDB TT,AR1
	JUMPE TT,ALJ2
	CAIGE TT,"!
	 JRST ALJ1B
	CAIE TT,":
	 JRST ALJ1A1
	MOVE C,T
	JRST ALJ1

ALJ1A1:	CAIE TT,".
	 JRST ALJ1A2
	MOVE A,T
	SETZ B,
	AOJA D,ALJ1

ALJ1A2:	CAIE TT,"[		;START OF PPN SPEC?
	 JRST ALJ1A3
SA%	GETPPN R,		;HOLD PPN IN R
SA%	 JFCL			;IGNORE FUNNY SKIP RETURNS
SA$	SETZ R,
SA$	DSKPPN R,		;ON SAIL USE ALIAS
	PUSHJ P,HAFPPN		;READ 1/2 PPN, SKIP IF ZERO
	 HLR R,T
	CAIE TT,",		;IF TERMINATOR NOT COMMA THEN GIVE UP ON PPN
	 JRST ALPPN1
	PUSHJ P,HAFPPN		;READ THE OTHER HALF OF THE PPN
	 HRR R,T		;REPLACE IN GENERATED PPN
	CAIE TT,"]		;TERMINATING CLOSE BRACKET?
ALPPN1:	 MOVE TT,C+2		;NOPE, RESTORE OLD BYTE POINTER
	JRST ALJ1

ALJ1A3:	CAIL TT,"a		;LOWER CASE
	 CAILE TT,"z
	  ADDI TT,40
	ANDI TT,77
	TLNE AR2A,770000
	 IDPB TT,AR2A
	JRST ALJ1A

ALJ1B:	JUMPE T,ALJ1B2
	SKIPN D
	 SKIPA A,T
	  HLLZ B,T
ALJ1B2:	CAIN TT,33	;ALT-MODE SAYS DONT FLUSH JCL
	 JRST ALJ2Q
	CAIN TT,↑M
	 JRST ALJ1
ALJ2:	SETZM SJCLBUF
ALJ2Q:	SKIPN C+1,C
	 MOVSI C+1,(SIXBIT \DSK\)
	SETOM ATYF
	PUSHJ P,ALOFL1		;SKIP RETURN MEANS INIT FILE NOT FOUND
	 JRST ALLFL1

	SETZM ATYF		;TURN ON TTY I/O
	JRST ALJ3

HAFPPN:	SETZ T,			;START OFF WITH 0
	MOVE C+2,AR1		;SAVE CURRENT BYTE POINTER
	ILDB TT,AR1
	CAIL TT,"0		;MUST BE NUMERIC
	 CAILE TT,"9
	  JRST HAFPP1
	LSH T,3			;ADD DIGIT INTO PPN
	ADDI T,-"0(TT)
	JRST HAFPPN
HAFPP1:	SKIPN T			;SKIP RETURN IF T NIL
	 AOS (P)
	POPJ P,

ALJ3:
]		;END OF IFN D10
	PUSHJ P,ALLTYO
	ASCIZ \
LISP \
	MOVE B,[LVRNO]
ALLOCB:	SETZ A,
	LSHC A,6
	JUMPE A,ALLOCA
	ADDI A,40
	PUSHJ P,ALLTYC
	JRST ALLOCB

ALLOCA:
IFN D10*<1-QIO>,[
	PUSHJ P,SIXJBN
	MOVE TT,D10NAM ;MOVE IN ###LSP FOR FILENAME
	MOVEM TT,UFN1
	MOVSI TT,(SIXBIT /TMP/)
	MOVEM TT,UFN2
]		;END OF IFN D10*<1-QIO>
IFE ITS,[
	PUSHJ P,ALLTYO
Q% 	ASCIZ \ with OLD I/O\
Q$	ASCIZ \ with NEW I/O\
]
ALLOC1:	PUSHJ P,ALLTYO
	ASCIZ \
Alloc? \
	PUSHJ P,ALLTYI
	SETZM ALLF
	CAIN C,↑W
	SETOM ATYF
	CAIE C,↑W
	CAIN C,↑Q
	JRST ALLFIL
	CAIE C,33	;ALTMODE
	CAIN C,40	;SPACE
	SETOM ALLF
	CAIE C,↑S
	JRST .+3
	SETOM AINFIL
	JRST ALLOCC
	CAIE C,"n	;LOWER CASE
	CAIN C,"N
	SETOM ALLF
	SKIPE ALLF
  	JRST ALLOCC
	CAIE C,"Y
	CAIN C,"y	;LOWER CASE
	JRST ALLOCC
	CAIN C,"?
	JRST ALHELP
	CAIE C,"H
	CAIN C,"h	;LOWER CASE
	JRST ALHELP
SA$	BEEP=047000,,400111
SA$	SETOM A
SA$	BEEP A,
SA%	MOVEI A,↑G	;RANDOM ILLEGAL CHARACTER TO ALLOC
SA%	PUSHJ P,ALLTYC
Q% IT$	.RESET TYIC,	;RESET ANY TYPE-AHEAD
Q% 10$	CLRBFI
Q$ IT$	HRRZ TT,TTYIF2+F.CHAN
Q$ IT$	.CALL CKI2I
Q$ IT$	 .VALUE
20$	MOVEI 1,.PRIIN
20$	CFIBF
	JRST ALLOC1


IFN ITS+D20,[
ALCORX==<BBPSSG-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
ALCORE==ALCORX+<MAXFFS+MAXFFX+MAXFFL+MAXFFB+MAXFFY+MAXFFA+PAGSIZ-1>/PAGSIZ
]
.ELSE [
ALCORX==<BBPSSG-FIRSTLOC+STDLO-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
ALCORE==ALCORX+4
]

ALLOCC:
10$	ALLHACK ASBPS,#,BPS,ALBPS,ENDLISP-BBPSSG,,BPSH
	ALLHACK ASRPDL,#,REGPDL,ALPDL,200,100,OC2
	ALLHACK ASSPDL,#,SPECPDL,ALSPDL,200,100,OSC2
	ALLHACK ASFXP,#,FXPDL,ALFXP,200,LSWS+12,OFXC2
	ALLHACK ASFLP,#,FLPDL,ALFLP,10,10,OFLC2
10$	ALLHACK ASDDT,#,DDTSYMS,100,20,,SYMLO
	ALLHACK ASLIST,,LIST,MAXFFS,200,,XFFS
	ALLHACK ASSYM,,SYMBOL,MAXFFY,200,,XFFY
	ALLHACK ASFIX,,FIXNUM,MAXFFX,200,,XFFX
	ALLHACK ASFLO,,FLONUM,MAXFFL,200,,XFFL
IFN BIGNUM,	ALLHACK ASBIG,,BIGNUM,MAXFFB,100,,XFFB
	ALLHACK ASARY,,ARRAY,MAXFFA,100,,XFFA
	PUSHJ P,ALLTYO
	ASCIZ \
\


SUBTTL	RUNTIME STORAGE ALLOCATION

	MOVEI TT,ALCORX*PAGSIZ
IRP Q,,[S,X,L,B,Y,A]Z,,[FS,FX,FL,BN,SY,SA]N,,[NIFSSG+2,NIFXSG+2
NIFLSG+1,NBNSG,NSYMSG+1,NSARSG]FLG,,[1,1,1,BIGNUM,1,1]
IFN FLG,[
	MOVEI T,<N>*SEGSIZ
	CAML T,XFF!Q
	MOVEM T,XFF!Q
	MOVE T,XFF!Q
	CAMGE T,G!Z!SIZ
	MOVEM T,G!Z!SIZ
	ADD TT,T
	LSH T,-4	;HACK
	CAIGE T,SEGSIZ
	MOVEI T,SEGSIZ
	CAILE T,4000
	MOVEI T,4000
	CAML T,G!Z!SIZ
	SUBM T,G!Z!SIZ
]		;END OF IFN FLG
TERMIN
	MOVEI D,ALCORE
	SUB D,TT
	JUMPLE D,ALLCZX
IRP Q,,[S,X,L,Y]%%%,,[70.,15.,3.,12.]
	MOVEI T,(D)
	IMULI T,%%%
	IDIVI T,100.
	ADDM T,XFF!Q
TERMIN
ALLCZX==.

;FALLS THROUGH


;FALLS IN

IFN PAGING,[

ALLCPD:	SETZ F,
	MOVEI R,MEMORY-NSCRSG*SEGSIZ
IRP Q,,[SC2,C2,FLC2,FXC2]Y,,[1,0,0,0]W,,[SPDL,PDL,FLP,FXP]
	MOVEI T,(R)
	SUBI T,MIN!W
	EXCH T,O!Q
	CAIGE T,MIN!W
	MOVEI T,MIN!W
	MOVEM T,X!W
	ADDI T,PAGSIZ-1+MIN!W
	ANDI T,PAGMSK
	MOVEI TT,(T)
	LSH TT,-PAGLOG
	SUBI F,(TT)
	SUBI R,(T)
	MOVEI D,PAGSIZ-20
	CAML D,X!W
	MOVE D,X!W
	MOVNS D
	HRLS D
	HRRI D,(R)
IFN <Y>,	ADD D,R70+Y
	MOVEM D,Q
	MOVEI D,(R)
	ADD D,X!W
	ANDI D,777760	;KEEP AWAY FROM PAGE BOUNDARIES!
	TRNN D,PAGKSM
	SUBI D,20
	MOVEM D,X!W
	MOVEM D,Z!W
TERMIN
	HRLM F,PDLFL1
	IMULI F,SGS%PG
	HRLM F,PDLFL2
	MOVEI F,(R)
	LSH F,-PAGLOG
	HRRM F,PDLFL1
	MOVEI F,(R)
	LSH F,-SEGLOG
	HRRM F,PDLFL2
	SUBI R,1
	MOVEM R,HINXM
	HRRZ A,SC2
	MOVEM A,ZSC2
	HRRZ A,C2
	ADDI A,1
	MOVEM A,NPDLH
	HRRZ A,FXC2
	ADDI A,1
	MOVEM A,NPDLL
	JRST ALLDONE

]		;END OF IFN PAGING


;FALLS IN

IFE PAGING,[

ALLCPD:	MOVEI A,BFXPSG
	MOVEM A,NPDLL
	MOVEI B,LOFXPDL		;SET UP FXP
	ADD B,OFXC2
	ADDI B,SEGSIZ-1
	ANDI B,SEGMSK
	MOVNI C,-LOFXPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,FXC2
	ADDI C,-LOFXPDL(B)
	HRLI C,-LOFXPDL
	MOVEM C,OFXC2
	MOVE C,[FX+$PDLNM,,QFIXNUM]
	JSP T,ALSGHK
	MOVEI B,LOFLPDL		;SET UP FLP
	ADD B,OFLC2
	ADDI B,SEGSIZ-1
	ANDI B,SEGMSK
	MOVNI C,-LOFLPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,FLC2
	ADDI C,-LOFLPDL(B)
	HRLI C,-LOFLPDL
	MOVEM C,OFLC2
	MOVE C,[FL+$PDLNM,,QFLONUM]
	JSP T,ALSGHK
	MOVEM A,NPDLH
	MOVEI B,LOPDL+LOSPDL+1		;SET UP P AND SP
	ADD B,OC2
	ADD B,OSC2
	MOVEI AR1,SEGSIZ-1(B)
	ANDI AR1,SEGMSK
	MOVEI AR2A,(AR1)
	MOVEI F,(A)
	SUBI AR1,(B)
	LSH AR1,-1			;SPLIT SEGMENT REMAINDER
	MOVE B,OC2
	ADDI B,LOPDL(AR1)
	MOVNI C,-LOPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,C2
	ADDI C,-LOPDL(B)
	HRLI C,-LOPDL
	MOVEM C,OC2
	ADDI A,(B)
	MOVE B,OSC2
	ADDI B,LOSPDL+1(AR1)
	MOVNI C,-LOSPDL-1(B)
	MOVSI C,(C)
	HRRI C,(A)	.SEE UBD	;SP NEEDS FUNNY SLOT
	MOVEM C,SC2
	HRRZM C,ZSC2
	ADDI C,-LOSPDL-1(B)
	HRLI C,-LOSPDL
	MOVEM C,OSC2
	MOVEI A,(F)
	MOVEI B,(AR2A)
	MOVE C,[$XM,,QRANDOM]
	JSP T,ALSGHK
	MOVEM A,BPSL
	MOVEM A,VBP1
	MOVE C,A
	ADDB C,BPSH		;FIRST ESTIMATE OF BPSH
	HRRE B,.JBSYM
	JUMPLE B,ALCPD1		;ONLY HACK SYMBOLS IF IN LOW SEGMENT
	SUB B,SYMLO
	CAIG C,(B)
	MOVE C,B
	MOVEM C,BPSH		;SECOND ESTIMATE OF BPSH
	ADD C,SYMLO
	HLRE B,.JBSYM"
	HRRO D,.JBSYM
	SUB D,B
	SUBI D,1			;TO BE A PDL PTR IN THE SYMMOV
	SUB C,B
ALCPD1:	IORI C,SEGKSM			;HIGHEST ADDR FOR AUGMENTED SYMTAB
	MOVEI B,1(C)
	CAMG C,.JBFF
	 JRST .+3
	CORE C,
	 JRST ALQX2
	HRRM B,.JBFF"
	MOVEI F,-1(B)
	SUB B,BPSL		;TOTAL NUMBER WDS OCCUPIED BY RANDOM BPS AND SYMTAB
	SUBI F,(D)		;TOTAL DISTANCE THAT SYMTAB MOVES
	HRRE R,.JBSYM
	JUMPLE R,ALQX1		;ONLY HACK SYMBOLS IF THERE OR IN LOW SEGMENT
	HLRE R,.JBSYM
	JUMPE F,ALQX1
	MOVE TT,[SYMMOV,,SYMMV1]
	BLT TT,LPROGS
	HRRI SYMMV1,(F)
	JRST SYMMV1
SYMMV6:	ADDI SYMMV1,1(D)
	HRRM SYMMV1,.JBSYM"
	SUB SYMMV1,SYMLO
	SUBI SYMMV1,1
	HRRZM SYMMV1,BPSH			;IF THERE WAS A SYMTAB, NOW WE KNOW WHERE BPSH IS
IFE SAIL,[
	MOVE F,[112,,11]
	GETTAB F,
	 SETZ F,
	LDB F,[061400,,A]
	CAIN F,3
	 HRRM SYMMV1,@770001	;TENEX SIMULATOR FOR TOPS-10
]		;END OF IFE SAIL
ALQX1:	MOVE C,SYMLO
	ASH C,-1
	MOVEM SYMLO		;CONVERT FROM # OF WORDS TO  # OF ENTRIES
	HRRZ C,BPSH
Q$	SUB C,IGCFX1		;IF NEWIO, MUST ALLOW FOR INITIAL ARRAY
Q$	SUB C,IGCFX2		;AND INIT FILE ARRAY
	MOVEM C,VBPE1		;INITIAL SETTING OF BPEND
	MOVE C,[$XM,,QRANDOM]
	JSP T,ALSGHK
	MOVEI C,-1(A)
	MOVEM C,HIXM
	MOVEI B,HILOC
	ANDI B,SEGMSK
	SUBI B,(A)
	MOVE C,[$NXM,,QRANDOM]
	JSP T,ALSGHK
	JRST ALLDONE

ALSGHK:	MOVEI TT,(A)
	MOVNI D,(B)
	LSH TT,-SEGLOG
	ASH D,-SEGLOG
	HRLI TT,(D)
	MOVEM C,ST(TT)
	AOBJN TT,.-1
	ADDI A,(B)
	JRST (T)

ALQX2:	PUSHJ P,ALLTYO
	ASCIZ \
CAN'T GET ENOUGH CORE!\
	JRST ALLOC1
]		;END OF IFE PAGING

ALLDONE:
	MOVEI A,LISP
	HRRM A,LISPSW
10$	MOVEI A,GOINIT
10$	HRRM A,.JBSA"
	SETZM ALGCF		;GC IS OKAY NOW
	JRST LISP

CONSTANTS	;ALLOC'S LITERALS GET EXPANDED HERE

IFN D10,[

SYMMOV:			;MOVE MOBY JOB SYMBOL TABLE UPWARDS
OFFSET C-.
SYMMV1:	POP D,.(D)	;C
	AOJL R,SYMMV1	;AR1
	JRST SYMMV6	;AR2A
LPROGS==.-1
OFFSET 0
.HKILL SYMMV1

]		;END OF IFN D10



IFN QIO,[

;;; INITIAL ARRAYS IN SYSTEM GO HERE.
	.SEE GCMKL
	.SEE IGCMKL
	.SEE VBPE1


SUBTTL	INITIAL INIT FILE ARRAY FOR .LISP. (INIT) FILE

	-F.GC,,INIIF2		;GC AOBJN POINTER
INIIF1:	JSP TT,1DIMS
		INIIFA		;POINTER TO SAR
		0		;CAN'T ACCESS
INIIF2:
OFFSET -.
	FI.EOF::	NIL		;EOF FUNCTION
	FI.BBC::	0,,NIL		;BUFFERED BACK CHARS
	FI.BBF::	NIL		;BUFFERED BACK FORMS
			BLOCK 5
	F.MODE::	0		;MODE (BLOCK ASCII DSK INPUT)
	F.CHAN::	-1		;CHANNEL # (INITIALLY ILLEGAL)
	20$ F.JFN::	-1		;JOB-FILE NUMBER
	20%		0
	F.FLEN::	0		;FILE LENGTH
	F.FPOS::	-1		;FILEPOS
			BLOCK 3
IFN ITS+D10,[
	F.DEV::		SIXBIT \DSK\	;DEVICE
IT$	F.SNM::		0		;SNAME (FILLED IN)
10$	F.PPN::		0		;PPN (FILLED IN)
IT$	F.FN1::		SIXBIT \.LISP.\	;FILE NAME 1
10$	F.FN1::		SIXBIT \LISP\
IT$	F.FN2::		SIXBIT \(INIT)\	;FILE NAME 2
10$	F.FN2::		SIXBIT \INI\
	F.RDEV::	BLOCK 4		;.RCHST'D NAMES
]		;END OF IFN ITS+D10
IFN D20,[
	F.DEV::		ASCIZ \DSK\	;DEVICE
		BLOCK L.6DEV-<.-F.DEV>
	F.DIR::				;DIRECTORY (FILLED IN)
		BLOCK L.6DIR-<.-F.DIR>
	F.FNM::		ASCIZ \INIT\	;FILE NAME
		BLOCK L.6FNM-<.-F.FNM>
	F.EXT::		ASCIZ \MACLISP\	;EXTENSION
		BLOCK L.6EXT-<.-F.EXT>
	F.VRS::				;VERSION
		BLOCK L.6VRS
]		;END OF IFN D20
LOC INIIF2+LOPOFA
		BLOCK 5
	AT.CHS::	0		;CHARPOS
	AT.LNN::	0		;LINENUM
	AT.PGN::	0		;PAGENUM
		BLOCK 10
LONBFA::
	FB.BYT::	0		;BYTE SIZE
	FB.BFL::	0		;BUFFER LENGTH
	FB.BVC::	0		;COUNT OF VALID CHARACTERS
IFN ITS+D20,[
	FB.IBP::	0		;INITIAL BYTE POINTER
	FB.BP::		0		;BYTE POINTER
	FB.CNT::	0		;CHARACTER COUNT
		BLOCK 2
]		;END OF IFN ITS+D20
IFN D10,[
	FB.HED::	0		;BUFFER HEADER
	FB.NBF::	0		;NUMBER OF BUFFERS
	FB.BWS::	0		;SIZE OF BUFFER IN WORDS
SA%		0
SA$	FB.ROF::	0		;RECORD OFFSET
		BLOCK 1
]		;END OF IFN D10
	FB.BUF::
IFN ITS+D20,	BLOCK RBFSIZ
IFN D10,	BLOCK NIOBFS*<LIOBUF+3>

OFFSET 0
LINIFA==:.-INIIF1+1		;TOTAL NUMBER OF WORDS
EINIFA::			;END OF ARRAY

]		;END OF IFN QIO
βββ