<mdl.int>/interr.mid.425

   1
   2 TITLE INTERRUPT HANDLER FOR MUDDLE
   3
   4 RELOCATABLE
   5
   6 ;C. REEVE  APRIL 1971
   7
   8 .INSRT MUDDLE >
   9
  10 SYSQ
  11 XJRST=JRST 5,
  12
  13 F==PVP
  14 G==TVP
  15
  16 IF1,[
  17 IFE ITS,.INSRT STENEX >
  18 ]
  19
  20 PDLGRO==10000   ;AMOUNT TO GROW A PDL THAT LOSES
  21 NINT==72.       ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE
  22
  23 IFN ITS,[
  24 ;SET UP LOCATION 42 TO POINT TO TSINT
  25
  26 RMT [
  27
  28 ZZZ==$. ;SAVE CURRENT LOCATION
  29
  30 LOC 42
  31
  32         JSR     MTSINT          ;GO TO HANDLER
  33
  34 LOC ZZZ
  35 ]
  36 ]
  37
  38 ; GLOBALS NEEDED BY INTERRUPT HANDLER
  39
  40 .GLOBAL ONINT   ; FUDGE INS EXECUTED IF NON ZERO AT START OF INTERRUPT
  41 .GLOBAL INTBCK  ; "PC-LOSER HACK "
  42 .GLOBA GCFLG    ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING
  43 .GLOBAL GCFLCH  ; FLUSH CHARS IMMEDIATE SO GC CAN SEE THEM
  44 .GLOBAL CORTOP  ; TOP OF CORE
  45 .GLOBA GCINT    ;TELLS GARBAGE COLLECTOR TO SIMULATE AN INTERRUPT
  46 .GLOBAL INTNUM,INTVEC   ;TV ENTRIES CONCERNING INTERRUPTS
  47 .GLOBAL AGC     ;CALL THE GARBAGE COLLECTOR
  48 .GLOBAL VECNEW,PARNEW,GETNUM    ;GC PSEUDO ARGS
  49 .GLOBAL GCPDL   ;GARBAGE COLLECTORS PDL
  50 .GLOBAL VECTOP,VECBOT   ;DELIMIT VECTOR SPACE
  51 .GLOBAL PURTOP,CISTNG,SAGC
  52 .GLOBAL PDLBUF  ;AMOUNT OF  PDL GROWTH
  53 .GLOBAL PGROW   ;POINTS TO DOPE WORD OF NEXT PDL TO GROW
  54 .GLOBAL TPGROW  ;POINTS TO NEXT MUDDLE PDL TO GROW
  55 .GLOBAL TOPLEV,ERROR%,N.CHNS,CHNL1
  56 .GLOBAL BUFRIN,CHNL0,SYSCHR     ;CHANNEL GLOBALS
  57 .GLOBAL IFALSE,TPOVFL,1STEPR,INTOBL,INCHAR,CURPRI,RDEVIC,RDIREC,GFALS,STATUS
  58 .GLOBAL PSTAT,NOTRES,IOIN2,INAME,INTFCN,CHNCNT,CHANNO,GIBLOK,ICONS,INCONS
  59 .GLOBAL IEVECT,INSRTX,ILOOKC,IPUT,IREMAS,IGET,CSTAK,EMERGE,CHFSWP
  60 .GLOBAL MTSINT  ;BEGINNING OF INTERRUPT HANDLER
  61 .GLOBAL INTINT  ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS
  62 .GLOBAL FRMSTK,APPLY,CHUNW,TGFALS
  63 .GLOBAL IPCGOT,DIRQ     ;HANDLE BRANCHING OFF TO IPC KLUDGERY
  64 .GLOBAL MULTSG
  65
  66 ; GLOBALS FOR GC
  67 .GLOBAL GCTIM,GCCAUS,GCCALL,GPDLOV
  68
  69 ; GLOBALS FOR MONITOR ROUTINES
  70
  71 .GLOBAL MONCH,MONCH0,RMONCH,RMONC0,LOCQ,SMON,BAPT,APLQ,MAKACT,NAPT
  72 .GLOBAL PURERR,BUFRIN,INSTAT,REALTV,DSTORE
  73
  74 MONITOR
  75
  76 .GLOBAL MSGTYP,MTYI,UPLO,IFLUSH,OCLOS,ERRET,MASK1,MASK2 ;SUBROUTINES USED
  77 .GLOBAL ERROR,LISTEN,ECHO,RRESET,MTYO,GCHAPN,P.CORE,P.TOP,QUEUES,NOTTY,TTYOP2,TTICHN
  78 .GLOBAL INTHLD,BNDV,SPECBE,DEMFLG,PLODR
  79
  80 ; GLOBALS FOR PRE-AGC INTERRUPT
  81
  82 .GLOBAL FRETOP,GCSTOP,FREMIN,CORTOP,P.CORE,PURBOT,GETNUM,GCKNUM,GCHPN,INTAGC
  83 .GLOBAL SPECBIND,SSPEC1,ILVAL
  84
  85
  86 ; GLOBALS FOR COPY/WRITE HACK FOR GCDUMP AND PURIFY
  87
  88 .GLOBAL GCDFLG,%CWINF,BUFGC,WNDBOT,WIND,WNDP,%SHWND,GPURFL,%FDBUF,PURMNG,RPURBT
  89 .GLOBAL NPWRIT,PVSTOR,SPSTOR,OPSYS
  90
  91
  92
  93 ;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE)
  94
  95
  96 ;***** TEMP FUDGE *******
  97
  98 QUEUES==INTVEC
  99
 100 \f
 101 ; DECLARATIONS ASSOCIATED WITH INTERRUPT HANDERS AND HEADERS
 102
 103 ; SPECIAL TABLES
 104
 105 SPECIN: IRP A,,[CHAR,CLOCK,MPV,ILOPR,WRITE,READ,IOC,PURE,SYSDOWN,INFERIOR,RUNT,REALT
 106 PARITY]
 107         MQUOTE A,[A]INTRUP
 108         TERMIN
 109 SPECLN==.-SPECIN
 110
 111 ; TABLE OF SPECIAL FINDING ROUTINES
 112
 113 FNDTBL: IRP A,,[GETCHN,0,0,0,LOCGET,LOCGET,0,0,0,0,0,0,0]
 114         A
 115         TERMIN
 116
 117 ; TABLE OF SPECIAL SETUP ROUTINES
 118
 119 INTBL:  IRP A,,[S.CHAR,S.CLOK,S.MPV,S.ILOP,S.WMON,S.RMON,S.IOC,S.PURE,S.DOWN,S.INF
 120 S.RUNT,S.REAL,S.PAR]
 121         A
 122         S!A==.IRPCNT
 123         TERMIN
 124
 125 IFN ITS,[
 126
 127 ; EXTERNAL INTERRUPT TABLE
 128
 129 EXTINT: REPEAT NINT-36.,0
 130         REPEAT 16.,HCHAR
 131         0
 132         0
 133         REPEAT 8.,HINF
 134         REPEAT NINT-62.,0
 135 EXTIND:
 136
 137 IRP A,,[[HCLOCK,13.],[HMPV,14.],[HILOPR,6],[HIOC,9],[HPURE,26.],[HDOWN,7],[HREAL,35.]
 138 [HRUNT,34.],[HPAR,28.]]
 139         IRP B,C,[A]
 140         LOC EXTINT+C
 141         B
 142         .ISTOP
 143         TERMIN
 144 TERMIN
 145
 146
 147 LOC EXTIND
 148 ]
 149 \f
 150 IFE ITS,[
 151
 152 ; TABLES FOR TENEX INTERRUPT SYSTEM
 153
 154 LEVTAB: P1              ; POINTS TO INT PC HOLDERS FOR LEVS 1,2 AND 3
 155         P2
 156         P3
 157
 158 CHNMSK==700000,,7       ; WILL BE MASK WORD FOR INT SET UP
 159 MFORK==400000
 160 NNETS==7                ; ALLOW 7 NETWRK INTERRUPTS
 161 UINTS==4
 162 NETCHN==36.-NNETS-UINTS-1
 163 NCHRS==6
 164 RLCHN==36.-NNETS-UINTS
 165
 166 RMT [
 167 IMPURE                  ; IMPURE BECAUSE IT CHANGES IN MULTI-SECTION MODE
 168 CHNTAB:                 ; LOCATION OF INT ROUTINES FOR VARIOUS "CHANNELS"
 169
 170 REPEAT NCHRS,   1,,INTCHR+3*.RPCNT
 171         BLOCK   36.-NNETS-NCHRS-UINTS-1 ; THERE ARE 36. TENEX INT CHANNELS
 172
 173 REPEAT NNETS+UINTS, 1,,INTNET+3*.RPCNT
 174
 175 IRP A,,[[9.,TNXPDL],[17.,PWRIT],[10.,TNXEOF],[11.,TNXIOC],[12.,TNXFUL]
 176 [RLCHN,TNXRLT],[19.,TNXINF]]
 177         IRP B,C,[A]
 178         LOC CHNTAB+B
 179         1,,C
 180         CHNMSK==CHNMSK+<1_<35.-B>>
 181         .ISTOP
 182         TERMIN
 183 TERMIN
 184 LOC CHNTAB+36.
 185 PURE
 186 ]
 187 EXTINT:
 188 BLOCK 36.
 189 REPEAT NCHRS,SETZ HCHAR
 190 BLOCK NINT-NNETS-NCHRS-UINTS-36.-1
 191 REPEAT NNETS,SETZ HNET
 192 REPEAT UINTS,SETZ USRINT
 193 LOC EXTINT+NINT-11.
 194 REPEAT 3,SETZ HIOC
 195 LOC EXTINT+NINT-RLCHN-1
 196 SETZ HREAL
 197 LOC EXTINT+NINT-19.-1
 198 SETZ HINF
 199 LOC EXTINT+NINT
 200 ]
 201
 202
 203 ; HANDLER/HEADER PARAMETERS
 204
 205 ; HEADER BLOCKS
 206
 207 IHDRLN==4               ; LENGTH OF HEADER BLOCK
 208
 209 INAME==0                ; NAME OF INTERRUPT
 210 ISTATE==2               ; CURRENT STATE
 211 IHNDLR==4               ; POINTS TO LIST OF HANDLERS
 212 INTPRI==6               ; CONTAINS PRIORITY OF INTERRUPT
 213
 214 IHANDL==4               ; LENGTH OF A HANDLER BLOCK
 215
 216 INXT==0                 ; POINTS TO NEXTIN CHAIN
 217 IPREV==2                ; POINTS TO PREV IN CHAIN
 218 INTFCN==4               ; FUNCTION ASSOCIATED WITH THIS HANDLER
 219 INTPRO==6               ; PROCESS TO RUN INT IN
 220
 221 IFN ITS,[
 222 RMT [
 223 IMPURE
 224 TSINT:
 225 MTSINT: 0                       ;INTERRUPT BITS GET STORED HERE
 226 TSINTR: 0                       ;INTERRUPT PC WORD STORED HERE
 227         JRST    TSINTP          ;GO TO PURE CODE
 228
 229 ; SOFTWARE INTERNAL INTERRUPTS JSR TO HERE
 230
 231 LCKINT: 0
 232         JRST    DOINT
 233
 234 PURE
 235 ]
 236 ]
 237 IFE ITS,[
 238 RMT [
 239 ; JSR HERE FOR SOFTWARE INTERNAL INTERRUPTS
 240
 241 IMPURE
 242 LCKINT: 0
 243         JRST    DOINT
 244 PURE
 245 ]
 246 ]
 247 \f
 248
 249 IFN ITS,[
 250
 251 ;THE REST OF THIS CODE IS PURE
 252
 253 TSINTP: SOSGE   INTFLG          ; SKIP IF ENABLED
 254         SETOM   INTFLG          ;DONT GET LESS THAN -1
 255
 256         SKIPE   INTBCK          ; ANY INT HACKS?
 257         JRST    PCLOSR          ; DO A PC-LOSR ON THE PROGRAM
 258         MOVEM   A,TSAVA         ;SAVE TWO ACS
 259         MOVEM   B,TSAVB
 260         MOVE    A,TSINT         ;PICK UP INT BIT PATTERN
 261         JUMPL   A,2NDWORD       ;DONT CHECK FOR PDL OVERFLOW ETC. IF SIGN BIT ON
 262
 263         TRZE    A,200000        ;IS THIS A PDL OVERFLOW?
 264         JRST    IPDLOV          ;YES, GO HANDLE IT FIRST
 265
 266 IMPCH:  MOVEI   B,0
 267         TRNE    A,20000         ;IS IT A MEMORY PROTECTION VIOLATION?
 268         MOVEI   B,1             ; FLAG SAME
 269
 270         TRNE    A,40            ;ILLEGAL OP CODE?
 271         MOVEI   B,2             ; ALSO FLAG
 272         TRNN    A,400           ; IOC?
 273         JRST    .+3
 274         SOS     TSINTR
 275         MOVEI   B,3
 276         TLNE    A,200           ; PURE?
 277         JRST    GCPWRT          ; CHECK FOR PURE WRITE FOR POSSIBLE C/W
 278 NOPUGC: SOJGE   B,DO.NOW                ; CANT WAIT AROUND
 279
 280 ;DECODE THE REST OF THE INTERRUPTS USING A TABLE
 281
 282 2NDWORD:
 283         JUMPL   A,GC2           ;2ND WORD?
 284         IORM    A,PIRQ          ;NO, INTO WORD 1
 285         JRST    GCQUIT          ;AND DISMISS INT
 286
 287 GC2:    TLZ     A,400000        ;TURN OFF SIGN BIT
 288         IORM    A,PIRQ2
 289         TRNE    A,177777        ;CHECK FOR CHANNELS
 290         JRST    CHNACT          ;GO IF CHANNEL ACTIVITY
 291 ]
 292 GCQUIT: SKIPGE  INTFLG          ;SKIP IF INTERRUPTS ENABLED
 293         JRST    INTDON          ;NO, DEFER REAL HANDLING UNTIL LATER
 294
 295         MOVE    A,TSINTR        ;PICKUP RETURN WORD
 296 IFE ITS,[
 297         SKIPE   MULTSG
 298          JRST   MLTEX
 299         TLON    A,10000         ; EXEC PC?
 300         SOJA    A,MLTEX1        ; YES FIXUP PC
 301 MLTEX:  TLON    A,10000
 302         SOS     TSINTR+1
 303         MOVEM   A,TSINTR
 304         MOVE    A,TSINTR+1
 305 ]
 306 MLTEX1: MOVEM   A,LCKINT        ;STORE ELSEWHERE
 307         MOVEI   A,DOINTE        ;CAUSE DISMISS TO HANDLER
 308 IFN ITS,        HRRM    A,TSINTR        ;STORE IN INT RETURN
 309 IFE ITS,[
 310         SKIPE   MULTSG
 311          HRRM   A,TSINTR+1
 312         SKIPN   MULTSG
 313          HRRM   A,TSINTR
 314 ]
 315         PUSH    P,INTFLG        ;SAVE INT FLAG
 316         SETOM   INTFLG          ;AND DISABLE
 317
 318
 319 INTDON: MOVE    A,TSAVA         ;RESTORE ACS
 320         MOVE    B,TSAVB
 321 IFN ITS,        .DISMISS        TSINTR          ;AND DISMISS THE INTERRUPT
 322 IFE ITS,        DEBRK
 323
 324 IFN ITS,[
 325 PCLOSR: MOVEM   A,TSAVA
 326         HRRZ    A,TSINTR        ; WHERE FROM
 327         CAIG    A,INTBCK
 328         CAILE   A,INTBEN        ; AVOID TIMING ERRORS
 329         JRST    .+2
 330         JRST    INTDON
 331
 332         SOS     A,INTBCK
 333         MOVEM   A,TSINTR
 334         SETZM   INTBCK
 335         SETZM   INTFLG
 336         AOS     INTFLG
 337         MOVE    TP,TPSAV(TB)
 338         MOVE    P,PSAV(TB)
 339         MOVE    A,TSAVA
 340         JRST    TSINTP
 341 ]
 342 DO.NOW: SKIPN   GPURFL
 343         SKIPE   GCFLG
 344         JRST    DLOSER          ; HANDLE FATAL GC ERRORS
 345         MOVSI   B,1
 346         SKIPGE  INTFLG          ; IF NOT ENABLED
 347         MOVEM   B,INTFLG        ; PRETEND IT IS
 348 IFN ITS,        JRST    2NDWORD
 349 IFE ITS,        JRST    GCQUIT
 350
 351 IFE ITS,[
 352
 353 ; HERE FOR TENEX PDL OVER FLOW INTERRUPT
 354
 355 TNXPDL: SOSGE   INTFLG
 356         SETOM   INTFLG
 357         MOVEM   A,TSAVA
 358         MOVEM   B,TSAVB
 359         JRST    IPDLOV          ; GO TO COMMON HANDLER
 360
 361 ; HERE FOR REAL TIMER
 362
 363 TNXRLT: MOVEM   A,TSAVA
 364 IFG <RLCHN-18.>,        MOVEI   A,<1_<35.-<RLCHN>>>
 365 IFLE <RLCHN-18.>        MOVSI   A,(<1_<35.-<RLCHN>>>)
 366
 367         JRST    CNTSG
 368
 369 ; HERE FOR TENEX ^G AND ^S INTERRUPTS
 370
 371 INTCHR:
 372 REPEAT NCHRS,[
 373         MOVEM   A,TSAVA
 374         MOVEI   A,<1_<.RPCNT>>
 375         JRST    CNTSG
 376 ]
 377 CNTSG:  MOVEM   B,TSAVB
 378         IORM    A,PIRQ2         ; SAY FOR MUDDLE LEVEL
 379         SOSGE   INTFLG
 380         SETOM   INTFLG
 381         JRST    GCQUIT
 382 INTNET:
 383 REPEAT NNETS+UINTS,[
 384         MOVEM   A,TSAVA
 385         MOVE    A,[1_<.RPCNT+NETCHN>]
 386         JRST    CNTSG
 387 ]
 388 TNXINF: MOVEM   A,TSAVA
 389         MOVEI   A,<1_<35.-19.>>
 390         JRST    TNXCHN
 391
 392 ; LOW LEVEL HANDLERS FOR 10X IOC INTERRUPTS
 393
 394 TNXEOF: MOVEM   A,TSAVA
 395         MOVSI   A,(1_<35.-10.>)
 396         JRST    TNXCHN
 397
 398 TNXIOC: MOVEM   A,TSAVA
 399         MOVSI   A,(1_<35.-11.>)
 400         JRST    TNXCHN
 401
 402 TNXFUL: MOVEM   A,TSAVA
 403         SKIPN   PLODR
 404          JRST   TNXFU1
 405         FATAL DISK FULL IN PURE FIXUP, CONTINUE TO RETRY
 406         JRST    INTDON
 407
 408 TNXFU1: MOVSI   A,(1_<35.-12.>)
 409
 410 TNXCHN: IORM    A,PIRQ2
 411         MOVEM   B,TSAVB
 412         HRRZ    A,TSAVA         ; ASSUME JFN IS IN A (PRETTY FLAKEY BUT ...)
 413         MOVEM   A,IOCLOS
 414         JRST    DO.NOW
 415 ]
 416 \f
 417 ; HERE TO PROCESS INTERRUPTS
 418
 419 DOINT:  SKIPE   INTHLD          ; GLOBAL LOCK ON INTS
 420         JRST    @LCKINT
 421         SETOM   INTHLD          ; DONT LET IT HAPPEN AGAIN
 422         PUSH    P,INTFLG
 423 DOINTE: SKIPE   ONINT           ; ANY FUDGE?
 424         XCT     ONINT           ; YEAH, TRY ONE
 425         PUSH    P,ONINT
 426         SETZM   ONINT
 427         EXCH    0,LCKINT        ; RELATIVIZE PC IF FROM RSUBR
 428 IFE ITS,        TLZ     0,777740        ; KILL EXCESS BITS
 429         PUSH    P,0             ; AND SAVE
 430         ANDI    0,-1
 431         CAMG    0,PURTOP
 432         CAMGE   0,VECBOT
 433         JRST    DONREL
 434         SUBI    0,(M)           ; M IS BASE REG
 435 IFN ITS,        TLO     0,400000+M      ; INDEX IT OFF M
 436 IFE ITS,[
 437         TLO     0,400000+M
 438         SKIPN   MULTSG
 439          JRST   .+3
 440         HLL     0,(P)
 441         TLO     0,400000
 442 ]
 443         EXCH    0,(P)           ; AND RESTORE TO STACK
 444 DONREL: EXCH    0,LCKINT        ; GET BACK SAVED 0
 445         SETZM   INTFLG          ;DISABLE
 446         AOS     -2(P)           ;INCR SAVED FLAG
 447
 448 ;NOW SAVE WORKING ACS
 449
 450         PUSHJ   P,SAVACS
 451         HLRZ    A,-2(P)         ; HACK FUNNYNESS FOR MPV/ILOPR
 452         SKIPE   A
 453         SETZM   -2(P)           ; REALLY DISABLED
 454
 455 DIRQ:   MOVE    A,PIRQ          ;NOW SATRT PROCESSING
 456         JFFO    A,FIRQ          ;COUNT BITS AND GO
 457         MOVE    A,PIRQ2         ;1ST DONE, LOOK AT 2ND
 458         JFFO    A,FIRQ2
 459
 460 INTDN1: SKIPN   GCHAPN          ; SKIP IF MUST DO GC INT
 461         JRST    .+3
 462         SETZM   GCHAPN
 463         PUSHJ   P,INTOGC        ; AND INTERRUPT
 464
 465         PUSHJ   P,RESTAC
 466
 467 IFN ITS,[
 468         .SUSET  [.SPICLR,,[0]]  ; DISABLE INTS
 469 ]
 470         POP     P,LCKINT
 471         POP     P,ONINT
 472         POP     P,INTFLG
 473         SETZM   INTHLD          ; RE-ENABLE THE WORLD
 474 IFN ITS,[
 475         EXCH    0,LCKINT
 476         HRRI    0,@0            ; EFFECTIVIZE THE ADDRESS
 477         TLZ     0,37            ; KILL IND AND INDEX
 478         EXCH    0,LCKINT
 479         .DISMIS LCKINT
 480 ]
 481 IFE ITS,[
 482         SKIPN   MULTSG
 483          JRST   @LCKINT
 484         XJRST   .+1             ; MAKE SURE OUT OF SECTION 0
 485                 0
 486                 FSEG,,.+1
 487         EXCH    0,LCKINT
 488         TLZE    0,400000
 489          ADDI   0,(M)
 490         EXCH    0,LCKINT
 491         JRST    @LCKINT
 492 ]
 493 FIRQ:   PUSHJ   P,GETBIT        ;SET UP THE BIT TO CLOBBER IN PIRQ
 494         ANDCAM  A,PIRQ          ;CLOBBER IT
 495         ADDI    B,36.           ;OFSET INTO TABLE
 496         JRST    XIRQ            ;GO EXECUTE
 497
 498 FIRQ2:  PUSHJ   P,GETBIT        ;PREPARE TO CLOBBER BIT
 499         ANDCAM  A,PIRQ2         ;CLOBBER IT
 500         ADDI    B,71.           ;AGAIN OFFSET INTO TABLE
 501 XIRQ:
 502         CAIE    B,21            ;PDL OVERFLOW?
 503         JRST    FHAND           ;YES, HACK APPROPRIATELY
 504
 505 PDL2:   JSP     E,PDL3
 506         JRST    DIRQ
 507
 508 PDL3:   SKIPN   A,PGROW
 509         SKIPE   A,TPGROW
 510         JRST    .+2
 511         JRST    (E)             ; NOTHING GROWING, FALSE ALARM
 512         MOVEI   B,PDLGRO_-6     ;GET GROWTH SPEC
 513         DPB     B,[111100,,-1(A)]       ;STORE GROWTH SPEC
 514 REAGC:  MOVE    C,[10.,,1]      ; INDICATOR FOR AGC
 515         SKIPE   PGROW           ; P IS GROWING
 516         ADDI    C,6
 517         SKIPE   TPGROW          ; TP IS GROWING
 518         ADDI    C,1
 519         PUSHJ   P,AGC           ;COLLECT GARBAGE
 520         SETZM   PGROW
 521         SETZM   TPGROW
 522         AOJL    A,REAGC         ; IF NO CORE, RETRY
 523         JRST    (E)
 524
 525 SAVACS:
 526         PUSH    P,PVP
 527         MOVE    PVP,PVSTOR+1
 528 IRP A,,[0,A,B,C,D,E,TVP,SP]
 529         PUSH    TP,A!STO(PVP)
 530         SETZM   A!STO(PVP)      ;NOW ZERO TYPE
 531         PUSH    TP,A
 532         TERMIN
 533         PUSH    TP,$TLOSE
 534         PUSH    TP,DSTORE
 535         MOVE    D,PVP
 536         POP     P,PVP
 537         PUSH    TP,PVPSTO(D)
 538         PUSH    TP,PVP
 539         SKIPE   D,DSTORE
 540         MOVEM   D,-13(TP)       ; USE AS DSTO
 541         SETZM   DSTORE
 542         POPJ    P,
 543
 544 RESTAC: POP     TP,PVP
 545         PUSH    P,PVP
 546         MOVE    PVP,PVSTOR+1
 547         POP     TP,PVPSTO(PVP)
 548         POP     TP,DSTORE
 549         SUB     TP,[1,,1]
 550 IRP A,,[SP,TVP,E,D,C,B,A,0]
 551         POP     TP,A
 552         POP     TP,A!STO(PVP)
 553         TERMIN
 554         SKIPE   DSTORE
 555         SETZM   DSTO(PVP)
 556         POP     P,PVP
 557         POPJ    P,
 558
 559 ; HERE TO DO GC INTERRUPT AND CLOSE ANY DEAD CHANNELS
 560
 561 INTOGC: PUSH    P,[N.CHNS-1]
 562         MOVE    PVP,PVSTOR+1
 563         MOVE    TVP,REALTV+1(PVP)
 564         MOVEI   A,CHNL1
 565         SUBI    A,(TVP)
 566         HRLS    A
 567         ADD     A,TVP
 568         PUSH    TP,$TVEC
 569         PUSH    TP,A
 570
 571 INTGC1: MOVE    A,(TP)          ; GET POINTER
 572         SKIPN   B,1(A)          ; ANY CHANNEL?
 573         JRST    INTGC2
 574         HRRE    0,(A)           ; INDICATOR
 575         JUMPGE  0,INTGC2
 576         PUSH    TP,$TCHAN
 577         PUSH    TP,B
 578         MCALL   1,FCLOSE
 579
 580         MOVE    A,(TP)
 581
 582 INTGC2: HLLZS   (A)
 583         ADD     A,[2,,2]
 584         MOVEM   A,(TP)
 585         SOSE    (P)
 586         JRST    INTGC1
 587
 588         SUB     P,[1,,1]
 589         SUB     TP,[2,,2]
 590         PUSH    TP,$TCHSTR
 591         PUSH    TP,CHQUOTE GC
 592         PUSH    TP,$TFLOAT      ; PUSH  ON TIME ARGUMENT
 593         PUSH    TP,GCTIM
 594         PUSH    TP,$TFIX        ; PUSH ON THE CAUSE ARGUMENT
 595         PUSH    TP,GCCAUS
 596         PUSH    TP,$TATOM       ; PUSH ON THE CALL ARGUMENT
 597         MOVE    A,GCCALL
 598         PUSH    TP,@GCALLR(A)
 599         MCALL   4,INTERR
 600         POPJ    P,
 601
 602 ; PRE AGC INTERRUPT. CAUSED WHEN FREE STORAGE REQUEST CAN BE SATISFIED BY
 603 ; EXTENDING CORE. IT IS CALLED "AGC" AND THE HANDLER IS PASSED THE CALLER,
 604 ; AND THE PENDING REQUEST.
 605
 606
 607 INTAGC: MOVE    A,GETNUM
 608         MOVEM   A,GCKNUM                ; SET UP TO CAUSE INTERRUPT
 609         PUSH    P,C             ; SAVE ARGS TO GC
 610         MOVEI   A,2000          ; GET WORKING SPACE
 611         PUSHJ   P,INTCOR        ; GET IT
 612         MOVSI   A,TATOM         ; EXAMINE BINDING OF FLAG
 613         MOVE    B,IMQUOTE AGC-FLAG
 614         PUSHJ   P,ILVAL
 615         CAME    A,$TUNBOUND
 616         JRST    INAGCO          ; JUMP TO GET CORE FOR INTERRUPT
 617         MOVE    A,GETNUM
 618         ADD     A,P.TOP         ; SEE IF WE CAN POSSIBLY WIN
 619         ADD     A,FREMIN
 620         CAML    A,PURBOT
 621         JRST    AGCCAU          ; WORLD IS IN BAD SHAPE, CALL AGC
 622         PUSH    TP,$TTP         ; BIND FLAG
 623         PUSH    TP,TP           ; FOR UNBINDING PURPOSES
 624         PUSH    TP,[TATOM,,-1]  ; SPECBINDS ARGS
 625         PUSH    TP,IMQUOTE AGC-FLAG
 626         PUSH    TP,$TFIX
 627         PUSH    TP,[-1]
 628         PUSH    TP,[0]
 629         PUSH    TP,[0]
 630         PUSHJ   P,SPECBIND
 631
 632 ; SET UP CALL TO HANDLER
 633
 634         PUSH    TP,$TCHSTR      ; STRING INDICATING INTERRUPT
 635         PUSH    TP,CHQUOTE DIVERT-AGC
 636         PUSH    TP,$TFIX        ; PENDING REQUEST
 637         PUSH    TP,GETNUM
 638         HLRZ    C,(P)
 639         PUSH    TP,$TATOM
 640         PUSH    TP,@GCALLR(C)
 641         SETZM   GCHPN
 642         MCALL   3,INTERR        ; ENABLE INTERRUPT
 643         GETYP   A,A             ; CHECK TO SEE IF INTERRUPT WAS ENABLED
 644         HRRZ    E,-6(TP)        ; GET ARG FOR UNBINDING
 645         PUSHJ   P,SSPEC1
 646         SUB     TP,[8,,8]       ; CLEAN OFF STACK
 647         CAIE    A,TFALSE        ; SKIP IF NOT
 648         JRST    CHKWIN
 649
 650 ; CAUSE AN AGC TO HAPPEN
 651
 652 AGCCAU: MOVE    C,(P)           ; INDICATOR
 653         PUSHJ   P,SAGC          ; CALL AGC
 654         JRST    FINAGC
 655
 656 ; SEE WHETHER ENOUGH CORE WAS ALLOCATED
 657 CHKWIN: MOVE    A,FRETOP
 658         SUB     A,GCSTOP
 659         SUB     A,GCKNUM        ; AMOUNT NEEDED OR IN EXCESS
 660         JUMPGE  A,FINAGC        ; JUMP IF DONE
 661         MOVE    A,GCKNUM
 662         MOVEM   A,GETNUM        ; SET UP REQUEST
 663         MOVE    C,(P)
 664         JRST    AGCCAU
 665 FINAGC: SETZM   GETNUM
 666         POP     P,C             ; RESTORE C
 667         POPJ    P,              ; EXIT
 668
 669 ; ROUTINE TO  HANDLE INTERRUPT WHILE INTERRUPT IS RUNNING
 670 ; IT TRIES TO ALLOCATE FOR REQUEST+ AT LEAST ONE CORE BLOCK
 671
 672 INAGCO: MOVE    A,GETNUM                ; GET REQUEST
 673         SUB     A,GCKNUM        ; CALCULATE REAL CURRENT REQUEST
 674         ADDI    A,1777
 675         ANDCMI  A,1777  ; AMOUNT WANTED
 676         PUSHJ   P,INTCOR        ; GET IT
 677         POP     P,C             ; RESTORE C
 678         POPJ    P,              ; EXIT
 679
 680 ; ROUTINE TO GET CORE FOR PRE-AGC INTERRUPT.  REQUEST IN A
 681
 682
 683 INTCOR: ADD     A,P.TOP         ; ADD TOP TO REQUEST
 684         CAML    A,PURBOT        ; SKIP IF BELOW PURE
 685         JRST    AGCCA1          ; LOSE
 686         MOVEM   A,CORTOP        ; STORE POSSIBLE CORE TOP
 687         ASH     A,-10.          ; TO PAGES
 688         PUSHJ   P,P.CORE        ; GET THE CORE
 689         JRST    AGCCA1          ; LOSE,LOSE,LOSE
 690         PUSH    P,B
 691         MOVE    B,FRETOP
 692         SUBI    B,2000
 693         MOVE    A,FRETOP
 694         SETZM   (B)
 695         HRLI    B,(B)
 696         ADDI    B,1
 697         BLT     B,-1(A)
 698         POP     P,B
 699         MOVEM   A,FRETOP
 700         POPJ    P,              ; EXIT
 701 AGCCA1: MOVE    C,-1(P)         ; GET ARGS FOR AGC
 702         SUB     P,[1,,1]        ; FLUSH RETURN ADDRESS
 703         JRST    AGCCAU+1
 704
 705
 706
 707 GCALLR: MQUOTE GC-READ
 708         MQUOTE BLOAT
 709         MQUOTE GROW
 710         IMQUOTE LIST
 711         IMQUOTE VECTOR
 712         IMQUOTE SET
 713         IMQUOTE SETG
 714         MQUOTE FREEZE
 715         MQUOTE PURE-PAGE-LOADER
 716         MQUOTE GC
 717         MQUOTE INTERRUPT-HANDLER
 718         MQUOTE NEWTYPE
 719         MQUOTE PURIFY
 720
 721 \f; OLD "ON"  SETS UP EVENT AND HANDLER
 722
 723 MFUNCTION ON,SUBR
 724
 725         ENTRY
 726
 727         HLRE    0,AB            ; 0=> -2*NUM OF ARGS
 728         ASH     0,-1            ; TO -NUM
 729         CAME    0,[-5]
 730         JRST    .+3
 731         MOVEI   B,10(AB)        ; LAST MUST BE CHAN OR LOC
 732         PUSHJ   P,CHNORL
 733         ADDI    0,3
 734         JUMPG   0,TFA           ; AT LEAST 3
 735         MOVEI   A,0             ; SET UP IN CASE NO PROC
 736         AOJG    0,ONPROC        ; JUMP IF NONE
 737         GETYP   C,6(AB)         ; CHECK IT
 738         CAIE    C,TPVP
 739         JRST    TRYFIX
 740         MOVE    A,7(AB)         ; GET IT
 741 ONPROC: PUSH    P,A             ; SAVE AS A FLAG
 742         GETYP   A,(AB)          ; CHECK PREV EXISTANCE
 743         PUSH    P,0
 744         CAIN    A,TATOM
 745         JRST    .+3
 746         CAIE    A,TCHSTR
 747         JRST    WTYP1
 748         MOVEI   B,(AB)          ; FIND IT
 749         PUSHJ   P,FNDINT
 750         POP     P,0             ; REST NUM OF ARGS
 751         JUMPN   B,ON3           ; ALREADY THERE
 752         SKIPE   C               ; SKIP IF NOTHING TO FLUSH
 753         SUB     TP,[2,,2]
 754         PUSH    TP,(AB)         ; GET NAME
 755         PUSH    TP,1(AB)
 756         PUSH    TP,4(AB)
 757         PUSH    TP,5(AB)
 758         MOVEI   A,2             ; # OF ARGS TO EVENT
 759         AOJG    0,ON1           ; JUMP IF NO LAST ARG
 760         PUSH    TP,10(AB)
 761         PUSH    TP,11(AB)
 762         ADDI    A,1
 763 ON1:    ACALL   A,EVENT
 764
 765 ON3:    PUSH    TP,A
 766         PUSH    TP,B
 767         PUSH    TP,2(AB)        ; NOW FCN
 768         PUSH    TP,3(AB)
 769         MOVEI   A,3             ; NUM OF ARGS
 770         SKIPN   (P)
 771         SOJA    A,ON2           ; NO PROC
 772         PUSH    TP,$TPVP
 773         PUSH    TP,7(AB)
 774 ON2:    ACALL   A,HANDLER
 775         JRST    FINIS
 776
 777
 778 TRYFIX: SKIPN   A,7(AB)
 779         CAIE    C,TFIX
 780         JRST    WRONGT
 781         JRST    ONPROC
 782 \f
 783 ; ROUTINE TO BUILD AN EVENT
 784
 785 MFUNCTION EVENT,SUBR
 786
 787         ENTRY
 788
 789         HLRZ    0,AB
 790         CAIN    0,-2            ; IF JUST 1
 791         JRST    RE.EVN          ; COULD BE EVENT
 792         CAIL    0,-3            ; MUST BE AT LEAST 2 ARGS
 793         JRST    TFA
 794         GETYP   A,2(AB)         ; 2ND ARG MUST BE FIXED POINT PRIORITY
 795         CAIE    A,TFIX
 796         JRST    WTYP2
 797         GETYP   A,(AB)          ; FIRST ARG SHOULD BE CHSTR
 798         CAIN    A,TATOM         ; ALLOW ACTUAL ATOM
 799         JRST    .+3
 800         CAIE    A,TCHSTR
 801         JRST    WTYP1
 802         CAIL    0,-5
 803         JRST    GOTRGS
 804         CAIG    0,-7
 805         JRST    TMA
 806         MOVEI   B,4(AB)
 807         PUSHJ   P,CHNORL        ; CHANNEL OR LOCATIVE (PUT ON STACK)
 808
 809 GOTRGS: MOVEI   B,(AB)          ; NOW TRY TO FIND HEADER FOR THIS INTERRUPT
 810         PUSHJ   P,FNDINT        ; CALL INTERNAL HACKER
 811         JUMPN   B,FINIS         ; ALREADY ONE OF THIS NAME
 812         PUSH    P,C
 813         JUMPE   C,.+3           ; GET IT OFF STACK
 814         POP     TP,B
 815         POP     TP,A
 816         PUSHJ   P,MAKINT        ; MAKE ONE FOR ME
 817         MOVSI   0,TFIX
 818         MOVEM   0,INTPRI(B)     ; SET UP PRIORITY
 819         MOVE    0,3(AB)
 820         MOVEM   0,INTPRI+1(B)
 821 CH.SPC: POP     P,C             ; GET CODE BACK
 822         SKIPGE  C
 823         PUSHJ   P,DO.SPC        ; DO ANY SPECIAL HACKS
 824         JRST    FINIS
 825
 826 RE.EVN: GETYP   0,(AB)
 827         CAIE    0,TINTH
 828         JRST    TFA             ; ELSE SAY NOT ENOUGH
 829         MOVE    B,1(AB)         ; GET IT
 830         SETZM   ISTATE+1(B)     ; MAKE SURE ENABLED
 831         SETZB   D,C
 832         GETYP   A,INAME(B)      ; CHECK FOR CHANNEL
 833         CAIN    A,TCHAN         ; SKIP IF NOT
 834         HRROI   C,SS.CHA        ; SET UP CHANNEL HACK
 835         HRLZ    E,INTPRI(B)     ; GET POSSIBLE READ/WRITE BITS
 836         TLNE    E,.WRMON+.RDMON ; SKIP IF NOT MONITORS
 837         PUSHJ   P,GETNM1
 838         JUMPL   C,RE.EV1
 839         MOVE    B,INAME+1(B)    ; CHECK FOR SPEC
 840         PUSHJ   P,SPEC1
 841         MOVE    B,1(AB)         ; RESTORE IHEADER
 842 RE.EV1: PUSH    TP,INAME(B)
 843         PUSH    TP,INAME+1(B)
 844         PUSH    P,C
 845         MOVSI   C,TATOM
 846         PUSH    TP,$TATOM
 847         SKIPN   D
 848         MOVE    D,MQUOTE INTERRUPT
 849         PUSH    TP,D
 850         MOVE    A,INAME(B)
 851         MOVE    B,INAME+1(B)    ; GET IT
 852         PUSHJ   P,IGET          ; LOOK FOR IT
 853         JUMPN   B,FINIS         ; RETURN IT
 854         MOVE    A,(TB)
 855         MOVE    B,1(TB)
 856         POP     TP,D
 857         POP     TP,C
 858         PUSH    TP,(AB)
 859         PUSH    TP,1(AB)
 860         PUSHJ   P,IPUT          ; REESTABLISH IT
 861         MOVE    A,(AB)
 862         MOVE    B,1(AB)
 863         JRST    CH.SPC
 864
 865 \f
 866 ; FUNCTION TO GENERATE A HANDLER FOR A GIVEN INTERRUPT
 867
 868 MFUNCTION HANDLER,SUBR
 869
 870         ENTRY
 871
 872         HLRZ    0,AB
 873         CAIL    0,-2            ; MUST BE 2 OR MORE ARGS
 874         JRST    TFA
 875         GETYP   A,(AB)
 876         CAIE    A,TINTH         ; EVENT?
 877         JRST    WTYP1
 878         GETYP   A,2(AB)
 879         CAIN    0,-4            ; IF EXACTLY 2
 880         CAIE    A,THAND         ; COULD BE HANDLER
 881         JRST    CHEVNT
 882
 883         MOVE    B,3(AB)         ; GET IT
 884         SKIPN   IPREV+1(B)      ; SKIP IF ALREADY IN USE
 885         JRST    HNDOK
 886         MOVE    D,1(AB)         ; GET EVENT
 887         SKIPN   D,IHNDLR+1(D)   ; GET FIRST HANDLER
 888         JRST    BADHND
 889         CAMN    D,B             ; IS THIS IT?
 890         JRST    HFINIS          ; YES, ALREADY "HANDLED"
 891         MOVE    D,INXT+1(D)     ; GO TO NEXT HANDLER
 892         JUMPN   D,.-3
 893 BADHND: ERRUUO  EQUOTE HANDLER-ALREADY-IN-USE
 894
 895 CHEVNT: CAIG    0,-7            ; SKIP IF LESS THAN 4
 896         JRST    TMA
 897         PUSH    TP,$TPVP                ; SLOT FOR PROCESS
 898         PUSH    TP,[0]
 899         CAIE    0,-6            ; IF 3, LOOK FOR PROC
 900         JRST    NOPROC
 901         GETYP   0,4(AB)
 902         CAIE    0,TPVP
 903         JRST    WTYP3
 904         MOVE    0,5(AB)
 905         MOVEM   0,(TP)
 906
 907 NOPROC: PUSHJ   P,APLQ
 908         JRST    NAPT
 909         PUSHJ   P,MHAND         ; MAKE THE HANDLER
 910         MOVE    0,1(TB)         ; GET PROCESS
 911         MOVEM   0,INTPRO+1(B)   ; AND PUT IT INTO HANDLER
 912         MOVSI   0,TPVP          ; SET UP TYPE
 913         MOVEM   0,INTPRO(B)
 914         MOVE    0,2(AB)         ; SET UP FUNCTION
 915         MOVEM   0,INTFCN(B)
 916         MOVE    0,3(AB)
 917         MOVEM   0,INTFCN+1(B)
 918
 919 HNDOK:  MOVE    D,1(AB)         ; PICK UP EVEENT
 920         MOVE    E,IHNDLR+1(D)   ; GET POINTER TO HANDLERS
 921         MOVEM   B,IHNDLR+1(D)   ; PUT NEW ONE IN
 922         MOVSI   0,TINTH         ; GET INT HDR TYPE
 923         MOVEM   0,IPREV(B)      ; INTO BACK POINTER
 924         MOVEM   D,IPREV+1(B)    ; AND POINTER ITSELF
 925         MOVEM   E,INXT+1(B)     ; NOW NEXT POINTER
 926         MOVSI   0,THAND         ; NOW HANDLER TYPE
 927         MOVEM   0,IHNDLR(D)     ; SET TYPE IN HEADER
 928         MOVEM   0,INXT(B)
 929         JUMPE   E,HFINIS        ; JUMP IF HEADER WAS EMPTY
 930         MOVEM   0,IPREV(E)      ; FIX UP ITS PREV
 931         MOVEM   B,IPREV+1(E)
 932 HFINIS: MOVSI   A,THAND
 933         JRST    FINIS
 934
 935 \f
 936
 937 ; FUNCTIONS TO SET TIME LIMITS FOR REALTIME AND RUNTIME INTS
 938
 939 IFN ITS,[
 940
 941 MFUNCTION RUNTIMER,SUBR
 942
 943         ENTRY
 944
 945         CAMG    AB,[-3,,0]
 946          JRST   TMA
 947         JUMPGE  AB,RNTLFT
 948         GETYP   0,(AB)
 949         JFCL    10,.+1
 950         MOVE    A,1(AB)
 951         CAIE    0,TFIX
 952         JRST    RUNT1
 953         IMUL    A,[245761.]
 954         JRST    RUNT2
 955
 956 RUNT1:  CAIE    0,TFLOAT
 957         JRST    WTYP1
 958         FMPR    A,[245760.62]
 959         MULI    A,400           ; FIX IT
 960         TSC     A,A
 961         ASH     B,(A)-243
 962         MOVE    A,B
 963 RUNT2:  JUMPL   A,OUTRNG        ; NOT FOR NEG #
 964         JFCL    10,OUTRNG
 965         .SUSET  [.SRTMR,,A]
 966         MOVE    A,(AB)
 967         MOVE    B,1(AB)
 968         JRST    FINIS
 969 RNTLFT: .SUSET  [.RRTMR,,B]
 970         JUMPL   B,IFALSE        ; RETURN FALSE IF NONE SET
 971         IDIV    B,[245761.]     ; TO SECONDS
 972         MOVSI   A,TFIX
 973         JRST    FINIS
 974
 975 ]
 976 .TIMAL==5
 977 .TIMEL==1
 978
 979 MFUNCTION REALTIMER,SUBR
 980
 981         ENTRY
 982
 983         CAMG    AB,[-3,,0]
 984          JRST   TMA
 985         JUMPGE  AB,RLTPER
 986         JFCL    10,.+1
 987         GETYP   0,(AB)
 988         MOVE    A,1(AB)
 989         CAIE    0,TFIX
 990         JRST    REALT1
 991 IFN ITS,        IMULI   A,60.   ; TO 60THS OF SEC
 992 IFE ITS,        IMULI   A,1000. ; TO MILLI
 993         JRST    REALT2
 994
 995 REALT1: CAIE    0,TFLOAT
 996         JRST    WTYP1
 997 IFN ITS,        FMPRI   A,(60.0)
 998 IFE ITS,        FMPRI   A,(1000.0)
 999         MULI    A,400
