system/ddtdsk.31

   1 ;;; Copyright (c) 1999 Massachusetts Institute of Technology
   2 ;;;
   3 ;;; This program is free software; you can redistribute it and/or
   4 ;;; modify it under the terms of the GNU General Public License as
   5 ;;; published by the Free Software Foundation; either version 3 of the
   6 ;;; License, or (at your option) any later version.
   7 ;;;
   8 ;;; This program is distributed in the hope that it will be useful,
   9 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;;; General Public License for more details.
  12 ;;;
  13 ;;; You should have received a copy of the GNU General Public License
  14 ;;; along with this program; if not, write to the Free Software
  15 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16
  17
  18 ;AC's used by disk routines
  19
  20 da=11                   ;used mostly for argument passing
  21 db=12
  22 dc=13
  23 dd=14                   ;dd>=0 if file open else reason why file is closed
  24
  25 nudsl==500.             ;# user directory slots in M.F.D.
  26
  27 ;file system parameters and RH10/RP04 parameters
  28
  29 ifn dsksw-3, .err Only RH10 disk is supported
  30 .insrt system;rh10
  31 .insrt system;fsdefs
  32
  33 icwa==20                ;initial channel control word
  34 lowfix==icwa+2          ;lowest fixed loacation
  35 blksiz==2000            ;# words in disk block
  36 maxtry==10              ;# times to try disk transfer before hard failure assumed
  37 maxlnk==20              ;maximum # of links
  38 ;ntutbl==               ;# pages necessary to store a TUT
  39 swpags==ntutbl+4        ;# pages swapped to disk (mfd, ufd, io bfr, core bfr and tut)
  40 swpblk==tblks-swpags    ;first disk block used for core swapping
  41 bootbl==swpblk-4        ;four disk blocks to save ddt for fast booting
  42 mfd=lowcod-blksiz       ;mfd origin
  43 ufd=mfd-blksiz          ;ufd origin
  44 corbfr=ufd-blksiz       ;core buffer origin
  45 iobfr=corbfr-blksiz     ;io buffer origin
  46 tut=iobfr-<blksiz*ntutbl>
  47                         ;tut goes last
  48 lowswp==lowcod-<blksiz*swpags>
  49                         ;lowest location swapped
  50 ifn tut-lowswp, .err lowswp loses
  51 maxdmp==200             ;largest dump block allowed
  52 lowclr==40              ;lowest location zeroed when ddt loads
  53
  54 ;template for datao's that cause disk transfers
  55
  56 rdatao==%hrctl\%hrlod,,%hmred\<icwa_<35.-29.>>
  57 wdatao==%hrctl\%hrlod,,%hmwrt\<icwa_<35.-29.>>
  58
  59 kl, swpua=701540,,0
  60
  61 ;bug halt for bugs
  62 ;error halt for error conditions beyond capabilities of program
  63
  64 define errhlt
  65         jrst 4,.
  66 termin
  67
  68 define  bughlt
  69         jrst 4,.
  70 termin
  71
  72 dskcod==.
  73
  74 \f
  75 ;lowest level io
  76
  77 ;calculates Physical Disk Address and sets up Channel Command List
  78
  79 pdaccl: pushj p,rp4map          ;caluculate physical disk address
  80         skiple w1,ioadr ;first word to be transferred
  81         caige w1,17             ;don't try transfer from or to shadow AC's
  82         bughlt
  83         subi w1,1               ;iowd format
  84 ka,     hrli w1,-blksiz         ;# words in block
  85 .else   hrli w1,-blksiz_4
  86 pdacc2: movem w1,icwa           ;transfer data (iowd)
  87         setzm icwa+1            ;DF10 writes here for termination
  88         popj p,
  89
  90 ;calculates RP04 cylinder, surface, and sector given block #
  91
  92 rp4map: skipl w1,da             ;the block #
  93         cail w1,tblks           ;check for reasonable block #
  94         bughlt
  95         idivi w1,nblksc         ;blocks/cylinder
  96         movem w1,cylndr
  97         imuli w2,secblk         ;sectors/block
  98         move w1,w2              ;sector # on this cylinder
  99         idivi w1,nsecs          ;sectors/surface
 100         movem w1,surfce
 101         movem w2,sector
 102         popj p,
 103
 104 ;transfers disk block
 105
 106 redblk: skipa db,[rdatao]       ;the beginnings of a datao (go bit is on)
 107 wrtblk: move db,[wdatao]
 108 rwblk:  pushj p,pdaccl          ;calculate physical disk address, set up CCL
 109 rwblk0: move w1,drive           ;fill in the desired drive
 110         skipn qact(w1)          ;make sure is good drive
 111          jrst rwblkl
 112         dpb w1,[$hcdrv db]
 113         setzm xfrcnt            ;count times through loop
 114 rwblk1: pushj p,xfer            ;transfer the data
 115          aosa w1,xfrcnt
 116           popj p,               ;transfer succeeded, don't try again
 117         caig w1,maxtry
 118          jrst rwblk1
 119 rwblkl: move w1,drive
 120         hrroi dd,'UN0(w1)
 121         jrst fserr
 122
 123 xfer:   consz dsk,%hibsy        ;wait for controller to finish
 124         jrst .-1
 125         datao dsk,[%hrrae\%hrlod,,377];flush any rae's that may be there
 126         cono dsk,%hoclr\%horae  ;flush any left overs and plunge on
 127 kl,[    consz pag,600000
 128          swpua                  ;sweep the cache
 129         consz 200000            ;apr,
 130          jrst .-1
 131 ]
 132         movsi w1,%hrsts         ;get the drive status
 133         jsp t,rhget             ;will popj on error
 134         trnn w1,%hserr          ;any drive errors
 135         jrst xfer2              ;drive is okay plunge on
 136
 137 ;detected drive error before data xfer, try to reset drive if possible
 138
 139         trc  w1,%hsvv\%hsmol\%hsrdy     ;check for all ready bits on
 140         trce w1,%hsvv\%hsmol\%hsrdy
 141         popj p,                 ;not ready, transfer fails
 142 xfer2:  movsi w1,%hrcyl         ;set cylinder
 143         hrr w1,cylndr
 144         jsp t,rhset
 145         move w1,surfce          ;set sector and track
 146         lsh w1,10
 147         ior w1,sector
 148         hrli w1,%hradr
 149         jsp t,rhset
 150         datao dsk,db            ;zap
 151         conso dsk,%hidone       ;wait for transfer to finish
 152         jrst .-1
 153         conso dsk,%hierr        ;errors?
 154         aos (p)                 ;    no
 155         popj p,                 ;    yes
 156
 157 ;rhset and rhget are used to read and write device registers on Massbus
 158 ;They are called with jsp t, but popj if they fail.  Beware!!!
 159
 160 rhset:  tloa w1,%hrlod          ;load register
 161 rhget:  tlz  w1,%hrlod          ;just read register
 162         tso w1,drive            ;put in drive #
 163         datao dsk,w1
 164         movei w1,6              ;delat for massbus
 165         sojg w1,.
 166         datai dsk,w1
 167         tlne w1,%hderr          ;covers the multitude of sins
 168          popj p,                ;failed
 169         jrst (t)                ;success
 170 \f
 171 ;routines to read and write special disk blocks
 172
 173 swpin:  skipl blkin             ;skip if no core buffer
 174          pushj p,swpbfo         ;swap the buffer out first
 175         pushj p,swpi1           ;do all disk transfers necessary
 176         move c,[twenty,,20]     ;restore old stuff at icwa
 177         blt c,lowfix-1
 178         setob c,blkin           ;also used as no blocks in flag
 179         popj p,
 180
 181 swpout: movs c,[twenty,,20]     ;try and save a literal
 182         blt c,ac0+lowfix-1      ;save stuff used by icwa
 183         skipa c,[wrtblk]
 184 swpi1:  movei c,redblk
 185         movei b,lowcod          ;starting at this core address
 186         move a,mu
 187         movem a,drive           ;always use master unit for swapping
 188         movei a,swpags-1        ;block counter
 189 swpio:  movei b,-blksiz(b)
 190         movem b,ioadr
 191         movei da,swpblk(a)
 192         pushj p,(c)             ;call either redblk or wrtblk
 193         sojge a,swpio
 194         movei c,<corbfr-lowswp>/blksiz
 195 swpbfp: movem c,blkin           ;block that is swapped in
 196         skipge da,c
 197         bughlt                  ;no blocks are swapped out
 198         imuli da,blksiz
 199         addi da,lowswp          ;virtual address of first word in corbfr
 200         movem da,swporg
 201         addi da,blksiz-1        ;virtual address of last word in corbfr
 202         movem da,swpor1
 203         popj p,
 204
 205 ;here to swap core block in and set up pointers
 206
 207 swpbfi: pushj p,swpbfp          ;set buffer pointers
 208         skipa b,[redblk]
 209
 210 ;swaps out the block in corbfr
 211
 212 swpbfo: movei b,wrtblk
 213         skipge c,blkin          ;index of block we want
 214          bughlt
 215         movei da,corbfr         ;core address for transfer
 216         movem da,ioadr
 217         move da,mu              ;swapped from and onto master unit
 218         movem da,drive
 219         movei da,swpblk(c)      ;block # to read
 220         jrst (b)                ;transfer the block
 221 \f
 222 nxttut: aos c,cu                ;try next tut
 223         cail c,ndsk
 224          setzb c,cu
 225         skipn qact(c)
 226          jrst nxttut
 227 redtut: skipa c,[redblk]
 228 wrttut: movei c,wrtblk
 229         movei b,tut+<ntutbl*blksiz>
 230         move a,cu               ;tut goes on current unit
 231         movem a,drive
 232         movei a,ntutbl-1
 233 tutio:  movei b,-blksiz(b)
 234         movem b,ioadr
 235         movei da,tutblk(a)
 236         pushj p,(c)
 237         sojge a,tutio
 238         popj p,
 239
 240 redmfd: movei da,mfdblk
 241         movei b,mfd
 242 mfdufd: movem b,ioadr
 243         move b,mu               ;read from master unit
 244         movem b,drive
 245         jrst redblk
 246
 247 redufd: move da,ufdblk          ;where ufd is
 248         movei b,ufd
 249         jrst mfdufd
 250
 251 wrtufd: move da,ufdblk          ;ufd is written on all units
 252         movei b,ufd
 253         movem b,ioadr
 254         move a,cu               ;start with current unit
 255         movem a,drive
 256 wrtuf1: skipe qact(a)
 257          pushj p,wrtblk
 258         aos a,drive
 259         cail a,ndsk
 260         setzb a,drive
 261         came a,cu
 262         jrst wrtuf1
 263         popj p,
 264
 265 ; Reset the disks
 266
 267 reset:  coni pag,b              ;turn off paging
 268         trz b,060000
 269         cono pag,(b)
 270         movei b,ndsk-1
 271 reset0: movem b,drive
 272         skipe qact(b)           ;skip unit if turned off
 273          pushj p,reset1
 274         sojge b,reset0
 275         move b,mu               ;is master unit active?
 276         skipe qact(b)
 277          popj p,
 278         movei b,ndsk-1          ;no, pick an active unit for mu
 279         skipn qact(b)
 280          sojge b,.-1
 281         jumpl b,resetl          ;"UN/" mumble
 282         movem b,mu
 283         popj p,
 284
 285 reset1: pushj p,reset3          ;poptj if win
 286 resetl: hrroi dd,'UN0(b)                ;popj if lose
 287         jrst fserr
 288
 289 reset3: cono dsk,%hoclr\%horae
 290         datao dsk,[%hrrae\%hrlod,,377]
 291         movei w1,%hmclr
 292         jsp t,rhset
 293         movei w1,%hmrdp
 294         jsp t,rhset
 295         movsi w1,%hrofs
 296         jsp t,rhset
 297         movei w1,%hmack
 298         jsp t,rhset
 299         movsi w1,%hrsts
 300         jsp t,rhget
 301         trne w1,%hserr
 302          popj p,
 303         trc w1,%hsvv+%hsmol+%hsrdy
 304         trcn w1,%hsvv+%hsmol+%hsrdy
 305          jrst poptj             ;win
 306         popj p,
 307 \f
 308 ;file system routines
 309
 310 ;lookup -- call with file names and sname in fn1, fn2, and sname
 311 ;fails if dd<0 otherwise returns user directory index in dd
 312 ;dirpt is set up as byte pointer into descriptor area
 313 ;if lookup found a link then lnkcnt will be non-zero and lnkufd and lnkptr
 314 ;will contain block # of ufd and name area index respectively of
 315 ;first link in chain  fn1, fn2, and sname are clobbered file at end of chain
 316
 317 lookup: setzm lnkcnt            ;link counter
 318         pushj p,redmfd          ;read the mfd
 319         move t,mfd+mdchk
 320         came t,[sixbit /M.F.D./]
 321         errhlt                  ;how can this be the mfd?
 322         move t,mfd+mdnuds
 323         caie t,nudsl            ;make sure there are enough directory slots
 324         errhlt                  ;this still doesn't look like an mfd
 325 linklk: skipn t,sname           ;entry point for link solver
 326          jrst look1b
 327         move db,mfd+mdnamp      ;pointer to mfd name area
 328 look1a: camn t,mfd+mnunam(db)
 329          jrst look2             ;found directory in mfd
 330         addi db,lmnblk          ;next slot in mfd
 331         caige db,blksiz
 332          jrst look1a
 333 look1b: hrroi dd,'NXD           ;directory slot not found
 334         popj p,
 335
 336 ;found the ufd slot, pointer in db
 337
 338 look2:  lsh db,-1
 339         movei da,<nudsl-1000>(db);magic
 340         movem da,ufdblk         ;save address of ufd
 341         move t,sname
 342         camn t,ufd+udname
 343         jrst look3              ;don't read ufd unless we have to
 344         pushj p,redufd          ;read ufd from master disk
 345         move t,sname            ;check for right one
 346         came t,ufd+udname
 347         errhlt                  ;this is not it
 348 look3:  move dd,ufd+udnamp      ;pointer to name area
 349         skipn da,fn1            ;search user directory
 350          popj p,                ;just getting dir, return now
 351         move db,fn2
 352         movsi dc,unigfl         ;deleted or open for writing
 353 ulook:  camn da,ufd+unfn1(dd)   ;file name match?
 354         came db,ufd+unfn2(dd)
 355         jrst ulook1
 356         tdnn dc,ufd+unrndm(dd)  ;file names match
 357         jrst ulook2             ;found file
 358 ulook1: addi dd,lunblk          ;advance to next file
 359         caige dd,blksiz
 360         jrst ulook
 361         hrroi dd,'FNF           ;file not found
 362         popj p,
 363 \f
 364 ;found file, set up pointer into descriptor area, and get tut in core
 365
 366 ulook2: pushj p,ufdbp           ;make ufd descriptor byte pointer
 367         movem da,dirpt
 368         movsi da,unlink
 369         tdne da,ufd+unrndm(dd)  ;is this a link?
 370         jrst ulink              ;    yes, call link solver
 371         ldb dc,[unpkn ufd+unrndm(dd)]
 372         setzm cu
 373 ulook3: pushj p,nxttut
 374         camn dc,tut+qpknum
 375          jrst ulook4
 376         skipe cu
 377          jrst ulook3
 378         hrroi dd,'NSP           ;no such pack
 379         popj p,
 380
 381 ulook4: setzm lblock            ;last block accessed
 382         setzm blkcnt            ;forces next descriptor byte
 383         setzm wrdcnt            ;forces buffer reload
 384         popj p,
 385
 386 ;returns byte pointer into descriptor area in da, clobbers db
 387
 388 ufdbp:  ldb da,[undscp ufd+unrndm(dd)]
 389         idivi da,ufdbyt         ;convert ufd character address into byte pointer
 390         imuli db,-10000*ufdbyt
 391         hrli da,440000+<ufdbyt_6>(db)
 392         addi da,ufd+uddesc      ;origin of ufd descriptor area
 393         popj p,
 394 \f
 395 ;link solver
 396
 397 ulink:  skipe lnkcnt            ;first link
 398         jrst ulink1             ;    no
 399         movem dd,lnkptr         ;save pointer to first one
 400         move t,ufdblk
 401         movem t,lnkufd
 402 ulink1: aos t,lnkcnt
 403         caile t,maxlnk          ;too many links
 404         jrst [  hrroi dd,'TML
 405                 popj p,]
 406         pushj p,redlnk          ;read the link name
 407         jrst linklk
 408
 409 redlnk: setzm sname
 410         setzm fn1
 411         setzm fn2
 412         move dc,[440600,,sname] ;read file name from descriptor area
 413 linkl:  ildb t,dirpt
 414         cain t,';               ;directory name?
 415         jrst links
 416         cain t,':
 417         jrst [  ildb t,dirpt    ;: quotes next character
 418                 idpb t,dc
 419                 jrst link1]     ;allows blanks in file names
 420         idpb t,dc
 421         jumpe t,cpopj           ;jump if finished reading link
 422 link1:  came dc,[000600,,fn2]   ;finished?
 423         jrst linkl
 424         popj p,                 ;end of link
 425
 426 ;found ";" in file name
 427
 428 links:  tlnn dc,770000          ;align byte pointer on word boundary
 429         jrst link1
 430         ibp dc
 431         jrst links
 432 \f
 433 fsdele: pushj p,lookup          ;find the file
 434         jumpl dd,cpopj          ;jump if we're losing
 435         pushj p,zapdsc          ;zap descriptor area
 436         setzm ufd+unfn1(dd)
 437         setzm ufd+unfn2(dd)
 438         setzm ufd+unrndm(dd)
 439         skipn lnkcnt            ;don't write if link
 440         pushj p,wrttut          ;write the tut
 441         jrst wrtufd             ;write the ufd out on all units
 442
 443 ;zap file descriptor
 444
 445 zapdsc: setzm blkcnt            ;make plenty damn sure
 446         skipn lnkcnt            ;if there were no links
 447         jrst zaprf              ;    then zap real file
 448
 449 ;zap link descriptor
 450
 451         move da,lnkufd          ;fetch the original ufd
 452         pushj p,redufd
 453         move dd,lnkptr          ;pointer to file
 454         movsi da,unlink         ;test for link
 455         tdnn da,ufd+unrndm(dd)
 456         bughlt                  ;hmmm, it said it was a link
 457         pushj p,ufdbp           ;get byte pointer to descriptor area
 458         push p,da               ;save beginning byte pointer
 459         movem da,dirpt          ;grist for redlnk
 460         pushj p,redlnk
 461         skipa
 462 zaplop: pop p,dd                ;entry point from zaprf
 463         pop p,da                ;beginning of descriptor area
 464         setzb db,blkcnt         ;clear blkcnt set by advblk
 465 zapl1:  idpb db,da              ;zero out descriptor
 466         came da,dirpt           ;caught the end yet?
 467         jrst zapl1
 468         popj p,
 469
 470 ;zap real file descriptor
 471
 472 zaprf:  jumpl dd,cpopj          ;if file not found then give error return
 473         movsi da,unlink         ;test for link
 474         tdne da,ufd+unrndm(dd)
 475         bughlt                  ;it should not be a link
 476
 477 ;update tut before zapping descriptor area
 478
 479         push p,dirpt            ;save pointer to beginning
 480         push p,dd               ;save pointer to name area in ufd
 481 zaprf1: pushj p,advblk          ;gets next block in da
 482         jumpl dd,zaplop         ;now zap descriptor area
 483         pushj p,tutpnt          ;returns tut byte pointer in da
 484         ldb db,da               ;tut entry
 485         caige db,tutlk-1        ;block locked for some reason
 486         sojl db,[bughlt]
 487         dpb db,da               ;clobber tut
 488         jrst zaprf1
 489 \f
 490 ;opens file for output
 491
 492 outopn: pushj p,lookup          ;does version of file already exist?
 493         skipn lnkcnt
 494         jumpl dd,outo1          ;not necessary to zap descriptor area
 495         skipn lnkcnt            ;if its a link, we must make sure ufd and tut are in
 496         jrst outo01             ;    not a link all the good stuff is together
 497         jrst pikpak             ;not necessary to find a free directory slot
 498
 499 ;find free slot in ufd name area
 500
 501 outo1:  came dd,[-1,,'FNF]      ;proceed only if file not in ufd
 502         popj p,
 503         move dd,ufd+udnamp      ;start looking at beginning
 504 outo11: skipn ufd+unfn1(dd)     ;slot free?
 505         jrst pikpak             ;    yes, pick-a-pack
 506         addi dd,lunblk
 507         caige dd,blksiz         ;past end of ufd?
 508         jrst outo11             ;    no,try again
 509
 510 ;no free slots, try to extend name area down
 511
 512         movni dd,lunblk
 513         addb dd,ufd+udnamp
 514         move da,ufd+udescp
 515         idivi da,ufdbyt
 516         addi da,uddesc+3
 517         caml da,ufd+udnamp      ;did we run into descriptor area?
 518         jrst [  hrroi dd,'FUL   ;directory full
 519                 popj p,]
 520         setzm ufd+unfn1(dd)     ;clear out that file name
 521
 522 ;directory slot all set up, now decide which unit to write on (pick-a-pack)
 523
 524 pikpak: move t,mu
 525         movem t,cu
 526         pushj p,redtut          ;start searching on current unit
 527         push p,cu               ;unit we started on
 528         push p,[0]              ;# free blocks on best unit
 529         push p,(p)              ;# free blocks on this unit
 530         push p,cu               ;best unit so far
 531 piknxt: setzm -1(p)             ;# free blocks on this unit
 532         move dc,tut+qfrstb
 533         ;following lines commented out so that files will be written in swap area
 534         ;thus avoiding Y files when dumping crashes.  When sys comes up will get copied.
 535         ;camge dc,tut+qswapa    ;first track beyond swapping area
 536          ;move dc,tut+qswapa
 537         move da,dc
 538         sub da,tut+qlastb
 539         hrl dc,da               ;aobjn pointer
 540 piknx1: movei da,(dc)           ;block #
 541         pushj p,tutpnt          ;byte pointer to tut entry
 542         ldb da,da
 543         skipn da
 544         aos -1(p)               ;found a free block
 545         aobjn dc,piknx1         ;counted all free blocks on pack yet?
 546         move da,-1(p)           ;# free blocks on this pack
 547         camg da,-2(p)           ;more blocks on this one
 548         jrst piknx2             ;    no, advance to next tut
 549         movem da,-2(p)
 550         move db,cu
 551         movem db,(p)            ;this is best so far
 552 piknx2: pushj p,nxttut          ;try next tut
 553         move db,cu
 554         came db,-3(p)           ;have we gone around the packs
 555         jrst piknxt             ;    no, go to next unit
 556         pop p,cu                ;this unit won
 557         sub p,[3,,3]            ;clean up stack
 558         pushj p,redtut          ;read in tut from current unit
 559         skipn lnkcnt            ;if a link, then get ufd in
 560         jrst outo0              ;was not a link, ufd is already there
 561         move da,lnkufd
 562         movem da,ufdblk
 563         pushj p,redufd
 564 outo0:  skipe ufd+unfn1(dd)     ;fresh file?
 565         jrst outo01             ;no, zap descriptor area
 566         move da,fn1             ;put in the file name
 567         movem da,ufd+unfn1(dd)
 568         move da,fn2
 569         movem da,ufd+unfn2(dd)
 570         skipa
 571 outo01: pushj p,zapdsc          ;zap descriptor area
 572         setzm blkcnt            ;no contig blks taken yet
 573         setzm lblock            ;and start searching from beginning
 574         setzm ufd+unrndm(dd)    ;flush all random bits
 575         move da,tut+qpknum      ;pack #
 576         dpb da,[unpkn ufd+unrndm(dd)]
 577         setom ufd+undate(dd)    ;clear date file created
 578         move da,ufd+udescp      ;first free byte in descriptor area
 579         dpb da,[undscp ufd+unrndm(dd)]
 580         pushj p,ufdbp           ;turn him into a byte pointer
 581         movem da,dirpt          ;descriptor area byte pointer
 582 outbuf: setzm iobfr             ;clear io buffer
 583         move da,[iobfr,,iobfr+1]
 584         blt da,iobfr+blksiz-1
 585         jrst fsbfr              ;set up buffer pointers and return
 586
 587 tutpnt: skipge tut+qpknum
 588          jrst [ hrroi dd,'OLD   ;TUT must be old-format
 589                 jrst fserr ]
 590         push p,db               ;convert block no in da into ildb ptr to tut entry
 591         camge da,tut+qlastb
 592         camge da,tut+qfrstb
 593          jrst 4,.               ;block number out of bounds
 594         sub da,tut+qfrstb
 595         idivi da,tutepw
 596         imul db,[-10000*tutbyt]
 597         hrli da,440000-tutbyt_14+tutbyt_6(db)
 598         addi da,tut+ltiblk
 599         pop p,db
 600         popj p,
 601 \f
 602 ;opens file for input
 603
 604 inpopn: pushj p,lookup          ;look that file up
 605         jumpl dd,fserr          ;file not found, tell him why
 606 fsin:   pushj p,advblk          ;set up pointers for next block
 607         jumpl dd,cpopj          ;jump if eof
 608
 609 ;actually reads the next sequential block in file
 610
 611 rfsblk: movei da,iobfr          ;read into the io buffer
 612         movem da,ioadr
 613         move da,cu              ;read from the current unit
 614         movem da,drive
 615         move da,lblock          ;this is the block to read
 616         pushj p,redblk          ;read it
 617 fsbfr:  movei da,blksiz         ;set up buffer pointers
 618         movem da,wrdcnt         ;count
 619         move da,[444400,,iobfr]
 620         movem da,wrdptr         ;byte pointer
 621         jumpge dd,cpopj         ;jump if block came in okay
 622
 623 ;here for file system error, print error message and give up
 624
 625 fserr:  skipl dd
 626          bughlt                 ;make sure we don't have total garbage
 627         skipl blkin             ;are there blocks swapped out?
 628          pushj p,swpin          ;yes, get them back into core
 629         hrlz w1,dd              ;get sixbit error message
 630         pushj p,sixo1           ;sixbit type out
 631         jrst err
 632
 633 ;advances pointers for next block in file, returns next block in da
 634
 635 advblk: sosl blkcnt             ;take next sequential block?
 636         jrst [  aos da,lblock   ;    yes, increment block number
 637                 popj p,]
 638         ildb da,dirpt           ;next descriptor byte
 639         jumpe da,[      hrroi dd,'EOF   ;end of file
 640                         popj p,]
 641         movem da,blkcnt         ;save block count just in case
 642         caig da,udtkmx
 643         jrst advblk             ;take next blkcnt
 644         caige da,udwph          ;jump?
 645         jrst advb0              ;    no, skip some blocks and take one
 646         cain da,udwph           ;place holder?
 647         bughlt                  ;    yes, should not happen on read
 648         subi da,udwph+1
 649         movei db,nxlbyt         ;# bytes for jump address
 650         movem db,lblock
 651 fsjmp:  ildb db,dirpt           ;next descriptor byte
 652         lsh da,ufdbyt           ;accumulate
 653         ior da,db
 654         sosle lblock            ;read enough bytes?
 655         jrst fsjmp
 656         movem da,lblock         ;jump to that block
 657         jrst advb01             ;and take next one
 658
 659 advb0:  subi da,udtkmx-1
 660         addb da,lblock          ;skip da blocks
 661 advb01: setzm blkcnt            ;and take next one
 662         popj p,
 663 \f
 664 ;write block into file
 665
 666 fsout:  move dc,lblock          ;save last block taken
 667 fsout1: aos da,lblock           ;and find next free block
 668         ;following lines commented out so that files will be written in swap area
 669         ;thus avoiding Y files when dumping crashes.  When sys comes up will get copied.
 670         ;camge da,tut+qswapa    ;that lies within file area
 671          ;move da,tut+qswapa
 672         caml da,tut+qlastb
 673          jrst [ hrroi dd,'DVF   ;got whole way through
 674                 popj p, ]
 675         movem da,lblock
 676         pushj p,tutpnt
 677         ldb db,da               ;get corresponding tut byte
 678         jumpn db,fsout1         ;not free, try next block
 679         movei db,1
 680         dpb db,da               ;claim it in tut
 681         move da,lblock          ;da := block # being written
 682         subm da,dc              ;dc := # blocks skipped + 1
 683         sojn dc,fsout2          ;fix dc and jump if not contiguous
 684         aos dc,blkcnt           ;add to contiguous group
 685         caig dc,udtkmx
 686          jrst fsout4
 687         movei db,udtkmx         ;doesn't fit start new group
 688         pushj p,ufdput
 689         jumpl dd,cpopj
 690         movei db,1
 691         movem db,blkcnt
 692         jrst fsout4
 693
 694 fsout2: caile dc,udskmx         ;maybe skip to it?
 695          jrst fsout3
 696         skipe db,blkcnt
 697          pushj p,ufdput
 698         jumpl dd,cpopj
 699         setzm blkcnt
 700         movei db,udtkmx(dc)
 701         pushj p,ufdput
 702         jumpl dd,cpopj
 703         jrst fsout4
 704
 705 fsout3: skipe db,blkcnt
 706          pushj p,ufdput
 707         jumpl dd,cpopj
 708         setzm blkcnt
 709         move db,lblock          ;generate jump command
 710         lshc db,-ufdbyt*nxlbyt
 711         addi db,udwph+1
 712         pushj p,ufdput
 713         jumpl dd,cpopj
 714 repeat nxlbyt,[
 715         lshc db,ufdbyt
 716         pushj p,ufdput
 717         jumpl dd,cpopj
 718 ]
 719
 720 fsout4: movei da,iobfr          ;block is in ufd & tut.  now write it
 721         movem da,ioadr
 722         move da,cu
 723         movem da,drive
 724         move da,lblock
 725         pushj p,wrtblk
 726         jrst outbuf
 727
 728 ;close the output file (writes ufds and tut)
 729
 730 outeof: movni da,blksiz         ;close file
 731         addm da,wrdcnt
 732         jsp t,acsav
 733         skipge wrdcnt           ;is buffer empty
 734          pushj p,fsout          ;    no, write it
 735         jumpl dd,outef1         ;don't update tut and ufd if problems
 736         skipe db,blkcnt         ;write any residual take-N code
 737          pushj p,ufdput
 738         jumpl dd,outef1
 739         aos ufd+udescp          ;count one extra for zero block at end
 740         pushj p,wrttut          ;write the tut for this drive
 741         pushj p,wrtufd          ;write ufd on all drives
 742 outef1: jsp t,acrest            ;do some ac restoring here
 743         jumpl dd,fserr
 744         hrroi dd,'EOF           ;this file is now closed
 745         popj p,
 746
 747 ;put byte into ufd descriptor area, checks for directory full
 748
 749 ufdput: idpb db,dirpt           ;put byte into ufd
 750         aos ufd+udescp
 751         push p,da
 752         movei db,0              ;throw in eof at end
 753         move da,dirpt
 754         idpb db,da
 755         movei da,-ufd(da)       ;word offset
 756         caml da,ufd+udnamp      ;did we flow into name area
 757          hrroi dd,'FUL          ;   yes, give error indication
 758         pop p,da
 759         popj p,
 760
 761 ;gets one word into io buffer, reads next block if necessary
 762
 763 wrdi0:  jsp t,acsav             ;save ddt ac's on stack
 764         pushj p,fsin
 765         jsp t,acrest            ;restore ac's
 766         jumpl dd,fserr          ;tried to read past eof
 767 wrdi:   sosge wrdcnt
 768          jrst wrdi0             ;buffer is empty read a new one
 769         ildb d,wrdptr
 770         popj p,
 771
 772 ;puts one word into io buffer, writes block if no more room
 773
 774 wrdo0:  movem d,dsktmp          ;d=t
 775         jsp t,acsav
 776         pushj p,fsout
 777         jsp t,acrest
 778         skipa d,dsktmp          ;restore d
 779 dmpo:   move d,(c)
 780 wrdo:   jumpl dd,fserr          ;check for errors
 781         sosge wrdcnt
 782         jrst wrdo0
 783         idpb d,wrdptr
 784         popj p,
 785
 786 ;ddt ac saving and restoring
 787
 788 acsav:  push p,a
 789         push p,b
 790         push p,c
 791         push p,w1
 792         push p,w2
 793         jrst (t)
 794
 795 acrest: pop p,w2
 796         pop p,w1
 797         pop p,c
 798         pop p,b
 799         pop p,a
 800         jrst (t)
 801
 802 ;file name saving and restoring
 803
 804 pushfn: push p,fn1
 805         push p,fn2
 806         push p,sname
 807         jrst (t)
 808
 809 popfn:  pop p,sname
 810         pop p,fn2
 811         pop p,fn1               ;restore file name
 812         jrst (t)
 813 \f
 814 ;load and dump routines
 815
 816 dump:   pushj p,reset
 817         tlne f,ccf
 818          jrst wboot
 819         pushj p,getfil          ;read a file name
 820         jsp t,pushfn            ;save old file names
 821         pushj p,swpout          ;make room for ufd, mfd, etc.
 822         pushj p,outopn          ;open file for output
 823         jsp t,popfn             ;and restore
 824         jumpl dd,fserr          ;jump if could not open file
 825
 826 ;ac usage
 827 ;       b       aobjn pointer for current block being dumped, rh is virtual address
 828 ;       c       real address of word to be dumped
 829
 830         move d,[jrst 1]         ;end of sblk loader
 831         pushj p,wrdo
 832         movei b,0               ;ac's are loaded and dumped!
 833 dump1:  pushj p,fd              ;convert virtual address to real address
 834          jrst dumpj             ;went past end, write symbols and close
 835         skipn (c)               ;look for non-zero
 836          aoja b,dump1
 837         hrrz a,@jobsym          ;addr of lowest symbol
 838         caml b,a
 839          jrst dumpj             ;all core done
 840         move a,b                ;save address of first non-zero
 841         hrli b,-maxdmp          ;keep size of dump block within reason
 842 dump2:  pushj p,fd              ;calculate real address
 843          jrst dump3             ;past end
 844         skipe (c)               ;look for zeros
 845          jrst dump2a
 846         aos b
 847         pushj p,fd              ;look ahead - block is ended by
 848          soja b,dump3           ; two consecutive zeros
 849         sos b
 850         skipe (c)
 851 dump2a:  aobjn b,dump2
 852 dump3:  hrrzm b,dmpnxt          ;save next address to check
 853         subm a,b                ;negative block length
 854         hrl a,b                 ;aobjn pointer to block
 855         jumpge a,dumpj          ;zero length block, must be all core done
 856         move b,a
 857         pushj p,dumpb
 858         move b,dmpnxt           ;start the next dump
 859         jrst dump1
 860
 861 dumpb:  pushj p,wrdoa           ;a checksum, b aobjn ptr.  write header
 862 dumpb1: pushj p,fd              ;calculate real address
 863          bughlt                 ;can't fetch what we fetched before
 864         pushj p,dmpo            ;write word
 865         rot a,1                 ;checksum
 866         add a,d
 867         aobjn b,dumpb1
 868 wrdoa:  move d,a
 869         jrst wrdo               ;write checksum
 870
 871 ;write starting address, symbols and close
 872
 873 dumpj:  move d,starta
 874         hrli d,(jumpa)
 875         pushj p,wrdo            ;there goes starting address
 876         move b,@jobsym
 877         add b,[nsyms,,]         ;don't punch builtin symbols
 878         jumpge b,dumpj1         ;don't punch zero-length block
 879         hllz a,b                ;symbol block header has address=0
 880         pushj p,dumpb           ;dump 'em all out
 881 dumpj1: move d,starta           ;starting address again
 882         hrli d,(jumpa)
 883         pushj p,wrdo
 884         pushj p,outeof          ;close the output file (writes ufds and tut)
 885 dskex:  pushj p,swpin           ;swap real core back in
 886         jrst dd1                ;crlf, close loc, ddt
 887 \f
 888 ;load code
 889
 890 load:   pushj p,reset
 891         tlne f,ccf
 892          jrst load1             ;\e\eL merge core images
 893         move a,kilc             ;\eL flush the old symbols
 894         movem a,@jobsym
 895         movem a,prgm
 896         setzm lowclr            ; and clear core
 897         move b,[lowclr,,lowclr+1]
 898         blt b,-1(a)
 899         setzm starta
 900 load1:  pushj p,getfil
 901         jsp t,pushfn            ;push file name
 902         pushj p,swpout          ;make space for dirs etc.
 903         pushj p,lookup          ;look him up
 904         jsp t,popfn             ;restore the file name
 905         jumpl dd,fserr          ;jump if file not found
 906         pushj p,wrdi            ;read first word
 907         hrroi dd,'PDM
 908         jumpe d,fserr           ;can't read pdumped files
 909         tdza dd,dd
 910 load2:   pushj p,wrdi           ;skip sblk loader
 911         came d,[jrst 1]
 912          jrst load2
 913 load3:  tlnn f,cf
 914          jrst dskex             ;after loading block of symbols
 915         pushj p,wrdi
 916         jumpge d,loads          ;jump for starting address
 917         move a,d                ;set up ac's to load block
 918         move b,d
 919 load4:  pushj p,wrdi            ;read word
 920         rot a,1                 ;checksum
 921         add a,d
 922         pushj p,fd              ;real address calculation
 923         skipa                   ;ignore words that we can't wriet
 924         movem d,(c)             ;store word
 925         aobjn b,load4
 926         pushj p,wrdi            ;read checksum
 927         camn a,d
 928         jrst load3
 929 ckserr: hrroi dd,'CKS           ;checksum error
 930         jrst fserr
 931
 932 ;found starting address, hopefully there are some symbols there too
 933
 934 loads:  skipn starta            ;only believe first start address seen
 935          movem d,starta         ;starting address
 936         tlon f,ccf              ;if \e\eL don't load symols
 937 loadii:  pushj p,wrdi           ;else get symbol table pointer
 938         jumpge d,dskex          ;no symbol table in file or not to be loaded
 939         trne d,-1               ;block type 0?
 940          jrst loadi             ;no, skip other brain-damaged info
 941         movs b,d
 942         hrli b,-1(b)            ;compensate for carry
 943         addb b,@jobsym          ;subtract new symbol table size from both halves
 944         movem b,prgm
 945         hll b,d                 ;make aobjn ptr to new block of symbols
 946         move a,d                ;init checksum
 947         tlz f,cf                ;make sure only to load one block
 948         jrst load4              ;go load 'em up (ccf now on so no read past eof)
 949
 950 loadi:  hlro b,d                ;minus number of words to skip (also checksum)
 951         pushj p,wrdi
 952         aojle b,.-1
 953         jrst loadii             ;try for next block of crud
 954
 955 ;takes virtual address in right half of b, returns real address in c
 956 ;swaps in block in necessary
 957
 958 fd:     aos (p)                 ;skip return is default
 959         movei c,(b)             ;get virtual address
 960         cail c,lowswp           ;lowest location swapped
 961         jrst fdhi               ;word might be swapped out
 962         caige c,lowfix          ;perhaps an ac or in channel command list
 963         addi c,ac0
 964         popj p,                 ;word alread in place
 965
 966 ;here if address might be swapped out
 967
 968 fdhi:   cail c,lowcod           ;address in ddt?
 969         jrst [  sos (p)         ;take non-skip return
 970                 popj p,]
 971         camle c,swporg          ;virtual origin of swapped block
 972         camle c,swpor1          ;highest virtual address swapped in
 973         jrst fdswp              ;block not swapped in
 974 fdhi1:  sub c,swporg
 975         addi c,corbfr           ;address of word in core
 976         popj p,
 977
 978 ;must swap out corbfr and swap the appropriate block
 979
 980 fdswp:  push p,d                ;d=t
 981         jsp t,acsav             ;save the ac's before we do this
 982         push p,c                ;the address inside block we want
 983         pushj p,swpbfo          ;swap the old buffer out
 984         pop p,c
 985         subi c,lowswp           ;lowest location swapped
 986         idivi c,blksiz          ;get block to swap in
 987         pushj p,swpbfi          ;swap that block in
 988         jsp t,acrest            ;get ac's back
 989         pop p,d
 990         jrst fdhi1              ;set up real address in c
 991 \f
 992 ; List Directory
 993
 994 listf:  pushj p,reset
 995         tlzn f,qf
 996          jrst listf1
 997         move t,[440600,,sname]
 998         movem t,dsktmp
 999         move t,[jrst listf2]
1000         movem t,spts(i)
1001         move t,sym
1002         pushj p,spt1-1
1003 listf1: push p,swpout
1004         setzm fn1
1005         pushj p,lookup          ;get ufd
1006         jumpl dd,fserr
1007         move b,ufd+udnamp
1008         move w1,sname
1009 listf3: pushj p,sixo1
1010         pushj p,crf
1011         pushj p,listen
1012          cail b,2000
1013           jrst dskex            ;end of dir or char typed
1014         ldb t,[unpkn ufd+unrndm(b)]
1015         pushj p,toc
1016         pushj p,tspc
1017         move w1,ufd+unfn1(b)
1018         pushj p,sixo1
1019         pushj p,tspc
1020         move w1,ufd+unfn2(b)
1021         addi b,lunblk
1022         jrst listf3
1023
1024 listf2: subi t,40
1025         idpb t,dsktmp
1026         popj p,
1027
1028 ;n\e\eY write DDT on boot area unit n
1029
1030 wboot:  move t,syl              ;get n
1031         movem t,drive
1032         movei da,bootbl
1033         pushj p,rp4map          ;set up disk addr
1034         move t,kilc             ;flush all but builtin symbols
1035         movem t,prgm
1036         movem t,@jobsym
1037 ka,     move t,[-10000,,ddt-4001]       ;write out last 4 pages of low moby
1038 kl,     move t,[-10000_4,,ddt-4001]     ;..
1039         movem t,icwa
1040         setzm icwa+1
1041         move db,[wdatao]
1042         pushj p,rwblk0
1043         jrst dd1
1044 \f
1045 ;PUSHJ P,GETFIL reads a file name, sets SNAME, FN1, FN2
1046 ;clobbers a,b,db,t
1047
1048 getfil: pushj p,tspc
1049         skipa b,[sixbit/@/]     ;default fn1
1050 getfl3:  movem a,sname
1051 getfl1: movei a,0
1052         move db,[440600,,a]
1053 getfl2: pushj p,iin
1054         subi t,40
1055         jumple t,getfl4         ;break
1056         cain t,';
1057          jrst getfl3            ;sname
1058         tlne db,770000
1059          idpb t,db
1060         jrst getfl2
1061
1062 getfl4: jumpe a,getfl5          ;leading space
1063         exch a,b
1064         jumpe t,getfl1          ;space, get another name
1065         movem a,fn1             ;cr, done
1066         movem b,fn2
1067         jrst crf                ;echo crlf and return
1068
1069 getfl5: jumpe t,getfl1
1070         jrst err                ;blank name
1071 \f
1072 ;disk address for next transfer
1073
1074 drive:  0
1075 cylndr: 0
1076 sector: 0
1077 surfce: 0
1078 ioadr:  0       ;core address for next disk transfer
1079 dsktmp: 0       ;used for temporary storage here and there
1080 xfrcnt: 0       ;# times we have tried this disk transfer
1081 cu:     0       ;current unit
1082 mu:     0       ;master unit
1083 ufdblk: 0       ;disk block of ufd
1084 qact:   repeat 8, -1+ifge .rpcnt-ndsk,1 ;-1 if should use, 0 if unit not active
1085
1086 ;file manipulation variables (leave sname, fn1, and fn2 contigous and in this order
1087 ;otherwise code at ulink will cease to function)
1088
1089 sname:  sixbit/./       ;directory name
1090 fn1:    0       ;first file name
1091 fn2:    0       ;second file name
1092
1093 ;dev:   0       ;for holding random device
1094 wrdcnt: 0       ;disk io buffer word count
1095 wrdptr: 0       ;disk buffer byte pointer
1096 lblock: 0       ;last block read or written
1097 blkcnt: 0       ;number of blocks read or written consectively
1098 dirpt:  0       ;descriptor area byte pointer
1099 tutpt:  0       ;tut byte pointer
1100 lnkcnt: 0       ;link counter used by link solver non-zero means at least one link
1101 lnkptr: 0       ;user directory index of first link in chain
1102 lnkufd: 0       ;block # of ufd of of first link in chain
1103 pknum:  repeat ndsk,-1
1104 qded:   repeat ndsk,0
1105
1106 dmpnxt: 0       ;virtual address of next block to dump
1107
1108 ;swapping variables
1109
1110 blkin:  -1      ;index of block in, negative implies no core swapped out
1111 swporg: 0       ;virtual address of first location in corbfr
1112 swpor1: 0       ;virtual address of last  location in corbfr
1113
1114 litter: constants
1115 vars::  variables
1116
1117 inform dsksiz,\<.-dskcod>