<mdl.int>/mudex.mid.183

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