MUDDLE/initm.42

   1
   2 TITLE INITIALIZATION FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 LAST==1 ;POSSIBLE CHECKS DONE LATER
   7
   8 .INSRT MUDDLE >
   9
  10 .LIFL <TVLNT-TVLOC>
  11 .LOP .VALUE
  12 .ELDC
  13
  14
  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
  19
  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.
  24 /]
  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
  32         ADDI    A,1             ;BUMP UP
  33         MOVEM   A,PARBOT        ;UPDATE PARBOT AND TOP
  34         MOVEM   A,PARTOP
  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
  41         HRLI    TB,1
  42         SUB     TP,[1,,1]       ;POP ONCE
  43
  44 ; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS
  45
  46         PUSH    P,[3]           ;COUNT INITIAL OBLISTS
  47
  48 MAKEOB: MCALL   0,MOBLIST       ;GOBBLE AN OBLIST
  49         PUSH    TP,$TOBLS       ;AND SAVE THEM
  50         PUSH    TP,B
  51         SOS     A,(P)           ;COUNT DOWN
  52         MOVEM   B,@OBTBL(A)     ;STORE
  53         JUMPN   A,MAKEOB
  54
  55         MOVE    C,TVP           ;MAKE 2 COPIES OF XFER VECTOR POINTER
  56         MOVE    D,TVP
  57
  58 ;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE
  59 ;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR
  60
  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
  65         CAIN    A,TATOM         ;ATOM?
  66         JRST    ATOMHK          ;YES, CHECK IT OUT
  67         MOVE    A,(C)           ;MOVE TO NEW HOME (MAY BE SAME)
  68         MOVEM   A,(D)
  69         MOVE    A,1(C)
  70         MOVEM   A,1(D)
  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
  75 \f
  76 ;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST
  77
  78 TVEXAU: HLRE    B,C             ;GET -LENGTH
  79         SUBI    C,(B)           ;POIT TO DOPE WORD
  80         ANDI    C,-1            ;NO LH
  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
  91         MOVEM   E,(C)
  92         MOVEM   E,(D)
  93
  94
  95 ; FIX UP TYPE VECTOR
  96
  97         MOVE    A,TYPVEC+1(TVP) ;GET POINTER
  98         MOVEI   0,0             ;FOR POSSIBLE NULL SLOTS
  99         MOVSI   B,TATOM         ;SET TYPE TO ATOM
 100
 101 TYPLP:  HLLM    B,(A)           ;CHANGE TYPE TO ATOM
 102         MOVE    C,@1(A)         ;GET ATOM
 103         MOVEM   C,1(A)
 104         ADD     A,[2,,2]                ;BUMP
 105         JUMPL   A,TYPLP
 106 \f
 107 ;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS
 108
 109 ;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL
 110
 111         IRP     A,,[[PRINT,TCHSTR],[OUTPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
 112         IRP     B,C,[A]
 113         PUSH    TP,$!C
 114         PUSH    TP,CHQUOTE B
 115         .ISTOP
 116         TERMIN
 117         TERMIN
 118
 119         MCALL   4,FOPEN         ;OPEN THE OUT PUT CHANNEL
 120         MOVEM   B,TTOCHN+1(TVP) ;SAVE IT
 121
 122 ;ASSIGN AS GLOBAL VALUE
 123
 124         PUSH    TP,$TATOM
 125         PUSH    TP,MQUOTE OUTCHAN
 126         PUSH    TP,A
 127         PUSH    TP,B
 128         MOVE    A,[PUSHJ P,TYO] ;MORE WINNING INS
 129         MOVEM   A,IOINS(B)      ;CLOBBER
 130         MCALL   2,SETG
 131
 132 ;SETUP A CALL TO OPEN THE TTY CHANNEL
 133
 134         IRP     A,,[[READ,TCHSTR],[INPUT,TCHSTR],[MUDDLE,TCHSTR],[TTY,TCHSTR]]
 135         IRP     B,C,[A]
 136         PUSH    TP,$!C
 137         PUSH    TP,CHQUOTE B
 138         .ISTOP
 139         TERMIN
 140         TERMIN
 141
 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
 146         PUSH    TP,A
 147         PUSH    TP,B
 148         MOVE    C,BUFRIN(B)     ;GET AUX BUFFER PTR
 149         MOVE    A,[PUSHJ P,TYI]
 150         MOVEM   A,IOIN2(C)      ;MORE OF A WINNER
 151         MOVE    A,[PUSHJ P,TYO]
 152         MOVEM   A,ECHO(C)       ;ECHO INS
 153         MCALL   2,SETG
 154
 155 ;GENERATE AN INITIAL PROCESS AND SWAP IT IN
 156
 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
 162         PUSH    TP,[1,,0]
 163         PUSH    TP,[0]
 164         PUSH    TP,SP
 165         PUSH    TP,P
 166         MOVE    C,TP    ;COPY TP
 167         ADD     C,[3,,3]        ;FUDGE
 168         PUSH    TP,C    ;TPSAV PUSHED
 169         PUSH    TP,PP
 170         PUSH    TP,[TOPLEV]
 171         HRRI    TB,(TP) ;SETUP TB
 172         HRLI    TB,2
 173         ADD     TB,[1,,1]
 174         MOVEM   TB,TBINIT+1(PVP)
 175
 176 ; CREATE LIST OF ROOT AND NEW OBLIST
 177
 178         MCALL   0,MOBLIST       ;MAKE OBLIST
 179         PUSH    TP,A    ;SAVE RESULTS
 180         PUSH    TP,B
 181         PUSH    TP,ROOT(TVP)
 182         PUSH    TP,ROOT+1(TVP)
 183         MCALL   2,LIST  ;MAKE LIST
 184         MOVEM   A,ROOT(TVP)
 185         MOVEM   B,ROOT+1(TVP)
 186         PUSH    TP,$TATOM       ;ASSIGN TO GLOBAL VALUE
 187         PUSH    TP,MQUOTE OBLIST
 188         PUSH    TP,A
 189         PUSH    TP,B
 190         MCALL   2,SETG
 191
 192
 193         PUSH    TP,$TATOM
 194         PUSH    TP,MQUOTE QUITTER
 195         MCALL   1,LIST
 196         PUSH    TP,$TCHAN               ;SET UP CNTL-G INT
 197         PUSH    TP,TTICHN+1(TVP)
 198         PUSH    TP,$TFORM
 199         PUSH    TP,B
 200         MCALL   2,ONCHAR                ;TURN ON INTERRUPT
 201         MOVEI   A,SETUP         ;POINT TO START
 202         MOVEM   A,CODTOP
 203         ADDI    A,1
 204         SUB     A,PARBOT        ;FIND WHERE PAIRS SHOULD GO
 205         MOVEM   A,PARNEW
 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 )]
 219         PUSH    P,[HRRI B,C]
 220         PUSH    P,[JRST B]      ;GO DO VALRET
 221         PUSH    P,[A]   ;RETURN ADDRESS FOR AGC
 222         PUSH    P,A     ;SAVE A
 223         MOVE    A,[JRST -11.(P)]        ;WHEER TO START
 224         SUB     P,[1,,1]        ;REMOVE LOSSAGE
 225         MOVE    0,[JUMPA START]
 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
 230         JRST    @1(P)           ;GO DO IT
 231 \f
 232 ; CHECK PAIR SPACE
 233
 234 PAIRCH: CAMG    A,B
 235         JRST    SETTV           ;O.K.
 236
 237 DEATH1: MOVEI   B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP
 238 /]
 239         PUSHJ   P,MSGTYP
 240         .VALUE
 241
 242 ;CHARACTER STRING HACKER
 243
 244 CHACK:  MOVE    A,(C)           ;GET TYPE
 245         HLLZM   A,(D)           ;STORE IN NEW HOME
 246         MOVE    B,1(C)          ;GET POINTER
 247         HLRE    E,B             ;-LENGHT
 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
 256         LSH     E,1
 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
 261         MOVEI   B,TVP
 262         DPB     B,[220400,,-1(A)]       ;CLOBBER INDEX FIELD
 263 CHACK1: ADDI    E,1
 264         HRRM    E,(A)           ;STORE INTO REFERENCE
 265         JRST    SETLP
 266 \f
 267 ; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T
 268 ; ALREADY THERE
 269
 270 ATOMHK: PUSH    TP,$TVEC        ;SAVE TV POINTERS
 271         PUSH    TP,C
 272         PUSH    TP,$TVEC
 273         PUSH    TP,D
 274         MOVE    B,1(C)          ;GET THE ATOM
 275         PUSH    TP,$TATOM       ;AND SAVE
 276         PUSH    TP,B
 277         HRRZ    A,(B)           ;GET OBLIST SPEC FROM ATOM
 278         LSH     A,1
 279         ADDI    A,1(TB)         ;POINT TO ITS HOME
 280         PUSH    TP,$TOBLS
 281         PUSH    TP,(A)          ;AND SAV IT
 282
 283         ADD     B,[2,,2]        ;POINT TO ATOM'S PNAME
 284         MOVEI   A,0             ;FOR HASHING
 285         XOR     A,(B)
 286         AOBJN   B,.-1
 287         MOVMS   A               ;FORCE POSITIVE RESULT
 288         IDIV    A,OBLNT
 289         HRLS    B               ;REMAINDER IN B IS BUCKET
 290         ADDB    B,(TP)          ;UPDATE POINTER
 291
 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
 300         CAME    A,(E)           ;COMPARE
 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
 304
 305 NXTBCK: HRRZ    C,(C)           ;CDR THE LIST
 306         JUMPN   C,OBLOO3        ;IF NOT NIL, KEEP TRYING
 307
 308 ;HERE IF THIS ATOM MUST BE PUT ON OBLIST
 309
 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
 313         PUSH    TP,-3(TP)
 314         PUSH    TP,$TLIST
 315         PUSH    TP,C
 316         MCALL   2,CONS          ;CONS IT UP
 317         MOVE    C,(TP)          ;REGOBBLE BUCKET POINTER
 318         HRRZM   B,(C)           ;CLOBBER
 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
 322         MOVE    D,-4(TP)
 323         SUB     TP,[8,,8]
 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
 327         MOVEM   A,1(D)
 328         MOVE    A,(P)           ;GET CURRENT OFFSET
 329         LSH     A,1
 330         ADDI    A,1
 331         ANDI    B,-1            ;CHECKFOR REAL REF
 332         JUMPE   B,SETLP
 333         HRRM    A,(B)           ;CLOBBER CODE
 334         JRST    SETLP
 335
 336 \f
 337 ; A POSSIBLE MATCH ARRIVES HERE
 338
 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
 346         MOVEM   A,(D)
 347         MOVE    A,1(B)
 348         MOVEM   A,1(D)
 349         MOVE    B,D             ;EXISTING ATOM TO B
 350         PUSHJ   P,VALMAK        ;MAKE A VALUE
 351
 352 ;NOW FIND ATOMS OCCURENCE IN XFER VECTOR
 353
 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?
 358         JRST    AFOUND
 359         ADD     C,[2,,2]        ;BUMP COUNTER
 360         CAMGE   C,D             ;HAVE WE HIT END
 361         AOJA    A,ALOOP         ;NO, KEEP LOOKING
 362
 363         MOVEI   B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED
 364 /]
 365 TYPIT:  PUSHJ   P,MSGTYP
 366         .VALUE
 367
 368 AFOUND: LSH     A,1             ;FOUND ATOM, GET REAL OFFSET
 369         ADDI    A,1
 370         MOVE    C,-6(TP)        ;GET TV POINTER TO NEW ATOM
 371         HRRZ    B,(C)           ;POINT TO REFERENCE
 372         SKIPE   B               ;ANY THERE?
 373         HRRM    A,(B)           ;YES, CLOBBER AWAY
 374         SUB     TP,[8,,8]
 375         JRST    SETLP1          ;AND GO ON
 376
 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
 382
 383         MOVEI   B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES
 384 /]
 385         JRST    TYPIT
 386
 387 \f
 388 ;MAKE A VALUE IN SLOT ON GLOBAL SP
 389
 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
 396         JRST    SPOVFL
 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
 403         MOVEM   C,(A)
 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
 408         MOVEM   A,1(B)
 409         POPJ    P,
 410
 411 SPOVFL: MOVEI   B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW
 412 /]
 413         JRST    TYPIT
 414
 415
 416 OBTBL:  INTOBL+1(TVP)
 417         ERROBL+1(TVP)
 418         ROOT+1(TVP)
 419
 420 END SETUP
 421
 422
 423 \f\f\ 3\f