1000         TSC     A,A
1001         ASH     B,(A)-243
1002         MOVE    A,B
1003
1004 REALT2: JUMPL   A,OUTRNG
1005         JFCL    10,OUTRNG
1006         MOVEM   A,RLTSAV
1007 IFN ITS,[
1008         MOVE    B,[200000,,A]
1009         SKIPN   A
1010         MOVSI   B,400000
1011         .REALT  B,
1012         JFCL
1013 ]
1014 IFE ITS,[
1015         MOVE    A,[MFORK,,.TIMAL]       ; FLUSH CURRENT FIRST
1016         TIMER
1017          JRST   TIMERR
1018         SKIPN   B,RLTSAV
1019          JRST   RETRLT
1020         HRRI    A,.TIMEL
1021         MOVEI   C,RLCHN
1022         TIMER
1023          JRST   TIMERR
1024 RETRLT: MOVE    A,(AB)
1025         MOVE    B,1(AB)
1026         JRST    FINIS
1027
1028 TIMERR: MOVNI   A,1
1029         PUSHJ   P,TGFALS
1030         JRST    FINIS
1031
1032 RLTPER: SKIPGE  B,RLTSAV
1033          JRST   IFALSE
1034 IFN ITS,        IDIVI   B,60.           ; BACK TO SECONDS
1035 IFE ITS,        IDIVI   B,1000.
1036         MOVSI   A,TFIX
1037         JRST    FINIS
1038
1039
1040 ; FUNCTIONS TO ENABLE AND DISABLE INTERRUPTS
1041
1042 MFUNCTION %ENABL,SUBR,ENABLE
1043
1044         PUSHJ   P,GTEVNT
1045         SETZM   ISTATE+1(B)
1046         JRST    FINIS
1047
1048 MFUNCTION %DISABL,SUBR,DISABLE
1049
1050
1051         PUSHJ   P,GTEVNT
1052         SETOM   ISTATE+1(B)
1053         JRST    FINIS
1054
1055 GTEVNT: ENTRY   1
1056         GETYP   0,(AB)
1057         CAIE    0,TINTH
1058         JRST    WTYP1
1059         MOVE    A,(AB)
1060         MOVE    B,1(AB)
1061         POPJ    P,
1062
1063 DO.SPC: HRRO    C,INTBL(C)      ; POINT TO SPECIAL CODE
1064         HLRZ    0,AB            ; - TWO TIMES NUM ARGS
1065         PUSHJ   P,(C)           ; CALL ROUTINE
1066         JUMPE   E,CPOPJ         ; NO BITS TO ENABLE, LEAVE
1067 IFE ITS,[
1068         PUSH    TP,A
1069         PUSH    TP,B
1070         MOVE    B,1(TB)         ; CHANNEL
1071         MOVE    0,CHANNO(B)
1072         MOVEM   0,(E)           ; SAVE IN TABLE
1073         MOVEI   E,(E)
1074         SUBI    E,NETJFN-NETCHN
1075         MOVE    A,0             ; SETUP FOR MTOPR
1076         MOVEI   B,24
1077         MOVSI   C,(E)
1078         TLO     C,770000        ; DONT SETUP INR/INS
1079         MTOPR
1080         MOVEI   0,1
1081         MOVNS   E
1082         LSH     0,35.(E)
1083         IORM    0,MASK1
1084         MOVE    B,MASK1
1085         MOVEI   A,MFORK
1086         AIC
1087
1088         POP     TP,B
1089         POP     TP,A
1090         POPJ    P,              ; ***** TEMP ******
1091 ]
1092 IFN ITS,[
1093         CAILE   E,35.           ; SKIP IF 1ST WORD BIT
1094         JRST    SETW2
1095         LSH     0,-1(E)
1096
1097         IORM    0,MASK1         ; STORE IN PROTOTYPE MASK
1098         .SUSET  [.SMASK,,MASK1]
1099         POPJ    P,
1100
1101 SETW2:  LSH     0,-36.(E)
1102         IORM    0,MASK2         ; SET UP PROTO MASK2
1103         .SUSET  [.SMSK2,,MASK2]
1104         POPJ    P,
1105 ]
1106
1107 ; ROUTINE TO CHECK FOR CHANNEL OR LOCATIVE
1108
1109 CHNORL: GETYP   A,(B)           ; GET TYPE
1110         CAIN    A,TCHAN         ; IF CHANNEL
1111         JRST    CHNWIN
1112         PUSH    P,0
1113         PUSHJ   P,LOCQ          ; ELSE LOOCATIVE
1114         JRST    WRONGT
1115         POP     P,0
1116 CHNWIN: PUSH    TP,(B)
1117         PUSH    TP,1(B)
1118         POPJ    P,
1119 \f
1120 ; SUBROUTINE TO FIND A HANDLER OF A GIVEN NAME
1121
1122 FNDINT: PUSHJ   P,FNDNM
1123         JUMPE   B,CPOPJ
1124         PUSHJ   P,SPEC1         ; COULD BE FUNNY
1125
1126 INTASO: PUSH    P,C             ; C<0 IF SPECIAL
1127         PUSH    TP,A
1128         PUSH    TP,B
1129         MOVSI   C,TATOM
1130         SKIPN   D               ; COULD BE CHANGED FOR MONITOR
1131         MOVE    D,MQUOTE INTERRUPT
1132         PUSH    TP,C
1133         PUSH    TP,D
1134         PUSHJ   P,IGET
1135         MOVE    D,(TP)
1136         SUB     TP,[2,,2]
1137         POP     P,C             ; AND RESTOR SPECIAL INDICATOR
1138         SKIPE   B               ; IF FOUND
1139         SUB     TP,[2,,2]       ; REMOVE CRUFT
1140 CPOPJ:  POPJ    P,              ; AND RETURN
1141
1142 ; CHECK FOR SPECIAL INTERNAL INTERRUPT HACK
1143
1144 SPEC1:  MOVSI   C,-SPECLN       ; BUILD AOBJN PNTR
1145 SPCLOP: CAME    B,@SPECIN(C)    ; SKIP IF SPECIAL
1146         AOBJN   C,.-1           ; UNTIL EXHAUSTED
1147         JUMPGE  C,.+3
1148         SKIPE   E,FNDTBL(C)
1149         JRST    (E)
1150         MOVEI   0,-1(TB)        ; SEE IF OK
1151         CAIE    0,(TP)
1152         JRST    TMA
1153         POPJ    P,
1154
1155 ; ROUTINE TO CREATE A NEW INTERRUPT (INTERNAL ONLY--NOT ITS FLAVOR)
1156
1157 MAKINT: JUMPN   C,GOTATM        ; ALREADY HAVE NAME, GET THING
1158         MOVEI   B,(AB)          ; POINT TO STRING
1159         PUSHJ   P,CSTAK         ; CHARS TO STAKC
1160         MOVE    B,INTOBL+1
1161         PUSHJ   P,INSRTX
1162         MOVE    D,MQUOTE INTERRUPT
1163 GOTATM: PUSH    TP,$TINTH       ; MAKE SLOT FOR HEADER BLOCK
1164         PUSH    TP,[0]
1165         PUSH    TP,A
1166         PUSH    TP,B            ; SAVE ATOM
1167         PUSH    TP,$TATOM
1168         PUSH    TP,D
1169         MOVEI   A,IHDRLN*2
1170         PUSHJ   P,GIBLOK
1171         MOVE    A,-3(TP)                ; GET NAME AND STORE SAME
1172         MOVEM   A,INAME(B)
1173         MOVE    A,-2(TP)
1174         MOVEM   A,INAME+1(B)
1175         SETZM   ISTATE+1(B)
1176         MOVEM   B,-4(TP)        ; STASH HEADER
1177         POP     TP,D
1178         POP     TP,C
1179         EXCH    B,(TP)
1180         MOVSI   A,TINTH
1181         EXCH    A,-1(TP)        ; INTERNAL PUT CALL
1182         PUSHJ   P,IPUT
1183         POP     TP,B
1184         POP     TP,A
1185         POPJ    P,
1186
1187 ; FIND NAME OF INTERRUPT
1188
1189 FNDNM:  GETYP   A,(B)           ; TYPE
1190         CAIE    A,TCHSTR        ; IF STRING
1191         JRST    FNDATM          ; DONT HAVE ATOM, OTHERWISE DO
1192         PUSHJ   P,IILOOK
1193         JRST    .+2
1194 FNDATM: MOVE    B,1(B)
1195         SETZB   C,D             ; PREVENT LOSSAGE LATER
1196         MOVSI   A,TATOM
1197
1198 ; THE NEXT 2 INSTRUCTIONS ARE A KLUDGE TO GET THE RIGHT ERROR ATOM
1199
1200         CAMN    B,IMQUOTE ERROR
1201         MOVE    B,MQUOTE ERROR,ERROR,INTRUP
1202         POPJ    P,
1203
1204 IILOOK: PUSHJ   P,CSTAK         ; PUT CHRS ON STACK
1205         MOVSI   A,TOBLS
1206         MOVE    B,INTOBL+1
1207         JRST    ILOOKC  ; LOOK IT UP
1208 \f
1209 ; ROUTINE TO MAKE A HANDLER BLOCK
1210
1211 MHAND:  MOVEI   A,IHANDL*2
1212         JRST    GIBLOK          ; GET BLOCK
1213
1214 ; HERE TO GET CHANNEL FOR "CHAR" INTERRUPT
1215
1216 GETCHN: GETYP   0,(TB)          ; GET TYPE
1217         CAIE    0,TCHAN         ; CHANNL IS WINNER
1218         JRST    WRONGT
1219         MOVE    A,(TB)          ; USE THE CHANNEL TO NAME THE INTERRUPT
1220         MOVE    B,1(TB)
1221         SKIPN   CHANNO(B)       ; SKIP IF WINNING CHANNEL
1222         JRST    CBDCHN          ; LOSER
1223         POPJ    P,
1224
1225 LOCGET: GETYP   0,(TB)          ; TYPE
1226         CAIN    0,TCHAN         ; SKIP IF LOCATIVE
1227         JRST    WRONGT
1228         MOVE    D,B
1229         MOVE    A,(TB)
1230         MOVE    B,1(TB)         ; GET LOCATIVE
1231         POPJ    P,
1232
1233 ; FINAL MONITOR SETUP ROUTINES
1234
1235 S.RMON: SKIPA   E,[.RDMON,,]
1236 S.WMON: MOVSI   E,.WRMON
1237         PUSH    TP,A
1238         PUSH    TP,B
1239         HLRM    E,INTPRI(B)     ; SAVE BITS
1240         MOVEI   B,(TB)          ; POINT TO LOCATIVE
1241         HRRZ    A,FSAV(TB)
1242         CAIN    A,OFF
1243         MOVSI   D,(ANDCAM E,)   ; KILL INST
1244         CAIN    A,EVENT
1245         MOVSI   D,(IORM E,)
1246         PUSHJ   P,SMON          ; GO DO IT
1247         POP     TP,B
1248         POP     TP,A
1249         MOVEI   E,0
1250         POPJ    P,
1251 \f
1252
1253 ; SPECIAL SETUP ROUTINES FOR INITIAL INTERRUPTS
1254
1255 IFN ITS,[
1256 S.CHAR: MOVE    E,1(TB)         ; GET CHANNEL
1257         MOVE    0,RDEVIC(E)
1258         ILDB    0,0             ; 1ST CHAR TO 0
1259         CAIE    0,"T            ; TTY
1260         JRST    .+3             ; NO
1261         MOVEI   0,C.INTL
1262         XORM    0,-2(E)         ; IN CASE OUTPUT
1263         MOVE    E,CHANNO(E)
1264         ADDI    E,36.           ; GET CORRECT MASK BIT
1265 ONEBIT: MOVEI   0,1             ; BIT FOR INT TO RET
1266         POPJ    P,
1267 ]
1268 IFE ITS,[
1269 S.CHAR: MOVE    E,1(TB)
1270         MOVEI   0,C.INTL
1271         XORM    0,-2(E)         ; IN CASE OUTPUT
1272         MOVE    0,RDEVIC(E)
1273         ILDB    0,0             ; 1ST CHAR
1274         PUSH    P,A
1275         CAIE    0,"N            ; NET ?
1276         JRST    S.CHA1
1277
1278         MOVEI   A,0
1279         HRRZ    0,CHANNO(E)
1280         MOVE    E,[-NNETS,,NETJFN]
1281         CAMN    0,(E)
1282         JRST    S.CHA2
1283         SKIPN   (E)
1284         MOVE    A,E             ; REMEMBER WHERE
1285         AOBJN   E,.-4
1286         TLNN    A,-1
1287         FATAL   NO MORE NETWORK
1288         SKIPA   E,A
1289 S.CHA1: MOVEI   E,0
1290 S.CHA2: POP     P,A
1291         POPJ    P,
1292 ]
1293
1294
1295 ; SPECIAL FOR CLOCK
1296 IFN ITS,[
1297 S.DOWN: SKIPA   E,[7]
1298 S.CLOK: MOVEI   E,13.           ; FOR NOW JUST GET BIT #
1299         JRST    ONEBIT
1300
1301 S.PAR:  MOVEI   E,28.
1302         JRST    ONEBIT
1303
1304 ; RUNTIME AND REALTIME INTERRUPTS
1305
1306 S.RUNT: SKIPA   E,[34.]
1307 S.REAL: MOVEI   E,35.
1308         JRST    ONEBIT
1309
1310 S.IOC:  SKIPA   E,[9.]          ; IO CHANNEL ERROR
1311 S.PURE: MOVEI   E,26.
1312         JRST    ONEBIT
1313
1314 ; MPV AND ILOPR
1315
1316 S.MPV:  SKIPA   E,[14.]         ; BIT POS
1317 S.ILOP: MOVEI   E,6
1318         JRST    ONEBIT
1319
1320 ; HERE TO TURN ALL INFERIOR INTS
1321
1322 S.INF:  MOVEI   E,36.+16.+2     ; START OF BITS
1323         MOVEI   0,37            ; 8 BITS WORTH
1324         POPJ    P,
1325 ]
1326 IFE ITS,[
1327 S.PURE:
1328 S.MPV:
1329 S.ILOP:
1330 S.DOWN:
1331 S.CLOK:
1332 S.PAR:
1333
1334
1335 S.RUNT: ERRUUO  EQUOTE INTERRUPT-UNAVAILABLE-ON-TENEX
1336 S.IOC:  MOVEI   0,7             ; 3 BITS FOR EOF/FULL/ERROR
1337         MOVEI   E,10.
1338         POPJ    P,
1339
1340 S.INF:
1341 S.REAL: MOVEI   E,0
1342         POPJ    P,
1343 ]
1344
1345
1346 ; HERE TO HANDLE ITS INTERRUPTS
1347
1348 FHAND:  SKIPN   D,EXTINT(B)     ; SKIP IF HANDLERS ARE POSSIBLE
1349         JRST    DIRQ
1350         JRST    (D)
1351
1352 IFN ITS,[
1353 ; SPECIAL CHARACTER HANDLERS
1354
1355 HCHAR:  MOVEI   D,CHNL0+1
1356         ADDI    D,(B)           ; POINT TO CHANNEL SLOT
1357         ADDI    D,(B)
1358         SKIPN   D,-72.(D)       ; PICK UP CHANNEL
1359         JRST    IPCGOT          ;WELL, IT GOTTA BEE THE THE IPC THEN
1360         PUSH    TP,$TCHAN
1361         PUSH    TP,D
1362         LDB     0,[600,,STATUS(D)]      ; GET DEVICE CODE
1363         CAILE   0,2             ; SKIP IF A TTY
1364         JRST    HNET            ; MAYBE NETWORK CHANNEL
1365         HRRZ    0,-2(D)
1366         TRNN    0,C.READ
1367         JRST    HMORE
1368         CAMN    D,TTICHN+1
1369         SKIPE   DEMFLG          ; SKIP IF NOT DEMON
1370         JRST    .+3
1371         SKIPN   NOTTY
1372         JRST    HCHR11
1373         MOVE    B,D             ; CHAN TO B
1374         PUSH    P,A
1375         PUSHJ   P,TTYOP2        ; RE-GOBBLE TTY
1376         POP     P,A
1377         MOVE    D,(TP)
1378 HCHR11: MOVE    D,CHANNO(D)     ; GET ITS CHANNEL
1379         PUSH    P,D             ; AND SAVE IT
1380         .CALL   HOWMNY          ; GET # OF CHARS
1381         MOVEI   B,0             ; IF TTY GONE, NO CHARS
1382 RECHR:  ADDI    B,1             ; BUMP BY ONE FOR SOSG
1383         MOVEM   B,CHNCNT(D)     ; AND SAVE
1384         IORM    A,PIRQ2         ; LEAVE THE INT ON
1385
1386 CHRLOO: MOVE    D,(P)           ; GET CHNNAEL NO.
1387         SOSG    CHNCNT(D)       ; GET COUNT
1388         JRST    CHRDON
1389
1390         MOVE    B,(TP)
1391         MOVE    D,BUFRIN(B)     ; GET EXTRA BUFFER
1392         XCT     IOIN2(D)        ; READ CHAR
1393         JUMPL   A,CHRDON        ; NO CHAR THERE, FORGET IT
1394         PUSH    TP,$TCHSTR
1395         PUSH    TP,CHQUOTE CHAR
1396         PUSH    TP,$TCHRS       ; SAVE CHAR FOR CALL
1397         PUSH    TP,A
1398         PUSH    TP,$TCHAN       ; SAVE CHANNEL
1399         PUSH    TP,B
1400         PUSHJ   P,INCHAR        ; PUT CHAR IN USERS BUFFER
1401         MCALL   3,INTERRUPT     ; RUN THE HANDLERS
1402         JRST    CHRLOO          ; AND LOOP
1403
1404 CHRDON: .CALL   HOWMNY
1405         MOVEI   B,0
1406         MOVEI   A,1             ; SET FOR PI WORD CLOBBER
1407         LSH     A,(D)
1408         JUMPG   B,RECHR         ; ANY MORE?
1409         ANDCAM  A,PIRQ2
1410         SUB     P,[1,,1]
1411         SUB     TP,[2,,2]
1412         JRST    DIRQ
1413
1414
1415 \f
1416 ; HERE FOR NET CHANNEL INTERRUPT
1417
1418 HNET:   CAIE    0,26            ; NETWORK?
1419         JRST    HSTYET          ; HANDLE PSEUDO TTY ETC.
1420         PUSH    TP,$TATOM
1421         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP
1422         PUSH    TP,$TUVEC
1423         PUSH    TP,BUFRIN(D)
1424         PUSH    TP,$TCHAN
1425         PUSH    TP,D
1426         MOVE    B,D             ; CHAN TO B
1427         PUSHJ   P,INSTAT        ; UPDATE THE NETWRK STATE
1428         MCALL   3,INTERRUPT
1429         SUB     TP,[2,,2]
1430         JRST    DIRQ
1431
1432 HMORE:
1433 HSTYET: PUSH    TP,$TATOM
1434         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP
1435         PUSH    TP,$TCHAN
1436         PUSH    TP,D
1437         MCALL   2,INTERRUPT
1438         SUB     TP,[2,,2]
1439         JRST    DIRQ
1440
1441 ]
1442 CBDCHN: ERRUUO  EQUOTE BAD-CHANNEL
1443
1444 IFN ITS,[
1445
1446 HCLOCK: PUSH    TP,$TCHSTR
1447         PUSH    TP,CHQUOTE CLOCK
1448         MCALL   1,INTERRUPT
1449         JRST    DIRQ
1450
1451 HRUNT:  PUSH    TP,$TATOM
1452         PUSH    TP,MQUOTE RUNT,RUNT,INTRUP
1453         MCALL   1,INTERRUPT
1454         JRST    DIRQ
1455 ]
1456 HREAL:  PUSH    TP,$TATOM
1457         PUSH    TP,MQUOTE REALT,REALT,INTRUP
1458         MCALL   1,INTERRUPT
1459         JRST    DIRQ
1460 IFN ITS,[
1461 HPAR:   MOVE    A,MQUOTE PARITY,PARITY,INTRUP
1462         JRST    HMPV1
1463
1464 HMPV:   MOVE    A,MQUOTE MPV,MPV,INTRUP
1465         JRST    HMPV1
1466
1467 HILOPR: MOVE    A,MQUOTE ILOPR,ILOPR,INTRUP
1468         JRST    HMPV1
1469
1470 HPURE:  MOVE    A,MQUOTE PURE,PURE,INTRUP
1471 HMPV1:  PUSH    TP,$TATOM
1472         PUSH    TP,A
1473         PUSH    P,LCKINT        ; SAVE LOCN
1474         PUSH    TP,$TATOM
1475         PUSH    TP,A
1476         PUSH    TP,$TWORD
1477         PUSH    TP,LCKINT
1478         MCALL   2,EMERGENCY
1479         POP     P,A
1480         MOVE    C,(TP)
1481         SUB     TP,[2,,2]
1482         JUMPN   B,DIRQ
1483
1484         PUSH    TP,$TATOM
1485         PUSH    TP,EQUOTE DANGEROUS-INTERRUPT-NOT-HANDLED
1486         PUSH    TP,$TATOM
1487         PUSH    TP,C
1488         PUSH    TP,$TWORD
1489         PUSH    TP,A
1490         MCALL   3,ERROR
1491         JRST    DIRQ
1492
1493 \f
1494
1495 ; HERE TO HANDLE SYS DOWN INTERRUPT
1496
1497 HDOWN:  PUSH    TP,$TATOM
1498         PUSH    TP,MQUOTE SYSDOWN,SYSDOWN,INTRUP
1499         .DIETI  A,              ; HOW LONG?
1500         PUSH    TP,$TFIX
1501         PUSH    TP,A
1502         PUSH    P,A             ; FOR MESSAGE
1503         MCALL   2,INTERRUPT
1504         POP     P,A
1505         JUMPN   B,DIRQ
1506         .SUSET  [.RTTY,,B]      ; DO WE NOW HAVE A TTY AT ALL?
1507         JUMPL   B,DIRQ          ; DONT HANG AROUND
1508         PUSH    P,A
1509         MOVEI   B,[ASCIZ /
1510 Excuse me, SYSTEM going down in /]
1511         SKIPG   (P)             ; SKIP IF REALLY GOING DOWN
1512         MOVEI   B,[ASCIZ /
1513 Excuse me, SYSTEM has been REVIVED!
1514 /]
1515         PUSHJ   P,MSGTYP
1516         POP     P,B
1517         JUMPE   B,DIRQ
1518         IDIVI   B,30.           ; TO SECONDS
1519         IDIVI   B,60.           ; A/ SECONDS B/ MINUTES
1520         JUMPE   B,NOMIN
1521         PUSH    P,C
1522         PUSHJ   P,DECOUT
1523         MOVEI   B,[ASCIZ / minutes /]
1524         PUSHJ   P,MSGTYP
1525         POP     P,B
1526         JRST    .+2
1527 NOMIN:  MOVEI   B,(C)
1528         PUSHJ   P,DECOUT
1529         MOVEI   B,[ASCIZ / seconds.
1530 /]
1531         PUSHJ   P,MSGTYP
1532         JRST    DIRQ
1533
1534 ; TWO DIGIT DEC OUT FROM B/
1535
1536 DECOUT: IDIVI   B,10.
1537         JUMPE   B,DECOU1        ; NO TEN
1538         MOVEI   A,60(B)
1539         PUSHJ   P,MTYO
1540 DECOU1: MOVEI   A,60(C)
1541         JRST    MTYO
1542 ]
1543 \f
1544 ; HERE TO HANDLE I/O CHANNEL ERRORS
1545
1546 HIOC:
1547 IFN ITS,[
1548         .SUSET  [.RAPRC,,A]     ; CONTAINS CHANNEL OF MOST RECENT LOSSAGE
1549         LDB     A,[330400,,A]   ; GET CHAN #
1550         MOVEI   C,(A)           ; COPY
1551 ]
1552         PUSH    TP,$TATOM       ; PUSH ERROR
1553         PUSH    TP,EQUOTE FILE-SYSTEM-ERROR
1554 IFE ITS,        MOVE    C,IOCLOS        ; GET JFN
1555         PUSH    TP,$TCHAN
1556         ASH     C,1             ; GET CHANNEL
1557         ADDI    C,CHNL0+1       ; GET CHANNEL VECTOR
1558         PUSH    TP,(C)
1559 IFN ITS,[
1560         LSH     A,23.           ; DO A .STATUS
1561         IOR     A,[.STATUS A]
1562         XCT     A
1563 ]
1564 IFE ITS,[
1565         MOVNI   A,1                     ; GET "MOST RECENT ERROR"
1566 ]
1567         MOVE    B,(TP)
1568 IFN ITS,        PUSHJ   P,GFALS         ; GEN NAMED FALSE
1569 IFE ITS,        PUSHJ   P,TGFALS
1570         PUSH    TP,A
1571         PUSH    TP,B
1572         PUSH    TP,$TATOM
1573         PUSH    TP,MQUOTE IOC,IOC,INTRUP
1574
1575         PUSH    TP,A
1576         PUSH    TP,B
1577         PUSH    TP,-7(TP)
1578         PUSH    TP,-7(TP)
1579         MCALL   3,EMERGENCY
1580         JUMPN   B,DIRQ1         ; JUMP IF HANDLED
1581         MCALL   3,ERROR
1582         JRST    DIRQ
1583
1584 DIRQ1:  SUB     TP,[6,,6]
1585         JRST    DIRQ
1586 ]
1587 ; HANDLE INFERIOR KNOCKING AT THE DOOR
1588
1589 HINF:
1590 IFN ITS,        SUBI    B,36.+16.+2     ; CONVERT TO INF #
1591 IFE ITS,        MOVEI   B,0
1592         PUSH    TP,$TATOM
1593         PUSH    TP,MQUOTE INFERIOR,INFERIOR,INTRUP
1594         PUSH    TP,$TFIX
1595         PUSH    TP,B
1596         MCALL   2,INTERRUPT
1597         JRST    DIRQ
1598 \f
1599 IFE ITS,[
1600
1601 ; HERE FOR TENEX INTS (FIRST CUT)
1602
1603 MFUNCTION %ACCHRS,SUBR,[ACTIVATE-CHARS]
1604
1605         ENTRY
1606
1607         JUMPGE  AB,RETCHR
1608         CAMGE   AB,[-3,,]
1609         JRST    TMA
1610
1611         GETYP   A,(AB)
1612         CAIE    A,TCHSTR
1613         JRST    WTYP1
1614         HRRZ    D,(AB)          ; CHECK LENGTH
1615         MOVEI   C,0             ; SEE IF ANY NET CHANS IN USE
1616         MOVE    A,[-NNETS,,NETJFN]
1617         SKIPE   (A)
1618         SUBI    C,1
1619         AOBJN   A,.-2
1620
1621         CAILE   D,NCHRS+NNETS(C)
1622         JRST    WTYP1
1623
1624         MOVEI   0,(D)           ; CHECK THEM
1625         MOVE    B,1(AB)
1626
1627         JUMPE   0,.+4
1628         ILDB    C,B
1629         CAILE   C,32
1630         JRST    WTYP1
1631         SOJG    0,.-3
1632
1633         MOVSI   E,-<NCHRS+NNETS>        ; ZAP CURRENT
1634         HRRZ    A,CHRS(E)
1635         DTI
1636         SETZM   CHRS(E)
1637         AOBJN   E,.-3
1638
1639         MOVE    A,[-NNETS,,NETJFN]      ; IN CASE USED NET INTS FOR CHARS
1640
1641         SKIPGE  (A)
1642         SETZM   (A)
1643         AOBJN   A,.-2
1644
1645         MOVE    E,1(AB)
1646         SETZB   C,F             ; C WILL BE MASK, F OFFSET INTO TABLE
1647         MOVSI   0,400000        ; 0 WILL BE THE BIT FOR INT MASK OR'ING
1648         JUMPE   D,ALP1          ; JUMP IF NONE
1649         MOVNS   D               ; BUILD AOBJN POINTER TO CHRS TABLE
1650         MOVSI   D,(D)
1651         MOVEI   B,0             ; B COUNTS NUMBER DONE
1652
1653 ALP:    ILDB    A,E             ; GET CHR
1654         IOR     C,0
1655         LSH     0,-1
1656         HRROM   A,CHRS(D)
1657         MOVSS   A
1658         HRRI    A,(D)
1659         ADDI    A,(F)           ; POSSIBLE OFFSET FOR MORE CHANS
1660         ATI
1661         ADDI    B,1
1662         CAIGE   B,NCHRS
1663          JRST   ALP2
1664
1665         SKIPE   NETJFN-NCHRS(B)
1666          AOJA   B,.-1
1667
1668         MOVEI   F,36.-NNETS-UINTS-NCHRS(B)
1669         MOVN    G,F
1670         MOVSI   0,400000
1671         LSH     0,(G)                   ;NEW MASK FOR INT MASKS
1672         SUBI    F,1(D)
1673
1674 ALP2:   AOBJN   D,ALP
1675
1676 ALP1:   IORM    C,MASK1
1677         MOVEI   A,MFORK
1678         MOVE    B,MASK1         ; SET UP FOR INT BITS
1679         AIC                     ; TURN THEM ON
1680         MOVE    A,(AB)
1681         MOVE    B,1(AB)
1682         JRST    FINIS
1683
1684 RETCHR: MOVE    C,[-NCHRS-NNETS,,CHRS]
1685         MOVEI   A,0
1686
1687 RETCH1: SKIPN   D,(C)
1688         JRST    RETDON
1689         PUSH    TP,$TCHRS
1690         ANDI    D,177
1691         PUSH    TP,D
1692         ADDI    A,1
1693         AOBJN   C,RETCH1
1694
1695 RETDON: PUSHJ   P,CISTNG
1696         JRST    FINIS
1697
1698 HCHAR:  HRRZ    A,CHRS-36.(B)
1699         PUSH    TP,$TATOM
1700         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP
1701         PUSH    TP,$TCHRS
1702         PUSH    TP,A
1703         PUSH    TP,$TCHAN
1704         PUSH    TP,TTICHN+1
1705         MCALL   3,INTERRUPT
1706         JRST    DIRQ
1707
1708 HNET:   SKIPLE  A,NETJFN-NINT+NNETS+UINTS+1(B)
1709          JRST   HNET1
1710         SUBI    B,36.-NNETS-UINTS-NCHRS
1711         JUMPE   A,DIRQ
1712         JRST    HCHAR
1713 HNET1:  ASH     A,1
1714         ADDI    A,CHNL0+1
1715         MOVE    B,(A)
1716         PUSH    TP,$TATOM
1717         PUSH    TP,MQUOTE CHAR,CHAR,INTRUP
1718         PUSH    TP,$TUVEC
1719         PUSH    TP,BUFRIN(B)
1720         PUSH    TP,$TCHAN
1721         PUSH    TP,B
1722         PUSHJ   P,INSTAT
1723         MCALL   3,INTERRUPT
1724         JRST    DIRQ
1725
1726 USRINT: SUBI    B,36.
1727         PUSH    TP,$TATOM
1728         PUSH    TP,MQUOTE USERINT,USERINT,INTRUP
1729         PUSH    TP,$TFIX
1730         PUSH    TP,B
1731         MCALL   2,INTERRUPT
1732         JRST    DIRQ
1733 ]
1734
1735 \f
1736 MFUNCTION OFF,SUBR
1737         ENTRY
1738
1739         JUMPGE  AB,TFA
1740         HLRZ    0,AB
1741         GETYP   A,(AB)          ; ARG TYPE
1742         MOVE    B,1(AB)         ; AND VALUE
1743         CAIN    A,TINTH         ; HEADER, GO HACK
1744         JRST    OFFHD           ; QUEEN OF HEARTS
1745         CAIN    A,TATOM
1746         JRST    .+3
1747         CAIE    A,TCHSTR
1748         JRST    TRYHAN          ; MAYBE INDIVIDUAL HANDLER
1749         CAIN    0,-2            ; MORE THAN 1 ARG?
1750         JRST    OFFAC1          ; NO, GO ON
1751         CAIG    0,-5            ; CANT BE MORE THAN 2
1752         JRST    TMA
1753         MOVEI   B,2(AB)         ; POINT TO 2D
1754         PUSHJ   P,CHNORL
1755 OFFAC1: MOVEI   B,(AB)
1756         PUSHJ   P,FNDINT
1757         JUMPGE  B,NOHAN1        ; NOT HANDLED
1758
1759 OFFH1:  PUSH    P,C             ; SAVE C FOR BIT CLOBBER
1760         MOVSI   C,TATOM
1761         SKIPN   D
1762         MOVE    D,MQUOTE INTERRUPT
1763         MOVE    A,INAME(B)
1764         MOVE    B,INAME+1(B)
1765         PUSHJ   P,IREMAS
1766         SKIPE   B               ; IF NO ASSOC, DONT SMASH
1767         SETOM   ISTATE+1(B)     ; DISABLE IN CASE QUEUED
1768         POP     P,C             ; SPECIAL?
1769         JUMPGE  C,FINIS         ;  NO, DONE
1770
1771         HRRZ    C,INTBL(C)      ; POINT TO SPECIAL CODE
1772         PUSHJ   P,(C)           ; GO TO SAME
1773         JUMPE   E,OFINIS        ; DONE
1774 IFN ITS,[
1775         CAILE   E,35.           ; SKIP IF 1ST WORD
1776         JRST    CLRW2           ; CLOBBER 2D WORD BIT
1777         LSH     0,-1(E)         ; POSITION BIT
1778         ANDCAM  0,MASK1         ; KILL BIT
1779         .SUSET  [.SMASK,,MASK1]
1780 ]
1781 IFE ITS,[
1782         MOVE    D,B
1783         SETZM   (E)
1784         MOVEI   E,(E)
1785         SUBI    E,NETJFN-NETCHN
1786         MOVEI   0,1
1787         MOVNS   E
1788         LSH     0,35.(E)
1789         ANDCAM  0,MASK1
1790         MOVEI   A,MFORK
1791         SETCM   B,MASK1
1792         DIC
1793         ANDCAM  0,PIRQ          ; JUST IN CASE
1794         MOVE    B,D
1795 ]
1796 OFINIS: MOVSI   A,TINTH
1797         JRST    FINIS
1798
1799 IFN ITS,[
1800 CLRW2:  LSH     0,-36.(E)       ; POS BIT FOR 2D WORD
1801         ANDCAM  0,MASK2
1802         .SUSET  [.SMSK2,,MASK2]
1803         JRST    OFINIS
1804 ]
1805
1806 TRYHAN: CAIE    A,THAND         ; HANDLER?
1807         JRST    WTYP1
1808         CAIE    0,-2
1809         JRST    TMA
1810         GETYP   0,IPREV(B)      ; GET TYPE OF PREV
1811         MOVE    A,INXT+1(B)
1812         SKIPN   C,IPREV+1(B)    ; dont act silly if already off! (TT)
1813         JRST    HFINIS
1814         MOVE    D,IPREV(B)
1815         CAIE    0,THAND
1816         JRST    DOHEAD          ; PREV HUST BE HDR
1817         MOVEM   A,INXT+1(C)
1818         JRST    .+2
1819 DOHEAD: MOVEM   A,IHNDLR+1(C)   ; INTO HDR
1820         JUMPE   A,OFFINI
1821         MOVEM   D,IPREV(A)
1822         MOVEM   C,IPREV+1(A)
1823 OFFINI: SETZM   IPREV+1(B)      ; Leave NXT slot intact for RUNINT (BKD)
1824         MOVSI   A,THAND
1825         JRST    FINIS
1826
1827 OFFHD:  CAIE    0,-2
1828         JRST    TMA
1829         PUSHJ   P,GETNMS                ; GET INFOR ABOUT INT
1830         JUMPE   C,OFFH1
1831         PUSH    TP,INAME(B)
1832         PUSH    TP,INAME+1(B)
1833         JRST    OFFH1
1834
1835 GETNMS: GETYP   A,INAME(B)      ; CHECK FOR SPECIAL
1836         SETZB   C,D
1837         CAIN    A,TCHAN
1838         HRROI   C,SS.CHA
1839         PUSHJ   P,LOCQ          ; LOCATIVE?
1840         JRST    CHGTNM
1841
1842         MOVEI   B,INAME(B)      ; POINT TO LOCATIVE
1843         MOVSI   D,(MOVE E,)
1844         PUSHJ   P,SMON          ; GET MONITOR
1845         MOVE    B,1(AB)
1846 GETNM1: HRROI   C,SS.WMO        ; ASSUME WRITE
1847         TLNN    E,.WRMON
1848         HRROI   C,SS.RMO
1849         MOVE    D,MQUOTE WRITE,WRITE,INTRUP
1850         TLNN    E,.WRMON
1851         MOVE    D,MQUOTE READ,READ,INTRUP
1852         POPJ    P,
1853
1854 CHGTNM: JUMPL   C,CPOPJ
1855         MOVE    B,INAME+1(B)
1856         PUSHJ   P,SPEC1
1857         MOVE    B,1(AB)         ; RESTORE IHEADER
1858         POPJ    P,
1859 \f
1860 ; EMERGENCY, CANT DEFER ME!!
1861
1862 MQUOTE INTERRUPT
1863
1864 EMERGENCY:
1865         PUSH    P,.
1866         JRST    INTERR+1
1867
1868 MFUNCTION INTERRUPT,SUBR
1869
1870         PUSH    P,[0]
1871
1872         ENTRY
1873
1874         SETZM   INTHLD          ; RE-ENABLE THE WORLD
1875         JUMPGE  AB,TFA
1876         MOVE    B,1(AB)         ; GET HANDLER/NAME
1877         GETYP   A,(AB)          ; CAN BE HEADER OR NAME
1878         CAIN    A,TINTH         ; SKIP IF NOT HEADER
1879         JRST    GTHEAD
1880         CAIN    A,TATOM
1881         JRST    .+3
1882         CAIE    A,TCHSTR        ; SKIP IF CHAR STRING
1883         JRST    WTYP1
1884         MOVEI   B,(AB)          ; LOOK UP NAME
1885         PUSHJ   P,FNDNM         ; GET NAME
1886         JUMPE   B,IFALSE
1887         MOVEI   D,0
1888         CAMN    B,MQUOTE CHAR,CHAR,INTRUP
1889         PUSHJ   P,CHNGT1
1890         CAME    B,MQUOTE READ,READ,INTRUP
1891         CAMN    B,MQUOTE WRITE,WRITE,INTRUP
1892         PUSHJ   P,GTLOC1
1893         PUSHJ   P,INTASO
1894         JUMPE   B,IFALSE
1895
1896 GTHEAD: SKIPE   ISTATE+1(B)     ; ENABLED?
1897         JRST    IFALSE          ; IGNORE COMPLETELY
1898         MOVE    A,INTPRI+1(B)   ; GET PRIORITY OF INTERRUPT
1899         CAMLE   A,CURPRI        ; SEE IF MUST QUEU
1900         JRST    SETPRI          ; MAY RUN NOW
1901         SKIPE   (P)             ; SKIP IF DEFER OK
1902         JRST    DEFERR
1903         MOVEM   A,(P)
1904         PUSH    TP,$TINTH       ; SAVE HEADER
1905         PUSH    TP,B
1906         MOVEI   A,1             ; SAVE OTHER ARGS
1907 PSHARG: ADD     AB,[2,,2]
1908         JUMPGE  AB,QUEU1        ; GO MAKE QUEU ENTRY
1909         PUSH    TP,(AB)
1910         PUSH    TP,1(AB)
1911         AOJA    A,PSHARG
1912 QUEU1:  PUSHJ   P,IEVECT        ; GET VECTOR
1913         PUSH    TP,$TVEC
1914         PUSH    TP,[0]          ; WILL HOLD QUEUE HEADER
1915         PUSH    TP,A
1916         PUSH    TP,B
1917
1918         POP     P,A             ; RESTORE PRIORITY
1919
1920         MOVE    B,QUEUES+1      ; GET INTERRUPT QUEUES
1921         MOVEI   D,0
1922         JUMPGE  B,GQUEU         ; MAKE A QUEUE HDR
1923
1924 NXTQU:  CAMN    A,1(B)          ; GOT PRIORITY?
1925         JRST    ADDQU           ; YES, ADD TO THE QUEU
1926         CAML    A,1(B)          ; SKIP IF SPOT NOT FOUND
1927         JRST    GQUEU
1928         MOVE    D,B
1929         MOVE    B,3(B)          ; GO TO NXT QUEUE
1930         JUMPL   B,NXTQU
1931
1932 GQUEU:  PUSH    TP,$TVEC        ; SAVE NEXT POINTER
1933         PUSH    TP,D
1934         PUSH    TP,$TFIX
1935         PUSH    TP,A            ; SAVE PRIORITY
1936         PUSH    TP,$TVEC
1937         PUSH    TP,B
1938         PUSH    TP,$TLIST
1939         PUSH    TP,[0]
1940         PUSH    TP,$TLIST
1941         PUSH    TP,[0]
1942         MOVEI   A,4
1943         PUSHJ   P,IEVECT
1944         MOVE    D,(TP)          ; NOW SPLICE
1945         SUB     TP,[2,,2]
1946         JUMPN   D,GQUEU1
1947         MOVEM   B,QUEUES+1
1948         JRST    .+2
1949 GQUEU1: MOVEM   B,3(D)
1950
1951 ADDQU:  MOVEM   B,-2(TP)        ; SAVE QUEU HDR
1952         POP     TP,D
1953         POP     TP,C
1954         PUSHJ   P,INCONS        ; CONS IT
1955         MOVE    C,(TP)          ;GET QUEUE HEADER
1956         SKIPE   D,7(C)          ; IF END EXISTS
1957         HRRM    B,(D)           ; SPLICE
1958         MOVEM   B,7(C)
1959         SKIPN   5(C)            ; SKIP IF START EXISTS
1960         MOVEM   B,5(C)
1961
1962 IFINI:  MOVSI   A,TATOM
1963         MOVE    B,IMQUOTE T
1964         JRST    FINIS
1965
1966 SETPRI: EXCH    A,CURPRI
1967         MOVEM   A,(P)
1968
1969         PUSH    TP,$TAB         ; PASS AB TO HANDLERS
1970         PUSH    TP,AB
1971
1972         PUSHJ   P,RUNINT        ; RUN THE HANDLERS
1973         POP     P,A             ; UNQUEU ANY WAITERS
1974         PUSHJ   P,UNQUEU
1975
1976         JRST    IFINI
1977
1978 ; HERE TO UNQUEUE WAITING INTERRUPTS
1979
1980 UNQUEU: PUSH    P,A             ; SAVE NEW LEVEL
1981
1982 UNQUE1: MOVE    A,(P)           ; TARGET LEVEL
1983         CAMLE   A,CURPRI        ; CHECK RUG NOT PULLED OUT
1984         JRST    UNDONE
1985         SKIPE   B,QUEUES+1
1986         CAML    A,1(B)          ; RIGHT LEVEL?
1987         JRST    UNDONE          ; FINISHED
1988
1989         SKIPN   C,5(B)          ; ON QUEUEU?
1990         JRST    UNXQ
1991         HRRZ    D,(C)           ; CDR THE LIST
1992         MOVEM   D,5(B)
1993         SKIPN   D               ; SKIP IF NOT LAST
1994         SETZM   7(B)            ; CLOBBER END POINTER
1995         MOVE    A,1(B)          ; GET THIS PRIORITY LEVEL
1996         MOVEM   A,CURPRI        ; MAKE IT THE CURRENT ONE
1997         MOVE    D,1(C)          ; GET SAVED VECTOR OF INF
1998
1999         MOVE    B,1(D)          ; INT HEADER
2000         PUSH    TP,$TVEC
2001         PUSH    TP,D            ; AND ARGS
2002
2003         PUSHJ   P,RUNINT        ; RUN THEM
2004         JRST    UNQUE1
2005
2006 UNDONE: POP     P,CURPRI        ; SET CURRENT LEVEL
2007         MOVE    A,CURPRI
2008         POPJ    P,
2009
2010 UNXQ:   MOVE    B,3(B)          ; GO  TO NEXT QUEUE
2011         MOVEM   B,QUEUES+1
2012         JRST    UNQUE1
2013
2014
2015
2016 ; SUBR TO CHANGE INTERRUPT LEVEL
2017
2018 MFUNCTION INTLEV,SUBR,[INT-LEVEL]
2019         ENTRY
2020         JUMPGE  AB,RETLEV       ; JUST RETURN CURRENT
2021         GETYP   A,(AB)
2022         CAIE    A,TFIX
2023         JRST    WTYP1           ; LEVEL IS FIXED
2024         SKIPGE  A,1(AB)
2025         JRST    OUTRNG"
2026         CAMN    A,CURPRI        ; DIFFERENT?
2027         JRST    RETLEV          ; NO RETURN
2028         PUSH    P,CURPRI
2029         CAMG    A,CURPRI        ; SKIP IF NO UNQUEUE NEEDED
2030         PUSHJ   P,UNQUEU
2031         MOVEM   A,CURPRI        ; SAVE
2032         POP     P,A
2033         SKIPA   B,A
2034 RETLEV: MOVE    B,CURPRI
2035         MOVSI   A,TFIX
2036         JRST    FINIS
2037
2038 RUNINT: PUSH    TP,$THAND       ; SAVE HANDLERS LIST
2039         PUSH    TP,IHNDLR+1(B)
2040
2041         SKIPN   ISTATE+1(B)     ; SKIP IF DISABLED
2042         SKIPN   B,(TP)
2043         JRST    SUBTP4
2044 NXHND:  MOVEM   B,(TP)          ; SAVE CURRENT HDR
2045         MOVE    A,-2(TP)                ; SAVE ARG POINTER
2046         PUSHJ   P,CHSWAP        ; SEE IF MUST SWAP
2047         PUSH    TP,[0]
2048         PUSH    TP,[0]
2049         MOVEI   C,1             ; COUNT ARGS
2050         PUSH    TP,SPSTOR       ; SAVE INITIAL BINDING POINTER
2051         PUSH    TP,SPSTOR+1
2052         MOVE    D,PVSTOR+1
2053         ADD     D,[1STEPR,,1STEPR]
2054         PUSH    TP,BNDV
2055         PUSH    TP,D
2056         PUSH    TP,$TPVP
2057         PUSH    TP,[0]
2058         MOVE    E,TP
2059 NBIND:  PUSH    TP,INTFCN(B)
2060         PUSH    TP,INTFCN+1(B)
2061         ADD     A,[2,,2]
2062         JUMPGE  A,DO.HND
2063         PUSH    TP,(A)
2064         PUSH    TP,1(A)
2065         AOJA    C,.-4
2066 DO.HND: MOVE    PVP,PVSTOR+1
2067         SKIPN   1STEPR+1(PVP)   ; NECESSARY TO DO 1STEP BINDING ?
2068         JRST    NBIND1          ; NO, DON'T BOTHER
2069         PUSH    P,C
2070         PUSHJ   P,SPECBE        ; BIND 1 STEP FLAG
2071         POP     P,C
2072 NBIND1: ACALL   C,INTAPL        ; RUN HAND WITH POSSIBLY BOUND 1STEP FLAG
2073         MOVE    SP,SPSTOR+1     ; GET CURRENT BINDING POINTER
2074         CAMN    SP,-4(TP)       ; SAME AS SAVED BINDING POINTER ?
2075         JRST    NBIND2          ; YES, 1STEP FLAG NOT BOUND
2076         MOVE    C,(TP)          ; RESET 1 STEP
2077         MOVE    PVP,PVSTOR+1
2078         MOVEM   C,1STEPR+1(PVP)
2079         MOVE    SP,-4(TP)       ; RESTORE SAVED BINDING POINTER
2080         MOVEM   SP,SPSTOR+1
2081 NBIND2: SUB     TP,[6,,6]
2082         PUSHJ   P,CHUNSW
2083         CAMN    E,PVSTOR+1
2084         SUB     TP,[4,,4]       ; NO PROCESS CHANGE, POP JUNK
2085         CAMN    E,PVSTOR+1
2086         JRST    .+4
2087         MOVE    D,TPSTO+1(E)
2088         SUB     D,[4,,4]
2089         MOVEM   D,TPSTO+1(E)    ; FIXUP HIS STACK
2090 DO.H1:  GETYP   A,A             ; CHECK FOR A DISMISS
2091         CAIN    A,TDISMI
2092         JRST    SUBTP4
2093         MOVE    B,(TP)          ; TRY FOR NEXT HANDLER
2094         SKIPE   B,INXT+1(B)
2095         JRST    NXHND
2096 SUBTP4: SUB     TP,[4,,4]
2097         POPJ    P,
2098
2099 MFUNCTION INTAPL,SUBR,[RUNINT]
2100         JRST    APPLY
2101
2102
2103 NOHAND: JUMPE   C,NOHAN1
2104         PUSH    TP,$TATOM
2105         PUSH    TP,EQUOTE INTERNAL-INTERRUPT
2106 NOHAN1: PUSH    TP,(AB)
2107         PUSH    TP,1(AB)
2108         PUSH    TP,$TATOM
2109         PUSH    TP,EQUOTE NOT-HANDLED
2110         SKIPE   A,C
2111         MOVEI   A,1
2112         ADDI    A,2
2113         JRST    CALER
2114
2115 DEFERR: PUSH    TP,$TATOM
2116         PUSH    TP,EQUOTE ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT
2117         PUSH    TP,$TINTH
2118         PUSH    TP,B
2119         PUSH    TP,$TATOM
2120         PUSH    TP,MQUOTE INTERRUPT
2121         MCALL   3,RERR          ; FORCE REAL ERROR
2122         JRST    FINIS
2123
2124 ; FUNCTION TO DISMISS AN INTERRUPT TO AN ARBITRARY ACTIVATION
2125
2126 MFUNCTION DISMISS,SUBR
2127
2128         HLRZ    0,AB
2129         JUMPGE  AB,TFA
2130         CAIGE   0,-6
2131         JRST    TMA
2132         MOVNI   D,1
2133         CAIE    0,-6
2134         JRST    DISMI3
2135         GETYP   0,4(AB)
2136         CAIE    0,TFIX
2137         JRST    WTYP
2138         SKIPGE  D,5(AB)
2139         JRST    OUTRNG
2140
2141 DISMI3: MOVEI   A,(TB)
2142
2143 DISMI0: HRRZ    B,FSAV(A)
2144         HRRZ    C,PCSAV(A)
2145         CAIE    B,INTAPL
2146         JRST    DISMI1
2147
2148         MOVE    E,OTBSAV(A)
2149         MOVEI   0,(A)           ; SAVE FRAME
2150         MOVEI   A,DISMI2
2151         HRRM    A,PCSAV(E)      ; GET IT BACK HERE
2152         MOVE    A,(AB)
2153         MOVE    B,1(AB)
2154         MOVE    C,TPSAV(E)
2155         MOVEM   A,-7(C)
2156         MOVEM   B,-6(C)
2157         MOVEI   C,0
2158         CAMGE   AB,[-3,,]
2159         MOVEI   C,2(AB)
2160         MOVE    B,0             ; DEST FRAME
2161         JUMPL   D,.+3
2162         MOVE    A,PSAV(E)       ; NOW MUNG SAVED INT LEVEL
2163         MOVEM   D,-1(A)         ; ZAP YOUR MUNGED
2164         PUSHJ   P,CHUNW         ; CHECK ON UNWINDERS
2165         JRST    FINIS           ; FALL DOWN
2166
2167 DISMI1: MOVEI   E,(A)
2168         HRRZ    A,OTBSAV(A)
2169         JUMPN   A,DISMI0
2170
2171         MOVE    A,(AB)
2172         MOVE    B,1(AB)
2173
2174         PUSH    TP,A
2175         PUSH    TP,B
2176         SKIPGE  A,D
2177         JRST    .+4
2178         CAMG    A,CURPRI
2179         PUSHJ   P,UNQUEU
2180         MOVEM   A,CURPRI
2181         CAML    AB,[-3,,]
2182         JRST    .+5
2183         PUSH    TP,2(AB)
2184         PUSH    TP,3(AB)
2185         MCALL   2,ERRET
2186         JRST    FINIS
2187
2188         POP     TP,B
2189         POP     TP,A
2190         JRST    FINIS
2191
2192 DISMI2: CAMN    SP,-4(TP)       ; 1STEP FLAG BEEN BOUND ?
2193         JRST    NDISMI          ; NO
2194         MOVE    C,(TP)
2195         MOVE    PVP,PVSTOR+1
2196         MOVEM   C,1STEPR+1(PVP)
2197         MOVE    SP,-4(TP)
2198 NDISMI: SUB     TP,[6,,6]
2199         PUSHJ   P,CHUNSW        ; UNDO ANY PROCESS HACKING
2200         MOVE    C,TP
2201         CAME    E,PVSTOR+1      ; SWAPED?
2202         MOVE    C,TPSTO+1(E)
2203         MOVE    D,-1(C)
2204         MOVE    0,(C)
2205         SUB     TP,[4,,4]
2206         SUB     C,[4,,4]        ; MAYBE FIXUP OTHER STACK
2207         CAME    E,PVSTOR+1
2208         MOVEM   C,TPSTO+1(E)
2209         PUSH    TP,D
2210         PUSH    TP,0
2211         PUSH    TP,A
2212         PUSH    TP,B
2213         MOVE    A,-1(P)         ; SAVED PRIORITY
2214         CAMG    A,CURPRI
2215         PUSHJ   P,UNQUEU
2216         MOVEM   A,CURPRI
2217         SKIPN   -1(TP)
2218         JRST    .+3
2219         MCALL   2,ERRET
2220         JRST    FINIS
2221
2222         SUB     TP,[4,,4]
2223         MOVSI   A,TDISMI
2224         MOVE    B,IMQUOTE T
2225         JRST    DO.H1
2226
2227 CHNGT1: HLRE    B,AB
2228         SUBM    AB,B
2229         GETYP   0,-2(B)
2230         CAIE    0,TCHAN
2231         JRST    WTYP3
2232         MOVE    B,-1(B)
2233         MOVSI   A,TCHAN
2234         POPJ    P,
2235
2236 GTLOC1: GETYP   A,2(AB)
2237         PUSHJ   P,LOCQ
2238         JRST    WTYP2
2239         MOVE    D,B             ; RET ATOM FOR ASSOC
2240         MOVE    A,2(AB)
2241         MOVE    B,3(AB)
2242         POPJ    P,
2243 \f; MONITOR CHECKERS
2244
2245 MONCH0: HLLZ    0,(B)           ; POTENTIAL MONITORS
2246 MONCH:  TLZ     0,TYPMSK        ; KILL TYPE
2247         IOR     C,0             ; IN NEW TYPE
2248         PUSH    P,0
2249         MOVEI   0,(B)
2250         CAIL    0,HIBOT
2251         JRST    PURERR
2252         POP     P,0
2253         TLNN    0,.WRMON        ; SKIP IF WRITE MONIT
2254         POPJ    P,
2255
2256 ; MONITOR IS ON, INVOKE HANDLER
2257
2258         PUSH    TP,A            ; SAVE OBJ
2259         PUSH    TP,B
2260         PUSH    TP,C
2261         PUSH    TP,D            ; SAVE DATUM
2262         MOVSI   C,TATOM         ; PREPARE TO FIND IT
2263         MOVE    D,MQUOTE WRITE,WRITE,INTRUP
2264         PUSHJ   P,IGET
2265         JUMPE   B,MONCH1        ; NOT FOUND IGNORE FOR NOW
2266         PUSH    TP,A            ; START SETTING UP CALL
2267         PUSH    TP,B
2268         PUSH    TP,-5(TP)
2269         PUSH    TP,-5(TP)
2270         PUSH    TP,-5(TP)
2271         PUSH    TP,-5(TP)
2272         PUSHJ   P,FRMSTK        ; PUT FRAME ON STAKC
2273         MCALL   4,EMERGE        ; DO IT
2274 MONCH1: POP     TP,D
2275         POP     TP,C
2276         POP     TP,B
2277         POP     TP,A
2278         HLLZ    0,(B)           ; UPDATE MONITORS
2279         TLZ     0,TYPMSK
2280         IOR     C,0
2281         POPJ    P,
2282
2283 ; NOW FOR READ MONITORS
2284
2285 RMONC0: HLLZ    0,(B)
2286 RMONCH: TLNN    0,.RDMON
2287         POPJ    P,
2288         PUSH    TP,A
2289         PUSH    TP,B
2290         MOVSI   C,TATOM
2291         MOVE    D,MQUOTE READ,READ,INTRUP
2292         PUSHJ   P,IGET
2293         JUMPE   B,RMONC1
2294         PUSH    TP,A
2295         PUSH    TP,B
2296         PUSH    TP,-3(TP)
2297         PUSH    TP,-3(TP)
2298         PUSHJ   P,FRMSTK        ; PUT FRAME ON STACK
2299         MCALL   3,EMERGE
2300 RMONC1: POP     TP,B
2301         POP     TP,A
2302         POPJ    P,
2303
2304 ; PUT THE CURRENT FRAME ON THE STACK
2305
2306 FRMSTK: PUSHJ   P,MAKACT
2307         HRLI    A,TFRAME
2308         PUSH    TP,A
2309         PUSH    TP,B
2310         POPJ    P,
2311
2312 ; HERE TO COMPLAIN ABOUT ATTEMPTS TO MUNG PURE CODE
2313
2314 PURERR: PUSH    TP,$TATOM
2315         PUSH    TP,EQUOTE ATTEMPT-TO-MUNG-PURE-STRUCTURE
2316         PUSH    TP,A
2317         PUSH    TP,B
2318         MOVEI   A,2
2319         JRST    CALER
2320 \f
2321 ; PROCESS SWAPPING CODE
2322
2323 CHSWAP: MOVE    E,PVSTOR+1      ; GET CURRENT
2324         POP     P,0
2325         SKIPE   D,INTPRO+1(B)   ; SKIP IF NO PROCESS GIVEN
2326         CAMN    D,PVSTOR+1      ; SKIP IF DIFFERENT
2327         JRST    PSHPRO
2328
2329         PUSHJ   P,SWAPIT        ; DO SWAP
2330
2331 PSHPRO: PUSH    TP,$TPVP
2332         PUSH    TP,E
2333         JRST    @0
2334
2335 CHUNSW: MOVE    E,PVSTOR+1      ; RET OLD PROC
2336         MOVE    D,-2(TP)        ; GET SAVED PROC
2337         CAMN    D,PVSTOR+1      ; SWAPPED?
2338         POPJ    P,
2339
2340 SWAPIT: PUSH    P,0
2341         MOVE    0,PSTAT+1(D)    ; CHECK STATE
2342         CAIE    0,RESMBL
2343         JRST    NOTRES
2344         MOVE    PVP,PVSTOR+1
2345         MOVEM   0,PSTAT+1(PVP)
2346         MOVEI   0,RUNING
2347         MOVEM   0,PSTAT+1(D)    ; SAVE NEW STATE
2348         POP     P,0
2349         POP     P,C
2350         JRST    SWAP"
2351 \f
2352
2353 ;SUBROUTINE TO GET BIT FOR CLOBBERAGE
2354
2355 GETBIT: MOVNS   B               ;NEGATE
2356         MOVSI   A,400000        ;GET THE BIT
2357         LSH     A,(B)           ;SHIFT TO POSITION
2358         POPJ    P,              ;AND RETURN
2359
2360 ; HERE TO HANDLE PURE WRITE AND CHECK FOR POSSIBLE C/W
2361
2362 IFN ITS,[
2363 GCPWRT: SKIPN   GCDFLG          ; SEE IF IN DUMPER OR PURIFYER
2364         SKIPE   NPWRIT
2365         JRST    .+3
2366         MOVEI   B,4             ; INDICATE PURE WRITE
2367         JRST    NOPUGC          ; CONTINUE
2368         TLZ     A,200
2369         MOVEM   A,TSINT         ; SVE A
2370         MOVE    A,TSAVA
2371         SOS     TSINTR
2372         .SUSET  [.RMPVA,,A]
2373         CAML    A,RPURBT        ; SKIP IF NOT PURE
2374         CAIL    A,HIBOT         ; DONT MARK IF TOUCHING INTERPRETER
2375         SKIPA
2376         SETOM   PURMNG          ; MUNGING PURENESS INDICATE
2377         MOVE    B,BUFGC         ; GET BUFFER
2378         JUMPL   B,GCPW1         ; JUMP IF WINDOW IS BUFFER
2379         EXCH    P,GCPDL
2380         PUSHJ   P,%CWINF        ; GO DO COPY/WRITE
2381 GCPW2:  EXCH    P,GCPDL
2382         MOVE    A,TSINT         ; RESTORE A
2383         JRST    2NDWORD         ; CONTINUE
2384 GCPW1:  EXCH    P,GCPDL
2385         MOVEI   B,WIND          ; START OF BUFFER
2386         PUSHJ   P,%CWINF        ; C/W
2387         MOVEI   B,WNDP          ; RESTORE WINDOW
2388         MOVE    A,WNDBOT        ; BOTTOM OF WINDOW
2389         ASH     A,-10.          ; TO PAGES
2390         SKIPE   A
2391         PUSHJ   P,%SHWND        ; SHARE IT
2392         JRST    GCPW2
2393 ]
2394 IFE ITS,[
2395
2396 ; HERE TO HANDLE BUFFERING FOR GC-DUMP AND PURIFY FOR TENEX
2397
2398 PWRIT:  SKIPN   GCDFLG          ; SEE IF IN DUMPER OR PURIFYER
2399         SKIPE   GPURFL
2400         SKIPA
2401         FATAL IMW
2402         EXCH    P,GCPDL         ; GET A GOOD PDL
2403         MOVEM   A,TSAVA         ; SAVE AC'S
2404         MOVEM   B,TSAVB
2405         MOVEI   A,MFORK         ; FOR TWENEX  THIS IS A MOVEI
2406         SKIPE   OPSYS           ; SKIP IF TOPS20
2407         MOVSI   A,MFORK         ; FOR A TENEX IT SHOULD BE A MOVSI
2408         GTRPW                   ; GET TRAP WORDS
2409         PUSH    P,A             ; SAVE ADDRESS AND WORD
2410         PUSH    P,B
2411         ANDI    A,-1
2412         CAML    A,RPURBT        ; SKIP IF NOT PURE
2413         CAIL    A,HIBOT         ; DONT MARK IF TOUCHING INTERPRETER
2414         SKIPA
2415         SETOM   PURMNG          ; MUNGING PURENESS INDICATE
2416         MOVE    B,BUFGC         ; GET BUFFER
2417         ANDCMI  A,1777          ; TO PAGE BOUNDRY
2418         JUMPL   B,PWRIT2        ; USE WINDOW AS BUFFER
2419 PWRIT3: PUSHJ   P,%CWINF        ; FIX UP
2420 PWRIT4: POP     P,B             ; RESTORE AC'S
2421         POP     P,A
2422         TLNN    A,10            ; SEE IF R/W CYCLE
2423         MOVEM   B,(A)           ; FINISH WRITE
2424         EXCH    P,GCPDL
2425         JRST    INTDON
2426 PWRIT2: MOVEI   B,WIND
2427         PUSHJ   P,%CWINF        ; GO TRY TO WIN
2428         MOVEI   B,WNDP
2429         MOVE    A,WNDBOT        ; BOTTOM OF WINDOW
2430         ASH     A,-10.          ; TO PAGES
2431         SKIPE   A
2432         PUSHJ   P,%SHWND        ; SHARE IT
2433         JRST    PWRIT4
2434 ]
2435
2436 ;HERE TO HANDLE PDL OVERFLOW.  ASK FOR A GC
2437
2438 IPDLOV:
2439 IFN ITS,[
2440         MOVEM   A,TSINT         ;SAVE INT WORD
2441 ]
2442
2443         SKIPE   GCFLG           ;IS GC RUNNING?
2444         JRST    GCPLOV          ;YES, COMPLAIN GROSSLY
2445
2446         MOVEI   A,200000        ;GET BIT TO CLOBBER
2447         IORM    A,PIRQ          ;LEAVE A MESSAGE FOR HIGHER LEVEL
2448
2449         EXCH    P,GCPDL         ;GET A WINNING PDL
2450         HRRZ    B,TSINTR        ;GET POINTER TO LOSING INSTRUCTION
2451 IFE ITS,[
2452         SKIPE   MULTSG
2453          MOVE   B,TSINTR+1
2454 ]
2455         SKIPG   GCPDL           ; SKIP IF NOT P
2456         LDB     B,[270400,,-1(B)]       ;GET AC FIELD
2457         SKIPL   GCPDL           ; SKIP IF P
2458         MOVEI   B,P
2459         MOVEI   A,(B)           ;COPY IT
2460         LSH     A,1             ;TIMES 2
2461         EXCH    PVP,PVSTOR+1
2462         ADDI    A,0STO(PVP)     ;POINT TO THIS ACS CURRENT TYPE
2463         EXCH    PVP,PVSTOR+1
2464         HLRZ    A,(A)           ;GET THAT TYPE INTO A
2465         CAIN    B,P             ;IS IT P
2466         MOVEI   B,GCPDL         ;POINT TO SAVED P
2467
2468         CAIN    B,B             ;OR IS IT B ITSELF
2469         MOVEI   B,TSAVB
2470         CAIN    B,A             ;OR A
2471         MOVEI   B,TSAVA
2472
2473         CAIN    B,C             ;OR C
2474         MOVEI   B,1(P)          ;C WILL BE ON THE STACK
2475
2476         PUSH    P,C
2477         PUSH    P,A
2478
2479         MOVE    A,(B)           ;GET THE LOSING POINTER
2480         MOVEI   C,(A)           ;AND ISOLATE RH
2481
2482         CAMG    C,VECTOP        ;CHECK IF IN GC SPACE
2483         CAMG    C,VECBOT
2484         JRST    NOGROW          ;NO, COMPLAIN
2485
2486 ; FALL THROUGH
2487 \f
2488
2489         HLRZ    C,A             ;GET -LENGTH
2490         SUBI    A,-1(C)         ;POINT TO A DOPE WORD
2491         POP     P,C             ;RESTORE TYPE INTO C
2492         PUSH    P,D             ; SAVE FOR GROWTH HACKER
2493         MOVEI   D,0
2494         CAIN    C,TPDL          ; POINT TD TO APPROPRIATE DOPE WORD
2495         MOVEI   D,PGROW
2496         CAIN    C,TTP
2497         MOVEI   D,TPGROW
2498         JUMPE   D,BADPDL        ; IF D STILL 0, THIS PDL IS WEIRD
2499         MOVEI   A,PDLBUF(A)     ; POINT TO ALLEGED REAL DOPE WORD
2500         SKIPN   (D)             ; SKIP IF PREVIOUSLY BLOWN
2501         MOVEM   A,(D)           ; CLOBBER IN
2502         CAME    A,(D)           ; MAKE SURE IT IS THE SAME
2503         JRST    PDLOSS
2504         POP     P,D             ; RESTORE D
2505
2506
2507 PNTRHK: MOVE    C,(B)           ;RESTORE PDL POINTER
2508         SUB     C,[PDLBUF,,0]   ;FUDGE THE POINTER
2509         MOVEM   C,(B)           ;AND STORE IT
2510
2511         POP     P,C             ;RESTORE THE WORLD
2512         EXCH    P,GCPDL         ;GET BACK ORIG PDL
2513 IFN ITS,[
2514         MOVE    A,TSINT         ;RESTORE INT WORD
2515
2516         JRST    IMPCH           ;LOOK FOR MORE INTERRUPTS
2517 ]
2518 IFE ITS,        JRST    GCQUIT
2519
2520 TPOVFL: SETOM   INTFLG          ;SIMULATE PDL OVFL
2521         PUSH    P,A
2522         MOVEI   A,200000        ;TURN ON THE BIT
2523         IORM    A,PIRQ
2524         HLRE    A,TP            ;FIND DOPEW
2525         SUBM    TP,A            ;POINT TO DOPE WORD
2526         MOVEI   A,PDLBUF+1(A)   ; ZERO LH AND POINT TO DOPEWD
2527         SKIPN   TPGROW
2528         HRRZM   A,TPGROW
2529         CAME    A,TPGROW        ; MAKE SURE WINNAGE
2530         JRST    PDLOS1
2531         SUB     TP,[PDLBUF,,0]  ; HACK STACK POINTER
2532         POP     P,A
2533         POPJ    P,
2534
2535
2536 ; GROW CORE IF PDL OVERFLOW DURING GC
2537
2538 GCPLOV: EXCH    P,GCPDL         ; NEED A PDL TO CALL P.CORE
2539         PUSHJ   P,GPDLOV        ; HANDLE PDL OVERFLOW
2540         EXCH    P,GCPDL
2541         PUSHJ   P,%FDBUF
2542 IFE ITS,[
2543         JRST    GCQUIT
2544 ]
2545 IFN ITS,[
2546         MOVE    A,TSINT
2547         JRST    IMPCH
2548
2549 ]
2550 \f
2551 IFN ITS,[
2552
2553 ;HERE TO HANDLE LOW-LEVEL CHANNELS
2554
2555
2556 CHNACT: SKIPN   GCFLG           ;GET A WINNING PDL
2557         EXCH    P,GCPDL
2558         ANDI    A,177777        ;ISOLATE CHANNEL BITS
2559         PUSH    P,0             ;SAVE
2560
2561 CHNA1:  MOVEI   B,0             ;BIT COUNTER
2562         JFFO    A,.+2           ;COUNT
2563         JRST    CHNA2
2564         SUBI    B,35.           ;NOW HAVE CHANNEL
2565         MOVMS   B               ;PLUS IT
2566         MOVEI   0,1
2567         LSH     0,(B)
2568         ANDCM   A,0
2569         MOVEI   0,(B)           ; COPY TO 0
2570         LSH     0,23.           ;POSITION FOR A .STATUS
2571         IOR     0,[.STATUS 0]
2572         XCT     0               ;DO IT
2573         ANDI    0,77            ;ISOLATE DEVICE
2574         CAILE   0,2
2575         JRST    CHNA1
2576
2577 PMIN4:  MOVE    0,B             ; CHAN TO 0
2578         .ITYIC  0,              ; INTO 0
2579         JRST    .+2             ; DONE, GO ON
2580         JRST    PMIN4
2581         SETZM   GCFLCH          ; LEAVE GC MODE
2582         JRST    CHNA1
2583
2584 CHNA2:  POP     P,0
2585         SKIPN   GCFLG
2586         EXCH    P,GCPDL
2587         JRST    GCQUIT
2588
2589 HOWMNY: SETZ
2590         SIXBIT /LISTEN/
2591         D
2592         402000,,B
2593 ]
2594
2595 MFUNCTION GASCII,SUBR,ASCII
2596         ENTRY   1
2597
2598         GETYP   A,(AB)
2599         CAIE    A,TCHRS
2600         JRST    TRYNUM
2601
2602         MOVE    B,1(AB)
2603         MOVSI   A,TFIX
2604         JRST    FINIS
2605
2606 TRYNUM: CAIE    A,TFIX
2607         JRST    WTYP1
2608         SKIPGE  B,1(AB)         ;GET NUMBER
2609         JRST    TOOBIG
2610         CAILE   B,177           ;CHECK RANGE
2611         JRST    TOOBIG
2612         MOVSI   A,TCHRS
2613         JRST    FINIS
2614
2615 TOOBIG: ERRUUO  EQUOTE ARGUMENT-OUT-OF-RANGE
2616
2617 \f
2618 ;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION
2619
2620 BADPDL: FATAL   NON PDL OVERFLOW
2621
2622 NOGROW: FATAL   PDL OVERFLOW ON NON EXPANDABLE PDL
2623
2624 PDLOS1: MOVEI   D,TPGROW
2625 PDLOSS: MOVSI   A,(GENERAL)     ; FIX UP TP DOPE WORD JUST IN CASE
2626         HRRZ    D,(D)           ; POINT TO POSSIBLE LOSING D.W.
2627         SKIPN   TPGROW
2628         JRST    PDLOS2
2629         MOVEM   A,-1(D)
2630         MOVEI   A,(TP)          ; SEE IF REL STACK SIZE WINS
2631         SUBI    A,(TB)
2632         TRNN    A,1
2633         SUB     TP,[1,,1]
2634 PDLOS2: MOVSI   A,.VECT.
2635         SKIPE   PGROW
2636         MOVEM   A,-1(D)
2637         SUB     P,[2,,2]                ; TRY TO RECOVER GRACEFULLY
2638         EXCH    P,GCPDL
2639         MOVEI   A,DOAGC         ; SET UP TO IMMEDIATE GC
2640 IFN ITS,[
2641         HRRM    A,TSINTR
2642 ]
2643 IFE ITS,[
2644         SKIPE   MULTSG
2645          HRRM   A,TSINTR+1
2646         SKIPN   MULTSG
2647          HRRM   A,TSINTR
2648 ]
2649 IFN ITS,        .DISMIS TSINTR
2650 IFE ITS,        DEBRK
2651
2652 DOAGC:  SKIPE   PGROW
2653         SUB     P,[2,,2]        ; ALLOW ROOM FOR CALL
2654         JSP     E,PDL3          ; CLEANUP
2655         ERRUUO  EQUOTE PDL-OVERFLOW-BUFFER-EXHAUSTED
2656
2657
2658 DLOSER: PUSH    P,LOSRS(B)
2659         MOVE    A,TSAVA
2660         MOVE    B,TSAVB
2661         POPJ    P,
2662
2663 LOSRS:  IMPV
2664         ILOPR
2665         IOC
2666         IPURE
2667
2668
2669 ;MEMORY PROTECTION INTERRUPT
2670
2671 IOC:    FATAL   IO CHANNEL ERROR IN GARBAGE COLLECTOR
2672 IMPV:   FATAL   MPV IN GARBAGE COLLECTOR
2673
2674 IPURE:  FATAL   PURE WRITE IN GARBAGE COLLECTOR
2675 ILOPR:  FATAL   ILLEGAL OPEREATION IN GARBAGE COLLECTOR
2676
2677 IFN ITS,[
2678
2679 ;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO SETUP INTS
2680
2681 INTINT: SETZM   CHNCNT
2682         MOVE    A,[CHNCNT,,CHNCNT+1]
2683         BLT     A,CHNCNT+16.
2684         SETZM   INTFLG
2685         .SUSET  [.SPICLR,,[-1]]
2686         MOVE    A,MASK1         ;SET MASKS
2687         MOVE    B,MASK2
2688         .SETM2  A,              ;SET BOTH MASKS
2689         MOVSI   A,TVEC
2690         MOVEM   A,QUEUES
2691         SETZM   QUEUES+1        ;UNQUEUE ANY OLD INTERRUPTS
2692         SETZM   CURPRI
2693         POPJ    P,
2694 ]
2695 IFE ITS,[
2696
2697 ; INITIALIZE TENEX INTERRUPT SYSTEM
2698
2699 INTINT: CIS                     ; CLEAR THE INT WORLD
2700         SETZM   INTFLG          ; IN CASE RESTART
2701         MOVSI   A,TVEC          ; FIXUP QUEUES
2702         MOVEM   A,QUEUES
2703         SETZM   QUEUES+1
2704         SETZM   CURPRI          ; AND PRIORITY LEVEL
2705         MOVEI   A,MFORK         ; TURN ON MY INTERRUPTS
2706         SKIPN   MULTSG
2707          JRST   INTINM
2708         PUSHJ   P,@[DOSIR]      ; HACK TO TEMP GET TO SEGMENT 0
2709         JRST    INTINX
2710
2711 INTINM: MOVE    B,[-36.,,CHNTAB]
2712         MOVSI   0,1
2713         HLLM    0,(B)
2714         AOBJN   B,.-1
2715
2716         MOVE    B,[LEVTAB,,CHNTAB]      ; POINT TO TABLES
2717         SIR                     ; TELL SYSTEM ABOUT THEM
2718
2719 INTINX: MOVSI   D,-NCHRS
2720         MOVEI   0,40
2721         MOVEI   C,0
2722
2723 INTILP: SKIPN   A,CHRS(D)
2724         JRST    ITTIL1
2725         IOR     C,0
2726         MOVSS   A
2727         HRRI    A,(D)
2728         ATI
2729 ITTIL1: LSH     0,-1
2730         AOBJN   D,INTILP
2731
2732         DPB     C,[360600,,MASK1]
2733         MOVE    B,MASK1         ; SET UP FOR INT BITS
2734         MOVEI   A,MFORK
2735         AIC                     ; TURN THEM ON
2736         MOVEI   A,MFORK         ; DO THE ENABLE
2737         EIR
2738         POPJ    P,
2739
2740
2741 DOSIR:  MOVE    B,[-36.,,CHNTAB]
2742         MOVSI   0,<1_12.>+FSEG
2743         HLLM    0,(B)
2744         AOBJN   B,.-1
2745
2746         MOVEI   B,..ARGB        ; WILL RUN IN SEGMENT 0
2747 RMT [
2748 ..ARGB: 3
2749         LEVTAB
2750         CHNTAB
2751 ]
2752         XSIR
2753         POP     P,D
2754         HRLI    D,FSEG
2755         XJRST   C               ; GET BACK TO CALLING SEGMENT
2756 ]
2757 \f
2758
2759 ; CNTL-G HANDLER
2760
2761 MFUNCTION QUITTER,SUBR
2762
2763         ENTRY   2
2764         GETYP   A,(AB)
2765         CAIE    A,TCHRS
2766         JRST    WTYP1
2767         GETYP   A,2(AB)
2768         CAIE    A,TCHAN
2769         JRST    WTYP2
2770         MOVE    B,1(AB)
2771         MOVE    A,(AB)
2772 IFE ITS,        CAIE    ^O
2773         CAIN    B,^S            ; HANDLE CNTL-S
2774         JRST    RETLIS
2775         CAIE    B,7
2776         JRST    FINIS
2777
2778         PUSHJ   P,CLEAN         ; CLEAN UP I/O CHANNELS
2779         PUSH    TP,$TATOM
2780         PUSH    TP,EQUOTE CONTROL-G?
2781         MCALL   1,ERROR
2782         JRST    FINIS
2783
2784 RETLIS: MOVE    B,IMQUOTE LER,[LERR ]INTRUP
2785         PUSHJ   P,ILVAL         ; GET CURRENT VALUE
2786         PUSH    TP,A
2787         PUSH    TP,B
2788         MOVEI   B,-1(TP)
2789         PUSHJ   P,CHFSWP
2790         SUB     TP,[2,,2]
2791         MOVEI   D,(TB)          ; FIND A LISTEN OR ERROR TO RET TO
2792
2793 RETLI1: HRRZ    A,OTBSAV(D)
2794         CAIN    A,(B)           ; CHECK FOR WINNER
2795         JRST    FNDHIM
2796         HRRZ    C,FSAV(A)       ; CHECK FUNCTION
2797         CAIE    C,LISTEN
2798         CAIN    C,ERROR         ; FOUND?
2799         JRST    FNDHIM          ; YES, GO TO SAME
2800         CAIN    C,ERROR%        ; FUNNY ERROR
2801         JRST    FNDHIM
2802         CAIN    C,TOPLEV        ; NO ERROR/LISTEN
2803         JRST    FINIS
2804         MOVEI   D,(A)
2805         JRST    RETLI1
2806
2807 FNDHIM: PUSH    TP,$TTB
2808         PUSH    TP,D
2809         PUSHJ   P,CLEAN
2810         MOVE    B,(TP)          ; NEW FRAME
2811         SUB     TP,[2,,2]
2812         MOVEI   C,0
2813         PUSHJ   P,CHUNW         ; UNWIND?
2814         MOVSI   A,TATOM
2815         MOVE    B,IMQUOTE T
2816         JRST    FINIS
2817
2818 CLEAN:  MOVE    B,3(AB)         ; GET IN CHAN
2819         PUSHJ   P,RRESET
2820         MOVE    B,3(AB)         ; CHANNEL BAKC
2821         MOVE    C,BUFRIN(B)
2822         SKIPN   C,ECHO(C)       ; GET ECHO
2823         JRST    CLUNQ
2824 IFN ITS,[
2825         MOVEI   A,2
2826         CAMN    C,[PUSHJ P,MTYO]
2827         JRST    TYONUM
2828         LDB     A,[270400,,C]
2829 TYONUM: LSH     A,23.
2830         IOR     A,[.RESET]
2831         XCT     A
2832 ]
2833 IFE ITS,[
2834         MOVEI   A,101           ; OUTPUT JFN
2835         CFOBF
2836 ]
2837
2838 CLUNQ:  SETZB   A,CURPRI
2839         JRST    UNQUEU
2840
2841 \f
2842 IMPURE
2843 ONINT:  0               ; INT FUDGER
2844 INTBCK: 0               ; GO BACK TO THIS PC AFTER INTERRUPT
2845         MOVEM   TP,TPSAV(TB)            ; SAVE STUFF
2846         MOVEM   P,PSAV(TB)
2847 INTBEN: SKIPL   INTFLG          ; PENDING INTS?
2848         JRST    @INTBCK
2849         PUSH    P,A
2850         SOS     A,INTBCK
2851         SETZM   INTBCK
2852         MOVEM   A,LCKINT
2853         POP     P,A
2854         JRST    LCKINT+1
2855
2856
2857 IFN ITS,[
2858 ;RANDOM IMPURE CRUFT NEEDED
2859 CHNCNT: BLOCK   16.     ; # OF CHARS IN EACH CHANNEL
2860
2861 TSAVA:  0
2862 TSAVB:  0
2863 PIRQ:   0                       ;HOLDS REQUEST BITS FOR 1ST WORD
2864 PIRQ2:  0                       ;SAME FOR WORD 2
2865 PCOFF:  0
2866 MASK1:  200,,200100                     ;FIRST MASK
2867 MASK2:  0                       ;SECOND THEREOF
2868 CURPRI: 0               ; CURRENT PRIORITY
2869 RLTSAV: 0
2870 ]
2871 IFE ITS,[
2872 CHRS:   7                       ; CNTL-G
2873         23                      ; CNTL-O
2874         17                      ; CNTL-S
2875         BLOCK   NCHRS-3
2876
2877 NETJFN: BLOCK   NNETS
2878 MASK1:  CHNMSK
2879 RLTSAV: 0
2880 TSINTR:
2881 P1:     0
2882         0                       ; PC INT LEVEL 1 (1ST WORD IN 1 SEG MODE, 2D
2883                                 ;               IN MULTI SEG MODE)
2884 P2:     0
2885         0                       ; PC INT LEVEL 2
2886 P3:     0
2887         0                       ; PC INT LEVEL 3
2888 CURPRI: 0
2889 TSAVA:  0
2890 TSAVB:  0
2891 PIRQ:   0
2892 PIRQ2:  0
2893 IOCLOS: 0                       ; HOLDS LOSING JFN IN TNX IOC
2894 ]
2895 PURE
2896
2897 END
2898 \f