" *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " APND - Appending Simulation Package for BOS. " " Last Modified: (Date and Reason) " 06/02/72 by Noel Morris & Bill Silver to run on 645F. " Various times in 1975 by Bernard Greenberg for NSS " April 1982 by J. Bongiovanni to work with more than 8 Meg. addresses " July 1982 by Sherman D. Sprague to allow cmp to live in it's own seg. " September 1983 by Sherman D. Sprague to delete PD support. " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " ****** THE FOLLOWING EQU'S ARE SUBJECT TO CHANGE. ****** bool sltsegno,7 segment # of the SLT include bosequ include config_cards bool flagbox,20 location of flagbox in SETUP include fgbx include apnd_equ " org apnd_org org cmdbr bss ,2 org hcdbr vfd 24/0,9/0,3/4,o15/077777,3/5,18/0 org fetchout its tmp,0 org read_args bss ,2 org fetchin bss ,1 org sltseg zero sltsegno org bosdmp oct 0 org pagesw oct 1 org pmlsw oct 1 org sstsdw bss ,2 org cmpsdw bss ,2 org castap arg castap_ org getinit tra getinit_ org getsdw tra getsdw_ org getwd tra * org grab tra grab_ org apnd tra apnd_ org unapnd tra unapnd_ org get tra get_ org put tra put_ org comp tra comp_ org fetch tra fetch_ org unfetch tra unfetch_ org fetch_use_buffer tra fetch_use_buffer_ org sltsearch tra sltsearch_ org getsltname tra getsltname_ org pd_check tra pd_check_ org pd_modify tra pd_modify_ org pd_getptr tra pd_getptr_ org pvt_to_devt tra pvt_to_devt_ " " This is the getinit subroutine. " tsx2 getinit after changing dbr or sup segnos getinit_: stx2 gsdsx2 save xrs " The first time getinit is called, the length of the appending buffer should " be supplied in AU. This length will be used to construct an SDW for segment BF. initbf: tra *+1 execute this code once only sta dmpbufl save length of buffer arl 18+6 shift to AL and divide by 64 sta dmpbufsec save number of 64-word sectors als 18+3+2 shift to SDW bound position sbla =o10,du compute bound orsa apnd_sdw+1 and insert in SDW for apnd " Get the hardcore DBR, the SST SDW, and the SLT segment number from the flagbox region. ldaq tmp|flagbox+fgbx.sst_sdw Get SDW for SST segment. staq sstsdw .. ldaq tmp|flagbox+fgbx.hc_dbr Get hardcore DBR value. staq hcdbr .. lda tmp|flagbox+fgbx.slt_segno Get segment # of the SLT. tze *+2 If nonzero, save it. sta sltseg .. " Save list of alphabetically sorted disk subsystems. eax6 0 initialize subsystem index lda =aprph prepare to find PRPH cards for disks tsx2 getconf look for first one tra enddisk stop when failure ldq com|DISK_cd.sub,7 get subsystem name anq =o777777777000 mask out last character cmpq =3adsk must be "dskn" tnz getmore otherwise, go for another card stx7 disklist,6 save config card pointer eax6 1,6 step subsystem index tra getmore look for another DISK card enddisk: stx6 ndisks save number of subsystems eax6 -1,6 start with last element srtdisk1: tmoz dsksrted if so, exit from loop eax4 -1,6 simple interchange sort srtdisk2: tmi srtdisk3 test for inner loop completion ldx7 disklist,6 get pointers to two cards lda com|DISK_cd.sub,7 and sort on subsystem names ldx5 disklist,4 .. cmpa com|DISK_cd.sub,5 .. tmi *+3 if not in correct order, stx7 disklist,4 exchange the pointers stx5 disklist,6 .. eax4 -1,4 on to the next tra srtdisk2 .. srtdisk3: eax6 -1,6 outer loop tra srtdisk1 back to test for completion dsksrted: eax7 *+2 don't execute this code again stx7 initbf .. " " Set up DBR. If this is BOS's DBR or we are dumping BOS, proceed no further. ldaq cmdbr Test the current dbr to see if it is oraq dbr_set_mask staq cmtemp eraq ds|ds*2 = to the BOS dbr ( = SDW for seg ds). anaq dbr_test_mask Don't test F,R,E,W,P bits or F code. tze getibos If the same then this DBR is for BOS. szn bosdmp Test BOS switch to see if we are dumping tnz getibos BOS itself. Tra if yes. " Use SST SDW to fetch variables from SST. ldaq sstsdw Do we have SDW? tze nosst no new pc tsx2 grab call grab to fetch variables zero asttab tra nosst nosstsdw: " Set hardcore DBR value. Use current DBR if none was supplied in flagbox. ldaq hcdbr get possible hcdbr value cana =o777777770000 see if nonzero address tnz gotdbr if set, don't fetch from core default_hcdbr: ldaq cmtemp gotdbr: oraq dbr_set_mask Make sure F,R, & W bits ON. staq hcdbr Make sure DBR saved in hcdbr. staq cmdbr Set cmdbr for following hardcore fetches only. ldaq sstsdw was there an sst? tze nocmp no, so there's no cmp either. lda cmp_segno otherwise, let's get that core_map sdw tsx2 getsdw tra nocmp tra nocmp staq cmpsdw nocmpsdw: " Initialize the SLT Management procedures. tsx2 initslt initialize the SLT manager tra getiend all finished " If we are initializing for BOS then zero all of the supervisor segment SDWs. getibos: fld 0,dl clear out all SDW's staq sstsdw staq sltsdw " Always initialize the PML Simulation Package. getiend: tsx2 pdinit ldaq cmtemp restore original DBR value staq cmdbr .. " This is the return location for getinit. gsdsx2: eax2 * tra 0,2 nosst: tsx2 erpt acc "no sst" stz sstsdw stz sstsdw+1 tra nosstsdw nocmp: tsx2 erpt acc "no cmp" stz cmpsdw stz cmpsdw+1 tra nocmpsdw " " These are the data items usde by getinit. even dbr_test_mask: oct 777777777770 Test all of DBR but F bit and Fcode oct 777770377777 and R,E,W, and P bits. dbr_set_mask: oct 000000000004 Set ON F bit oct 000005000000 and R & W bits. even cmtemp: bss ,2 temporary to save cmdbr asttab: zero sst.astap+1 castap_: oct 0 start of ast array - ITS pair offset zero sst.astsize castsize: oct 0 length of ast entry zero sst.ptwbase cptwbase: oct 0 abs addr of ptws zero sst.cmp cmp_segno:dec 0 zero sst.cmp+1 cmp_offset: dec 0 core map absolute base zero sst.pdmap+1 pdmaddr: oct 0 dec -1 " " This routine will retrieve the SDW of a given segment. " It assumes the DBR to be used is in "cmdbr". " The calling sequence is: " " lda segno Segment number must be in AU. " tsx2 getsdw " tra seg_not_there Error - returned SDW has fault. " tra seg_out_of_bounds Error return for segment number too " big for descriptor segment. " staq sdw_save SDW is returned in AQ. " getsdw_: stx2 gsdw2 Save return address. eaq 0,au Segment number in QU. qls 1 but first multiply by 2. tsx2 apnd Call apnd to get SDW in descrptr seg. zero cmdbr apnd will use this DBR as its SDW. tra gser Error - apnd can't get SDW. ldaq fetchout,* Save word for next time cana =o777777770000 Is address nonzero? tnz gsdw2 If so, let it stand. cana sdw.df,dl Test for directed fault. tze gssfer If yes, then return error. " We have successfully retrieved the SDW. gsdw2: eax2 * Restore the return address. tra 2,2 Return to successful location. gser: ldx2 gsdw2 Return apnd error code. tra 1,2 gssfer: ldx2 gsdw2 Return segment fault error. tra 0,2 " " This is the grab subroutine. It will get a list of words. " ldaq sdw " tsx2 grab to get words from seg " zero list " tra error "list: zero offset "contents of word "... "dec -1 grab_: stx2 grx2 save x2 stx0 grx2+1 staq apnd_in_sdw Setup SDW for apnd. ldx0 0,2 get pointer to list grlp: ldq 0,0 Get offset for apnd. tmi grx2 if neg, quit tsx2 apnd zero apnd_in_sdw tra grerr lda fetchout,* sta 1,0 eax0 2,0 go to next pair tra grlp grx2: eax2 * eax0 * tra 2,2 grerr: ldx2 grx2 ldx0 grx2+1 tra 1,2 give error return even apnd_in_sdw: oct 0,0 Used to hold input SDWs. " " This is the apnd routine " " Its calling sequence is: " " ldq offset Offset within specified segment. " tsx2 apnd " arg sdw_input Bits 0 - 17 = addr of input SDW. " It may be a DBR when referencing " descriptor segments. " tra apnd_error Error return location. Code in AU. " sta absaddr No error => AU = absolute address " of the 64 word block retrieved by " apnd. Address in AU is 0 mod 64. " If word was not in core then there is " no abs addr and A = -1. " " The error codes returned by apnd are: " 1 => access error " 2 => page not there " 3 => bounds error - offset too high " apnd_: anq =-1,du Make sure only offset saved. stq apoff Save offset. stx2 apxrs Save X2. sxl0 apxrs And X0. stz aposr Clear switch. ldaq 0,2* Get actual SDW. (DBRs treated as SDWs.) staq apsdw Now save SDW . cana sdw.df,dl Does SDW have fault? tze accerr If yes - go return access error code. " Now check that the word offset is within the bounds of this segment. anq sdw.bound,du mask the bound field qls 4-3 compute word count in QU orq 15,du .. cmpq apoff if offset within bound? tnc apotb if not, give error " THE FOLLOWING INSTRUCTION ASSUMES A PAGE SIZE OF 1024 WORDS. qrl 10 divide by page size stcq appages,70 and save count of pages " Now check to see if the segment is paged or unpaged. ldaq apsdw Retrieve the whole SDW. canq sdw.unpaged,dl Test SDW.U bit. tnz apnpaged U bit ON => unpaged. " " This segment is paged. Compute page number and get PTW. lda apoff Get word offset within segment. " THE FOLLOWING INSTRUCTION ASSUMES A PAGE SIZE OF 1024 WORDS. lrl 10+18 compute page number in AL als 18 move page number to AU sta appno Save page number. qrl 18-10 offset within page in QU stq appoff Save offset within page. lca dmpbufl Get mask of buffer length. ana appoff Compute offset of start of buffer within page. sta apboff Save offset of buffer. lda apsdw word A of SDW in A ldq appno page number in Q tsx2 get_ptw Get the PTW for this page. tra apnpa Error return. sta apptw And save it. " Now test this PTW for page faults. cana ptw.df,dl Test PTW.F bit. tze page_fault Tra if F bit OFF => page not in core. " The page is in core - we lucked out. " THE FOLLOWING INSTRUCTION ASSUMES A PAGE SIZE OF 1024 WORDS. ana =o777760,du Ignore low order bits of PTW.ADDR. sta fetchin Set absolute address of beginning of page. lda appoff Get offset into page. arl 6 In A(0-23). orsa fetchin Absolute address now in fetchin. tsx2 fetch Get piece of page into buffer. tra apnpa tra apend All finished. " " Come here if the page is not in core. page_fault: szn pagesw Test read page switch. tze apnpa OFF => don't read in any pages. cana add_type.core,dl is this in core (prob. os/read)? tze ck_null no, do devadd case. " PTW contains a core address, but core has not yet had data " read into it. We must wade through the core map to determine " the device address. szn sstsdw get sstsdw tze apnpa if no SST, cannot page "THE FOLLOWING INSTRUCTION ASSUMES A PAGE SIZE OF 1024 WORDS arl 2 get cme offset adla cmp_offset relocate to beginning of cme eaa cme.devadd,au address of where device address is arl 6 form 24-bit address adla cmpsdw compute absolute address sta fetchin save the cme absaddr tsx2 fetch tra notos if loses, use core lda fetchout,* ana =o777777740000 isolate did, devadd sta aposr save information notos: ck_null: cana add_type.non_null,dl is there data? tze pinnadd no, null address cana add_type.pd,dl Handle PD addresses special. tze not_pd lda 1,dl KLUDGE device type is 1.. bulkstore tra readrec " Now fetch pvtx from aste. not_pd: cana ptw.nulled,du nulled disk address? tnz pinnadd yes, do null case " Real disk address -- get devt word tsx2 getpvt get the pvt index, tra apnpa failure exit readrec: sta pindevt save devt word lda apptw Get the device address. arl 18 multicial devadd to lower tsx2 mulbos convert from multics addr to bos arg pindevt tra apnpa ana =o777777770000 Zero all but BOS device address. ora dmpbufsec Put num records to read in AL. sta pintemp Save device addr and num of records. " The device address points to the beginning of a page on the paging device. " All we want is one dump buffer full of words,ie, one record - but the one " that contains the word we are trying to get. lda apboff Get offset of buffer within page arl 6+6 Now A (0-23) = # of 64 wd record in page. adla pintemp Add to starting record address. ldq pindevt Get device ID. cmpaq read_args Test rdev arguments to see if buffer " already contains what we want. tze pinrok Yes, don't bother to read. staq read_args No,save args for next call. tsx2 rdev read device arg pindevt nop bf|0 tra apnpa Paging device error tra pinrok Read OK. pinrok: tsx2 fetch_use_buffer Set segment tmp to point to buffer. nop lda appoff Get offset within page. sbla apboff Subtract offset of buffer within page. sta fetchout+1 We have computed offset within buffer. lca 1,dl A = -1 => page not in core. tra apend Exit. " " Come here if the caller is referencing a null page. " We will test to see if the rest of the pages in this segment are also null. " If they are we will return an OUT_OF_BOUNDS error code to the caller. " If any of the pages from this one to the end of the segment are non null " then we will return a dump buffer of all zeros. pinnadd: ldq appno Get page number adq 1,du Bump to next page. stq appno Save page number. cmpq appages Have we tested all pages? tpnz apotb If so, give OOB return. lda apsdw Get SDW word 1 in A tsx2 get_ptw Get PTW for this page. tra apnpa Error return. cana ptw.df,dl Got PTW. Test F bit. tnz ret_zero_buf ON => page in core => not null. cana add_type.non_null,dl try to optimize real null case "if os/read nulled devadd, forget it. tze pinnadd 0 => null page. Go test next page. " We have found a non null page so we can't return an out_of_bounds " error code. Instead we will return a buffer with all zeros. ret_zero_buf: lda dmpbufl Zero all of dump buffer. als 2 Compute character count. mlr (),(pr,rl),fill(0) This does it quickly. desc9a *,0 desc9a bf|0,au stz read_args+1 Prevent use of buffer on next call. tra pinrok Go set buffer and return. " " Come here if we have an unpaged segment. apnpaged: lda apoff Get offset of word. arl 6 Shift to align with SDW.ADDR. adla apsdw Add SDW.ADDR to offset " Bits 24 - 35 are ignored. sta fetchin Set pointer to word. tsx2 fetch call fetch to find core tra apnpa Error if core block not found. lda fetchin Get abs addr. It is in AU only (0mod64). " When we get here A contains the absolute address of the word we had to " return. A = -1 => word not in core. apend: ldx2 apxrs Retrieve X2. lxl0 apxrs Get X0. tra 2,2 Now RETURN. This is the normal return. " Note: AU = abs addr of block. " Or A = -1. " These are the apnd error routines. accerr: lda =1,du Access error - segment has fault. tra aper apnpa: lda =2,du page not there tra aper apotb: lda =3,du out of bounds aper: eax2 -1 Set X2 to return to error location. asx2 apxrs Make sure this is value of X2. tra apend Go and return. " " This routine is called to rewrite modified pages. " It will set the modified bit in the PTW and attempt to " set the modified bit the the paging device map, if needed. " It know how to sort out the problems associated with handling " a page that is out-of-service on a read. " " This procedure must be called immediately after a call to apnd. " " tsx2 unapnd " tra error " unapnd_: stx2 unax2 save X2. tsx2 unfetch Write back buffer containing segment. tra unaerr ldaq apsdw Look at SDW. canq sdw.unpaged,dl Unpaged segment? tnz unax2 If so, all finished. szn aposr Out of service on read? tze noosr If not, avoid a lot of trouble. sprp4 unapr4 Save PR4. lprp4 unaset4 Set PR4 to segment 4. ldaq ds|tmp*2 Get SDW for page. staq ds|4*2 And put it where it can be used. cams 0 lda apptw PTW contains real core address. ana =o777777,du Mask it. sta fetchin And set up for a fetch. lda appoff Get offset within page. arl 6 In A(0-23). adla fetchin Add to page offset. sta fetchin Now have absolute addr of word. tsx2 dont_fetch Fetch without reading disk. tra unaerr ldq dmpbufl Length of buffer in QU. qrl 18-2 Compute character count. mlr (pr,rl),(pr,rl) Copy the buffer. desc9a 4|0,ql desc9a tmp|0,ql lprp4 unapr4 Restore PR4 now. tsx2 unfetch Write out the page into core. tra unaerr noosr: lda apsdw SDW word A in A. ldq appno Page number in Q. tsx2 get_ptw Fetch the PTW. tra unaerr ora ptw.phm,dl Set the modified bit. sta fetchout,* And replace the PTW. tsx2 unfetch Write out core containing PTW. tra unaerr lda apptw PTW in A. cana ptw.df,dl Was page faulted? tnz unax2 If not, all finished. cana ptw.os,dl Out of service? tze *+2 If so, lda aposr Get true device address. tsx2 pd_getptr Try to get ptr to pdmap entry. tra unax2 tsx2 pd_modify If successful, set modified flag. tra unax2 unax2: eax2 * Restore X2. tra 1,2 And return to caller. unaerr: ldx2 unax2 Restore X2. tra 0,2 And take error return. unapr4: bss ,1 unaset4: zero 4,0 " " These are some of the data items used by apnd. " The contents of the apnd SDW is as follows: " zero address field points to beginning of segment (tmp). " F bit ON => segment in memory. " BOUND = size of dump buffer (num 16 wd blks in buffer) -1 " R & W bits ON " U bit ON => segment is unpaged. even apnd_sdw: vfd 24/0,9/0,o3/4 vfd 15/0,o3/5,o3/2,15/0 dmpbufsec: oct 0 number of 64-word sectors in dmpbuf dmpbufl: zero 0 number of words in dmpbuf pindevt: oct 0 pintemp: oct 0 even apsdw: bss ,2 Input SDW. apxrs: bss ,1 Where X2 and X0 are saved. apoff: bss ,1 Input word offset. appoff: bss ,1 Offset of word within page. apboff: bss ,1 Offset of apnd buffer within page. appages: bss ,1 Number of last page in segment. appno: bss ,1 Page number of word offset. apptw: bss ,1 PTW for this page. in_core: bss ,1 Non-zero if fetch from core. aposr: bss ,1 Non-zero if page OS on read. " " GETPVT - this routine gets the PVT index for the segment " whose SDW is in "apsdw" " Its return value is a "device type word" for running BOS io " vfd 3/iom,6/channel,9/device_no,18/device_type " " tsx2 getpvt " tra erret " sta dev_type getpvt: stx2 gpvt2 lda apsdw Get SDW, with PT loc arl sdw.add_shift isolate addr of pt sbla ast_size,dl compute addr of ast begin adla aste.pvtx_word,dl ..now addr of word with pvtx als 12 sta fetchin .. obtain pvtx tsx2 fetch .. tra gpvt_err .. lda fetchout,* Get the pvt index. arl aste.pvtx_shift ana aste.pvtx_mask,dl Isolate pvt index. tra pvt_to_devt1 merge with next routine " " " PVT_TO_DEVT - this routine gets a 'devt' word (see UTIL for description) given a pvtx. " " lda pvtx " tsx2 pvt_to_devt " tra erret " sta dev_type " pvt_to_devt_: stx2 gpvt2 save return pvt_to_devt1: als 0 set indicators from A tmoz gpvt_err must be positive and nonzero cmpa gpvt_pvtx same PVT index as before? tze gotpvt if so, skip this stuff sta gpvt_pvtx save this PVT index ldx7 ndisks get number of disk subsystems gpvtl1: ldx6 disklist-1,7 get pointer from list eax5 0,6 place in X5, too sta gpvt3 save this index temporarily gpvtl2: szn com|DISK_cd.ndrives,5 any drives for this device type? tmi gpvtnxt if not, try next subsystem szn com|DISK_cd.model,5 test model number tze gpvtskp zero model means gap in drive numbers sba com|DISK_cd.ndrives,5 decrement index tmoz gpvt_got if <= 0, we've found subsystem eax5 2,5 otherwise, see if more types tra gpvtl2 .. gpvtskp: ldq com|DISK_cd.ndrives,5 get number of drives to skip asq gpvt3 and adjust drive number eax5 2,5 step to next type tra gpvtl2 .. gpvtnxt: eax7 -1,7 step to next subsystem tpnz gpvtl1 .. tra gpvt_err if not found, error gpvt_got: lda gpvt3 got device number in A als 27-6 now have device number ora com|DISK_cd.iom,6 insert IOM number sba 1,dl minus 1 als 6 insert channel number ora com|DISK_cd.chn,6 .. alr 27 shift to position sta gpvt3 and save eaa 0,6 config card offset in A arl 18 move to AL orsa gpvt3 insert as part of devt lda com|DISK_cd.model,5 get correct model number tsx2 lookup_devmodel look up device type tra gpvt_err .. orsa gpvt3 insert rest of stuff gotpvt: lda gpvt3 answer in A gpvt2: eax2 * tra 1,2 gpvt_err: stz gpvt_pvtx prevent future lookup ldx2 gpvt2 get return index tra 0,2 take error return gpvt_pvtx:bss ,1 gpvt3: bss ,1 ndisks: bss ,1 disklist: bss ,10 " This subroutine is called to get a PTW. It is only called by the apnd " routine itself. " " INPUT: The page number must be in QU. " The first word of the SDW for the segment containing the " page must be in A. " "OUTPUT: The PTW will be returned in A. " " The first instruction after the tsx2 to get_ptw will be for an error return. " The normal return will be to the second location after the tsx2. get_ptw: stx2 get_ptw_return Save X2 since we will call fetch. sta fetchin Put SDW.ADDR in fetchin (ignore bits 24-35) qrl 6 Shift page number to line up with SDW.ADDR. adlq fetchin Add SDW.ADDR to page number. stq fetchin This yields the abs addr of the PTW. tsx2 fetch Get the blk that contains this PTW. tra get_ptw_error Error - can't get PTW block. lda fetchout,* Thus we can now get the PTW. get_ptw_return: eax2 * Restore return address into X2. tra 1,2 Make a normal return. get_ptw_error: ldx2 get_ptw_return Restore X2. tra 0,2 Transfer back to error location. " This is the fetch routine. " Given an absolute address of a word it will retrieve the block " which contains the specified word. " " Bits 0-23 of "fetchin" must contain the absolute address " of the word to be fetched. " " The ITS pair "fetchout" will be setup by fetch to reference into " the retrieved block. " This reference is made through segment (tmp). fetch will setup the " the SDW of segment (tmp) to point to the beginning of the 64 word " block. The length of the segment is = to the size of the dump buffer. " " The instruction after the tsx2 fetch must be a transfer to an error " routine. fetch_: stz dontsw Do not inhibit disk I/O. fetchj: lda dmpbufl Length of buffer in AU. sba 1,du Make a mask for low-order bits. arl 6 Place address mask in A(0-23). ana fetchin Compute part of address within buffer. als 6 Place in AU. sta fetchout+1 Set indirect word for buffer fetch. " Now check that the absolute address really exists in memory. eax7 8 Set up loop to test memory on 8 ports. test_port_mem: eax7 -1,7 Set index to next port. tmi 0,2* If all ports tested then nonexistent addr lxl6 com|coreblocks,7 Get size of this port in X6. cmpx6 -1,du If it's -1, then no memory on this port. tze test_port_mem Try next port. eaq -1,6 Size - 1 in QU. adlq com|coreblocks,7 Compute highest 64-word block on this port. lda com|coreblocks,7 First 64-word block on this port in AU. ana -1,du Mask the A. orq -1,dl Force Q(18-35) > fetchin (18-35). cwl fetchin Is first block <= block <= last block? tnz test_port_mem If not, address is not on this port. " We come here once we know that the given absolute address really exists. " Now we must see if the block we are looking for has been written " onto secondary storage by BOS. szn bosdmp Test BOS dump switch. tnz fetchincore If ON then assume word in core. lxl7 com|corearea Get number of records of core written by BOS. anx7 =o7777,du Mask the sector count. tze fetchincore If no mem written out assume addr in core. cmpx7 fetchin Compare it with addr of requested word tnc fetchincore TRA if really in core tze fetchincore " The block we want was written out by BOS as part of the low " memory that it saved. stx2 fetx2 Save X2 so we can make a call. lca dmpbufl Get mask for high-order bits. ars 6 Mask in A(0-23). ana fetchin Get starting address of block we want. arl 6 Move to sector address position. adla com|corearea Add address to core image on disk ana =o777777770000 Mask out count bits. ora dmpbufsec Insert # of sectors to read. lcq 1,dl Q = -1 => read from standard BOS device " Now the A,Q contains the data that is needed to read a record from " secondary storage. cmpaq read_args Are we after the same record as last call? tze fetx2 If yes skip read. staq read_args No, save it for next read. szn dontsw Should we do this? tnz fetx2 If not, continue without reading. tsx2 rdsec Read the specified record into nop bf|0 the dump buffer (dmpbuf). dis * Here on rdsec error. " The memory block we want is now in dmpbuf. " The rest of fetch may be called as a special entry. It sets up the SDW for " segment (tmp) so that it references the dump buffer. Thus the dump buffer " may be referenced via fetchout. fetx2: eax2 * Restor X2. fetch_use_buffer_: stz in_core indicate fetch no from core absa bf|0 Get absolute address of dump buffer. tra fet_setsdw Don't use the address from fetchin. fetchincore: stc2 in_core indicate fetch directly from core lca dmpbufl Get mask for high-order address bits. ars 6 In A(0-23). ana fetchin Absolute address of base of block in A(0-23). " The A now contains the absolute address of the block that we " must pass back to the caller through fetchout. fet_setsdw: ldq 0,dl A,Q now used to form an SDW. oraq apnd_sdw OR in template SDW - has all bits set. staq ds|tmp*2 Use this SDW to reference segment (tmp). cams "Make sure SDWs in Ass. Mem updated. tra 1,2 Now we can RETURN. " dont_fetch: stc2 dontsw Inhibit disk read. tra fetchj Join common code. unfetch_: stx2 unfx2 Save X2. szn in_core did we patch core? tnz 1,2 yes, easy. " " Must rewrite disk or paging device or something. " ldaq read_args qls 0 Set indicators from Q. tze 1,2 If zero, just return. tmi unfbos if negative, write BOS stq pindevt tsx2 wdev write the disk. arg pindevt arg bf|0 tra unferr unfx2: eax2 * Restore X2. tra 1,2 Normal return. unferr: ldx2 unfx2 Restore X2. tra 0,2 Error return. unfbos: tsx2 wtsec write BOS sector nop bf|0 tra unferr tra unfx2 dontsw: bss ,1 Inhibit fetch I/O switch " " Procedures to Perform Block Transfers. " Coded 5/75 by B. S. Greenberg " ldq offset,du " tsx2 get " arg sdw " zero where_to_be_put,count " tra erret bool data,4 get_: tsx7 mapg set up map loop mlr (pr,rl,al),(pr,rl) move data to destination desc9a tmp|0,ql desc9a data|0,ql tra 0,2 return to map loop " ldq offset,du " tsx2 comp " arg sdw " zero where_to_compare,count " tra erret " tze zero return with indicators set comp_: tsx7 mapg set up map loop cmpc (pr,rl,al),(pr,rl) compare data desc9a tmp|0,ql desc9a data|0,ql sti get.ir save indicators tnz get.exit if non-zero, all finished tra 0,2 return to loop for more " " ldq offset,du " tsx2 put to move stuff to multics " arg sdw " zero where_from_to_put,count " tra erret put_: tsx7 mapg set up map mlr (pr,rl),(pr,rl,al) move from 4 to 1 desc9a data|0,ql desc9a tmp|0,ql stq put.qtemp Save Q. stx2 put.x2 And X2. tsx2 unapnd Write back the buffer. tra get.erret ldq put.qtemp Restore Q. put.x2: tra *-* And return. put.qtemp: dec 0 " mapg: stx7 get.switch stx2 get.exit sti get.ir sprp (data),get.pr stq get.offset lda 1,2 get address and count epp (data),0,au point to data dest/source ana -1,dl mask count als 2 mpy out to chars sta get.count eaq 0,2* get sdw address stq get.sdwp save for apnd get.loop: ldq get.offset tsx2 apnd address beginning of remainder of data get.sdwp: arg *-* tra get.erret " " seg 1 is now pointing at 64-word data buffer. " ldq dmpbufl get size of buffer sblq fetchout+1 find how much data is in buf left qrl 18-2 convert to characters " " EIS char offset to a, count to q " cmpq get.count do we need whole buffer? tmi *+2 count > bufleft => use count ldq get.count lda fetchout+1 get char disp into tmp arl 18-2 get.switch: tsx2 *-* dispatch get/put lda 0,dl negl 0 negate q asq get.count decrement count tmoz get.exit no more data, all done negl 0 q back + a9bd data|0,ql point further into data dest. qls 18-2 reduce to words asq get.offset increase offset, guaranteed mod 64 tra get.loop fetch more data get.erret: ldx2 get.exit setup bad return eax2 -1,2 make error return tra *+2 get.exit: eax2 *-* reload return lprp (data),get.pr ldi get.ir tra 3,2 return even get.pr: bss ,1 save pr get.ir: bss ,1 save indicators get.count: dec 0 chars left to move get.offset: arg 0 word offset in seg of next loc " " Segment Loading Table Routines for BOS. " Coded 2/21/73 by Noel I. Morris include slt include slte " " tsx2 sltsearch search SLT for name of supervisor segment " arg name must be blank padded to end of word " tra error " sta segno in AU sltsearch_: szn sltsdw do we have SDW for SLT? tze 1,2 if not, take error return right away stx2 slsx2 save X2 ldx7 0,2 get address of name eax7 1,7 X7 -> characters of name stx7 slscad save for copying ldq -1,7 get length of name cmpc (rl),(),fill(040) same name as last time? slscad: desc9a *,ql desc9a slsname,32 tze slsfnd if so, return segno mlr (id,rl),(),fill(040) copy the name and pad it arg slscad desc9a slsname,32 ldq slthd+slt.first_sup_seg get first sup seg # sltlk1: stq slksegno set the segment # cmpq slthd+slt.last_init_seg are we at end of SLT? tpnz slsnfd if so, return -- name was not found tsx2 extsltname extract names from SLT arg slscmp tra slsnxt slsnxt: ldq slksegno get segment # cmpq slthd+slt.last_sup_seg was this last sup seg? tnz *+3 if so, ldq slthd+slt.first_init_seg next segment is first init tra sltlk1 .. adq 1,dl step the segment # tra sltlk1 and loop to next segment slsfnd: lda slksegno name found! load segment number slsx2: eax2 * restore X2 als 18 move segment # to AU tra 2,2 and return slsnfd: ldx2 slsx2 restore X2 tra 1,2 take error return slscmp: stx2 slscx2 save X2 tsx2 comp perform comparison arg sltntsdw zero slsname,8 tra slnerr tze slsfnd slscx2: eax2 * restore X2 tra 0,2 comparison not successful slksegno: bss ,1 slsname: bss ,8 " " lda segno segment # in AU " tsx2 getsltname get segment name from SLT " desc6a name(offset),length descriptor to use in storing name " tra error getsltname_: szn sltsdw is the an SLT? tze 1,2 if not, take error return stx2 gsnx2 save X2 arl 18 move segment # to AL sta gsnseg save segment # ldq 0,2 descriptor in Q stcq gsdesc,74 save it anq =o7777,dl mask length lda 0,dl clear A staq gsofflen offset in A, remaining length in Q lda slthd+slt.first_sup_seg check segment number for valid sup seg ldq slthd+slt.last_sup_seg .. cwl gsnseg .. tze gsnok .. lda slthd+slt.first_init_seg check segment number for valid init seg ldq slthd+slt.last_init_seg .. cwl gsnseg .. tnz gsnerr .. gsnok: ldq gsnseg segment # in QU tsx2 extsltname extract names from SLT arg gsget tra gsnerr gsnx2: eax2 * restore X2 tra 2,2 return to caller gsnerr: ldx2 gsnx2 restore X2 tra 1,2 take error return gsget: stx2 gsgx2 save X2 tsx2 get grab this name arg sltntsdw zero gsname,8 tra gsnerr scm (),(du) find end of name (first blank) desc9a gsname,32 aci " " arg gstally lxl7 gstally length of name in X7 ldaq gsofflen offset znd length in A/Q mvt (rl),(rl,al),fill(040) move the name desc9a gsname,x7 gsdesc: desc6a *,ql gstabad: arg * ada gstally add length of name of offset ada 1,dl plus a blank sbq gstally subtract from remaining length sbq 1,dl .. tmoz gsnx2 if output is full, stop here staq gsofflen save offset and remaining length gsgx2: eax2 * restore X2 tra 0,2 and return to caller gsname: bss ,8 gstally: bss ,1 gsnseg: bss ,1 even gsofflen: bss ,2 " " ldq segno segment # in QL " tsx2 extsltname extract name from SLT " arg funct subroutine to process name " tra error error return extsltname: stx2 xslx2 save XR's stx0 xslx0 .. mpy slte_size,dl compute SLT entry index eaq slt.seg+slte.names_ptr,ql get addr of SLT entry tsx2 apnd fetch pointer to names arg sltsdw tra slnerr ldx7 fetchout,* rel pointer to names in X7 eax7 segnam.name,7 X7 -> first name stx7 slknp save name pointer eaq -segnam.name,7 QU -> number of names tsx2 apnd fetch the # of names arg sltntsdw tra slnerr lca fetchout,* -number of names sta slknms save complement for counting sltlk2: eaq slknp,* get pointer to next name ldx2 xslx2 restore X2 tsx2 0,2* call to process name slknxn: lda 9,du step name pointer to next name asa slknp .. aos slknms count off one name tmi sltlk2 loop, if more names xslx2: eax2 * restore XR's xslx0: eax0 * .. tra 2,2 and return slnerr: ldx2 xslx2 restore XR's ldx0 xslx0 .. tra 1,2 take error return slknp: bss ,1 slknms: bss ,1 " " tsx2 initslt initialize the SLT package initslt: stx2 islx2 save X2 lda sltseg segno of SLT in QU tsx2 getsdw get SDW for SLT tra noslt tra noslt staq sltsdw save SDW for SLT eaq 0 get the SLT header tsx2 get grab SLT header arg sltsdw zero slthd,slt.seg tra noslt lda slthd+slt.name_seg_ptr look at the name table pointer ana -1,dl mask the modifier cmpa =o43,dl is it an ITS? tnz noslt if not, stop here lda slthd+slt.name_seg_ptr segno of name table in QU tsx2 getsdw get SDW for name table segment tra nosltnt tra nosltnt staq sltntsdw save SDW eaa asgetab,i get address of conversion table sta gstabad MVT won't take ID here islx2: eax2 * restore X2 tra 0,2 and return noslt: tsx2 erpt acc "no slt" tra isler nosltnt: tsx2 erpt acc "no slt name table" isler: stz sltsdw clear SDW for SLT stz sltsdw+1 .. tra islx2 now return even sltsdw: bss ,2 sltntsdw: bss ,2 slthd: bss ,slt.seg " " Paging device management for BOS. " Coded 5/24/72 by N. I. Morris " lda b device address " tsx2 pd_check to see if really on paging device " these arguments are also returned if call OK. " arg did device ID " arg pdmep rel ptr to pdmap entry " tra error error return " sta b new device address pd_check_: tra 3,2 "TEMPORARY " szn pmlsw do we wish to do this? " tze 4,2 if not, just return " stx2 pdcx2 save X2 " " sta pdcaddr save device address " stz 2,2* clear map entry pointer " ldq 0,2* get did " stq pdcdid and save " stq pdcarea save that too " " tsx2 bosmul convert to Multics device address " arg pdcdid .. " tra pdcerr .. " "" form multics device address " tsx2 pd_hash_search search for entry in pd map " tra pdcnoentry .. " tra pdcerr .. " sta pdcmep save map entry ptr " sbla pdmaddr get index within pdmap " lrl 36 in QU " div pdsize,dl compute pd device address " lls 18 move quotient to AL " " tsx2 mulbos convert back to BOS address " arg pdmdid .. " tra pdcerr .. " sta pdcnewaddr save new device address " " tsx2 erpt print a message " acc "^d,^o,^o -> ^d,^o,^o." " arg pdcdid " arg pdcarea " arg pdcaddr " arg pdmdid " arg pdcnewarea " arg pdcnewaddr " " lda pdcnewaddr new device address in A "pdcx2: eax2 * restore X2 " ldq pdmdid set new device ID " stq 0,2* .. " ldq pdcnewarea and new area # " stq 1,2* .. " ldq pdcmep return the map entry ptr " stq 2,2* .. " tra 4,2 return " "pdcnoentry: " ldx2 pdcx2 restore X2 " lda pdcaddr return the old address " tra 4,2 .. "pdcerr: ldx2 pdcx2 restore X2 " eax2 -1,2 make return to 2,2 " tra pdcnoentry+1 .. pdcdid: bss ,1 pdcarea: bss ,1 pdcnewarea: bss ,1 pdcaddr: bss ,1 pdcnewaddr: bss ,1 pdcmep: bss ,1 " " lda devadd Multics device address " tsx2 pd_getptr to get pointer to pd map entry " tra error error return " sta pdmep rel ptr to pd map entry pd_getptr_: tra 0,2 TEMPORARY " szn pmlsw just return if not " tze 0,2 simulating PML " stx2 pdgtx2 save X2 " " sta pdgtdevadd save device address " cana add_type.non_null,dl " tze 0,2 not pd " cana add_type.pd,dl Is it the PD? " tze 0,2 if not, take error return " " lda pdgtdevadd device adress in A " ana -1,du mask the adress " lrl 36 move to QU " mpy pdsize,dl compute pdmap index " adlq pdmaddr .. " stq pdgtmep save map entry pointer " " eaa pdme.flags,qu add offset of flags and place in AU " tsx2 fetch_pdmap fetch the flags " tra pdgterr .. " cana pdme.used,dl is entry used? " tze pdgterr if not, take error return " "pdgtx2: eax2 * restore X2 " lda pdgtmep load map entry pointer " tra 1,2 and return " " "pdgterr: ldx2 pdgtx2 restore X2 " tra 0,2 take error return pdgtdevadd: bss ,1 pdgtmep: bss ,1 " " lda pdmep rel ptr to pd map entry " tsx2 pd_modify to turn on modified bit " tra error error return pd_modify_: tra 0,2 TEMPORARY " stx2 pdmox2 save X2 " eaa pdme.flags,au add offset of flags " tsx2 fetch_pdmap get correct word of map " tra pdmoerr .. " ora pdme.mod,dl turn on modified bit " sta fetchout,* and store the flags " " szn ftpsw are we patching pdmap in core? " tze pdmox2 if so, we're all finished " lda read_args get device address " tsx2 wdev write out this piece of pdmap " arg pdmdid .. " arg bf|0 .. " tra pdmoerr .. " "pdmox2: eax2 * restore X2 " tra 1,2 and return " "pdmoerr: ldx2 pdmox2 restore X2 " tra 0,2 take error return " " " lda offset relative to base of SST " tsx2 fetch_pdmap to get word from pdmap " tra error error return " sta word returned word fetch_pdmap: stx2 ftpx2 save X2 eaq 0,au place address in AU lda sstsdw SDW for SST in A - just chk wrd 1. tze ftpnosst if no SST, must read in map stz ftpsw indicate fetch from core tsx2 apnd go get word arg sstsdw tra ftperr .. tra ftpx2 fetch the word and return ftpnosst: sblq pdmaddr subtract offset of map in SST lls 18-6 mod 64 address in A qrl 18-6 offset within 64-word sector in QU stq fetchout+1 save for later reference als 12 mod 64 address in A (0-23) ldq 0,dl clear Q adaq pdfrec add addr of start of pdmap cmpaq read_args Do we have correct sector already? tze ftpgot if so, skip read staq read_args Save device address. stc2 ftpsw indicate fetch from secondary storage tsx2 rdev read in piece of pdmap arg pdmdid .. arg bf|0 .. tra ftperr .. ftpgot: tsx2 fetch_use_buffer Make tmp segment same as bf segment. nop ftpx2: eax2 * restore X2 lda fetchout,* fetch the word tra 1,2 return ftperr: ldx2 ftpx2 restore X2 tra 0,2 take error return ftpsw: bss ,1 " " tsx2 pdinit to initialize paging device software pdinit: stx2 pdinx2 save X2 lda =apage search for "page" card tsx2 getconf in configuration deck tra nopdid exit if none lda com|2,7 Get frec from card. sta pdfrec save it lda com|1,7 Get device name from card. tsx2 find_disk Get devt word. arg pdmdid tra nopdid if illegal ID, return lda pdfrec Get first record number. tsx2 mulbos convert to BOS device address arg pdmdid .. tra pderr .. ana =o777777770000 remove the sector count ora 1,dl insert sector count of 1 ldq pdmdid form composite word in Q staq pdfrec save for later usage ldaq sstsdw SST in core? tze pdnosst if not, must get info from pdmap tra pdinx2 and return pdnosst: stz pdmaddr make sure it's cleared lda 0,du read word 0 of pdmap tsx2 fetch_pdmap fetch it tra pderr .. ldaq fetchout,* load both words stca pdmaddr,70 save addr of pdmap pdinx2: eax2 * restore X2 tra 0,2 and return pderr: tsx2 erpt complain acc "unable to get pdmap" nopdid: stz pmlsw clear PML switch tra pdinx2 and return pdmdid: bss ,1 even pdfrec: bss ,2 " include bos_sdw include bos_ptw include sst include add_type include aste include cmp include bos_page_info include bos_tv include bos_common end " " " ----------------------------------------------------------- " " " " Historical Background " " This edition of the Multics software materials and documentation is provided and donated " to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. " as a contribution to computer science knowledge. " This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, " Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull " and Bull HN Information Systems Inc. to the development of this operating system. " Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), " renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership " of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for " managing computer hardware properly and for executing programs. Many subsequent operating systems " incorporated Multics principles. " Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., " as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . " " ----------------------------------------------------------- " " Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without " fee is hereby granted,provided that the below copyright notice and historical background appear in all copies " and that both the copyright notice and historical background and this permission notice appear in supporting " documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining " to distribution of the programs without specific prior written permission. " Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. " Copyright 2006 by Bull HN Information Systems Inc. " Copyright 2006 by Bull SAS " All Rights Reserved " "