2 TITLE INITIALIZATION FOR MUDDLE
6 LAST==1 ;POSSIBLE CHECKS DONE LATER
15 .GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AGC,ICR,SWAP,OBLNT,MSGTYP
16 .GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,VECBOT,VECTOP,TPBASE
17 .GLOBAL LISTEN,ROOT,TBINIT,TOPLEV,INTOBL,ERROBL,TTYOPE
18 .GLOBAL IOINS,BUFRIN,IOIN2,ECHO,TYI,TYO
20 SETUP: MOVE P,GCPDL ;GET A PUSH DOWN STACK
21 MOVE TVP,[-TVLNT,,TVBASE] ;GET INITIAL TRANSFER VECTOR
22 PUSHJ P,TTYOPE ;OPEN THE TTY
23 MOVEI B,[ASCIZ /MUDDLE INITIALIZATION.
25 PUSHJ P,MSGTYP ;PRINT IT
26 MOVE A,CODTOP ;CHECK FOR A WINNING LOAD
27 CAML A,VECBOT ;IT BETTER BE LESS
28 JRST DEATH1 ;LOSE COMPLETELY
29 MOVE B,PARBOT ;CHECK FOR ANY PAIRS
30 CAME B,PARTOP ;ANY LOAD/ASSEMBLE TIME PAIRS?
31 JRST PAIRCH ;YES CHECK THEM
33 MOVEM A,PARBOT ;UPDATE PARBOT AND TOP
35 SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR
36 MOVEI A,(PVP) ;SET UP A BLT
37 HRLI A,PVBASE ;FROM PROTOTYPE
38 BLT A,PVLNT*2-1(PVP) ;INITIALIZE
39 MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS
40 MOVEI TB,(TP) ;AND A BASE
42 SUB TP,[1,,1] ;POP ONCE
44 ; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
46 PUSH P,[3] ;COUNT INITIAL OBLISTS
48 MAKEOB: MCALL 0,MOBLIST ;GOBBLE AN OBLIST
49 PUSH TP,$TOBLS ;AND SAVE THEM
52 MOVEM B,@OBTBL(A) ;STORE
55 MOVE C,TVP ;MAKE 2 COPIES OF XFER VECTOR POINTER
58 ;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
59 ;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR
61 ILOOP: HLRZ A,(C) ;FIRST TYPE
62 JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED
63 CAIN A,TCHSTR ;CHARACTER STRING?
64 JRST CHACK ;YES, GO HACK IT
66 JRST ATOMHK ;YES, CHECK IT OUT
67 MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME)
71 SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR
72 ADD D,[2,,2] ;OUT COUNTER
73 SETLP1: ADD C,[2,,2] ;AND IN COUNTER
74 JUMPL C,ILOOP ;JUMP IF MORE TO DO
76 ;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
78 TVEXAU: HLRE B,C ;GET -LENGTH
79 SUBI C,(B) ;POIT TO DOPE WORD
81 HLRZ A,1(C) ;INTIAL LENGTH TO A
82 MOVEI E,(C) ;COPY OF POINTER TO DOPW WD
83 SUBI E,(D) ;AMOUNT LEFT OVER TO E
84 HRLZM E,1(C) ;CLOBBER INTO DOPE WORD FOR GARBAGE
85 MOVSI E,(E) ;PREPARE TO UPDATE TVP
86 ADD TVP,E ;NOW POINTS TO THE RIGHT AMOUNT
87 HLRE B,D ;-AMOUNT LEFT TO B
88 ADD B,A ;AMOUNT OF GOOD STUFF
89 HRLZM B,1(D) ;STORE IT IN GODD DOPE WORD
90 MOVSI E,400000 ;CLOBBER TO GENERAL IN BOTH CASES
97 MOVE A,TYPVEC+1(TVP) ;GET POINTER
98 MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS
99 MOVSI B,TATOM ;SET TYPE TO ATOM
101 TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM
102 MOVE C,@1(A) ;GET ATOM
107 ;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
109 ;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
111 IRP A,,[[PRINT,TCHSTR],[OUTPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
119 MCALL 4,FOPEN ;OPEN THE OUT PUT CHANNEL
120 MOVEM B,TTOCHN+1(TVP) ;SAVE IT
122 ;ASSIGN AS GLOBAL VALUE
125 PUSH TP,MQUOTE OUTCHAN
128 MOVE A,[PUSHJ P,TYO] ;MORE WINNING INS
129 MOVEM A,IOINS(B) ;CLOBBER
132 ;SETUP A CALL TO OPEN THE TTY CHANNEL
134 IRP A,,[[READ,TCHSTR],[INPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
142 MCALL 4,FOPEN ;OPEN INPUTCHANNEL
143 MOVEM B,TTICHN+1(TVP) ;SAVE IT
144 PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE
145 PUSH TP,MQUOTE INCHAN
148 MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR
150 MOVEM A,IOIN2(C) ;MORE OF A WINNER
152 MOVEM A,ECHO(C) ;ECHO INS
155 ;GENERATE AN INITIAL PROCESS AND SWAP IT IN
157 PUSHJ P,ICR ;CREATE IT
158 MOVE D,B ;SET UP TO CALL SWAP
159 JSP C,SWAP ;AND SWAP IN
160 MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS
161 PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME
168 PUSH TP,C ;TPSAV PUSHED
171 HRRI TB,(TP) ;SETUP TB
174 MOVEM TB,TBINIT+1(PVP)
176 ; CREATE LIST OF ROOT AND NEW OBLIST
178 MCALL 0,MOBLIST ;MAKE OBLIST
179 PUSH TP,A ;SAVE RESULTS
183 MCALL 2,LIST ;MAKE LIST
186 PUSH TP,$TATOM ;ASSIGN TO GLOBAL VALUE
187 PUSH TP,MQUOTE OBLIST
194 PUSH TP,MQUOTE QUITTER
196 PUSH TP,$TCHAN ;SET UP CNTL-G INT
197 PUSH TP,TTICHN+1(TVP)
200 MCALL 2,ONCHAR ;TURN ON INTERRUPT
201 MOVEI A,SETUP ;POINT TO START
204 SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO
206 PUSH P,[14.,,14.] ;PUSH A SMALL PRGRM ONTO P
207 MOVEI A,1(P) ;POINT TO ITS START
208 PUSH P,[JRST AGC] ;GO TO AGC
209 PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P
210 PUSH P,[SUB B,-13.(P)] ;FUDGE TO POP OFF PROGRAM
211 PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME
212 PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP
213 PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT
214 PUSH P,[MOVE B,SPSTO+1(PVP)] ;SP
215 PUSH P,[MOVEM B,SPSAV(TB)]
216 PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO
217 PUSH P,[MOVEM B,PCSAV(TB)]
218 PUSH P,[MOVSI B,(.VALUE )]
220 PUSH P,[JRST B] ;GO DO VALRET
221 PUSH P,[A] ;RETURN ADDRESS FOR AGC
223 MOVE A,[JRST -11.(P)] ;WHEER TO START
224 SUB P,[1,,1] ;REMOVE LOSSAGE
226 MOVE B,[.VALUE C] ;SETUP VALRET
227 MOVE C,[ASCII \
\170/
\e9\]
228 MOVE D,[ASCII \B!
\eQî\]
229 MOVE E,[ASCIZ \
\16*\] ;TERMINATE
237 DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
242 ;CHARACTER STRING HACKER
244 CHACK: MOVE A,(C) ;GET TYPE
245 HLLZM A,(D) ;STORE IN NEW HOME
246 MOVE B,1(C) ;GET POINTER
248 SUBM B,E ;E POINTS TO DOPE WORDS
249 ADDI E,1 ;POINT TO 2ND
250 HRRM E,(D) ;INTO PE CELL
251 HRLI B,350700 ;MAKE POINT BYTER
252 MOVEM B,1(D) ;AND STORE IT
253 ANDI A,-1 ;CLEAR LH OF A
254 JUMPE A,SETLP ;JUMP IF NO REF
255 MOVE E,(P) ;GET OFFSET
257 HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
258 CAIE B,$TCHSTR ;SKIP IF IT DOES
259 JRST CHACK1 ;NO, JUST DO CHQUOTE PART
260 HRRM E,-1(A) ;CLOBBER
262 DPB B,[220400,,-1(A)] ;CLOBBER INDEX FIELD
264 HRRM E,(A) ;STORE INTO REFERENCE
267 ; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
270 ATOMHK: PUSH TP,$TVEC ;SAVE TV POINTERS
274 MOVE B,1(C) ;GET THE ATOM
275 PUSH TP,$TATOM ;AND SAVE
277 HRRZ A,(B) ;GET OBLIST SPEC FROM ATOM
279 ADDI A,1(TB) ;POINT TO ITS HOME
281 PUSH TP,(A) ;AND SAV IT
283 ADD B,[2,,2] ;POINT TO ATOM'S PNAME
284 MOVEI A,0 ;FOR HASHING
287 MOVMS A ;FORCE POSITIVE RESULT
289 HRLS B ;REMAINDER IN B IS BUCKET
290 ADDB B,(TP) ;UPDATE POINTER
292 SKIPN C,(B) ;GOBBLE BUCKET CONTENTS
293 JRST USEATM ;NONE, LEAVE AND USE THIS ATOM
294 OBLOO3: MOVE E,-2(TP) ;RE-GOBBLE ATOM
295 ADD E,[2,,2] ;POINT TO PNAME
296 SKIPN D,1(C) ;CHECK LIST ELEMNT
297 JRST NXTBCK ;0, CHECK NEXT IN THIS BUCKET
298 ADD D,[2,,2] ;POINT TO PNAME
299 OBLOO2: MOVE A,(D) ;GET A WORD
301 JRST NXTBCK ;THEY DIFFER, TRY NEX
302 OBLOOP: AOBJP E,CHCKD ;COULD BE A MATCH, GO CHECK
303 AOBJN D,OBLOO2 ;HAVEN'T LOST YET
305 NXTBCK: HRRZ C,(C) ;CDR THE LIST
306 JUMPN C,OBLOO3 ;IF NOT NIL, KEEP TRYING
308 ;HERE IF THIS ATOM MUST BE PUT ON OBLIST
310 USEATM: MOVE B,(TP) ;POINTER TO BUCKET
311 HRRZ C,(B) ;POINTER TO LIST IN THIS BUCKET
312 PUSH TP,$TATOM ;GENERATE CALL TO CONS
316 MCALL 2,CONS ;CONS IT UP
317 MOVE C,(TP) ;REGOBBLE BUCKET POINTER
319 MOVE B,-2(TP) ;POINT TO ATOM
320 PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER
321 MOVE C,-6(TP) ;RESET POINTERS
324 MOVE B,(C) ;MOVE THE ENTRY
325 HLLZM B,(D) ;DON'T WANT REF POINTER STORED
326 MOVE A,1(C) ;AND MOVE ATOM
328 MOVE A,(P) ;GET CURRENT OFFSET
331 ANDI B,-1 ;CHECKFOR REAL REF
333 HRRM A,(B) ;CLOBBER CODE
337 ; A POSSIBLE MATCH ARRIVES HERE
339 CHCKD: AOBJN D,NXTBCK ;SIZES DIFFER, JUMP
340 MOVE D,1(C) ;THEY MATCH!, GET EXISTING ATOM
341 HLRZ A,(D) ;GET TYPE OF IT
342 CAIE A,TUNBOU ;UNBOUND?
343 JRST A1VAL ;YES, CONTINUE
344 MOVE B,-2(TP) ;GET NEW ATOM
345 MOVE A,(B) ;MOVE VALUE
349 MOVE B,D ;EXISTING ATOM TO B
350 PUSHJ P,VALMAK ;MAKE A VALUE
352 ;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
354 OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP
355 MOVE C,TVP ;AND A COPY OF TVP
356 MOVEI A,0 ;INITIALIZE COUNTER
357 ALOOP: CAMN B,1(C) ;IS THIS IT?
359 ADD C,[2,,2] ;BUMP COUNTER
360 CAMGE C,D ;HAVE WE HIT END
361 AOJA A,ALOOP ;NO, KEEP LOOKING
363 MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
365 TYPIT: PUSHJ P,MSGTYP
368 AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET
370 MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM
371 HRRZ B,(C) ;POINT TO REFERENCE
373 HRRM A,(B) ;YES, CLOBBER AWAY
375 JRST SETLP1 ;AND GO ON
377 A1VAL: MOVE B,-2(TP) ;GET NEW ATOM POINTER
378 HLRZ C,(B) ;GET VALUE'S TYPE
379 MOVE B,D ;NOW PUT EXISTING ATOM IN B
380 CAIN C,TUNBOU ;UNBOUND?
381 JRST OFFIND ;YES, WINNER
383 MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
388 ;MAKE A VALUE IN SLOT ON GLOBAL SP
390 VALMAK: HLRZ A,(B) ;TYPE OF VALUE
391 CAIN A,TUNBOU ;VALUE?
392 POPJ P, ;NO, ALL DONE
393 MOVE A,GLOBSP+1(TVP) ;GET POINTER TO GLOBAL SP
394 SUB A,[4,,4] ;ALLOCATE SPACE
395 CAMG A,GLOBAS+1(TVP) ;CHECK FOR OVERFLOW
397 MOVEM A,GLOBSP+1(TVP) ;STORE IT BACK
398 MOVE C,(B) ;GET TYPE CELL
399 HLLZM C,2(A) ;INTO TYPE CELL
400 MOVE C,1(B) ;GET VALUE
401 MOVEM C,3(A) ;INTO VALUE SLOT
402 MOVSI C,TATOM ;GET TATOM,,0
404 MOVEM B,1(A) ;AND POINTER TO ATOM
405 MOVSI C,TLOCI ;NOW CLOBBER THE ATOM
406 MOVEM C,(B) ;INTO TYPE CELL
407 ADD A,[2,,2] ;POINT TO VALUE
411 SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW