Add more manuals.
[pdp10-muddle.git] / <mdl.int> / initm.mid.371
1 TITLE INITIALIZATION FOR MUDDLE
2
3 RELOCATABLE
4
5 HTVLNT==3000            ; GUESS OF TVP LENGTH
6
7 LAST==1 ;POSSIBLE CHECKS DONE LATER
8
9 .INSRT MUDDLE >
10
11 SYSQ
12 XBLT==123000,,
13 GCHN==0
14 IFE ITS,[
15 FATINS==.FATAL"
16 SEVEC==104000,,204
17 .INSRT STENEX >
18 ]
19
20 IMPURE
21
22 OBSIZE==151.    ;DEFAULT OBLIST SIZE
23
24 .LIFG <TVBASE+TVLNT-TVLOC>
25 .LOP .VALUE
26 .ELDC
27
28 .GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ
29 .GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW
30 .GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE
31 .GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER
32 .GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR
33 .GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1
34 .GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR
35 .GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS
36 .GLOBAL HASHTB,ILOOKC
37
38 LPUR==.LPUR             ; SET UP SO LPUR WORKS
39
40 ; INIITAL AMOUNT OF AFREE SPACE
41
42 STOSTR:
43 LOC TVSTRT-1
44 ISTOST: TVSTRT-STOSTR,,0
45
46         BLOCK HTVLNT                            ; TVP
47
48 SETUP:  MOVEI   0,0                     ; ZERO ACS
49         MOVEI   17,1
50         BLT     17,17
51
52 IFN ITS,        .SUSET  [.RUNAM,,%UNAM]         ; FOR AGC'S BENFIT
53         MOVE    P,GCPDL         ;GET A PUSH DOWN STACK
54 IFN ITS,        .SUSET  [.SMASK,,[200000]]      ; ENABLE PDL OVFL
55         MOVE    0,[TVBASE,,TVSTRT]
56         BLT     0,TVSTRT+HTVLNT-3       ; BLT OVER TVP
57 IFE ITS,        PUSHJ   P,TWENTY        ; FIND OUT WHETHER IT IS TOPS20 OR NOT
58         PUSHJ   P,TTYOPE                ;OPEN THE TTY
59         AOS     A,20            ; TOP OF LOW SEGG
60         HRRZM   A,P.TOP
61         SOSN    A               ; IF NOTHING YET
62 IFN ITS,        .SUSET  [.RMEMT,,P.TOP]
63 IFE ITS,        JRST    4,
64         MOVE    A,P.TOP
65         SUB     A,FRETOP        ; SETUP FOR GETTING NEEDED CORE
66         SUBI    A,3777
67         ASH     A,-10.          ; TO PAGES
68         HRLS    A               ; SET UP AOBJN
69         HRRZ    0,P.TOP
70         ASH     0,-10.
71         SUBI    0,1
72         HRR     A,0
73 IFN ITS,[
74         .CALL   HIGET           ; GET THEM
75         FATAL   INITM--CORE NOT AVAILABLE FOR INITIALIZATION
76         ASH     A,10.           ; TO WORDS
77         MOVEM   A,P.TOP
78         SUBI    A,2000          ; WHERE FRETOP IS
79         MOVEM   A,FRETOP
80
81 ]
82 IFE ITS,[
83         MOVE    A,FRETOP
84         ADDI    A,2000
85         MOVEM   A,P.TOP
86 ]
87         HRRE    A,P.TOP         ; CHECK TOP
88         TRNE    A,377777                ; SKIP IF ALL LOW SEG
89         JUMPL   A,PAGLOS        ; COMPLAIN
90         MOVE    A,HITOP         ; FIND HI SEG TOP
91         ADDI    A,1777
92         ANDCMI  A,1777
93         MOVEM   A,RHITOP        ; SAVE IT
94         MOVEI   A,200
95         SUBI    A,PHIBOT
96         JUMPE   A,HIBOK
97         MOVSI   A,(A)
98         HRRI    A,200
99 IFN ITS,[
100         .CALL   GIVCOR
101         .VALUE
102 ]
103 HIBOK:  MOVEI   B,[ASCIZ /MUDDLE INITIALIZATION.
104 /]
105         PUSHJ   P,MSGTYP        ;PRINT IT
106         MOVE    A,CODTOP        ;CHECK FOR A WINNING LOAD
107         CAML    A,VECBOT        ;IT BETTER BE LESS
108         JRST    DEATH1          ;LOSE COMPLETELY
109 SETTV:  MOVE    PVP,[-PVLNT*2,,GCPVP]   ;AND A PROCESS VECTOR
110         MOVEM   PVP,PVSTOR+1
111         MOVEM   PVP,PVSTOR+1-TVSTRT+TVBASE
112         MOVEI   A,(PVP)         ;SET UP A BLT
113         HRLI    A,PVBASE        ;FROM PROTOTYPE
114         BLT     A,PVLNT*2-1(PVP)        ;INITIALIZE
115         MOVE    TP,[-ITPLNT,,TPBAS]     ;GET A STACK FOR THIS PROCCESS
116         MOVEI   TB,(TP)         ;AND A BASE
117 IFN ITS,        HRLI    TB,1
118 IFE ITS,        HRLI    TB,400001       ; FOR MULTI SEG HACKING
119         SUB     TP,[1,,1]       ;POP ONCE
120
121 ; FIRST BUILD MOBY HASH TABLE
122
123         MOVEI   A,1023.         ; TRY THIS OUT FOR SIZE
124         PUSHJ   P,IBLOCK
125         MOVEM   B,HASHTB+1-TVSTRT+TVBASE        ; STORE IN TVP POINTER
126         HLRE    A,B
127         SUB     B,A
128         MOVEI   A,TATOM+.VECT.
129         HRLM    A,(B)
130         
131 ; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
132
133         PUSH    P,[5]           ;COUNT INITIAL OBLISTS
134
135         PUSH    P,OBLNT         ;SAVE CURRENT OBLIST DEFAULT SIZE
136
137 MAKEOB: SOS     A,-1(P)
138         MOVE    A,OBSZ(A)
139         MOVEM   A,OBLNT
140         MCALL   0,MOBLIST       ;GOBBLE AN OBLIST
141         PUSH    TP,$TOBLS       ;AND SAVE THEM
142         PUSH    TP,B
143         MOVE    A,(P)-1         ;COUNT DOWN
144         MOVEM   B,@OBTBL(A)     ;STORE
145         JUMPN   A,MAKEOB
146
147         POP     P,OBLNT         ;RESTORE DEFAULT OBLIST SIZE
148
149         MOVE    C,[-TVLNT+2,,TVBASE]
150         MOVE    D,[-HTVLNT+2,,TVSTRT]
151
152 ;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
153 ;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR
154
155 ILOOP:  HLRZ    A,(C)           ;FIRST TYPE
156         JUMPE   A,TVEXAU        ;USEFUL STUFF EXHAUSTED
157         CAIN    A,TCHSTR        ;CHARACTER STRING?
158         JRST    CHACK           ;YES, GO HACK IT
159         CAIN    A,TATOM         ;ATOM?
160         JRST    ATOMHK          ;YES, CHECK IT OUT
161         MOVE    A,(C)           ;MOVE TO NEW HOME (MAY BE SAME)
162         MOVEM   A,(D)
163         MOVE    A,1(C)
164         MOVEM   A,1(D)
165 SETLP:  AOS     (P)             ;COUNT NUMBER OF PAIRS IN XFER VECTOR
166         ADD     D,[2,,2]        ;OUT COUNTER
167 SETLP1: ADD     C,[2,,2]        ;AND IN COUNTER
168         JUMPL   C,ILOOP         ;JUMP IF MORE TO DO
169 \f
170 ;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
171
172 TVEXAU: HLRE    B,D             ; LEFT HALF OF AOBJN
173         MOVNI   TVP,HTVLNT-2    ; CALCULATE LENGTH OF TVP
174         SUB     TVP,B           ; GET -LENGTH OF TVP IN TVP
175         HRLS    TVP
176         HRRI    TVP,TVSTRT      ; BUILD A TASTEFUL TVP POINTER
177         MOVNI   C,TVLNT-HTVLNT+2(B)             ; SMASH IN LENGTH INTO END DOPE WORDS
178         HRLM    C,TVSTRT+HTVLNT-1
179         MOVSI   E,400000
180         MOVEM   E,TVSTRT+HTVLNT-2
181         HLRE    C,TVP
182         MOVNI   C,-2(C)         ; CLOBBER LENGTH INTO REAL TVP
183         HLRE    B,TVP
184         SUBM    TVP,B
185         MOVEM   E,(B)
186         HRLM    C,1(B)          ; PUT IN LENGTH 
187         MOVE    PVP,PVSTOR+1
188         MOVEM   TVP,REALTV+1(PVP)
189
190
191 ; FIX UP TYPE VECTOR
192
193         MOVE    A,TYPVEC+1      ;GET POINTER
194         MOVEI   0,0             ;FOR POSSIBLE NULL SLOTS
195         MOVSI   B,TATOM         ;SET TYPE TO ATOM
196         MOVEI   D,400000        ; TYPE CODE HACKS
197
198 TYPLP:  HLLM    B,(A)           ;CHANGE TYPE TO ATOM
199         MOVE    C,@1(A)         ;GET ATOM
200         HLRE    E,C             ; FIND DOPE WORD
201         SUBM    C,E
202         HRRM    D,(E)           ; STUFF INTO ATOM
203         MOVEM   C,1(A)
204         ADDI    D,1
205         ADD     A,[2,,2]                ;BUMP
206         JUMPL   A,TYPLP
207
208 \f; CLOSE TTY CHANNELS
209 IFN ITS,[
210
211         .CLOSE  1,
212         .CLOSE  2,
213 ]
214
215 ;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
216
217 ;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
218
219         IRP     A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]]
220         IRP     B,C,[A]
221         PUSH    TP,$!C
222         PUSH    TP,CHQUOTE B
223         .ISTOP
224         TERMIN
225         TERMIN
226
227         MCALL   2,FOPEN         ;OPEN THE OUT PUT CHANNEL
228         MOVEM   B,TTOCHN+1      ;SAVE IT
229
230 ;ASSIGN AS GLOBAL VALUE
231
232         PUSH    TP,$TATOM
233         PUSH    TP,IMQUOTE OUTCHAN
234         PUSH    TP,A
235         PUSH    TP,B
236         MOVE    A,[PUSHJ P,MTYO]        ;MORE WINNING INS
237         MOVEM   A,IOINS(B)      ;CLOBBER
238         MCALL   2,SETG
239
240 ;SETUP A CALL TO OPEN THE TTY CHANNEL
241
242         IRP     A,,[[READ,TCHSTR],[TTY:,TCHSTR]]
243         IRP     B,C,[A]
244         PUSH    TP,$!C
245         PUSH    TP,CHQUOTE B
246         .ISTOP
247         TERMIN
248         TERMIN
249
250         MCALL   2,FOPEN         ;OPEN INPUTCHANNEL
251         MOVEM   B,TTICHN+1      ;SAVE IT
252         PUSH    TP,$TATOM       ;ASSIGN AS A GLOBAL VALUE
253         PUSH    TP,IMQUOTE INCHAN
254         PUSH    TP,A
255         PUSH    TP,B
256         MOVE    C,BUFRIN(B)     ;GET AUX BUFFER PTR
257         MOVE    A,[PUSHJ P,MTYI]
258         MOVEM   A,IOIN2(C)      ;MORE OF A WINNER
259         MOVE    A,[PUSHJ P,IMTYO]
260         MOVEM   A,ECHO(C)       ;ECHO INS
261         MCALL   2,SETG
262         MOVEI   A,3             ;FIRST CHANNEL AFTER INIT HAPPENS
263         MOVEM   A,FRSTCH
264         
265 ;GENERATE AN INITIAL PROCESS AND SWAP IT IN
266
267         MOVEI   A,TPLNT         ;STACK PARAMETERS
268         MOVEI   B,PLNT
269         PUSHJ   P,ICR           ;CREATE IT
270         MOVE    PVP,PVSTOR+1
271         MOVE    0,SPSTO+1(B)
272         MOVEM   0,SPSTOR+1
273         MOVE    0,REALTV+1(PVP)
274         MOVEM   0,REALTV+1(B)   ; STUFF IN TRANSFER VECTOR POINTER
275         MOVEI   0,RUNING
276         MOVEM   0,PSTAT"+1(B)
277         MOVE    D,B             ;SET UP TO CALL SWAP
278         JSP     C,SWAP          ;AND SWAP IN
279         MOVEM   PVP,MAINPR"     ;SAVE AS THE MAIN PROCESS
280         PUSH    TP,[TENTRY,,TOPLEV]     ;BUILD DUMMY FRAME
281         PUSH    TP,[1,,0]
282         MOVEI   A,-1(TP)
283         PUSH    TP,A
284         PUSH    TP,SPSTOR+1
285         PUSH    TP,P
286         MOVE    C,TP    ;COPY TP
287         ADD     C,[3,,3]        ;FUDGE
288         PUSH    TP,C    ;TPSAV PUSHED
289         PUSH    TP,[TOPLEV]
290         HRRI    TB,(TP) ;SETUP TB
291 IFN ITS,        HRLI    TB,2
292 IFE ITS,        HRLI    TB,400002
293         ADD     TB,[1,,1]
294         MOVE    PVP,PVSTOR+1
295         MOVEM   TB,TBINIT+1(PVP)
296         MOVSI   A,TSUBR
297         MOVEM   A,RESFUN(PVP)
298         MOVEI   A,LISTEN"
299         MOVEM   A,RESFUN+1(PVP)
300         PUSH    TP,$TATOM
301         PUSH    TP,IMQUOTE THIS-PROCESS
302         PUSH    TP,$TPVP
303         PUSH    TP,PVP
304         MCALL   2,SETG
305
306 ; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE
307
308         MOVEI   A,IMQUOTE T
309         SUBI    A,
310 TVTOFF==0
311         ADDSQU  TVTOFF
312
313         MOVEM   A,SQULOC-1
314
315         PUSH    TP,$TATOM
316         PUSH    TP,IMQUOTE TVTOFF,,MUDDLE
317         PUSH    TP,$TFIX
318         PUSH    TP,A
319         MCALL   2,SETG
320
321 ; HERE TO SETUP SQUOZE TABLE IN PURE CORE
322
323         PUSHJ   P,SQSETU        ; GO TO ROUTINE
324
325         PUSHJ   P,DUMPGC
326         MOVEI   A,400000        ; FENCE POST PURE SR VECTOR
327         HRRM    A,PURVEC
328         MOVE    A,TP
329         HLRE    B,A
330         SUBI    A,-PDLBUF(B)    ;POINT TO DOPE WORDS
331         MOVEI   B,12            ;GROWTH SPEC
332         IORM    B,(A)
333         MOVE    PVP,PVSTOR+1
334         MOVE    0,REALTV+1(PVP)
335         HLRE    E,0
336         SUBI    0,-1(E)
337         HRRZM   0,CODTOP
338 IFE ITS,        PUSHJ   P,GETJS
339         PUSHJ   P,AAGC          ;DO IT
340         AOJL    A,.-1
341         MOVE    PVP,PVSTOR+1
342         MOVE    A,TPBASE+1(PVP)
343         SUB     A,[640.,,640.]
344         MOVEM   A,TPBASE+1(PVP)
345
346 ; CREATE LIST OF ROOT AND NEW OBLIST
347
348         MOVEI   A,5
349         PUSH    P,A
350
351 NAMOBL: PUSH    TP,$TATOM
352         PUSH    TP,@OBNAM-1(A)  ; NAME
353         PUSH    TP,$TATOM
354         PUSH    TP,IMQUOTE OBLIST
355         PUSH    TP,$TOBLS
356         PUSH    TP,@OBTBL1-1(A)
357         MCALL   3,PUT           ; NAME IT
358         SOS     A,(P)
359         PUSH    TP,$TOBLS
360         PUSH    TP,@OBTBL1(A)
361         PUSH    TP,$TATOM
362         PUSH    TP,IMQUOTE OBLIST
363         PUSH    TP,$TATOM
364         PUSH    TP,@OBNAM(A)
365         MCALL   3,PUT
366         SKIPE   A,(P)
367         JRST    NAMOBL
368         SUB     P,[1,,1]
369
370 ;Define MUDDLE version number
371         MOVEI   A,5
372         MOVEI   B,0             ;Initialize result
373         MOVE    C,[440700,,MUDSTR+2]
374 VERLP:  ILDB    D,C             ;Get next charcter digit
375         CAIG    D,"9            ;Non-digit ?
376         CAIGE   D,"0
377         JRST    VERDEF
378         SUBI    D,"0            ;Convert to number
379         IMULI   B,10.
380         ADD     B,D             ;Include number into result
381         SOJG    A,VERLP         ;Finished ?
382 VERDEF:
383         PUSH    TP,$TATOM
384         PUSH    TP,IMQUOTE MUDDLE
385         PUSH    TP,$TFIX
386         PUSH    TP,B
387         MCALL   2,SETG          ;Make definition
388 OPIPC:
389 IFN ITS,[
390         PUSH    TP,$TCHSTR
391         PUSH    TP,CHQUOTE IPC
392         PUSH    TP,$TATOM
393         PUSH    TP,MQUOTE IPC-HANDLER
394         MCALL   1,GVAL
395         PUSH    TP,A
396         PUSH    TP,B
397         PUSH    TP,$TFIX
398         PUSH    TP,[1]
399         MCALL   3,ON
400         MCALL   0,IPCON
401 ]
402
403 ; Allocate inital template tables
404
405         MOVEI   A,10
406         PUSHJ   P,CAFRE1
407         MOVSI   A,(B)
408         HRRI    A,1(B)
409         SETZM   (B)
410         BLT     A,7(B)
411         ADD     B,[10,,10]              ; REST IT OFF
412         MOVEM   B,TD.LNT+1
413         MOVEI   A,10
414         PUSHJ   P,CAFRE1
415         MOVEI   0,TUVEC         ; SETUP UTYPE
416         HRLM    0,10(B)
417         MOVEM   B,TD.GET+1
418         MOVSI   A,(B)
419         HRRI    A,1(B)
420         SETZM   (B)
421         BLT     A,7(B)
422         MOVEI   A,10
423         PUSHJ   P,CAFRE1
424         MOVEI   0,TUVEC         ; SETUP UTYPE
425         HRLM    0,10(B)
426         MOVEM   B,TD.PUT+1
427         MOVSI   A,(B)
428         HRRI    A,1(B)
429         SETZM   (B)
430         BLT     A,7(B)
431         MOVEI   A,10
432         PUSHJ   P,CAFRE1
433         MOVEI   0,TUVEC         ; SETUP UTYPE
434         HRLM    0,10(B)
435         MOVEM   B,TD.AGC+1
436         MOVSI   A,(B)
437         HRRI    A,1(B)
438         SETZM   (B)
439         BLT     A,7(B)
440
441 PTSTRT: MOVEI   A,SETUP
442         ADDI    A,1
443         SUB     A,PARBOT        ;FIND WHERE PAIRS SHOULD GO
444         MOVEM   A,PARNEW
445
446 ; PURIFY/IMPURIFY THE WORLD (PDL)
447
448 IFN ITS,[
449 PURIMP: MOVE    A,FRETOP
450         SUBI    A,1
451         LSH     A,-12
452         MOVE    B,A
453         MOVNI   A,1(A)
454         HRLZ    A,A
455         DOTCAL  CORBLK,[[1000,,310000],[1000,,-1],A]
456          FATAL  INITM -- CAN'T IMPURIFY LOW CORE
457         MOVEI   A,PHIBOT
458         ADDI    B,1
459         SUB     A,B
460         MOVNS   A
461         HRL     B,A
462         DOTCAL  CORBLK,[[1000,,0],[1000,,-1],B]
463          FATAL  INITM -- CAN'T FLUSH MIDDLE CORE
464         MOVE    A,[-<400-PHIBOT>,,PHIBOT]
465         DOTCAL  CORBLK,[[1000,,210000],[1000,,-1],A]
466          FATAL  INITM -- CAN'T PURIFY HIGH CORE
467 ]
468
469 IFE ITS,[
470         MOVEI   A,400000
471         MOVE    B,[1,,START]
472         SEVEC
473 ]
474         PUSH    P,[15.,,15.]    ;PUSH A SMALL PRGRM ONTO P
475         MOVEI   A,1(P)  ;POINT TO ITS START
476         PUSH    P,[JRST AAGC]   ;GO TO AGC
477         PUSH    P,[MOVE PVP,PVSTOR+1]
478         PUSH    P,[MOVE B,PSTO+1(PVP)]  ;GET SAVED P
479         PUSH    P,[SUB B,-14.(P)]       ;FUDGE TO POP OFF PROGRAM
480         PUSH    P,[MOVEM B,PSAV(TB)]    ;INTO FRAME
481         PUSH    P,[MOVE B,TPSTO+1(PVP)] ;GET TP
482         PUSH    P,[MOVEM B,TPSAV(TB)]   ;STORE IT
483         PUSH    P,[MOVE B,SPSTOR+1]     ;SP
484         PUSH    P,[MOVEM B,SPSAV(TB)]
485         PUSH    P,[MOVEI B,TOPLEV]      ;WHERE TO GO
486         PUSH    P,[MOVEM B,PCSAV(TB)]
487 IFN ITS,        PUSH    P,[MOVSI B,(.VALUE )]
488 IFE ITS,        PUSH    P,[MOVSI B,(JRST)]
489         PUSH    P,[HRRI B,C]
490         PUSH    P,[JRST B]      ;GO DO VALRET
491         PUSH    P,[B]
492         PUSH    P,A             ; PUSH START ADDR
493         MOVE    B,[JRST -12.(P)]
494         MOVE    0,[JUMPA START]
495 IFE ITS,        MOVE    C,[HALTF]
496 IFE ITS,        SKIPE   OPSYS
497         MOVE    C,[ASCII \\170/\e9\]
498         MOVE    D,[ASCII \B/\e1Q\]
499         MOVE    E,[ASCIZ \\r\16*\r\]                ;TERMINATE
500         POPJ    P,              ; GO
501 \f
502 ; CHECK PAIR SPACE
503
504 PAIRCH: CAMG    A,B
505         JRST    SETTV           ;O.K.
506
507 DEATH1: MOVEI   B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
508 /]
509         PUSHJ   P,MSGTYP
510         .VALUE
511
512 ;CHARACTER STRING HACKER
513
514 CHACK:  MOVE    A,(C)           ;GET TYPE
515         HLLZM   A,(D)           ;STORE IN NEW HOME
516         MOVE    B,1(C)          ;GET POINTER
517         HLRZ    E,B             ;-LENGHT
518         HRRM    E,(D)
519         PUSH    P,E+1           ; IDIVI WILL CLOBBER
520         ADDI    E,4+5*2         ; ROUND AND ACCOUNT FOR DOPE WORDS
521         IDIVI   E,5             ; E/ WORDS LONG
522         PUSHJ   P,EBPUR         ; MAKE A PURIFIED COPY
523         POP     P,E+1
524         HRLI    B,010700        ;MAKE POINT BYTER
525         SUBI    B,1
526         MOVEM   B,1(D)          ;AND STORE IT
527         ANDI    A,-1    ;CLEAR LH OF A
528         JUMPE   A,SETLP ;JUMP IF NO REF
529         HRRZ    B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR
530         CAIE    B,$TCHSTR       ;SKIP IF IT DOES
531         JRST    CHACK1  ;NO, JUST DO CHQUOTE PART
532         HRRM    D,-1(A) ;CLOBBER
533 CHACK1: MOVEI   E,1(D)
534         HRRM    E,(A)           ;STORE INTO REFERENCE
535         MOVEI   E,0
536         DPB     E,[220400,,(A)]
537         JRST    SETLP
538
539 ; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT
540
541 EBPUR:  PUSH    P,E
542         PUSH    P,A
543         ADD     E,HITOP         ; GET NEW TOP
544         CAMG    E,RHITOP        ; SKIP IF TOO BIG
545         JRST    EBPUR1
546
547 ;  CODE TO GROW HI SEG 
548
549         MOVEI   A,2000
550         ADDB    A,RHITOP        ; NEW TOP
551         TLNE    A,777776
552          JRST   HIFUL
553 IFN ITS,[
554         ASH     A,-10.          ; NUM OF BLOCKS
555         SUBI    A,1             ; BLOCK TO GET
556         .CALL   HIGET
557         .VALUE
558 ]
559
560 EBPUR1: MOVEI   A,-1(E)         ; NEEDED TO TERMINATE BLT
561         EXCH    E,HITOP
562         HRLI    E,(B)
563         MOVEI   B,(E)
564         BLT     E,(A)
565         POP     P,A
566         POP     P,E
567         POPJ    P,
568
569 GIVCOR: SETZ
570         SIXBIT /CORBLK/
571         1000,,0
572         1000,,-1
573         SETZ    A
574
575 HIGET:  SETZ
576         SIXBIT /CORBLK/
577         1000,,100000
578         1000,,-1
579         A
580         401000,,400001
581
582 \f
583 ; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
584 ; ALREADY THERE
585
586 ATOMHK: PUSH    TP,$TOBLS       ; SAVE OBLIST
587         PUSH    TP,[0]          ; FILLED IN LATER
588         PUSH    TP,$TVEC        ;SAVE TV POINTERS
589         PUSH    TP,C
590         PUSH    TP,$TVEC
591         PUSH    TP,D
592         MOVE    C,1(C)          ;GET THE ATOM
593         PUSH    TP,$TATOM       ;AND SAVE
594         PUSH    TP,C
595         PUSH    TP,$TATOM
596         PUSH    TP,[0]
597         HRRZ    B,(C)           ;GET OBLIST SPEC FROM ATOM
598         LSH     B,1
599         ADDI    B,1(TB)         ;POINT TO ITS HOME
600         HRRM    B,-9(TP)
601         MOVE    B,(B)
602         MOVEM   B,-10(TP)       ; CLOBBER
603
604         SETZM   2(C)            ; FLUSH CURRENT OBLIST SPEC
605         MOVEI   E,0
606         MOVE    D,C
607         PUSH    P,[LOOKCR]
608         ADD     D,[3,,3]
609         JUMPGE  D,.+4
610         PUSH    P,(D)
611         ADDI    E,1
612         AOBJN   D,.-2
613         PUSH    P,E
614         MOVSI   A,TOBLS
615         JRST    ILOOKC
616 LOOKCR:
617         MOVEM   B,(TP)
618         JUMPN   B,CHCKD
619
620 ;HERE IF THIS ATOM MUST BE PUT ON OBLIST
621
622 USEATM: MOVE    B,-2(TP)                ; GET ATOM
623         HLRZ    E,(B)           ; SEE IF PURE OR NOT
624         TRNN    E,400000        ; SKIP IF IMPURE
625         JRST    PURATM
626         PUSH    TP,$TATOM
627         PUSH    TP,B
628         PUSH    TP,$TOBLS
629         PUSH    TP,-13(TP)
630         MCALL   2,INSERT
631
632         PUSHJ   P,VALMAK        ;MAKE A GLOBAL VALUE FOR THIS LOSER
633 PURAT2: MOVE    C,-6(TP)        ;RESET POINTERS
634         MOVE    D,-4(TP)
635         SUB     TP,[12,,12]
636         MOVE    B,(C)           ;MOVE THE ENTRY
637         HLLZM   B,(D)           ;DON'T WANT REF POINTER STORED
638         MOVE    A,1(C)          ;AND MOVE ATOM
639         MOVEM   A,1(D)
640         MOVEI   A,1(D)
641         ANDI    B,-1            ;CHECK FOR REAL REF
642         JUMPE   B,SETLP1        ;DON'T SAVE THIS ATOM ON TVP
643         HRRM    A,(B)           ;CLOBBER CODE
644         MOVEI   A,0
645         DPB     A,[220400,,(B)] ; CLOBBER TVP PORTION
646         JRST    SETLP
647
648
649 ; HERE TO MAKE A PURE ATOM
650
651 PURATM: HRRZ    B,-2(TP)        ; POINT TO IT
652         HLRE    E,-2(TP)        ; - LNTH
653         MOVNS   E
654         ADDI    E,2
655         PUSHJ   P,EBPUR         ; PURE COPY
656         HRRM    B,-2(TP)        ; AND STORE BACK
657         MOVE    B,-2(TP)
658         JUMPE   0,PURAT0
659         HRRZ    D,0
660         HLRE    E,0
661         SUBM    D,E
662         HLRZ    0,2(D)
663         JUMPE   0,PURAT8
664         CAIG    0,HIBOT
665         FATAL   INITM--PURE IMPURE LOSSAGE
666         JRST    PURAT8
667
668 PURAT0: HRRZ    E,(C)
669         MOVE    D,-2(TP)        ; GET ATOM BACK
670         HRRZ    0,(D)           ; GET OBLIST CODE
671         JUMPE   E,PURAT9
672 PURAT7: HLRZ    D,1(E)
673         MOVEI   D,-2(D)
674         SUBM    E,D
675         HLRZ    D,2(D)
676         CAILE   D,HIBOT                 ; IF NEXT PURE & I AM ROOT
677         JUMPE   0,PURAT8                ; TAKES ADVANTAGE OF SYSTEM=0
678         JUMPE   D,PURAT8
679         MOVE    E,D
680         JRST    PURAT7
681
682 PURAT8: HLRZ    D,1(E)
683         SUBI    D,2
684         SUBM    E,D
685         HLRE    C,B
686         SUBM    B,C
687         HLRZ    E,2(D)
688         HRLM    E,2(B)
689         HRLM    C,2(D)
690         JRST    PURAT6
691
692 PURAT9: HLRE    A,-2(TP)
693         SUBM    B,A
694         HRRZM   A,(C)
695
696 PURAT6: MOVE    B,-10(TP)               ; GET BUCKET BACK
697         MOVE    C,-2(TP)
698         HRRZ    0,-9(TP)
699         HRRM    0,2(C)          ; STORE OBLIST IN ATOM
700 PURAT1: HRRZ    C,(B)           ; GET CONTENTS
701         JUMPE   C,HICONS        ; AT END, OK
702         CAIL    C,HIBOT         ; SKIP IF IMPURE
703         JRST    HICONS  ; CONS IT ON
704         MOVEI   B,(C)
705         JRST    PURAT1
706
707 HICONS: HRLI    C,TATOM
708         PUSH    P,C
709         PUSH    P,-2(TP)
710         PUSH    P,B
711         MOVEI   B,-2(P)
712         MOVEI   E,2
713         PUSHJ   P,EBPUR         ; MAKE PURE LIST CELL
714
715         MOVE    C,(P)
716         SUB     P,[3,,3]
717         HRRM    B,(C)           ; STORE IT
718         MOVE    B,1(B)          ; ATOM BACK
719         MOVE    C,-6(TP)        ; GET TVP SLOT
720         HRRM    B,1(C)          ; AND STORE
721         HLRZ    0,(B)           ; TYPE OF VAL
722         MOVE    C,B
723         CAIN    0,TUNBOU        ; NOT UNBOUND?
724         JRST    PURAT3          ; UNBOUND, NO VAL
725         MOVEI   E,2             ; COUNT AGAIN
726         PUSHJ   P,EBPUR         ; VALUE CELL
727         MOVE    C,-2(TP)                ; ATOM BACK
728         HLLZS   (B)             ; CLEAR LH
729         MOVSI   0,TLOCI
730         MOVEM   B,1(C)
731         SKIPA
732 PURAT3: MOVEI   0,0
733         HRRZ    A,(C)           ; GET OBLIST CODE
734         MOVE    A,OBTBL2(A)
735         HRRM    A,2(C)          ; STORE OBLIST SLOT
736         MOVEM   0,(C)
737         JRST    PURAT2
738 \f
739 ; A POSSIBLE MATCH ARRIVES HERE
740
741 CHCKD:  MOVE    D,(TP)          ;THEY MATCH!,  GET EXISTING ATOM
742         MOVEI   A,(D)           ;GET TYPE OF IT
743         MOVE    B,-2(TP)        ;GET NEW ATOM
744         HLRZ    0,(B)
745         TRZ     A,377777        ; SAVE ONLY 400000 BIT
746         TRZ     0,377777
747         CAIN    0,(A)           ; SKIP IF WIN
748         JRST    IM.PUR
749         MOVSI   0,400000
750         ANDCAM  0,(B)
751         ANDCAM  0,(D)
752         HLRZ    A,(D)
753         JUMPN   A,A1VAL
754         MOVE    A,(B)           ;MOVE VALUE
755         MOVEM   A,(D)
756         MOVE    A,1(B)
757         MOVEM   A,1(D)
758         MOVE    B,D             ;EXISTING ATOM TO B
759         MOVEI   0,(B)
760         CAIL    0,HIBOT
761         JRST    .+3
762         PUSHJ   P,VALMAK        ;MAKE A VALUE
763         JRST    .+2
764         PUSHJ   P,PVALM
765
766 ;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
767
768 OFFIND: MOVE    D,-4(TP)        ;GET CURRENT POINTER INTO TP
769         MOVE    C,[-TVLNT,,TVSTRT]      ;AND A COPY OF TVP
770         MOVEI   A,0             ;INITIALIZE COUNTER
771 ALOOP:  CAMN    B,1(C)          ;IS THIS IT?
772         JRST    AFOUND
773         ADD     C,[2,,2]        ;BUMP COUNTER
774         CAMG    C,D
775         AOJA    A,ALOOP         ;NO, KEEP LOOKING
776
777         MOVEI   B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
778 /]
779 TYPIT:  PUSHJ   P,MSGTYP
780         .VALUE
781
782 AFOUND: LSH     A,1             ;FOUND ATOM, GET REAL OFFSET
783         ADDI    A,1
784         ADDI    A,TVSTRT
785         MOVE    C,-6(TP)        ;GET TV POINTER TO NEW ATOM
786         HRRZ    B,(C)           ;POINT TO REFERENCE
787         SKIPE   B               ;ANY THERE?
788         HRRM    A,(B)           ;YES, CLOBBER AWAY
789         SUB     TP,[12,,12]
790         MOVEI   A,0
791         DPB     A,[220400,,(B)] ; KILL TVP POINTER
792         JRST    SETLP1          ;AND GO ON
793
794 A1VAL:  HLRZ    C,(B)           ;GET VALUE'S TYPE
795         MOVE    B,D             ;NOW PUT EXISTING ATOM IN B
796         CAIN    C,TUNBOU        ;UNBOUND?
797         JRST    OFFIND          ;YES, WINNER
798
799         MOVEI   B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
800 /]
801         JRST    TYPIT
802
803
804 IM.PUR: MOVEI   B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE
805 /]
806         JRST    TYPIT
807
808 PAGLOS: MOVEI   B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT
809 /]
810         JRST    TYPIT
811
812 HIFUL:  MOVEI   B,[ASCIZ /LOSSAGE--HI SEG FULL
813 /]
814         JRST    TYPIT
815
816 \f
817 ;MAKE A VALUE IN SLOT ON GLOBAL SP
818
819 VALMAK: HLRZ    A,(B)           ;TYPE OF VALUE
820         CAIE    A,400000+TUNBOU
821         CAIN    A,TUNBOU        ;VALUE?
822         JRST    VALMA1
823         MOVE    A,GLOBSP+1      ;GET POINTER TO GLOBAL SP
824         SUB     A,[4,,4]        ;ALLOCATE SPACE
825         CAMG    A,GLOBAS+1      ;CHECK FOR OVERFLOW
826         JRST    SPOVFL
827         MOVEM   A,GLOBSP+1      ;STORE IT BACK
828         MOVE    C,(B)           ;GET TYPE CELL
829         TLZ     C,400000
830         HLLZM   C,2(A)          ;INTO TYPE CELL
831         MOVE    C,1(B)          ;GET VALUE
832         MOVEM   C,3(A)          ;INTO VALUE SLOT
833         MOVSI   C,TGATOM        ;GET TATOM,,0
834         MOVEM   C,(A)
835         MOVEM   B,1(A)          ;AND POINTER TO ATOM
836         MOVSI   C,TLOCI         ;NOW CLOBBER THE ATOM
837         MOVEM   C,(B)           ;INTO TYPE CELL
838         ADD     A,[2,,2]        ;POINT TO VALUE
839         MOVEM   A,1(B)
840         POPJ    P,
841
842 VALMA1: SETZM   (B)
843         POPJ    P,
844
845 SPOVFL: MOVEI   B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
846 /]
847         JRST    TYPIT
848
849
850 PVALM:  HLRZ    0,(B)
851         CAIE    0,400000+TUNBOU
852         CAIN    0,TUNBOU
853         JRST    VALMA1
854         MOVEI   E,2
855         PUSH    P,B
856         PUSHJ   P,EBPUR
857         POP     P,C
858         MOVEM   B,1(C)
859         MOVSI   0,TLOCI
860         MOVEM   0,(C)
861         MOVE    B,C
862         POPJ    P,
863 \f;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER
864
865 VECTGO DUMMY1
866
867 IRP     A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW
868 ILOC,IGLOC,IDVAL,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER
869 IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR
870 MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS
871 CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ
872 CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN
873 CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG
874 C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR
875 OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY
876 CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO
877 CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT
878 CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C
879 CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL
880 CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS
881 CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1
882 CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT
883 GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF
884 CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ
885 TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG
886 NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR]
887         .GLOBAL A
888         ADDSQU A
889 TERMIN
890
891 VECRET
892
893 ; ROUTINE TO SORT AND PURIFY SQUOZE TABLE
894
895 SQSETU: MOVE    A,[SQUTBL-SQULOC+2,,SQUTBL]
896         MOVEI   0,1
897 SQ2:    MOVE    B,(A)
898         CAMG    B,2(A)
899         JRST    SQ1
900         MOVEI   0,0
901         EXCH    B,2(A)
902         MOVEM   B,(A)
903         MOVE    B,1(A)
904         EXCH    B,3(A)
905         MOVEM   B,1(A)
906 SQ1:    ADD     A,[2,,2]
907         JUMPL   A,SQ2
908         JUMPE   0,SQSETU
909 IFE ITS,[
910 STSQU:  MOVE    B,[440700,,SQBLK]
911         PUSHJ   P,MNGNAM
912         HRROI   B,SQBLK
913         MOVSI   A,600001
914         GTJFN
915         FATAL   CANT MAKE FIXUP FILE
916         MOVEI   E,(A)
917         MOVE    B,[440000,,100000]
918         OPENF
919         FATAL   CANT OPEN FIXUP FILE
920         MOVE    B,[444400,,SQUTBL]
921         MOVNI   C,SQULOC-SQUTBL
922         SOUT
923         MOVEI   A,(E)
924         CLOSF
925         JFCL
926         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
927         MOVEM   A,SQUPNT"
928 ]
929 IFN ITS,[
930 .GLOBAL CSIXBT
931 STSQU:  MOVE    C,MUDSTR+2              ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE
932         PUSHJ   P,CSIXBT
933         HRRI    C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE
934         MOVSS   C
935         MOVEM   C,SQBLK+2               ; STORE IN APPROPRIATE BLOCKS
936         MOVEM   C,SQWBLK+2
937         .SUSET  [.SSNAM,,SQDIR]
938         .OPEN   GCHN,SQWBLK     ; OPEN FILE
939         FATAL CAN'T CREATE SQUOZE FILE
940         MOVE    A,[SQUTBL-SQULOC,,SQUTBL]
941         MOVEM   A,SQUPNT"
942         .IOT    GCHN,A
943         .CLOSE  GCHN            ; CLOSE THE CHANNEL
944 ]
945         POPJ    P,
946         
947 RHITOP: 0
948
949 OBSZ:   151.
950         13.
951         151.
952         151.
953         317.
954
955 OBTBL2: ROOT+1
956         ERROBL+1
957         INTOBL+1
958         MUDOBL+1
959         INITIAL+1
960
961 OBTBL:  INITIAL+1-TVSTRT+TVBASE
962         MUDOBL+1-TVSTRT+TVBASE
963         INTOBL+1-TVSTRT+TVBASE
964         ERROBL+1-TVSTRT+TVBASE
965         ROOT+1-TVSTRT+TVBASE
966 OBNAM:  MQUOTE INITIAL
967         IMQUOTE MUDDLE
968         MQUOTE INTERRUPTS
969         MQUOTE ERRORS
970         MQUOTE ROOT
971
972 OBTBL1: INITIAL+1
973         MUDOBL+1
974         INTOBL+1
975         ERROBL+1
976         ROOT+1
977
978
979 IFN ITS,[
980 SQWBLK: SIXBIT /  'DSK/
981         SIXBIT /SQUOZE/
982         SIXBIT /TABLE/
983 ]
984 IFE ITS,[
985 MNGNAM: MOVE    A,[440700,,MUDSTR+2]            ; FOR NAME HACKING
986         ILDB    0,A                     ; SEE IF IT IS A VERSION
987         CAIN    0,177
988          POPJ   P,
989         MOVE    A,B
990         ILDB    0,A
991         CAIN    0,"X                    ; LOOK FOR X'S
992          JRST   .+3
993         MOVE    B,A
994         JRST    .-4
995
996         MOVE    A,[440700,,MUDSTR+2]
997         ILDB    0,A
998         IDPB    0,B
999         ILDB    0,A
1000         IDPB    0,B
1001         ILDB    0,A
1002         IDPB    0,B
1003         POPJ    P,
1004 ]
1005
1006 IFN ITS,[
1007 .GLOBAL VCREATE,MUDSTR
1008
1009 DEBUG:  MOVE    E,[440600,,[SIXBIT /EXPERIMENTAL/]]
1010         MOVEI   0,12.
1011         JRST    STUFF
1012
1013 VCREATE:        .SUSET  [.SSNAM,,[SIXBIT /MUDSYS/]]
1014         .OPEN   0,OP%
1015         .VALUE
1016         MOVEI   0,0     ; SET 0 TO DO THE .RCHST
1017         .RCHST  0
1018         .CLOSE  0
1019         .FDELE  DB%
1020         .VALUE
1021         MOVE    E,[440600,,B]
1022         MOVEI   0,6
1023 STUFF:  MOVE    D,[440700,,MUDSTR+2]
1024 STUFF1: ILDB    A,E             ; GET A CHAR
1025         CAIN    A,0             ;SUPRESS SPACES
1026         MOVEI   A,137           ;RUBOUT'S DON'T TYPE OUT
1027         ADDI    A,40            ; TO ASCII
1028         IDPB    A,D             ; STORE
1029         SOJN    0,STUFF1
1030         SETZM   34
1031         SETZM   35
1032         SETZM   36
1033         .VALUE
1034
1035 OP%:    1,,(SIXBIT /DSK/)
1036         SIXBIT /MUD%/
1037         SIXBIT />/
1038
1039 DB%:    (SIXBIT /DSK/)
1040         SIXBIT /MUD%/
1041         SIXBIT /</
1042         0
1043         0
1044 ]
1045
1046
1047 .GLOBAL GCDIR,ILDBLK,TILDBL,GCLDBK,LENGC,SLENGC,SGCLBK,RLENGC
1048 .GLOBAL SECBLK,SECLEN,RSLENG,DECBLK
1049
1050 ; ROUTINE TO DUMP OUT THE GARBAGE-COLLECTOR
1051
1052 DUMPGC:
1053 IFN ITS,[
1054         .SUSET  [.SSNAM,,GCDIR]                 ; SET SNAME
1055         MOVE    C,MUDSTR+2                      ; CREATE SECOND NAMES
1056         PUSHJ   P,CSIXBT
1057         HRRI    C,(SIXBIT /MUD/)
1058         MOVS    A,C                             ; MUDxx IS SECOND NAME
1059         MOVEM   A,GCLDBK+2
1060         MOVEM   A,SGCLBK+2
1061         MOVEM   A,ILDBLK+2
1062         MOVEM   A,GCDBLK+2                      ; SMASH IN SECOND NAMES
1063         MOVEM   A,SGCDBK+2
1064         MOVEM   A,INTDBK+2
1065         .OPEN   0,GCDBLK                        ; OPEN GC FILE
1066         FATAL   CANT CREATE AGC FILE
1067         MOVNI   A,LENGC                         ; CALCULATE IOT POINTER
1068         ASH     A,10.
1069         HRLZS   A
1070         HRRI    A,REALGC
1071         .IOT    0,A                             ; SEND IT OUT
1072         .CLOSE  0,                              ; CLOSE THE CHANNEL
1073         .OPEN   0,SGCDBK                        ; OPEN GC FILE
1074         FATAL   CANT CREATE AGC FILE
1075         MOVNI   A,SLENGC                        ; CALCULATE IOT POINTER
1076         ASH     A,10.
1077         HRLZS   A
1078         HRRI    A,REALGC+RLENGC
1079         .IOT    0,A                             ; SEND IT OUT
1080         .CLOSE  0,                              ; CLOSE THE CHANNEL
1081
1082
1083 ; ROUTINE TO DUMP THE INTERPRETER
1084
1085         .SUSET  [.SSNAM,,INTDIR]
1086         .OPEN   0,ILDBLK                        ; OPEN FILE TO INTERPRETER BLOCK
1087         FATAL   CANT FIXUP INTERPRETER
1088         HLRE    B,TP                            ; MAKE SURE BIG ENOUGJ
1089         MOVNS   B                               ; SEE IF WE WIN
1090         CAIGE   B,400                           ; SKIP IF WINNING
1091         FATAL   NO ROOM FOR PAGE MAP
1092         MOVSI   A,-400
1093         HRRI    A,1(TP)
1094         .ACCES  0,[1]
1095         .IOT    0,A                     ; GET IN PAGE MAP
1096         .CLOSE  0,
1097         .OPEN   0,INTDBK
1098         FATAL   CANT FIXUP INTERPRETER
1099         MOVEI   A,1                             ; INITIALIZE FILE PAGE COUNT
1100         MOVEI   B,0                             ; CORE PAGE COUNT
1101         MOVEI   E,1(TP)
1102 LOPFND: HRRZ    0,(E)
1103         JUMPE   0,NOPAG                         ; IF 0 FORGET IT
1104         ADDI    A,1                             ; AOS FILE MAP
1105 NOPAG:  ADDI    B,1                             ; AOS PAGE MAP
1106         CAIE    B,PAGEGC                                ; SKIP IF DONE
1107         AOJA    E,LOPFND
1108         ASH     A,10.                           ; TO WORDS
1109         .ACCES  0,A
1110         MOVNI   B,LENGC
1111         ASH     B,10.                           ; TO WORDS
1112         HRLZS   B                               ; SWAP
1113         HRRI    B,AGCLD
1114         .IOT    0,B
1115         .CLOSE  0,
1116         POPJ    P,                              ; DONE
1117
1118 GCDBLK: SIXBIT /  'DSK/
1119         SIXBIT /AGC/
1120         SIXBIT /MUD  /
1121
1122 SGCDBK: SIXBIT /  'DSK/
1123         SIXBIT /SGC/
1124         SIXBIT /MUD  /
1125
1126 INTDBK: 100007,,(SIXBIT /DSK/)
1127         SIXBIT /TS/
1128         SIXBIT /MUD/
1129
1130 ]
1131 IFE ITS,[
1132         MOVE    B,[440700,,GCLDBK]
1133         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1134         HRROI   B,GCLDBK
1135         MOVSI   A,600001
1136         GTJFN
1137          FATAL  CANT WRITE OUT GC
1138         MOVEI   E,(A)
1139         MOVE    B,[440000,,100000]
1140         OPENF
1141          FATAL  CANT OPEN GC FILE
1142         MOVNI   C,LENGC
1143         ASH     C,10.
1144         MOVE    B,[444400,,REALGC]
1145         MOVEI   A,(E)
1146         SOUT
1147         MOVEI   A,(E)
1148         CLOSF
1149          JFCL
1150         MOVEI   D,LENGC+LENGC
1151         MOVNI   A,1
1152         MOVEI   B,REALGC
1153         ASH     B,-9.
1154         HRLI    B,400000
1155
1156         PMAP
1157         ADDI    B,1
1158         SOJG    D,.-2
1159
1160         MOVE    B,[440700,,SGCLBK]
1161         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1162         HRROI   B,SGCLBK
1163         MOVSI   A,600001
1164         GTJFN
1165          FATAL  CANT WRITE OUT GC
1166         MOVEI   E,(A)
1167         MOVE    B,[440000,,100000]
1168         OPENF
1169          FATAL  CANT OPEN GC FILE
1170         MOVNI   C,SLENGC
1171         ASH     C,10.
1172         MOVE    B,[444400,,REALGC+RLENGC]
1173         MOVEI   A,(E)
1174         SOUT
1175         MOVEI   A,(E)
1176         CLOSF
1177          JFCL
1178         MOVEI   D,SLENGC+SLENGC
1179         MOVNI   A,1
1180         MOVEI   B,REALGC+RLENGC
1181         ASH     B,-9.
1182         HRLI    B,400000
1183
1184         PMAP
1185         ADDI    B,1
1186         SOJG    D,.-2
1187
1188         MOVE    B,[440700,,SECBLK]
1189         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1190         HRROI   B,SECBLK
1191         MOVSI   A,600001
1192         GTJFN
1193          FATAL  CANT WRITE OUT GC
1194         MOVEI   E,(A)
1195         MOVE    B,[440000,,100000]
1196         OPENF
1197          FATAL  CANT OPEN GC FILE
1198         MOVNI   C,SECLEN
1199         ASH     C,10.
1200         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1201         MOVEI   A,(E)
1202         SOUT
1203         MOVEI   A,(E)
1204         CLOSF
1205          JFCL
1206
1207 ; NOW MUNG THE THING TO BE DIFFERENT TO USE UUOS FOR DEBUGGING VERSION
1208
1209 .GLOBAL %FXUPS,%FXEND
1210
1211         MOVEI   A,%FXUPS
1212
1213 %DBG1:  HLRZ    D,(A)
1214         HRRZ    A,(A)
1215         LDB     0,[331100,,(A)]         ; GET INS
1216         MOVEI   C,%TBL
1217         HRRZ    B,(C)
1218         CAME    B,0
1219          AOJA   C,.-2
1220         CAIN    B,<<(XBLT)>_<-9.>>
1221          HLLZS  (A)
1222         LDB     B,[331100,,(C)]
1223         DPB     B,[331100,,(A)]
1224         MOVE    A,D
1225         JUMPN   A,%DBG1
1226 %DBG2:
1227         MOVE    B,[440700,,DECBLK]
1228         PUSHJ   P,MNGNAM                        ; VERSION TO NAME IF NECESSARY
1229         HRROI   B,DECBLK
1230         MOVSI   A,600001
1231         GTJFN
1232          FATAL  CANT WRITE OUT GC
1233         MOVEI   E,(A)
1234         MOVE    B,[440000,,100000]
1235         OPENF
1236          FATAL  CANT OPEN GC FILE
1237         MOVNI   C,SECLEN
1238         ASH     C,10.
1239         MOVE    B,[444400,,REALGC+RLENGC+RSLENG]
1240         MOVEI   A,(E)
1241         SOUT
1242         MOVEI   A,(E)
1243         CLOSF
1244          JFCL
1245         MOVEI   D,SECLEN+SECLEN
1246         MOVNI   A,1
1247         MOVEI   B,REALGC+RLENGC
1248         ASH     B,-9.
1249         HRLI    B,400000
1250
1251         PMAP
1252         ADDI    B,1
1253         SOJG    D,.-2
1254
1255         MOVE    B,[440700,,ILDBLK]
1256         SKIPE   OPSYS
1257          MOVE   B,[440700,,TILDBL]
1258         PUSHJ   P,MNGNAM
1259         MOVSI   C,-1000
1260         MOVSI   A,400000
1261 RPA:    RPACS
1262         TLNE    B,10000
1263         TLNN    B,400                   ; SKIP IF NOT PRIVATE
1264         SKIPA
1265          MOVES  (C)
1266         ADDI    C,777
1267         ADDI    A,1
1268         AOBJN   C,RPA
1269
1270         MOVNI   A,1
1271         CLOSF
1272          FATAL  CANT CLOSE STUFF
1273         HRROI   B,ILDBLK
1274         MOVSI   A,100001
1275         GTJFN                                   ; GET A JFN
1276          FATAL  GARBAGE COLLECTOR IS MISSING
1277         HRRZS   E,A                             ; SAVE JFN
1278         MOVE    B,[440000,,300000]
1279         OPENF
1280          FATAL  CANT OPEN GC FILE
1281         MOVEI   A,(E)                           ; FIND OUT LENGTH OF MAP
1282         BIN                                     ; GET LENGTH WORD
1283         HLRZ    0,B
1284         CAIE    0,1776                          ; TOPS20 SSAVE FILE FORMAT
1285          CAIN   0,1000                          ; TENEX SSAVE FILE FORMAT
1286           JRST  .+2
1287         FATAL   NOT AN SSAVE FILE
1288          MOVEI  A,(B)                           ; ISOLATE SIZE OF MAP
1289         HLRE    B,TP                            ; MUST BE SPACE FOR CRUFT
1290         MOVNS   B
1291         CAIGE   B,(A)                           ; ROOM?
1292          FATAL  NO ROOM FOR PAGE MAP (GULP)
1293         MOVN    C,A
1294         MOVEI   A,(E)                           ; READY TO READ IN MAP
1295         MOVEI   B,1(TP)                         ; ONTO TP STACK
1296         HRLI    B,444400
1297         SIN                                     ; SNARF IT IN
1298
1299         MOVEI   A,1(TP)                         ; POINT TO MAP
1300         CAIE    0,1000
1301          JRST   RPA1                            ; GO TO THE TOPS20 CODE
1302         LDB     0,[221100,,(A)]                 ; GET FORK PAGE
1303         CAIE    0,PAGEGC+PAGEGC                 ; GOT IT?
1304          AOJA   A,.-2
1305         JRST    RPA2
1306
1307 RPA1:   ADDI    A,1                             ; POINT TO PROCESS PAGE NUMBER
1308         LDB     0,[331100,,(A)]                 ; REPEAT COUNT IN 0
1309         LDB     B,[3300,,(A)]                   ; FIRST PAGE NUMBER IN B
1310         ADD     0,B                             ; LARGEST PAGE NUMBER
1311         CAIL    0,PAGEGC+PAGEGC
1312          CAILE  B,PAGEGC+PAGEGC
1313           AOJA  A,RPA1                          ; NEXT PAIR OF WORDS PLEASE
1314         SUBI    A,1                             ; POINT TO FILE PAGE NUMBER
1315         SUBI    B,PAGEGC+PAGEGC
1316         MOVN    B,B
1317         ADDM    B,(A)                           ; SET UP THE PAGE
1318
1319 RPA2:   HRRZ    B,(A)                           ; GET PAGE
1320         MOVEI   A,(E)                           ; GET JFN
1321         ASH     B,9.
1322         SFPTR
1323          FATAL  ACCESS OF FILE FAILED
1324         MOVEI   A,(E)
1325         MOVE    B,[444400,,AGCLD]
1326         MOVNI   C,LENGC
1327         ASH     C,10.
1328         SOUT
1329         MOVEI   A,(E)
1330         CLOSF
1331          JFCL
1332         POPJ    P,
1333
1334 ; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
1335
1336 TWENTY: HRROI   A,C                             ; RESULTS KEPT HERE
1337         HRLOI   B,600015
1338         MOVEI   C,0                             ; CLEAN C UP
1339         DEVST
1340          JFCL
1341         MOVEI   A,1                             ; TENEX HAS OPSYS = 1
1342         CAME    C,[ASCII/NUL/]                  ; TOPS20 GIVES "NUL"
1343          MOVEM  A,OPSYS                         ; TENEX  GIVES "NIL"
1344         POPJ    P,
1345 %TBL:   IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT]
1346         S!A <<(A)>_<-9.>>
1347         TERMIN
1348
1349 GCLDBK: ASCIZ /MDLXXX.AGC/
1350 SGCLBK: ASCIZ /MDLXXX.SGC/
1351 SECBLK: ASCIZ /MDLXXX.SEC/
1352 ILDBLK: ASCIZ /MDLXXX.EXE/
1353 TILDBL: ASCIZ /MDLXXX.SAV/
1354 DECBLK: ASCIZ /MDLXXX.DEC/
1355 ]
1356         
1357         
1358
1359 END SETUP
1360 \f