system/dskdmp.215

   1 ;;; -*-Midas-*-
   2 ;;; Copyright (c) 1999 Massachusetts Institute of Technology
   3 ;;;
   4 ;;; This program is free software; you can redistribute it and/or
   5 ;;; modify it under the terms of the GNU General Public License as
   6 ;;; published by the Free Software Foundation; either version 3 of the
   7 ;;; License, or (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;; General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with this program; if not, write to the Free Software
  16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17
  18
  19 TITLE DSKDMP
  20
  21 .MLLIT==1
  22
  23 DEFINE SETF TEXT,FLG
  24 IFDEF FLG,.STOP
  25 .TAG FOOBAR
  26 PRINTC "TEXT
  27 FLG="
  28 .TTYMAC FLAG
  29 .TTYFLG==.TTYFLG+1
  30 PRINTX/FLAG
  31 /
  32 .TTYFLG==.TTYFLG-1
  33 IFSE FLAG,YES,FLG==1
  34 IFSE FLAG,NO,FLG==0
  35 IFSE FLAG,Y,FLG==1
  36 IFSE FLAG,N,FLG==0
  37 IFNDEF FLG,FLG==FLAG
  38 TERMIN
  39 IFNDEF FLG,.GO FOOBAR
  40 TERMIN
  41
  42 IF1,[
  43 PRINTC "Configuration (KSRP06, KSRP07, KSRM03, KSRM80 or ASK) ? "
  44 .TTYMAC MACH
  45 IFSE MACH,KSRP06,[
  46         HRIFLG==0
  47         RP06P==1
  48         KS10P==1
  49         NUDSL==500.
  50 ] ;KSRP06
  51 IFSE MACH,KSRP07,[
  52         HRIFLG==0
  53         RP06P==0
  54         RP07P==1
  55         KS10P==1
  56         NUDSL==500.
  57 ] ;KSRP07
  58 IFSE MACH,KSRM03,[
  59         HRIFLG==0
  60         RP06P==0
  61         RP07P==0
  62         RM03P==1
  63         KS10P==1
  64         NUDSL==500.
  65 ] ;KSRM03
  66 IFSE MACH,KSRM80,[
  67         HRIFLG==0
  68         RP06P==0
  69         RP07P==0
  70         RM03P==0
  71         RM80P==1
  72         KS10P==1
  73         NUDSL==500.
  74 ] ;KSRM80
  75 IFSN MACH,ASK,[
  76 IFNDEF NUDSL,[ PRINTC /No known configuration for "MACH".
  77 / ]]
  78 TERMIN
  79 ] ;IF1
  80
  81 SETF [Readin Mode Paper Tape?]HRIFLG
  82 SETF [Assemble BOOT? (If no, full DSKDMP)]BOOTSW
  83
  84 SETF [RH11/RP06 disk system?]RP06P
  85 IFE RP06P,[
  86 SETF [RH11/RP07 disk system?]RP07P
  87 IFE RP07P,[
  88 SETF [RH11/RM03 disk system?]RM03P
  89 IFE RM03P,[
  90 SETF [RH11/RM80 disk system?]RM80P
  91 IFE RM80P,[
  92 SETF [RH10 (MC-KL) disk control?]RH10P
  93 IFE RH10P,[
  94 SETF [AIKA disk control? (no => RP02/RP03)]DC10P
  95 ]]]]]
  96 IFN RP06P, RP07P==0
  97 IFN RP06P+RP07P, RM03P==0
  98 IFN RP06P+RP07P+RM03P, RM80P==0
  99 IFN RP06P+RP07P+RM03P+RM80P, RH10P==0
 100 IFN RP06P+RP07P+RM03P+RM80P+RH10P, DC10P==0
 101 IFN RP06P+RP07P+RM03P+RM80P+RH10P+DC10P, RP10P==0
 102 IFE RP06P+RP07P+RM03P+RM80P+RH10P+DC10P, RP10P==1
 103
 104 IFE BOOTSW, SETF [Number of dirs? (DM-KA: 200., ML-KA: 250., AI-KA: 440., all others: 500.)]NUDSL
 105
 106 SETF [KS10 processor?]KS10P
 107 IFE KS10P, SETF [KL10 processor? (no => KA10)]KL10P
 108 IFN KS10P, KL10P==0
 109 IFN KS10P+KL10P, KA10P==0
 110 IFE KS10P+KL10P, KA10P==1
 111
 112 RH11P==:RP06P+RP07P+RM03P+RM80P
 113
 114 DEFINE RP
 115 IFN RP10P!TERMIN
 116 DEFINE SC
 117 IFN DC10P!TERMIN
 118 DEFINE RH
 119 IFN RH10P!TERMIN
 120 DEFINE PH
 121 IFN RH11P!TERMIN
 122
 123 DEFINE KA
 124 IFN KA10P!TERMIN
 125 DEFINE KL
 126 IFN KL10P!TERMIN
 127 DEFINE KS
 128 IFN KS10P!TERMIN
 129
 130 IFN HRIFLG,[
 131 NOSYMS                  ;MAKE PAPER TAPE SHORTER
 132 RIM10
 133 ]
 134
 135 C=1                     ;C-A-B FOR LINKS
 136 A=2
 137 B=3
 138 D=4
 139 BLKIN=5                 ;PSEUDO-CORE BLOCK IN CBUF
 140 WRITE=6                 ;NEG MEANS DUMP, RH 0 OR WRBIT
 141 DIFF=7                  ;DIFF CONO ALSO TEMP
 142 HEAD=10                 ;HEAD CONO ALSO TEMP
 143 P=11                    ;JSP AC
 144 BLOK=12
 145 UNIT=13                 ;UNIT AND M.A. DATAO
 146 CMD=14                  ;COMMAND CHAR
 147 T=15                    ;VERY TEMP
 148 TT=16                   ;ANOTHER JSP AC, ALSO VERY TEMP
 149 BUFP=17                 ;DBUF PNTR--LAST WORD USED
 150
 151 IF1,[                   ;DON'T TAKE A WEEK AND A HALF TO ASSEMBLE.
 152 RP, .INSRT SYSTEM;RP10 >
 153 SC, .INSRT SYSTEM;DC10 >
 154 RH, .INSRT SYSTEM;RH10 >
 155 PH, .INSRT SYSTEM;RH11 >
 156 IFN RP06P, .INSRT SYSTEM;RP06 >
 157 IFN RP07P, .INSRT SYSTEM;RP07 >
 158 IFN RM03P, .INSRT SYSTEM;RM03 >
 159 IFN RM80P, .INSRT SYSTEM;RM80 >
 160 IFE BOOTSW, .INSRT SYSTEM;FSDEFS >
 161 IFE BOOTSW, KL, .INSRT SYSTEM;EPT >
 162 KS, .INSRT SYSTEM;KSDEFS >
 163 KA, TTY==120
 164 ]
 165 \f
 166 ;PARAMETER FILE FOR DSKDMP
 167
 168 MEMSIZ=1000000          ;ACTUAL SIZE OF MEM
 169 IFNDEF DBGSW,DBGSW==0   ;1 TO DEBUG THIS WITH DDT
 170 DDT==MEMSIZ-4000
 171 IFN DBGSW,MEMSIZ==MEMSIZ-10000  ;MOVE DOWN UNDER DDT IF DEBUG MODE
 172 CORE==MEMSIZ-10000-<2000*NTUTBL>                ;HIGHEST ADR ALWAYS IN CORE+1
 173 CORES==CORE_<-12>       ;BLK # OF ABOVE (FIRST OF BLKS SWAPPED OUT FOR BUFFER AREAS)
 174 NSWBL==4+NTUTBL         ;# BLOCKS SWAPPED OUT FOR BUFFER AREAS, +1 FOR DSKDMP ITSELF
 175 HIGH==MEMSIZ-100        ;HIGHEST ADR LOADED/DUMPED+1
 176
 177 NDSK==8                 ;MAX POSSIBLE.  L$n$ DEFINES WHICH ARE REALLY THERE
 178 RP,ICWA=34
 179 RH,ICWA=34
 180
 181 PH, UBPG==:17           ; Use last (usable) page in Unibus map
 182
 183 KA, LPM=102000,,
 184 KA, LPMR=LPM 2,
 185 KL, PAG=<BLKI 10,>-<BLKI>
 186
 187 DEFINE INFORM A,B
 188 IF1,[ PRINTX \1c A = B
 189 \1c] TERMIN
 190
 191 ;COMMANDS ARE:
 192 ;   L$file      LOAD FILE INTO CORE
 193 ;   T$file      LOAD FILE INTO CORE AND GIVE SYMBOLS TO DDT AND START DDT
 194 ;   M$file      LOAD FILE INTO CORE WITHOUT CLEARING CORE FIRST, DOESN'T LOAD SYMBOLS
 195 ;   K$file      DELETE FILE
 196 ;   D$file      DUMP CORE INTO FILE
 197 ;   I$file      VERIFY FILE AGAINST CORE
 198 ;   G$          START AT STARTING ADDRESS
 199 ;   U$dir;      LIST DIRECTORY
 200 ;   F$          LIST CURRENT DIRECTORY
 201 ;   S$          LIST PACK IDS THEN MFD
 202 ;   nnn$        SET STARTING ADDRESS TO nnn
 203 ;   L$n$        PUT DISK n ONLINE
 204 ;   K$n$        TAKE DISK n OFFLINE
 205
 206 ;ERROR MESSAGES ARE:
 207 ;   CMPERR      VERIFY FAILED TO MATCH
 208 ;   DIRFUL      DIRECTORY FULL
 209 ;   EOF         UNEXPECTED EOF
 210 ;   DIRNF       DIRECTORY DOES NOT EXIST
 211 ;   FNF         FILE NOT FOUND
 212 ;   PKNMTD      FILE IS ON PACK THAT IS NOT MOUNTED
 213 ;   CKSERR      CHECKSUM ERROR
 214 ;   DSKFUL      DISK FULL
 215 ;   NODDT       CAN'T ADDRESS DDT SYMBOL TABLE (BUG)
 216 ;   ?BUG?       BUG
 217 ;   SEEKFL      DISK SEEK ERROR
 218 ;   CLOBRD      DISK READ ERROR
 219 ;   CLOBWR      DISK WRITE ERROR
 220 ;   DIRCLB      DIR NAME DIFFERS, TUT DISAGREES WITH DIR
 221 ;   MFDCLB      M.F.D. CLOBBERED
 222 ;   DSKLUZ      DISK LOSSAGE (OFFLINE OR UNSAFE OR MASSBUS ERROR)
 223 \f
 224 KS,     LOC 4000                ; Avoid MTBOOT and KSRIM
 225
 226 IFE BOOTSW,[
 227 ZZZ:    IFE DBGSW,[
 228         MOVE T,....             ;THIS CODE BLTS THE FOLLOWING OFFSET CODE
 229         BLT T,MEMSIZ-1-1        ;INTO HIGH MEMORY AND WRITES DSKDMP ON ITS
 230         MOVE T,PROG+MEMSIZ-2-BEG+1
 231         MOVEM T,BEG+MEMSIZ-2-BEG+1      ;AVOID LOSING DUE TO -1 BLT LOSSAGE
 232 ]
 233         MOVSI T,-NDSK+1         ;MAKE ALL BUT DISK 0 BE DEAD (MUST DO L$ TO MAKE THEM ALIVE)
 234         SETOM QDED+1(T)
 235         MOVNS QDED+1(T)
 236         AOBJN T,.-2
 237         SETZM QDED+0
 238 RP,[    MOVEI T,ICWA+2          ;SET UP CHANNEL JUMP
 239         MOVEM T,ICWA            ;IN INITIAL CHANNEL ADDRESS
 240         SETZM ICWA+1            ;AND CLEAR REMAINING STUFF
 241         SETZM ICWA+3
 242         DATAO DPC,SUNIT0
 243         DATAI DPC,B
 244         TRNN B,RP03BT
 245          JRST WBOOT1
 246         MOVEI B,MBLKS           ;UNIT 0 IS AN RP03, ADJUST WORLD
 247         HRRM B,CBLK
 248         MOVE B,RP3ADJ
 249         MOVSI A,-NSWBL
 250         XORM B,SWPSK(A)
 251         AOBJN A,.-1
 252 WBOOT1: HLLZS BOOT0
 253         MOVEI UNIT,BEG          ;MAGIC BLOCK THEN STARTS IT
 254         HRRZ BLOK,CBLK
 255         ADDI BLOK,NSWBL         ;FIRST BLOCK AFTER CORE BUFFER IS WHERE DSKDMP LIVES
 256         MOVEI WRITE,10
 257         JSP TT,WRD3
 258         HRRZ BLOK,CBLK
 259         ADDI BLOK,NSWBL+1
 260         MOVEI WRITE,10
 261         JSP TT,WRD3
 262         CONSZ DPC,ALLER
 263 IFN DBGSW,JRST DDT
 264 IFE DBGSW,JRST 4,.              ;FORMERLY JRST MEMSIZ-400 (??)
 265         JRST BEG
 266 ];RP
 267 PH,[    MOVEI T,%HYCLR          ; Clear controller
 268         IOWRQ T,%HRCS2          ; (Selects drive 0)
 269 WBOOT0: IORDQ T,%HRCS1
 270         TRNN T,%HXDVA
 271          JRST WBOOT0            ; Await drive available (well, it is a dual
 272                                 ; ported drive...  perhaps someday?)
 273         MOVEI UNIT,BEG
 274         HRRZ BLOK,CBLK
 275         ADDI BLOK,NSWBL         ; FIRST BLOCK AFTER CORE BUFFER IS WHERE
 276                                 ; DSKDMP LIVES
 277         MOVEI WRITE,10
 278         JSP TT,WRD3
 279         HRRZ BLOK,CBLK
 280         ADDI BLOK,NSWBL+1
 281         MOVEI WRITE,10
 282         JSP TT,WRD3
 283         IORDQ TT,%HRCS1
 284         TRNE TT,%HXTRE+%HXMCP
 285 IFN DBGSW, JRST DDT
 286 IFE DBGSW, JRST 4,.             ; Formerly JRST MEMSIZ-400 (??)
 287         JRST BEG
 288 ];PH
 289 RH,[    MOVEI T,ICWA+2          ;SET UP CHANNEL JUMP
 290         MOVEM T,ICWA            ;IN INITIAL CHANNEL ADDRESS
 291         SETZM ICWA+1            ;AND CLEAR REMAINING STUFF
 292         SETZM ICWA+3
 293 WBOOT0: DATAO DSK,[%HRDCL,,]
 294         MOVEI A,20
 295         SOJG A,.
 296         DATAI DSK,A
 297         TRNN A,%HCDVA
 298          JRST WBOOT0            ;AWAIT DRIVE AVAILABLE
 299         MOVEI UNIT,BEG          ;MAGIC BLOCK THEN STARTS IT
 300         HRRZ BLOK,CBLK
 301         ADDI BLOK,NSWBL         ;FIRST BLOCK AFTER CORE BUFFER IS WHERE DSKDMP LIVES
 302         MOVEI WRITE,10
 303         JSP TT,WRD3
 304         HRRZ BLOK,CBLK
 305         ADDI BLOK,NSWBL+1
 306         MOVEI WRITE,10
 307         JSP TT,WRD3
 308         CONSZ DSK,%HIERR
 309 IFN DBGSW,JRST DDT
 310 IFE DBGSW,JRST 4,.              ;FORMERLY JRST MEMSIZ-400 (??)
 311         JRST BEG
 312 ];RP
 313 SC,[    MOVEI UNIT,BEG          ;MAGIC BLOCK THEN STARTS IT
 314         MOVEI BLOK,NBLKS+NSWBL
 315         MOVEI WRITE,60
 316         JSP TT,WRD3
 317         MOVEI BLOK,NBLKS+NSWBL+1
 318         MOVEI WRITE,60
 319         JSP TT,WRD3
 320         DATAO DC0,.....
 321         CONSZ DC0,DSSACT
 322         JRST .-1
 323         CONSZ DC0,DSSERR
 324 IFN DBGSW,JRST DDT
 325 IFE DBGSW,JRST 4,.              ;FORMERLY JRST MEMSIZ-400 (??)
 326         JRST BEG
 327
 328 .....:  DJMP .+1
 329         DWRITE
 330         DCOPY ......(-LRIBLK_2&37774)
 331         DHLT
 332
 333 ......: DWRITE+DUNENB+DADR              ;FOR READIN
 334         DCOPY BEG(-2000_2&37774)
 335         DREAD+DADR1
 336         DCOPY BEG(-2000_2&37774)
 337         DHLT
 338 ];SC
 339
 340 IFE DBGSW,[
 341 ....:   PROG,,BEG
 342
 343 KA,     LOC 2000                ; MAKE OFFSET CONVENIENT
 344 KL,     LOC 2000
 345 KS,     LOC 6000                ; Avoid MTBOOT and KSRIM
 346 PROG:   OFFSET CORE+<<NSWBL-1>*2000>-.
 347 ]IFN DBGSW,LOC MEMSIZ-2000
 348 \f
 349 BEG:
 350 KA,[    CONO 635550             ;ENTER HERE, CLEAR WORLD
 351         JRST .+1
 352         JFCL 1,[JRST 4,.]       ;A PDP6??
 353         LPMR [0]-2              ;TURN OFF EXEC PAGING
 354 ]
 355 KL,[    CONO 327740             ;CLEAR APR
 356         CONSZ PAG,660000        ;PAGING AND CACHE BETTER BE OFF
 357          JRST 4,.
 358 ]
 359 KS,[    CONO 127760             ; Enable, and Clear all.
 360         RDEBR B
 361         TRNE B,60000            ; Paging and Tops-20 better be off.
 362          JRST 4,.
 363         SETZM 8SWIT0            ; Clear 8080 Communications area to prevent
 364         MOVE B,[8SWIT0,,8SWIT0+1]       ; mysterious IO behavior.
 365         BLT B,8RHBAS-1
 366         ;; If the machine has just been powered on, there is likely to be
 367         ;; bad parity all over the place.  I guess that isn't our problem
 368         ;; as long as we don't touch any of it...
 369 ]
 370         MOVSI B,-NDSK           ;FOR NUMBER OF DISKS
 371         SETOM PKNUM(B)          ;SET DISK TO UNKNOWN
 372         AOBJN B,.-1
 373         MOVE T,[JRST LOADG1]    ;SET BOOTSTRAP TO MIDDLE OF WORLD
 374         MOVEM T,BOOT
 375         MOVE D,['DSKDMP]        ;ANNOUNCE SELF
 376         JSP TT,PD
 377         JRST READ               ;CRLF AND BEGIN READING COMMANDS
 378
 379 ERROR:  0
 380         CLEARM MEMSIZ-1         ;DON'T READ ANY MORE COMMANDS FROM MEMORY
 381         SOS T,ERROR             ;PICK UP ERROR CODE FROM THE AC FIELD OF
 382         LDB T,[270400+T,,]      ;THE JSR ERROR
 383         MOVE D,ERMESS(T)
 384         JSP TT,PD               ;PRINT OUT APPROPRIATE COMMENT
 385         CAIL T,EBUG
 386          JRST READ              ;BAD ERROR - NO MORE DISKING
 387 LOADG1:
 388 KA,     DATAI TTY,C             ;FLUSH RANDOM CHARACTER
 389 KS,     SETZM 8CTYIN            ; ".RESET"
 390         TRO CMD,10              ;MAKE SURE PSEUDO-CORE IN CORE
 391         JRST LOADG              ;BY SIMULATING END OF LOADING, NON-GOING COMMAND
 392
 393 ERMESS: IRP XX,,[ECMP,EDIR,EEOF,ESNF,EFNF,EPNM,ECKS
 394 EDSK,EDDT,EBUG,EC63,ECRD,ECWR,ECDR,EMFC,EDLZ]YY,,[CMPERR,DIRFUL
 395 EOF,DIRNF,FNF,PKNMTD,CKSERR,DSKFUL,NODDT,?BUG?,SEEKFL
 396 CLOBRD,CLOBWR,DIRCLB,MFDCLB,DSKLUZ]
 397 XX==.-ERMESS
 398         SIXBIT \YY\
 399 TERMIN
 400
 401 PD:     JSP P,CRLF              ;TYPE A CR
 402 PD2:    MOVEI C,40
 403         JSP P,TYO               ;AND A SPACE
 404         MOVE B,[440600,,D]
 405 PD1:    ILDB C,B                ;AND THE SIXBIT CONTENTS OF D
 406         ADDI C,40
 407         JSP P,TYO
 408         TLNE B,770000
 409          JRST PD1
 410         JRST (TT)
 411
 412 PNO:
 413 C12:    IDIVI C,10.             ;PRINT CONTENTS OF C AS A TWO-DIGIT
 414         DPB C,[60600,,A]        ;DECIMAL NUMBER PRECEDED
 415         MOVEI D,(SIXBIT /#00/+A) ;BY <SPACE>#
 416         MOVE B,[300600,,D]
 417         JRST PD1
 418 \f
 419 WRCB:   MOVEI UNIT,CBUF         ;WRITE OUT CONTENTS OF CBUF
 420         LSH BLKIN,-12           ;ON APPROPRIATE BLOCK
 421         HRRZ BLOK,CBLK
 422         ADDI BLOK,-CORES(BLKIN)
 423         JRST WRM
 424
 425 LODUMP: MOVEI UNIT,CORE         ;DEPENDING ON SIGN BIT OF WRITE, LOAD OR DUMP
 426         HRRZ BLOK,CBLK          ;PSEUDO-CORE (766000-775777)
 427 LODMP1: JSP TT,WRDM
 428         ADDI UNIT,2000
 429         CAIGE UNIT,BEG
 430          AOJA BLOK,LODMP1
 431         MOVEI BLKIN,CORE
 432         JRST (P)
 433
 434 FD:     HRRZ C,B                ;SET UP POINTER IN C TO FETCH OR DEPOSIT
 435                                 ;CONTENTS OF ADDRESS IN RIGHT HALF OF B
 436 IFN DBGSW, SKIPGE WRITE         ;LOAD DDT WHEN IN DEBUG MODE
 437         CAIGE C,HIGH
 438         CAIGE C,40
 439          JRST (P)
 440         CAIGE C,CORE            ;IF ADDR IS IN REAL CORE, RETURN IMMEDIATELY
 441          JRST 1(P)
 442 FDX:    CAIL C,(BLKIN)          ;ADDR IS IN PSEUDO-CORE--CHECK IF RIGHT
 443         CAILE C,1777(BLKIN)     ;BLOCK IS IN CBUF
 444          JRST FD3               ;IT'S NOT THERE--READ IT IN
 445 FD4:    SUBI C,-CORE(BLKIN)     ;IT'S THERE--SET UP RIGHT POINTER IN C
 446         JRST 1(P)               ;AND RETURN
 447 FD3:    JUMPLE WRITE,FD3A       ;IF DUMP OR VERIFY DON'T BOTHER
 448                                 ;TO WRITE OUT CURRENT BLOCK
 449 FD3B:   JSP TT,WRCB             ;IF LOAD, WRITE CURRENT BLOCK FIRST
 450 FD3A:   MOVEI UNIT,CBUF
 451         MOVE BLKIN,C
 452         ANDI BLKIN,776000
 453         LDB BLOK,[121000,,BLKIN]
 454         ADD BLOK,CBLK
 455         MOVEI BLOK,-CORES(BLOK)
 456         JSP TT,RDM              ;READ IN CORRECT BLOCK
 457         JRST FD4                ;SET UP POINTER AND RETURN
 458
 459 GBP:    IDIVI C,6               ;TURN USER DIRECTORY CHARACTER ADDR IN C
 460         IMULI A,-60000          ;INTO A BYTE POINTER
 461         HRLI C,440600(A)
 462         ADDI C,DIR+UDDESC
 463         JRST (TT)
 464
 465 WD:     AOBJN BUFP,WD1          ;READ, WRITE, OR VERIFY WORD IN D FROM, INTO,
 466         JSP TT,NXTBLK           ;OR AGAINST WORD IN DBUF
 467         JSP TT,WRDB             ;TIME TO REFILL OR EMPTY DBUF
 468         MOVSI BUFP,-2000        ;RESET BUFFER POINTER
 469 WD1:    JUMPG WRITE,WD2         ;JUMP ON LOAD
 470         JUMPL WRITE,WD3         ;JUMP ON WRITE
 471         CAME D,DBUF(BUFP)       ;HERE IF VERIFY
 472          JSR ECMP,ERROR         ;VERIFY COMPARE LOST
 473         JRST (P)
 474 WD2:    SKIPA D,DBUF(BUFP)      ;LOAD
 475 WD3:     MOVEM D,DBUF(BUFP)     ;DUMP
 476         JRST (P)
 477 \f
 478 NXTTUT: HRRZ B,CU               ;SELECT NEXT UNIT AND READ ITS TUT
 479         AOJ B,
 480         CAIN B,NDSK
 481          MOVEI B,0
 482         HRRM B,CU
 483         CAIN B,@MU
 484          JRST 1(TT)             ;SKIP IF NO MORE
 485         SKIPE QDED(B)
 486          JRST NXTTUT            ;UNIT NOT ON LINE
 487 RDTUT:  MOVEI BLOK,TUTBLK       ;READ TUT OF CURRENT UNIT
 488         MOVEI UNIT,TUT
 489         SETOM PKNUM(B)          ;ALWAYS READ HEADER FOR TUT
 490 IFG NTUTBL-1,[                  ;READ IN MULTI-BLOCK TUT
 491         HRRM TT,RDTUTX          ;SAVE RETURN ADDRESS
 492 REPEAT NTUTBL-1,[
 493         JSP TT,RD
 494         ADDI UNIT,2000
 495         AOS BLOK
 496 ]
 497 RDTUTX: MOVEI TT,.
 498 ]
 499         JRST RD
 500
 501 NXTBW3: 0
 502         IBP DIRPT               ;DO AN IDPB T,DIRPT CHECKING TO SEE IF
 503         LDB DIFF,[1200,,DIRPT]  ;RUNNING INTO NAME AREA
 504         CAML DIFF,DIR+UDNAMP
 505          JSR EDIR,ERROR
 506         DPB T,DIRPT
 507         JRST @NXTBW3
 508
 509 NXTBW:  MOVE BLOK,LBLOCK        ;FIND NEXT FREE BLOCK TO WRITE
 510         MOVEI HEAD,1(BLOK)
 511         ILDB T,TUTPT
 512         JUMPN T,NXTBW1          ;JUMP IF VERY NEXT BLOCK NOT FREE
 513         AOSG T,BLKCNT
 514 NXTBW5:  SOJA HEAD,NXTBW4       ;GENERATE LOAD ADR IF FIRST TIME (COMPENSATE FOR LBLOCK OFF BY 1)
 515         CAIG T,UDTKMX-1
 516          JRST NXTBW2            ;NO NEED TO MODIFY DIRECTORY YET
 517         CLEARM BLKCNT           ;14 IN A ROW--RESET COUNTER AND
 518 NXTBW6: JSR NXTBW3              ;DPB BYTE INTO DIRECTORY
 519 NXTBW2: MOVE BLOK,HEAD
 520         CAML BLOK,TUT+QLASTB
 521          JSR EDSK,ERROR         ;NO MORE DISK LEFT
 522         MOVEI T,1
 523         DPB T,TUTPT             ;MARK BLOCK USED IN TUT
 524         JRST WRDB1
 525
 526 NXTBW1: ADDI HEAD,1             ;SEARCH FOR NEXT FREE BLOCK
 527         ILDB T,TUTPT
 528         JUMPN T,NXTBW1
 529         SUBM HEAD,BLOK
 530         SKIPLE T,BLKCNT         ;COME UP WITH DESC BYTE FOR LAST FEW BLOCKS
 531          JSR NXTBW3
 532         CLEARM BLKCNT
 533         JUMPL T,NXTBW5          ;FIRST TIME
 534         MOVEI T,UDTKMX-1(BLOK)
 535         CAIGE T,UDWPH           ;CAN WE SAY SKIP N--TAKE 1?
 536          JRST NXTBW6            ;YES
 537 NXTBW4: MOVEI BLOK,NXLBYT
 538         MOVE T,HEAD
 539         ROT T,-NXLBYT*6
 540         ADDI T,UDWPH+1
 541         JSR NXTBW3
 542         ROT T,6
 543         SOJG BLOK,.-2
 544         JRST NXTBW6
 545 \f
 546 NXTBLK: JUMPL WRITE,NXTBW       ;GET NEXT BLOCK OF FILE--IF DUMP, FIND FREE
 547         MOVE BLOK,LBLOCK        ;BLOCK
 548 NXTB6:  SOSLE BLKCNT            ;HAVE WE RUN OUT OF "TAKE N"?
 549          AOJA BLOK,WRDB1        ;NO--TAKE NEXT BLOCK
 550         ILDB T,DIRPT            ;YES--GET NEXT DESC BYTE
 551         CAILE T,UDWPH
 552          JRST NXTB1             ;IT'S A LOAD ADDR
 553         CAIE T,UDWPH
 554          JUMPN T,NXTB2          ;IT'S A TAKE OR SKIP
 555         CAIE CMD,'D             ;IT'S 0 OR NULL--IF THIS IS A LOAD, IT'S AN
 556         CAIN CMD,'K             ;UNEXPECTED END OF FILE
 557          JRST KILL1             ;IF DUMP OR KILL, O.K.
 558         JSR EEOF,ERROR
 559
 560 NXTB1:  MOVEI BLOK,-UDWPH-1(T)  ;LOAD ADR
 561         MOVEI BUFP,NXLBYTS
 562 NXTB1A: MOVEI T,0
 563         CAIE CMD,'D
 564         CAIN CMD,'K
 565          DPB T,DIRPT            ;IF KILLING FILE, ZERO THIS BYTE (OTHERS ZEROED AT KILL)
 566         LSH BLOK,6
 567         ILDB T,DIRPT
 568         ADD BLOK,T              ;GET COMPLETE BLOCK NUMBER
 569         SOJG BUFP,NXTB1A
 570         JRST NXTB3
 571
 572 NXTB2:  MOVEM T,BLKCNT
 573         CAIG T,UDTKMX
 574          AOJA BLOK,WRDB1        ;TAKE N STARTING WITH NEXT ONE
 575         ADDI BLOK,-UDTKMX+1(T)  ;SKIP N-<MAX TAKE> AND TAKE 1
 576 NXTB3:  CLEARM BLKCNT
 577 WRDB1:  MOVEM BLOK,LBLOCK
 578         JRST (TT)
 579 \f;RP10 IO ROUTINE
 580 RP,[
 581 WRDM:   SKIPL WRITE             ;SEE WHETHER LOAD OR DUMP/VERIFY
 582 RDM:     TRZA WRITE,(WRITE)     ;READ FROM MASTER UNIT
 583 WRM:      HRRI WRITE,10         ;WRITE ON MASTER UNIT
 584 MU:     IORI WRITE,0            ;MASTER UNIT SELECT STORED HERE
 585         JRST WRD3A
 586
 587 WRDB:   MOVEI UNIT,DBUF         ;READ OR WRITE DBUF FROM/ON CURRENT UNIT
 588 WRD:    SKIPL WRITE             ;READ OR WRITE FROM/ON CURRENT UNIT
 589 RD:      TRZA WRITE,(WRITE)     ;READ FROM CURRENT UNIT
 590 WR:       HRRI WRITE,10         ;WRITE ON CURRENT UNIT
 591 CU:     IORI WRITE,0            ;CURRENT UNIT SELECT STORED HERE
 592 WRD3A:
 593 WRD3:   DPB WRITE,[360600,,DBLK]        ;SET OP, UNIT SEL
 594         DPB WRITE,[DUNFLD SEEK]
 595         DPB WRITE,[DUNFLD RECAL]
 596         HRLI UNIT,-2000         ;ADDRESS COMES IN IN `UNIT'
 597         MOVEM UNIT,@ICWA
 598         SOS @ICWA
 599         LDB UNIT,[300,,WRITE]   ;ISOLATE FROM GARBAGE
 600         MOVNI DIFF,16.          ;INITIALIZE ERROR COUNTER
 601         MOVEM DIFF,ERRCT        ;15. LOSSES PERMITTED
 602 WRD5:   HRRZ DIFF,BLOK
 603         IMULI DIFF,SECBLK
 604         IDIVI DIFF,NSECS
 605         DPB HEAD,[DSECT DBLK]
 606         IDIVI DIFF,NHEDS
 607         DPB HEAD,[DSURF DBLK]
 608         DPB DIFF,[DCYL DBLK]
 609         DPB DIFF,[DCYL SEEK]
 610         DATAO DPC,CLATT         ;CLEAR ATTENTIONS
 611         LSH DIFF,-8             ;EXTRA CYLINDER BIT FOR RP03
 612         DPB DIFF,[DCYLXB DBLK]
 613         DPB DIFF,[DCYLXB SEEK]
 614         DATAO DPC,SEEK
 615         DATAI DPC,DIFF
 616         TRNN DIFF,ALLATT
 617          JRST .-2
 618         DATAO DPC,CLATT
 619         TLNN DIFF,(ONCYL)
 620          JRST WRD0
 621         DATAO DPC,DBLK
 622         CONSO DPC,DONE
 623          JRST .-1
 624         CONSO DPC,ALLER
 625          JRST WRDX
 626         HRRZM BLOK,BADBLK
 627         AOSG ERRCT              ;HARDWARE ERROR--CHECK COUNTER
 628          JRST WRD5              ;TRY AGAIN
 629         TRNE WRITE,10           ;GIVE UP--DISTINGUISH BETWEEN
 630          JSR ECWR,ERROR         ;WRITE ERRORS AND
 631         JSR ECRD,ERROR          ;READ ERRORS
 632
 633 WRDX:   HRRZ UNIT,@ICWA         ;RESTORE ADDR
 634         ADDI UNIT,1             ;COMPENSATE FOR IOWD LOSSAGE
 635         TRZ WRITE,-1            ;FLUSH GARBAGE
 636         JRST (TT)
 637
 638 WRD0:   AOSLE ERRCT
 639          JSR EC63,ERROR
 640         DATAO DPC,RECAL
 641         DATAI DPC,DIFF
 642         TRNN DIFF,ALLATT
 643          JRST .-2
 644         JRST WRD5
 645
 646 DBLK:   ICWA
 647 SEEK:   DSEEKC
 648 RECAL:  DRCALC
 649 CLATT:  DEASEC ALLATT
 650 ];RP
 651 \f;RH11 IO ROUTINE
 652 PH,[
 653 WRDM:   SKIPL WRITE             ;SEE WHETHER LOAD OR DUMP/VERIFY
 654 RDM:     TRZA WRITE,(WRITE)     ;READ FROM MASTER UNIT
 655 WRM:      HRRI WRITE,10         ;WRITE ON MASTER UNIT
 656 MU:     IORI WRITE,0            ;MASTER UNIT SELECT STORED HERE
 657         JRST WRD3A
 658
 659 WRDB:   MOVEI UNIT,DBUF         ;READ OR WRITE DBUF FROM/ON CURRENT UNIT
 660 WRD:    SKIPL WRITE             ;READ OR WRITE FROM/ON CURRENT UNIT
 661 RD:      TRZA WRITE,(WRITE)     ;READ FROM CURRENT UNIT
 662 WR:       HRRI WRITE,10         ;WRITE ON CURRENT UNIT
 663 CU:     IORI WRITE,0            ;CURRENT UNIT SELECT STORED HERE
 664 WRD3A:
 665 WRD3:   TRNE UNIT,1777          ; Better be on a page boundary!
 666          JRST 4,.
 667         LDB DIFF,[111100,,UNIT] ; Point Unibus map at page in question
 668         TRO DIFF,%UQFST+%UQVAL
 669         IOWRQ DIFF,UBAPAG+UBPG_1
 670         ADDI DIFF,1
 671         IOWRQ DIFF,UBAPAG+UBPG_1+1
 672         LDB DIFF,[000300,,WRITE]        ; Select drive
 673         IOWRQ DIFF,%HRCS2
 674         JSP HEAD,RHCHEK         ; Check for immediate trouble
 675         MOVEI DIFF,%HMRDP       ; Init the drive
 676         IOWRQ DIFF,%HRCS1
 677         MOVNI DIFF,16.          ;INITIALIZE ERROR COUNTER
 678         MOVEM DIFF,ERRCT        ;15. LOSSES PERMITTED
 679 WRD5:   MOVNI DIFF,4000
 680         IOWRQ DIFF,%HRWC        ; 4000 half words
 681         MOVEI DIFF,UBPG_14
 682         IOWRQ DIFF,%HRBA        ; "Byte" base address
 683         HRRZ DIFF,BLOK
 684         IDIVI DIFF,NBLKSC
 685         IOWRQ DIFF,%HRCYL       ; Desire cylinder
 686         MOVE DIFF,HEAD
 687         IMULI DIFF,SECBLK
 688         IDIVI DIFF,NSECS
 689         DPB DIFF,[$HATRK HEAD]
 690         IOWRQ HEAD,%HRADR       ; Desire track and sector
 691         MOVEI DIFF,%HMRED
 692         TRNE WRITE,10
 693          MOVEI DIFF,%HMWRT
 694         IOWRQ DIFF,%HRCS1       ; Do it (implied seek)
 695 WRD7:   IORDQ DIFF,%HRCS1
 696         TRNN DIFF,%HXRDY        ; Wait for controller to finish
 697          JRST WRD7
 698         TRNN DIFF,%HXTRE+%HXMCP ; Trouble?
 699          JRST WRDX              ; Nope, exit
 700         HRRZM BLOK,BADBLK
 701         AOSG ERRCT              ;HARDWARE ERROR--CHECK COUNTER
 702          JRST WRD0              ;RECALIBRATE AND TRY AGAIN
 703         TRNE WRITE,10           ;GIVE UP--DISTINGUISH BETWEEN
 704          JSR ECWR,ERROR         ;WRITE ERRORS AND
 705         JSR ECRD,ERROR          ;READ ERRORS
 706
 707 WRDX:   TRZ WRITE,-1            ;FLUSH GARBAGE
 708         JRST (TT)
 709
 710 WRD0:   MOVEI DIFF,%HYCLR       ; Clear controller
 711         IOWRQ DIFF,%HRCS2
 712         LDB DIFF,[000300,,WRITE]        ; Select drive
 713         IOWRQ DIFF,%HRCS2
 714         MOVEI DIFF,%HMCLR       ; Clear drive
 715         IOWRQ DIFF,%HRCS1
 716         JSP HEAD,RHCHEK         ; Immediate lossage?
 717         MOVEI DIFF,%HMREC       ; Recalibrate
 718         IOWRQ DIFF,%HRCS1
 719         MOVEI HEAD,100000.
 720 WRD0A:  SOSGE HEAD
 721          JSR EC63,ERROR
 722         IORDQ DIFF,%HRSTS
 723         TRNE DIFF,%HSPIP        ; WAIT FOR DRIVE TO FINISH
 724          JRST WRD0A
 725         ANDI DIFF,%HSDPR+%HSMOL+%HSVV+%HSRDY+%HSERR
 726         CAIE DIFF,%HSDPR+%HSMOL+%HSVV+%HSRDY
 727          JSR EDLZ,ERROR
 728         JRST WRD5
 729
 730 ;;; JSP HEAD,RHCHEK to check for errors.
 731 RHCHEK: IORDQ DIFF,%HRCS1
 732         TRNE DIFF,%HXTRE+%HXMCP
 733          JSR EDLZ,ERROR
 734         JRST (HEAD)
 735 ];PH
 736 \f;RH10 IO ROUTINE
 737 RH,[
 738 WRDM:   SKIPL WRITE             ;SEE WHETHER LOAD OR DUMP/VERIFY
 739 RDM:     TRZA WRITE,(WRITE)     ;READ FROM MASTER UNIT
 740 WRM:      HRRI WRITE,10         ;WRITE ON MASTER UNIT
 741 MU:     IORI WRITE,0            ;MASTER UNIT SELECT STORED HERE
 742         JRST WRD3A
 743
 744 WRDB:   MOVEI UNIT,DBUF         ;READ OR WRITE DBUF FROM/ON CURRENT UNIT
 745 WRD:    SKIPL WRITE             ;READ OR WRITE FROM/ON CURRENT UNIT
 746 RD:      TRZA WRITE,(WRITE)     ;READ FROM CURRENT UNIT
 747 WR:       HRRI WRITE,10         ;WRITE ON CURRENT UNIT
 748 CU:     IORI WRITE,0            ;CURRENT UNIT SELECT STORED HERE
 749 WRD3A:
 750 WRD3:   HRLI UNIT,-2000         ;ADDRESS COMES IN IN `UNIT'
 751         CONI DSK,HEAD           ;SET WORD COUNT TO ONE BLOCK
 752         TLNE HEAD,(%HID22)      ;ACCORDING TO TYPE OF CHANNEL
 753          HRLI UNIT,-2000_4
 754         MOVEM UNIT,@ICWA
 755         LDB UNIT,[300,,WRITE]   ;ISOLATE FROM GARBAGE
 756         SOS @ICWA               ;ADJUST FOR DF10 LOSSAGE
 757         MOVNI DIFF,16.          ;INITIALIZE ERROR COUNTER
 758         MOVEM DIFF,ERRCT        ;15. LOSSES PERMITTED
 759 WRD5:   MOVSI DIFF,%HRDCL(UNIT)
 760         HRRI DIFF,%HMRDP        ;INIT THE DRIVE
 761         JSP HEAD,RHSET
 762         HRRZ DIFF,BLOK
 763         IDIVI DIFF,NBLKSC
 764         EXCH DIFF,HEAD
 765         MOVEM HEAD,DBLK         ;SAVE CYLINDER
 766         IMULI DIFF,SECBLK
 767         IDIVI DIFF,NSECS
 768         EXCH DIFF,HEAD
 769         DPB HEAD,[$HATRK DIFF]
 770         TLO DIFF,%HRADR(UNIT)
 771         JSP HEAD,RHSET
 772         MOVE DIFF,DBLK
 773         TLO DIFF,%HRCYL(UNIT)
 774         JSP HEAD,RHSET
 775         MOVSI DIFF,%HRCTL(UNIT)
 776         IORI DIFF,ICWA_6
 777         TRNE WRITE,10
 778          TROA DIFF,%HMWRT
 779           TRO DIFF,%HMRED
 780         JSP HEAD,RHSET          ;DO IT (USE IMPLIED SEEK)
 781         CONSO DSK,%HIDON
 782          JRST .-1
 783         CONSO DSK,%HIERR
 784          JRST WRDX
 785         HRRZM BLOK,BADBLK
 786         AOSG ERRCT              ;HARDWARE ERROR--CHECK COUNTER
 787          JRST WRD0              ;RECALIBRATE AND TRY AGAIN
 788         TRNE WRITE,10           ;GIVE UP--DISTINGUISH BETWEEN
 789          JSR ECWR,ERROR         ;WRITE ERRORS AND
 790         JSR ECRD,ERROR          ;READ ERRORS
 791
 792 WRDX:   HRRZ UNIT,@ICWA         ;RESTORE ADDR
 793         ADDI UNIT,1             ;COMPENSATE FOR IOWD LOSSAGE
 794         TRZ WRITE,-1            ;FLUSH GARBAGE
 795         JRST (TT)
 796
 797 WRD0:   MOVSI DIFF,%HRDCL(UNIT)
 798         HRRI DIFF,%HMCLR
 799         JSP HEAD,RHSET
 800         MOVSI DIFF,%HRDCL(UNIT)
 801         HRRI DIFF,%HMREC
 802         JSP HEAD,RHSET
 803         MOVEI DIFF,100000.
 804         MOVEM DIFF,DBLK
 805 WRD0A:  SOSGE DBLK
 806          JSR EC63,ERROR
 807         MOVSI DIFF,%HRSTS(UNIT)
 808         JSP HEAD,RHGET
 809         TRNE DIFF,%HSPIP
 810          JRST WRD0A
 811         ANDI DIFF,%HSVV+%HSRDY+%HSMOL+%HSERR
 812         CAIE DIFF,%HSVV+%HSRDY+%HSMOL
 813          JSR EDLZ,ERROR
 814         JRST WRD5
 815
 816 ;RH10 HACKING ROUTINES. CALL BY JSP HEAD,.  DIFF HAS REGISTER ADDRESS IN LH, DATA IN RH.
 817 RHSET:  TLOA DIFF,%HRLOD
 818 RHGET:   TLZ DIFF,%HRLOD
 819         DATAO DSK,DIFF
 820         MOVEI DIFF,20
 821         SOJG DIFF,.
 822         DATAI DSK,DIFF
 823         TLNE DIFF,%HDERR
 824          JSR EDLZ,ERROR
 825         ANDI DIFF,177777
 826         JRST (HEAD)
 827
 828 DBLK:   0
 829 ];RH
 830 \f;SC DISK IO ROUTINE
 831 SC,[
 832 WRDM:   SKIPL WRITE             ;SEE WHETHER LOAD OR DUMP/VERIFY
 833 RDM:     TRZA WRITE,(WRITE)     ;READ FROM MASTER UNIT
 834 WRM:      HRRI WRITE,60#120     ;WRITE ON MASTER UNIT
 835 MU:     IORI WRITE,0            ;MASTER UNIT SELECT STORED HERE
 836         JRST WRD3A
 837
 838 WRDB:   MOVEI UNIT,DBUF         ;READ OR WRITE DBUF FROM/ON CURRENT UNIT
 839 WRD:    SKIPL WRITE             ;READ OR WRITE FROM/ON CURRENT UNIT
 840 RD:      TRZA WRITE,(WRITE)     ;READ FROM CURRENT UNIT
 841 WR:       HRRI WRITE,60#120     ;WRITE ON CURRENT UNIT
 842 CU:     IORI WRITE,0            ;CURRENT UNIT SELECT STORED HERE
 843 WRD3A:  TRC WRITE,120
 844 WRD3:   DPB WRITE,[330700,,DBLK]        ;SET OP, UNIT SEL
 845         DPB UNIT,[DCCA DBLK+1]  ; & CORE ADDR
 846         DPB UNIT,[DCCA DBLK1+1]
 847         LDB UNIT,[400,,WRITE]   ;ISOLATE FROM GARBAGE
 848         MOVNI DIFF,16.          ;INITIALIZE ERROR COUNTER
 849         MOVEM DIFF,ERRCT        ;15. LOSSES PERMITTED
 850 WRD5:   HRRZ DIFF,BLOK
 851         IDIVI DIFF,NSECS
 852         DPB HEAD,[DSECT DBLK]
 853         IDIVI DIFF,NHEDS
 854         DPB HEAD,[DSURF DBLK]
 855         DPB DIFF,[DCYL DBLK]
 856         CONO DC0,DCCSET\DCDENB  ;RESET ALL, THEN SET DCDENB
 857         CAIL DIFF,NCYLS
 858          TDZA DIFF,DIFF
 859           SKIPLE DIFF,PKNUM(UNIT)
 860            JRST WRD4            ;PKID IN
 861         MOVE DIFF,QTRAN(UNIT)   ;READ PACK ID
 862         DPB DIFF,[DUNFLD GPKID]
 863         MOVEI DIFF,TUTCYL
 864         SKIPGE QTRAN(UNIT)
 865          ADDI DIFF,NCYLS+XCYLS
 866         DPB DIFF,[DCYL GPKID]
 867         DATAO DC0,[DJMP GPKID]
 868         CONSZ DC0,DSSACT
 869          JRST .-1
 870         CONSZ DC0,DSSERR
 871          JRST WRD0
 872         CONO DC0,DCCSET\DCDENB  ;RESET POSSIBLE "FUTURE" IP OR RLCERR
 873         LDB DIFF,[DPKID RPKID]
 874         MOVEM DIFF,PKNUM(UNIT)
 875 WRD4:   DPB DIFF,[DPKID DBLK]
 876         MOVE DIFF,DBLK
 877         DPB DIFF,[3300,,DBLK1]
 878         MOVE DIFF,QTRAN(UNIT)
 879         DPB DIFF,[DUNFLD DBLK]
 880         JUMPGE DIFF,WRD4A
 881         LDB DIFF,[DCYL DBLK]    ;2ND HALF UNIT
 882         ADDI DIFF,NCYLS+XCYLS
 883         DPB DIFF,[DCYL DBLK]
 884 WRD4A:  DATAO DC0,[DJMP DBLK]
 885         CONSZ DC0,DSSACT
 886          JRST .-1
 887         CONSO DC0,DSSERR
 888          JRST WRDX      ;XFER OK
 889         MOVE DIFF,ERRCT
 890         TRNN DIFF,2     ;DO RECALIBRATE 2 OUT OF 4 RETRIES
 891          JRST WRD2
 892 WRD0:   AOSLE ERRCT     ;POSITIONER ERROR--CHECK ERROR COUNT
 893          JSR EC63,ERROR ;TOO MANY--GIVE UP
 894         DATAO DC0,[DSPC+DSRCAL+DSWINF]
 895         CONSO DC0,DSSATT
 896          JRST .-1
 897         JRST WRD5       ;TRY AGAIN AFTER RESETTING UNIT
 898
 899 WRD2:   HRRZM BLOK,BADBLK
 900         AOSG ERRCT      ;HARDWARE ERROR--CHECK COUNTER
 901          JRST WRD5      ;TRY AGAIN
 902         TRNE WRITE,40   ;GIVE UP--DISTINGUISH BETWEEN
 903          JSR ECWR,ERROR ;WRITE ERRORS AND
 904         JSR ECRD,ERROR  ;READ ERRORS
 905
 906 WRDX:   DPB BLOK,[XWBLK XWDS]   ;PNTR TO PREV BLOCK
 907         LDB UNIT,[DCCA DBLK+1]  ;RESTORE ADR
 908         TRZ WRITE,-1    ;FLUSH GARBAGE
 909         JRST (TT)
 910
 911 DBLK:   DREAD+DUNENB
 912         DCOPY .(-2000_2&37774)
 913         DCOPY XWDS(-4_2&37774)
 914 DBLK1:  DRC
 915         DCOPY .(-2000_2&37774)
 916         DCOPY XWDS(-4_2&37774)
 917         DHLT
 918
 919 GPKID:  DSPC+DSCRHD+DSWIDX+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
 920         DCOPY RPKID(37774)
 921         DHLT
 922 ];SC
 923 \f
 924 ;JSP P,TYI RETURNS CHAR IN C.
 925 ;JSP P,TYI0 ALSO SKIPS IF NO INPUT AVAILABLE.
 926 TYI:    ILDB C,MEMSIZ-1         ;CHECK FOR COMMANDS FROM MEMORY
 927         JUMPN C,(P)             ;FOUND ONE--RETURN
 928         CLEARM MEMSIZ-1
 929 TYI0:                           ;ENTRY TO SKIP IF NO INPUT AVAILABLE
 930 KA,[    CONSO TTY,40
 931          JRST TYI1
 932         DATAI TTY,C
 933 ]
 934 KS,[    SKIPN C,8CTYIN
 935          JRST TYI1
 936         ANDI C,177
 937         SETZM 8CTYIN
 938 ]
 939 KL,[    MOVEI C,3400            ;DDT MODE INPUT
 940         SETZM DTEFLG
 941         MOVEM C,DTECMD
 942         CONO DTE,%DBL11
 943         SKIPN DTEFLG
 944          JRST .-1
 945         MOVE C,DTEF11
 946         SETZM DTEFLG
 947         JUMPE C,TYI1
 948 ]       ANDI C,177
 949         CAIGE C,175
 950         CAIN C,33
 951          JRST (P)               ;DON'T ECHO GRITCHES
 952 ;DROP INTO TYO
 953
 954 ;JSP P,TYO TYPES OUT CHAR IN C.  CLOBBERS A,C.
 955 TYO:    ;SKIPE MEMSIZ-1
 956         ; JRST (P)              ;DON'T ECHO COMMANDS FROM MEMORY
 957 KA,[    HRRZ A,C                ;COMPUTE PARITY
 958         IMULI A,40201
 959         AND A,[1111111]
 960         IMUL A,[1111111]
 961         TLNE A,1
 962          IORI C,200
 963         CONSZ TTY,20
 964          JRST .-1
 965         DATAO TTY,C
 966         ANDCMI C,200
 967 ]
 968 KS,[    MOVE A,C
 969         ANDI A,177
 970         TRO A,400
 971         MOVEM A,8CTYOT
 972         CONI A
 973         IORI A,80INT
 974         CONO (A)
 975         SKIPE 8CTYOT
 976          JRST .-1
 977 ]
 978 KL,[    MOVE A,C
 979         ANDI A,177
 980         SETZM DTEFLG
 981         MOVEM A,DTECMD
 982         CONO DTE,%DBL11
 983         SKIPN DTEFLG
 984          JRST .-1
 985         SETZM DTEFLG
 986 ]
 987         JUMPGE C,(P)            ;CHECK FOR CRLF (AS OPPOSED TO ECHOING A CR)
 988         SKIPA C,C12             ;TYPE AN LF
 989 CRLF:    HRROI C,15
 990         JRST TYO
 991
 992 TYI1:   HRRZ C,-1(P)            ;NO INPUT AVAILABLE
 993         CAIE C,TYI0
 994          JRST TYI               ;WAIT FOR IT
 995         JRST 1(P)               ;CALL WAS TO TYI0, SKIP RETURN
 996 \f
 997 LINK:   CAIE CMD,'D
 998         CAIN CMD,'K
 999          MOVSI WRITE,-1         ;MAKE THIS INFO MORE CONVENIENT
1000         MOVE D,[440600,,C]
1001         MOVEI T,0
1002 LINKL:  ILDB TT,DIRPT
1003         SKIPGE WRITE
1004          DPB T,DIRPT            ;CLOBBER CHARS READ FOR DUMP OR KILL
1005         CAIN TT,';
1006          JRST LINKN
1007         CAIN TT,':
1008          JRST LINKQ
1009         JUMPE TT,LINKN
1010 LINKQ1: IDPB TT,D
1011         TLNE D,770000
1012          JRST LINKL
1013 LINKN1: CAMGE D,[600,,B]        ;THROUGH WITH FN2?
1014          JRST LINKL
1015         JUMPL WRITE,KILL1
1016         MOVEM A,FN1
1017         MOVEM B,FN2
1018         JRST MLOOK2
1019
1020 LINKN:  TLNN D,770000
1021          JRST LINKN1
1022         IDPB T,D                ;FILL OUT WITH SPACES
1023         JRST LINKN
1024
1025 LINKQ:  ILDB TT,DIRPT
1026         JUMPGE WRITE,LINKQ1
1027         DPB T,DIRPT
1028         JRST LINKQ1
1029 \f
1030 READ:   MOVEI BLKIN,CORE
1031         JSP P,CRLF
1032         MOVEI CMD,0             ;INITIALIZE COMMAND
1033 READ1A: MOVEI WRITE,0           ;INITIALIZE NUMBER
1034         MOVSI B,(SIXBIT \@\)    ;INITIALIZE 1ST FILE NAME
1035 READ1:  MOVEM B,FN1
1036 READ3A: MOVSI B,(SIXBIT \@\)    ;INITIALIZE CURRENT FILE NAME
1037         MOVE D,[440600,,B]
1038 READ2:  JSP P,TYI
1039         CAIN C,177
1040          JRST READ              ;IF RUBOUT START OVER
1041         CAIGE C,175
1042         CAIN C,33
1043          JRST ALTMOD            ;JUMP IF 33, 175, 176
1044         ASH WRITE,3             ;DOES NOT CHANGE SIGN OF WRITE
1045         CAIL C,"0
1046         CAILE C,"7
1047          TLOA WRITE,400000      ;NON-NUMERIC CHAR--MAKE WRITE NEGATIVE
1048           ADDI WRITE,-"0(C)     ;NUMERIC CHAR--ACCUMULATE NUMBER
1049         CAIN C,";
1050          JRST READ3             ;SET SYSTEM NAME
1051         CAIN C,40
1052          JRST READ1             ;SET FIRST FILE NAME
1053         CAIN C,^Q
1054          JSP P,TYI              ;QUOTED CHARACTER
1055         CAIGE C,140             ;CHECK FOR LOWER CASE
1056          SUBI C,40
1057         JUMPL C,DOIT            ;IF LESS THAN 40 (EXC. ^Q) END OF COMMAND
1058         TLNE D,770000           ;SKIP IF ALREADY SIX CHARS
1059          IDPB C,D
1060         JRST READ2
1061
1062 READ3:  MOVEM B,SYSN
1063         CAIE CMD,'U
1064          JRST READ3A
1065         JRST DOIT               ;IF COMMAND IS U GO LIST DIRECTORY
1066 \f
1067 ONOFF:  CAIGE WRITE,NDSK
1068          DPB CMD,[100,,QDED(WRITE)]     ;LOW BIT OF CMD DETERMINES ON/OFF LINE STATUS
1069         JRST READ               ; (K=13, L=14)
1070
1071 ALT1:   LDB CMD,D               ;PICK UP COMMAND CHAR
1072         CAIE CMD,'K
1073          TRNN CMD,2
1074           JRST READ1A           ;GET FILE NAME
1075         JRST DOIT               ;DON'T WANT FILE NAME--GO TO WORK
1076
1077 ALTMOD: MOVEI C,"$
1078         JSP P,TYO               ;ECHO DOLLAR SIGN
1079         JUMPLE WRITE,ALT2       ;JUMP IF NOT <NUMBER><ALTMODE> LAST TYPED
1080         JUMPN CMD,ONOFF         ;JUMP IF <CMD><ALTMODE><NUMBER><ALTMODE>
1081         HRRM WRITE,SADR         ;SET STARTING ADDR
1082         JRST READ
1083
1084 ALT2:   TLC D,360000
1085         TLCN D,360000           ;SKIP IF SINGLE CHARACTER BEFORE <ALTMODE>
1086          JUMPE CMD,ALT1         ;JUMP IF NO COMMAND ALREADY TYPED
1087 DOIT:   MOVEM B,FN2             ;STORE SECOND FILE NAME
1088         HRRZ B,MU
1089         HRRM B,CU               ;MAKE MASTER UNIT CURRENT UNIT
1090         MOVNI WRITE,1
1091         JSP P,LODUMP            ;DUMP OUT PSEUDO-CORE
1092         CAIN CMD,'G
1093          JRST LOADG0            ;GO
1094         JSP TT,RDTUT
1095         MOVE C,SYSN
1096 MLOOK2: MOVSI WRITE,1           ;MAKE WRITE INDICATE LOAD
1097         MOVEI BLOK,MFDBLK
1098         MOVEI UNIT,DIR
1099         JSP TT,RD               ;READ MASTER DIRECTORY TO FIND WHERE USER DIRECTORY IS
1100         MOVE T,DIR+MDCHK
1101         CAME T,[SIXBIT/M.F.D./]
1102          JSR EMFC,ERROR
1103         MOVE T,DIR+MDNUDS
1104         CAIE T,NUDSL
1105          JSR EMFC,ERROR
1106         CAIN CMD,'S
1107          JRST LISTS             ;LIST DISK ID'S AND SYSTEM NAMES
1108         MOVE T,DIR+MDNAMP
1109 MLOOK:  CAMN C,DIR+MNUNAM(T)    ;LOOK UP SYSTEM NAME
1110          JRST MLOOK1
1111         ADDI T,LMNBLK
1112         CAIGE T,2000
1113          JRST MLOOK
1114         JSR ESNF,ERROR          ;NOT FOUND
1115 \f
1116 MLOOK1: MOVEI BLOK,2*NUDSL-2000(T)      ;CONVERT USER SLOT TO BLOCK NUMBER
1117         LSH BLOK,-1
1118         HRRM BLOK,UDBLK         ;REMEMBER FOR KILL OR DUMP
1119         MOVEI UNIT,DIR
1120         JSP TT,RDM              ;READ USER DIRECTORY
1121 ULOOK:  CAME C,DIR+UDNAME
1122          JSR ECDR,ERROR         ;WRONG ONE??
1123         CAIE CMD,'F
1124         CAIN CMD,'U
1125          JRST LISTFC            ;LIST USER DIRECTORY
1126         MOVSI TT,UNIGFL
1127         MOVE T,DIR+UDNAMP
1128         MOVE A,FN1
1129         MOVE B,FN2
1130 ULOOK1: CAMN A,DIR+UNFN1(T)     ;LOOK UP FILE NAME
1131         CAME B,DIR+UNFN2(T)
1132          JRST ULOOK2
1133         TDNN TT,DIR+UNRNDM(T)   ;IS THIS FILE FOR REAL?
1134          JRST ULOOK3
1135 ULOOK2: ADDI T,LUNBLK
1136         CAIGE T,2000
1137          JRST ULOOK1
1138         CAIE CMD,'D             ;IF NOT FOUND BETTER BE DUMP
1139          JSR EFNF,ERROR
1140         MOVE T,DIR+UDNAMP
1141 ULOOK4: SKIPN DIR+UNFN1(T)      ;FIND FREE SLOT FOR NEW FILE
1142          JRST DUMP
1143         ADDI T,LUNBLK
1144         CAIGE T,2000
1145          JRST ULOOK4
1146         MOVNI T,LUNBLK          ;NO FREE SLOTS--TRY TO EXTEND NAME AREA DOWN
1147         ADDM T,DIR+UDNAMP
1148         MOVE T,DIR+UDESCP
1149         IDIVI T,6
1150         ADDI T,UDDESC
1151         CAMGE T,DIR+UDNAMP      ;DID WE RUN INTO DESCRIPTOR AREA?
1152          JRST DUMP0
1153         JSR EDIR,ERROR          ;YES
1154
1155 ULOOK3: HRRM T,DMP4             ;IF FILE FOUND, SAVE SLOT NUMBER FOR DUMP
1156         LDB C,[UNDSCP DIR+UNRNDM(T)]
1157         JSP TT,GBP
1158         MOVEM C,DIRPT           ;SET UP DESCRIPTOR AREA BYTE POINTER
1159         MOVSI TT,UNLINK
1160         TDNE TT,DIR+UNRNDM(T)
1161          JRST LINK              ;FILE IS A LINK
1162         LDB A,[UNPKN DIR+UNRNDM(T)]
1163 ULOOK5: CAMN A,TUT+QPKNUM       ;SEE IF IT'S MOUNTED
1164          JRST LOAD
1165         JSP TT,NXTTUT
1166          JRST ULOOK5
1167         JSR EPNM,ERROR
1168 \f
1169 LOAD:   CAIE CMD,'D             ;GET HERE IF FILE FOUND
1170         CAIN CMD,'K             ;IF DUMP OR KILL, DELETE IT
1171          JRST KILL
1172 ZERO:   MOVEI TT,CORE-1
1173         TRNN CMD,20             ;SKIP IF T$ SYMBOL LOADING COMMAND
1174          JRST ZERO1
1175         MOVEI B,DDT-1           ;ASSUME ALWAYS USING MOBY DDT
1176         JSP P,FD                ;GET DDT'S SYMBOL TABLE POINTER
1177          JSR EDDT,ERROR         ;CAN'T GET IT??
1178         HRROS B,(C)             ;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
1179         CAME B,[-1,,DDT-2]      ;VERIFY THAT IT'S REALLY A MOBY DDT LIKE WE THOUGHT
1180          JSR EDDT,ERROR
1181         SKIPE D,-2(C)           ;FLUSH ALL BUT INITIAL SYMBOLS
1182          MOVEM D,-1(C)
1183         MOVE D,-1(C)
1184         MOVEI TT,CORE-1
1185         CAILE TT,-1(D)
1186          MOVEI TT,-1(D)         ;DON'T ZERO SYMBOL TABLE NOR DDT
1187 ZERO1:  TRNE CMD,1
1188          JRST LOAD1             ;NON-ZEROING COMMAND
1189         SETZM 40                ;BEGIN CLEARING CORE
1190         MOVE T,[40,,41]         ;SET UP BLT POINTER
1191 ;CODE TO SKIP OVER NXM
1192 ZERO2:  CAIG TT,10*2000-1(T)    ;MORE THAN 8K LEFT TO ZERO?
1193          JRST ZERO4             ;NO, ZERO REMAINING WORDS AND PROCEED
1194         MOVE D,T                ;AVOID KA/KL INCOMPAT BY COPYING BLT PNTR
1195         BLT D,10*2000-1(T)      ;ZERO NEXT 8K
1196 ZERO3:  ADDI T,10*2000          ;MOVE DEST OF BLT PNTR UP 8K
1197         ANDCMI T,1777           ;ROUND DOWN TO 1K BOUNDARY
1198 KA,     CONO 10000              ;CLEAR NXM
1199         MOVES (T)               ;SET NXM IF HOLE
1200 KA,     CONSZ 10000             ;NXM GENERATED?
1201 KA,      JRST ZERO3             ;YES, GO TO NEXT 8K
1202         JRST ZERO2              ;NO, CLEAR THIS 8K
1203
1204 ZERO4:  BLT T,(TT)              ;AND CLEAR TO TOP BOUNDARY
1205         TRNE CMD,20
1206          JRST LOAD1             ;IF SYMBOL-LOADING COMMAND, STOP THERE
1207         CLEARM CBUF
1208         MOVE T,[CBUF,,CBUF+1]
1209         BLT T,CBUF+1777
1210         MOVEI UNIT,CBUF
1211         MOVE BLOK,CBLK          ;-NSWBL IN LH
1212         JSP TT,WRM              ;CLEAR PSEUDO-CORE
1213         AOBJN BLOK,.-1
1214 LOAD1:  SETZB BUFP,BLKCNT       ;SET UP BUFP SO FIRST CALL TO WD WILL READ
1215 LOAD2:  JSP P,WD                ;FIRST BLOCK OF FILE
1216         CAME D,[JRST 1]         ;LOOK FOR END OF SBLK LOADER
1217          JRST LOAD2
1218         CAIN CMD,'I             ;IF VERIFY, START SIMULATING DUMP
1219          JRST DUMP.5
1220 LOAD3:  JSP P,WD                ;READ BLOCK HEADER
1221         JUMPGE D,LOADS          ;IT'S A JUMP BLOCK
1222         MOVE A,D
1223         MOVE B,D
1224         JSR LOADB               ;LOAD LOGICAL BLOCK INTO CORE
1225         JRST LOAD3
1226
1227 LOADB:  0
1228 LOAD4:  JSP P,WD                ;LOAD A LOGICAL BLOCK--AOBJN POINTER IN B,
1229         ROT A,1                 ;BLOCK HEADER IN A (FOR CHECKSUM)
1230         ADD A,D                 ;ADD NEW WORD INTO CHECKSUM
1231         JSP P,FD                ;AND PREPARE TO SMASH IT AWAY
1232          JRST .+2               ;LOCATION CAN'T BE LOADED
1233           MOVEM D,(C)           ;SMASH WORD AWAY
1234         AOBJN B,LOAD4
1235         JSP P,WD
1236         CAMN A,D                ;CHECK THE CHECKSUM
1237          JRST @LOADB
1238         JSR ECKS,ERROR          ;BAD CHECKSUM
1239 \f
1240 LOADS:  CAIN CMD,'M
1241          JRST LOADG0            ;DON'T LOAD SYMBOLS NOR SADR
1242         MOVEM D,NXTBW3          ;SAVE S.A.
1243         MOVEI B,DDT-1           ;ASSUME IS ALWAYS MOBY DDT.
1244         JSP P,FD                ;GET DDT'S SYMBOL TABLE POINTER
1245          JSR EDDT,ERROR         ;CAN'T GET IT??
1246         SKIPN (C)
1247          JRST LOADJ             ;AIN'T GOT NO DDT, IGNORE SYMBOLS
1248         HRROS B,(C)             ;TELL DDT ITS SYMBOL TABLE WAS BUGGERED
1249         CAMN B,[-1,,DDT-2]      ;VERIFY THAT IT'S REALLY A MOBY DDT LIKE WE THOUGHT
1250          JSP P,FD               ;FETCH SYMBOL TABLE POINTER
1251           JSR EDDT,ERROR
1252         MOVE D,(C)
1253         MOVEM D,DDTM2
1254 LOADS1: MOVE B,DDTM2            ;GET LOWEST SYMBOL LOC SO FAR
1255         JSP P,WD                ;GET SYMBOL BLOCK HEADER
1256         JUMPGE D,LOADS2         ;JUMP IF END OF SYMBOLS
1257         TRNE D,-1               ;SKIP IF REALLY SYMBOLS AND NOT SOME OTHER BRAIN-DAMAGED CRUFT
1258          JRST LOADBD
1259         MOVSS D
1260         HRLI D,-1(D)
1261         ADD B,D                 ;EFFECTIVELY SUBTRACTS LENGTH OF BLOCK FROM BOTH HALVES
1262         MOVEM B,DDTM2           ;OF SYMBOL TABLE POINTER
1263         HRL B,D                 ;SET UP AOBJN POINTER IN B
1264         HRLZ A,D                ;AND RECREATE HEADER IN A
1265         JSR LOADB               ;LOAD THE SYMBOLS
1266         JRST LOADS1
1267
1268 LOADBD: HLRO B,D                ;-# WORDS TO SKIP (NOT COUNTING CHECKSUM)
1269         JSP P,WD
1270         AOJLE B,.-1
1271         JRST LOADS1             ;TRY NEXT SYMBOL BLOCK
1272
1273 LOADS2: MOVE D,DDTM2            ;GET UPDATED DDT SYMBOL PNTR
1274 LOADS4: MOVEI B,DDT-2           ;WE KNOW WHERE IT ALWAYS GOES
1275         JSP P,FD                ;PUT BACK SYMBOL TABLE POINTER
1276          JSR EBUG,ERROR         ;CAN'T PUT IT BACK??
1277         MOVEM D,(C)
1278         MOVEI B,DDT-4           ;GIVE STARTING ADDRESS TO DDT
1279         JSP P,FD
1280          JSR EBUG,ERROR
1281         MOVE D,NXTBW3
1282         MOVEM D,(C)
1283         MOVEI D,DDT             ;AND SET DSKDMP START ADDRESS TO DDT
1284 LOADJ:  HRRM D,SADR             ;SET STARTING ADDRESS FROM JUMP BLOCK
1285 LOADG0: MOVE T,BOOTNS           ;APPROP DISK WAIT FOR NON BUSY INSTR
1286         MOVEM T,BOOT
1287 LOADG:  JSP TT,WRCB             ;MAKE SURE ALL LOADED CRUFT IN PSEUDO-CORE IS OUT
1288         MOVEI WRITE,0
1289         JSP P,LODUMP            ;AND LOAD IT ALL IN
1290         TRNE CMD,10
1291          JRST READ              ;NON-GOING COMMAND
1292 GO:
1293 PH,[    MOVSI B,-LSWPADR
1294 GO1:    IORD DIFF,SWPCS1
1295         TRNN DIFF,%HXRDY        ; Wait for controller
1296          JRST GO1
1297         HRRZ DIFF,SWPVAL(B)
1298         IOWR DIFF,SWPADR(B)
1299         AOBJN B,GO1
1300 ];PH
1301 RH,[    MOVE B,ERRWD
1302         CONI DSK,HEAD
1303         TLNE HEAD,(%HID22)
1304          HRLI B,-1700_4
1305         MOVEM B,@ICWA
1306         MOVSI B,-6
1307 GO1:    CONSZ DSK,%HIBSY
1308          JRST .-1
1309         MOVE DIFF,SWPOU1(B)
1310         JSP HEAD,RHSET
1311         AOBJN B,GO1
1312 ];RH
1313 RP,[    MOVE B,ERRWD
1314         MOVEM B,@ICWA
1315         DATAO DPC,SWPSK
1316         JSP P,SKWAIT
1317         DATAO DPC,SWPOU1
1318         CONSO DPC,DONE
1319          JRST .-1
1320         DATAO DPC,SWPOU2
1321 ];RP
1322 SC,     DATAO DC0,[DJMP SWPOUT]
1323         JRST WAIT
1324 \f
1325 LISTS:  JSP P,CRLF
1326 LISTS2: JSP P,TYI0
1327          JRST LOADG1            ;SHUT UP IF KEY HIT
1328         MOVE C,TUT+QPKNUM       ;TYPE PACK NUMBER
1329         JSP TT,PNO
1330         MOVE D,TUT+QPAKID       ;AND I.D.
1331         JSP TT,PD2
1332         JSP TT,NXTTUT           ;SAME FOR ALL DIRECTORIES
1333          JRST LISTS2
1334         MOVE T,DIR+MDNAMP
1335 LISTS1: CAIGE T,2000
1336          JSP P,TYI0             ;STOP TYPING IF TTI FLAG ON
1337           JRST LOADG1
1338         SKIPE D,DIR+MNUNAM(T)
1339          JSP TT,PD              ;TYPE OUT USER NAME
1340         ADDI T,LMNBLK
1341         JRST LISTS1
1342
1343 LISTFC: MOVE T,DIR+UDNAMP
1344 LISTF1:
1345 KA,     CONSO TTY,40            ;STOP TYPING IF TTI FLAG ON
1346 KS,     SKIPN 8CTYIN            ; Stop typing if character waiting
1347          CAIL T,2000
1348           JRST LOADG1
1349         SKIPN DIR+UNFN1(T)      ;SKIP IF FILE IN THIS SLOT
1350          JRST LISTF2
1351         JSP P,CRLF
1352         LDB C,[UNPKN DIR+UNRNDM(T)]
1353         JSP TT,PNO              ;TYPE PACK NUMBER
1354         MOVE D,DIR+UNFN1(T)
1355         JSP TT,PD2              ;TYPE FIRST FILE NAME
1356         MOVE D,DIR+UNFN2(T)
1357         JSP TT,PD2              ;AND SECOND FILE NAME
1358 LISTF2: ADDI T,LUNBLK
1359         JRST LISTF1
1360
1361 KILL:   JSP TT,NXTB6            ;GET HERE ON KILL OR DUMP OF EXISTING FILE
1362         MOVEI T,0               ;ZERO BYTES IN USER DIRECTORY DESCIPTOR AREA
1363         DPB T,DIRPT             ;NXTB6 JUMPS TO KILL1 AT END OF FILE
1364         MOVE C,BLOK
1365         JSP TT,GTP
1366         ILDB T,C
1367         CAIGE T,TUTLK-1         ;SOS USAGE OF THIS BLOCK
1368          SOJL T,[JSR ECDR,ERROR]
1369         DPB T,C
1370         JRST KILL
1371
1372 KILL1:  HRRZ T,DMP4             ;CLEAR OUT USER DIRECTORY SLOT
1373         CLEARM DIR+UNFN1(T)
1374         CLEARM DIR+UNFN2(T)
1375         CLEARM DIR+UNRNDM(T)
1376         MOVSI WRITE,-1
1377         CAIN CMD,'K
1378          JRST KILDMP            ;IF KILL DON'T DUMP
1379         JRST DMP4               ;MUST DUMP ON SAME UNIT
1380 \f
1381 DUMP0:  MOVE T,DIR+UDNAMP       ;GET HERE IF SLOT CREATED AT BOTTOM OF NAME AREA
1382 DUMP:   HRRM T,DMP4             ;GET HERE IF EMPTY SLOT FOUND IN NAME AREA
1383 DMP0:   MOVEI D,0               ;GET HERE IF USING SLOT OF OLD FILE
1384 DMP1:   ;MOVE C,TUT+QSWAPA
1385         MOVEI C,0               ;NOTE START AT 0 NOT QSWAPA
1386         MOVE B,C
1387         SUB B,TUT+QLASTB
1388         HRLZ B,B                ;LH(B) COUNTS BLOCKS, RH(B) COUNTS FREE BLOCKS
1389         JSP TT,GTP
1390 DMP2:   ILDB T,C
1391         SKIPE T
1392 KA,      SUBI B,1               ;THIS RELIES ON CARRY PROPAGATING FROM RH TO LH IN AOBJN
1393 KL,      HRRI B,-1(B)           ;ON KI10, KL10 CHANGE SUBI B,1 TO HRRI B,-1(B)
1394 KS,      HRRI B,-1(B)           ;KS too...
1395         AOBJN B,DMP2
1396         CAIG B,(D)              ;RH OF D IS HIGHEST SO FAR, LH SAYS WHICH UNIT
1397          JRST DMP5              ;NOT BETTER THAN RECORD
1398         MOVE D,B                ;NEW RECORD--RECORD IT
1399         HRL D,CU
1400 DMP5:   JSP TT,NXTTUT           ;TRY NEXT
1401          JRST DMP1
1402                         ;FALLS THROUGH AT END
1403 DMP3:   HLRM D,CU               ;SET CURRENT UNIT TO ONE WITH MOST FREE BLOCKS
1404         JSP TT,RDTUT            ;GET ITS TUT
1405 DMP4:   MOVEI T,.
1406         MOVE A,FN1
1407         MOVE B,FN2
1408         MOVEM A,DIR+UNFN1(T)    ;PUT CRUFT INTO SLOT
1409         MOVEM B,DIR+UNFN2(T)
1410         SETOM DIR+UNDATE(T)     ; Unknown creation date
1411         HRROI C,777000          ; Unknown reference date
1412         MOVEM C,DIR+UNREF(T)    ; Unknown author, 36. bit bytes
1413 SC,[    MOVEM A,XWDS+XWFN1
1414         MOVEM B,XWDS+XWFN2
1415         MOVE C,SYSN
1416         MOVEM C,XWDS+XWSYSN
1417 ]       MOVE C,DIR+UDESCP       ;PUT DESCRIPTOR CHARACTER ADDRESS
1418         MOVE B,TUT+QPKNUM       ;AND PACK NUMBER
1419         DPB B,[UNPKN C]
1420         MOVEM C,DIR+UNRNDM(T)   ;INTO USER DIRECTORY SLOT
1421         ;MOVE C,TUT+QSWAPA      ;COMMENTED OUT INSN DUMPS INTO FILE AREA
1422         MOVEI C,0               ;DUMP INTO SWAPPING AREA TO AVOID Y FILES
1423         MOVEM C,LBLOCK          ;A DAEMON WILL COPY INTO FILE AREA AFTER SALVAGE
1424         JSP TT,GTP
1425         MOVEM C,TUTPT           ;INITIALIZE TUT POINTER
1426         MOVE C,DIR+UDESCP
1427         JSP TT,GBP
1428         MOVEM C,DIRPT           ;INITIALIZE DESCRIPTOR AREA POINTER
1429         SETOB WRITE,BLKCNT      ;FORCE NXTBW TO LOAD ADR
1430 KA,     HRLOI BUFP,-2001-1      ;SET UP BUFP SO FIRST WORD GOES IN DBUF+0
1431 KL,     HRLOI BUFP,-2001
1432 KS,     HRLOI BUFP,-2001
1433         MOVE D,[JRST 1]
1434         JSP P,WD                ;END OF SBLK LOADER
1435 ;DROPS THROUGH
1436 \f
1437 ;DROPS IN
1438 DUMP.5: MOVSI WRITE,-'I(CMD)    ;GET HERE IF VERIFY--SET WRITE NEGATIVE IF
1439         MOVEI B,40              ;DUMP AND ZERO IF VERIFY--FIRST ADDR DUMPED IS 40
1440         HRRM B,DUMP4
1441         HLLOS DUMP6
1442         SETZM DUMP9S
1443         SETZM DUMP9J
1444         SETZM DUMP9K
1445         MOVEI B,DDT-3           ;SET UP TO NOT DUMP SYMBOLS AS PART OF CORE IMAGE
1446         JSP P,FD
1447          JSR EBUG,ERROR
1448         SKIPN A,(C)             ;GET PNTR TO BUILT IN SYMBOLS
1449          JRST DUMP4             ;NO DDT, DON'T HACK THIS
1450         HRRM A,DUMP7            ;THIS IS WHERE WE START DUMPING AGAIN
1451         MOVEM A,DUMP9K          ;THIS WILL BE INITIAL SYMBOL TABLE PNTR WHEN DDT LOADED
1452         MOVNI A,(A)
1453         ADD A,1(C)              ;GET MINUS SIZE OF NON-BUILTIN SYMBOL TABLE IN RH(A)
1454         HRL A,1(C)              ;GET PNTR TO SYMBOL TABLE
1455         HLRM A,DUMP6            ;THIS IS WHERE WE STOP DUMPING
1456         MOVSM A,DUMP9S          ;SAVE AOBJN PNTR TO NON-BUILTIN SYMBOLS
1457         MOVE A,-1(C)            ;PICK UP START ADDRESS
1458         MOVEM A,DUMP9J          ;SAVE
1459         MOVE B,-2(C)            ;DUMP LOW CORE (ACS) OUT OF PLACE SAVED IN DDT
1460         HLLZ A,B                ;HERE B HAS ADDRESS DUMPING FROM
1461         JRST DUMP3B             ;AND A AND D HAVE VIRTUAL ADDRESS
1462
1463 DUMP1:                          ;SKIP OVER NXM ON DUMPING
1464 KA,[    CONSO 10000             ;NXM SET?
1465          JRST DUMP1A            ;NO, CONTINUE IN SEQUENCE
1466         ADDI B,10*2000-1        ;SKIP 8K
1467         TRZ B,1777              ;ROUND DOWN TO 8K BOUDARY
1468         CONO 10000              ;CLEAR NXM
1469 DUMP1A:
1470 ];KA
1471 DUMP6:  CAIGE B,.               ;SKIP IF REACHED SYMBOL TABLE
1472          JRST DUMP8
1473 DUMP7:  MOVEI B,.               ;SKIP OVER SYMBOLS, DUMP DDT
1474         HLLOS DUMP6             ;DEFUSE TEST
1475 DUMP8:  JSP P,FD
1476          JRST DUMPJ             ;TIME TO WRITE JUMP BLOCK AND SYMBOL TABLE
1477         SKIPN (C)               ;LOOK FOR NON-ZEROES
1478          AOJA B,DUMP1
1479         MOVE A,B                ;SAVE START OF BLOCK
1480 DUMP2:  TLZ A,-1                ;LOOK FOR TWO CONSECUTIVE ZEROES
1481 DUMP2A: CAIL B,200(A)           ;BUT DON'T DUMP MORE THAN 200 WORDS AT A TIME
1482          JRST DUMP3
1483         XCT DUMP6
1484          JSP P,FD
1485           JRST DUMP3            ;END OF CORE, WRITE OUT LAST BLOCK
1486         SKIPE (C)
1487          AOJA B,DUMP2           ;NONZERO
1488         TLON A,-1               ;ZERO, WAS PREV LOC ZERO ALSO?
1489          AOJA B,DUMP2A          ;NO, CHECK FOLLOWING LOC
1490         SOJA B,DUMP3            ;YES, DUMP THE NON-ZERO THAT PRECEDES IT
1491
1492 DUMP3:  HRRM B,DUMP4            ;SAVE ADDRESS TO CONTINUE SEARCH
1493         SUBM A,B                ;RH(B) GETS MINUS THE LENGTH OF THE BLOCK
1494         HRL A,B                 ;SET UP HEADER IN A
1495         MOVE B,A                ;AND B
1496 DUMP3B: MOVE D,A                ;AND D
1497         JSP P,WD                ;WRITE HEADER
1498 DUMP3A: JSP P,FD
1499          JSR EBUG,ERROR         ;CAN'T FETCH WORD WE FETCHED BEFORE??
1500         MOVE D,(C)
1501         ROT A,1
1502         ADD A,D                 ;COMPUTE CHECKSUM
1503         JSP P,WD                ;WRITE DATA WORD
1504         AOBJN B,DUMP3A
1505         MOVE D,A
1506         JSP P,WD                ;WRITE OUT CHECKSUM
1507 DUMP4:  MOVEI B,.               ;AND CONTINUE SEARCHING
1508         JUMPN B,DUMP1           ;IF MRC EVER SEES THIS --SELFMODIFYING CODE-- ....
1509         JRST DUMP9              ;FINISHED DUMPING SYMBOLS
1510 \f
1511 DUMPJ:  SKIPN DUMP9K
1512          JRST DMP9J1
1513         HRROI D,DDT-2           ;BUGGER THE SYMBOL TABLE
1514         MOVE A,D
1515         JSP P,WD
1516         MOVE D,DUMP9K
1517         ROT A,1
1518         JSP P,WD
1519         ADD D,A
1520         JSP P,WD
1521 DMP9J1: SKIPN D,DUMP9J
1522          MOVE D,SADR
1523         JSP P,WD                ;WRITE OUT JUMP BLOCK
1524         SKIPN B,DUMP9S          ;WRITE SYMBOLS
1525          JRST DUMP9             ;NO SYMBOLS
1526         HLLZ A,B
1527         HLLZS DUMP4             ;DUMP SYMBOL BLOCK, RETURN TO DUMP9
1528         JRST DUMP3B
1529
1530 DUMP9:  JUMPE WRITE,LOADG1      ;IF VERIFY, THAT'S ALL
1531         SKIPN D,DUMP9J
1532          MOVE D,SADR
1533         JSP P,WD                ;SECOND JUMP BLOCK
1534         HRRZ T,DMP4             ; GET POINTER TO NAME AREA
1535         AOS BUFP
1536         DPB BUFP,[UNWRDC+DIR+UNRNDM(T)]
1537         JSP TT,NXTBLK
1538         JSP TT,WRDB             ;WRITE OUT LAST BLOCK
1539         SKIPE T,BLKCNT
1540          JSR NXTBW3             ;STORE LAST DESCRIPTOR BYTE
1541         MOVEI T,0
1542         JSR NXTBW3              ;AND INDICATE END OF FILE
1543         LDB T,[360600,,DIRPT]
1544         IDIVI T,6
1545         HRRZ TT,DIRPT
1546         IMULI TT,6
1547         SUBI TT,6*<DIR+UDDESC>-5-1(T)
1548         HRRZM TT,DIR+UDESCP     ;INDICATE NEW END OF DESCRIPTOR AREA
1549 KILDMP: MOVEI UNIT,TUT
1550         MOVEI BLOK,TUTBLK
1551         JSP TT,WRD              ;WRITE OUT TUT ON THIS UNIT
1552 REPEAT NTUTBL-1,[
1553         ADDI UNIT,2000
1554         ADDI BLOK,1
1555         JSP TT,WRD
1556 ]
1557         HRRZ B,CU
1558         HRRM B,KD2              ;WRITE OUT USER DIRECTORY ON ALL UNITS
1559 KD1:    ADDI B,1
1560         CAIN B,NDSK
1561          MOVEI B,0
1562         HRRM B,CU
1563         SKIPE QDED(B)
1564          JRST KD2
1565         MOVEI UNIT,DIR
1566 UDBLK:  MOVEI BLOK,.
1567         MOVE TT,DIR+UDNAME
1568         CAME TT,SYSN
1569          JSR EBUG,ERROR
1570         JSP TT,WR
1571 KD2:    CAIN B,.
1572          JRST LOADG1
1573         JRST KD1
1574
1575 GTP:    SKIPGE TUT+QPKNUM
1576          JSR EBUG,ERROR         ;MUST BE OLD-STYLE TUT?
1577         SUB C,TUT+QFRSTB
1578         JUMPL C,[JSR EBUG,ERROR]
1579         IDIVI C,TUTEPW
1580         IMULI A,-10000*TUTBYT
1581         HRLI C,440000+TUTBYT_6(A)
1582         ADDI C,TUT+LTIBLK
1583         JRST (TT)
1584 \f
1585 SC,[    ;LOGICAL TO PHYSICAL DISK MAPPING
1586 QTRAN:  0       ;INDEX BY LOG DSK #
1587         1       ;4.9 => USE HIGH HALF OF DRIVE, RH = PHYS DRIVE #
1588         2       ;(NO LONGER DOES ANYTHING, NOW THAT MEMOWRECKS ARE GONE,
1589         3       ; BUT KEEP AROUND JUST IN CASE EVER NEEDED AGAIN.)
1590         4
1591         5
1592         6
1593         7
1594 IFL .-QTRAN-NDSK,.ERR QTRAN LOSES!!
1595 ];SC
1596
1597 ERRCT:  0               ;ERROR COUNTER
1598 DDTM2:  0               ;DDT SYMBOL TABLE POINTER
1599 DUMP9J: 0               ;START INSTRUCTION (AT DUMP9)
1600 DUMP9S: 0               ;SYMBOL TABLE POINTER (AT DUMP9)
1601 DUMP9K: 0               ;INITIAL SYMBOL TABLE PNTR (AT DUMP9)
1602 LBLOCK: 0               ;LAST BLOCK WRITTEN OR READ
1603 BLKCNT: 0               ;NUMBER OF BLOCKS READ OR WRITTEN CONSECUTIVELY
1604 DIRPT:  0               ;DESCRIPTOR AREA BYTE POINTER
1605 TUTPT:  0               ;TUT BYTE POINTER
1606 FN1:    0               ;FILE NAME 1
1607 FN2:    0               ;FILE NAME 2
1608 PKNUM:  REPEAT NDSK,-1  ;PACK NUMBER INDEXED BY DRIVE NUMBER
1609 QDED:   BLOCK NDSK      ;-1 IF DRIVE NOT TO BE USED
1610 XWDS:   BLOCK 4
1611 RPKID:  0
1612 BOOTNS: RP, CONSZ DPC,BUSY
1613         SC, CONSZ DC0,DSSACT
1614         RH, CONSZ DSK,%HIBSY
1615         PH, IORD B,SWPCS1       ; UGH!
1616
1617         CONSTANTS
1618
1619 IFL BEG+1677-., .ERR BLOAT
1620 INFORM SPACE LEFT,\BEG+1677-.
1621 BLOCK BEG+1677-.
1622
1623 BADBLK: 0               ;BLOCK WITH HDWE ERROR
1624 INFORM BADBLK,\.-1-BEG+<MEMSIZ-2000>
1625 \f
1626 ];END IFE BOOTSW
1627 IFN BOOTSW,[
1628 BEG=MEMSIZ-2000
1629 LOC MEMSIZ-100
1630 ]
1631
1632 CBOOT:  CLEARM MEMSIZ-1         ;BOOTSTRAP
1633 RP,[
1634 BOOT:
1635 IFE BOOTSW,     JRST BEG        ;OR CONSZ DPC,BUSY OR JRST LOADG1
1636 IFN BOOTSW,     CONSZ DPC,BUSY
1637          JRST .-1
1638         MOVEI B,ICWA+2          ;SET UP CHANNEL PROG
1639         MOVEM B,ICWA
1640         SETZM ICWA+1
1641         SETZM ICWA+3
1642         DATAO DPC,CLATT1
1643         DATAO DPC,SUNIT0
1644         DATAI DPC,B
1645 BOOT0:  TRNN B,RP03BT
1646          JRST BOOT1
1647         MOVEI B,MBLKS           ;UNIT 0 IS AN RP03, ADJUST WORLD
1648         HRRM B,CBLK
1649         MOVE B,RP3ADJ
1650         MOVSI A,-NSWBL
1651         XORM B,SWPSK(A)
1652         AOBJN A,.-1
1653 BOOT1:  HLLZS BOOT0             ;PREVENT TRNN FROM SKIPPING AGAIN
1654         MOVE B,ERRWD
1655         MOVEM B,@ICWA
1656         DATAO DPC,SWPSK
1657         JSP P,SKWAIT
1658         DATAO DPC,SWPIN1
1659         CONSO DPC,DONE
1660          JRST .-1
1661         DATAO DPC,SWPIN2
1662         CONSO DPC,DONE
1663          JRST .-1
1664         JRST BEG
1665
1666 ERRWD:  -1700,,BEG-1
1667 CLATT1: DEASEC ALLATT
1668 SWPSK:  DSEEKC+200._22.
1669 SWPIN1: DWRITC+200._22.+3_17.+2._12.+ICWA       ;NBLKS 4
1670 SWPIN2: DREADC+200._22.+4_17.+8._12.+ICWA
1671 SWPOU1: DWRITC+200._22.+4_17.+8._12.+ICWA
1672 SWPOU2: DREADC+200._22.+3_17.+2_12.+ICWA
1673 IFN NSWBL-5, .ERR THE PRECEDING 4 CONSTANTS ARE WRONG!
1674 CBLK:   -NSWBL,,NBLKS                   ;DISK ADDR OF CORE BUFFER, - # BLOCKS IN LH
1675 RP3ADJ: <<MCYLS#NCYLS>&377>_22.+<.BM DCYLXB>
1676 SUNIT0: DNOOPC
1677
1678 SKWAIT: DATAI DPC,A             ;AWAIT SEEK DONE UNIT 0
1679         TRNN A,ALLATT
1680          JRST SKWAIT
1681         DATAO DPC,CLATT1
1682         MOVEI A,30.
1683         SOJG A,.
1684         DATAI DPC,A
1685         TLNN A,(ONCYL)
1686          JRST SKWAIT
1687         JRST (P)
1688
1689 WAIT:   CONSO DPC,DONE
1690          JRST .-1
1691 ];RP
1692 \f
1693 PH,[    ;; Initially we could not use IORDQ or IOWRQ because they were
1694         ;; macros that used a literal.  There is nothing to stop us now,
1695         ;; except the fact that this code works fine and is as small as you
1696         ;; could possibly want.
1697
1698 BOOT:
1699 IFE BOOTSW, JRST BEG            ; or IORD B,SWPCS1 or JRST LOADG1
1700 IFN BOOTSW, IORD B,SWPCS1
1701         TRNN B,%HXRDY
1702          JRST BOOT
1703 KS,     WREBR 0                 ; No paging or caching
1704         MOVEI A,0
1705         IOWR A,SWPCS2           ; Select drive
1706 BOOT0:  IORD A,SWPCS1
1707         TRNN A,%HXDVA
1708          JRST BOOT0             ; Await drive available
1709         MOVSI B,-LSWPADR
1710 BOOT1:  HLRZ A,SWPVAL(B)
1711         IOWR A,SWPADR(B)
1712 BOOT2:  IORD A,SWPCS1
1713         TRNN A,%HXRDY           ; Wait for controller
1714          JRST BOOT2
1715         TRNE A,%HXTRE+%HXMCP    ; Lossage?
1716          JRST 4,.               ; Foo!
1717         AOBJN B,BOOT1
1718         JRST BEG
1719
1720 ZZ1==<NSWBL-1>*SECBLK   ;BLOCK CONTAINING CORE SWAPPED OUT TO BRING DSKDMP IN
1721 ZZ2==<NSWBL>*SECBLK     ;DSKDMP RESIDENCE BLOCK
1722 ZZ3==ZZ1/NSECS
1723 ZZ4==ZZ2/NSECS
1724 ZZ1==ZZ3*400+<ZZ1-NSECS*ZZ3>    ;CONVERT ADDR TO DISK FORMAT
1725 ZZ2==ZZ4*400+<ZZ2-NSECS*ZZ4>
1726
1727 SWPADR: UBAQ,,UBAPAG+UBPG_1     ; Set up Unibus map
1728         UBAQ,,UBAPAG+UBPG_1+1
1729         UBAQ,,%HRCS2            ; Clear controller
1730 SWPCS2: UBAQ,,%HRCS2            ; Select drive
1731 SWPCS1: UBAQ,,%HRCS1            ; Initialize
1732         UBAQ,,%HRCYL            ; Desire cylinder
1733         UBAQ,,%HRWC             ; Set (half) word count
1734         UBAQ,,%HRBA             ; Set Unibus address
1735         UBAQ,,%HRADR            ; Desire track and sector
1736         UBAQ,,%HRCS1            ; Write
1737         UBAQ,,%HRWC             ; Reset (half) word count
1738         UBAQ,,%HRBA             ; Reset Unibus address
1739         UBAQ,,%HRADR            ; Desire track and sector
1740         UBAQ,,%HRCS1            ; Read
1741 LSWPADR==:.-SWPADR
1742
1743 IFN BEG&1777, .ERR BEG does not lie on a page boundary?
1744
1745 ;;; LH FOR SWAP IN, RH FOR SWAP OUT
1746 SWPVAL: %UQVAL+%UQFST+BEG_-9,,%UQVAL+%UQFST+BEG_-9      ; Set up Unibus map
1747         %UQVAL+%UQFST+BEG_-9+1,,%UQVAL+%UQFST+BEG_-9+1
1748         %HYCLR,,%HYCLR          ; Clear controller
1749         0,,0                    ; Select drive
1750         %HMRDP,,%HMRDP          ; Initialize
1751         NCYLS,,NCYLS            ; Desire cylinder
1752         -1700*2,,-1700*2        ; Set (half) word count
1753         UBPG_14,,UBPG_14        ; Set Unibus address
1754         ZZ1,,ZZ2                ; Desire track and sector
1755         %HMWRT,,%HMWRT          ; Write
1756         -1700*2,,-1700*2        ; Reset (half) word count
1757         UBPG_14,,UBPG_14        ; Reset Unibus address
1758         ZZ2,,ZZ1                ; Desire track and sector
1759         %HMRED,,%HMRED          ; Read
1760 IFN .-SWPVAL-LSWPADR, .ERR SWPVAL wrong length.
1761
1762 CBLK:   -NSWBL,,NBLKS
1763
1764 WAIT:   IORD B,SWPCS1
1765         TRNN B,%HXRDY
1766          JRST WAIT
1767 ];PH
1768 \f
1769 RH,[
1770 BOOT:
1771 IFE BOOTSW,     JRST BEG        ;OR CONSZ DSK,%HIBSY OR JRST LOADG1
1772 IFN BOOTSW,     CONSZ DSK,%HIBSY
1773          JRST .-1
1774 KL,     CONSZ PAG,660000        ;PAGING AND CACHE MUST BE DISABLED
1775 KL,      JRST 4,.
1776         MOVEI B,ICWA+2          ;SET UP CHANNEL PROG
1777         MOVEM B,ICWA
1778         SETZM ICWA+1
1779         SETZM ICWA+3
1780 BOOT0:  DATAO DSK,[%HRDCL,,]
1781         MOVEI A,20
1782         SOJG A,.
1783         DATAI DSK,A
1784         TRNN A,%HCDVA
1785          JRST BOOT0             ;AWAIT DRIVE AVAILABLE
1786         MOVE B,ERRWD
1787         CONI DSK,A
1788         TLNE A,(%HID22)
1789          HRLI B,-1700_4
1790         MOVEM B,@ICWA
1791         MOVSI B,-6
1792 BOOT1:  DATAO DSK,SWPIN1(B)
1793         MOVEI A,20
1794         SOJG A,.
1795         CONSZ DSK,%HIBSY
1796          JRST .-1
1797         AOBJN B,BOOT1
1798         CONSZ DSK,%HIERR
1799          JRST 4,.
1800         JRST BEG
1801
1802 ZZ1==<NSWBL-1>*SECBLK   ;BLOCK CONTAINING CORE SWAPPED OUT TO BRING DSKDMP IN
1803 ZZ2==<NSWBL>*SECBLK     ;DSKDMP RESIDENCE BLOCK
1804 ZZ3==ZZ1/NSECS
1805 ZZ4==ZZ2/NSECS
1806 ZZ1==ZZ3*400+<ZZ1-NSECS*ZZ3>    ;CONVERT ADDR TO DISK FORMAT
1807 ZZ2==ZZ4*400+<ZZ2-NSECS*ZZ4>
1808
1809 ERRWD:  -1700,,BEG-1
1810 SWPIN1: %HRLOD+%HRDCL,,%HMRDP
1811 SWPIN2: %HRLOD+%HRCYL,,NCYLS+1  ;AVOID CYLINDER 406 WHICH KLDCP USES
1812 SWPIN3: %HRLOD+%HRADR,,ZZ1
1813 SWPIN4: %HRLOD+%HRCTL,,%HMWRT+ICWA_6
1814 SWPIN5: %HRLOD+%HRADR,,ZZ2
1815 SWPIN6: %HRLOD+%HRCTL,,%HMRED+ICWA_6
1816
1817 SWPOU1: %HRLOD+%HRDCL,,%HMRDP
1818 SWPOU2: %HRLOD+%HRCYL,,NCYLS+1  ;AVOID CYLINDER 406 WHICH KLDCP USES
1819 SWPOU3: %HRLOD+%HRADR,,ZZ2
1820 SWPOU4: %HRLOD+%HRCTL,,%HMWRT+ICWA_6
1821 SWPOU5: %HRLOD+%HRADR,,ZZ1
1822 SWPOU6: %HRLOD+%HRCTL,,%HMRED+ICWA_6
1823
1824 CBLK:   -NSWBL,,NBLKS+NBLKSC    ;AVOID CYLINDER 406 WHICH KLDCP USES
1825
1826 WAIT:   CONSO DSK,%HIDON
1827          JRST .-1
1828 ];RH
1829 \f
1830 SC,[
1831 BOOT:
1832 IFE BOOTSW,     JRST BEG        ;OR CONSZ DC0,DSSACT OR JRST LOADG1
1833 IFN BOOTSW,     CONSZ DC0,DSSACT
1834          JRST .-1
1835         DATAO DC0,SWPINJ
1836         CONSZ DC0,DSSACT
1837          JRST .-1
1838         JRST BEG
1839
1840 SWPINJ: DJMP SWPIN
1841
1842 DADR==NCYLS_13+<<NSWBL-1>/2>_6+<<NSWBL-1>&1>    ;ADDR OF LAST BLOCK IN CORE BUFFER
1843 DADR1==NCYLS_13+<NSWBL/2>_6+<NSWBL&1>           ;ADDR OF NEXT BLOCK (CONTAINS
1844 SWPIN:  DWRITE+DUNENB+DADR                      ; WORKING COPY OF DSKDMP)
1845         DCOPY BEG(-2000_2&37774)
1846         DCSKIP (-4_2&37774)
1847         DRC+DADR
1848         DCOPY BEG(-2000_2&37774)
1849         DCSKIP (-4_2&37774)
1850         DREAD+DADR1
1851         DCOPY BEG(-1700_2&37774)
1852         DCSKIP (-104_2&37774)
1853         DRC+DADR1
1854         DCOPY BEG(-1700_2&37774)
1855         DCSKIP (-104_2&37774)
1856         DHLT
1857
1858 SWPOUT: DWRITE+DUNENB+DADR1
1859         DCOPY BEG(-2000_2&37774)
1860         DCSKIP (-4_2&37774)
1861         DRC+DADR1
1862         DCOPY BEG(-2000_2&37774)
1863         DCSKIP (-4_2&37774)
1864         DREAD+DADR
1865         DCOPY BEG(-1700_2&37774)
1866         DCSKIP (-104_2&37774)
1867         DRC+DADR
1868         DCOPY BEG(-1700_2&37774)
1869         DCSKIP (-104_2&37774)
1870         DHLT
1871
1872 CBLK:   -NSWBL,,NBLKS           ;DISK ADDR OF CORE BUFFER, - # BLOCKS IN LH
1873 WAIT:   CONSZ DC0,DSSACT
1874          JRST .-1
1875 ];SC
1876 SADR:   JRST BOOT               ;AND GO TO PROGRAM TO BE STARTED
1877 SYSN:   SIXBIT /./              ;CURRENT DIRECTORY
1878 IFG .+1-MEMSIZ,.ERR BOOT BLOAT
1879
1880 IFE BOOTSW,{                    ;CURLY BRACKETS TO AVOID ERROR MESSAGE
1881         OFFSET 0
1882         LOC CORE
1883
1884 ;THESE ARE THE BLOCKS THAT GET WRITTEN ON DISK
1885 ; STARTING AT THE BEGINNING OF THE FIRST EXTRA CYLINDER
1886
1887 CBUF:   BLOCK 2000              ;PSEUDO-CORE BUFFER
1888 DBUF:   BLOCK 2000              ;DISK BUFFER
1889 DIR:    BLOCK 2000              ;DIRECTORY BUFFER
1890 TUT:    BLOCK 2000*NTUTBL       ;TUT BUFFER
1891 IFN .-BEG,.ERR BLOCKS LOST
1892 ;       BLOCK 2000              ;CORE OVERLAYED BY DSKDMP
1893 ;       BLOCK 2000              ;COPY OF DSKDMP
1894 ;       BLOCK 2000              ;SPARE COPY OF DSKDMP
1895
1896 END ZZZ
1897 };END IFE BOOTSW
1898 IFN BOOTSW, END CBOOT