<mdl.int>/interr.426

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