--- /dev/null
+TITLE INITIALIZATION FOR MUDDLE
+
+RELOCATABLE
+
+HTVLNT==3000 ; GUESS OF TVP LENGTH
+
+LAST==1 ;POSSIBLE CHECKS DONE LATER
+
+.INSRT MUDDLE >
+
+SYSQ
+XBLT==123000,,
+GCHN==0
+IFE ITS,[
+FATINS==.FATAL"
+SEVEC==104000,,204
+.INSRT STENEX >
+]
+
+IMPURE
+
+OBSIZE==151. ;DEFAULT OBLIST SIZE
+
+.LIFG <TVBASE+TVLNT-TVLOC>
+.LOP .VALUE
+.ELDC
+
+.GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
+.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW
+.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE
+.GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER
+.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR
+.GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1
+.GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR
+.GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS
+.GLOBAL HASHTB,ILOOKC
+
+LPUR==.LPUR ; SET UP SO LPUR WORKS
+
+; INIITAL AMOUNT OF AFREE SPACE
+
+STOSTR:
+LOC TVSTRT-1
+ISTOST: TVSTRT-STOSTR,,0
+
+ BLOCK HTVLNT ; TVP
+
+SETUP: MOVEI 0,0 ; ZERO ACS
+ MOVEI 17,1
+ BLT 17,17
+
+IFN ITS, .SUSET [.RUNAM,,%UNAM] ; FOR AGC'S BENFIT
+ MOVE P,GCPDL ;GET A PUSH DOWN STACK
+IFN ITS, .SUSET [.SMASK,,[200000]] ; ENABLE PDL OVFL
+ MOVE 0,[TVBASE,,TVSTRT]
+ BLT 0,TVSTRT+HTVLNT-3 ; BLT OVER TVP
+IFE ITS, PUSHJ P,TWENTY ; FIND OUT WHETHER IT IS TOPS20 OR NOT
+ PUSHJ P,TTYOPE ;OPEN THE TTY
+ AOS A,20 ; TOP OF LOW SEGG
+ HRRZM A,P.TOP
+ SOSN A ; IF NOTHING YET
+IFN ITS, .SUSET [.RMEMT,,P.TOP]
+IFE ITS, JRST 4,
+ MOVE A,P.TOP
+ SUB A,FRETOP ; SETUP FOR GETTING NEEDED CORE
+ SUBI A,3777
+ ASH A,-10. ; TO PAGES
+ HRLS A ; SET UP AOBJN
+ HRRZ 0,P.TOP
+ ASH 0,-10.
+ SUBI 0,1
+ HRR A,0
+IFN ITS,[
+ .CALL HIGET ; GET THEM
+ FATAL INITM--CORE NOT AVAILABLE FOR INITIALIZATION
+ ASH A,10. ; TO WORDS
+ MOVEM A,P.TOP
+ SUBI A,2000 ; WHERE FRETOP IS
+ MOVEM A,FRETOP
+
+]
+IFE ITS,[
+ MOVE A,FRETOP
+ ADDI A,2000
+ MOVEM A,P.TOP
+]
+ HRRE A,P.TOP ; CHECK TOP
+ TRNE A,377777 ; SKIP IF ALL LOW SEG
+ JUMPL A,PAGLOS ; COMPLAIN
+ MOVE A,HITOP ; FIND HI SEG TOP
+ ADDI A,1777
+ ANDCMI A,1777
+ MOVEM A,RHITOP ; SAVE IT
+ MOVEI A,200
+ SUBI A,PHIBOT
+ JUMPE A,HIBOK
+ MOVSI A,(A)
+ HRRI A,200
+IFN ITS,[
+ .CALL GIVCOR
+ .VALUE
+]
+HIBOK: MOVEI B,[ASCIZ /MUDDLE INITIALIZATION.
+/]
+ PUSHJ P,MSGTYP ;PRINT IT
+ MOVE A,CODTOP ;CHECK FOR A WINNING LOAD
+ CAML A,VECBOT ;IT BETTER BE LESS
+ JRST DEATH1 ;LOSE COMPLETELY
+SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR
+ MOVEM PVP,PVSTOR+1
+ MOVEM PVP,PVSTOR+1-TVSTRT+TVBASE
+ MOVEI A,(PVP) ;SET UP A BLT
+ HRLI A,PVBASE ;FROM PROTOTYPE
+ BLT A,PVLNT*2-1(PVP) ;INITIALIZE
+ MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS
+ MOVEI TB,(TP) ;AND A BASE
+IFN ITS, HRLI TB,1
+IFE ITS, HRLI TB,400001 ; FOR MULTI SEG HACKING
+ SUB TP,[1,,1] ;POP ONCE
+
+; FIRST BUILD MOBY HASH TABLE
+
+ MOVEI A,1023. ; TRY THIS OUT FOR SIZE
+ PUSHJ P,IBLOCK
+ MOVEM B,HASHTB+1-TVSTRT+TVBASE ; STORE IN TVP POINTER
+ HLRE A,B
+ SUB B,A
+ MOVEI A,TATOM+.VECT.
+ HRLM A,(B)
+
+; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
+
+ PUSH P,[5] ;COUNT INITIAL OBLISTS
+
+ PUSH P,OBLNT ;SAVE CURRENT OBLIST DEFAULT SIZE
+
+MAKEOB: SOS A,-1(P)
+ MOVE A,OBSZ(A)
+ MOVEM A,OBLNT
+ MCALL 0,MOBLIST ;GOBBLE AN OBLIST
+ PUSH TP,$TOBLS ;AND SAVE THEM
+ PUSH TP,B
+ MOVE A,(P)-1 ;COUNT DOWN
+ MOVEM B,@OBTBL(A) ;STORE
+ JUMPN A,MAKEOB
+
+ POP P,OBLNT ;RESTORE DEFAULT OBLIST SIZE
+
+ MOVE C,[-TVLNT+2,,TVBASE]
+ MOVE D,[-HTVLNT+2,,TVSTRT]
+
+;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
+;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR
+
+ILOOP: HLRZ A,(C) ;FIRST TYPE
+ JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED
+ CAIN A,TCHSTR ;CHARACTER STRING?
+ JRST CHACK ;YES, GO HACK IT
+ CAIN A,TATOM ;ATOM?
+ JRST ATOMHK ;YES, CHECK IT OUT
+ MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME)
+ MOVEM A,(D)
+ MOVE A,1(C)
+ MOVEM A,1(D)
+SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR
+ ADD D,[2,,2] ;OUT COUNTER
+SETLP1: ADD C,[2,,2] ;AND IN COUNTER
+ JUMPL C,ILOOP ;JUMP IF MORE TO DO
+\f
+;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
+
+TVEXAU: HLRE B,D ; LEFT HALF OF AOBJN
+ MOVNI TVP,HTVLNT-2 ; CALCULATE LENGTH OF TVP
+ SUB TVP,B ; GET -LENGTH OF TVP IN TVP
+ HRLS TVP
+ HRRI TVP,TVSTRT ; BUILD A TASTEFUL TVP POINTER
+ MOVNI C,TVLNT-HTVLNT+2(B) ; SMASH IN LENGTH INTO END DOPE WORDS
+ HRLM C,TVSTRT+HTVLNT-1
+ MOVSI E,400000
+ MOVEM E,TVSTRT+HTVLNT-2
+ HLRE C,TVP
+ MOVNI C,-2(C) ; CLOBBER LENGTH INTO REAL TVP
+ HLRE B,TVP
+ SUBM TVP,B
+ MOVEM E,(B)
+ HRLM C,1(B) ; PUT IN LENGTH
+ MOVE PVP,PVSTOR+1
+ MOVEM TVP,REALTV+1(PVP)
+
+
+; FIX UP TYPE VECTOR
+
+ MOVE A,TYPVEC+1 ;GET POINTER
+ MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS
+ MOVSI B,TATOM ;SET TYPE TO ATOM
+ MOVEI D,400000 ; TYPE CODE HACKS
+
+TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM
+ MOVE C,@1(A) ;GET ATOM
+ HLRE E,C ; FIND DOPE WORD
+ SUBM C,E
+ HRRM D,(E) ; STUFF INTO ATOM
+ MOVEM C,1(A)
+ ADDI D,1
+ ADD A,[2,,2] ;BUMP
+ JUMPL A,TYPLP
+
+\f; CLOSE TTY CHANNELS
+IFN ITS,[
+
+ .CLOSE 1,
+ .CLOSE 2,
+]
+
+;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
+
+;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
+
+ IRP A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]]
+ IRP B,C,[A]
+ PUSH TP,$!C
+ PUSH TP,CHQUOTE B
+ .ISTOP
+ TERMIN
+ TERMIN
+
+ MCALL 2,FOPEN ;OPEN THE OUT PUT CHANNEL
+ MOVEM B,TTOCHN+1 ;SAVE IT
+
+;ASSIGN AS GLOBAL VALUE
+
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE OUTCHAN
+ PUSH TP,A
+ PUSH TP,B
+ MOVE A,[PUSHJ P,MTYO] ;MORE WINNING INS
+ MOVEM A,IOINS(B) ;CLOBBER
+ MCALL 2,SETG
+
+;SETUP A CALL TO OPEN THE TTY CHANNEL
+
+ IRP A,,[[READ,TCHSTR],[TTY:,TCHSTR]]
+ IRP B,C,[A]
+ PUSH TP,$!C
+ PUSH TP,CHQUOTE B
+ .ISTOP
+ TERMIN
+ TERMIN
+
+ MCALL 2,FOPEN ;OPEN INPUTCHANNEL
+ MOVEM B,TTICHN+1 ;SAVE IT
+ PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE
+ PUSH TP,IMQUOTE INCHAN
+ PUSH TP,A
+ PUSH TP,B
+ MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR
+ MOVE A,[PUSHJ P,MTYI]
+ MOVEM A,IOIN2(C) ;MORE OF A WINNER
+ MOVE A,[PUSHJ P,IMTYO]
+ MOVEM A,ECHO(C) ;ECHO INS
+ MCALL 2,SETG
+ MOVEI A,3 ;FIRST CHANNEL AFTER INIT HAPPENS
+ MOVEM A,FRSTCH
+
+;GENERATE AN INITIAL PROCESS AND SWAP IT IN
+
+ MOVEI A,TPLNT ;STACK PARAMETERS
+ MOVEI B,PLNT
+ PUSHJ P,ICR ;CREATE IT
+ MOVE PVP,PVSTOR+1
+ MOVE 0,SPSTO+1(B)
+ MOVEM 0,SPSTOR+1
+ MOVE 0,REALTV+1(PVP)
+ MOVEM 0,REALTV+1(B) ; STUFF IN TRANSFER VECTOR POINTER
+ MOVEI 0,RUNING
+ MOVEM 0,PSTAT"+1(B)
+ MOVE D,B ;SET UP TO CALL SWAP
+ JSP C,SWAP ;AND SWAP IN
+ MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS
+ PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME
+ PUSH TP,[1,,0]
+ MOVEI A,-1(TP)
+ PUSH TP,A
+ PUSH TP,SPSTOR+1
+ PUSH TP,P
+ MOVE C,TP ;COPY TP
+ ADD C,[3,,3] ;FUDGE
+ PUSH TP,C ;TPSAV PUSHED
+ PUSH TP,[TOPLEV]
+ HRRI TB,(TP) ;SETUP TB
+IFN ITS, HRLI TB,2
+IFE ITS, HRLI TB,400002
+ ADD TB,[1,,1]
+ MOVE PVP,PVSTOR+1
+ MOVEM TB,TBINIT+1(PVP)
+ MOVSI A,TSUBR
+ MOVEM A,RESFUN(PVP)
+ MOVEI A,LISTEN"
+ MOVEM A,RESFUN+1(PVP)
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE THIS-PROCESS
+ PUSH TP,$TPVP
+ PUSH TP,PVP
+ MCALL 2,SETG
+
+; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE
+
+ MOVEI A,IMQUOTE T
+ SUBI A,
+TVTOFF==0
+ ADDSQU TVTOFF
+
+ MOVEM A,SQULOC-1
+
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE TVTOFF,,MUDDLE
+ PUSH TP,$TFIX
+ PUSH TP,A
+ MCALL 2,SETG
+
+; HERE TO SETUP SQUOZE TABLE IN PURE CORE
+
+ PUSHJ P,SQSETU ; GO TO ROUTINE
+
+ PUSHJ P,DUMPGC
+ MOVEI A,400000 ; FENCE POST PURE SR VECTOR
+ HRRM A,PURVEC
+ MOVE A,TP
+ HLRE B,A
+ SUBI A,-PDLBUF(B) ;POINT TO DOPE WORDS
+ MOVEI B,12 ;GROWTH SPEC
+ IORM B,(A)
+ MOVE PVP,PVSTOR+1
+ MOVE 0,REALTV+1(PVP)
+ HLRE E,0
+ SUBI 0,-1(E)
+ HRRZM 0,CODTOP
+IFE ITS, PUSHJ P,GETJS
+ PUSHJ P,AAGC ;DO IT
+ AOJL A,.-1
+ MOVE PVP,PVSTOR+1
+ MOVE A,TPBASE+1(PVP)
+ SUB A,[640.,,640.]
+ MOVEM A,TPBASE+1(PVP)
+
+; CREATE LIST OF ROOT AND NEW OBLIST
+
+ MOVEI A,5
+ PUSH P,A
+
+NAMOBL: PUSH TP,$TATOM
+ PUSH TP,@OBNAM-1(A) ; NAME
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE OBLIST
+ PUSH TP,$TOBLS
+ PUSH TP,@OBTBL1-1(A)
+ MCALL 3,PUT ; NAME IT
+ SOS A,(P)
+ PUSH TP,$TOBLS
+ PUSH TP,@OBTBL1(A)
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE OBLIST
+ PUSH TP,$TATOM
+ PUSH TP,@OBNAM(A)
+ MCALL 3,PUT
+ SKIPE A,(P)
+ JRST NAMOBL
+ SUB P,[1,,1]
+
+;Define MUDDLE version number
+ MOVEI A,5
+ MOVEI B,0 ;Initialize result
+ MOVE C,[440700,,MUDSTR+2]
+VERLP: ILDB D,C ;Get next charcter digit
+ CAIG D,"9 ;Non-digit ?
+ CAIGE D,"0
+ JRST VERDEF
+ SUBI D,"0 ;Convert to number
+ IMULI B,10.
+ ADD B,D ;Include number into result
+ SOJG A,VERLP ;Finished ?
+VERDEF:
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE MUDDLE
+ PUSH TP,$TFIX
+ PUSH TP,B
+ MCALL 2,SETG ;Make definition
+OPIPC:
+IFN ITS,[
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOTE IPC
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE IPC-HANDLER
+ MCALL 1,GVAL
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TFIX
+ PUSH TP,[1]
+ MCALL 3,ON
+ MCALL 0,IPCON
+]
+
+; Allocate inital template tables
+
+ MOVEI A,10
+ PUSHJ P,CAFRE1
+ MOVSI A,(B)
+ HRRI A,1(B)
+ SETZM (B)
+ BLT A,7(B)
+ ADD B,[10,,10] ; REST IT OFF
+ MOVEM B,TD.LNT+1
+ MOVEI A,10
+ PUSHJ P,CAFRE1
+ MOVEI 0,TUVEC ; SETUP UTYPE
+ HRLM 0,10(B)
+ MOVEM B,TD.GET+1
+ MOVSI A,(B)
+ HRRI A,1(B)
+ SETZM (B)
+ BLT A,7(B)
+ MOVEI A,10
+ PUSHJ P,CAFRE1
+ MOVEI 0,TUVEC ; SETUP UTYPE
+ HRLM 0,10(B)
+ MOVEM B,TD.PUT+1
+ MOVSI A,(B)
+ HRRI A,1(B)
+ SETZM (B)
+ BLT A,7(B)
+ MOVEI A,10
+ PUSHJ P,CAFRE1
+ MOVEI 0,TUVEC ; SETUP UTYPE
+ HRLM 0,10(B)
+ MOVEM B,TD.AGC+1
+ MOVSI A,(B)
+ HRRI A,1(B)
+ SETZM (B)
+ BLT A,7(B)
+
+PTSTRT: MOVEI A,SETUP
+ ADDI A,1
+ SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO
+ MOVEM A,PARNEW
+
+; PURIFY/IMPURIFY THE WORLD (PDL)
+
+IFN ITS,[
+PURIMP: MOVE A,FRETOP
+ SUBI A,1
+ LSH A,-12
+ MOVE B,A
+ MOVNI A,1(A)
+ HRLZ A,A
+ DOTCAL CORBLK,[[1000,,310000],[1000,,-1],A]
+ FATAL INITM -- CAN'T IMPURIFY LOW CORE
+ MOVEI A,PHIBOT
+ ADDI B,1
+ SUB A,B
+ MOVNS A
+ HRL B,A
+ DOTCAL CORBLK,[[1000,,0],[1000,,-1],B]
+ FATAL INITM -- CAN'T FLUSH MIDDLE CORE
+ MOVE A,[-<400-PHIBOT>,,PHIBOT]
+ DOTCAL CORBLK,[[1000,,210000],[1000,,-1],A]
+ FATAL INITM -- CAN'T PURIFY HIGH CORE
+]
+
+IFE ITS,[
+ MOVEI A,400000
+ MOVE B,[1,,START]
+ SEVEC
+]
+ PUSH P,[15.,,15.] ;PUSH A SMALL PRGRM ONTO P
+ MOVEI A,1(P) ;POINT TO ITS START
+ PUSH P,[JRST AAGC] ;GO TO AGC
+ PUSH P,[MOVE PVP,PVSTOR+1]
+ PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P
+ PUSH P,[SUB B,-14.(P)] ;FUDGE TO POP OFF PROGRAM
+ PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME
+ PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP
+ PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT
+ PUSH P,[MOVE B,SPSTOR+1] ;SP
+ PUSH P,[MOVEM B,SPSAV(TB)]
+ PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO
+ PUSH P,[MOVEM B,PCSAV(TB)]
+IFN ITS, PUSH P,[MOVSI B,(.VALUE )]
+IFE ITS, PUSH P,[MOVSI B,(JRST)]
+ PUSH P,[HRRI B,C]
+ PUSH P,[JRST B] ;GO DO VALRET
+ PUSH P,[B]
+ PUSH P,A ; PUSH START ADDR
+ MOVE B,[JRST -12.(P)]
+ MOVE 0,[JUMPA START]
+IFE ITS, MOVE C,[HALTF]
+IFE ITS, SKIPE OPSYS
+ MOVE C,[ASCII \\170/\e9\]
+ MOVE D,[ASCII \B/\e1Q\]
+ MOVE E,[ASCIZ \\r\16*\r\] ;TERMINATE
+ POPJ P, ; GO
+\f
+; CHECK PAIR SPACE
+
+PAIRCH: CAMG A,B
+ JRST SETTV ;O.K.
+
+DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
+/]
+ PUSHJ P,MSGTYP
+ .VALUE
+
+;CHARACTER STRING HACKER
+
+CHACK: MOVE A,(C) ;GET TYPE
+ HLLZM A,(D) ;STORE IN NEW HOME
+ MOVE B,1(C) ;GET POINTER
+ HLRZ E,B ;-LENGHT
+ HRRM E,(D)
+ PUSH P,E+1 ; IDIVI WILL CLOBBER
+ ADDI E,4+5*2 ; ROUND AND ACCOUNT FOR DOPE WORDS
+ IDIVI E,5 ; E/ WORDS LONG
+ PUSHJ P,EBPUR ; MAKE A PURIFIED COPY
+ POP P,E+1
+ HRLI B,010700 ;MAKE POINT BYTER
+ SUBI B,1
+ MOVEM B,1(D) ;AND STORE IT
+ ANDI A,-1 ;CLEAR LH OF A
+ JUMPE A,SETLP ;JUMP IF NO REF
+ HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
+ CAIE B,$TCHSTR ;SKIP IF IT DOES
+ JRST CHACK1 ;NO, JUST DO CHQUOTE PART
+ HRRM D,-1(A) ;CLOBBER
+CHACK1: MOVEI E,1(D)
+ HRRM E,(A) ;STORE INTO REFERENCE
+ MOVEI E,0
+ DPB E,[220400,,(A)]
+ JRST SETLP
+
+; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT
+
+EBPUR: PUSH P,E
+ PUSH P,A
+ ADD E,HITOP ; GET NEW TOP
+ CAMG E,RHITOP ; SKIP IF TOO BIG
+ JRST EBPUR1
+
+; CODE TO GROW HI SEG
+
+ MOVEI A,2000
+ ADDB A,RHITOP ; NEW TOP
+ TLNE A,777776
+ JRST HIFUL
+IFN ITS,[
+ ASH A,-10. ; NUM OF BLOCKS
+ SUBI A,1 ; BLOCK TO GET
+ .CALL HIGET
+ .VALUE
+]
+
+EBPUR1: MOVEI A,-1(E) ; NEEDED TO TERMINATE BLT
+ EXCH E,HITOP
+ HRLI E,(B)
+ MOVEI B,(E)
+ BLT E,(A)
+ POP P,A
+ POP P,E
+ POPJ P,
+
+GIVCOR: SETZ
+ SIXBIT /CORBLK/
+ 1000,,0
+ 1000,,-1
+ SETZ A
+
+HIGET: SETZ
+ SIXBIT /CORBLK/
+ 1000,,100000
+ 1000,,-1
+ A
+ 401000,,400001
+
+\f
+; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
+; ALREADY THERE
+
+ATOMHK: PUSH TP,$TOBLS ; SAVE OBLIST
+ PUSH TP,[0] ; FILLED IN LATER
+ PUSH TP,$TVEC ;SAVE TV POINTERS
+ PUSH TP,C
+ PUSH TP,$TVEC
+ PUSH TP,D
+ MOVE C,1(C) ;GET THE ATOM
+ PUSH TP,$TATOM ;AND SAVE
+ PUSH TP,C
+ PUSH TP,$TATOM
+ PUSH TP,[0]
+ HRRZ B,(C) ;GET OBLIST SPEC FROM ATOM
+ LSH B,1
+ ADDI B,1(TB) ;POINT TO ITS HOME
+ HRRM B,-9(TP)
+ MOVE B,(B)
+ MOVEM B,-10(TP) ; CLOBBER
+
+ SETZM 2(C) ; FLUSH CURRENT OBLIST SPEC
+ MOVEI E,0
+ MOVE D,C
+ PUSH P,[LOOKCR]
+ ADD D,[3,,3]
+ JUMPGE D,.+4
+ PUSH P,(D)
+ ADDI E,1
+ AOBJN D,.-2
+ PUSH P,E
+ MOVSI A,TOBLS
+ JRST ILOOKC
+LOOKCR:
+ MOVEM B,(TP)
+ JUMPN B,CHCKD
+
+;HERE IF THIS ATOM MUST BE PUT ON OBLIST
+
+USEATM: MOVE B,-2(TP) ; GET ATOM
+ HLRZ E,(B) ; SEE IF PURE OR NOT
+ TRNN E,400000 ; SKIP IF IMPURE
+ JRST PURATM
+ PUSH TP,$TATOM
+ PUSH TP,B
+ PUSH TP,$TOBLS
+ PUSH TP,-13(TP)
+ MCALL 2,INSERT
+
+ PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER
+PURAT2: MOVE C,-6(TP) ;RESET POINTERS
+ MOVE D,-4(TP)
+ SUB TP,[12,,12]
+ MOVE B,(C) ;MOVE THE ENTRY
+ HLLZM B,(D) ;DON'T WANT REF POINTER STORED
+ MOVE A,1(C) ;AND MOVE ATOM
+ MOVEM A,1(D)
+ MOVEI A,1(D)
+ ANDI B,-1 ;CHECK FOR REAL REF
+ JUMPE B,SETLP1 ;DON'T SAVE THIS ATOM ON TVP
+ HRRM A,(B) ;CLOBBER CODE
+ MOVEI A,0
+ DPB A,[220400,,(B)] ; CLOBBER TVP PORTION
+ JRST SETLP
+
+
+; HERE TO MAKE A PURE ATOM
+
+PURATM: HRRZ B,-2(TP) ; POINT TO IT
+ HLRE E,-2(TP) ; - LNTH
+ MOVNS E
+ ADDI E,2
+ PUSHJ P,EBPUR ; PURE COPY
+ HRRM B,-2(TP) ; AND STORE BACK
+ MOVE B,-2(TP)
+ JUMPE 0,PURAT0
+ HRRZ D,0
+ HLRE E,0
+ SUBM D,E
+ HLRZ 0,2(D)
+ JUMPE 0,PURAT8
+ CAIG 0,HIBOT
+ FATAL INITM--PURE IMPURE LOSSAGE
+ JRST PURAT8
+
+PURAT0: HRRZ E,(C)
+ MOVE D,-2(TP) ; GET ATOM BACK
+ HRRZ 0,(D) ; GET OBLIST CODE
+ JUMPE E,PURAT9
+PURAT7: HLRZ D,1(E)
+ MOVEI D,-2(D)
+ SUBM E,D
+ HLRZ D,2(D)
+ CAILE D,HIBOT ; IF NEXT PURE & I AM ROOT
+ JUMPE 0,PURAT8 ; TAKES ADVANTAGE OF SYSTEM=0
+ JUMPE D,PURAT8
+ MOVE E,D
+ JRST PURAT7
+
+PURAT8: HLRZ D,1(E)
+ SUBI D,2
+ SUBM E,D
+ HLRE C,B
+ SUBM B,C
+ HLRZ E,2(D)
+ HRLM E,2(B)
+ HRLM C,2(D)
+ JRST PURAT6
+
+PURAT9: HLRE A,-2(TP)
+ SUBM B,A
+ HRRZM A,(C)
+
+PURAT6: MOVE B,-10(TP) ; GET BUCKET BACK
+ MOVE C,-2(TP)
+ HRRZ 0,-9(TP)
+ HRRM 0,2(C) ; STORE OBLIST IN ATOM
+PURAT1: HRRZ C,(B) ; GET CONTENTS
+ JUMPE C,HICONS ; AT END, OK
+ CAIL C,HIBOT ; SKIP IF IMPURE
+ JRST HICONS ; CONS IT ON
+ MOVEI B,(C)
+ JRST PURAT1
+
+HICONS: HRLI C,TATOM
+ PUSH P,C
+ PUSH P,-2(TP)
+ PUSH P,B
+ MOVEI B,-2(P)
+ MOVEI E,2
+ PUSHJ P,EBPUR ; MAKE PURE LIST CELL
+
+ MOVE C,(P)
+ SUB P,[3,,3]
+ HRRM B,(C) ; STORE IT
+ MOVE B,1(B) ; ATOM BACK
+ MOVE C,-6(TP) ; GET TVP SLOT
+ HRRM B,1(C) ; AND STORE
+ HLRZ 0,(B) ; TYPE OF VAL
+ MOVE C,B
+ CAIN 0,TUNBOU ; NOT UNBOUND?
+ JRST PURAT3 ; UNBOUND, NO VAL
+ MOVEI E,2 ; COUNT AGAIN
+ PUSHJ P,EBPUR ; VALUE CELL
+ MOVE C,-2(TP) ; ATOM BACK
+ HLLZS (B) ; CLEAR LH
+ MOVSI 0,TLOCI
+ MOVEM B,1(C)
+ SKIPA
+PURAT3: MOVEI 0,0
+ HRRZ A,(C) ; GET OBLIST CODE
+ MOVE A,OBTBL2(A)
+ HRRM A,2(C) ; STORE OBLIST SLOT
+ MOVEM 0,(C)
+ JRST PURAT2
+\f
+; A POSSIBLE MATCH ARRIVES HERE
+
+CHCKD: MOVE D,(TP) ;THEY MATCH!, GET EXISTING ATOM
+ MOVEI A,(D) ;GET TYPE OF IT
+ MOVE B,-2(TP) ;GET NEW ATOM
+ HLRZ 0,(B)
+ TRZ A,377777 ; SAVE ONLY 400000 BIT
+ TRZ 0,377777
+ CAIN 0,(A) ; SKIP IF WIN
+ JRST IM.PUR
+ MOVSI 0,400000
+ ANDCAM 0,(B)
+ ANDCAM 0,(D)
+ HLRZ A,(D)
+ JUMPN A,A1VAL
+ MOVE A,(B) ;MOVE VALUE
+ MOVEM A,(D)
+ MOVE A,1(B)
+ MOVEM A,1(D)
+ MOVE B,D ;EXISTING ATOM TO B
+ MOVEI 0,(B)
+ CAIL 0,HIBOT
+ JRST .+3
+ PUSHJ P,VALMAK ;MAKE A VALUE
+ JRST .+2
+ PUSHJ P,PVALM
+
+;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
+
+OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP
+ MOVE C,[-TVLNT,,TVSTRT] ;AND A COPY OF TVP
+ MOVEI A,0 ;INITIALIZE COUNTER
+ALOOP: CAMN B,1(C) ;IS THIS IT?
+ JRST AFOUND
+ ADD C,[2,,2] ;BUMP COUNTER
+ CAMG C,D
+ AOJA A,ALOOP ;NO, KEEP LOOKING
+
+ MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
+/]
+TYPIT: PUSHJ P,MSGTYP
+ .VALUE
+
+AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET
+ ADDI A,1
+ ADDI A,TVSTRT
+ MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM
+ HRRZ B,(C) ;POINT TO REFERENCE
+ SKIPE B ;ANY THERE?
+ HRRM A,(B) ;YES, CLOBBER AWAY
+ SUB TP,[12,,12]
+ MOVEI A,0
+ DPB A,[220400,,(B)] ; KILL TVP POINTER
+ JRST SETLP1 ;AND GO ON
+
+A1VAL: HLRZ C,(B) ;GET VALUE'S TYPE
+ MOVE B,D ;NOW PUT EXISTING ATOM IN B
+ CAIN C,TUNBOU ;UNBOUND?
+ JRST OFFIND ;YES, WINNER
+
+ MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
+/]
+ JRST TYPIT
+
+
+IM.PUR: MOVEI B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE
+/]
+ JRST TYPIT
+
+PAGLOS: MOVEI B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT
+/]
+ JRST TYPIT
+
+HIFUL: MOVEI B,[ASCIZ /LOSSAGE--HI SEG FULL
+/]
+ JRST TYPIT
+
+\f
+;MAKE A VALUE IN SLOT ON GLOBAL SP
+
+VALMAK: HLRZ A,(B) ;TYPE OF VALUE
+ CAIE A,400000+TUNBOU
+ CAIN A,TUNBOU ;VALUE?
+ JRST VALMA1
+ MOVE A,GLOBSP+1 ;GET POINTER TO GLOBAL SP
+ SUB A,[4,,4] ;ALLOCATE SPACE
+ CAMG A,GLOBAS+1 ;CHECK FOR OVERFLOW
+ JRST SPOVFL
+ MOVEM A,GLOBSP+1 ;STORE IT BACK
+ MOVE C,(B) ;GET TYPE CELL
+ TLZ C,400000
+ HLLZM C,2(A) ;INTO TYPE CELL
+ MOVE C,1(B) ;GET VALUE
+ MOVEM C,3(A) ;INTO VALUE SLOT
+ MOVSI C,TGATOM ;GET TATOM,,0
+ MOVEM C,(A)
+ MOVEM B,1(A) ;AND POINTER TO ATOM
+ MOVSI C,TLOCI ;NOW CLOBBER THE ATOM
+ MOVEM C,(B) ;INTO TYPE CELL
+ ADD A,[2,,2] ;POINT TO VALUE
+ MOVEM A,1(B)
+ POPJ P,
+
+VALMA1: SETZM (B)
+ POPJ P,
+
+SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
+/]
+ JRST TYPIT
+
+
+PVALM: HLRZ 0,(B)
+ CAIE 0,400000+TUNBOU
+ CAIN 0,TUNBOU
+ JRST VALMA1
+ MOVEI E,2
+ PUSH P,B
+ PUSHJ P,EBPUR
+ POP P,C
+ MOVEM B,1(C)
+ MOVSI 0,TLOCI
+ MOVEM 0,(C)
+ MOVE B,C
+ POPJ P,
+\f;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER
+
+VECTGO DUMMY1
+
+IRP A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW
+ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER
+IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR
+MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS
+CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ
+CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN
+CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG
+C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR
+OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY
+CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO
+CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT
+CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C
+CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL
+CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS
+CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1
+CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT
+GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF
+CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ
+TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG
+NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR,VECBOT]
+ .GLOBAL A
+ ADDSQU A
+TERMIN
+
+VECRET
+
+; ROUTINE TO SORT AND PURIFY SQUOZE TABLE
+
+SQSETU: MOVE A,[SQUTBL-SQULOC+2,,SQUTBL]
+ MOVEI 0,1
+SQ2: MOVE B,(A)
+ CAMG B,2(A)
+ JRST SQ1
+ MOVEI 0,0
+ EXCH B,2(A)
+ MOVEM B,(A)
+ MOVE B,1(A)
+ EXCH B,3(A)
+ MOVEM B,1(A)
+SQ1: ADD A,[2,,2]
+ JUMPL A,SQ2
+ JUMPE 0,SQSETU
+IFE ITS,[
+STSQU: MOVE B,[440700,,SQBLK]
+ PUSHJ P,MNGNAM
+ HRROI B,SQBLK
+ MOVSI A,600001
+ GTJFN
+ FATAL CANT MAKE FIXUP FILE
+ MOVEI E,(A)
+ MOVE B,[440000,,100000]
+ OPENF
+ FATAL CANT OPEN FIXUP FILE
+ MOVE B,[444400,,SQUTBL]
+ MOVNI C,SQULOC-SQUTBL
+ SOUT
+ MOVEI A,(E)
+ CLOSF
+ JFCL
+ MOVE A,[SQUTBL-SQULOC,,SQUTBL]
+ MOVEM A,SQUPNT"
+]
+IFN ITS,[
+.GLOBAL CSIXBT
+STSQU: MOVE C,MUDSTR+2 ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE
+ PUSHJ P,CSIXBT
+ HRRI C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE
+ MOVSS C
+ MOVEM C,SQBLK+2 ; STORE IN APPROPRIATE BLOCKS
+ MOVEM C,SQWBLK+2
+ .SUSET [.SSNAM,,SQDIR]
+ .OPEN GCHN,SQWBLK ; OPEN FILE
+ FATAL CAN'T CREATE SQUOZE FILE
+ MOVE A,[SQUTBL-SQULOC,,SQUTBL]
+ MOVEM A,SQUPNT"
+ .IOT GCHN,A
+ .CLOSE GCHN ; CLOSE THE CHANNEL
+]
+ POPJ P,
+
+RHITOP: 0
+
+OBSZ: 151.
+ 13.
+ 151.
+ 151.
+ 317.
+
+OBTBL2: ROOT+1
+ ERROBL+1
+ INTOBL+1
+ MUDOBL+1
+ INITIAL+1
+
+OBTBL: INITIAL+1-TVSTRT+TVBASE
+ MUDOBL+1-TVSTRT+TVBASE
+ INTOBL+1-TVSTRT+TVBASE
+ ERROBL+1-TVSTRT+TVBASE
+ ROOT+1-TVSTRT+TVBASE
+OBNAM: MQUOTE INITIAL
+ IMQUOTE MUDDLE
+ MQUOTE INTERRUPTS
+ MQUOTE ERRORS
+ MQUOTE ROOT
+
+OBTBL1: INITIAL+1
+ MUDOBL+1
+ INTOBL+1
+ ERROBL+1
+ ROOT+1
+
+
+IFN ITS,[
+SQWBLK: SIXBIT / 'DSK/
+ SIXBIT /SQUOZE/
+ SIXBIT /TABLE/
+]
+IFE ITS,[
+MNGNAM: MOVE A,[440700,,MUDSTR+2] ; FOR NAME HACKING
+ ILDB 0,A ; SEE IF IT IS A VERSION
+ CAIN 0,177
+ POPJ P,
+ MOVE A,B
+ ILDB 0,A
+ CAIN 0,"X ; LOOK FOR X'S
+ JRST .+3
+ MOVE B,A
+ JRST .-4
+
+ MOVE A,[440700,,MUDSTR+2]
+ ILDB 0,A
+ IDPB 0,B
+ ILDB 0,A
+ IDPB 0,B
+ ILDB 0,A
+ IDPB 0,B
+ POPJ P,
+]
+
+IFN ITS,[
+.GLOBAL VCREATE,MUDSTR
+
+DEBUG: MOVE E,[440600,,[SIXBIT /EXPERIMENTAL/]]
+ MOVEI 0,12.
+ JRST STUFF
+
+VCREATE: .SUSET [.SSNAM,,[SIXBIT /MUDSYS/]]
+ .OPEN 0,OP%
+ .VALUE
+ MOVEI 0,0 ; SET 0 TO DO THE .RCHST
+ .RCHST 0
+ .CLOSE 0
+ .FDELE DB%
+ .VALUE
+ MOVE E,[440600,,B]
+ MOVEI 0,6
+STUFF: MOVE D,[440700,,MUDSTR+2]
+STUFF1: ILDB A,E ; GET A CHAR
+ CAIN A,0 ;SUPRESS SPACES
+ MOVEI A,137 ;RUBOUT'S DON'T TYPE OUT
+ ADDI A,40 ; TO ASCII
+ IDPB A,D ; STORE
+ SOJN 0,STUFF1
+ SETZM 34
+ SETZM 35
+ SETZM 36
+ .VALUE
+
+OP%: 1,,(SIXBIT /DSK/)
+ SIXBIT /MUD%/
+ SIXBIT />/
+
+DB%: (SIXBIT /DSK/)
+ SIXBIT /MUD%/
+ SIXBIT /</
+ 0
+ 0
+]
+
+
+.GLOBAL GCDIR,ILDBLK,TILDBL,GCLDBK,LENGC,SLENGC,SGCLBK,RLENGC
+.GLOBAL SECBLK,SECLEN,RSLENG,DECBLK
+
+; ROUTINE TO DUMP OUT THE GARBAGE-COLLECTOR
+
+DUMPGC:
+IFN ITS,[
+ .SUSET [.SSNAM,,GCDIR] ; SET SNAME
+ MOVE C,MUDSTR+2 ; CREATE SECOND NAMES
+ PUSHJ P,CSIXBT
+ HRRI C,(SIXBIT /MUD/)
+ MOVS A,C ; MUDxx IS SECOND NAME
+ MOVEM A,GCLDBK+2
+ MOVEM A,SGCLBK+2
+ MOVEM A,ILDBLK+2
+ MOVEM A,GCDBLK+2 ; SMASH IN SECOND NAMES
+ MOVEM A,SGCDBK+2
+ MOVEM A,INTDBK+2
+ .OPEN 0,GCDBLK ; OPEN GC FILE
+ FATAL CANT CREATE AGC FILE
+ MOVNI A,LENGC ; CALCULATE IOT POINTER
+ ASH A,10.
+ HRLZS A
+ HRRI A,REALGC
+ .IOT 0,A ; SEND IT OUT
+ .CLOSE 0, ; CLOSE THE CHANNEL
+ .OPEN 0,SGCDBK ; OPEN GC FILE
+ FATAL CANT CREATE AGC FILE
+ MOVNI A,SLENGC ; CALCULATE IOT POINTER
+ ASH A,10.
+ HRLZS A
+ HRRI A,REALGC+RLENGC
+ .IOT 0,A ; SEND IT OUT
+ .CLOSE 0, ; CLOSE THE CHANNEL
+
+
+; ROUTINE TO DUMP THE INTERPRETER
+
+ .SUSET [.SSNAM,,INTDIR]
+ .OPEN 0,ILDBLK ; OPEN FILE TO INTERPRETER BLOCK
+ FATAL CANT FIXUP INTERPRETER
+ HLRE B,TP ; MAKE SURE BIG ENOUGJ
+ MOVNS B ; SEE IF WE WIN
+ CAIGE B,400 ; SKIP IF WINNING
+ FATAL NO ROOM FOR PAGE MAP
+ MOVSI A,-400
+ HRRI A,1(TP)
+ .ACCES 0,[1]
+ .IOT 0,A ; GET IN PAGE MAP
+ .CLOSE 0,
+ .OPEN 0,INTDBK
+ FATAL CANT FIXUP INTERPRETER
+ MOVEI A,1 ; INITIALIZE FILE PAGE COUNT
+ MOVEI B,0 ; CORE PAGE COUNT
+ MOVEI E,1(TP)
+LOPFND: HRRZ 0,(E)
+ JUMPE 0,NOPAG ; IF 0 FORGET IT
+ ADDI A,1 ; AOS FILE MAP
+NOPAG: ADDI B,1 ; AOS PAGE MAP
+ CAIE B,PAGEGC ; SKIP IF DONE
+ AOJA E,LOPFND
+ ASH A,10. ; TO WORDS
+ .ACCES 0,A
+ MOVNI B,LENGC
+ ASH B,10. ; TO WORDS
+ HRLZS B ; SWAP
+ HRRI B,AGCLD
+ .IOT 0,B
+ .CLOSE 0,
+ POPJ P, ; DONE
+
+GCDBLK: SIXBIT / 'DSK/
+ SIXBIT /AGC/
+ SIXBIT /MUD /
+
+SGCDBK: SIXBIT / 'DSK/
+ SIXBIT /SGC/
+ SIXBIT /MUD /
+
+INTDBK: 100007,,(SIXBIT /DSK/)
+ SIXBIT /TS/
+ SIXBIT /MUD/
+
+]
+IFE ITS,[
+ MOVE B,[440700,,GCLDBK]
+ PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
+ HRROI B,GCLDBK
+ MOVSI A,600001
+ GTJFN
+ FATAL CANT WRITE OUT GC
+ MOVEI E,(A)
+ MOVE B,[440000,,100000]
+ OPENF
+ FATAL CANT OPEN GC FILE
+ MOVNI C,LENGC
+ ASH C,10.
+ MOVE B,[444400,,REALGC]
+ MOVEI A,(E)
+ SOUT
+ MOVEI A,(E)
+ CLOSF
+ JFCL
+ MOVEI D,LENGC+LENGC
+ MOVNI A,1
+ MOVEI B,REALGC
+ ASH B,-9.
+ HRLI B,400000
+
+ PMAP
+ ADDI B,1
+ SOJG D,.-2
+
+ MOVE B,[440700,,SGCLBK]
+ PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
+ HRROI B,SGCLBK
+ MOVSI A,600001
+ GTJFN
+ FATAL CANT WRITE OUT GC
+ MOVEI E,(A)
+ MOVE B,[440000,,100000]
+ OPENF
+ FATAL CANT OPEN GC FILE
+ MOVNI C,SLENGC
+ ASH C,10.
+ MOVE B,[444400,,REALGC+RLENGC]
+ MOVEI A,(E)
+ SOUT
+ MOVEI A,(E)
+ CLOSF
+ JFCL
+ MOVEI D,SLENGC+SLENGC
+ MOVNI A,1
+ MOVEI B,REALGC+RLENGC
+ ASH B,-9.
+ HRLI B,400000
+
+ PMAP
+ ADDI B,1
+ SOJG D,.-2
+
+ MOVE B,[440700,,SECBLK]
+ PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
+ HRROI B,SECBLK
+ MOVSI A,600001
+ GTJFN
+ FATAL CANT WRITE OUT GC
+ MOVEI E,(A)
+ MOVE B,[440000,,100000]
+ OPENF
+ FATAL CANT OPEN GC FILE
+ MOVNI C,SECLEN
+ ASH C,10.
+ MOVE B,[444400,,REALGC+RLENGC+RSLENG]
+ MOVEI A,(E)
+ SOUT
+ MOVEI A,(E)
+ CLOSF
+ JFCL
+
+; NOW MUNG THE THING TO BE DIFFERENT TO USE UUOS FOR DEBUGGING VERSION
+
+.GLOBAL %FXUPS,%FXEND
+
+ MOVEI A,%FXUPS
+
+%DBG1: HLRZ D,(A)
+ HRRZ A,(A)
+ LDB 0,[331100,,(A)] ; GET INS
+ MOVEI C,%TBL
+ HRRZ B,(C)
+ CAME B,0
+ AOJA C,.-2
+ CAIN B,<<(XBLT)>_<-9.>>
+ HLLZS (A)
+ LDB B,[331100,,(C)]
+ DPB B,[331100,,(A)]
+ MOVE A,D
+ JUMPN A,%DBG1
+%DBG2:
+ MOVE B,[440700,,DECBLK]
+ PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY
+ HRROI B,DECBLK
+ MOVSI A,600001
+ GTJFN
+ FATAL CANT WRITE OUT GC
+ MOVEI E,(A)
+ MOVE B,[440000,,100000]
+ OPENF
+ FATAL CANT OPEN GC FILE
+ MOVNI C,SECLEN
+ ASH C,10.
+ MOVE B,[444400,,REALGC+RLENGC+RSLENG]
+ MOVEI A,(E)
+ SOUT
+ MOVEI A,(E)
+ CLOSF
+ JFCL
+ MOVEI D,SECLEN+SECLEN
+ MOVNI A,1
+ MOVEI B,REALGC+RLENGC
+ ASH B,-9.
+ HRLI B,400000
+
+ PMAP
+ ADDI B,1
+ SOJG D,.-2
+
+ MOVE B,[440700,,ILDBLK]
+ SKIPE OPSYS
+ MOVE B,[440700,,TILDBL]
+ PUSHJ P,MNGNAM
+ MOVSI C,-1000
+ MOVSI A,400000
+RPA: RPACS
+ TLNE B,10000
+ TLNN B,400 ; SKIP IF NOT PRIVATE
+ SKIPA
+ MOVES (C)
+ ADDI C,777
+ ADDI A,1
+ AOBJN C,RPA
+
+ MOVNI A,1
+ CLOSF
+ FATAL CANT CLOSE STUFF
+ HRROI B,ILDBLK
+ MOVSI A,100001
+ GTJFN ; GET A JFN
+ FATAL GARBAGE COLLECTOR IS MISSING
+ HRRZS E,A ; SAVE JFN
+ MOVE B,[440000,,300000]
+ OPENF
+ FATAL CANT OPEN GC FILE
+ MOVEI A,(E) ; FIND OUT LENGTH OF MAP
+ BIN ; GET LENGTH WORD
+ HLRZ 0,B
+ CAIE 0,1776 ; TOPS20 SSAVE FILE FORMAT
+ CAIN 0,1000 ; TENEX SSAVE FILE FORMAT
+ JRST .+2
+ FATAL NOT AN SSAVE FILE
+ MOVEI A,(B) ; ISOLATE SIZE OF MAP
+ HLRE B,TP ; MUST BE SPACE FOR CRUFT
+ MOVNS B
+ CAIGE B,(A) ; ROOM?
+ FATAL NO ROOM FOR PAGE MAP (GULP)
+ MOVN C,A
+ MOVEI A,(E) ; READY TO READ IN MAP
+ MOVEI B,1(TP) ; ONTO TP STACK
+ HRLI B,444400
+ SIN ; SNARF IT IN
+
+ MOVEI A,1(TP) ; POINT TO MAP
+ CAIE 0,1000
+ JRST RPA1 ; GO TO THE TOPS20 CODE
+ LDB 0,[221100,,(A)] ; GET FORK PAGE
+ CAIE 0,PAGEGC+PAGEGC ; GOT IT?
+ AOJA A,.-2
+ JRST RPA2
+
+RPA1: ADDI A,1 ; POINT TO PROCESS PAGE NUMBER
+ LDB 0,[331100,,(A)] ; REPEAT COUNT IN 0
+ LDB B,[3300,,(A)] ; FIRST PAGE NUMBER IN B
+ ADD 0,B ; LARGEST PAGE NUMBER
+ CAIL 0,PAGEGC+PAGEGC
+ CAILE B,PAGEGC+PAGEGC
+ AOJA A,RPA1 ; NEXT PAIR OF WORDS PLEASE
+ SUBI A,1 ; POINT TO FILE PAGE NUMBER
+ SUBI B,PAGEGC+PAGEGC
+ MOVN B,B
+ ADDM B,(A) ; SET UP THE PAGE
+
+RPA2: HRRZ B,(A) ; GET PAGE
+ MOVEI A,(E) ; GET JFN
+ ASH B,9.
+ SFPTR
+ FATAL ACCESS OF FILE FAILED
+ MOVEI A,(E)
+ MOVE B,[444400,,AGCLD]
+ MOVNI C,LENGC
+ ASH C,10.
+ SOUT
+ MOVEI A,(E)
+ CLOSF
+ JFCL
+ POPJ P,
+
+; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
+
+TWENTY: HRROI A,C ; RESULTS KEPT HERE
+ HRLOI B,600015
+ MOVEI C,0 ; CLEAN C UP
+ DEVST
+ JFCL
+ MOVEI A,1 ; TENEX HAS OPSYS = 1
+ CAME C,[ASCII/NUL/] ; TOPS20 GIVES "NUL"
+ MOVEM A,OPSYS ; TENEX GIVES "NIL"
+ POPJ P,
+%TBL: IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT]
+ S!A <<(A)>_<-9.>>
+ TERMIN
+
+GCLDBK: ASCIZ /MDLXXX.AGC/
+SGCLBK: ASCIZ /MDLXXX.SGC/
+SECBLK: ASCIZ /MDLXXX.SEC/
+ILDBLK: ASCIZ /MDLXXX.EXE/
+TILDBL: ASCIZ /MDLXXX.SAV/
+DECBLK: ASCIZ /MDLXXX.DEC/
+]
+
+
+
+END SETUP
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff