MUDDLE/ninter.4

   1
   2 TITLE INTERRUPT HANDLER FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 ;C. REEVE  APRIL 1971
   7
   8 .INSRT MUDDLE >
   9
  10 PDLGRO==10000   ;AMOUNT TO GROW A PDL THAT LOSES
  11 NINT==72.       ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE
  12
  13 ;SET UP LOCATION 42 TO POINT TO TSINT
  14
  15 ZZZ==.  ;SAVE CURRENT LOCATION
  16
  17 LOC 42
  18 î       JSR     TSINT           ;GO TO HANDLER
  19
  20 LOC ZZZ
  21
  22 ; GLOBALS NEEDED BY INTERRUPT HANDLER
  23
  24 .GLOBA GCFLG    ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING
  25 .GLOBA GCINT    ;TELLS GARBAGE COLLECTOR TO SIMULATE AN INTERRUPT
  26 .GLOBAL INTNUM,INTVEC   ;TV ENTRIES CONCERNING INTERRUPTS
  27 .GLOBAL AGC     ;CALL THE GARBAGE COLLECTOR
  28 .GLOBAL VECNEW,PARNEW,GETNUM    ;GC PSEUDO ARGS
  29 .GLOBAL GCPDL   ;GARBAGE COLLECTORS PDL
  30 .GLOBAL VECTOP,VECBOT   ;DELIMIT VECTOR SPACE
  31 .GLOBAL PDLBUF  ;AMOUNT OF  PDL GROWTH
  32 .GLOBAL PGROW   ;POINTS TO DOPE WORD OF NEXT PDL TO GROW
  33 .GLOBAL TPGROW  ;POINTS TO NEXT MUDDLE PDL TO GROW
  34 .GLOBAL PPGROW  ;BLOWN PLANNER PDL
  35 .GLOBAL PLDGRO  ;SEE ABOVE
  36 .GLOBAL CALER1,TMA,TFA
  37 .GLOBAL BUFRIN,CHANL0,SYSCHR    ;CHANNEL GLOBALS
  38 .GLOBAL IFALSE,TPOVFL,PDLOSS
  39 .GLOBAL FLFLG   ;-1  IFF INTERRUPT IN FAIL
  40
  41
  42 .GLOBAL INTINT  ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS
  43
  44 .GLOBAL MSGTYP,TYI,IFLUSH,OCLOS,ERRET   ;SUBROUTINES USED
  45 ;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE)
  46
  47 TSINT:  0                       ;INTERRUPT BITS GET STORED HERE
  48 TSINTR: 0                       ;INTERRUPT PC WORD STORED HERE
  49         JRST    TSINTP          ;GO TO PURE CODE
  50
  51 ; SOFTWARE INTERNAL INTERRUPTS JSR TO HERE
  52
  53 LCKINT: 0
  54         JRST    DOINT
  55
  56 ;THE REST OF THIS CODE IS PURE
  57
  58 TSINTP: SOSGE   INTFLG          ; SKIP IF ENABLED
  59         SETOM   INTFLG          ;DONT GET LESS THAN -1
  60
  61         MOVEM   A,TSAVA         ;SAVE TWO ACS
  62         MOVEM   B,TSAVB
  63         MOVE    A,TSINT         ;PICK UP INT BIT PATTERN
  64         JUMPL   A,2NDWORD       ;DONT CHECK FOR PDL OVERFLOW ETC. IF SIGN BIT ON
  65
  66         TRZE    A,200000        ;IS THIS A PDL OVERFLOW?
  67         JRST    IPDLOV          ;YES, GO HANDLE IT FIRST
  68
  69 IMPCH:  TRZE    A,20000         ;IS IT A MEMORY PROTECTION VIOLATION?
  70         JRST    IMPV            ;YES, GO HANDLE IT
  71
  72         TRZE    A,40            ;ILLEGAL OP CODE?
  73         JRST    ILOPR           ;YES, GO HANDLE
  74
  75 ;DECODE THE REST OF THE INTERRUPTS USING A TABLE
  76
  77 2NDWORD:
  78         JUMPL   A,GC2           ;2ND WORD?
  79         IORM    A,PIRQ          ;NO, INTO WORD 1
  80         JRST    GCQUIT          ;AND DISMISS INT
  81
  82 GC2:    TLZ     A,400000        ;TURN OFF SIGN BIT
  83         IORM    A,PIRQ2
  84         TRNE    A,177777        ;CHECK FOR CHANNELS
  85         JRST    CHNACT          ;GO IF CHANNEL ACTIVITY
  86
  87 GCQUIT: SKIPGE  INTFLG          ;SKIP IF INTERRUPTS ENABLED
  88         JRST    INTDON          ;NO, DEFER REAL HANDLING UNTIL LATER
  89
  90         MOVE    A,TSINTR        ;PICKUP RETURN WORD
  91         MOVEM   A,LCKINT        ;STORE ELSEWHERE
  92         MOVEI   A,DOINTE        ;CAUSE DISMISS TO HANDLER
  93         HRRM    A,TSINTR        ;STORE IN INT RETURN
  94         PUSH    P,INTFLG        ;SAVE INT FLAG
  95         SETOM   INTFLG          ;AND DISABLE
  96
  97
  98 INTDON: MOVE    A,TSAVA         ;RESTORE ACS
  99         MOVE    B,TSAVB
 100         .DISMISS        TSINTR          ;AND DISMISS THE INTERRUPT
 101
 102 ; HERE IF INTERRUPTED IN OTHER THAN GC
 103
 104 DOINT:  PUSH    P,INTFLG
 105 DOINTE: PUSH    P,LCKINT        ;SAVE RETURN
 106         SETZM   INTFLG          ;DISABLE
 107         AOS     -1(P)           ;INCR SAVED FLAG
 108
 109 ;NOW SAVE WORKING ACS
 110
 111 IRP A,,[0,A,B,C,D,E]
 112         PUSH    TP,A!STO(PVP)
 113         SETZM   A!STO(PVP)      ;NOW ZERO TYPE
 114         PUSH    TP,A
 115         TERMIN
 116         PUSH    P,INTNUM+1(TVP) ;PUSH CURRENT VALUE
 117
 118 DIRQ:   MOVE    A,PIRQ          ;NOW SATRT PROCESSING
 119         JFFO    A,FIRQ          ;COUNT BITS AND GO
 120         MOVE    A,PIRQ2         ;1ST DONE, LOOK AT 2ND
 121         JFFO    A,FIRQ2
 122
 123 INTDN1:
 124         POP     P,INTNUM+1(TVP) ;RESTORE CURRENT
 125 IRP A,,[E,D,C,B,A,0]
 126         POP     TP,A
 127         POP     TP,A!STO(PVP)
 128         TERMIN
 129
 130         POP     P,LCKINT
 131         POP     P,INTFLG
 132         JRST    @LCKINT         ;AND RETURN
 133
 134 FIRQ:   PUSHJ   P,GETBIT        ;SET UP THE BIT TO CLOBBER IN PIRQ
 135         ANDCAM  A,PIRQ          ;CLOBBER IT
 136         ADDI    B,36.           ;OFSET INTO TABLE
 137         JRST    XIRQ            ;GO EXECUTE
 138
 139 FIRQ2:  PUSHJ   P,GETBIT        ;PREPARE TO CLOBBER BIT
 140         ANDCAM  A,PIRQ2         ;CLOBBER IT
 141         ADDI    B,71.           ;AGAIN OFFSET INTO TABLE
 142 XIRQ:
 143         CAIN    B,21            ;PDL OVERFLOW?
 144         JRST    PDL2            ;YES, HACK APPROPRIATELY
 145         MOVEM   B,INTNUM+1(TVP) ;AND SAVE
 146         LSH     B,1             ;TIMES 2
 147         ADD     B,INTVEC+1(TVP) ;POINT TO LIST OF TASKS
 148         SKIPN   A,(B)           ;ANY TASKS?
 149         JRST    DIRQ            ;NO, PUNT
 150
 151         PUSH    TP,$TLIST       ;SAVE LIST
 152         PUSH    TP,A
 153 DOINTS: HLRZ    C,(A)           ;GET TYPE
 154         CAIE    C,TLIST         ;LIST?
 155         JRST    IWTYP
 156         HRRZ    A,1(A)
 157         JUMPE   A,IWTYP         ;LIST IS NIL, LOSE
 158         HLRZ    C,(A)           ;CHECK FOR A PROCESS
 159         CAIE    C,TPVP
 160         JRST    IWTYP
 161         HRRZ    D,(A)           ;POINT TO 2D PART OF PAIR
 162         PUSH    TP,(D)          ;SETUP CALL TO EVAL
 163         PUSH    TP,1(D)
 164         MOVE    D,TB            ;GET CURRENT FRAME POINTER
 165         MOVE    C,1(A)          ;GET PROCESS WHO WANTS THIS INTERRUPT
 166         CAME    C,PVP           ;SKIP IF CURRENT PROCESS
 167         MOVE    D,TBSTO+1(C)    ;GET SAVED FRAME
 168         HLRE    A,C             ;COMPUTE DOPE WORD POINTER
 169         SUBI    C,-1(A)         ;HAVE POINTER
 170         HRLI    C,TFRAME        ;BUILD A FRAME HACK
 171         HLL     D,OTBSAV(D)     ;GET A WINNING TIME
 172         PUSH    TP,C            ;AND PUSH IT
 173         PUSH    TP,D
 174         MCALL   2,EVAL
 175 INTCDR: HRRZ    A,@(TP)         ;CDR THE LIST OF TASKS
 176         JUMPE   A,TPPOP
 177         MOVEM   A,(TP)          ;SAVE THE CDR'D LIST
 178         JRST    DOINTS
 179
 180 TPPOP:  SUB     TP,[2,,2]       ;REMOVE LIST
 181         JRST    DIRQ
 182
 183 IWTYP:  PUSH    TP,(A)          ;SAVE TASK
 184         PUSH    TP,1(A)
 185         PUSH    TP,$TATOM
 186         PUSH    TP,MQUOTE BAD-INTERRUPT-HANDLER-TASK-IGNORED
 187         MCALL   1,PRINT
 188         MCALL   1,PRINT
 189         JRST    INTCDR
 190
 191 PDL2:   MOVEI   B,PDLGRO_-6     ;GET GROWTH SPEC
 192         SKIPE   A,PGROW         ;SKIP IF A P IS NOT GROWING
 193         DPB     B,[111100,,-1(A)]       ;STORE GROWTH SPEC
 194 TRYTPG: SKIPE   A,TPGROW        ;IS TP BLOWN
 195         DPB     B,[111100,,-1(A)]       ;YES, SET GROWTH SPEC
 196         SKIPE   A,PPGROW                ;POINT TO BLOWN PP
 197         DPB     B,[111100,,-1(A)]
 198         PUSHJ   P,AGC           ;COLLECT GARBAGE
 199         SETZM   PPGROW
 200         SETZM   PGROW
 201         SETZM   TPGROW
 202         JRST    INTDN1
 203
 204
 205
 206 ;SUBROUTINE TO SET AN INTERRUPT HANDLER
 207
 208 MFUNCTION SETINT,SUBR
 209         ENTRY   2
 210
 211         HLRZ    A,(AB)          ;FIRST IS FIXED
 212         CAIE    A,TFIX
 213         JRST    WTYP1
 214         HLRZ    A,2(AB)
 215         CAIE    A,TLIST
 216         JRST    WTYP2
 217         SKIPGE  B,1(AB)         ;GET NUMBER
 218         JRST    NEGINT          ;INTERRUPT NEGATIVE
 219         HRRZ    C,3(AB)         ;PICKUP LIST
 220 ISENT1: PUSH    P,CFINIS                ;FALL INTO INTERNAL SET TO POP TO FINIS
 221
 222 ISETNT: MOVEI   D,(B)           ;COPY
 223         LSH     B,1
 224         HRLI    B,(B)           ;TO 2 HALVES
 225         ADD     B,INTVEC+1(TVP) ;POINT TO HANDLER
 226         JUMPGE  B,INTOBG        ;OUT OF RANGE
 227         HRRZ    E,(B)           ;AND OLD POINTER
 228         HRRM    E,(C)           ;SPLICE
 229         HRRM    C,(B)
 230         CAILE   D,35.           ;WHICH MASK?
 231         JRST    SETW2
 232
 233         SUBI    D,36.           ;FIND BIT POSITION
 234         MOVSI   A,400000
 235         LSH     A,(D)           ;POSTITION
 236         IORM    A,MASK1
 237         .SUSET  [.SMASK,,MASK1]
 238 SETIN1: MOVE    A,(AB)
 239         MOVE    B,1(AB)
 240 CFINIS: POPJ    P,FINIS ;USED BY SETINT TO SETUP RETURN
 241
 242 SETW2:  SUBI    D,71.
 243         MOVSI   A,400000
 244         LSH     A,(D)
 245         IORM    A,MASK2
 246         .SUSET  [.SMSK2,,MASK2]
 247         JRST    SETIN1
 248 WTYP1:  PUSH    TP,$TATOM
 249         PUSH    TP,MQUOTE FIRST-ARG-WRONG-TYPE
 250         JRST    CALER1
 251
 252
 253 WTYP2:  PUSH    TP,$TATOM
 254         PUSH    TP,MQUOTE SECOND-ARG-WRONG-TYPE
 255         JRST    CALER1
 256
 257 NEGINT: PUSH    TP,$TATOM
 258         PUSH    TP,MQUOTE NEGATIVE-INTERRUPT-NUMBER
 259         JRST    CALER1
 260 INTOBG: PUSH    TP,$TATOM
 261         PUSH    TP,MQUOTE INT-NUMBER-TOO-LARGE
 262         JRST    CALER1
 263
 264 BADCHN: PUSH    TP,$TATOM
 265         PUSH    TP,MQUOTE CHANNEL-NOT-PHYSICAL
 266         JRST    CALER1
 267
 268 LWTYP:  PUSH    TP,$TATOM
 269         PUSH    TP,MQUOTE LAST-ARG-WRONG-TYPE
 270         JRST    CALER1
 271
 272 ; SET A CHANNEL INTERRUPT
 273
 274 MFUNCTION ONCHAR,SUBR
 275
 276         ENTRY
 277
 278         SKIPL   B,AB            ;COPY ARG POINTER
 279         JRST    TFA
 280         ADD     B,[2,,2]        ;POINT TO EXPRESSION ARG
 281         PUSHJ   P,CHKRGS        ;CHECK OUT THE ARGS AND MAKE THE LIST
 282         GETYP   A,(AB)  ;CHECK FOR A CHANNEL
 283         CAIE    A,TCHAN
 284         JRST    WTYP1
 285         MOVE    C,1(AB)         ;GET CHANNEL
 286         SKIPN   C,CHANNO(C)     ;GET CHANNEL
 287         JRST    BADCHN
 288         ADDI    C,36.           ;POINT INTO INT VECTOR
 289         EXCH    B,C
 290         PUSHJ   P,ISETNT        ;SET THE INTERRUPT
 291         MOVE    A,2(AB)         ;RETURN ARG
 292         MOVE    B,3(AB)
 293         JRST    FINIS
 294
 295 ; SET A CLOCK INTERRUPT
 296
 297 MFUNCTION ONCLOCK,SUBR
 298
 299         ENTRY
 300
 301         MOVE    B,AB
 302         PUSHJ   P,CHKRGS                ;CHECK ARGS AND MAKE LIST
 303         MOVE    C,B     ;COPY LIST POINTER
 304         MOVEI   B,13.           ;CLOCK INT NUMBER
 305         JRST    ISENT1          ;SET UP THE INT
 306
 307 CHKRGS: JUMPGE  B,TFA
 308         MOVE    C,PVP           ;GET CURRENT PROCESS
 309         CAML    B,[-2,,0]       ;CHECK FOR PROCESS ARG
 310         JRST    GOTPVP
 311         CAMGE   B,[-4,,0]       ;SKIP IF RIGHT NO. OF ARGS
 312         JRST    TMA             ;TOO MANY
 313         GETYP   A,2(B)          ;CHECK TYPE
 314         CAIE    A,TPVP
 315         JRST    LWTYP           ;WRONG TYPE
 316         MOVE    C,3(B)          ;GET PROCESS
 317 GOTPVP: PUSH    TP,$TPVP
 318         PUSH    TP,C
 319         PUSH    TP,(B)          ;PUSH EXPRESSION
 320         PUSH    TP,1(B)
 321         MCALL   2,LIST  ;MAKE THE LIST
 322         PUSH    TP,A
 323         PUSH    TP,B
 324         MCALL   1,LIST          ;MAKE A LIST OF A LIST
 325         POPJ    P,
 326
 327
 328 ;ROUTINE TO GET CURRENT INT NUMBER
 329
 330 MFUNCTION GETINT,SUBR
 331
 332         ENTRY   0
 333         MOVSI   A,TFIX
 334         MOVE    B,INTNUM+1(TVP)
 335         JRST    FINIS
 336
 337 MFUNCTION INTCHAR,SUBR
 338
 339         ENTRY
 340         PUSH    P,CFINIS        ;CAUSE RETURN TO FINIS
 341 INTCH1: MOVE    B,INTNUM+1(TVP)
 342         JUMPGE  AB,GOTNUM
 343         HLRZ    A,(AB)
 344         CAIE    A,TFIX
 345         JRST    WTYP1
 346         MOVE    B,1(AB)
 347
 348 GOTNUM: SUBI    B,36.           ;CONVERT TO CHANNEL
 349         MOVEI   C,(B)           ;SAVE A COPY OF CHANNEL
 350         .ITYIC  B,
 351         JRST    NOCHRS
 352
 353         LSH     B,29.
 354         MOVSI   A,TCHRS
 355         MOVEI   D,(C)   ;COPY CHANNEL AGAIN
 356         LSH     D,1             ;TIMES 2
 357         ADDI    D,CHANL0+1(TVP) ;POINT TO INFO
 358         HRRZ    E,(D)   ;POINT TO CHANNEL
 359         HRRZ    E,BUFRIN(E)     ;POINT TO ADDL INFO
 360         AOS     SYSCHR(E)
 361
 362 REINT:  MOVEI   E,1     ;PREPARE TO RENABLE
 363         LSH     E,(C)
 364         IORM    E,MASK2
 365         .SUSET  [.SMSK2,,MASK2]
 366         POPJ    P,
 367
 368
 369 NOCHRS: MOVEI   B,0
 370         MOVSI   A,TFALSE
 371         JRST    REINT
 372
 373 MFUNCTION QUITTER,SUBR
 374
 375         ENTRY   0
 376
 377 REQT:   PUSHJ   P,INTCH1        ;CHECK FOR A CHAR
 378         CAMN    A,$TFALSE       ;ANY LEFT?
 379         JRST    FINIS   ;NO
 380         CAME    B,[7_29.]       ;CNTL G?
 381         JRST    REQT
 382         PUSH    TP,$TCHAN               ;QUIT HERE
 383         PUSH    TP,(D)          ;PUSH CHANNEL
 384         MCALL   1,RRRES
 385         PUSH    TP,$TATOM
 386         PUSH    TP,MQUOTE CONTROL-G
 387         MCALL   1,ERROR
 388         JRST    FINIS
 389
 390 MFUNCTION INTRCH,SUBR,INTCHAN
 391
 392         ENTRY   0
 393
 394         MOVE    B,INTNUM+1(TVP) ;GET INT NUMBER
 395         SUBI    B,36.
 396         JUMPL   B,IFALSE        ;NOT A CHANNEL
 397         CAILE   B,17
 398         JRST    IFALSE          ;NOT A CHANNEL
 399         LSH     B,1             ;TIMES 2
 400         ADDI    B,CHANL0(TVP)   ;GET POINTER TO CHANNEL
 401         MOVE    A,(B)
 402         MOVE    B,1(B)
 403         JRST    FINIS
 404
 405 MFUNCTION GASCII,SUBR,ASCII
 406         ENTRY   1
 407
 408         HLRZ    A,(AB)
 409         CAIE    A,TCHRS
 410         JRST    TRYNUM
 411
 412         MOVE    B,1(AB)
 413         TDNN    B,[3777,,-1]
 414         LSH     B,-29.
 415         MOVSI   A,TFIX
 416         JRST    FINIS
 417
 418 TRYNUM: CAIE    A,TFIX
 419         JRST    WTYP1
 420         SKIPGE  B,1(AB)         ;GET NUMBER
 421         JRST    TOOBIG
 422         CAILE   B,177           ;CHECK RANGE
 423         JRST    TOOBIG
 424         LSH     B,29.
 425         MOVSI   A,TCHRS
 426         JRST    FINIS
 427
 428 TOOBIG: PUSH    TP,$TATOM
 429         PUSH    TP,MQUOTE OUT-OF-RANGE
 430         JRST    CALER1
 431
 432 ;SUBROUTINE TO GET BIT FOR CLOBBERAGE
 433
 434 GETBIT: MOVNS   B               ;NEGATE
 435         MOVSI   A,400000        ;GET THE BIT
 436         LSH     A,(B)           ;SHIFT TO POSITION
 437         POPJ    P,              ;AND RETURN
 438
 439 ;HERE TO HANDLE PDL OVERFLOW.  ASK FOR A GC
 440
 441 IPDLOV: SKIPE   FLFLG           ;DURING FAILURE,
 442         JRST    IMPCH           ;LET FAIL HANDLE BLOWN PDLS
 443         MOVEM   A,TSINT         ;SAVE INT WORD
 444         MOVEI   A,200000        ;GET BIT TO CLOBBER
 445         IORM    A,PIRQ          ;LEAVE A MESSAGE FOR HIGHER LEVEL
 446
 447         SKIPE   GCFLG           ;IS GC RUNNING?
 448         JRST    GCPLOV          ;YES, COMPLAIN GROSSLY
 449
 450         EXCH    P,GCPDL         ;GET A WINNING PDL
 451         HRRZ    B,TSINTR        ;GET POINTER TO LOSING INSTRUCTION
 452         LDB     B,[270400,,-1(B)]       ;GET AC FIELD
 453         MOVEI   A,(B)           ;COPY IT
 454         LSH     A,1             ;TIMES 2
 455         ADDI    A,0STO(PVP)     ;POINT TO THIS ACS CURRENT TYPE
 456         HLRZ    A,(A)           ;GET THAT TYPE INTO A
 457         CAIN    B,P             ;IS IT P
 458         MOVEI   B,GCPDL         ;POINT TO SAVED P
 459
 460         CAIN    B,B             ;OR IS IT B ITSELF
 461         MOVEI   B,TSAVB
 462         CAIN    B,A             ;OR A
 463         MOVEI   B,TSAVA
 464
 465         CAIN    B,C             ;OR C
 466         MOVEI   B,1(P)          ;C WILL BE ON THE STACK
 467
 468         PUSH    P,C
 469         PUSH    P,A
 470
 471         MOVE    A,(B)           ;GET THE LOSING POINTER
 472         MOVEI   C,(A)           ;AND ISOLATE RH
 473
 474         CAMG    C,VECTOP        ;CHECK IF IN GC SPACE
 475         CAMG    C,VECBOT
 476         JRST    NOGROW          ;NO, COMPLAIN
 477
 478         HLRZ    C,A             ;GET -LENGTH
 479         SUBI    A,-1(C)         ;POINT TO A DOPE WORD
 480         POP     P,C             ;RESTORE TYPE INTO C
 481         CAIE    C,TPDL          ;IS IT A P STACK?
 482         JRST    TRYTP           ;NO
 483         SKIPE   PGROW           ;YES, ALREADY GROWN?
 484         JRST    PDLOSS          ;YES, LOSE
 485         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD
 486         HRRM    A,PGROW         ;STORE
 487         JRST    PNTRHK          ;FIX UP THE PDL POINTER
 488
 489 TRYTP:  CAIE    C,TTP           ;TP STACK
 490         JRST    TRYPP
 491         SKIPE   TPGROW          ;ALREADY GROWN?
 492         JRST    PDLOSS
 493         ADDI    A,PDLBUF        ;POINT TO REAL DOPE WORD
 494         HRRM    A,TPGROW
 495         JRST    PNTRHK          ;GO MUNG POINTER
 496
 497 TRYPP:  CAIE    C,TPP           ;PLANNER PDL?
 498         JRST    BADPDL
 499         SKIPE   PPGROW
 500         JRST    PDLOSS          ;LOSER
 501         ADDI    A,PDLBUF
 502         HRRM    A,PPGROW
 503
 504
 505 PNTRHK: MOVE    C,(B)           ;RESTORE PDL POINTER
 506         SUB     C,[PDLBUF,,0]   ;FUDGE THE POINTER
 507         MOVEM   C,(B)           ;AND STORE IT
 508
 509         POP     P,C             ;RESTORE THE WORLD
 510         MOVE    A,TSINT         ;RESTORE INT WORD
 511
 512         EXCH    P,GCPDL         ;GET BACK ORIG PDL
 513         JRST    IMPCH           ;LOOK FOR MORE INTERRUPTS
 514
 515 TPOVFL: SETOM   INTFLG          ;SIMULATE PDL OVFL
 516         PUSH    P,A
 517         MOVEI   A,200000        ;TURN ON THE BIT
 518         IORM    A,PIRQ
 519         SUB     TP,[PDLBUF,,0]  ;HACK STACK POINTER
 520         HLRE    A,TP            ;FIND DOPEW
 521         SUBM    TP,A            ;POINT TO DOPE WORD
 522         ADDI    A,1
 523         HRRZM   A,TPGROW
 524         POP     P,A
 525         POPJ    P,
 526
 527
 528 ;HERE TO HANDLE LOW-LEVEL CHANNELS
 529
 530
 531 CHNACT: SKIPN   GCFLG           ;GET A WINNING PDL
 532         EXCH    P,GCPDL
 533         ANDI    A,177777        ;ISOLATE CHANNEL BITS
 534         PUSH    P,0             ;SAVE
 535
 536 CHNA1:  MOVEI   B,0             ;BIT COUNTER
 537         JFFO    A,.+2           ;COUNT
 538         JRST    CHNA2
 539         SUBI    B,35.           ;NOW HAVE CHANNEL
 540         MOVMS   B               ;PLUS IT
 541         MOVEI   0,1
 542         LSH     0,(B)           ;SET TO CLOBBER BIT
 543         ANDCM   A,0
 544         LSH     B,23.           ;POSITION FOR A .STATUS
 545         IOR     B,[.STATUS B]
 546         XCT     B               ;DO IT
 547         ANDI    B,77            ;ISOLATE DEVICE
 548         CAILE   B,2
 549         JRST    CHNA1
 550         ANDCAM  0,MASK2         ;TURN OFF BIT
 551         .SUSET  [.SMSK2,,MASK2]
 552         JRST    CHNA1
 553
 554 CHNA2:  POP     P,0
 555         SKIPN   GCFLG
 556         EXCH    P,GCPDL
 557         JRST    GCQUIT
 558
 559 ;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION
 560
 561 BADPDL: SKIPA   B,[[ASCIZ /NON-PDL OVERFLOW
 562 /]]
 563 GCPLOV: MOVEI   B,[ASCIZ /PDL OVERFLOW DURING GARBAGE COLLECTION
 564 /]
 565 GFATER: MOVE    P,GCPDL         ;GET ORIGINAL PDL FOR TYPE OUT
 566         JRST    FATERR          ;GO TO FATAL ERROR ROUTINE
 567
 568 NOGROW: MOVEI   B,[ASCIZ /PDL OVERFLOW ON NON-EXPANDABLE PDL
 569 /]
 570         JRST    GFATER
 571
 572 PDLOSS: MOVEI   B,[ASCIZ /PDL OVERFLOW BUFFER EXHAUSTED
 573 /]
 574         JRST    GFATER
 575
 576 FATERR: PUSHJ   P,MSGTYP        ;TYPE THE MESSAGE
 577         MOVEI   B,[ASCIZ /FATAL ERROR, PLEASE DUMP SO THAT MUDDLE SYSTEM PROGRAMMERS
 578 MAY DEBUG./]
 579         PUSHJ   P,MSGTYP        ;TYPE THE LOSER MESSAGE
 580         PUSHJ   P,OCLOS         ;CLOSE THE TTY
 581         .VALUE
 582         JRST    .-1
 583
 584
 585 ;MEMORY PROTECTION INTERRUPT
 586
 587 IMPV:   MOVEI   B,[ASCIZ /MPV -- /]
 588
 589 IMPV1:  PUSHJ   P,MSGTYP        ;TYPE
 590         SKIPE   GCFLG           ;THESE ERRORS FATAL IN GARBAGE COLLECTOR
 591         JRST    GCERR
 592
 593         MOVE    P,GCPDL         ;MAKE SURE OF A WINNING PDL
 594 ERLP:   MOVEI   B,[ASCIZ /TYPE "S" TO GO TO SUPERIOR, "R" TO RESTART PROCESS./]
 595         PUSHJ   P,IFLUSH        ;FLUSH AWAITING INPUT
 596         PUSHJ   P,MSGTYP
 597
 598         PUSHJ   P,TYI           ;READ THE CHARACTER
 599
 600         PUSHJ   P,UPLO          ;CONVERT TO UPPER CASE
 601         CAIN    A,"S
 602         .VALUE
 603
 604         CAIE    A,"R            ;DOES HE WANT TO RESTART
 605         JRST    ERLP            ;NO, TELL HIM AGAIN
 606
 607         MCALL   0,INTABR        ;ABORT THE PROCESS
 608
 609 INTABR: MOVEI   A,ERRET         ;REAALY GO TO ERRET
 610         HRRM    A,TSINTR
 611         .DISMISS        TSINTR
 612
 613
 614 GCERR:  MOVEI   B,[ASCIZ /IN GARBAGE COLLECTOR
 615 /]
 616         JRST    FATERR
 617
 618 ILOPR:  MOVEI   B,[ASCIZ /ILLEGAL OPERATION -- /]
 619         JRST    IMPV1
 620
 621 ; SUBROUTINE TO CONVERT LOWER CASE LETTERS TO UPPER
 622
 623 UPLO:   CAIG    A,172           ;GEATER THAN Z?
 624         CAIG    A,140           ;NO, LESS THAN A
 625         POPJ    P,              ;YES, LOSE
 626         SUBI    A,40            ;MAKE UPPER CASE
 627         POPJ    P,
 628
 629 ;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO FUDGE INT PC
 630
 631 INTINT: PUSHJ   P,PCHACK        ;FUDGE PC LOSSAGE
 632         MOVE    A,MASK1 ;SET MASKS
 633         MOVE    B,MASK2
 634         .SETM2  A,              ;SET BOTH MASKS
 635         POPJ    P,
 636
 637 PCHACK: .SUSET  [.SMASK,,[200000]]      ;SET FOR ONLY PDL OVERFLOW
 638         MOVE    D,TSINT+2       ;SAVE CONTENTS OF ITERRUPT HANDLER
 639         MOVEI   A,FUNINT        ;POINT TO DUMMY THEREOF
 640         HRRM    A,TSINT+2       ;AND STORE IT
 641         HRROI   A,0             ;MAKE A VERY SHORT PDL
 642 CHPUSH: PUSH    A,0             ;PUSH SOMETHING AND OVERFLOW
 643         .VALUE  [ASCIZ /?/]     ;SHOULD NEVER GET HERE
 644
 645 FUNINT: HRRM    D,TSINT+2       ;RESTORE STANDARD HANDLER
 646         HRRZ    D,TSINTR        ;GET THE LOCATION STORED
 647         SUBI    D,CHPUSH        ;FIND THE DIFFERENCE
 648         MOVEM   D,PCOFF         ;AND SAVE
 649         POP     P,TSINTR        ; POP INTO DISMISS WORD
 650         .DISMISS        TSINTR          ;AND DISMISS
 651
 652
 653
 654 INTLOS: .VALUE  [ASCIZ /INT/]
 655 CHARCH: .VALUE  [ASCIZ /CHAR?/]
 656 ;RANDOM IMPURE CRUFT NEEDED
 657
 658 TSAVA:  0
 659 TSAVB:  0
 660 PIRQ:   0                       ;HOLDS REQUEST BITS FOR 1ST WORD
 661 PIRQ2:  0                       ;SAME FOR WORD 2
 662 PCOFF:  0
 663 MASK1:  220040                  ;FIRST MASK
 664 MASK2:  0                       ;SECOND THEREOF
 665
 666
 667 END
 668 \f\f\ 3\f