github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-28 09:27:41 +00:00
Code Issues Releases Wiki Activity
Files
6be8b181ae864b63ffdfef751b8e5d435bd75277
PDP-10.its/src/l/alloc.303

1782 lines
36 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** INITIALIZATION AND ALLOCATION ROUTINES **
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 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, AND IS RECLAIMED WHEN LISP STARTS UP
.CRFOFF
OBTL: REPEAT KNOB, CONC OB,\.RPCNT
.CRFON
INITIALIZE:
IFN D10*HISEGMENT,[
SETZ FREEAC,
SETUWP FREEAC, ;FREEAC HAS OLD STATE OF HISEG-PURE BIT
.VALUE
] ;END OF IFN D10
IFN D10*PAGING,[
MOVEI FREEAC,MEMORY-1
HRRM FREEAC,.JBFF
CORE FREEAC,
.VALUE
IFN SAIL,[
HRRZ FREEAC,.JBSA ;SET DDT STARTING ADDRESS SO SAVE COMMAND WINS
SKIPN .JBDDT
SETDDT FREEAC,
] ;END IFN SAIL
] ;END IFN D10*PAGING
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,[-LFAKP-1,,FAKP-1]
MOVE FXP,[-LFAKFXP-1,,FAKFXP-1]
MOVE T,[.FVERS] ;REMEMBER, FILE VERSION NUMBER HAS 2000.
CAIGE T,1000. ; SUBTRACTED FROM IT. (SOME DAY, 3000.?)
ADDI T,2000.
MOVEI R,4 ;GET 4 DIGITS OF THE VERSION NUBMER, AND
IDIVI T,10. ; BUILD UP A 4-CHARACTER ASCII STRING IN
ADDI TT,"0 ; ALVRNO
PUSH FXP,TT
SOJG R,.-3
SETZM ALVRNO
MOVEI R,4
MOVE T,[440700,,ALVRNO]
POP FXP,TT
IDPB TT,T
SOJG R,.-2
;;; FALLS THROUGH
SUBTTL DUMP OUT TOPS20 SYMBOL TABLE
IFN D20,[
JSP D,TNXP ;SETUP TENEXP FLAG
MOVE D,[.FVERS]
MOVE A,D
LSH A,30
TLZ A,700000
MOVEM A,ENTVEC+2 ;VERSION NUMBER STORED IN LOC 137 AS 0XXX00,,
SKIPN <.JBSYM==:116> ;CHECK FOR SYMBOL TABLE
JRST INIT2X ;
CAIGE D,1000. ;See not above about .FVERS
ADDI D,2000.
MOVEI 1,(D) ;LOOK TO SEE IF A FILE EXISTS NAMED
HRLI 1,(GJ%SHT+GJ%OLD) ; LISP.SYMBOLS.xxxx
SKIPE TENEXP
SKIPA 2,[440700,,[ASCIZ \DSK:<MACLISP>LISP.SYMBOLS\]]
MOVE 2,[440700,,[ASCIZ \PS:<MACLISP>LISP.SYMBOLS\]]
GTJFN ;IF SUCH A SYMBOLS FILE ALREADY EXISTS,
JRST INIT2F ; THEN DELETE IT
HRLI 1,0
DELF
JRST INIT2E
GJINF ;get directory number into 2
HRLI 1,(DD%DTF+DD%DNF)
DELDF ;EXPUNGE FORMER SYMBOL TABLE
INIT2F: MOVEI 1,(D) ;D continues to have version number in it
HRLI 1,(GJ%SHT+GJ%NEW)
SKIPE TENEXP
SKIPA 2,[440700,,[ASCIZ \DSK:<MACLISP>LISP.SYMBOLS\]]
MOVE 2,[440700,,[ASCIZ \PS:<MACLISP>LISP.SYMBOLS\]]
GTJFN
JRST INIT2E
MOVE TT,1 ;REMEMBER THE FILE HANDLE FOR LATER USE
MOVE 2,[<44_36>+OF%WR] ;36 BIT BYTES, WRITE ACCESS
OPENF
JRST INIT2E
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,[ASCIZ \;Symbol table dumped out in \]
PSOUT
MOVEI 1,.PRIOU ;output to terminal
MOVE 2,TT ;JFN of symbols file
SETZ 3,
JFNS
HRROI 1,[ASCIZ \
\]
PSOUT
MOVE 1,TT ;RESTORE JFN
CLOSF
JRST INIT2E
JRST INIT2X
INIT2E: HRROI 1,[ASCIZ \I/O Loses badly while trying to dump symbol table
\]
PSOUT
HALTF
] ;END OF IFN D20
INIT2X:
;;; 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
IFN HISEGMENT,[
MOVEI T,HILOC
MOVEI TT,HILOC
SUBI TT,STDHI
MOVEM TT,MAXNXM
SOS MAXNXM
JSP F,INIBD
ASCIZ \HIGH\
SKIPE A
EXIT ;LOSE LOSE
] ;END IFN HISEGMENT
HS% MOVEI TT,-1
HS% MOVEM TT,MAXNXM ;AS MUCH CORE AS IT WANTS TO USE!
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
IFN ITS,[
MOVE T,[DBGMS2]
MOVEM T,IMASK2
MOVE A,[SETO AR1,]
MOVEM A,PURIFY
.BREAK 12,[..SSTA,,[LISPGO]] ;SET START ADDRESS
.CORE <ENDLISP+PAGSIZ-1>_-PAGLOG ;FLUSH PDL PAGES
.VALUE
.VALUE [ASCIZ \:INITIALIZED
\]
MOVE A,[JRST BINIT9] ;CLOBBER INIT, SINCE ONLY
MOVEM A,INITIALIZE ; NEED DO ONCE
BINIT9: .VALUE [ASCIZ \:ALREADY INITIALIZED
\]
JRST BINIT9
] ;END OF IFN ITS
IFN D20,[
MOVEI 1,.FHSLF
MOVE 2,[3,,ENTVEC]
SEVEC
SKIPN PSYSP
JRST .+3
PUSHJ P,PURIFY ;If we Purify the SYStem Pages
SETZM .JBSYM ; then that flushs the symtab
MOVE A,[JRST BINIT9] ;CLOBBER INIT, SINCE ONLY
MOVEM A,INITIALIZE ; NEED DO ONCE
HRROI 1,[ASCIZ \;Initialization Done
\]
SKIPA
BINIT9: HRROI 1,[ASCIZ \;Already initialized
\]
PSOUT
HALTF ;RETURN TO SUPERIOR
JRST BINIT9
] ;END IFN D20
IFN D10,[
MACROLOOP N2DIF,ZZD,*
IFE SAIL,[
OPEN TMPC,INITO1 ;CHECK TO SEE IF THERE IS A
JRST INIT1Z ; "LISP:" DEVICE WHICH
LOOKUP TMPC,INIT1Q ; SHOULD HAVE "DEFMAX.FAS" ON IT
JRST INIT1Z
MOVEI T,QLISP ;"LISP" IS THUS THE LISP SYSTEM DEVICE
MOVEI TT,NIL ; AND NEEDS NO PPN PROPERTY
JRST INIT1W
INIT1Z: OPEN TMPC,INITO2 ;CHECK FOR A "LSP:" DEVICE
JRST INIT1A
LOOKUP TMPC,INIT1Q
JRST INIT1A
MOVEI T,QLSP
MOVEI TT,IRACOM
INIT1W: CLOSE TMPC,
HRLM T,IRACOM ;PUT THE RIGHT "DEVICE" IN THE AUTOLOAD THING
HRLM TT,INIT1Y ;FIX UP THE "PPN" PROPERTY OF "LISP"
JRST INIT1X ;BY RPLACD'ING IN THE NEW PPN PROPERTY
INIT1E: JFCL
OUTSTR [ASCIZ \
Error in scanning PPN, or PPN is not the LISP sys area - try again.
\]
INIT1A: JSP T,D10SET
OUTSTR [ASCIZ \What is the PPN of the area with the autoload files? \]
SETZM PNBUF
MOVE T,[PNBUF,,PNBUF+1]
BLT T,PNBUF+LPNBUF-1
MOVE R,[440700,,PNBUF]
SETZB TT,D ;NUMBER WORDS - BASE 8 AND BASE 10.
SETZB F,T ;FLAGS WORD
; 1 PROJ NUM FOUND
; 2 PROG NUM FOUND
; 4 CMU STYLE
; 10 "[" ENCOUNTERED
; 20 "]" ENCOUNTERED
; 40 "." ENCOUNTERED DURING NUMBER
; 400000,, ANY DIGITS/CMU-STRING FOUND
INIT1B: INCHWL A
CAIE A,^C
CAIN A,^M
JRST INIT1C ;^C OR <CR> TERMINATES PROGRAMMER NUMBER
TRNE F,20
JSP T,INIT1E ;NO MORE CHARS PERMITTED AFTER RB
CAIE A,91. ;LB FOUND
JRST INIT1M
TLNE F,400000
JSP T,INIT1E
TROE F,10
TLO F,400000 ;PERMIT BRACKETS, BUT NOT REQUIRED
JRST INIT1B
INIT1M: CAIE A,93. ;RB FOUND
JRST .+3
TRO F,20
JRST INIT1B
SKIPE CMUP
TRNN F,4
JRST INIT1K
INIT1J: CAIL A,"a
CAILE A,"z
JRST .+2
SUBI A,"a-"A
TLO F,400000
IDPB A,R ;ACCUMULATING CMU STYLE INTO PNBUF
JRST INIT1B
INIT1K: CAIE A,".
JRST INIT1F
TLNE F,400000 ;"."
TROE F,40
JSP T,INIT1E
JRST INIT1B
INIT1F: CAIL A,"0
CAILE A,"9
JRST INIT1G
TLO F,400000
IMULI TT,8 ;ACCUMULATE NUMBER BASE 8
IMULI D,10. ; AND BASE 10.
ADDI TT,-"0(A)
ADDI D,-"0(A)
JRST INIT1B
INIT1G: CAIE A,",
JRST INIT1H
TLZE F,400000 ;BETTER BE SOME DIGITS
TROE F,1 ;CANT HAVE TWO COMMAS
JSP T,INIT1E
TRZE F,40 ;PROJ NUMBER FOUND
MOVE TT,D ;BASE 10.?
MOVEM TT,IPPN1
SETZB TT,D
JRST INIT1B
INIT1H: SKIPN CMUP ;NEITHER DIGITS NOR SYNTAX CHARS
JSP T,INIT1E
CAIL A,"a
CAILE A,"z
JRST .+2
SUBI A,"a-"A
CAIL A,"A
CAILE A,"Z
JSP T,INIT1E
TRO F,4
JRST INIT1J
INIT1D: MOVEI T,PNBUF
SKIPE CMUP ;0,,ADDRESS OF CMU PPN STRING
CMUDEC T, ;CMUDEC WILL CONVERT A STRING TO A PPN WORD
JSP T,INIT1E ;FAIL IF NOT A VALID CMU PPN
HLRZM T,IPPN1
HRRZM T,IPPN2
JRST INIT1V
INIT1C: TLNN F,400000 ;BETTER BE SOME DIGITS
JSP T,INIT1E
TRNE F,4
JRST INIT1D
TRZE F,40 ;PROGRAMMER NUMBER FOUND?
MOVE TT,D ;BASE 10.?
MOVEM TT,IPPN2
INIT1V: MOVE T,IPPN1
HRLM T,INIT1S+3 ;CHECK TO SEE IF THAT PPN EXISTS
MOVE T,IPPN2
HRRM T,INIT1S+3
RELEASE TMPC,
OPEN TMPC,INITO3
JSP T,INIT1E
INIT1X: RELEASE TMPC,
] ;END OF IFE SAIL
MOVE A,[.FVERS]
LSH A,30 ;VERSION NUMBER STORED IN LOC 137 AS
TLZ A,700000
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
HS$ SA% SETUWP FREEAC, ;RESTORE WRITE PROTECT STATUS
HS$ SA% .VALUE
IFE SAIL,[
OUTSTR [ASCIZ \:$INITIALIZED$
\]
EXIT 1,
] ;END OF IFE SAIL
IFN SAIL,[
IFN HISEGMENT,[
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 IFN HISEGMENT
IFE HISEGMENT,[
OUTSTR [ASCIZ \:$INITIALIZED$
\]
EXIT 1,
JRST @.JBSA
] ;END IFE HISEGMENT
] ;END OF IFN SAIL
] ;END OF IFN D10
INIT99: JRST LISPGO
IFN D10,[
INITO1: .IOBIN
SIXBIT \LISP\
0
INITO2: .IOBIN
SIXBIT \LSP\
0
INITO3: .IOBIN
SIXBIT \DSK\
0
INIT1Q: SIXBIT \DEFMAX\
SIXBIT \FAS\
0
0
INIT1S: SIXBIT \DEFMAX\
SIXBIT \FAS\
0
0 ;FILLED IN WITH ippn1,,ippn2
] ;END OF IFN D10
;;; 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!
NOTINIT:
IFN ITS,[
.VALUE [ASCIZ \:LISP NOT INITIALIZED (USE INIT$G)
\]
] ;END OF IFN ITS
IFN D20,[
HRROI 1,[ASCIZ \;Not INITIALIZED (use INIT$G)
\]
PSOUT
HALTF
] ;END OF IFN D20
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==400
LOFXPDL==200
LOSPDL==100
LOFLPDL==10
ALBPS==14000
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
IT$ ALLJCL: BLOCK 80. ;BUFFER UP JOB COMMAND LINE IF THERE WAS ONE.
IT$ 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,[
.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:
.IOT 0,A ;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
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
ALOFL2: CAMN A,[SIXBIT /*/] ;ALREADY TRIED **?
JRST ALFLER ;YUP, GIVE UP
MOVE A,@ALOFL2 ;ELSE TRY **
JRST ALOINI
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
SA% JRST ALFLER
IFN SAIL,[
SKIPA A,[SIXBIT /ELISP /]
JRST E.ALJ1
SKIPN E.PHANTOM
JRST ALFLER
MOVEM A,E.FIL
MOVSI B,(SIXBIT /INI/)
MOVEM B,E.EXT
MOVSI C,(SIXBIT /DSK/)
MOVEM C,INIIF2+F.DEV
MOVEM C,E.DEV
MOVE C+1,[SIXBIT /MACLSP/]
MOVEM C+1,E.PPN
MOVEM C+1,INIIF2+F.PPN
LOOKUP TMPC,A
JRST ALFLER
E.ALJ1:
] ;END OF IFN SAIL
MOVEM A,INIIF2+F.FN1
HLLZM B,INIIF2+F.FN2
CLOSE TMPC,
SA$ RELEASE 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
ALLFIL: PUSHJ P,ALOFIL ;OPEN INIT FILE
ALLFL1: 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: 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]
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
,,TTYIF2+F.CHAN ;CHANNEL #
,,[STTYA1] ;TTYST1
400000,,[STTYA2]
] ;END OF IFN ITS
ALHELP: PUSHJ P,ALLTYO
ASCIZ \
N = DON'T ALLOCATE (I.E. USE DEFAULTS)
Y = ALLOC FROM TTY
^A = READ INIT FILE AND ALLOC FROM IT
^B = ALLOC FROM TTY, THEN READ INIT FILE
^W = SAME AS ^A, 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: MOVEI D,[SIXBIT \ INIT FILE NOT FOUND!\]
ALCERR: SETZM TAPRED
SETZM TTYOFF
SETZM TAPWRT
SA$ SKIPE E.PHANTOM
SA$ EXIT 1, ;LOSER STATED WRONG FILE, BARF
AOSN FAKJCL ;DID WE FAKE JCL?
JRST POPJ1 ;YUP, THEN SKIP RETURN SO CAN DO ALLOC
STRT [SIXBIT \ !\]
IFN ITS,[
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: EXCH A,R
SETZ AR2A,
MOVE TT,[440600,,AR1]
ALFL6A: ILDB A,TT
JUMPE A,ALF6A0
ADDI A,40
IT$ ALFL6C: .IOT 0,A ;CHANNEL # FILLED IN
10$ OUTCHR A
20$ PBOUT
JRST ALFL6A
ALF6A0: MOVE A,T
IT$ ALFL6B: .IOT 0,A ;CHANNEL # FILLED IN
10$ OUTCHR A
20$ PBOUT
EXCH A,R
POPJ P,
SUBTTL MAIN ALLOC INTERACTION CODE
%ALLOC:
20$ RESET ;RESET OURSELVES ON STARTUP
IFN D10*<1-SAIL>,[
MOVEM 0,SGANAM ;SAVE MAGIC STUFF FOR GETHGH
MOVEM 11,SGADEV
MOVEM 7,SGAPPN
] ;END OF IFN D10*<1-SAIL>
SETZM MUNGP
JSR STINIT
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
IFN D10,[
SETZM LICACR ;LAST INPUT CHAR TO ALLOC WAS? CR - NO!
MOVEI A,ENDLISP+PAGSIZ-1;MUST DO CRUFTY CALCULATION BY HAND AS INVOLVES
ANDI A,PAGMSK ;BOOLEAN OPS AND RELOCATABLE SYMBOLS (BARF!!)
SUBI A,EINIFA
MOVEM A,IGCFX1
] ;END OF IFN D10
IFN ITS,[
.SUSET [.RSNAM,,T]
MOVEM T,TTYIF2+F.SNM
MOVEM T,TTYOF2+F.SNM
] ;END OF IFN ITS
IFN D10,[
SA$ SETZ T,
SA$ DSKPPN T, ;AS SET BY ALIAS COMMAND
SA% GETPPN T,
MOVEM T,TTYIF2+F.PPN
MOVEM T,TTYOF2+F.PPN
SA% SETZ T,
] ;END OF IFN D10
IFE D20,[
PUSH FXP,[SIXBIT \DSK\]
PUSH FXP,T
PUSH FXP, [SIXBIT \*\]
IT$ PUSH FXP,[SIXBIT \>\]
10$ SA% PUSH FXP,[SIXBIT \LSP\]
SA$ PUSH FXP, [SIXBIT \___\]
] ;END IFE D20
IFN D20,[
SKIPE TENEXP
SKIPA T,[ASCIZ \DSK\]
MOVE T,[ASCIZ \PS\] ;LOSE LOSE - ASSUME CONNECTED TO "PS:"
PUSH FXP,T
PUSHN FXP,L.6DEV-1
PUSH FXP,[ASCIZ \*\]
PUSHN FXP,L.6DIR-1
PUSH FXP,[ASCIZ \*\]
PUSHN FXP,L.6FNM-1
PUSH FXP,[ASCIZ\LSP\]
PUSHN FXP,L.6EXT-1
PUSH FXP,[ASCIZ \*\]
PUSHN FXP,L.6VRS-1
] ;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
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
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
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 SAIL,[
SKIPN E.PHANTOM
JRST E.ALJO
MOVE A,E.FIL
MOVE B,E.EXT
MOVE AR1,E.DEV
MOVE R,E.PPN
SETZ C,
JRST ALJ2
E.ALJO:
] ;END OF IFN SAIL
IFN D10\D20,[
SETZM FAKJCL ;NOT FAKE JCL YET
JSP F,JCLSET
] ;END OF IFN D10\D20
IFN D10,[
SKIPE SJCLBUF+1 ;ANY JCL?
JRST ALJ0
SETOM FAKJCL ;JCL IS REALLY FAKE
MOVE TT,[ASCII \LISP.\] ;DEFAULT JCL: LISP.INI<CR>
MOVEM TT,SJCLBUF+1
MOVE TT,[ASCII \INI
\]
MOVEM TT,SJCLBUF+2
ALJ0: SETZB D,R ;D IS FLAG FOR . SEEN, R IS PPN
SETZB A,C
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,91. ;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
HRL 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,95. ;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\)
SKIPN D ;. SEEN?
HRLZI B,(SIXBIT/INI/)
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
IFN D20,[
SKIPE TENEXP
SKIPA C,[ASCIZ \DSK\]
MOVE C,[ASCIZ \PS\] ;"REMODEL" THE DEFAULT DEVICE IN
MOVEM C,INIIF2+F.DEV ; ALLOC INIT FILE ARRAY
SKIPN TENEXP ;TENEX LOSES - WONT PARSE JCL LINE
SKIPN 1,SJCLBUF ;ANY CHARS IN JCL? -- IF NONE AT
JRST ALJ1X ; ALL, THEN TRY "LISP.INI"
ALJ0: MOVE 2,[440700,,SJCLBUF+1]
ILDB 3,2 ;IF JCL CONSISTS ONLY OF SPACES (OR
CAIN 3,^M ;SUCH) BEFORE THE CR, THEN THERE IS NO
JRST ALLCB1 ; INIT FILE -- JUST CONTINUE NORMALLY
CAIG 3,40
SOJG 1,.-4
ADD 2,[070000,,0] ;DECREMENT BP
MOVSI 1,(GJ%OLD+GJ%SHT)
GTJFN ; IF LOSE, THEN PRETEND NO JCL
JRST ALLCB1 ;
MOVEM 1,6 ;SAVE JFN IN ACC 6
;; WHAT A CROCK -- AFTER GTJFN WINS, THEN FILL IN THE NAMES OF
;; THE COMPONENTS IN THE "INIT" FILE ARRAY, AND JOIN COMMON CODE
IRP FLD,,[DEV,DIR,FNM,EXT,VRS]AOF,,[DEV,DIR,NAM,TYP,GEN]
SETZM INIIF2+F.!FLD
HRROI 1,INIIF2+F.!FLD
MOVE 2,6 ;RESTORE JFN
MOVSI 3,(JS%!AOF&JS%OUT)
JFNS ;GET ASCIZ STRING FOR COMPONENT
TERMIN
JRST ALJ1Z
;; LAST RESTORT
ALJ1X: SKIPE TENEXP
jrst alj1xt
gjinf ;get user number
move 2,1
hrroi 1,iniif2+f.dir
dirst ;convert the number to string.
halt ;uh, oh.
move tt,[asciz /INIT/]
movem tt,iniif2+f.ext
movei 1,alj1gt
setzi 2,
gtjfn
jrst alj1x1
jrst alj1z
alj1x1: move tt,[asciz /INI/]
movem tt,iniif2+f.ext
movei 1,alj1gt
setzi 2,
gtjfn
jrst allcb1
jrst alj1z
alj1gt: gj%old ? .nulio,,.nulio
-1,,iniif2+f.dev ? -1,,iniif2+f.dir
-1,,iniif2+f.fnm ? -1,,iniif2+f.ext
0 ? 0 ? 0
;;;TENEX simple case...
alj1xt: hrlzi 1,(gj%sht+gj%old)
hrroi 2,[ASCIZ /DSK:LISP.INI/]
gtjfn
jrst allcb1
ALJ1Z: RLJFN ;HAVE THE INIT FILE, RETURN THE JFN
JFCL
SETOM ATYF ;NO TYPEOUT
JRST ALLFIL ;THEN READ AND PROCESS INIT FILE
ALLCB1: ] ;END IFN D20
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:
ALLOC1: PUSHJ P,ALLTYO
ASCIZ \
Alloc? \
PUSHJ P,ALLTYI
SETZM ALLF
CAIN C,^W
SETOM ATYF
CAIE C,^W
CAIN C,^A
JRST ALLFIL
CAIE C,33 ;ALTMODE
CAIN C,40 ;SPACE
SETOM ALLF
CAIE C,^B
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
IT$ HRRZ TT,TTYIF2+F.CHAN
IT$ .CALL CKI2I
IT$ .VALUE
20$ MOVEI 1,.PRIIN
20$ CFIBF
JRST ALLOC1
IFN PAGING,[
ALCORX==<BBPSSG-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
ALCORE==ALCORX+<MAXFFS+MAXFFX+MAXFFL+MAXFFB+MAXFFY+MAXFFA+PAGSIZ-1>/PAGSIZ
] ;END IFN PAGING
.ELSE [
ALCORX==<BBPSSG-FIRSTLOC+STDLO-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
ALCORE==ALCORX+4
]
ALLOCC:
PG% 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)
IFE SAIL,[
MOVEI D,PAGSIZ-20
CAML D,X!W
MOVE D,X!W
] ;END OF IFE SAIL
IFN SAIL,[
MOVE D,X!W
CAIG D,PAGSIZ-20
MOVEI D,PAGSIZ-20
] ;END OF IFN SAIL
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
IT% SETZM SYMLO
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
SUB C,IGCFX1 ;IF NEWIO, MUST ALLOW FOR INITIAL ARRAY
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:
IFE PAGING,[
IFE SAIL,[
MOVE P,C2 ;SET UP PDL POINTERS
MOVE FXP,FXC2
MOVE FLP,FLC2
MOVE SP,SC2
] ;END OF IFE SAIL
] ;END OF IFE PAGING
MOVEI A,LISP
HRRM A,LISPSW
SETZM ALGCF ;GC IS OKAY NOW
IFN D10,[
MOVEI A,GOINIT
HRRM A,.JBSA"
PUSHJ P,GRELAR
] ;END OF IFN D10
JRST LISP
CONSTANTS ;ALLOC'S LITERALS GET EXPANDED HERE
IFE PAGING,[
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 IFE PAGING
;;; 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 (FILLED IN AT RUN TIME)
BLOCK L.6DEV-<.-F.DEV>
F.DIR:: ;DIRECTORY (UNSPECIFIED)
BLOCK L.6DIR-<.-F.DIR>
F.FNM:: ASCIZ \LISP\ ;FILE NAME
BLOCK L.6FNM-<.-F.FNM>
F.EXT:: ASCIZ \INI\ ;EXTENSION
BLOCK L.6EXT-<.-F.EXT>
F.VRS:: ASCIZ \0\ ;VERSION
BLOCK L.6VRS-<.-F.VRS>
] ;END OF IFN D20
;; see DEFNS file for format of a lot of stuff here
LOC INIIF2+FB.BUF
10% BLOCK RBFSIZ
10$ BLOCK NIOBFS*<LIOBUF+3>
10$ IFL NIOBFS-2, BLOCK NIOBFS*<LIOBUF+3>
OFFSET 0
LINIFA==:.-INIIF1+1 ;TOTAL NUMBER OF WORDS
EINIFA:: ;END OF ARRAY
-1 ;PHOOEY! FORCE THE "BLOCK" TO MAKE REAL 0'S
Reference in New Issue View Git Blame Copy Permalink