;;; Copyright (c) 1999 Massachusetts Institute of Technology ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as ;;; published by the Free Software Foundation; either version 3 of the ;;; License, or (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;AC's used by disk routines da=11 ;used mostly for argument passing db=12 dc=13 dd=14 ;dd>=0 if file open else reason why file is closed nudsl==500. ;# user directory slots in M.F.D. ;file system parameters and RH10/RP04 parameters ifn dsksw-3, .err Only RH10 disk is supported .insrt system;rh10 .insrt system;fsdefs icwa==20 ;initial channel control word lowfix==icwa+2 ;lowest fixed loacation blksiz==2000 ;# words in disk block maxtry==10 ;# times to try disk transfer before hard failure assumed maxlnk==20 ;maximum # of links ;ntutbl== ;# pages necessary to store a TUT swpags==ntutbl+4 ;# pages swapped to disk (mfd, ufd, io bfr, core bfr and tut) swpblk==tblks-swpags ;first disk block used for core swapping bootbl==swpblk-4 ;four disk blocks to save ddt for fast booting mfd=lowcod-blksiz ;mfd origin ufd=mfd-blksiz ;ufd origin corbfr=ufd-blksiz ;core buffer origin iobfr=corbfr-blksiz ;io buffer origin tut=iobfr- ;tut goes last lowswp==lowcod- ;lowest location swapped ifn tut-lowswp, .err lowswp loses maxdmp==200 ;largest dump block allowed lowclr==40 ;lowest location zeroed when ddt loads ;template for datao's that cause disk transfers rdatao==%hrctl\%hrlod,,%hmred\> wdatao==%hrctl\%hrlod,,%hmwrt\> kl, swpua=701540,,0 ;bug halt for bugs ;error halt for error conditions beyond capabilities of program define errhlt jrst 4,. termin define bughlt jrst 4,. termin dskcod==. ;lowest level io ;calculates Physical Disk Address and sets up Channel Command List pdaccl: pushj p,rp4map ;caluculate physical disk address skiple w1,ioadr ;first word to be transferred caige w1,17 ;don't try transfer from or to shadow AC's bughlt subi w1,1 ;iowd format ka, hrli w1,-blksiz ;# words in block .else hrli w1,-blksiz_4 pdacc2: movem w1,icwa ;transfer data (iowd) setzm icwa+1 ;DF10 writes here for termination popj p, ;calculates RP04 cylinder, surface, and sector given block # rp4map: skipl w1,da ;the block # cail w1,tblks ;check for reasonable block # bughlt idivi w1,nblksc ;blocks/cylinder movem w1,cylndr imuli w2,secblk ;sectors/block move w1,w2 ;sector # on this cylinder idivi w1,nsecs ;sectors/surface movem w1,surfce movem w2,sector popj p, ;transfers disk block redblk: skipa db,[rdatao] ;the beginnings of a datao (go bit is on) wrtblk: move db,[wdatao] rwblk: pushj p,pdaccl ;calculate physical disk address, set up CCL rwblk0: move w1,drive ;fill in the desired drive skipn qact(w1) ;make sure is good drive jrst rwblkl dpb w1,[$hcdrv db] setzm xfrcnt ;count times through loop rwblk1: pushj p,xfer ;transfer the data aosa w1,xfrcnt popj p, ;transfer succeeded, don't try again caig w1,maxtry jrst rwblk1 rwblkl: move w1,drive hrroi dd,'UN0(w1) jrst fserr xfer: consz dsk,%hibsy ;wait for controller to finish jrst .-1 datao dsk,[%hrrae\%hrlod,,377];flush any rae's that may be there cono dsk,%hoclr\%horae ;flush any left overs and plunge on kl,[ consz pag,600000 swpua ;sweep the cache consz 200000 ;apr, jrst .-1 ] movsi w1,%hrsts ;get the drive status jsp t,rhget ;will popj on error trnn w1,%hserr ;any drive errors jrst xfer2 ;drive is okay plunge on ;detected drive error before data xfer, try to reset drive if possible trc w1,%hsvv\%hsmol\%hsrdy ;check for all ready bits on trce w1,%hsvv\%hsmol\%hsrdy popj p, ;not ready, transfer fails xfer2: movsi w1,%hrcyl ;set cylinder hrr w1,cylndr jsp t,rhset move w1,surfce ;set sector and track lsh w1,10 ior w1,sector hrli w1,%hradr jsp t,rhset datao dsk,db ;zap conso dsk,%hidone ;wait for transfer to finish jrst .-1 conso dsk,%hierr ;errors? aos (p) ; no popj p, ; yes ;rhset and rhget are used to read and write device registers on Massbus ;They are called with jsp t, but popj if they fail. Beware!!! rhset: tloa w1,%hrlod ;load register rhget: tlz w1,%hrlod ;just read register tso w1,drive ;put in drive # datao dsk,w1 movei w1,6 ;delat for massbus sojg w1,. datai dsk,w1 tlne w1,%hderr ;covers the multitude of sins popj p, ;failed jrst (t) ;success ;routines to read and write special disk blocks swpin: skipl blkin ;skip if no core buffer pushj p,swpbfo ;swap the buffer out first pushj p,swpi1 ;do all disk transfers necessary move c,[twenty,,20] ;restore old stuff at icwa blt c,lowfix-1 setob c,blkin ;also used as no blocks in flag popj p, swpout: movs c,[twenty,,20] ;try and save a literal blt c,ac0+lowfix-1 ;save stuff used by icwa skipa c,[wrtblk] swpi1: movei c,redblk movei b,lowcod ;starting at this core address move a,mu movem a,drive ;always use master unit for swapping movei a,swpags-1 ;block counter swpio: movei b,-blksiz(b) movem b,ioadr movei da,swpblk(a) pushj p,(c) ;call either redblk or wrtblk sojge a,swpio movei c,/blksiz swpbfp: movem c,blkin ;block that is swapped in skipge da,c bughlt ;no blocks are swapped out imuli da,blksiz addi da,lowswp ;virtual address of first word in corbfr movem da,swporg addi da,blksiz-1 ;virtual address of last word in corbfr movem da,swpor1 popj p, ;here to swap core block in and set up pointers swpbfi: pushj p,swpbfp ;set buffer pointers skipa b,[redblk] ;swaps out the block in corbfr swpbfo: movei b,wrtblk skipge c,blkin ;index of block we want bughlt movei da,corbfr ;core address for transfer movem da,ioadr move da,mu ;swapped from and onto master unit movem da,drive movei da,swpblk(c) ;block # to read jrst (b) ;transfer the block nxttut: aos c,cu ;try next tut cail c,ndsk setzb c,cu skipn qact(c) jrst nxttut redtut: skipa c,[redblk] wrttut: movei c,wrtblk movei b,tut+ move a,cu ;tut goes on current unit movem a,drive movei a,ntutbl-1 tutio: movei b,-blksiz(b) movem b,ioadr movei da,tutblk(a) pushj p,(c) sojge a,tutio popj p, redmfd: movei da,mfdblk movei b,mfd mfdufd: movem b,ioadr move b,mu ;read from master unit movem b,drive jrst redblk redufd: move da,ufdblk ;where ufd is movei b,ufd jrst mfdufd wrtufd: move da,ufdblk ;ufd is written on all units movei b,ufd movem b,ioadr move a,cu ;start with current unit movem a,drive wrtuf1: skipe qact(a) pushj p,wrtblk aos a,drive cail a,ndsk setzb a,drive came a,cu jrst wrtuf1 popj p, ; Reset the disks reset: coni pag,b ;turn off paging trz b,060000 cono pag,(b) movei b,ndsk-1 reset0: movem b,drive skipe qact(b) ;skip unit if turned off pushj p,reset1 sojge b,reset0 move b,mu ;is master unit active? skipe qact(b) popj p, movei b,ndsk-1 ;no, pick an active unit for mu skipn qact(b) sojge b,.-1 jumpl b,resetl ;"UN/" mumble movem b,mu popj p, reset1: pushj p,reset3 ;poptj if win resetl: hrroi dd,'UN0(b) ;popj if lose jrst fserr reset3: cono dsk,%hoclr\%horae datao dsk,[%hrrae\%hrlod,,377] movei w1,%hmclr jsp t,rhset movei w1,%hmrdp jsp t,rhset movsi w1,%hrofs jsp t,rhset movei w1,%hmack jsp t,rhset movsi w1,%hrsts jsp t,rhget trne w1,%hserr popj p, trc w1,%hsvv+%hsmol+%hsrdy trcn w1,%hsvv+%hsmol+%hsrdy jrst poptj ;win popj p, ;file system routines ;lookup -- call with file names and sname in fn1, fn2, and sname ;fails if dd<0 otherwise returns user directory index in dd ;dirpt is set up as byte pointer into descriptor area ;if lookup found a link then lnkcnt will be non-zero and lnkufd and lnkptr ;will contain block # of ufd and name area index respectively of ;first link in chain fn1, fn2, and sname are clobbered file at end of chain lookup: setzm lnkcnt ;link counter pushj p,redmfd ;read the mfd move t,mfd+mdchk came t,[sixbit /M.F.D./] errhlt ;how can this be the mfd? move t,mfd+mdnuds caie t,nudsl ;make sure there are enough directory slots errhlt ;this still doesn't look like an mfd linklk: skipn t,sname ;entry point for link solver jrst look1b move db,mfd+mdnamp ;pointer to mfd name area look1a: camn t,mfd+mnunam(db) jrst look2 ;found directory in mfd addi db,lmnblk ;next slot in mfd caige db,blksiz jrst look1a look1b: hrroi dd,'NXD ;directory slot not found popj p, ;found the ufd slot, pointer in db look2: lsh db,-1 movei da,(db);magic movem da,ufdblk ;save address of ufd move t,sname camn t,ufd+udname jrst look3 ;don't read ufd unless we have to pushj p,redufd ;read ufd from master disk move t,sname ;check for right one came t,ufd+udname errhlt ;this is not it look3: move dd,ufd+udnamp ;pointer to name area skipn da,fn1 ;search user directory popj p, ;just getting dir, return now move db,fn2 movsi dc,unigfl ;deleted or open for writing ulook: camn da,ufd+unfn1(dd) ;file name match? came db,ufd+unfn2(dd) jrst ulook1 tdnn dc,ufd+unrndm(dd) ;file names match jrst ulook2 ;found file ulook1: addi dd,lunblk ;advance to next file caige dd,blksiz jrst ulook hrroi dd,'FNF ;file not found popj p, ;found file, set up pointer into descriptor area, and get tut in core ulook2: pushj p,ufdbp ;make ufd descriptor byte pointer movem da,dirpt movsi da,unlink tdne da,ufd+unrndm(dd) ;is this a link? jrst ulink ; yes, call link solver ldb dc,[unpkn ufd+unrndm(dd)] setzm cu ulook3: pushj p,nxttut camn dc,tut+qpknum jrst ulook4 skipe cu jrst ulook3 hrroi dd,'NSP ;no such pack popj p, ulook4: setzm lblock ;last block accessed setzm blkcnt ;forces next descriptor byte setzm wrdcnt ;forces buffer reload popj p, ;returns byte pointer into descriptor area in da, clobbers db ufdbp: ldb da,[undscp ufd+unrndm(dd)] idivi da,ufdbyt ;convert ufd character address into byte pointer imuli db,-10000*ufdbyt hrli da,440000+(db) addi da,ufd+uddesc ;origin of ufd descriptor area popj p, ;link solver ulink: skipe lnkcnt ;first link jrst ulink1 ; no movem dd,lnkptr ;save pointer to first one move t,ufdblk movem t,lnkufd ulink1: aos t,lnkcnt caile t,maxlnk ;too many links jrst [ hrroi dd,'TML popj p,] pushj p,redlnk ;read the link name jrst linklk redlnk: setzm sname setzm fn1 setzm fn2 move dc,[440600,,sname] ;read file name from descriptor area linkl: ildb t,dirpt cain t,'; ;directory name? jrst links cain t,': jrst [ ildb t,dirpt ;: quotes next character idpb t,dc jrst link1] ;allows blanks in file names idpb t,dc jumpe t,cpopj ;jump if finished reading link link1: came dc,[000600,,fn2] ;finished? jrst linkl popj p, ;end of link ;found ";" in file name links: tlnn dc,770000 ;align byte pointer on word boundary jrst link1 ibp dc jrst links fsdele: pushj p,lookup ;find the file jumpl dd,cpopj ;jump if we're losing pushj p,zapdsc ;zap descriptor area setzm ufd+unfn1(dd) setzm ufd+unfn2(dd) setzm ufd+unrndm(dd) skipn lnkcnt ;don't write if link pushj p,wrttut ;write the tut jrst wrtufd ;write the ufd out on all units ;zap file descriptor zapdsc: setzm blkcnt ;make plenty damn sure skipn lnkcnt ;if there were no links jrst zaprf ; then zap real file ;zap link descriptor move da,lnkufd ;fetch the original ufd pushj p,redufd move dd,lnkptr ;pointer to file movsi da,unlink ;test for link tdnn da,ufd+unrndm(dd) bughlt ;hmmm, it said it was a link pushj p,ufdbp ;get byte pointer to descriptor area push p,da ;save beginning byte pointer movem da,dirpt ;grist for redlnk pushj p,redlnk skipa zaplop: pop p,dd ;entry point from zaprf pop p,da ;beginning of descriptor area setzb db,blkcnt ;clear blkcnt set by advblk zapl1: idpb db,da ;zero out descriptor came da,dirpt ;caught the end yet? jrst zapl1 popj p, ;zap real file descriptor zaprf: jumpl dd,cpopj ;if file not found then give error return movsi da,unlink ;test for link tdne da,ufd+unrndm(dd) bughlt ;it should not be a link ;update tut before zapping descriptor area push p,dirpt ;save pointer to beginning push p,dd ;save pointer to name area in ufd zaprf1: pushj p,advblk ;gets next block in da jumpl dd,zaplop ;now zap descriptor area pushj p,tutpnt ;returns tut byte pointer in da ldb db,da ;tut entry caige db,tutlk-1 ;block locked for some reason sojl db,[bughlt] dpb db,da ;clobber tut jrst zaprf1 ;opens file for output outopn: pushj p,lookup ;does version of file already exist? skipn lnkcnt jumpl dd,outo1 ;not necessary to zap descriptor area skipn lnkcnt ;if its a link, we must make sure ufd and tut are in jrst outo01 ; not a link all the good stuff is together jrst pikpak ;not necessary to find a free directory slot ;find free slot in ufd name area outo1: came dd,[-1,,'FNF] ;proceed only if file not in ufd popj p, move dd,ufd+udnamp ;start looking at beginning outo11: skipn ufd+unfn1(dd) ;slot free? jrst pikpak ; yes, pick-a-pack addi dd,lunblk caige dd,blksiz ;past end of ufd? jrst outo11 ; no,try again ;no free slots, try to extend name area down movni dd,lunblk addb dd,ufd+udnamp move da,ufd+udescp idivi da,ufdbyt addi da,uddesc+3 caml da,ufd+udnamp ;did we run into descriptor area? jrst [ hrroi dd,'FUL ;directory full popj p,] setzm ufd+unfn1(dd) ;clear out that file name ;directory slot all set up, now decide which unit to write on (pick-a-pack) pikpak: move t,mu movem t,cu pushj p,redtut ;start searching on current unit push p,cu ;unit we started on push p,[0] ;# free blocks on best unit push p,(p) ;# free blocks on this unit push p,cu ;best unit so far piknxt: setzm -1(p) ;# free blocks on this unit move dc,tut+qfrstb ;following lines commented out so that files will be written in swap area ;thus avoiding Y files when dumping crashes. When sys comes up will get copied. ;camge dc,tut+qswapa ;first track beyond swapping area ;move dc,tut+qswapa move da,dc sub da,tut+qlastb hrl dc,da ;aobjn pointer piknx1: movei da,(dc) ;block # pushj p,tutpnt ;byte pointer to tut entry ldb da,da skipn da aos -1(p) ;found a free block aobjn dc,piknx1 ;counted all free blocks on pack yet? move da,-1(p) ;# free blocks on this pack camg da,-2(p) ;more blocks on this one jrst piknx2 ; no, advance to next tut movem da,-2(p) move db,cu movem db,(p) ;this is best so far piknx2: pushj p,nxttut ;try next tut move db,cu came db,-3(p) ;have we gone around the packs jrst piknxt ; no, go to next unit pop p,cu ;this unit won sub p,[3,,3] ;clean up stack pushj p,redtut ;read in tut from current unit skipn lnkcnt ;if a link, then get ufd in jrst outo0 ;was not a link, ufd is already there move da,lnkufd movem da,ufdblk pushj p,redufd outo0: skipe ufd+unfn1(dd) ;fresh file? jrst outo01 ;no, zap descriptor area move da,fn1 ;put in the file name movem da,ufd+unfn1(dd) move da,fn2 movem da,ufd+unfn2(dd) skipa outo01: pushj p,zapdsc ;zap descriptor area setzm blkcnt ;no contig blks taken yet setzm lblock ;and start searching from beginning setzm ufd+unrndm(dd) ;flush all random bits move da,tut+qpknum ;pack # dpb da,[unpkn ufd+unrndm(dd)] setom ufd+undate(dd) ;clear date file created move da,ufd+udescp ;first free byte in descriptor area dpb da,[undscp ufd+unrndm(dd)] pushj p,ufdbp ;turn him into a byte pointer movem da,dirpt ;descriptor area byte pointer outbuf: setzm iobfr ;clear io buffer move da,[iobfr,,iobfr+1] blt da,iobfr+blksiz-1 jrst fsbfr ;set up buffer pointers and return tutpnt: skipge tut+qpknum jrst [ hrroi dd,'OLD ;TUT must be old-format jrst fserr ] push p,db ;convert block no in da into ildb ptr to tut entry camge da,tut+qlastb camge da,tut+qfrstb jrst 4,. ;block number out of bounds sub da,tut+qfrstb idivi da,tutepw imul db,[-10000*tutbyt] hrli da,440000-tutbyt_14+tutbyt_6(db) addi da,tut+ltiblk pop p,db popj p, ;opens file for input inpopn: pushj p,lookup ;look that file up jumpl dd,fserr ;file not found, tell him why fsin: pushj p,advblk ;set up pointers for next block jumpl dd,cpopj ;jump if eof ;actually reads the next sequential block in file rfsblk: movei da,iobfr ;read into the io buffer movem da,ioadr move da,cu ;read from the current unit movem da,drive move da,lblock ;this is the block to read pushj p,redblk ;read it fsbfr: movei da,blksiz ;set up buffer pointers movem da,wrdcnt ;count move da,[444400,,iobfr] movem da,wrdptr ;byte pointer jumpge dd,cpopj ;jump if block came in okay ;here for file system error, print error message and give up fserr: skipl dd bughlt ;make sure we don't have total garbage skipl blkin ;are there blocks swapped out? pushj p,swpin ;yes, get them back into core hrlz w1,dd ;get sixbit error message pushj p,sixo1 ;sixbit type out jrst err ;advances pointers for next block in file, returns next block in da advblk: sosl blkcnt ;take next sequential block? jrst [ aos da,lblock ; yes, increment block number popj p,] ildb da,dirpt ;next descriptor byte jumpe da,[ hrroi dd,'EOF ;end of file popj p,] movem da,blkcnt ;save block count just in case caig da,udtkmx jrst advblk ;take next blkcnt caige da,udwph ;jump? jrst advb0 ; no, skip some blocks and take one cain da,udwph ;place holder? bughlt ; yes, should not happen on read subi da,udwph+1 movei db,nxlbyt ;# bytes for jump address movem db,lblock fsjmp: ildb db,dirpt ;next descriptor byte lsh da,ufdbyt ;accumulate ior da,db sosle lblock ;read enough bytes? jrst fsjmp movem da,lblock ;jump to that block jrst advb01 ;and take next one advb0: subi da,udtkmx-1 addb da,lblock ;skip da blocks advb01: setzm blkcnt ;and take next one popj p, ;write block into file fsout: move dc,lblock ;save last block taken fsout1: aos da,lblock ;and find next free block ;following lines commented out so that files will be written in swap area ;thus avoiding Y files when dumping crashes. When sys comes up will get copied. ;camge da,tut+qswapa ;that lies within file area ;move da,tut+qswapa caml da,tut+qlastb jrst [ hrroi dd,'DVF ;got whole way through popj p, ] movem da,lblock pushj p,tutpnt ldb db,da ;get corresponding tut byte jumpn db,fsout1 ;not free, try next block movei db,1 dpb db,da ;claim it in tut move da,lblock ;da := block # being written subm da,dc ;dc := # blocks skipped + 1 sojn dc,fsout2 ;fix dc and jump if not contiguous aos dc,blkcnt ;add to contiguous group caig dc,udtkmx jrst fsout4 movei db,udtkmx ;doesn't fit start new group pushj p,ufdput jumpl dd,cpopj movei db,1 movem db,blkcnt jrst fsout4 fsout2: caile dc,udskmx ;maybe skip to it? jrst fsout3 skipe db,blkcnt pushj p,ufdput jumpl dd,cpopj setzm blkcnt movei db,udtkmx(dc) pushj p,ufdput jumpl dd,cpopj jrst fsout4 fsout3: skipe db,blkcnt pushj p,ufdput jumpl dd,cpopj setzm blkcnt move db,lblock ;generate jump command lshc db,-ufdbyt*nxlbyt addi db,udwph+1 pushj p,ufdput jumpl dd,cpopj repeat nxlbyt,[ lshc db,ufdbyt pushj p,ufdput jumpl dd,cpopj ] fsout4: movei da,iobfr ;block is in ufd & tut. now write it movem da,ioadr move da,cu movem da,drive move da,lblock pushj p,wrtblk jrst outbuf ;close the output file (writes ufds and tut) outeof: movni da,blksiz ;close file addm da,wrdcnt jsp t,acsav skipge wrdcnt ;is buffer empty pushj p,fsout ; no, write it jumpl dd,outef1 ;don't update tut and ufd if problems skipe db,blkcnt ;write any residual take-N code pushj p,ufdput jumpl dd,outef1 aos ufd+udescp ;count one extra for zero block at end pushj p,wrttut ;write the tut for this drive pushj p,wrtufd ;write ufd on all drives outef1: jsp t,acrest ;do some ac restoring here jumpl dd,fserr hrroi dd,'EOF ;this file is now closed popj p, ;put byte into ufd descriptor area, checks for directory full ufdput: idpb db,dirpt ;put byte into ufd aos ufd+udescp push p,da movei db,0 ;throw in eof at end move da,dirpt idpb db,da movei da,-ufd(da) ;word offset caml da,ufd+udnamp ;did we flow into name area hrroi dd,'FUL ; yes, give error indication pop p,da popj p, ;gets one word into io buffer, reads next block if necessary wrdi0: jsp t,acsav ;save ddt ac's on stack pushj p,fsin jsp t,acrest ;restore ac's jumpl dd,fserr ;tried to read past eof wrdi: sosge wrdcnt jrst wrdi0 ;buffer is empty read a new one ildb d,wrdptr popj p, ;puts one word into io buffer, writes block if no more room wrdo0: movem d,dsktmp ;d=t jsp t,acsav pushj p,fsout jsp t,acrest skipa d,dsktmp ;restore d dmpo: move d,(c) wrdo: jumpl dd,fserr ;check for errors sosge wrdcnt jrst wrdo0 idpb d,wrdptr popj p, ;ddt ac saving and restoring acsav: push p,a push p,b push p,c push p,w1 push p,w2 jrst (t) acrest: pop p,w2 pop p,w1 pop p,c pop p,b pop p,a jrst (t) ;file name saving and restoring pushfn: push p,fn1 push p,fn2 push p,sname jrst (t) popfn: pop p,sname pop p,fn2 pop p,fn1 ;restore file name jrst (t) ;load and dump routines dump: pushj p,reset tlne f,ccf jrst wboot pushj p,getfil ;read a file name jsp t,pushfn ;save old file names pushj p,swpout ;make room for ufd, mfd, etc. pushj p,outopn ;open file for output jsp t,popfn ;and restore jumpl dd,fserr ;jump if could not open file ;ac usage ; b aobjn pointer for current block being dumped, rh is virtual address ; c real address of word to be dumped move d,[jrst 1] ;end of sblk loader pushj p,wrdo movei b,0 ;ac's are loaded and dumped! dump1: pushj p,fd ;convert virtual address to real address jrst dumpj ;went past end, write symbols and close skipn (c) ;look for non-zero aoja b,dump1 hrrz a,@jobsym ;addr of lowest symbol caml b,a jrst dumpj ;all core done move a,b ;save address of first non-zero hrli b,-maxdmp ;keep size of dump block within reason dump2: pushj p,fd ;calculate real address jrst dump3 ;past end skipe (c) ;look for zeros jrst dump2a aos b pushj p,fd ;look ahead - block is ended by soja b,dump3 ; two consecutive zeros sos b skipe (c) dump2a: aobjn b,dump2 dump3: hrrzm b,dmpnxt ;save next address to check subm a,b ;negative block length hrl a,b ;aobjn pointer to block jumpge a,dumpj ;zero length block, must be all core done move b,a pushj p,dumpb move b,dmpnxt ;start the next dump jrst dump1 dumpb: pushj p,wrdoa ;a checksum, b aobjn ptr. write header dumpb1: pushj p,fd ;calculate real address bughlt ;can't fetch what we fetched before pushj p,dmpo ;write word rot a,1 ;checksum add a,d aobjn b,dumpb1 wrdoa: move d,a jrst wrdo ;write checksum ;write starting address, symbols and close dumpj: move d,starta hrli d,(jumpa) pushj p,wrdo ;there goes starting address move b,@jobsym add b,[nsyms,,] ;don't punch builtin symbols jumpge b,dumpj1 ;don't punch zero-length block hllz a,b ;symbol block header has address=0 pushj p,dumpb ;dump 'em all out dumpj1: move d,starta ;starting address again hrli d,(jumpa) pushj p,wrdo pushj p,outeof ;close the output file (writes ufds and tut) dskex: pushj p,swpin ;swap real core back in jrst dd1 ;crlf, close loc, ddt ;load code load: pushj p,reset tlne f,ccf jrst load1 ;L merge core images move a,kilc ;L flush the old symbols movem a,@jobsym movem a,prgm setzm lowclr ; and clear core move b,[lowclr,,lowclr+1] blt b,-1(a) setzm starta load1: pushj p,getfil jsp t,pushfn ;push file name pushj p,swpout ;make space for dirs etc. pushj p,lookup ;look him up jsp t,popfn ;restore the file name jumpl dd,fserr ;jump if file not found pushj p,wrdi ;read first word hrroi dd,'PDM jumpe d,fserr ;can't read pdumped files tdza dd,dd load2: pushj p,wrdi ;skip sblk loader came d,[jrst 1] jrst load2 load3: tlnn f,cf jrst dskex ;after loading block of symbols pushj p,wrdi jumpge d,loads ;jump for starting address move a,d ;set up ac's to load block move b,d load4: pushj p,wrdi ;read word rot a,1 ;checksum add a,d pushj p,fd ;real address calculation skipa ;ignore words that we can't wriet movem d,(c) ;store word aobjn b,load4 pushj p,wrdi ;read checksum camn a,d jrst load3 ckserr: hrroi dd,'CKS ;checksum error jrst fserr ;found starting address, hopefully there are some symbols there too loads: skipn starta ;only believe first start address seen movem d,starta ;starting address tlon f,ccf ;if L don't load symols loadii: pushj p,wrdi ;else get symbol table pointer jumpge d,dskex ;no symbol table in file or not to be loaded trne d,-1 ;block type 0? jrst loadi ;no, skip other brain-damaged info movs b,d hrli b,-1(b) ;compensate for carry addb b,@jobsym ;subtract new symbol table size from both halves movem b,prgm hll b,d ;make aobjn ptr to new block of symbols move a,d ;init checksum tlz f,cf ;make sure only to load one block jrst load4 ;go load 'em up (ccf now on so no read past eof) loadi: hlro b,d ;minus number of words to skip (also checksum) pushj p,wrdi aojle b,.-1 jrst loadii ;try for next block of crud ;takes virtual address in right half of b, returns real address in c ;swaps in block in necessary fd: aos (p) ;skip return is default movei c,(b) ;get virtual address cail c,lowswp ;lowest location swapped jrst fdhi ;word might be swapped out caige c,lowfix ;perhaps an ac or in channel command list addi c,ac0 popj p, ;word alread in place ;here if address might be swapped out fdhi: cail c,lowcod ;address in ddt? jrst [ sos (p) ;take non-skip return popj p,] camle c,swporg ;virtual origin of swapped block camle c,swpor1 ;highest virtual address swapped in jrst fdswp ;block not swapped in fdhi1: sub c,swporg addi c,corbfr ;address of word in core popj p, ;must swap out corbfr and swap the appropriate block fdswp: push p,d ;d=t jsp t,acsav ;save the ac's before we do this push p,c ;the address inside block we want pushj p,swpbfo ;swap the old buffer out pop p,c subi c,lowswp ;lowest location swapped idivi c,blksiz ;get block to swap in pushj p,swpbfi ;swap that block in jsp t,acrest ;get ac's back pop p,d jrst fdhi1 ;set up real address in c ; List Directory listf: pushj p,reset tlzn f,qf jrst listf1 move t,[440600,,sname] movem t,dsktmp move t,[jrst listf2] movem t,spts(i) move t,sym pushj p,spt1-1 listf1: push p,swpout setzm fn1 pushj p,lookup ;get ufd jumpl dd,fserr move b,ufd+udnamp move w1,sname listf3: pushj p,sixo1 pushj p,crf pushj p,listen cail b,2000 jrst dskex ;end of dir or char typed ldb t,[unpkn ufd+unrndm(b)] pushj p,toc pushj p,tspc move w1,ufd+unfn1(b) pushj p,sixo1 pushj p,tspc move w1,ufd+unfn2(b) addi b,lunblk jrst listf3 listf2: subi t,40 idpb t,dsktmp popj p, ;nY write DDT on boot area unit n wboot: move t,syl ;get n movem t,drive movei da,bootbl pushj p,rp4map ;set up disk addr move t,kilc ;flush all but builtin symbols movem t,prgm movem t,@jobsym ka, move t,[-10000,,ddt-4001] ;write out last 4 pages of low moby kl, move t,[-10000_4,,ddt-4001] ;.. movem t,icwa setzm icwa+1 move db,[wdatao] pushj p,rwblk0 jrst dd1 ;PUSHJ P,GETFIL reads a file name, sets SNAME, FN1, FN2 ;clobbers a,b,db,t getfil: pushj p,tspc skipa b,[sixbit/@/] ;default fn1 getfl3: movem a,sname getfl1: movei a,0 move db,[440600,,a] getfl2: pushj p,iin subi t,40 jumple t,getfl4 ;break cain t,'; jrst getfl3 ;sname tlne db,770000 idpb t,db jrst getfl2 getfl4: jumpe a,getfl5 ;leading space exch a,b jumpe t,getfl1 ;space, get another name movem a,fn1 ;cr, done movem b,fn2 jrst crf ;echo crlf and return getfl5: jumpe t,getfl1 jrst err ;blank name ;disk address for next transfer drive: 0 cylndr: 0 sector: 0 surfce: 0 ioadr: 0 ;core address for next disk transfer dsktmp: 0 ;used for temporary storage here and there xfrcnt: 0 ;# times we have tried this disk transfer cu: 0 ;current unit mu: 0 ;master unit ufdblk: 0 ;disk block of ufd qact: repeat 8, -1+ifge .rpcnt-ndsk,1 ;-1 if should use, 0 if unit not active ;file manipulation variables (leave sname, fn1, and fn2 contigous and in this order ;otherwise code at ulink will cease to function) sname: sixbit/./ ;directory name fn1: 0 ;first file name fn2: 0 ;second file name ;dev: 0 ;for holding random device wrdcnt: 0 ;disk io buffer word count wrdptr: 0 ;disk buffer byte pointer lblock: 0 ;last block read or written blkcnt: 0 ;number of blocks read or written consectively dirpt: 0 ;descriptor area byte pointer tutpt: 0 ;tut byte pointer lnkcnt: 0 ;link counter used by link solver non-zero means at least one link lnkptr: 0 ;user directory index of first link in chain lnkufd: 0 ;block # of ufd of of first link in chain pknum: repeat ndsk,-1 qded: repeat ndsk,0 dmpnxt: 0 ;virtual address of next block to dump ;swapping variables blkin: -1 ;index of block in, negative implies no core swapped out swporg: 0 ;virtual address of first location in corbfr swpor1: 0 ;virtual address of last location in corbfr litter: constants vars:: variables inform dsksiz,\<.-dskcod>