;;; -*-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+<_11>] .CBLK TT, .VALUE MOVE TT,[4400,,400000+<_11>] .CBLK TT, .VALUE MOVE TT,[4400,,400000+<_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:LISP.SYMBOLS\]] MOVE 2,[440700,,[ASCIZ \PS: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:LISP.SYMBOLS\]] MOVE 2,[440700,,[ASCIZ \PS: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,<<&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,[-<<<&PAGMSK>-BBPSSG>_-SEGLOG>,,ST+] 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 _-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 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 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==>/PAGSIZ ALCORE==ALCORX+/PAGSIZ ] ;END IFN PAGING .ELSE [ ALCORX==>/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,*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 , 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* 10$ IFL NIOBFS-2, BLOCK NIOBFS* OFFSET 0 LINIFA==:.-INIIF1+1 ;TOTAL NUMBER OF WORDS EINIFA:: ;END OF ARRAY -1 ;PHOOEY! FORCE THE "BLOCK" TO MAKE REAL 0'S