<mdl.int>/mudex.mid.177

   1 TITLE MUDEX -- TENEX  DEPENDANT MUDDLE CODE
   2
   3 RELOCATABLE
   4
   5 .INSRT MUDDLE >
   6 .INSRT STENEX >
   7
   8 MFORK==400000
   9 XJRST==JRST 5,
  10
  11 .GLOBAL %SSNAM,%RSNAM,%KILLM,%LOGOU,%SLEEP,%VALRE,NOTTY,DEMFLG,MSGTYP,TTYOP2
  12 .GLOBAL %UNAM,%XUNA,%JNAM,%XJNA,%RUNAM,%RXUNA,%RJNAM,%RXJNA,%GCJOB,%VALFI
  13 .GLOBAL %SHWND,%SHFNT,%GETIP,%INFMP,SGCLBK,TWENTY,MULTSG,MLTUUP
  14 .GLOBAL GCHN,WNDP,FRNP,MESSAG,INITFL,6TOCHS,SGSNAM,MTYO,PGINT,WHOAMI
  15 .GLOBAL %TOPLQ,IBLOCK,TMTNXS,TNXSTR,%HANG,ILLUUO,UUOH,IPCINI,CTIME,BFLOAT
  16 .GLOBAL GCRSET,%MPINT,%GBINT,%CLSMP,%GCJB1,%CLMP1,%SAVIN,%MPIN,%MPIN1,%IMSV1
  17 .GLOBAL %PURIF,%MPINX,%CLSJB,%KILJB,%IFMP1,%OPGFX,STOSTR,%SAVRP,%RSTRP,GETSQU
  18 .GLOBAL WIND,%FDBUF,%CWINF,P.TOP,BUFGC,PURBOT,%IFMP2,%CLSM1,GETBUF,KILBUF
  19 .GLOBAL CERR1,CERR2,CERR3,COMPERR,CALER1,%LDRDO,%MPRDO,SQBLK,SQLOD,SQKIL,GETSQU
  20 .GLOBAL SQUPNT,SFRK,IJFNS,GETJS,OPBLK,SJFNS,OPSYS,GCLDBK,ILDBLK,IJFNS1,TILDBL
  21 .GLOBAL TBINIT,PVSTOR,SECBLK,PURCLN,NSEGS,INTINT,PURBTB,%CLNCO,OUTRNG
  22 .GLOBAL MULTI,NOMULT,THIBOT
  23 .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
  24 .GLOBAL C%M20,C%M30,C%M40,C%M60
  25
  26 GCHN==0
  27 CTTRAP==1000
  28 CTEXST==10000
  29 CTREAD==100000
  30 CTEXEC==20000
  31 CTWRIT==40000
  32 CTCW==400
  33
  34 MFORK==400000
  35 CTREAD==100000          ; READ BIT
  36 CTEXEC==20000           ; EXECUTE BIT
  37 CTWRIT==40000           ; WRITE BIT
  38 CTCW==400               ; COPY ON WRITE
  39
  40
  41 FREAD==200000           ; READ BIT FOR OPENF
  42 FEXEC==40000            ; EXEC BIT FOR OPENF
  43 FTHAW==2000
  44 FWRITE==100000
  45
  46 GJ%SHT==1               ; SHORT FORM GTJFN
  47 GJ%OLD==100000          ; FILE MUST EXIST
  48 OP%36B==440000          ; 36 BIT BYTES
  49 OP%7B==700000           ; 7 BIT BYTES
  50 CR%CAP==200000
  51
  52 SQLOD:  MOVEI   A,1
  53         JRST    @[.+1]          ; RUN IN 0 FOR BIZARRE BUGS
  54         PUSHJ   P,GETBUF
  55         HRRM    B,SQUPNT
  56         HLRZ    A,SJFNS
  57         JUMPE   A,SQLOD1
  58         HRRZS   SJFNS
  59         CLOSF
  60          JFCL
  61 SQLOD1: HRROI   B,SQBLK
  62         SKIPE   OPSYS
  63         HRROI   B,TSQBLK
  64         MOVSI   A,GJ%SHT+GJ%OLD
  65         GTJFN
  66         FATAL   CANT GET SQUOZE
  67         HRLM    A,SJFNS
  68         MOVEI   D,(A)
  69         MOVE    B,[OP%36B,,FREAD]
  70         OPENF
  71         FATAL   CANT OPEN SQUOZE
  72         SIZEF
  73         FATAL   CANT SIZEF SQUOZE
  74         MOVSI   A,(D)
  75         MOVNS   B
  76         HRLM    B,SQUPNT
  77         HRRZ    B,SQUPNT
  78         ASH     B,-9.
  79         HRLI    B,MFORK
  80         MOVSI   C,CTREAD+CTEXEC
  81
  82         PMAP
  83         ADDI    A,1
  84         ADDI    B,1
  85         PMAP
  86         MOVEI   A,(D)
  87         CLOSF
  88         JFCL
  89         SKIPN   MULTSG
  90          POPJ   P,
  91         POP     P,B
  92         MOVEI   A,0
  93         XJRST   A
  94
  95
  96 SQKIL:  PUSHJ   P,KILBUF
  97         HLLZS   SQUPNT
  98 CPOPJ:
  99 %PURIF:
 100 %GETIP: POPJ    P,
 101
 102 GETSQU: HRRZ    0,SQUPNT
 103         JUMPN   0,CPOPJ
 104         JRST    SQLOD
 105
 106
 107 CTIME:  SKIPE   OPSYS                   ; skip if TOPS20
 108         JRST    .+4
 109         MOVEI   A,400000
 110         RUNTM
 111         JRST    .+2
 112         JOBTM                           ; get run time in milli secs
 113         IDIVI   A,400000
 114         FSC     B,233
 115         FSC     A,254
 116         FADR    B,A
 117         FDVRI   B,(1000.0)              ; Change to units of seconds
 118         MOVSI   A,TFLOAT
 119         POPJ    P,
 120
 121 ; THE GLOBAL SNAME
 122
 123 %RSNAM: PUSHJ   P,TMTNXS        ; GET STRING ON STACK (POINTER IN E)
 124         GJINF                   ; USER NUMBER IS IN A
 125         PUSHJ   P,INFSTR        ; MAKE INFO STRING
 126
 127 %SSNAM: POPJ    P,
 128
 129 ; KILL THE CURRENT JOB
 130
 131 %VALFI:
 132 %KILLM: HALTF
 133         POPJ    P,
 134
 135 ; STRING IS IN A
 136 %VALRE: HRROS   A
 137         RSCAN                   ; PASS STRING
 138          JFCL
 139         MOVEI   A,0
 140         RSCAN                   ; MAKE IT AVAILABLE FOR USE
 141          JFCL
 142         JRST    %KILLM
 143
 144 ; LOGOUT OF SYSTEM (MUST BE "TOP LEVEL")
 145
 146 %LOGOU: LGOUT
 147         POPJ    P,
 148
 149 ; GO TO SLEEP A WHILE
 150
 151 %SLEEP: IMULI   A,33.           ; TO MILLI SECS
 152         DISMS
 153         POPJ    P,
 154
 155 ; HANG FOR EVER
 156
 157 %HANG:  WAIT
 158
 159 ; READ JNAME
 160
 161 %RXJNA:
 162 %RJNAM: GETNM                   ; RETURNS SIXBIT IN A
 163         MOVEM   A,%JNAM
 164         POPJ    P,
 165
 166 ; READ UNAME
 167
 168 %RXUNA:
 169 %RUNAM: PUSHJ   P,TMTNXS        ; GET STRING ON STACK (POINTER IN E)
 170         GJINF                   ; USER NUMBER IS IN A
 171         MOVE    B,A             ; USER NUMBER TO B
 172         PUSHJ   P,INFST1        ; MAKE INFO STRING
 173 CPOPJ1: AOS     (P)             ; SKIP RETURN
 174         POPJ    P,
 175
 176 ; MAKE A STRING FROM DIRST GOODIES
 177 INFSTR: TDZA    0,0
 178 INFST1: MOVEI   0,1             ; FLAG WHETHER TO SCAN
 179         HRROI   A,1(E)          ; STRING POINTER IN A
 180         DIRST                   ; GET THE NAME
 181          FATAL ATTACHED DIRECTORY DOESN'TEXIST
 182         MOVEI   B,1(E)          ; A AND B BOUND STRING
 183         JUMPN   0,INFST2        ; NO NEED TO SCAN
 184         SKIPE   OPSYS
 185          JRST   INFST2
 186
 187         HRLI    B,440700
 188         MOVE    A,B
 189
 190         ILDB    0,B             ; FLUSH : AND <>
 191         CAIE    0,"<
 192         JRST    .-2
 193
 194         ILDB    0,B
 195         CAIN    0,">
 196         JRST    .+3
 197         IDPB    0,A
 198         JRST    .-4
 199
 200         MOVE    B,A
 201         MOVEI   0,0
 202         IDPB    0,B
 203         MOVEI   B,1(E)
 204
 205
 206 INFST2: SUBM    P,E             ; RELATIVIZE E
 207         PUSHJ   P,TNXSTR        ; BUILD STRING (IN A AND B)
 208         MOVE    C,(P)           ; GET RETURN PC FROM PUSHJ
 209         SUB     P,E             ; P BACK TO NORMAL
 210         JRST    (C)
 211
 212 ; HERE TO SEE IF WE ARE A TOP LEVEL JOB
 213
 214 %TOPLQ: GJINF
 215         JUMPL   D,CPOPJ1
 216         JRST    CPOPJ
 217
 218 ; ERRORS IN COMPILED CODE MAY END UP HERE
 219
 220 CERR1:  ERRUUO  EQUOTE NEGATIVE-ARGUMENT
 221
 222 CERR2:  ERRUUO  EQUOTE NTH-REST-PUT-OUT-OF-RANGE
 223
 224 CERR3:  ERRUUO  EQUOTE UVECTOR-PUT-TYPE-VIOLATION
 225
 226 COMPERR:
 227         ERRUUO  EQUOTE ERROR-IN-COMPILED-CODE
 228
 229 \f
 230 ; GET AN INFERIOR FOR THE GARBAGE COLLECTOR
 231
 232 %GCJOB: PUSH    P,A
 233         MOVEI   A,CR%CAP        ; GET BITS FOR FORK
 234         CFORK                   ; MAKE AN IFERIOR FORK
 235         FATAL CANT GET GC FORK
 236         MOVEM   A,GCFRK         ; SAVE HANDLE
 237         POP     P,A             ; RESTORE PAGE
 238         MOVEI   B,FRNP
 239         PUSHJ   P,%SHWND
 240         POPJ    P,
 241
 242 ; HERE TO SHARE WINDOW
 243
 244 %SHWNF: PUSH    P,0
 245         MOVE    0,GCFK1
 246         JRST    SHWND1
 247
 248 %SHWND: PUSH    P,0
 249         MOVE    0,GCFRK
 250
 251 SHWND1: PUSH    P,A
 252         PUSH    P,B
 253         PUSH    P,C
 254         ASH     B,1             ; TO CRETINOUT TENEX PAGE SIZE
 255         HRLI    B,MFORK
 256         ASH     A,1             ; TIMES 2
 257         HRL     A,0
 258         MOVSI   C,CTREAD+CTWRIT ; READ AND WRITE ACCESS
 259
 260         PMAP
 261         ADDI    A,1
 262         ADDI    B,1
 263         PMAP
 264         ASH     B,9.            ; POINT TO PAGE
 265         MOVES   (B)             ; CLOBBER TOP
 266         MOVES   -1(B)           ; AND UNDER
 267         POP     P,C
 268         POP     P,B
 269         POP     P,A
 270         POP     P,0
 271         POPJ    P,
 272
 273 ; HERE TO MAP INFERIOR BACK AND KILL SAME
 274
 275 %INFMP: PUSH    P,C
 276         PUSH    P,D
 277         PUSH    P,E
 278         ASH     A,1
 279         ASH     B,1
 280         MOVE    D,A             ; POINT TO PAGES
 281         MOVE    E,B             ; FOR COPYING
 282         PUSH    P,A             ; SAVE FOR TOUCHING
 283
 284 ; HERE FOR OPTIONAL MULTI FORK HACK
 285
 286         SKIPLE  A,SFRK          ; SKIP NOT ENABLED OR NOT ACTIVE
 287         KFORK                   ; FLUSH THE OLD EXTRA
 288
 289         MOVS    A,GCFRK
 290         SKIPE   SFRK                    ; SKIP IF NOT MULTI FORK
 291         HLRZM   A,SFRK                  ; SAVE THIS AS IT
 292         MOVSI   B,MFORK
 293         MOVSI   C,CTREAD+CTEXEC+CTCW    ; READ AND WRITE COPY
 294         SKIPE   SFRK
 295         MOVSI   C,CTREAD+CTEXEC+CTWRIT
 296
 297 LP1:    HRRI    A,(E)
 298         HRRI    B,(D)
 299         PMAP
 300         ADDI    E,1
 301         AOBJN   D,LP1
 302
 303 ; HERE TO TOUCH PAGES TO INSURE KEEPING THEM (KLUDGE)
 304
 305         POP     P,E             ; RESTORE MY FIRST PAGE #
 306         SKIPE   SFRK            ; SKIP IF NOT MULTI CASE
 307         JRST    ALDON
 308         MOVEI   A,(E)           ; COPY FOR LOOP
 309         ASH     A,9.            ; TO WORD ADDR
 310         MOVES   (A)             ; WRITE IT
 311         AOBJN   E,.-3           ; FOR ALL PAGES
 312
 313         MOVE    A,GCFRK
 314         KFORK
 315 ALDON:  POP     P,E
 316         POP     P,D
 317         POP     P,C
 318         POPJ    P,
 319
 320 ; HACK TO PRINT MESSAGE OF INTEREST TO USER
 321
 322 MESOUT: MOVSI   A,(JFCL)
 323         MOVEM   A,MESSAG        ; DO ONLY ONCE
 324         RESET
 325         SKIPE   SFRK
 326         SETOM   SFRK                    ; NO FORK TO HACK RIGGHT NOW
 327         PUSHJ   P,GETJS         ; GET SOME JFNS
 328
 329         MOVEI   A,400000
 330         MOVE    B,[1,,ILLUUO]
 331         MOVE    C,[40,,UUOH]
 332         SCVEC
 333         SETZB   SP,FRM          ; HACK TO AVOID LOSSAGE WITH GARBAGE IN SP
 334                                 ;       FIRST TIME
 335         PUSHJ   P,GCRSET
 336         MOVE    A,[MFORK,,THIBOT]
 337         MOVSI   B,CTREAD+CTEXEC
 338         MOVEI   0,777-THIBOT
 339         SPACS
 340         ADDI    A,1
 341         SOJGE   0,.-2
 342         PUSHJ   P,PGINT         ; INITIALIZE PAGE MAP
 343         GJINF
 344         AOJN    D,.+3           ; JUMP IF HAS TTY
 345         SETOM   DEMFLG
 346         SETOM   NOTTY
 347         SKIPN   DEMFLG
 348         JRST    TTON
 349         MOVEI   A,MFORK         ; GET FORK HANDLE
 350         RPCAP
 351         MOVE    C,B             ; HAIR TO ENABLE CAPABILITIES OF DEMON
 352         EPCAP
 353 TTON:   PUSHJ   P,TTYOP2
 354         SKIPN   DEMFLG          ; SKIP IF DEMON
 355         SKIPE   NOTTY           ; HAVE A TTY?
 356         JRST    RESNM           ; NO, SKIP THIS STUFF
 357
 358         MOVEI   A,MESBLK
 359         MOVEI   B,0
 360         GTJFN
 361         JRST    RESNM
 362         MOVE    B,[OP%7B,,FREAD]
 363         OPENF
 364         JRST    RESNM
 365
 366 MSLP:   BIN
 367         MOVE    D,B             ; SAVE BYTE
 368         GTSTS
 369         TLNE    B,1000
 370         JRST    RESNM
 371         EXCH    D,A
 372         CAIN    A,14
 373         PBOUT
 374         MOVE    A,D
 375         JRST    MSLP
 376
 377 RESNM2: CLOSF
 378 IPCINI: JFCL
 379
 380 RESNM:  PUSHJ   P,TWENTY
 381 RESNM1: SKIPN   MULTSG
 382          POPJ   P,
 383         POP     P,C             ; STAY IN MAIN SEG
 384         HRLI    C,FSEG
 385         JRST    (C)
 386
 387 \f
 388 ; GET JFNS TO MDL INTERPRETER, AGC AND SGC, SAVE IN IJFNS AND IJFNS1
 389 GETJS:  MOVEI   A,$TLOSE
 390         LSH     A,-11
 391         HRLI    A,MFORK         ; THIS FORK
 392         RMAP
 393         JUMPGE  A,GETJS1        ; HAPPY?
 394 ; HERE TO GET MDL INTERPRETER JFN EXPLICITLY RATHER THAN THROUGH RMAP
 395         HRROI   B,ILDBLK
 396         SKIPE   OPSYS
 397          HRROI  B,TILDBL
 398         MOVSI   A,GJ%SHT+GJ%OLD
 399         GTJFN
 400          FATAL  INTERPRETER EXE FILE MISSING
 401         MOVE    B,[OP%36B,,FREAD+FWRITE]
 402         OPENF
 403          FATAL  CANT OPEN MDL INTERPRETER EXE FILE
 404         HRLM    A,A
 405 GETJS1: HLRZM   A,IJFNS                 ; SAVE JFN TO INTERPRETER
 406         POPJ    P,
 407
 408 ; GTJFN BLOCK FOR MESSAGE FILE
 409 MESBLK: 100000,,
 410         377777,,377777
 411         -1,,[ASCIZ /DSK/]
 412         -1,,[ASCIZ /MDL/]
 413         -1,,[ASCIZ /MUDDLE/]
 414         -1,,[ASCIZ /MESSAG/]
 415         0
 416         0
 417         0
 418
 419 MUDINT: MOVSI   0,(JFCL)        ; CLOBBER MUDDLE INIT SWITCH
 420         MOVEM   0,INITFL
 421
 422 ; LOOP TO TOUCH ALL PAGES SO PURIFY CAN WORK
 423
 424         SKIPN   A,DEMFLG                ; SKIP IF A DEMON
 425         JRST    FINDIR          ; GET USERS DIRECTORY
 426         AOJE    A,FINDIR
 427         MOVE    A,DEMFLG        ; GET SIXBIT OF DIRECTORY NAME
 428         PUSHJ   P,6TOCHS                ; TO CHARACACTER STRING
 429         JRST    DIRCON
 430
 431 FINDIR: GJINF                   ; GET INFO NEEDED
 432         MOVEM   A,SJFNS
 433         PUSHJ   P,TMTNXS        ; MAKE A TEMP STRING FOR TENEX INFO
 434                                 ;       (POINTER LEFT IN E)
 435         PUSHJ   P,INFSTR
 436 DIRCON: PUSH    TP,$TATOM
 437         PUSH    TP,IMQUOTE SNM
 438         PUSH    TP,A
 439         PUSH    TP,B
 440         MCALL   2,SETG
 441         SKIPE   WHOAMI
 442         JRST    SUBSYS
 443         MOVE    A,[SIXBIT/MUDDLE/]
 444         PUSHJ   P,6TOCHS        ; MAKE A CHARACTER STRING
 445         PUSH    TP,$TCHSTR
 446         PUSH    TP,CHQUOTE READ
 447         PUSH    TP,A
 448         PUSH    TP,B
 449         PUSH    TP,$TCHSTR              ; NOW THE .INIT
 450         PUSH    TP,CHQUOTE .INIT
 451         MCALL   2,STRING                ; MAKE A STRING
 452         PUSH    TP,A            ; ARGS TO FOPEN
 453         PUSH    TP,B
 454         MCALL   2,FOPEN
 455         GETYP   A,A
 456         CAIN    A,TCHAN
 457         JRST    ISVCHN
 458 SUBSYS: PUSH    TP,$TCHSTR
 459         PUSH    TP,CHQUOTE READ
 460         MOVE    A,[SIXBIT /MUDDLE/]
 461         SKIPE   WHOAMI
 462         MOVE    A,WHOAMI
 463         PUSHJ   P,6TOCHS
 464         PUSH    TP,A
 465         PUSH    TP,B
 466         PUSH    TP,$TCHSTR
 467         PUSH    TP,CHQUOTE INIT
 468         PUSH    TP,$TCHSTR
 469         PUSH    TP,CHQUOTE DSK
 470         PUSH    TP,$TCHSTR
 471         PUSH    TP,CHQUOTE MUDDLE
 472         MCALL   5,FOPEN
 473         GETYP   A,A
 474         CAIE    A,TCHAN
 475         POPJ    P,
 476 ISVCHN: PUSH    TP,$TCHAN
 477         PUSH    TP,B
 478         MOVEI   B,INITSTR       ; TELL USER WHAT'S HAPPENING
 479         SKIPE   WHOAMI
 480         JRST    INCOM
 481         SKIPE   DEMFLG          ; SKIP IF NOT A DEMON
 482         JRST    INCOM
 483         SKIPN   NOTTY
 484         PUSHJ   P,MSGTYP
 485 INCOM:  MCALL   1,MLOAD
 486         POPJ    P,
 487
 488 TMTNXS: POP     P,D             ; SAVE RET ADDR
 489         MOVE    E,P             ; BUILD A STRING SPACE ON PSTACK
 490         MOVEI   0,20.           ; USE 20 WORDS (=100 CHARS)
 491         PUSH    P,C%0
 492         SOJG    0,.-1
 493
 494         JRST    (D)
 495
 496
 497 TNXSTR: SUBI    B,(P)
 498         PUSH    P,B
 499         ADDI    B,-1(P)
 500         SUBI    B,(A)           ; WORDS TO B
 501         IMULI   B,5             ; TO CHARS
 502         LDB     0,[360600,,A]   ; GET BYTE POSITION
 503         IDIVI   0,7             ; TO  A REAL BYTE POSITION
 504         MOVNS   0
 505         ADDI    0,5
 506         SUBM    0,B             ; FINAL LENGTH IN BYTES TO B
 507         PUSH    P,B             ; SAVE IT
 508         MOVEI   A,4(B)          ; TO WORDS
 509         IDIVI   A,5
 510         PUSH    P,E             ; SAVE E
 511         PUSHJ   P,IBLOCK        ; GET STRING
 512         POP     P,E
 513         POP     P,A
 514         POP     P,C
 515         ADDI    C,(P)
 516         MOVE    D,B             ; COPY POINTER
 517         MOVE    0,(C)           ; GET A WORD
 518         MOVEM   0,(D)
 519         ADDI    C,1
 520         AOBJN   D,.-3
 521
 522         HRLI    A,TCHSTR
 523         HRLI    B,00700 ; MAKE INTO BYTER
 524         SOJA    B,CPOPJ
 525
 526 INITSTR:        ASCIZ /MUDDLE INIT/
 527
 528 ; HERE TO RECOPY PAGE 0 WHICH CONTAINS IMFORMATION FOR REMAPPING IN INFERIOR
 529 %OPGFX: PUSH    P,B             ; SAVE B
 530         PUSH    P,A
 531         MOVEI   B,STOSTR                ; TOP OF CONSTANTS
 532         ADDI    B,1777          ; ROUND
 533         ANDCMI  B,1777
 534         ASH     B,-10.          ; TO PAGES
 535         MOVN    A,B
 536         MOVEI   B,WNDP          ; GET WINDOW
 537         HRLZS   A               ; START WITH PAGE 0
 538 OPGFX2: JUMPGE  A,OPGFX1
 539         PUSH    P,A
 540         HRRZS   A
 541         PUSHJ   P,%SHWNF
 542         HRRZ    A,(P)
 543         ASH     A,10.           ; TO START OF PAGE
 544         HRLS    A               ; SET UP BLT POINTER
 545         HRRI    A,WIND
 546         MOVEI   B,WIND
 547         BLT     A,1777(B)       ; OUT INTO THE BUFFER
 548         POP     P,A             ; RESTORE A
 549         AOBJN   A,OPGFX2
 550 OPGFX1: POP     P,A
 551         POP     P,B
 552         POPJ    P,
 553
 554 ; ROUTINE TO PROTECT A CORE IMAGE BY SAVING IT IN AN INFERIOR
 555 ; A==FORK HANDLE B== AOBJN POINTER
 556
 557
 558 PROTCT: TRNN    B,-1            ; SEE IF PAGE 0 IS INCLUDED
 559         ADD     B,C%11          ; INC PAGE
 560         ASH     B,1
 561         PUSH    P,C             ; SAVE C
 562         MOVE    C,B             ; COPY AOBJN
 563         MOVSI   A,MFORK         ; FORK HANDLE
 564         JUMPE   C,PRTDON        ; IF ZERO THEN WE ARE DONE
 565 PROTC1: HRRI    A,(C)           ; GET PAGE
 566         HRRZ    D,C
 567         ASH     D,9.
 568         RPACS
 569         TLNN    B,CTWRIT+CTCW   ; SKIP IF NOT READ ONLY
 570          TLNN   B,CTEXST        ; SKIP IF EXISTS (OTHERWISE WE'LL CREATE IT)
 571           MOVES 20(D)           ; TOUCH PAGE
 572         MOVSI   B,CTREAD+CTEXEC ; SET UP TO MARK PAGES TO TRAP ON ANY REF
 573         SPACS                   ; CHANGE MODE OF PAGE
 574         AOBJN   C,PROTC1
 575 PRTDON: POP     P,C             ; RESTORE C
 576         POPJ    P,
 577
 578 %FDBUF: HRRZ    A,PURBOT
 579         SUB     A,P.TOP         ; CALCULATE ROOM FOR PROSPECTIVE BUFFER
 580         CAIG    A,2000          ; SEE IF ROOM
 581         JRST    FDBUF1
 582         MOVE    A,P.TOP         ; START OF BUFFER
 583         HRRM    A,BUFGC
 584         POPJ    P,
 585 FDBUF1: SETOM   BUFGC           ; INDICATE NO BUFFER FOUND
 586         POPJ    P,
 587
 588 ; HERE TO SIMULATE A COPY ON WRITE TO AN INFERIOR.  IF A PAGE HAS NO WRITE BITS
 589 ; IT WILL COPY IT INTO THE GCFRK1 FORK. A== START OF PAGE, B== START OF BUFFER PAGE
 590
 591 %CWINF: PUSH    P,A
 592         PUSH    P,B             ; SAVE AC'S
 593         PUSH    P,C
 594         ANDI    A,-1            ; CLEAN OUT LEFT HALF OF A
 595         ASH     A,-9.           ; TO PAGES
 596         PUSH    P,C%0
 597         HRLI    A,MFORK         ; GET FORK HANDLE
 598         RPACS                   ; READ PAGE BITS
 599         MOVEM   B,(P)
 600         TLNE    B,CTEXST        ; SKIP IF DOESN'T EXIST
 601          TLNE   B,CTWRIT        ; SEE IF WRITABLE
 602           JRST  CWINFX          ; NO, EXIT
 603         MOVSI   B,CTEXEC+CTREAD+CTCW
 604         SPACS                   ; RESTORE PAGE TO NORMAL
 605 CWINFX: ADDI    A,1
 606         RPACS                   ; READ PAGE BITS
 607         TLNE    B,CTEXST        ; SKIP IF DOESN'T EXIST
 608          TLNE   B,CTWRIT        ; SEE IF WRITABLE
 609           JRST  CWINFY          ; NO, EXIT
 610         MOVSI   B,CTEXEC+CTREAD+CTCW
 611         SPACS
 612         SUB     P,C%11
 613         JRST    CWINFZ
 614 CWINFY: POP     P,B
 615         TLNE    B,CTEXST        ; SKIP IF DOESN'T EXIST
 616          TLNE   B,CTWRIT        ; SEE IF WRITABLE
 617           JRST  CWINF1          ; NO, EXIT
 618 CWINFZ: HRRZI   A,-1(A)
 619         ASH     A,-1
 620         MOVE    B,-1(P)         ; SET UP BUFFER PAGE
 621         ASH     B,-10.          ; TO PAGE NUMBER
 622         PUSHJ   P,%SHWNF        ; SHARE A WINDOW
 623         HRLZ    A,-2(P)         ; PREPARE FOR BLT
 624         HRR     A,-1(P)
 625         HRRZ    B,-1(P)
 626         BLT     A,1777(B)       ; SAVE THE PAGE
 627 CWINF1: MOVE    B,-1(P)
 628         ASH     B,-9.           ; TO PAGES
 629         MOVNI   A,1
 630         HRLI    B,MFORK         ; SET UP HANDLE
 631         MOVEI   C,0
 632         PMAP                    ; FLUSH BUFFER
 633         POP     P,C
 634         POP     P,B
 635 POPAJ:  POP     P,A
 636         POPJ    P,
 637
 638
 639
 640 ; ROUTINE TO RESTORE THE IMAGE FROM A SAVED FORK IMAGE.
 641 ; A== FORK HANDLE  B== AOBJN POINTER TO MUDDLE
 642 ; C== START IN INF
 643
 644
 645 RSTIM:  ASH     B,1             ; TO CONVERT TO TENEX PAGES
 646         ASH     C,1
 647         HRLZS   A               ; FORK HANDLE TO LEFT HALF
 648         JUMPE   C,RSTIM1        ; SEE IF NO WORK TO DO
 649 RSTIM2: HRRI    A,(C)
 650         PUSH    P,B             ; SAVE B
 651         RPACS                   ; READ PAGE BITS
 652         TLNN    B,CTEXST        ; SKIP IF IT EXISTS
 653         JRST    RSTIM3
 654         HRRZ    B,(P)           ; GET PAGE
 655         HRLI    B,MFORK         ; GET PAGE BACK TO ME
 656         PUSH    P,C
 657         MOVSI   C,CTREAD+CTCW+CTEXEC    ; PAGE MODES
 658         PMAP                    ; GET THE PAGE
 659         POP     P,C             ;RESTORE C
 660         ASH     B,9.            ; TO START OF PAGE
 661         MOVES   20(B)           ; TOUCH PAGE
 662 RSTIM3: POP     P,B             ; GET BACK B
 663         ADDI    C,1             ; INC C
 664         AOBJN   B,RSTIM2        ; GO BACK IN LOOP
 665 RSTIM1: POPJ    P,              ; DONE
 666
 667
 668 ; ROUTINE TO MAP OUT PARTS OF THE INTERPRETER IN ORDER TO PRESERVE IT
 669
 670 %MPINX: MOVE    0,GCFK1
 671         JRST    MPIN
 672
 673 %MPIN:
 674 %MPIN1: MOVE    0,GCFRK
 675 MPIN:   PUSH    P,C             ; SAVE B
 676         MOVE    C,A
 677         MOVE    A,0             ; GET FORK HANDLE
 678         PUSHJ   P,RSTIM
 679         POP     P,C
 680         POPJ    P,              ; EXIT
 681
 682 %SAVIN: PUSH    P,B             ; SAVE AC'S
 683         PUSH    P,A
 684         MOVSI   A,CR%CAP
 685         CFORK
 686         FATAL AGC--CAN'T GET GC FORK
 687         MOVEM   A,GCFK1         ; SAVE FORK HANDLE
 688         POP     P,B             ; RESTORE AOBJN
 689         PUSHJ   P,PROTCT        ; PROTECT IMAGE
 690         POP     P,B             ; RESTORE AC
 691         POPJ    P,
 692
 693 %MPRDO: HRLI    B,-1
 694         HRR     B,A
 695         JRST    PROTCT
 696
 697
 698 ; CREATE A JOB FOR MARKING HACKS (PURIFY AND GC-DUMP) AND SAVES HANDLE IN TWO SEPERATE
 699 ; PLACES.
 700
 701 %GCJB1: PUSHJ   P,%GCJOB        ; CREATE FORK
 702         MOVE    A,GCFRK         ; GET HANDLE
 703         MOVEM   A,GCFK2
 704         POPJ    P,
 705
 706 %CLSMP: MOVE    0,GCFK2         ; GET BACK FROM FORK CONTAINING UPDATED WORLD
 707         PUSHJ   P,%GBINT
 708 %CLSM1: MOVE    A,GCFK2         ; KILL THE FORK
 709 KFK1:   KFORK
 710 %IFMP1:
 711 %CLSJB: POPJ    P,              ; IN ITS CLOSES AN INFERIORS CHANNEL WITHOUT
 712                                 ;        KILLING IT
 713
 714 ; HERE TO KILL THE IMAGE SAVING INFERIOR
 715
 716 %KILJB: PUSH    P,A             ; SAVE MAPPING PARAMS
 717         MOVE    A,GCFK1
 718         KFORK
 719         JRST    IFMP3           ; GO FIX UP CORE IMAGE
 720
 721 ; HERE TO MAP IN SAVED WORLD AND KILL INF CONTAINING IT
 722
 723 ;%IFMP1:        POPJ    P,
 724
 725 ; HERE TO MAP IN A PAGE IN READ ONLY MODE FROM THE AGD INFERIOR
 726
 727 %LDRDO: MOVE    0,GCFK1
 728         PUSH    P,A             ; SAVE PAGE POINTER
 729         MOVE    B,A
 730         HRLI    B,-1            ; MAKE UP PAGE POINTER
 731         PUSHJ   P,MPIN          ; MAP IN THE PAGES
 732         HRLI    B,CTREAD+CTEXEC
 733         HRLI    A,MFORK         ; SET UP HANDLE
 734         HRR     A,(P)
 735         ASH     A,1             ; CONVERT TO TENEX PATES
 736         HRRZ    C,A
 737         ASH     C,9
 738         MOVES   20(C)
 739         SPACS
 740         ADDI    A,1
 741         HRRZ    C,A
 742         ASH     C,9
 743         MOVES   20(C)
 744         SPACS
 745         SUB     P,C%11          ; CLEAN OFF STACK
 746         POPJ    P,
 747
 748 %IFMP2: PUSH    P,A             ; SAVE POINTER
 749         MOVE    0,GCFK1
 750         PUSHJ   P,MPIN          ; MAP IT IN
 751         MOVE    A,GCFK1         ; KILL IT
 752         KFORK
 753 IFMP3:  POP     P,C
 754         ASH     C,1
 755         MOVSI   A,MFORK         ; SET UP FORK HANDLE
 756         JUMPGE  C,IFMP2         ; IF DONE
 757 DORPA:  HRR     A,C             ; GET PAGE #
 758         RPACS
 759         TLNN    B,CTEXST        ; SKIP IF IT EXISTS
 760          JRST   .+3
 761         MOVSI   B,CTREAD+CTWRIT+CTEXEC  ; CAPABILATIES
 762         SPACS                   ; SET CAPABILATIES
 763         AOBJN   C,DORPA
 764 IFMP2:  POPJ    P,
 765
 766
 767 %CLMP1: MOVE    A,GCFK1         ; KILL THE FIRST FORK
 768         JRST    KFK1
 769
 770 %IMSV1:
 771 %MPINT: PUSH    P,C             ; SAVE C
 772         PUSH    P,B
 773         PUSH    P,D
 774         ASH     A,1
 775         MOVEI   C,0
 776         MOVE    D,A
 777 MPINT1: MOVSI   A,MFORK         ; SET UP ARGS TO RMAP
 778         HRRI    A,(D)
 779         RMAP
 780         MOVEM   A,RMPTAB(C)
 781         ADDI    C,1
 782         AOBJN   D,MPINT1
 783         POP     P,D
 784         POP     P,B
 785         POP     P,C
 786         POPJ    P,
 787
 788
 789 ; ROUTINE TO GET BACK THE INTERPRETER.  IT MAPS
 790 %GBINT: PUSH    P,E
 791         PUSH    P,B
 792         PUSH    P,C             ; SAVE AC'S
 793         PUSH    P,D
 794         ASH     A,1
 795         MOVE    D,A             ; COPY UDDATED AOBJN
 796         MOVEI   E,0             ; ZERO INDEX TO TABLE
 797 GBINT1: MOVE    A,RMPTAB(E)     ; GET FILE HANDLE
 798         MOVSI   B,MFORK         ; SET UP INTERPRETER ARG
 799         HRRI    B,(D)
 800         MOVSI   C,CTREAD+CTEXEC+CTCW
 801         PMAP                    ; IN IT COMES
 802         ADDI    E,1             ; INC INDEX
 803         AOBJN   D,GBINT1
 804         POP     P,D
 805         POP     P,C
 806         POP     P,B
 807         POP     P,E
 808         POPJ    P,
 809
 810 ; HERE TO SAVE RMAP TABLE FOR PURIFY
 811
 812 %SAVRP: PUSH    P,A             ; SAVE AC
 813         MOVE    A,[RMPTAB,,ORMTAB]
 814         BLT     A,ENDRPT-1      ; SAVE RMAP TABLE
 815         JRST    POPAJ
 816 ;       POP     P,A             ; RESTORE A
 817 ;       POPJ    P,
 818
 819 ; HERE TO RESTORE THE RMAP TABLE FOR PURIFY
 820
 821 %RSTRP: PUSH    P,A             ; SAVE A
 822         MOVE    A,[ORMTAB,,RMPTAB]
 823         BLT     A,ORMTAB-1
 824         JRST    POPAJ
 825 ;       POP     P,A             ; RESTORE A
 826 ;       POPJ    P,
 827
 828 SQBLK:  ASCIZ /PS:<MDL>MDLXXX.SQUOZE/
 829 TSQBLK: ASCIZ /DSK:<MDL>MDLXXX.SQUOZE/
 830
 831 ; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME
 832
 833 TWENTY: HRROI   A,C                             ; RESULTS KEPT HERE
 834         HRLOI   B,600015
 835         MOVEI   C,0                             ; CLEAN C UP
 836         DEVST
 837          JFCL
 838         MOVEI   A,1                             ; TENEX HAS OPSYS = 1
 839         CAME    C,[ASCII/NUL/]                  ; TOPS20 GIVES "NUL"
 840          MOVEM  A,OPSYS                         ; TENEX  GIVES "NIL"
 841         POPJ    P,
 842
 843 ;%CLNCO -- FLUSH SOME PAGES FOR SAFETY
 844 ; C ==> ADDR OF PAGE PREV TO LOSERS
 845 ; E ==> JUST ABOVE LOSERS
 846
 847 %CLNCO: PUSH    P,C
 848         PUSH    P,E
 849         ADDI    C,777
 850         ASH     C,-9.
 851         ASH     E,-9.
 852         CAIG    E,1(C)
 853          JRST   %CLN1
 854         PUSH    P,A
 855         PUSH    P,B
 856
 857         MOVSI   B,MFORK
 858         HRRI    B,(C)
 859         MOVNI   A,1
 860         MOVEI   C,0
 861
 862         PMAP
 863         CAIL    E,2(B)
 864          AOJA   B,.-2
 865
 866         POP     P,B
 867         POP     P,A
 868
 869 %CLN1:  POP     P,E
 870         POP     P,C
 871         POPJ    P,
 872
 873
 874 ; MULTI -- ENTER MULTI SEGMENT MODE
 875 ; THIS ROUTINE MAPS EVERYTHING UP AND THEN GOES UP THERE
 876
 877 MULTI:  PUSHJ   P,PURCLN        ; UNMAP ANY CORRENTLY MAPPED FBINS
 878         PUSHJ   P,SQKIL         ; AND SQUOZE TABLE
 879         SETOM   MULTSG
 880         MOVE    A,PURBOT        ; MUNG TABLE OF THESE GUYS
 881         MOVN    B,NSEGS
 882         MOVSI   B,(B)-1
 883
 884         MOVEM   A,PURBTB(B)
 885         AOBJN   B,.-1
 886
 887         MOVE    A,VECTOP        ; CWRITE GC SPACE
 888         ANDCMI  A,777
 889         MOVES   (A)
 890         SUBI    A,1000
 891         JUMPG   A,.-2
 892
 893         MOVEI   A,0             ; FIRST CREATE OTHER SECTIONS
 894         MOVE    B,[MFORK,,FSEG]
 895         MOVE    C,[CTREAD+CTWRIT+CTEXEC,,1]
 896         MOVE    D,NSEGS
 897         SMAP
 898         ADDI    B,1
 899         SOJG    D,.-2
 900
 901 ; CREATE GC SEGMENT
 902
 903         HRRI    B,GCSEG
 904         SMAP
 905
 906 ; NOW LOOP AROUND MAPPING PAGES (MAY TAKE SOME TIME)
 907
 908         MOVEI   D,FSEG_9.
 909         MOVEI   PVP,FSEG
 910         ADD     PVP,NSEGS
 911         LSH     PVP,9.          ; PVP NOW HIGHEST PAGE TO MAP
 912         MOVSI   E,-1000         ; 1ST PAGE AND COUNTER
 913
 914 PAGLP:  MOVSI   A,MFORK
 915         HRRI    A,(E)
 916         RMAP
 917         CAME    A,C%M1
 918          JRST   .+3
 919         MOVSI   A,MFORK
 920         HRRI    A,(E)
 921         MOVSI   B,MFORK
 922         HRRI    B,(E)
 923         IORI    B,(D)
 924         MOVSI   C,CTREAD+CTWRIT+CTEXEC
 925         PMAP
 926 LPON:   AOBJN   E,PAGLP
 927
 928         MOVSI   E,-1000
 929         ADDI    D,1_9.
 930         CAMGE   D,PVP
 931         JRST    PAGLP
 932
 933 ; SETUP MULTI SEG LUUO HANDLER
 934
 935         MOVEI   A,MFORK
 936         MOVEI   B,2             ; CODE FOR SETUP OF UUO TABLE
 937         MOVE    C,[FSEG,,MLTUUP]
 938         SWTRP
 939         MOVEI   C,FSEG
 940         MOVE    B,PVSTOR+1
 941         MOVE    B,TBINIT+1(B)
 942         HRLM    C,PCSAV(B)
 943         PUSHJ   P,INTINT
 944
 945         POP     P,C
 946         HRLI    C,FSEG          ; MAKE INTO FUNNY ADDRESS
 947         MOVEI   B,0
 948         TLO     TB,400000       ; MAKE TB BE A LOCAL INDEX
 949         XJRST   B
 950
 951 NOMULT: PUSHJ   P,PURCLN
 952         JRST    @[.+1]          ; RUN IN SECTION 0
 953         SETZM   MULTSG
 954         MOVNI   A,1
 955         MOVE    B,[MFORK,,FSEG]
 956         MOVEI   C,1
 957         MOVE    D,NSEGS
 958         SMAP
 959         ADDI    B,1
 960         SOJG    D,.-2
 961
 962 ; FLUSH GC SEG
 963
 964         HRRI    B,GCSEG
 965         SMAP
 966
 967         JRST    INTINT
 968 ;       PUSHJ   P,INTINT
 969 ;       POPJ    P,
 970
 971 MFUNCTION MMS,SUBR,MULTI-SECTION
 972
 973         ENTRY
 974
 975         PUSH    P,NSEGS
 976         PUSH    P,MULTSG
 977         JUMPGE  AB,RMULT                ; NO ARGS==>LEAVE
 978         CAMGE   AB,C%M30                ; [-3,,]
 979          JRST   TMA
 980         GETYP   0,(AB)
 981         CAIE    0,TFIX
 982          JRST   INOUT
 983         MOVE    0,1(AB)
 984         CAIL    0,2
 985          CAILE  0,30
 986           JRST  OUTRNG
 987         MOVEM   0,NSEGS
 988 INOUT:  GETYP   0,(AB)
 989         CAIE    0,TFALSE
 990          JRST   EMULT
 991 LMULT:  SKIPE   (P)
 992         PUSHJ   P,NOMULT
 993         JRST    RMULT
 994
 995 EMULT:  SKIPN   (P)
 996         PUSHJ   P,MULTI
 997
 998 RMULT:  POP     P,A
 999         POP     P,B                     ; POSSIBLE PREV NSEGS
1000         JUMPN   A,TMULT
1001         MOVSI   A,TFALSE
1002         MOVEI   B,0
1003         JRST    FINIS
1004
1005 TMULT:  MOVSI   A,TFIX
1006         JRST    FINIS
1007 IMPURE
1008
1009 DEMFLG: 0                       ; FLAG INDICATING DEMON
1010                                 ;       (IF DEMON SIXBIT OF DIRECTORY)
1011 SFRK:   -1                      ; FLAG FOR EXTRA INFERIOR HACK
1012 GCFRK:  0
1013 GCFK1:  0
1014 GCFK2:  0
1015 RMPTAB: BLOCK 25.
1016 ORMTAB: BLOCK 25.
1017 ENDRPT:
1018
1019 MESSAG: PUSHJ   P,MESOUT        ; MESSAGE SWITCH
1020
1021 INITFL: PUSHJ   P,MUDINT        ; MUDDLE INIT SWITCH
1022
1023 PURE
1024
1025 END