bootload_disk_post.pl1 11/11/89 1105.1rew 11/11/89 0803.9 17091 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bootload_disk_post: proc (coreadd, errcode); /* Routine to post bootload disk i/o completions. Written in June 1983 by Keith Loepere. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl addr builtin; dcl coreadd fixed bin (26) parameter; /* mem addr i/o finished into */ dcl errcode fixed bin (35) parameter; /* word of flags signalling successful/bad i/o */ dcl i fixed bin; /* loop counter */ dcl sys_info$initialization_state fixed bin ext; dcl syserr entry options (variable); if sys_info$initialization_state ^= 1 then go to crash; disk_post_area_ptr = addr (bootload_disk_post_seg$); do i = 1 to disk_post_area.number; if disk_post_area.buffer_coreadd (i) = coreadd then do; if disk_post_area.disk_complete (i) then go to crash; disk_post_area.disk_complete (i) = "1"b; disk_post_area.disk_error_code = errcode; return; end; end; crash: call syserr (CRASH, "bootload_disk_post: Attempt to post non-requested i/o completion."); return; %page; %include bootload_post_area; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: bootload_disk_post: Attempt to post non-requested i/o completion. S: $crash T: $init M: disk_control detected an i/o completion that Bootload Multics does not believe it requested. A: Reboot. END MESSAGE DOCUMENTATION */ end;  cam_cache.alm 11/11/89 1105.1rew 11/11/89 0803.9 94941 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " cam_cache " " " " Subroutine to clear ptw associative memory and (optionally)" " cache memory on this and all other processors. " " The subroutine will not return until this has been " " accomplished. " " " " This subroutine has two sets of entry points. One set " " consists of entry points callable only from within " " bound_page_control (via tsx7). For these, arguments are " " passed via the pxss/page_fault stack frame. The other " " set consists of entry points callable externally (via " " the transfer-module page. For these, arguments are " " passed in the usual (PL/1) manner. " " " " The only possible parameter to cam_cache entry points is " " an absolute memory address for selective cache clearing " " For calls from within bound_page_control, this address is " " passed in cell core_add in the stack frame. For external " " calls, the PTW of the page containing the target address " " for selective clearing is passed in Argument 1. " " " " The functions performed by the subroutine are as follows, " " with the internal and external entry points: " " " " Clear all ptw associative memory, selectively clear cache " " cam_cache (internal) " " cam_cache_ext (external) " " " " Clear all ptw associative memory, clear all cache " " cam (internal) " " cam_ext (external) " " " " Clear all ptw associative memory " " cam_ptws (internal) " " cam_ptws_ext (external) " " " " Clear all ptw associative memory, selectively clear cache, " " set scs$cam_wait so that all other processors wait " " for scs$cam_wait to be cleared before resuming. " " cam_with_wait (internal) " " cam_with_wait_ext (external) " " " " " " " The protocol for multi-processor clearing is as follows: " " " " This processor obtains the connect lock. " " " " Under the connect lock, the processor " " 1. sets scs$cam_pair to the instructions " " which do the clearing " " 2. sets the scs$fast_cam_pending cell " " non-zero for all other processors " " 3. if this is a cam-with-wait call, sets " " the appropriate bit in scs$cam_wait for " " all other processors " " 4. sends a connect to all other processors " " 5. XED's the code in scs$cam_pair " " 6. waits for all scs$fast_cam_pending cells " " to clear (indicating clearing done by " " all other processors). " " 7. releases the connect lock and returns " " Note - if only one processor is active, most " " of this is skipped. " " " " Upon receipt of a connect, all other processors " " 1. if its scs$fast_cam_pending cell is set, " " XED the code in scs$cam_pending and " " clear it scs$fast_cam_pending cell " " 2. if its bit in scs$cam_wait is set, wait " " for that bit to clear (this clearing is " " done by the caller of cam_cache on the " " originating processor). " " " " " " There are only two ways a conect fired to another " " processor can be lost. One is hardware failure, and the " " other is a processor put into step mode before the connect " " and taken out of step mode after the connect. There is " " a hedge against the latter here. If all processors have " " not responded within an unreasonable amount of time, the " " connects are re-issued, and the waiting begins anew. " " This hedge should not be construed as implicitly condoning " " putting a cpu on a multi-processor in step mode. It may " " help in truly strange circumstances. " " " " " " This code was copied from page_fault and modified for " " fast connects by J. Bongiovanni in February 1981. " " Modified September 1983, E. N. Kittlitz per S. Harris " " (UNCA) to not destroy temp_2/x0 if lock contention " " " """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" name cam_cache segdef cam_cache,cam_cache_ext segdef cam,cam_ext segdef cam_ptws,cam_ptws_ext segdef cam_with_wait,cam_with_wait_ext iftarget adp warn (WARNING: cam_cache has not been converted for the ADP.) ifend channel_mask_set: oct 17,17 " cam_cache_ext: " external entry for coreadd cache clear stz pds$temp_2 turn off wait flag lda ap|2,* PTW is passed in tsx7 cj1b merge with common code .rt: short_return " exit cam_cache: " entry to cam and clear cache stz pds$temp_2 turn off wait flag cj1a: lda core_add put core_add in pds als coreadd_to_ptw.ls shift to AU cj1b: ana ptw_add_mask,du mask extraneous bits sta pds$temp_1 eax0 0 set flag for PTW clear with cache tra cam_join_1 join common code cam_ext: push inhibit on <+><+><+><+><+><+><+><+><+><+><+><+> lxl1 prds$processor_tag get set for masking lprpab scs$mask_ptr,1 xec scs$read_mask,1 staq temp lxl1 prds$processor_tag we may have lost the processor lprpab scs$mask_ptr,1 ldaq scs$sys_level xec scs$set_mask,1 tsx7 cam join common code ldaq temp retrieve previous mask oraq channel_mask_set turn on all channel mask anaq scs$open_level turn off unconfigured channel mask bits lxl1 prds$processor_tag lprpab scs$mask_ptr,1 xec scs$set_mask,1 inhibit off <-><-><-><-><-><-><-><-><-><-><-><-> return cam: "camp and cams, clear all cache eax0 4 tra cam_join_0 set switch not to full Cam cam_with_wait_ext: stc1 pds$temp_2 " external entry issue a cam " and set scs$cam_wait eax7 .rt lda ap|2,* tra cj1b cam_with_wait: " entry from evict_page stc1 pds$temp_2 set wait flag tra cj1a cam_ptws_ext: " remove only PTWs from AMs eax7 .rt cam_ptws: eax0 2 cam_join_0: stz pds$temp_2 set no wait sw cam_join_1: nop 0,du allow for lockup fault reset, other CPU connect nop 0,du ditto inhibit on <+><+><+><+><+><+><+><+><+><+><+><+> lda prds$processor_pattern exclude this processor era =-1 .. ana scs$processor find which processors are running tnz hard_cam hard case, multiple processors ldx1 pds$temp_1 prepare for cache selective cam, if needed xed cam_table,0 execute proper type of cam tra 0,7 hard_cam: lda pds$processid lock the connect lock stac scs$connect_lock .. tnz cam_join_1 wait on other CPU without destroying x0, temp_2 szn pds$temp_2 see if waiting case tze wait_join tra if no lda prds$processor_pattern set flags for other processor(s) era =-1 .. ana scs$processor but not for this processor sta scs$cam_wait set key word in scs wait_join: eax0 0,0 test xr0 for coreadd case tze hard_cam_with_coreadd ldaq cam_table,0 access proper cams tra cam_join_2 hard_cam_with_coreadd: ldaq cam_other_for_cache get instructions for relocation ora pds$temp_1 insert selective clear addr cam_join_2: staq scs$cam_pair set up for all cpu's repeat: eax0 0 start counting with 0 ldq 0,dl keep track of array size lda prds$processor_pattern set up for all processors era =-1 except us ana scs$processor which are running nextp: stz scs$fast_cam_pending,0 clear cell just in case tpl missing processor not running or am us stc1 scs$fast_cam_pending,0 flag for cam/cache clear cioc scs$cow_ptrs,0* send connect missing: eax0 1,0 bump to next processor adq 4,dl bump array size in chars als 1 shift bit pattern to next cpu high tnz nextp more processors running xed scs$cam_pair clear our own inhibit off <-><-><-><-><-><-><-><-><-><-><-><-> lda 1000,dl bail-out of loop limit epplb scs$fast_cam_pending array of check-off cells wait: sba 1,dl one more loop tmi repeat try entire cycle again cmpc (),(pr,rl),fill(0) check entire array clear desc9a 0,0 desc9a lb|0,ql nop nop tnz wait all cells haven't cleared lda 0,dl clear the connect lock now ansa scs$connect_lock .. tra 0,7 even cam_table: "table of appropriate CAM pairs camp 4,1 "clear selective cache and ptws nop camp "clear just ptws nop camp "clear ptws cams 4 "and all cache cam_other_for_cache: camp 4 "clear selective cache and ptws nop 0,du " include pxss_page_stack include page_info end  core_queue_man.alm 11/11/89 1105.1r w 11/11/89 0803.9 56529 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " core_queue_man --- obscure program to " manage locks which manage the locking of locks. " Bernard Greenberg 12/06/76 " Modified for concurrent scheduler, RE Mullen 5/16/77 " " core queue is ordered queue of postings to be done, wich " could not be done because ptl was locked. Since all " ptl unlocking is done under cql, no requests are ever lost. segref page_fault,savex,unsavex,init_savex_bb,page_fault_error segdef disk_post,unlock_ptl,trylock_ptl,run_core_queue,clearout entry ptl_notify_return equ cq,1 include disk_post_queue " disk_post: push "args to stack.. lda ap|2,* sta core_add lda ap|4,* sta errcode tsx6 init_savex_bb eaq lock_and_done assume complicated entry lda pds$processid new mylock dones? cmpa sst|sst.ptl tnz *+2 go on with lock_and_done if ^= eaq page_fault$done_ tsx7 0,qu return " " - - - - - - - - - - - - - - - - - - - - - - - - - - " unlock_ptl: "from page fault... "push done, lp set, bb set, x7 is ret. tsx6 savex tra unlock_ptl_test_postq lock_and_done: tsx6 savex save x7 tsx7 trylock_ptl can we get the PTL? tra done_fails_ptl tra if not. do_the_done: tsx7 page_fault$done_ have ptl, will post unlock_ptl_test_postq: tsx7 looplock_cql grab the posting queue test_postq: tsx7 dequeue_posting see if posting to be done... tra unlock_ptl_real no, unlock ptl and cql. tsx7 unlock_cql unlock cql, there is posting, tra do_the_done and do it. " " Disk interrupt has failed to grab the PTL. " Enqueue the data from stack. " done_fails_ptl: tsx7 looplock_cql grab cql. This assures no-one can "unlock ptl until we unlock cql. tsx7 enqueue_posting tra queue_overflow no more room... looplock the ptl tsx7 trylock_ptl see if we can get ptl, for we have no guarantee that "ptl holder didnt go away right before "line at done_fails_ptl. tra *+2 "if ptl fails, guaranteed that enqueuement "will be picked up. tra test_postq "However, if we get it, we can now "do postings (both locks locked here.) tsx7 unlock_cql "don't have ptl, we deposited, so unlock cql tra unsavex and return. " " Queue overflown. Loop lock the PTL. " queue_overflow: aos cq|cq.overflows tsx7 unlock_cql done with cq tsx7 page_fault$lock_ptl_no_lp "this guy doesn't kid around. tra do_the_done " " Can now unlock ptl, for all posting is done, and anybody " who's trying to enqueue must wait for cql. " unlock_ptl_real: tsx7 actual_ptl_unlock_code he really, really does it. tsx7 unlock_cql szn sst|sst.ptl_wait_ct anybody wanna know? tze unsavex no, return to caller of core_queue_man " " Notify single PTL waiting process via pxss. " tra pxss$ptl_notify which returns to cqm$ptl_notify_return ptl_notify_return: epp sst,sst$ for luck .. tra unsavex return to call of core_queue_man " " Entry to make sure this thing isn't stuck. " The thing is called from dvctl$run with the " entire pc environment set up and the ptl locked " during the entire exercise. " " run_core_queue: tsx6 savex run_core_queue_loop: tsx7 looplock_cql tsx7 dequeue_posting tra run_core_queue_done tsx7 unlock_cql tsx7 page_fault$done_ do the done tra run_core_queue_loop run_core_queue_done: tsx7 unlock_cql tra unsavex " " Entry to clear the thing out at ESD time to validate " assumptions of pc_recover_sst (no "fatal_error in done!") " clearout: epp cq,disk_post_queue_seg$ stz cq|cq.lock stz cq|cq.put_ptr stz cq|cq.get_ptr stz cq|cq.number_in_queue tra 0,7 " " " Coreadd queue management. " looplock_cql: "must be looplock to avoid "russian doll lock syndrome. rccl sys_info$clock_,* staq temp epp cq,disk_post_queue_seg$+0 aos cq|cq.lockings lda pds$processid stac cq|cq.lock tze *+5 nop nop nop tnz *-5 cmpa cq|cq.lock never trust this hw tze *+2 tsx5 page_fault_error "ERROR - MYLOCK ON DISK POST QUEUE rccl sys_info$clock_,* staq temp1 save for under-lock metering sbaq temp adaq cq|cq.looplock_time staq cq|cq.looplock_time tra 0,7 unlock_cql: epp cq,disk_post_queue_seg$+0 NO CHANCES rccl sys_info$clock_,* sbaq temp1 adaq cq|cq.process_time staq cq|cq.process_time ldq pds$processid cmpq cq|cq.lock tze *+2 tsx5 page_fault_error "ERROR - STAC FAILS DISK POST QUEUE eaa 0 stacq cq|cq.lock tze *+2 tsx5 page_fault_error "ERROR - UNLOCK ERR DISK POST QUEUE cmpq cq|cq.lock tnz 0,7 tsx5 page_fault_error "ERROR - STACQ HW FAILS DISK POST QUEUE " " " Enqueue and dequeue. cq -> seg. " enqueue_posting: ldq cq|cq.number_in_queue cmpq cq_limit,dl all full? tpl 0,7 error exit aos cq|cq.queueings meter aos cq|cq.number_in_queue ldx1 cq|cq.put_ptr lda core_add ldq errcode staq cq|cq.queue,1 eax1 2,1 cmpx1 2*cq_limit,du tmi *+2 eax1 0 stx1 cq|cq.put_ptr tra 1,7 dequeue_posting: szn cq|cq.number_in_queue tze 0,7 exit no stuff lcq 1,dl asq cq|cq.number_in_queue tpl *+2 tsx5 page_fault_error "ERROR - DISK POST QUEUE CT NEGATIVE ldx1 cq|cq.get_ptr ldaq cq|cq.queue,1 sta core_add stq errcode eax1 2,1 cmpx1 2*cq_limit,du tmi *+2 eax1 0 stx1 cq|cq.get_ptr tra 1,7 " " " Real page_table lockery. " trylock_ptl: lda pds$processid cmpa sst|sst.ptl tze page_error$ptl_mylock stac sst|sst.ptl tnz 0,7 fail cmpa sst|sst.ptl tze 1,7 tsx5 page_fault_error "ERROR - STAC FAILS PTL " " Real page_table_lock unlockery " actual_ptl_unlock_code: ldq pds$processid lda 0,dl stacq sst|sst.ptl unlock it tze *+2 tsx5 page_fault_error "ERROR - PTL UNLOCK FAILS nop cmpq sst|sst.ptl double-check hw tnz 0,7 tsx5 page_fault_error "ERROR - PTL STACQ HW FAILS " include sst include pxss_page_stack include page_info end  dctl.alm 11/11/89 1105.1r w 11/11/89 0804.0 373239 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979), " audit(86-01-27,CLJones), install(86-03-21,MR12.0-1033): " Add support for dev 0 FIPS. " 2) change(86-05-29,Fawcett), approve(86-05-29,MCR7383), " audit(86-05-30,Coppola), install(86-07-17,MR12.0-1097): " Add code for MSU3380 and MSU3390 support. This code supports the " division of the devices into subvolumes. Also read 512 word sectors are " supported by only doing 512_word seek command (30 oct). Multics will not " support 64_seeks for these devices. " 3) change(86-09-10,Farley), approve(86-10-24,MCR7544), " audit(86-10-27,Fawcett), install(86-10-28,MR12.0-1200): " Added change to properly shift the TEST I/O command in the A-reg before " storing in chantab.rssdcw. " END HISTORY COMMENTS name dctl " dctl - fast path for disk control, coded in ALM for obvious reasons " " Written sometime by someone (possibly Mullen) " Modified by Fawcett 1979 for shared stack frames " Modified back by Hornig December 1980 " Modified March 1981 by J. Bongiovanni to add entry queue_length_given_pvtx " Modified July, 1981, WOS, to implement Mike Jordan's fix to the 501 sector number " overflow problem (too many sectors to represent in 20 bits). " Modified February 1982 by C. Hornig for MR10 io_manager. " Modified March 1982 by J. Bongiovanni to remove queue_length_given_pvtx " (moved to disk_control) and for new PVTE " Modified March 1982 by C. Hornig to unload disks. " Modified July 1982 by J. Bongiovanni for read_sectors, write_sectors " Modified April 1984 by T. Oke for system wide free_q. " Modified April 1984 by T. Oke for dynamic channel table and the use of " dskdcl_chans_per_subsys to define channel idx/subsystem relation. " Modified May 1984 by T. Oke to add pvtx in queue entry for azm analysis " of queue. " Modified May 1984 by T. Oke to install adaptive optimization, modifying " the quentry structure. " Modified Nov 26,1984 by R. A. Fawcett to suppoer dev 0 (fips). " Modified February 1985 by Keith Loepere to re-install bootload_read/write " which was broken by one of the above recently named. " Modified April 1985 by R. A. Fawcett to support real 512 work IO for 3380's. " Modified July 1985 by R. A. Fawcett to support sub-volumes on 3380/3390's " ============================================================================ tempd int_arg_list tempd meter_start_time,status_time,entry_time,test_time tempd ptp,mask Used for pmut$wire_and_mask tempd arglist(3) tempd listp tempd ima(8) temp coreadd temp sect_off,record_offset temp devadd temp errcd temp real_device temp sect_sw Uses upper bit (sign) to indicate sect temp bootload_sw Ditto for bootload temp sx Subsystem index in DL temp pvtx temp dev temp sector temp cylinder temp io_type Io type stored in DL temp masked Non-zero if call side running masked temp intrpt Caller requested interrupt on complete temp temp1 temp switches temp best_seek Also is best_pos_comb temp comb_qp DU has forward comb qp, DL has reverse temp best_neg_comb temp n_sectors,n_sectors_temp " entry disk_inter entry disk_read entry disk_write entry bootload_read entry bootload_write entry read_sectors entry write_sectors " REGISTER USAGE: " bb -> disk_seg base, disk_data " bp -> disktab, per subsystem info " ap -> chantabe " lb -> pvte, DCW list, devtabe (when opt_info access needed) " x0 = pdi " x1 temp " x2-> devtab " x3-> quentry " x4 temp " x5 temp " x6 call savex (top level calls) " x7 calls (lower level) " The ALM assembler must border on the least friendly assembler known " to man. So some techniques are in force through this program to aid " in the detection of error conditions due to movement of structure " contents. " Specifically there is quite a bit of use of the construction: " " equ quentry.coreadd_shift,0 " " This construction will cause an error if the value of the shift is not " zero, AS WE ARE PRESUMING IT TO BE. Thus we can produce fast code, with " extra supurflous instructions removed, but still detect if they would be " necessary if things move. Hopefully these little checks will do someone " good in the future. equ MUST_BE_ZERO,0 Used for 0 check " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " CALL SIDE OF DISK DIM -- various entries " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write_sectors: push ldx4 VTOC_WRITE,du tra go_sector read_sectors: push ldx4 VTOC_READ,du tra go_sector bootload_read: push ldx4 BOOTLOAD_READ,du tra go_sector bootload_write: push ldx4 BOOTLOAD_WRITE,du tra go_sector go_sector: sxl4 io_type lda ap|10,* pick up number of sectors sta n_sectors ldq ap|8,* pick up sect_off arg stq sect_off stz intrpt clear interrupt desired ldq bootload_mapping,du " IO type still in x4 qls 0,x4 tpl go_vtoc stz masked tra go_common " wire stack frame for vtoc_man go_vtoc: epplb mask sprilb arglist+2 epplb ptp sprilb arglist+4 ldaq two_args_nd staq arglist call pmut$wire_and_mask(arglist) lda 1,dl sta masked in masked environment tra go_common disk_write: push ldx4 PAGE_WRITE,du tra go_page disk_read: push ldx4 PAGE_READ,du go_page: sxl4 io_type stz n_sectors stz sect_off sect_off = 0 stz masked not in masked environment stz intrpt lda ap|8,* pick up priority arg tze no_intrpt intrpt="0"b lda quentry.intrpt,du intrpt=quentry.intrpt no_intrpt: sta intrpt go_common: " Common command interface lda ap|4,* als 12 MASK FOR COREADD arl 12 sta coreadd lda ap|6,* arl 18 sta devadd rccl sys_info$clock_,* get entry time for stats staq entry_time GET PVTE for device epplb pvt$array ldq ap|2,* get pvtx stq pvtx save for queue entry mpy pvte_size,dl epplb lb|-pvte_size,ql HENCEFORTH lb -> PVTE lda lb|pvte.dim_info arl pvtdi.sx_shift sta sx tsx7 setup eax4 disktab.call_lock_meters specify lock reason tsx7 lock ldq lb|pvte.logical_area_number_word qrl pvte.logical_area_number_shift """"" anq pvte.logical_area_number_mask,dl This mask bigger than next anq quentry.dev_mask,dl stq dev device in sub-sys ldx2 devtab_subs,ql subscript devtab ldq bp|devtab.pdi_word,x2 devtab.pdi equ devtab.pdi_shift,0 PRESUMED 0 """"" qrs devtab.pdi_shift anq devtab.pdi_mask,dl eax0 0,ql HENCEFORTH X0 = pdi ldx2 devtab_subs,x0 subscript devtab eax2 bp|0,x2 HENCEFORTH X2->devtab " The following code is out, since we will try the abandoned device " will get an error return, and it will be handled by disk_control " error processing. Thus disk_control eventually finds out. """"" lda bb|devtab.abandoned_word,x2 """"" cana devtab.abandoned,du """"" tnz ABANDONED " Allocate a quentry for this operation aos bp|disktab.alloc_wait_meters+disk_lock_meters.count tsx7 get_free_q HENCEFORTH X3->quentry arg got_fq get_free_q success "Failed to find free quentry. Call RUN. eax4 disktab.alloc_wait_meters meter this time as alloc wait tsx6 lock_meter_start retry_get_fq: tsx7 get_free_q arg retry_got_fq eppap sx spriap arglist+2 ldaq one_arg_nd staq arglist call disk_control$call_run(arglist) tra retry_get_fq retry_got_fq: eax4 disktab.alloc_wait_meters time metered as alloc wait tsx6 lock_meter_stop Compute cylinder and sector -- remember them in stack got_fq: ldq devadd lda lb|pvte.is_sv_word cana pvte.is_sv,du tze not_subvol " pvte does not define sv " div lb|pvte.records_per_cyl sta record_offset ldq devadd sblq record_offset mpy lb|pvte.num_of_svs adlq lb|pvte.record_factor adlq record_offset not_subvol: lda lb|pvte.device_type_word arl pvte.device_type_shift ana pvte.device_type_mask,dl eax1 0,al mpy sec_per_rec,x1 " mpy by 16 for 64 word io and 2 for 512 word io stq sector lda lb|pvte.dim_info ars pvtdi.usable_sect_per_cyl_shift ana pvtdi.usable_sect_per_cyl_mask,dl sta temp1 div temp1 into sector in Qreg stq cylinder ldq lb|pvte.dim_info equ pvtdi.unused_sect_per_cyl_shift,0 PRESUMED = 0 """""" qrs pvtdi.unused_sect_per_cyl_shift anq pvtdi.unused_sect_per_cyl_mask,dl mpy cylinder adq sect_off asq sector " Fill in quentry contents " quentry.intrpt, used, type, coreadd " PRESUMES that type,intrpt,used and coreadd are in the same quentry word. equ quentry.type_word,1 All presumed in word 1 equ quentry.intrpt_word,1 equ quentry.used_word,1 equ quentry.coreadd_word,1 equ MUST_BE_ZERO,quentry.coreadd_shift lda io_type als quentry.type_shift get io_type of operation ora intrpt Set interrupt flag ora quentry.used,du indicate entry is used ora coreadd presume shift is 0 sta bb|quentry.type_word,x3 " quentry.pvtx, pdi, dev, cylinder " PRESUMES that pvtx,cylinder,dev and pdi are in the same quentry word. equ quentry.pvtx_word,2 Presumed in word 2 equ quentry.pdi_word,2 equ quentry.dev_word,2 equ quentry.cylinder_word,2 equ MUST_BE_ZERO,quentry.cylinder_shift lda pvtx als quentry.pvtx_shift ora cylinder presume cylinder shift is 0 sta bb|quentry.pvtx_word,x3 eaa 0,x0 pdi from X0 als quentry.pdi_shift-18 orsa bb|quentry.pdi_word,x3 lda dev als quentry.dev_shift orsa bb|quentry.dev_word,x3 " quentry.n_sectors, sector " PRESUMES that n_sectors and sector are in the same quentry word. equ quentry.n_sectors_word,3 Presume in word 3 equ quentry.sector_word,3 equ MUST_BE_ZERO,quentry.sector_shift lda n_sectors als quentry.n_sectors_shift ora sector include sector number sta bb|quentry.sector_word,x3 " Fill in queued time. ldaq entry_time staq bb|quentry.time,x3 " "Provided the disk dim is functioning correctly on the interrupt side "then if there are already requests queued for this device "then there is no chance we can immediately issue a connect for this request. "Therefore we merely queue the request and return. "The same is true if the device is busy already. "On the other hand if the device is neither busy nor has a queue already "then if there is a free channel then we need not even add the quentry "to the queue, but instead issue the connect forthwith. " X3 -> quentry, X0 = pdi, X2 -> devtab (pdi) ldaq bp|disktab.dev_busy oraq bp|disktab.dev_queued lls 0,x0 X0 has PDI .. tmi call_side_queues this PDI is busy or queued ldx4 bp|disktab.channels find dynamic table eppap bb|0,x4 AP -> (first)chantabe lxl4 bp|disktab.nchan tze call_side_queues no channels exist - queue it ldaq channel_criteria bit and mask for testing call_chan_loop: cmk ap|chantab.in_use_word tze call_side_connects channel available - use it eppap ap|chantab_size try next channel eax4 -1,x4 if there is another channel tpnz call_chan_loop " Add to existing work queue for device and fast return call_side_queues: " io_type (DL) must be good tsx7 add_wq tra working " Have channel and no queued requests for idle device - send it work call_side_connects: tsx7 gotwork working: tsx7 unlock unlock and return szn masked see if we are masked tze unwired " We are wired and must clear wiring before return epplb mask sprilb arglist+2 epplb ptp sprilb arglist+4 ldaq two_args_nd staq arglist call pmut$unwire_unmask(arglist) unwired: return "for ldaq/cmk above:A has bits desired, Q has 1bits to mask dont-care bits "we require a channel which is in-use, and not-active even channel_criteria: zero 0,chantab.in_use zero -1,-chantab.in_use-chantab.active-1 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " SETUP -- called with sx in Areg " makes bb->disk_seg " makes bp->devtab " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " setup: eppbb disk_seg$ als 1 eppbp bb|disk_data.array-2,al* tra 0,7 setup returns " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " LOCK -- locks bp->disktab (ie a subsystem) " called with x4->metercells " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock: aos bp|disk_lock_meters.count,x4 lda pds$processid stac bp|disktab.lock lock subsystem lock tze 0,x7 lock ret1 tsx6 lock_meter_start lda pds$processid lockloop: stac bp|disktab.lock tze lockgot llr 72 llr 72 llr 72 llr 72 tra lockloop lockgot: tsx6 lock_meter_stop tra 0,x7 lock ret2 " " LOCK_METER_START - called via X6, X4 must specify lock reason " lock_meter_start: rccl sys_info$clock_,* staq meter_start_time aos bp|disk_lock_meters.waits,x4 tra 0,x6 " " LOCK_METER_STOP -called via X6, X4 must specify lock reason " lock_meter_stop: rccl sys_info$clock_,* sbaq meter_start_time adaq bp|disk_lock_meters.wait_time,x4 staq bp|disk_lock_meters.wait_time,x4 tra 0,x6 " " UNLOCK -- unlocks bp->disktab " unlock: lda pds$processid DEBUG cmpa bp|disktab.lock DEBUG tze *+2 oct 04 DEBUG Die Die Die eaa 0 ansa bp|disktab.lock tra 0,x7 unlock ret " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " GET_FREE_Q -- called with bp->disktab " sets x3->quentry " note indirect return if sucessful, direct if fail!! " " uses X4, X5, A " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " even lock_disk_data.wait: llr 72 Read/Alter/Rewrite delay llr 72 llr 72 llr 72 lock_disk_data: lda pds$processid stac bb|disk_data.lock lock disk_data tze 0,x4 return to caller tra lock_disk_data.wait " Unlock disk_data. Ensures write notification. unlock_disk_data: lda pds$processid DEBUG cmpa bb|disk_data.lock DEBUG tze *+2 oct 04 DEBUG Die Die Dia eaa 0 ansa bb|disk_data.lock tra 0,x4 unlock ret get_free_q: tsx4 lock_disk_data ldx3 bb|disk_data.free_q+qht.head tze gfq_bret bad unlock and return ldx4 bb|quentry.next,x3 make head point to next stx4 bb|disk_data.free_q+qht.head set head tze gfq_kill_tail kill tail if no next ldx5 0,du make an 18-bit zero sxl5 bb|quentry.prev,x4 kill new head's prev tra gfq_do_stats gfq_kill_tail: sxl4 bb|disk_data.free_q+qht.tail kill tail " Compile statistics. gfq_do_stats: lxl5 bb|disk_data.free_q+qht.depth eaa 0,x5 ars 18 asa bb|disk_data.free_q+qht.sum accumulate depth sum adx5 1,du increment depth counter sxl5 bb|disk_data.free_q+qht.depth cmpx5 bb|disk_data.free_q+qht.max_depth tmoz gfq_no_max_depth not maximum depth seen stx5 bb|disk_data.free_q+qht.max_depth gfq_no_max_depth: aos bb|disk_data.free_q+qht.count " unlock disk_data and return good tsx4 unlock_disk_data tra 0,x7* gfq_bret: tsx4 unlock_disk_data unlock disk_data tra 1,x7 gfq failure ret " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " ADD_FREE_Q -- add X3->quentry to queue " " Uses X4, X5 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " even add_free_q: tsx4 lock_disk_data lxl5 bb|disk_data.free_q+qht.tail X5->oldtail tze afq_empty was none! stx3 bb|quentry.next,x5 make old_tail -> new_tail tra afq_any afq_empty: stx3 bb|disk_data.free_q+qht.head was empty, make new head " make this entry's prev point to old tail afq_any: sxl5 bb|quentry.prev,x3 set this prev to old tail sxl3 bb|disk_data.free_q+qht.tail set tail ptr eax5 0 stx5 bb|quentry.next,x3 make newtail's next->nil " Account for returned element lxl5 bb|disk_data.free_q+qht.depth subtract for return sbx5 1,du sxl5 bb|disk_data.free_q+qht.depth tsx4 unlock_disk_data unlock disk_data tra 0,x7 add_q ret " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " ADD_WQ -- add X3->quentry to queue " " X2-> devtab (pdi), X0 = pdi " Uses X1, X4, X5, EAQ and lb " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " add_wq: lda =o400000,du set requests queued for dev ldq 0,du lrl 0,x0 orsa bp|disktab.dev_queued orsq bp|disktab.dev_queued+1 " add to work queue lxl5 bb|devtab.wq+qht.tail,x2 X5->oldtail tze aq_empty was none! stx3 bb|quentry.next,x5 make old_tail -> new_tail tra aq_any aq_empty: stx3 bb|devtab.wq+qht.head,x2 was empty, make new head aq_any: sxl5 bb|quentry.prev,x3 set this prev to old tail sxl3 bb|devtab.wq+qht.tail,x2 set tail ptr eax5 0 stx5 bb|quentry.next,x3 make newtail's next->nil " Compile statistics for queue loading. lxl5 bb|devtab.wq+qht.depth,x2 eaa 0,x5 ars 18 asa bb|devtab.wq+qht.sum,x2 accumulate depth sum adx5 1,du increment depth sxl5 bb|devtab.wq+qht.depth,x2 cmpx5 bb|devtab.wq+qht.max_depth,x2 tmoz gq_no_max_depth not maximum depth seen stx5 bb|devtab.wq+qht.max_depth,x2 gq_no_max_depth: aos bb|devtab.wq+qht.count,x2 " compile system load stats. Presumes io_type (DL) is good. tsx4 lock_disk_data ensure counter is ours lxl1 io_type ldx5 sys_info_subs,x1 x5 is sysp offset ldx4 bb|sys_info.depth_map,x5 get mapped counter fld bb|0,x4 increment depth fad =1.0,du fst bb|0,x4 " Produce sys_info.fraction. -(float (depth) - max_depth)/max_depth fsb bb|sys_info.max_depth,x5 fneg tpl gq_pos_fraction fraction is positive fld =0.0,du limit to 0.0 gq_pos_fraction: fdv bb|sys_info.max_depth,x5 fst bb|sys_info.fraction,x5 tsx4 unlock_disk_data clear disk_data lock " Produce multiplier. -(float (depth) * slope) + intercept " Final opt_info.multiplier is max (1.0, multiplier * sys_info.fraction) lxl4 opt_info_subs,x1 x4 is optp offset in devtab epplb bb|0,x2 pointer to devtab aos lb|opt_info.depth,x4 increment device depth lda lb|opt_info.depth,x4 als 18 clear high stuff lrs 72-18 float opt_info.depth lde =71b25,du fno fmp lb|opt_info.slope,x4 fneg fad lb|opt_info.intercept,x4 fmp bb|sys_info.fraction,x5 * fraction fst lb|opt_info.multiplier,x4 fcmp =1.0,du max (multiplier, 1.0) tpl 0,x7 add_q return fld =1.0,du fst lb|opt_info.multiplier,x4 set to 1.0 tra 0,x7 add_q return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " DEL_Q -- called with x3->quentry " " Uses X1, X4, X5, EAQ, lb " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " del_q: ldx4 bb|quentry.next,x3 get next pointer lxl5 bb|quentry.prev,x3 is if head is previous tnz dq_mid stx4 bb|devtab.wq+qht.head,x2 save new head tra dq_head_done dq_mid: stx4 bb|quentry.next,x5 set previous's next dq_head_done: cmpx4 0,du test zero/non-zero tnz dq_not_tail sxl5 bb|devtab.wq+qht.tail,x2 update tail tra dq_tail_done dq_not_tail: sxl5 bb|quentry.prev,x4 update next's previous " Compile queue loading statistics dq_tail_done: lxl5 bb|devtab.wq+qht.depth,x2 decrement current depth sbx5 1,du sxl5 bb|devtab.wq+qht.depth,x2 tpnz dq_with_queue lda =o400000,du turn off device_queued bit ldq 0,du lrl 0,x0 X0 has PDI eraq all_ones form mask ansa bp|disktab.dev_queued ansq bp|disktab.dev_queued+1 " compile system load stats. dq_with_queue: lda bb|quentry.type_word,x3 get type of IO ars quentry.type_shift ana quentry.type_mask,dl eax1 0,al save for opt_info subs tsx4 lock_disk_data lock for system update ldx5 sys_info_subs,x1 x5 is sysp offset ldx4 bb|sys_info.depth_map,x5 get mapped counter fld bb|0,x4 increment depth fsb =1.0,du tpl dq_pos_depth Must stay positive fld =0.0,du dq_pos_depth: fst bb|0,x4 " Produce sys_info.fraction. -(float (depth) - max_depth)/max_depth fsb bb|sys_info.max_depth,x5 fneg tpl dq_pos_fraction fraction is positive fld =0.0,du limit to 0.0 dq_pos_fraction: fdv bb|sys_info.max_depth,x5 fst bb|sys_info.fraction,x5 tsx4 unlock_disk_data " Produce multiplier. -(float (depth) * slope) + intercept " Final opt_info.multiplier is max (1.0, multiplier * sys_info.fraction) lxl4 opt_info_subs,x1 x4 is optp offset in devtab epplb bb|0,x2 pointer to devtab lxl1 lb|opt_info.depth,x4 decrement depth sbx1 1,du sxl1 lb|opt_info.depth,x4 eaa 0,x1 load into high A lrs 72-18 float opt_info.depth lde =71b25,du fno fmp lb|opt_info.slope,x4 fneg fad lb|opt_info.intercept,x4 fmp bb|sys_info.fraction,x5 * sys_info.fraction fst lb|opt_info.multiplier,x4 fcmp =1.0,du max (multiplier, 1.0) tpl 0,x6 add_wq return fld =1.0,du fst lb|opt_info.multiplier,x4 max to 1.0 tra 0,x6 add_wq_return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " GETWORK -- find something to do. " enter at gotwork if you already know what to do. " " ap->chantabe " bb->disk_seg " bp->disktab " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " getwork: lda ap|chantab.in_use_word Return if channel not in use cana chantab.in_use,dl tze gw_ret ldaq bp|disktab.dev_queued See if any PDI with queue is not busy cnaaq bp|disktab.dev_busy Z = AQ & ^Y-pair tze gw_ret Return if nothing to do " Scan through all devices round-robin til one is found which is not " busy, and has a queue. We are looking at the primary device to " determine not_busy and queued. lxl5 bp|disktab.last_dev get high drive number stx5 temp1 in upper for cmpx rccl sys_info$clock_,* get time for stagnate test staq test_time gw_dev.scan: aos bp|disktab.dev_index device to examine lxl4 bp|disktab.dev_index cmpx4 temp1 see if over-run tmoz gw_dev.in_range ldx4 bp|disktab.first_dev reset index to first dev sxl4 bp|disktab.dev_index gw_dev.in_range: ldx4 devtab_subs,x4 subscript devtab (dev) ldq bp|devtab.pdi_word,x4 get PDI equ devtab.pdi_shift,0 PRESUMED 0 """"" qrs devtab.pdi_shift anq devtab.pdi_mask,dl eax0 0,ql X0 is PDI ldaq bp|disktab.dev_busy see if PDI is busy lls 0,x0 tpl gw_dev.not_busy free for use gw_dev.check_done: sbx5 1,du count dev done cmpx5 bp|disktab.first_dev more to scan tpl gw_dev.scan tra gw_ret done sub-system " See if broken or without queue. gw_dev.not_busy: ldx4 devtab_subs,x0 subscript devtab (pdi) eax2 bp|0,x4 X2->DEVTABE lxl4 bb|devtab.wq+qht.depth,x2 test depth of queue tze gw_dev.check_done no work to do ldq bb|devtab.broken_word,x2 see if usable anq devtab.broken,du tnz gw_dev.check_done skip this one ldx3 bb|devtab.wq+qht.head,x2 get head of queue cmpx4 1,dl tze gw_dev.this_request take the only request lda bb|disk_data.stagnate_time see if we are stagnating lrs 36 full 71 bit time adaq bb|quentry.time,x3 plus queued time sbaq test_time minus time now tpl gw_dev.seek optimized nearest seek " " COMB DEVICE FOR BEST REQUEST " X0 = pdi " X1 temp " X2 -> devtabe " X3 -> best_quentry " X4 temp " bb -> disk_seg " bp -> disktab " ap -> chantabe " gw_dev.comb: aos bb|devtab.comb,x2 count a comb done lda =o400000,du best_neg_comb sta best_neg_comb lda =o377777,du best_pos_comb sta best_seek stz comb_qp flag no best yet comb.scan: ldq bb|devtab.forward_word,x2 see if moving forward lda bb|quentry.cylinder_word,x3 get queued cylinder ana quentry.cylinder_mask sba bb|devtab.cylinder,x2 tze gw_dev.this_request take on-cylinder request anq devtab.forward,du see if forward tnz comb.forward yes - use queue-device neg " use device-queue comb.forward: cmpa 0,dl test direction tmi comb.move_reverse " This move would be in the current direction. comb.move_forward: cmpa best_seek see if shorter move tpl comb.skip longer move sta best_seek stx3 comb_qp save forward best tra comb.skip " This move would reverse our direction. comb.move_reverse: cmpa best_neg_comb see if shorter move tmi comb.skip longer move sta best_neg_comb sxl3 comb_qp save reverse best " tra comb.skip " Continue scan of queue. comb.skip: ldx3 bb|quentry.next,x3 get next element tnz comb.scan continue scan ldx3 comb_qp see if forward was found tnz gw_dev.this_request yes - do it lxl3 comb_qp take reverse which must be here tra gw_dev.this_request " " FIND SHORTEST LOGICAL SEEK ON DEV " X0 = pdi " X1 = best_qp " X2 -> devtabe " X3 -> best_quentry " X4 temp " bb -> disk_seg " bp -> disktab " ap -> chantabe " lb -> devtabe " gw_dev.seek: fld =1.0e30,du high set best_seek fst best_seek eax1 0,x3 best_qp epplb bb|0,x2 form devtabe pointer seek.scan: lda bb|quentry.type_word,x3 get type of request ars quentry.type_shift ana quentry.type_mask,dl lxl5 opt_info_subs,al subscript opt_info lda bb|quentry.cylinder_word,x3 find cylinder move ana quentry.cylinder_mask,dl sba lb|devtab.cylinder tze gw_dev.this_request on-cylinder tpl seek.pos take absolute neg seek.pos: lrs 36 float lde =71b25,du fno fmp lb|opt_info.multiplier,x5 * multiplier fcmp best_seek see if best seek tpl seek.worse this one is worse eax1 0,x3 save this entry as best fst best_seek and the length seek.worse: ldx3 bb|quentry.next,x3 check next entry tnz seek.scan " The best seek is noted in X1, move to X3 and use it. eax3 0,x1 gw_dev.this_request: tsx6 del_q delete this request from Q " tra xfer_join " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " GOTWORK -- XFER JOIN process a quentry " X0 = pdi " X2 -> devtabe (from pdi) " X3 -> quentry " X5 -> devtabe for actual device " X7 is return address " bb -> disk_seg " bp -> disktab " ap -> chantabe " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " equ chantab.erct_shift,0 PRESUME=0 gotwork: xfer_join: lda -chantab.erct_mask-1,dl clear error count and qrp ansa ap|chantab.erct_word zero qrp,erct leave command stx3 ap|chantab.qrp save quentry index for later lda bb|quentry.dev_word,x3 ars quentry.dev_shift ana quentry.dev_mask,dl sta dev save device number als idcw.device_shift position dev in AU " dev value in AU is used in gw_testing below. equ quentry.used_word,quentry.type_word ldq bb|quentry.used_word,x3 canq quentry.used,du DEBUG tnz *+2 oct 04 DEBUG Die Die Die qrs quentry.type_shift anq quentry.type_mask,dl eax4 0,ql io_type to x4 cmpq TEST,dl See if TEST io tze gw_testing stca ap|chantab.scdcw,20 use dev in AU ora =o740000,dl (dcdcw) idcw.code=7 idcw.ext_ctl=1 sta ap|chantab.dcdcw lxl5 dev get device ldx5 devtab_subs,x5 subscript devtab eax5 bp|0,x5 HENCE x5 -> real devtabe " Determine if write IO by shifting the mask lda write_mapping,du als 0,ql io_type still QL tpl gw_read if positive then read lda =o310000,du tra gw_rw_done gw_read: lda =o250000,du gw_rw_done: stca ap|chantab.dcdcw,40 I believe an orsa would do "dcdcwp->idcw.ext = quentry.coreadd lda bb|quentry.coreadd_word,x3 equ MUST_BE_ZERO,quentry.coreadd_shift PRESUMPTION stca ap|chantab.dcdcw,10 "dddcwp->dcw.address = substr (quentry.coreadd,7) als 18 stba ap|chantab.dddcw,60 lda bb|quentry.sector_word,x3 leave sector in A for gw_put_seldata als 36-quentry.n_sectors_shift mask for sectors arl 36-quentry.n_sectors_shift sta ap|chantab.select_data " Check for 64 or 512 type seek use x1 ldx1 ap|chantab.scdcw bool seek_64_bit,040000 "34 = seek_64 (normal) 30 = seek_512 (ibm) anx1 seek_64_bit,du tnz seek_64 " bit was on seek_512: " Check io type for file system standards cmpx4 VTOC_WRITE,du tpnz not_stan cmpx4 PAGE_WRITE,du tmoz page_512 ora 000100,du stca ap|chantab.select_data,20 " store sector limit ldq 192,dl " real vtoce size stcq ap|chantab.dddcw,03 " store tally tra seek_stats page_512: ora 000200,du stca ap|chantab.select_data,20 " store sector limit ldq 1024,dl stcq ap|chantab.dddcw,03 " store tally tra seek_stats not_stan: ldq sector_mapping,du io_type still in X4 qls 0,x4 tpl not_sect_512 if positive then not sector " Formulate tally and select_data.limit 512 ldq bb|quentry.n_sectors_word,x3 qrl quentry.n_sectors_shift stq n_sectors qls chantab.limit_shift align for sector limit stq n_sectors_temp ada n_sectors_temp n_sectors + sector ldq n_sectors qls 9 times 512 tra sect_done_512 not_sect_512: ldq 1024,dl page size is 1024 words ada =o000200,du add in limit bit sect_done_512: stcq ap|chantab.dddcw,03 store tally put_seldata_512: sta ap|chantab.select_data tra seek_stats seek_64: ldq sector_mapping,du io_type still in X4 qls 0,x4 tpl gw_not_sect if positive then not sector Formulate tally and select_data.limit ldq bb|quentry.n_sectors_word,x3 qrl quentry.n_sectors_shift stq n_sectors qls chantab.limit_shift align for sector limit stq n_sectors_temp ada n_sectors_temp n_sectors + sector ldq n_sectors qls 6 times 64 tra gw_sect_done gw_not_sect: ldq 1024,dl page size is 1024 words ada =o002000,du add in limit bit gw_sect_done: stcq ap|chantab.dddcw,03 store tally gw_put_seldata: sta ap|chantab.select_data " Formulate seek statistics and seek direction. seek_stats: epplb bb|0,x5 form devtab (dev) pointer lxl4 opt_info_subs,x4 get opt_info subscript in devtab lda bb|quentry.cylinder_word,x3 get quentry.cylinder ana quentry.cylinder_mask,dl sta cylinder sba bb|devtab.cylinder,x2 subtract devtab.cylinder tze gw_seek_done on-cylinder retain forward tpl gw_seek_fwd seek from low to high gw_seek_back: " seek from high to low lcx1 devtab.forward+1,du clear forward bit ansx1 bb|devtab.forward_word,x2 neg " take absolute cylinder move tra gw_seek_done gw_seek_fwd: ldq devtab.forward,du orsq bb|devtab.forward_word,x2 gw_seek_done: asa lb|opt_info.seek_sum_word,x4 sum seek lengths aos lb|opt_info.seek_count_word,x4 count seek done lda cylinder sta bb|devtab.cylinder,x2 epplb ap|chantab.scdcw " Perform the operation tsx6 connect gw_ret: tra 0,x7 "TESTING HERE -- note dev for idcw in AU gw_testing: stca ap|chantab.rssdcw,20 use dev in AU lda bb|quentry.coreadd_word get command from coreadd ana idcw.command_mask,dl mask for command als 30 shift to bits 0 - 5 stca ap|chantab.rssdcw,40 in IDCW " Statistics for TEST - io_type in X4 epplb bb|0,x5 devtab (dev) pointer lxl4 opt_info_subs,x4 convert type to subscript cmpa 58,dl tze gw_testing.unload aos lb|opt_info.seek_count_word,x4 TEST tra gw_testing.connect gw_testing.unload: aos lb|opt_info.seek_sum_word,x4 UNLOAD gw_testing.connect: epplb ap|chantab.rssdcw tsx6 connect tra gw_ret " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " CONNECT -- called via tsx6 " " X0 = pdi " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " even one_arg_nd: zero 2,4 zero 0 two_args_nd: zero 4,4 zero 0 nullptr: its -1,1 " ********* " " LB -> DCW list " connect: sprilb ima+io_manager_arg.listp lda ap|chantab.chx sta ima+io_manager_arg.chx stz ima+io_manager_arg.pcw ldaq nullptr staq ima+io_manager_arg.ptp ldaq one_arg_nd staq arglist epplb ima sprilb arglist+2 call io_manager$connect_abs(arglist) aos ap|chantab.connects lda chantab.active,dl orsa ap|chantab.active_word rccl sys_info$clock_,* staq ap|chantab.connect_time lda =o400000,du ldq 0,du lrl 0,x0 leave PDI-th bit on orsa bp|disktab.dev_busy orsq bp|disktab.dev_busy+1 tra 0,x6 connect retns " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " DISK_INTER -- the interrupt side of the disk_dim " This proc only processes the easy cases, those " which do not involve errors or syserr messeage production. " It is assumed that if this procedure did not exist, the " pl1 version of the disk_dim could handle all cases " properly. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " evil_status_bits: oct 002300000000 even simple_interrupt_criteria: zero 0,chantab.active zero -1,-chantab.active-chantab.ioi_use-chantab.rsr-1 even all_ones: vfd 36/-1 vfd 36/-1 even time_mod: dec 1 dec 0 disk_inter: push " get a stack frame spriap int_arg_list " save arg list ptr eppbb disk_seg$ need bb in case of bailout lxl5 ap|4,* get interrupt level cmpx5 3,du only level = 3 (terminate) handled here tnz SLOW_INT " Each subsystem has a channel address space of dskdcl_chans_per_subsys. " If you divide the supplied channel idx by this you can arrive at the subsys " index. lda ap|2,* get idx lrs dskdcl_chans_per_subsys_shift sx = idx/# tsx7 setup qrl 36-dskdcl_chans_per_subsys_shift put mod(idx,#) in the q lxl4 chantab_subs,ql subscript chantab adx4 bp|disktab.channels locate dynamic table eppap bb|0,x4 HENCEFORTH AP -> chantabe eax4 disktab.int_lock_meters tsx7 lock lda ap|chantab.statusp,* get status tze NO_STATUS_TERM someone else processed status (disk_control$run) "CHECK 1 AGAIN tpl UNLOCK_THEN_SLOW "CHECK 8 -- handle abnormal termination status cana bb|disk_data.status_mask tnz UNLOCK_THEN_SLOW "CHECK 9 -- Test for non-zero tally residue in DCW (DISCONTINUED) "CHECK 10 -- If controller performed EDAC or auto retry cana evil_status_bits tnz UNLOCK_THEN_SLOW ldaq simple_interrupt_criteria pre-CHECKS 3&4&7 cmk ap|chantab.active_word test channel criteria tnz UNLOCK_THEN_SLOW " "CHECK 3 -- If status for ioi channel "CHECK 4 -- If channel not active scream bloody murder "CHECK 7 --If detailed status just read " rccl sys_info$clock_,* staq status_time "Now set needed registers pointing into disk_data seg ldx3 ap|chantab.qrp HENCEFORTH X3->quentry lda bb|quentry.pdi_word,x3 ars quentry.pdi_shift AL now has PDI ana quentry.pdi_mask,dl eax0 0,al HENCEFORTH X0 = PDI ldx2 devtab_subs,x0 subscript devtab (pdi) eax2 bp|0,x2 HENCEFORTH X2->devtabe " "CHECK 11 -- Was disk previously inoperative? lda bb|devtab.broken_word,x2 cana devtab.broken+devtab.was_broken,du tnz UNLOCK_THEN_SLOW " " Must set sect_sw bootload_sw coreadd prior ercd before yielding quentry "CHECK 12 -- If was test then indicate test result lda bb|quentry.type_word,x3 ars quentry.type_shift ana quentry.type_mask,dl sta io_type io_type (DL) ** cmpa TEST,dl tze UNLOCK_THEN_SLOW Handle through pl1 DIM ldq sector_mapping,du Determine if sector IO qls 0,al shift to sign bit stq sect_sw ldq bootload_mapping,du " Determine if bce IO qls 0,al stq bootload_sw ldq bb|quentry.coreadd_word,x3 qls 36-quentry.type_shift isolate coreaddress qrs 36-quentry.type_shift stq coreadd stz errcd " WE MAY NEED TO SET LB->PVTE HERE ... "AT THIS POINT WE KNOW THAT NO ERROR OCCURED. "AT THIS POINT WE KNOW WE WILL NOT HAVE TO PRINT ANY MESSAGES. "AT THIS POINT WE MAY BEGIN TO MODIFY DISK_SEG TO REFLECT AN I/O COMPLETION. lca chantab.active+chantab.inop+1,dl ansa ap|chantab.active_word Indicate channel is no longer active|inop lda =o400000,du ldq 0,du lrl 0,x0 X0=PDI -- turn off PDI-th bit eraq all_ones ansa bp|disktab.dev_busy ansq bp|disktab.dev_busy+1 lcx4 devtab.inop+1,du ansx4 bb|devtab.inop_word,x2 Clear the devtab.inop flag " Meter this i/o completion lxl4 io_type io_type in DL lxl4 opt_info_subs,x4 subscript opt_info epplb bb|0,x2 devtab pointer (pdi) rccl sys_info$clock_,* sbaq ap|chantab.connect_time adaq lb|opt_info.channel_wait,x4 sum channel wait staq lb|opt_info.channel_wait,x4 rccl sys_info$clock_,* sbaq bb|quentry.time,x3 adaq lb|opt_info.queue_wait,x4 sum queue wait staq lb|opt_info.queue_wait,x4 lcx4 quentry.used+1,du mask out used bit ansx4 bb|quentry.used_word,x3 tsx7 add_free_q tsx7 getwork tsx7 unlock " Post this io completion. epplb coreadd sprilb arglist+2 epplb errcd sprilb arglist+4 ldaq two_args_nd staq arglist szn sect_sw Select posting means tmi sector_post eppap arglist short_call page$done return sector_post: lda bb|0,3 szn bootload_sw tmi bootload_post eppap arglist short_call vtoc_interrupt$vtoc_interrupt return bootload_post: eppap arglist short_call bootload_disk_post$bootload_disk_post return " SLOW INT -- UNLOCK_THEN_SLOW -- bail out of hard case UNLOCK_THEN_SLOW: tsx7 unlock SLOW_INT: aos bb|disk_data.bail_outs count a bail-out to PL1 eppap int_arg_list,* get back arg list ptr short_call disk_control$disk_inter return NO_STATUS_TERM: aos ap|chantab.no_status_terminate; tsx7 unlock return " Constants for subscript calculations " Subscript for sys and opt info. Sys_info is DU, Opt_info is DL. " sys_info is segment offset of sys_info (i), opt_info is devtab " offset of opt_info (i). sec_per_rec: zero 0,0 " not used zero 0,0 " not used zero 0,16 " 500 zero 0,16 " 451 zero 0,16 " 400 zero 0,16 " 190 zero 0,16 " 181 zero 0,16 " 501 zero 0,2 " 3380 zero 0,2 " 3390 sys_info_subs: " (0:MAX_IO_TYPE) opt_info_subs: zero disk_data.sys_info+sys_info_size*0,devtab.opt_info+opt_info_size*0 zero disk_data.sys_info+sys_info_size*1,devtab.opt_info+opt_info_size*1 zero disk_data.sys_info+sys_info_size*2,devtab.opt_info+opt_info_size*2 zero disk_data.sys_info+sys_info_size*3,devtab.opt_info+opt_info_size*3 zero disk_data.sys_info+sys_info_size*4,devtab.opt_info+opt_info_size*4 zero disk_data.sys_info+sys_info_size*5,devtab.opt_info+opt_info_size*5 zero disk_data.sys_info+sys_info_size*6,devtab.opt_info+opt_info_size*6 zero disk_data.sys_info+sys_info_size*7,devtab.opt_info+opt_info_size*7 " Constants for channel table and devtab subscripting. Current basis is " the limit on either is 64. chantab_subs: " straight subscript (1:64) devtab_subs: " disktab.devtab subscript zero disktab.devtab+devtab_size*00,chantab_size*00 " @ 1 zero disktab.devtab+devtab_size*01,chantab_size*01 zero disktab.devtab+devtab_size*02,chantab_size*02 zero disktab.devtab+devtab_size*03,chantab_size*03 zero disktab.devtab+devtab_size*04,chantab_size*04 zero disktab.devtab+devtab_size*05,chantab_size*05 zero disktab.devtab+devtab_size*06,chantab_size*06 zero disktab.devtab+devtab_size*07,chantab_size*07 zero disktab.devtab+devtab_size*08,chantab_size*08 zero disktab.devtab+devtab_size*09,chantab_size*09 zero disktab.devtab+devtab_size*10,chantab_size*10 zero disktab.devtab+devtab_size*11,chantab_size*11 zero disktab.devtab+devtab_size*12,chantab_size*12 zero disktab.devtab+devtab_size*13,chantab_size*13 zero disktab.devtab+devtab_size*14,chantab_size*14 zero disktab.devtab+devtab_size*15,chantab_size*15 zero disktab.devtab+devtab_size*16,chantab_size*16 zero disktab.devtab+devtab_size*17,chantab_size*17 zero disktab.devtab+devtab_size*18,chantab_size*18 zero disktab.devtab+devtab_size*19,chantab_size*19 zero disktab.devtab+devtab_size*20,chantab_size*20 zero disktab.devtab+devtab_size*21,chantab_size*21 zero disktab.devtab+devtab_size*22,chantab_size*22 zero disktab.devtab+devtab_size*23,chantab_size*23 zero disktab.devtab+devtab_size*24,chantab_size*24 zero disktab.devtab+devtab_size*25,chantab_size*25 zero disktab.devtab+devtab_size*26,chantab_size*26 zero disktab.devtab+devtab_size*27,chantab_size*27 zero disktab.devtab+devtab_size*28,chantab_size*28 zero disktab.devtab+devtab_size*29,chantab_size*29 zero disktab.devtab+devtab_size*30,chantab_size*30 zero disktab.devtab+devtab_size*31,chantab_size*31 zero disktab.devtab+devtab_size*32,chantab_size*32 zero disktab.devtab+devtab_size*33,chantab_size*33 zero disktab.devtab+devtab_size*34,chantab_size*34 zero disktab.devtab+devtab_size*35,chantab_size*35 zero disktab.devtab+devtab_size*36,chantab_size*36 zero disktab.devtab+devtab_size*37,chantab_size*37 zero disktab.devtab+devtab_size*38,chantab_size*38 zero disktab.devtab+devtab_size*39,chantab_size*39 zero disktab.devtab+devtab_size*40,chantab_size*40 zero disktab.devtab+devtab_size*41,chantab_size*41 zero disktab.devtab+devtab_size*42,chantab_size*42 zero disktab.devtab+devtab_size*43,chantab_size*43 zero disktab.devtab+devtab_size*44,chantab_size*44 zero disktab.devtab+devtab_size*45,chantab_size*45 zero disktab.devtab+devtab_size*46,chantab_size*46 zero disktab.devtab+devtab_size*47,chantab_size*47 zero disktab.devtab+devtab_size*48,chantab_size*48 zero disktab.devtab+devtab_size*49,chantab_size*49 zero disktab.devtab+devtab_size*50,chantab_size*50 zero disktab.devtab+devtab_size*51,chantab_size*51 zero disktab.devtab+devtab_size*52,chantab_size*52 zero disktab.devtab+devtab_size*53,chantab_size*53 zero disktab.devtab+devtab_size*54,chantab_size*54 zero disktab.devtab+devtab_size*55,chantab_size*55 zero disktab.devtab+devtab_size*56,chantab_size*56 zero disktab.devtab+devtab_size*57,chantab_size*57 zero disktab.devtab+devtab_size*58,chantab_size*58 zero disktab.devtab+devtab_size*59,chantab_size*59 zero disktab.devtab+devtab_size*60,chantab_size*60 zero disktab.devtab+devtab_size*61,chantab_size*61 zero disktab.devtab+devtab_size*62,chantab_size*62 zero disktab.devtab+devtab_size*63,chantab_size*63 zero disktab.devtab+devtab_size*64,chantab_size*64 " include device_error include disk_error_interp include io_manager_dcls include iom_ctl_words " sectors per record must be used in seek calculations and are indexed by the pvte dev_type " include dskdcl " include pvte end  device_control.alm 11/11/89 1105.1r w 11/11/89 0804.1 50733 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " device_control " " Dispatcher to appropriate dim on device type. " The entries read, write, and run are transfered to via " a tsx7. " Index registers x2,x3,x4,x7 must be preserved. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Modified 2/6/74 by N. I. Morris " Modified 4/8/74 by S. H.Webber to meter reads and writes per device " Modified 6/6/74 by B. Greenberg for unified page_wait strategy. " Modified 12/11/74 by B. Greenberg for cme.notify_requested and new cme/ptw protocol " Modified 02/28/75 by BSG for NSS " Modified 06/21/79 by BSG for stack 0 sharing " Modified 1/80 by R.J.C. Kissel to eliminate a builtin constant " Modified 03/29/81, W. Olin Sibert, to conditionalize Page Multilevel " Modified 03/03/82 by J. Bongiovanni to remove Page Multilevel, and for new PVTE " Modified 6/21/82 by E. N. Kittlitz to move core map. include pxss_page_stack include aste include pvte include add_type include stack_frame include stack_header include page_info include sst include ptw include cmp include apte include fs_dev_types " name device_control segdef dev_read,dev_write,time_out,run,init,pwait,esd_reset segdef disk_offlinep entry ptl_waitlock segdef check_ckdv,ckdv_from_pvtx entry pwait_return " init: push "gonna call out. ldq ap|2,* get pvtx stq pvtx tsx0 get_device_type get from pvt short_call disk_init$disk_init(ap|0) return esd_reset: "this entry is called to flush out all dim I/O reqs. " note this works elegantly at ESD time, but does not "extend easily to fault recover time. push "for callouts epp sst,sst$ stz sst|sst.ptl somebody has to do this. short_call disk_control$esd_reset_locks tsx7 core_queue_man$clearout return dev_read: tsx0 get_device_type get it from pvt aos sst$+sst.reads-1,al eppap dctl$disk_read tra call_join go call the dim dev_write: tsx0 get_device_type aos sst$+sst.writes-1,al aos sst$+sst.wtct eppap dctl$disk_write call_join: eppbp inter pick up flag saying to interrupt spribp arg+8 eppbp pvtx spribp arg+2 eppbp core_add spribp arg+4 eppbp devadd spribp arg+6 fld =4b24,dl 4 arguments ora 4,dl all arg acceptable to PL1 staq arg eppbp ap|0 can't use ap to call call bp|0(arg) eppbp sst$+0,2 restore bp to point into SST epbpbb bp|0 restore bb to point to base of sst tra 0,7 pwait: "entry to wait for any page control event push: push "no more frame-avoiding m-mouse tsx6 page_fault$init_savex_bb pwait_retry: lda ap|2,* get event in a cana -1,du global event? tnz await_tc als 18 move to upper lda sst|0,au get ptw cana ptw.os,dl see if event still there tze .ret_long return if no longer o/s arl 2 get core map index eaa cme.devadd,au set to get devadd ldq cme.notify_requested,dl set notify bit in cme orsq sst|sst.cmp,*au .. as we came here to wait. lda sst|sst.cmp,*au get devadd word await_tc: lda ap|2,* get argument eppap pds$apt_ptr,* get apt ptr sta ap|apte.wait_event put it where it can get notified. tsx7 page_fault$unlock_ptl "clear postqueue, perhaps notify tra pxss$waitp ptl_waitlock: "contract of this entry: " 1. Who tras to me is in his stack frame, with its own return ptr valid. " 2. Who tras to me has masked to sys_level and wired the (pds) stack. " 3. I shall execute a full Multics return (to prev frame) when " and only when I have the PTL locked. "It is NOT necessary to stx6 init_savex here. push "Establish page control frame. pwait_return: epp3 sst$ don't forget! tsx7 core_queue_man$trylock_ptl tra pxss$dvctl_retry_ptlwait "patch to tra *-1 if too obscure .ret_long:return time_out: "entry to call to make sure disks havn't stopped save tsx7 page_fault$lock_ptl lock the page table lock tsx6 page_fault$init_savex init x7 save stack tsx7 run call run on each device tsx7 page_fault$unlock_ptl unlock the page table lock return run: tsx6 page_fault$savex tsx7 core_queue_man$run_core_queue tsx6 pc_trace$running trace the fact that we called run eppap =v18/0,18/4,18/0,18/0 call disk_control$disk_run tra page_fault$unsavex disk_offlinep: tsx0 get_device_type lda lb|pvte.device_inoperative_word cana pvte.device_inoperative,dl tze 1,7 tra 0,7 get_device_type: ldq pvtx tmoz page_error$bad_device_id mpy pvte_size,dl index the pvt epplb pvt$array epplb lb|-pvte_size,ql address the PVTE lda lb|pvte.device_type_word arl pvte.device_type_shift tze page_error$bad_device_id cmpa fs_dev.max_dev_type,dl tpnz page_error$bad_device_id tra 0,0 check_ckdv: lda page_fault$cme_devadd,*4 what device is this? lda ast|aste.pvtx_word,3 arl aste.pvtx_shift ana aste.pvtx_mask,dl get disk's pvtx ckdv_from_pvtx: lrl 36 move to x mpy pvte_size,dl eppap pvt$array eppap ap|-pvte_size,ql address the PVTE lda ap|pvte.check_read_incomplete_word cana pvte.check_read_incomplete,dl are we checking this dev? tnz 0,7 tra 1,7 no end  disk_control.pl1 10/01/90 1629.4rew 10/01/90 1626.9 771102 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* DISK_CONTROL - Device Control Module for Disks. coded 12/1/70 by N. I. Morris revised 7/1/73 - Lee J. Scheffler to add metering revised 12/73 by N. I. Morris to add DSU-191 disks. revised 4/8/74 by S.H.Webber to change lockptl metering code revised for new storage system - 3/27/75 by Noel I. Morris test_drive entry by Bernard Greenberg 4/9/76 improved error handling by Noel I. Morris - 6/3/76 bad channel removal added by Noel I. Morris - 8/16/77 disk offline waiting added by Bernard Greenberg - 9/20/77 changed to use reset status command in test_drive 2/1/79 by Michael R. Jordan modified for new seek optimization for MSU0500/1 devices 4/79 by Michael R. Jordan modified for io_manager conversion February 1981 by Chris Jones Modified July, 1981, WOS, to install Mike Jordan's fix to the 501 sector number overflow problem (too many sectors to represent in 20 bits). Modified February 1982 by C. Hornig for MR10 io_manager. Modified March 1982 by C. Hornig to unload disks. Modified March 1982 by J. Bongiovanni for queue_length_given_pvtx, new PVTE Modified July 1982 by J. Bongiovanni for read_sectors, write_sectors Modified June 1983 by Chris Jones for ioi rewrite Modified January 1984 by Chris Jones to add add_channel entry Modified April 1984 by T. Oke for system wide free_q. Modified April 1984 by T. Oke for dynamic channel table and the use of dskdcl_chans_per_subsys to define channel idx/subsystem relation. Modified May 1984 by T. Oke to save pvtx in queue entry for AZM analysis of queue. Modified for adaptive optimizer by T. Oke May 1984. Modified call_run to poll all sub-systems by T. Oke May 1984, Lossage counters moved to chantab and renamed. Modified to reset quentry.used in add_free_q by T. Oke November 1984. Modified Nov 26, 1984 by R. A. Fawcett to support dev 0 (fips). Also include Chris Jones's change for IMU-type detailed status delivery. Stepped zealousness of esd_reset_locks from "call call_run (sx)" to merely "call run" to prevent running un-reinitialized sub-systems. by T. Oke November 1984. Modified February 1985 by Chris Jones to allow a channel to be usurped if of its devices are deleted. Modified July 1985 by Paul Farley to correctly handle IMU style detailed status. */ /****^ HISTORY COMMENTS: 1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979), audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033): Add support for dev 0 FIPS, Chris Jones's change for IMU-type detailed status delivery. 2) change(86-04-01,Fawcett), approve(86-04-11,MCR7383), audit(86-05-27,Coppola), install(86-07-17,MR12.0-1097): Add support for subvolumes, and 512_word_io, devices 3380 and 3390. 3) change(86-07-24,Fawcett), approve(86-10-30,PBF7383), audit(86-11-18,Beattie), install(86-11-21,MR12.0-1223): Add an optional third line to the disk error message that gives the subvolume name and logical record/sector for use with the record_to_vtocx command. 4) change(86-10-29,Fawcett), approve(86-11-14,MCR7571), audit(86-11-18,Beattie), install(86-11-21,MR12.0-1223): Check the ioi_used bit before trying to place channels back in operation. 5) change(87-05-22,Fawcett), approve(87-05-27,MCR7704), audit(87-07-08,Farley), install(87-07-17,MR12.1-1043): Move the check for the TEST type IO quentry. This allows the secondary channels to be used if the primary is down. 6) change(87-05-27,Fawcett), approve(87-05-27,MCR7704), audit(87-07-08,Farley), install(87-07-17,MR12.1-1043): Set the "substat" variable to ANY so that matches in the disk_error_data segment can be found for such things as I/O system faults. Also display the I/O system fault word on the console. 7) change(87-08-31,Fawcett), approve(87-08-31,PBF7704), audit(87-08-31,Farley), install(87-09-01,MR12.1-1095): Change to correct a bug in the sub-status reporting in the above fix. 8) change(88-02-23,Farley), approve(88-02-23,MCR7759), audit(88-02-24,Fawcett), install(88-03-01,MR12.2-1029): Changed to set a new flag in the error code "all_paths_bad" and to give up if only one channel left and it is bad. At this time it will only be implemented for bootload_io. This is I/O done for BCE commands. 9) change(88-02-23,Farley), approve(88-02-23,MCR7793), audit(88-02-24,Fawcett), install(88-03-01,MR12.2-1029): Changed the handle_error procedure to only display/retry TEST I/O errors when they are of the bad_path variety. The retry will be done by removing the suspected bad path and re-queuing the I/O. If bad_path error on all paths, set the device inoperative and post the I/O. Same during esd. 10) change(88-03-18,Farley), approve(88-03-18,MCR7858), audit(88-04-11,Fawcett), install(88-04-19,MR12.2-1037): Changed disk_inter entry to set io_status_entry_ptr for all interrupt levels that will be processed. A null ptr fault was occuring with level-1 system faults. Changed bad_dev error handling to set pvte inop when doing TEST I/O during an ESD. 11) change(88-05-12,Farley), approve(88-06-03,MCR7906), audit(88-08-03,Fawcett), install(88-08-08,MR12.2-1080): Added a reconnect_announce_time variable to chantab to announce reconnect attempts the first time and every thirty seconds thereafter, until the I/O is successful. All other times the messages will go only to the log as they normally do. Also added I/O type to message. 12) change(89-06-23,Farley), approve(89-07-26,MCR8122), audit(89-09-11,WAAnderson), install(89-09-22,MR12.3-1072): Added functionality to interpret_status and printerr procedures to seperate FIPS disk statuses from all others by checking the pvte.is_sv flag and using new fields in disk_error_data. Also changed printerr to check the new "just_log" flag in disk_error_data. 13) change(90-06-27,WAAnderson), approve(90-08-28,MCR8188), audit(90-09-21,Schroth), install(90-10-01,MR12.4-1035): Fix bug in esd_reset_locks and handle_error that caused ESD to fail. END HISTORY COMMENTS */ /* ERROR RECOVERY STRATEGY When a fatal error is detected by the disk DIM, the drive involved is placed in a temporarily inoperative state. If the drive corrects the problem by itself within several seconds and sends a special interrupt, the drive will be placed back in operation. If no special is received within the several second time limit, the DIM will attempt to use the drive once more. If it generates another fatal error, the drive will be placed in broken state. The DIM will attempt to use a broken drive every several minutes. The receipt of a special interrupt, or a successful attempt to use a broken drive, will place that drive back in operation. Read requests that are queued for a broken drive will be posted as errors. Write requests will be left in the queue and ignored util the broken drive becomes operational again. */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ disk_control: proc; dcl a_pvtx fixed bin; /* index of PVT entry */ dcl a_coreadd fixed bin (24); /* absolute core address */ dcl a_devadd bit (18) aligned; /* secondary storage device address */ dcl a_intrpt fixed bin (1); /* non-zero if completion interrupt desired */ dcl a_queue_length fixed bin; /* current number of elements in Q */ dcl a_sect_off fixed bin (4); /* sector offset for single sector requests */ dcl a_n_sectors fixed bin; /* number of sectors for sector I/O */ dcl pvtx fixed bin; /* copied args to prevent page faults */ dcl coreadd fixed bin (24); dcl sect_off fixed bin (4); dcl n_sectors fixed bin; dcl record_offset fixed bin; /* Local Automatic storage. */ dcl bootload_sw bit (1) aligned; /* set if I/O is being done for bootload Multics */ dcl call_run_sx fixed bin; /* a_sx saved in call_run */ dcl channel_time fixed bin (52); /* time channel spent doing I/O */ dcl command bit (6) aligned; /* peripheral device command */ dcl cylinder fixed bin (12); /* cylinder heads are currently on */ dcl dcdcwp ptr; /* pointer to data xfer IDCW */ dcl dddcwp ptr; /* pointer to data xfer DCW */ dcl dev unsigned fixed bin (6); /* disk device code */ dcl devadd fixed bin (18); /* record number part of device address */ dcl dev_count fixed bin; /* counter in getwork */ dcl entry_time fixed bin (52); /* time of call */ dcl errcd fixed bin (35); /* error code to page control */ dcl i fixed bin; /* usually channel index */ dcl intrpt bit (1); /* if interrupt required */ dcl io_type fixed bin; /* type of IO */ dcl lcp ptr; /* local channel pointer in handle_error */ dcl level fixed bin (3); /* level of interrupt from IOM */ dcl majstat fixed bin (5); /* extended major status */ dcl mask fixed bin (71) aligned; /* temp for wire and mask */ dcl masked bit (1); /* running masked */ dcl meter_start_time fixed bin (52); /* time of attempt to lock */ dcl name_rel fixed bin (17); /* rel offset of the disk_error_data ascii names */ dcl pdi fixed bin (6) unsigned; /* Primary Device Index. */ dcl post_sw bit (1) aligned; /* "1"b if posting must be done */ dcl ptp ptr; /* temp for wire_and_mask */ dcl qrp bit (18) aligned; /* rel ptr to queue entry */ dcl qx fixed bin (8); /* index to queue entry */ dcl required bit (1) aligned; /* "1"b if IOI requires specific channel */ dcl sector fixed bin (21); /* physical disk sector */ dcl sect_sw bit (1); /* if sector IO */ dcl stat bit (36) aligned; /* copy of special or fault status word */ dcl status_time fixed bin (52); /* time status received */ dcl sx fixed bin (8); /* index of disk subsystem */ dcl sysc fixed bin; /* syserr report code */ dcl substat bit (6) aligned; /* substatus */ dcl temp_time fixed bin (52); /* for real time looping on inop chnl errors */ dcl usurped bit (1) aligned; /* "1"b if IOI usurped channel successfully */ dcl wait_time fixed bin (52); /* time from queuing to I/O completion */ dcl 1 msg_buf like io_msg aligned; /* for syserr data */ dcl 1 stat_entry like io_status_entry; /* the whole disaster */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$io_configured fixed bin (35) ext static; dcl pds$processid ext bit (36); dcl page_fault$disk_offline_event bit (36) aligned ext; dcl tc_data$system_shutdown ext fixed bin; dcl ANY bit (6) init ("000000"b) static options (constant); /* used for substatus that will match on any */ dcl ( BOTH init ("1"b), SINGLE init ("0"b), ON init ("1"b), OFF init ("0"b), SUCCESS init ("1"b), FAILURE init ("0"b) ) bit (1) aligned static options (constant); dcl IDCW bit (3) init ("7"b3) static options (constant); dcl ( WRITE init ("31"b3), READ init ("25"b3), RESET_STATUS init ("40"b3), UNLOAD init ("72"b3) ) bit (6) static options (constant); dcl UNLOCK bit (36) aligned init ((36)"0"b) static options (constant); dcl ( ANNOUNCE_RECONNECT_DELTA fixed bin (35) init (30000000), /* thirty seconds for reconnect announce throttling */ DISK_POLLING_TIME fixed bin (35) init (2000000), /* two seconds for lost interrupt */ INOP_POLLING_TIME fixed bin (35) init (5000000), /* five seconds for dropping out of ready */ BROKEN_POLLING_TIME fixed bin (35) init (180000000), /* three minutes for standby */ CHANNEL_POLLING_TIME fixed bin (35) init (60000000) /* one minute for bad channel */ ) static options (constant); dcl bootload_disk_post entry (fixed bin (24), fixed bin (35)); dcl seek_512 bit (6) init ("30"b3) static options (constant); dcl syserr entry options (variable); dcl syserr$binary entry options (variable); dcl pxss$notify entry (bit (36) aligned); dcl page$done entry (fixed bin (24), fixed bin (35)); dcl pmut$wire_and_mask entry (fixed bin (71) aligned, ptr); dcl pmut$unwire_unmask entry (fixed bin (71) aligned, ptr); dcl dctl$disk_inter entry (fixed bin (35), fixed bin (3), bit (36) aligned); dcl vtoc_interrupt entry (fixed bin (24), fixed bin (35)); dcl ioi_masked$online_device_count entry (char (*)) returns (fixed bin); dcl ioi_masked$interrupt entry (fixed bin (35), fixed bin (3), bit (36) aligned); dcl (abs, addr, addrel, bin, bit, clock, convert, divide, fixed, float, lbound, length, hbound, max, mod, null, ptr, rel, stacq, string, substr, unspec) builtin; dcl ME char (16) static options (constant) init ("disk_control"); dcl dev_mask (0:63) bit (72) aligned static options (constant) init ("100000000000000000000000000000000000000000000000000000000000000000000000"b, "010000000000000000000000000000000000000000000000000000000000000000000000"b, "001000000000000000000000000000000000000000000000000000000000000000000000"b, "000100000000000000000000000000000000000000000000000000000000000000000000"b, "000010000000000000000000000000000000000000000000000000000000000000000000"b, "000001000000000000000000000000000000000000000000000000000000000000000000"b, "000000100000000000000000000000000000000000000000000000000000000000000000"b, "000000010000000000000000000000000000000000000000000000000000000000000000"b, "000000001000000000000000000000000000000000000000000000000000000000000000"b, "000000000100000000000000000000000000000000000000000000000000000000000000"b, "000000000010000000000000000000000000000000000000000000000000000000000000"b, "000000000001000000000000000000000000000000000000000000000000000000000000"b, "000000000000100000000000000000000000000000000000000000000000000000000000"b, "000000000000010000000000000000000000000000000000000000000000000000000000"b, "000000000000001000000000000000000000000000000000000000000000000000000000"b, "000000000000000100000000000000000000000000000000000000000000000000000000"b, "000000000000000010000000000000000000000000000000000000000000000000000000"b, "000000000000000001000000000000000000000000000000000000000000000000000000"b, "000000000000000000100000000000000000000000000000000000000000000000000000"b, "000000000000000000010000000000000000000000000000000000000000000000000000"b, "000000000000000000001000000000000000000000000000000000000000000000000000"b, "000000000000000000000100000000000000000000000000000000000000000000000000"b, "000000000000000000000010000000000000000000000000000000000000000000000000"b, "000000000000000000000001000000000000000000000000000000000000000000000000"b, "000000000000000000000000100000000000000000000000000000000000000000000000"b, "000000000000000000000000010000000000000000000000000000000000000000000000"b, "000000000000000000000000001000000000000000000000000000000000000000000000"b, "000000000000000000000000000100000000000000000000000000000000000000000000"b, "000000000000000000000000000010000000000000000000000000000000000000000000"b, "000000000000000000000000000001000000000000000000000000000000000000000000"b, "000000000000000000000000000000100000000000000000000000000000000000000000"b, "000000000000000000000000000000010000000000000000000000000000000000000000"b, "000000000000000000000000000000001000000000000000000000000000000000000000"b, "000000000000000000000000000000000100000000000000000000000000000000000000"b, "000000000000000000000000000000000010000000000000000000000000000000000000"b, "000000000000000000000000000000000001000000000000000000000000000000000000"b, "000000000000000000000000000000000000100000000000000000000000000000000000"b, "000000000000000000000000000000000000010000000000000000000000000000000000"b, "000000000000000000000000000000000000001000000000000000000000000000000000"b, "000000000000000000000000000000000000000100000000000000000000000000000000"b, "000000000000000000000000000000000000000010000000000000000000000000000000"b, "000000000000000000000000000000000000000001000000000000000000000000000000"b, "000000000000000000000000000000000000000000100000000000000000000000000000"b, "000000000000000000000000000000000000000000010000000000000000000000000000"b, "000000000000000000000000000000000000000000001000000000000000000000000000"b, "000000000000000000000000000000000000000000000100000000000000000000000000"b, "000000000000000000000000000000000000000000000010000000000000000000000000"b, "000000000000000000000000000000000000000000000001000000000000000000000000"b, "000000000000000000000000000000000000000000000000100000000000000000000000"b, "000000000000000000000000000000000000000000000000010000000000000000000000"b, "000000000000000000000000000000000000000000000000001000000000000000000000"b, "000000000000000000000000000000000000000000000000000100000000000000000000"b, "000000000000000000000000000000000000000000000000000010000000000000000000"b, "000000000000000000000000000000000000000000000000000001000000000000000000"b, "000000000000000000000000000000000000000000000000000000100000000000000000"b, "000000000000000000000000000000000000000000000000000000010000000000000000"b, "000000000000000000000000000000000000000000000000000000001000000000000000"b, "000000000000000000000000000000000000000000000000000000000100000000000000"b, "000000000000000000000000000000000000000000000000000000000010000000000000"b, "000000000000000000000000000000000000000000000000000000000001000000000000"b, "000000000000000000000000000000000000000000000000000000000000100000000000"b, "000000000000000000000000000000000000000000000000000000000000010000000000"b, "000000000000000000000000000000000000000000000000000000000000001000000000"b, "000000000000000000000000000000000000000000000000000000000000000100000000"b); /* format: off */ /* Assumptions: Several variables are expected to be correct through most of this program: dev Device index of the devtab entry for the current device. dp Devtab Pointer, indicates the current devtab to be operating upon. It is typically set from addr (disktab.devtab (pdi)). pdi Primary Device Index of the current dev. Found in devtab.pdi Used to determine primary device of shared devices. The primary device will hold queue for all its shared spindles. sect_sw Sector switch indication for the current IO to be entered into a quentry (operation entry points), or when posting a completed IO. Major importance when posting an IO, since it must be correct for the coreadd being posted. sx Subsystem index. Indicates which subsystem is in use, in order of definition of subsystems in the config_file. When a disk interrupt is received, we take info on dev, pdi, coreadd, sect_sw from the entry in check_stat. These should not be messed with, since check_stat will also return the queue element to the free_q and will call getwork to start fresh IO on the channel ASAP. Sect_sw and coreadd must still be good at post time. Since on shared devices, a single pdi's queue will hold requests for more than a single device, the dev value is recovered from the selected queue in getwork (after xfer_join) to ensure we know who we are dealing with. Add_wq will add the new request to the queue of the pdi, but will do the appropriate statistics (other than queue stats) on the device (dev). Same with del_q. */ /* format: on */ /* Entry points to generate disk requests. Setup the type of the IO and then enter common code to process entry conditions. If we are doing testing or VTOCE IO, then we have to wire and mask. If doing PAGE IO, then we are wired and masked. */ write_sectors: entry (a_pvtx, a_coreadd, a_devadd, a_sect_off, a_n_sectors); io_type = VTOC_WRITE; goto go_sector; read_sectors: entry (a_pvtx, a_coreadd, a_devadd, a_sect_off, a_n_sectors); io_type = VTOC_READ; go_sector: devadd = bin (a_devadd, 18); /* copy device address */ coreadd = a_coreadd; /* copy core address */ sect_off = a_sect_off; /* setup offset */ n_sectors = a_n_sectors; goto go_masked; /* Enter masked env */ test_drive: entry (a_pvtx); /* test drive by issuing RSS */ io_type = TEST; coreadd = bin (RESET_STATUS, 24); /* Device TEST command */ goto go_test; unload_drive: entry (a_pvtx); /* cycle down a drive */ io_type = TEST; coreadd = bin (UNLOAD, 24); /* Device UNLOAD command */ go_test: sect_off = 0; /* no offset if TEST */ n_sectors = 0; /* no sectors if TEST */ devadd = 0; /* no core if TEST */ /* Sector and Test IO must be masked and have the stack wired. */ go_masked: call pmut$wire_and_mask (mask, ptp); /* mask for processing */ masked = "1"b; /* so we unmask */ intrpt = "0"b; goto go_common; /* Write/Read a Virtual Memory Page between Disk and a Memory Frame. */ disk_write: entry (a_pvtx, a_coreadd, a_devadd, a_intrpt); io_type = PAGE_WRITE; goto go_page; disk_read: entry (a_pvtx, a_coreadd, a_devadd, a_intrpt); io_type = PAGE_READ; go_page: masked = "0"b; /* run unmasked */ devadd = bin (a_devadd, 18); /* copy device address */ coreadd = a_coreadd; /* copy core address */ sect_off = 0; /* no sector offset */ n_sectors = 0; if a_intrpt ^= 0 then intrpt = "1"b; /* completion interrupt */ else intrpt = "0"b; /* Initialize indices and pointers and lock database. Then do operation. */ go_common: entry_time = clock (); sect_sw = sector_map (io_type); bootload_sw = bootload_map (io_type); pvtep = addr (addr (pvt$array) -> pvt_array (a_pvtx)); /* Get pointer to PVT entry for this device. */ pvtdip = addr (pvte.dim_info); /* Get pointer to DIM info. */ sx = pvtdi.sx; /* Extract index for this disk subsystem. */ call setup; /* Get pointers to data bases. */ call lock (addr (disktab.call_lock_meters)); /* Lock the database. */ dev = pvte.logical_area_number; /* Get physical device number. */ pdi = disktab.devtab (dev).pdi; /* Get PDI. */ dp = addr (disktab.devtab (pdi)); /* Get pointer to info for primary device. */ /* Test for device not to be used. */ if devtab.abandoned then do; /* If device is hopelessly broken ... */ errcd = 0; /* Clear error code. */ if ^write_map (io_type) then do; /* If about to read ... */ erfp = addr (errcd); /* Get pointer for mismatching dcl. */ errflags.device_inoperative = "1"b; /* Indicate read could not succeed. */ end; call unlock; /* Undo the lock. */ call post; /* Pretend write was successful. */ go to call_exit; /* Clean up and exit. */ end; /* Attempt to get free queue entry to fill in. */ disktab.alloc_wait_meters.count = disktab.alloc_wait_meters.count + 1; if ^get_free_q () then do; /* Try to grab a free queue entry. */ call lock_meter_start (addr (disktab.alloc_wait_meters)); do while (^get_free_q ()); /* Try to grab a free queue entry. */ call call_run (sx); /* If none, wait until some free up. */ end; /* Note: run destroys value of pvtep */ call lock_meter_stop (addr (disktab.alloc_wait_meters)); end; /* Compute physical sector address from input info. Physical sector result accounts for unused sectors per cylinder. */ if pvte.is_sv then do; /* convert the subvolume devadd to the real devadd */ record_offset = mod (devadd, pvte.records_per_cyl); devadd = ((devadd - record_offset) * pvte.num_of_svs) + pvte.record_factor + record_offset; end; sector = devadd * sect_per_rec (pvte.device_type);/* raw sector. */ cylinder = divide (sector, pvtdi.usable_sect_per_cyl, 12, 0); sector = sector + cylinder * pvtdi.unused_sect_per_cyl; sector = sector + sect_off; /* sector offset, if any. */ /* Fill in the queue entry. */ quentry.intrpt = intrpt; /* completion? */ quentry.used = "1"b; /* in-use */ quentry.type = io_type; /* Type of IO */ quentry.coreadd = bit (coreadd, 24); /* Insert the memory address for data xfer. */ quentry.pvtx = a_pvtx; /* Save for azm */ quentry.pdi = pdi; /* Also save PDI for this device. */ quentry.dev = dev; /* Place device code in queue entry. */ quentry.cylinder = cylinder; /* And the cylinder number. */ quentry.n_sectors = n_sectors; /* And the number of sectors (sector I/O only) */ quentry.sector = bit (sector, 21); /* Save the disk device address. */ /* Record time for AZM and stagnation testing. */ quentry.time = entry_time; /* If this is the only request for this device, try to start up a free channel. Otherwise, queue the request for processing later. */ if ^(disktab.dev_busy | disktab.dev_queued) & dev_mask (pdi) then do i = 1 to disktab.nchan; /* If device is free with no other requests ... */ cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (i)); /* Try to find a channel to run. */ if chantab.in_use & ^chantab.active then do; /* If free usable channel ... */ call gotwork; /* Let's do this request. */ go to working; /* And exit the loop. */ end; end; call add_wq; /* Add item to end of appropriate queue. */ /* Clean up and exit. */ working: call unlock; /* Unlock the data base now. */ call_exit: if masked then call pmut$unwire_unmask (mask, ptp); /* Restore vtoc_man's environment */ return; /* ESD_RESET_LOCKS - Reset data base locks on emergency shutdown. */ esd_reset_locks: entry; disksp = addr (disk_seg$); unspec (disk_data.free_q) = "0"b; /* clear free_q */ disk_data.free_q.depth = disk_data.free_q_size; /* empty queue */ /* This form of unlocking is used because it causes a load of "0"b and and ANSA instruction. This will do a read/alter/re-write cycle and correctly update cache. We cannot STACQ since it may not have been locked to our processid. */ unspec (disk_data.lock) = unspec (disk_data.lock) & "0"b; do qx = 1 to disk_data.free_q_size; /* Look at each queue entry. */ qp = addr (disk_data.free_q_entries (qx)); qrp = rel (qp); call add_free_q; /* Free all entries at ESD time. */ end; do sx = 1 to disk_data.subsystems; call setup; /* Get pointer to subsystem data. */ call unlock; /* Undo the lock. */ call lock (addr (disktab.call_lock_meters)); /* Set the lock to us. */ do dev = disktab.first_dev to disktab.last_dev; /* Clear each device. */ dp = addr (disktab.devtab (dev)); /* Get pointer to info for device. */ devtab.broken, devtab.was_broken, devtab.inop = "0"b; /* Try to use broken device. */ devtab.cylinder = 0; /* Reset positional info. */ unspec (devtab.wq) = "0"b; /* Clear queue pointers */ /* reset optimizer queue depth to reflect empty queues. */ do i = 0 to MAX_IO_TYPE; devtab.forward = "1"b; devtab.opt_info (i).depth = 0; end; end; cp = ptr (disksp, disktab.channels); /* Get pointer to channel table. */ do i = 1 to disktab.nchan; /* Iterate through all channels. */ cp -> disk_channel_table (i).active = "0"b; /* Mark all channels as not busy. */ cp -> disk_channel_table (i).inop = "0"b; /* Mark as operative */ cp -> disk_channel_table (i).broken = "0"b; /* Mark as not broken */ if ^(cp -> disk_channel_table (i).ioi_use) & ^(cp -> disk_channel_table (i).in_use) then do; cp -> disk_channel_table (i).in_use = "1"b; disktab.channels_online = disktab.channels_online+1; end; cp -> disk_channel_table (i).erct = 0; /* clear error count */ end; disktab.dev_busy = "0"b; /* Clear busy device flags. */ disktab.dev_queued = "0"b; /* Clear request queued flags. */ call run; /* Start this subsystem rolling. */ call unlock; /* Undo the lock. */ end; return; /* USURP_CHANNEL/CEDE_CHANNEL - Share disk channels with IOI. */ usurp_channel: entry (a_sx, a_chx, a_required, a_iom_chx, a_statusp); /* Entry to usurp channel for IOI use. */ dcl a_sx fixed bin (8); /* disk subsystem index */ dcl a_chx fixed bin (35); /* disk channel index */ dcl a_required bit (1) aligned; /* "1"b if specific channel required */ dcl chx fixed bin (35); /* chx as an integer */ sx = a_sx; /* Copy subsystem index. */ required = a_required; /* Copy argument. */ chx = a_chx; /* copy chx */ call setup; /* Get appropriate pointers. */ cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (chx)); /* Get pointer to chantab entry. */ call pmut$wire_and_mask (mask, ptp); /* Wire stack and mask interrupts. */ call lock (addr (disktab.call_lock_meters)); /* Lock the disk database. */ usurped = (required | ^(chantab.broken | chantab.inop)) & /* Usurp if required or not defective channel, and ... */ ((disktab.channels_online > 1) | ^chantab.in_use | (ioi_masked$online_device_count (disk_data.name (sx)) = 0)); /* Ensure last good channel will not be usurped. */ if usurped then do; /* If we may, usurp the channel. */ if chantab.in_use then /* If channel is being used, count it out. */ disktab.channels_online = disktab.channels_online - 1; chantab.in_use = "0"b; /* Take channel out of operation. */ chantab.broken, chantab.inop = "0"b; /* Clear flags. */ end; call unlock; /* Unlock the disk database. */ call pmut$unwire_unmask (mask, ptp); /* Unwire stack and unmask interrupts now. */ if usurped then do; /* If channel now usurped ... */ do while (chantab.active); /* Wait for I/O to stop. */ end; a_iom_chx = chantab.chx; a_statusp = chantab.statusp; chantab.ioi_use = "1"b; /* Now allow IOI to use channel. */ end; else do; a_iom_chx = 0; a_statusp = null (); end; return; cede_channel: entry (a_sx, a_chx, a_iom_chx, a_statusp); /* Entry to cede channel from IOI use. */ dcl a_iom_chx fixed bin (35) parameter; dcl a_statusp ptr parameter; dcl iom_chx fixed bin (35); dcl statusp ptr; sx = a_sx; /* Copy subsystem index. */ chx = a_chx; /* copy chx */ iom_chx = a_iom_chx; statusp = a_statusp; call setup; /* Get appropriate pointers. */ cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (chx)); /* Get pointer to chantab entry. */ chantab.chx = iom_chx; chantab.statusp = statusp; chantab.ioi_use = "0"b; /* Take channel back from IOI. */ chantab.in_use = "1"b; /* Place channel back in operation. */ disktab.channels_online = disktab.channels_online + 1; return; /* Entry to manually add a deleted channel */ add_channel: entry (a_sx, a_chx, a_code); dcl a_code fixed bin (35) parameter; sx = a_sx; chx = a_chx; call setup; cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (chx)); call pmut$wire_and_mask (mask, ptp); call lock (addr (disktab.call_lock_meters)); if chantab.broken then do; chantab.broken = "0"b; chantab.in_use = "1"b; disktab.channels_online = disktab.channels_online + 1; end; else errcd = error_table_$io_configured; call unlock; call pmut$unwire_unmask (mask, ptp); if errcd = 0 then call syserr (ANNOUNCE, "^a: Adding channel ^a.", ME, chantab.chanid); a_code = errcd; return; /* DISK_RUN - External entry to poll all disk subsystems. */ disk_run: entry; /* here to keep going */ entry_time = clock (); /* get time of entry */ disksp = addr (disk_seg$); /* Get pointer to disk data base. */ do sx = 1 to disk_data.subsystems; /* Iterate through all disk subsystems. */ call setup; /* Get pointers to data base. */ call lock (addr (disktab.run_lock_meters)); /* Lock the database. */ call run; /* Now perform run operation. */ call unlock; /* Unlock the data base when finished. */ end; return; /* CALL_RUN - Entry to poll a single disk subsystem. */ call_run: entry (a_sx); entry_time = clock (); sx = a_sx; /* Copy the subsystem index. */ call setup; call run; /* run the other sub-systems too. But now we have to lock them if possible. */ call_run_sx = a_sx; /* save sx to return to */ do sx = 1 to disk_data.subsystems; if sx ^= call_run_sx then do; call setup; if stacq (disktab.lock, pds$processid, UNLOCK) then do; /* locked it */ call run; call unlock; end; end; end; sx = call_run_sx; call setup; /* restore sub-sys */ return; /* RUN - Internal entry to perform polling. */ run: proc; /* Perform channel polling. */ do i = 1 to disktab.nchan; /* Iterate through all channels. */ cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (i)); /* Generate pointer to channel info table. */ if chantab.inop & ^chantab.in_use then /* If channel is inoperative ... */ if clock () - chantab.connect_time > CHANNEL_POLLING_TIME then do; chantab.in_use = "1"b; /* Try once more. */ disktab.channels_online = disktab.channels_online + 1; end; /* format: off */ /* Poll for disk completion. This is required for allocation lock checks, and during run_locks from page control, since both are run masked, and this polling is the only way we would see disk completion. This race hazard on normal 15-seconds run_locks will produce some interrupts without terminate status, but you can't win them all. It may also produce some situations of interrupt wile not active. */ /* format: on */ if ^chantab.active then /* If channel is inactive ... */ call getwork; /* Fire it up. */ else do; /* Attempt to pick up status. */ status_time = clock (); /* For reconnect test, NOT race */ io_status_entry_ptr = addr (stat_entry); call io_manager$get_status ((chantab.chx), io_status_entry_ptr); /* See if any status has come in. */ io_status_word_ptr = addr (stat_entry.word1); if /* case */ io_status_word.t then do; /* If status is present ... */ chantab.status_from_run = chantab.status_from_run + 1; level = 3; /* Set terminate status level. */ call check_stat; /* Go examine the status. */ if post_sw then do; /* If previous I/O must be posted ... */ call unlock; /* Don't call out with our lock set. */ call post; /* Do the posting. */ call lock (addr (disktab.call_lock_meters)); /* Relock our data base now. */ end; end; else if chantab.connect_time + DISK_POLLING_TIME < status_time then do; /* If an interrupt has been lost ... */ idcwp = addr (chantab.scdcw); /* Find out device in operation. */ dev = fixed (idcw.device, 6); /* .. */ pdi = disktab.devtab (dev).pdi; /* Get PDI for this device. */ if chantab.reconnect_announce_time < status_time then do; chantab.reconnect_announce_time = status_time + ANNOUNCE_RECONNECT_DELTA; sysc = ANNOUNCE; end; else sysc = LOG; call syserr (sysc, "^a: Reconnected ^a I/O on ^a (channel ^a).", ME, IO_TYPE (ptr (disksp, chantab.qrp) -> quentry.type), disk_name (SINGLE), chantab.chanid); call connect (idcwp); /* Reconnect */ end; end; end; /* Perform device polling. */ do dev = disktab.first_dev to disktab.last_dev; /* Poll all devices. */ pdi = disktab.devtab (dev).pdi; /* Get PDI for this device. */ if pdi = dev then do; /* This is primary device. */ dp = addr (disktab.devtab (pdi)); /* Get pointer to primary device info. */ if /* case */ devtab.inop then /* If device is inoperative ... */ if clock () - devtab.time_inop > INOP_POLLING_TIME then do; disktab.dev_busy = disktab.dev_busy & ^dev_mask (pdi); end; /* Try to use device again. */ else ; else if devtab.broken then /* If device is broken ... */ if clock () - devtab.time_inop > BROKEN_POLLING_TIME then do; devtab.inop = "1"b; /* Mark as inoperative again. */ devtab.was_broken = "1"b; /* .. */ pvtep = addr (addr (pvt$array) -> pvt_array (devtab.pvtx)); call set_pvte_inop (OFF); devtab.broken = "0"b; /* Turn off broken flag. */ end; else ; end; end; return; end run; /* DISK_INTER - This is the interrupt side of the disk DIM. */ disk_inter: entry (idx, ilevel, istat); /* called by io_manager at interrupt time */ dcl idx fixed bin (35), /* channel ID index */ istat bit (36) aligned, /* status for specials or faults */ ilevel fixed bin (3); /* level of interrupt */ dcl int_idx fixed bin (35); /* idx as an integer */ int_idx = idx; sx = divide (int_idx, dskdcl_chans_per_subsys, 17, 0); /* Get index of this disk subsystem. */ call setup; /* Get pointer to data base. */ i = int_idx - sx * dskdcl_chans_per_subsys + 1; /* Compute expected channel table index. */ cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (i)); level = ilevel; /* copy the level */ stat = istat; if level = 7 then do; call check_special_stat; return; end; io_status_word_ptr = chantab.statusp; /* point to status */ if ^io_status_word.t then if level >= 3 then do; chantab.no_status_terminate = chantab.no_status_terminate + 1; return; end; if ^chantab.ioi_use then do; /* If terminate, marker, or fault ... */ call lock (addr (disktab.int_lock_meters)); /* Lock the database. */ io_status_entry_ptr = addr (stat_entry); /* point to an area to return status */ unspec (io_status_entry) = ""b; if /* case */ level = 3 then do; /* Reget status, under lock */ call io_manager$get_status ((chantab.chx), io_status_entry_ptr); io_status_word_ptr = addr (io_status_entry.word1); if ^io_status_word.t then do; chantab.no_io_terminate = chantab.no_io_terminate + 1; call unlock; return; end; end; call check_stat; /* Go process the status. */ call unlock; /* Clear data base lock. */ if post_sw then /* If posting previous operation ... */ call post; end; else /* If status for IOI channel ... */ call ioi_masked$interrupt ((chantab.ioi_ctx), level, stat); return; /* And return to caller. */ check_special_stat: proc; io_special_status_ptr = addr (stat); /* base our templates */ if ^io_special_status.t then return; dev = fixed (io_special_status.device, 6); /* Extract device address from status. */ if dev = 0 & disktab.first_dev ^= 0 then /* If special for disk controller ... */ go to ioi_special; /* Perhaps IOI wants this one, but we don't. */ if dev > disktab.last_dev then return; /* Ignore this if number out-of-bounds. */ dp = addr (disktab.devtab (dev)); /* Get pointer to device info structure. */ pdi = devtab.pdi; /* Get PDI. */ pvtx = devtab.pvtx; /* Get index to PVT entry for device. */ if pvtx = 0 then return; /* This will occur when an MPC broadcasts a special interrupt status to all LA's attached to it, and the MPC controls more than one subsystem as seen by the PVT. */ pvtep = addr (pvt_array (pvtx)); /* Get pointer to PVT entry. */ if pvte.storage_system then do; /* If storage system volume ... */ call lock (addr (disktab.int_lock_meters)); /* Lock disk database. */ dp = addr (disktab.devtab (pdi)); if /* case */ devtab.broken then do; /* If device declared broken ... */ call syserr (ANNOUNCE, "^a: Placing ^a in operation.", ME, disk_name (BOTH)); call set_pvte_inop (OFF); /* Let ops get through */ devtab.inop = "1"b; /* Promote to inoperative state. */ devtab.was_broken = "1"b; /* .. */ devtab.broken = "0"b; /* Attempt to use device again. */ end; else if devtab.inop then do; /* If device is inoperative ... */ devtab.inop = "0"b; /* Attempt to place back in operation. */ disktab.dev_busy = disktab.dev_busy & ^dev_mask (pdi); end; call call_run (sx); /* Force run call on special interrupt. */ call unlock; /* Undo the lock now. */ end; else do; /* If not storage system volume ... */ ioi_special: call ioi_masked$interrupt ((chantab.ioi_ctx), level, stat); end; /* Pass on the status to IOI. */ return; end check_special_stat; /* Pick up and examine the status. */ check_stat: procedure; errcd = 0; /* Clear the error code */ erfp = addr (errcd); post_sw = "0"b; /* Clear posting required flag. */ if ^chantab.active then do; /* If channel wasn't active, whisper bloody murder. */ chantab.terminate_not_active = chantab.terminate_not_active + 1; call syserr (JUST_LOG, "^a: Unexpected IOM status ^24.3b for ^a (channel ^a).", ME, string (io_status_word), disk_data.name (sx), chantab.chanid); return; end; status_time = clock (); qrp = chantab.qrp; /* Get pointer to queue entry. */ qp = ptr (disksp, qrp); dev = quentry.dev; /* Extract device address from queue entry. */ pdi = quentry.pdi; /* Get PDI for this request. */ coreadd = bin (quentry.coreadd, 24); /* Get memory address. */ pvtx = quentry.pvtx; /* Get PVT index. */ sect_sw = sector_map (quentry.type); bootload_sw = bootload_map (quentry.type); pvtep = addr (addr (pvt$array) -> pvt_array (pvtx)); /* Get pointer to PVT entry. */ dp = addr (disktab.devtab (pdi)); /* Get pointer to primary device info structure. */ /* Remember this queue type entry so that we do the posting correctly. */ io_type = quentry.type; /* Process termination status. */ if level = 3 then do; /* If terminate status... */ chantab.active = "0"b; /* Channel is no longer active. */ disktab.dev_busy = disktab.dev_busy & ^dev_mask (pdi); /* Indicate primary device no longer busy. */ /* Process completion of detailed status read. */ if /* case */ chantab.rsr then do; /* If detailed status was just read ... */ if (string (io_status_word) & disk_data.status_mask) then /* Don't print bad RSR's */ chantab.rsr = "0"b; /* So clear this bit now. */ unspec (io_status_entry.detailed_status (*)) = unspec (chantab.detailed_status (*)); /* copy detail over */ io_status_word_ptr = addr (chantab.status); /* Unsave previous error status. */ command = chantab.command; /* And previous device command. */ call extract_status; /* Extract status info anew. */ call handle_error; /* Now handle the error. */ chantab.rsr = "0"b; /* Turn off the bit. */ end; /* Handle abnormal termination status. */ else if string (io_status_word) & disk_data.status_mask then do; call extract_status; /* Extract status info from status word. */ call interpret_status; /* Get pointer to interp data. */ call get_disk_command; /* Extract peripheral command. */ if disk_error_interp.rsr & (io_status_entry.detailed_status (1) = ""b) then do; /* If RSR required and none available ... */ chantab.rsr = "1"b; /* Do it now. */ chantab.status = string (io_status_word); /* Save status info for after RSR. */ chantab.action_code = io_status_entry.action_code; chantab.command = command; /* Also the device command. */ idcwp = addr (chantab.dscdcw); idcw.device = bit (dev); call connect (idcwp); /* Connect to RSR instruction. */ end; else /* If no RSR required ... */ call handle_error; /* Handle error right now. */ end; /* Test for nonzero tally residue in DCW. */ else if io_status_entry.tally_residue ^= 0 then do; majstat = 20; substat = ANY; call handle_error; /* Treat like any other error. */ end; /* Handle successful termination of disk operation. */ else do; /* If we got here, operation was successful. */ post_sw = "1"b; /* Post the results. */ if io_status_word.sub & "010011"b then do; /* If controller performed EDAC or auto retry ... */ disktab.edac_errors = disktab.edac_errors + 1; if io_status_word.sub & "010000"b then /* If EDAC performed ... */ majstat = 22; else /* If auto retries performed ... */ majstat = 21; substat = ANY; call interpret_status; /* Interpret status info. */ call get_disk_command (); /* Get the command */ call printerr; /* Enter message in syserr log. */ end; devtab.inop = "0"b; /* Clear this flag. */ if devtab.was_broken | devtab.broken then do; /* Was disk previously inoperative? */ devtab.was_broken = "0"b; /* Clear flag now. */ devtab.broken = "0"b; call set_pvte_inop (OFF); call syserr (ANNOUNCE, "^a: ^a now operational.", ME, disk_name (BOTH)); end; chantab.inop = "0"b; /* Clear this flag. */ end; end; /* level 3 */ /* Handle system fault status. */ else if level = 1 then do; /* If system fault word ... */ chantab.active = "0"b; /* Channel is no longer active. */ disktab.dev_busy = disktab.dev_busy & ^dev_mask (pdi); /* Indicate device no longer busy. */ majstat = 19; substat = ANY; call handle_error; /* Use standard error handler. */ end; else return; /* Ignore anything else. */ /* If no posting to be done, don't do any of the following. */ if post_sw then do; if io_type = TEST then do; pvte.testing = "0"b; post_sw = "0"b; end; /* Perform metering on completed I/O (whether successful or not). */ else do; status_time = clock (); /* Get time now. */ channel_time = status_time - chantab.connect_time; /* Compute time channel in use. */ wait_time = status_time - quentry.time; optp = addr (devtab.opt_info (quentry.type)); /* get opt_info */ opt_info.channel_wait = opt_info.channel_wait + channel_time; opt_info.queue_wait = opt_info.queue_wait + wait_time; /* Test for error */ if errcd ^= 0 /* count a fatal error */ then disktab.ferrors = disktab.ferrors + 1; end; call add_free_q; /* Scrap queue entry now. */ end; if ^chantab.active then /* If channel is now free ... */ call getwork; /* Look for more work to do. */ return; /* And return to caller. */ /* EXTRACT_STATUS - Extract major and substatus. */ extract_status: proc; if /* case */ io_status_word.power then do; majstat = 16; substat = ANY; end; else if io_status_word.channel_stat then do; majstat = 17; substat = io_status_word.channel_stat; end; else if io_status_word.central_stat then do; majstat = 18; substat = io_status_word.central_stat; end; else do; majstat = bin (io_status_word.major, 4); substat = io_status_word.sub; end; end extract_status; /* INTERPRET_STATUS - Get interpretive info for status. */ interpret_status: proc; dedp = addr (disk_error_data$); if pvte.is_sv then dskerap = addrel (dedp, disk_error_data (majstat).finterp); else dskerap = addrel (dedp, disk_error_data (majstat).interp); /***** find first description, which is just after last used substatus array entry */ name_rel = fixed (rel (addrel (dedp, disk_error_data (lbound (disk_error_data, 1)).namep)), 17); dskerp = addr (disk_status_interp_array (lbound (disk_status_interp_array, 1))); do i = lbound (disk_status_interp_array, 1) by 1 while (bin (rel (dskerp), 18) < name_rel); dskerp = addr (disk_status_interp_array (i)); if (substat & disk_error_interp.bitmask) = disk_error_interp.bitson then return; end; end interpret_status; /* GET_DISK_COMMAND - Find Command Causing Disk Error. */ get_disk_command: proc; idcwp = addrel (diskp, bin (io_status_entry.next_lpw_offset, 18) - disktab.abs_mem_addr - 1); /* Get pointer to IDCW. */ do while (idcw.code ^= IDCW); /* Search backward to IDCW. */ idcwp = addrel (idcwp, -1); end; command = idcw.command; /* Extract command from IDCW. */ end get_disk_command; /* PRINTERR - Print disk error message. */ printerr: proc; dcl type fixed bin; /* device type */ dcl record_address fixed bin (18); /* Multics page address */ dcl mjsdp ptr; /* major status description pointer */ dcl ssdp ptr; /* substatus description pointer */ dcl imu_detailed_status (0:23) bit (8) based; /* IMU detailed status bytes */ dcl logical_rec_addr fixed bin (17); /* logical record address of subvolume */ dcl logical_sector fixed bin (21); /* logical sector of subvolume */ dcl sector_offset fixed bin (17); /* used in calculation of logical_sector */ if devtab.broken then return; /* Keep mum about broken devices. */ sector = bin (chantab.select_data.sector); /* get sector number of disk address of error */ type = pvte.device_type; /* get device type */ pvtdip = addr (pvte.dim_info); record_address = divide (sector - (divide (sector, sect_per_cyl (type), 17, 0) * pvtdi.unused_sect_per_cyl), sect_per_rec (type), 17, 0); if pvte.is_sv then do; record_offset = mod (record_address, pvte.records_per_cyl); logical_rec_addr = divide ((record_address - pvte.record_factor - record_offset), pvte.num_of_svs, 17) + record_offset; sector_offset = mod (sector, sect_per_cyl (type)); logical_sector = divide ((sector - (pvte.sv_num * sect_per_cyl (type)) - sector_offset), pvte.num_of_svs, 17) + sector_offset; end; else do; logical_rec_addr = record_address; logical_sector = sector; end; if pvte.is_sv then mjsdp = addrel (dedp, disk_error_data (majstat).fnamep); else mjsdp = addrel (dedp, disk_error_data (majstat).namep); ssdp = addrel (dedp, disk_error_interp.namep); unspec (msg_buf) = "0"b; /* Now build data portion of syserr message */ io_msgp = addr (msg_buf); io_msg.level = bit (level, 3); io_msg.channel = chantab.chanid; io_msg.device = bit (dev); io_msg.type = chantab.action_code; io_msg.command = command; io_msg.status = string (io_status_word); io_msg.devname = disk_data.name (sx); if /* case */ devtab.broken | disk_error_interp.just_log then sysc = JUST_LOG; else if mod (chantab.erct, 5) = 1 then sysc = ANNOUNCE; else sysc = JUST_LOG; call syserr$binary (sysc, io_msgp, SB_disk_err, SBL_disk_err, "^a: ^a ^[^12.3b^1s^;^1s^a^] for ^a (channel ^a).^/^2-rec ^o, sect ^o, main ^o^[^/^2-subvol ^a, logical rec ^o, logical sect ^o^;^3s^]^[^/^2-detailed status:^24( ^2.4b^).^;^s^]", ME, mjsdp -> disk_status_descrip.chr, (level = 1), stat, ssdp -> disk_status_descrip.chr, disk_name (SINGLE), chantab.chanid, record_address, sector, coreadd, pvte.is_sv, pvte.sv_name, logical_rec_addr, logical_sector, (io_status_entry.detailed_status (1) ^= ""b), addr (io_status_entry.detailed_status) -> imu_detailed_status); return; end printerr; /* HANDLE_ERROR - Handle disk errors. */ handle_error: proc; chantab.erct = chantab.erct + 1; disktab.errors = disktab.errors + 1; call interpret_status; /* Look this error up. */ if io_type = TEST then idcwp = addr (chantab.rssdcw); else idcwp = addr (chantab.scdcw); if ^(io_type = TEST & ^disk_error_interp.bad_path) then call printerr; /* print and log error */ if /* case */ chantab.erct <= disk_error_interp.max_retries & io_type ^= TEST then do; if disk_error_interp.reseek then do; /* If reseek desired before retry ... */ idcwp = addr (chantab.rstdcw); idcw.device = bit (dev); call connect (idcwp); /* Connect to restore instruction. */ end; else do; /* If retrying ... */ if disk_error_interp.bad_path then do; /* Burn real time */ temp_time = clock (); do while (clock () < temp_time + 750000); /* 3/4 sec. */ end; end; call connect (idcwp); end; end; else if disk_error_interp.bad_dev then do; /* If error indicates a bad device ... */ if /* case */ devtab.inop | devtab.broken | io_type = TEST then do; /* If device is already inoperative or broken ... */ if ^devtab.broken then /* If not already broken ... */ if quentry.type ^= TEST then call syserr (BEEP, "^a: ^a requires intervention.", ME, disk_name (SINGLE)); devtab.broken = "1"b; /* Break the device altogether. */ call set_pvte_inop (ON); devtab.was_broken = "0"b; devtab.inop = "0"b; /* And clear this flag. */ devtab.time_inop = clock (); /* Note the current time. */ errflags.device_inoperative = "1"b;/* Set error code. */ post_sw = "1"b; /* Going to post this as error. */ end; else if tc_data$system_shutdown = 0 then do; /* Device was not previously inoperative. */ devtab.inop = "1"b; /* Mark it as inoperative. */ disktab.dev_busy = disktab.dev_busy | dev_mask (pdi); /* Mark as busy to prevent further use. */ devtab.time_inop = clock (); /* Note the current time. */ call add_wq; /* Place request at tail of queue. */ end; else do; /* If during shutdown ... */ if quentry.type = TEST then call set_pvte_inop (ON); errflags.device_inoperative = "1"b; post_sw = "1"b; /* Post this fact without further ado. */ end; end; else if disk_error_interp.bad_addr then do; /* If disk address is no good ... */ if write_map (quentry.type) then /* If writing ... */ errflags.reassign_address = "1"b; /* Try another disk address. */ else /* If reading ... */ errflags.seg_unusable = "1"b; /* Mark segment as unusable. */ post_sw = "1"b; /* Post this as error. */ end; else if disk_error_interp.bad_path then do; /* If error indicates a bad channel or controller ... */ if chantab.inop then do; /* If channel previously in trouble ... */ chantab.broken = "1"b; chantab.inop = "0"b; end; else do; /* If channel just started to act up ... */ chantab.inop = "1"b; /* Mark channel inoperative. */ chantab.connect_time = clock (); /* Record the time. */ end; if disktab.channels_online > 1 then do; call syserr (BEEP, "^a: Removing channel ^a.", ME, chantab.chanid); chantab.in_use = "0"b; disktab.channels_online = disktab.channels_online - 1; end; else do; if bootload_sw then do; /* for this type I/O, give up. */ errflags.all_paths_bad = "1"b; post_sw = "1"b; end; else if io_type = TEST then do; call set_pvte_inop (ON); /* effectively inop */ if (tc_data$system_shutdown ^= 0) then do; post_sw = "1"b; errflags.device_inoperative = "1"b; errflags.all_paths_bad = "1"b; return; end; end; else if tc_data$system_shutdown ^= 0 then do; errflags.device_inoperative = "1"b; /* effectively inop */ errflags.all_paths_bad = "1"b; post_sw = "1"b; end; else do; /* Just keep trying. */ chantab.erct = 0; chantab.inop = "0"b; call connect (addr (chantab.scdcw)); end; /* Every polling time re-ready channel entries for another try. This way we are not stuck with just the last channel. */ do i = 1 to disktab.nchan; lcp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (i)); if ^(lcp -> chantab.ioi_use) then do; /* If channel really belongs to disk dim (not ioi or deleted) */ if (lcp -> chantab.connect_time + CHANNEL_POLLING_TIME < clock ()) | post_sw /* time to give up */ then do; /* time to open up */ lcp -> chantab.broken = "0"b; /* not broken */ lcp -> chantab.inop = "0"b; /* operative */ lcp -> chantab.erct = 0; /* no errors */ lcp -> chantab.active = "0"b; /* not active */ lcp -> chantab.in_use = "1"b; /* can use */ lcp -> chantab.connect_time = clock (); disktab.channels_online = disktab.channels_online + 1; end; end; end; return; end; post_sw = "0"b; /* Don't post this operation. */ call add_wq; /* Requeue the operation. */ /* We should like to call call_run here, but this is indefinitely recursive. */ do i = 1 to disktab.nchan; /* Iterate thru all channels. */ cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (i)); /* Find an idle channel */ if chantab.in_use & ^chantab.active then do; call getwork; return; end; end; end; else if disk_error_interp.bad_mem then do; /* Too bad, core lost. */ errflags.fatal_error = "1"b; errflags.memory_unusable = "1"b; post_sw = "1"b; end; else do; /* Very random error. */ errflags.fatal_error = "1"b; post_sw = "1"b; /* Tell _s_o_m_ebody. */ end; return; end handle_error; end check_stat; /* GETWORK - Look for more work to keep channel busy. */ getwork: proc; if ^chantab.in_use then return; /* chnl ^in use. */ if ^disktab.dev_busy & disktab.dev_queued = "0"b then return; /* no work to do */ /* Scan drives in sequence to determine one which needs service. */ do dev_count = lbound (disktab.devtab, 1) to hbound (disktab.devtab, 1); disktab.dev_index = disktab.dev_index + 1; /* drive to check */ if disktab.dev_index > hbound (disktab.devtab, 1) then disktab.dev_index = lbound (disktab.devtab, 1); dev = disktab.dev_index; pdi = disktab.devtab (dev).pdi; if ^disktab.dev_busy & dev_mask (pdi) then do; /* If primary device free */ dp = addr (disktab.devtab (pdi)); /* Get pointer to primary device info table. */ if ^devtab.broken /* Device usable */ then if devtab.wq.depth > 0 /* work to do */ then do; qp = ptr (disksp, devtab.wq.head); /* If only one element in queue, then we are as optimal as you get. */ /* Stagnation control. Head of queue is oldest request. If it is older than disk_data.stagnate_time then we optimize with disk combing. */ if devtab.wq.depth > 1 then if quentry.time >= (clock () - disk_data.stagnate_time) then call find_shortest_seek; else call comb; /* stagnation */ call del_q; /* Remove from queue. */ go to xfer_join; end; end; end; return; /* Nothing to do, so just return. */ /* FIND_SHORTEST_SEEK - Procedure to Get Request Closest to Current Arm Position. */ find_shortest_seek: proc; dcl ( best_seek, /* best nearest seek */ this_seek /* seek distance for comparison */ ) float bin (27), ( best_pos_comb, /* best pos comb */ best_neg_comb, /* best neg comb */ this_comb /* seek distance for comparison */ ) fixed bin (35), best_qp ptr, /* pointer to best request */ best_neg_qp ptr, /* best neg comb */ type fixed bin; /* type of this request */ cylinder = devtab.cylinder; best_seek = 1.0e+30; /* maximum */ /* Get type of queue entry to locate fraction and multipliers. Determine Logical Seek Length for Nearest-Seek calculations. */ seek_loop: type = quentry.type; this_seek = float (abs (quentry.cylinder - cylinder) * devtab.opt_info (type).multiplier); if this_seek = 0.0 then goto seek_on_cylinder; /* ON-CYLINDER */ if this_seek < best_seek then do; /* pick best */ best_seek = this_seek; best_qp = qp; end; /* Step to next queue entry as we scan the queue. */ qrp = quentry.next; if qrp = "0"b then goto seek_found; /* we have best */ qp = ptr (disksp, qrp); /* pointer to entry. */ goto seek_loop; seek_found: qp = best_qp; /* pick up best .. */ seek_on_cylinder: /* qp -> entry */ qrp = rel (qp); return; /* Combing optimization eliminates possible IO stagnation by moving the head in and out continuously in a combing motion. */ comb: entry; devtab.comb = devtab.comb + 1; cylinder = devtab.cylinder; best_pos_comb = 34359738367; best_neg_comb = -34359738367; /* Attempt to maintain direction by appropriately setting comparison order between this cylinder and the current cylinder. */ comb_loop: if devtab.forward then this_comb = quentry.cylinder - cylinder; else this_comb = cylinder - quentry.cylinder; if this_comb = 0 then /* ON-CYLINDER */ goto seek_on_cylinder; /* Pick this one */ else if this_comb > 0 /* same direction */ then do; if this_comb < best_pos_comb then do; best_pos_comb = this_comb; best_qp = qp; end; end; else do; /* reverse direction */ if this_comb > best_neg_comb then do; best_neg_comb = this_comb; best_neg_qp = qp; end; end; qrp = quentry.next; if qrp = "0"b then goto comb_found; /* search complete */ qp = ptr (disksp, qrp); goto comb_loop; comb_found: if best_pos_comb ^= 34359738367 then /* if we found forward. */ qp = best_qp; /* pick up best .. */ else qp = best_neg_qp; qrp = rel (qp); return; end find_shortest_seek; /* GOTWORK - Found queue entry. Start the I/O. */ /* Presumes dp -> devtab(pdi) Current devtab for this request's pdi. qp -> quentry Quentry which has request to connect. cp -> chantab Current channel table to connect request to. */ gotwork: entry; xfer_join: if ^quentry.used then /* This must never happen. */ call syserr (CRASH, "^a: Queuing error.", ME); chantab.qrp = rel (qp); /* Save queue entry index for later. */ chantab.erct = 0; /* Clear the retry error count. */ chantab.reconnect_announce_time = 0; /* force first reconnect to be announced */ dev = quentry.dev; /* extract device */ if quentry.type = TEST then do; idcwp = addr (chantab.rssdcw); /* Get pointer to RSS. */ idcw.command = substr (quentry.coreadd, 19, 6); idcw.device = bit (dev); /* Set device address. */ /* Count TEST or UNLOAD calls. */ optp = addr (disktab.devtab (dev).opt_info (quentry.type)); if bin (quentry.coreadd, 24) = 58 then opt_info.seek_sum = opt_info.seek_sum + 1; /* UNLOAD */ else opt_info.seek_count = opt_info.seek_count + 1; /* TEST */ call connect (idcwp); /* Get device status. */ end; else do; /* Normal seek op - */ dcdcwp = addr (chantab.dcdcw); /* Get pointer to data xfer IDCW. */ dddcwp = addr (chantab.dddcw); /* Get pointer to data xfer DCW. */ idcwp = addr (chantab.scdcw); /* Get pointer to SEEK or RSS IDCW. */ idcw.device = bit (dev); /* Set device address */ unspec (dcdcwp -> idcw) = "0"b; /* clear idcw */ dcdcwp -> idcw.code = IDCW; dcdcwp -> idcw.ext_ctl = "1"b; if write_map (quentry.type) then /* set data transfer direction */ dcdcwp -> idcw.command = WRITE; else dcdcwp -> idcw.command = READ; dcdcwp -> idcw.ext = substr (quentry.coreadd, 1, length (idcw.ext)); /* Set address extension in IDCW. */ dddcwp -> dcw.address = substr (quentry.coreadd, 7); /* Set DCW address. */ dcdcwp -> idcw.device = bit (dev); /* Set up device address */ /* idcw.chan_cmd = "00"b3 is ok, = data xfer */ chantab.select_data.sector = quentry.sector; /* set disk sector address */ /* At this point the check is made for the type of seek (512 or 64) */ if idcw.command = seek_512 then do; /* sector size is 512 */ if quentry.type = VTOC_READ | quentry.type = VTOC_WRITE then do; dddcwp -> dcw.tally = bit (bin (192, 12)); chantab.select_data.limit = bit (bin (1, 12)); end; else if quentry.type = PAGE_READ | quentry.type = PAGE_WRITE then do; dddcwp -> dcw.tally = bit (bin (1024, 12)); chantab.select_data.limit = bit (bin (2, 12)); end; else if sector_map (quentry.type) then do; dddcwp -> dcw.tally = bit (bin ((512 * quentry.n_sectors), 12)); chantab.select_data.limit = bit (bin (quentry.n_sectors, 12)); end; end; else do; /* sector size must be 64 */ if sector_map (quentry.type) then do; /* If 64-word I/O ... */ dddcwp -> dcw.tally = bit (bin (64 * quentry.n_sectors, 12)); /* Set DCW tally. */ chantab.select_data.limit = bit (bin (quentry.n_sectors, 12)); /* Set sector count limit. */ end; else do; /* If 1024-word I/O ... */ dddcwp -> dcw.tally = bit (bin (1024, 12)); /* Set DCW tally. */ chantab.select_data.limit = bit (bin (16, 12)); /* Set sector count limit. */ end; end; call connect (addr (chantab.scdcw)); /* Start up the channel. */ /* find opt_info */ optp = addr (disktab.devtab (dev).opt_info (quentry.type)); cylinder = devtab.cylinder - quentry.cylinder; devtab.cylinder = quentry.cylinder; /* Determine direction of seek. If going low cylinder to high, then devtab.forward is set true, if going high to low it is set false. If we stay on-cylinder, then we leave the direction as what it was. */ /* We use this information to maintain combing. */ if cylinder > 0 /* Backward comb */ then devtab.forward = "0"b; else if cylinder < 0 /* Forward comb */ then devtab.forward = "1"b; opt_info.seek_sum = opt_info.seek_sum + abs (cylinder); opt_info.seek_count = opt_info.seek_count + 1; end; end getwork; /* CONNECT - Start Up the Channel. */ connect: procedure (listp); dcl listp ptr parameter; dcl 1 ima aligned like io_manager_arg; ima.chx = chantab.chx; ima.pcw = ""b; ima.ptp = null (); ima.listp = listp; call io_manager$connect_abs (ima); /* Fire up the channel. */ /* Fire up the channel. */ chantab.connects = chantab.connects + 1; /* Keep count of number of connects */ chantab.active = "1"b; /* Indicate channel now active */ chantab.connect_time = clock (); /* set time of connect */ disktab.dev_busy = disktab.dev_busy | dev_mask (pdi); /* Indicate primary device now busy. */ return; end connect; /* POST - Notify system of completed operation. */ post: proc; if /* case */ io_type = TEST then do; /* test results have been indicated by this time. */ post_sw = "0"b; return; end; if sect_sw then /* If 64-word I/O ... */ if bootload_sw then call bootload_disk_post (coreadd, errcd); else call vtoc_interrupt (coreadd, errcd); else /* If page I/O ... */ call page$done (coreadd, errcd); post_sw = "0"b; /* Clear switch to prevent double posting. */ return; end post; /* queue_length_given_pvtx - that says it all */ queue_length_given_pvtx: entry (a_pvtx, a_queue_length); pvtep = addr (addr (pvt$array) -> pvt_array (a_pvtx)); /* PVTE for this device */ pvtdip = addr (pvte.dim_info); /* Get pointer to DIM info */ sx = pvtdi.sx; /* Extract index for this disk subsystem */ call setup; /* Get pointers to databases */ dev = pvte.logical_area_number; /* Device number */ pdi = disktab.devtab (dev).pdi; /* Primary device number */ dp = addr (disktab.devtab (pdi)); /* Get pointer to info for primary device */ a_queue_length = devtab.wq.depth; /* current amount queued */ return; /* TUNING control. Externally accessible entry with which to setup tuning parameters in disk_seg. It ensures valid parameters. */ tune: entry (a_op, a_ptr, reason, ec); dcl a_op char (*); /* type of tuning */ dcl a_ptr ptr; /* pointer to structure */ dcl reason char (*) varying; /* textual description of error */ dcl ec fixed bin (35); dcl stagnate_time fixed bin (35) based (cptr); /* for setting time */ dcl response fixed bin (35); dcl load fixed bin; dcl cptr ptr; dcl op char (16); %include disk_tune; %page; disksp = addr (disk_seg$); cptr = a_ptr; op = a_op; if op = STAGNATE_TIME then do; /* limit 6 min. */ if stagnate_time > 360000000 | stagnate_time < 0 then do; if stagnate_time < 0 then reason = "stagnate time must be >= 0"; else reason = "stagname time must be <= 6 minutes"; ec = error_table_$bad_arg; return; end; else disk_data.stagnate_time = a_ptr -> stagnate_time; end; else if op = SYS_TUNE then do; io_type = cptr -> sys_info_tune.type; if io_type < 0 | io_type > MAX_IO_TYPE then goto bad_io_type; sysp = addr (disk_data.sys_info (io_type)); if cptr -> sys_info_tune.map > MAX_IO_TYPE then goto bad_map_type; /* if map is positive, then we update counter mapping. */ if cptr -> sys_info_tune.map >= 0 then sys_info.depth_map = rel (addr (disk_data.sys_info (cptr -> sys_info_tune.map))); /* if max_depth is > 1 then we update it. If 0 we would divide by 0. */ if cptr -> sys_info_tune.max_depth > 0 then sys_info.max_depth = float (cptr -> sys_info_tune.max_depth); end; else if op = OPT_TUNE then do; io_type = cptr -> opt_info_tune.type; if io_type < 0 | io_type > MAX_IO_TYPE then goto bad_io_type; do sx = 1 to disk_data.subsystems; if cptr -> opt_info_tune.sub_sys = disk_data.array (sx).name then goto tune_sub_sys; end; goto bad_io_sub_sys; tune_sub_sys: call setup; /* locate disktab */ dev = cptr -> opt_info_tune.dev; if dev < lbound (disktab.devtab, 1) | dev > hbound (disktab.devtab, 1) then goto bad_io_dev; pdi = disktab.devtab (dev).pdi; /* only tune pdi */ if pdi ^= dev then goto bad_io_dev; response = cptr -> opt_info_tune.response; if response < 1 then goto response_range; load = cptr -> opt_info_tune.load; optp = addr (disktab.devtab (pdi).opt_info (io_type)); if load > 1 then do; opt_info.slope = float (response - 1) / float (load - 1); opt_info.intercept = float ((response * load) - 1) / float (load - 1); end; else do; opt_info.slope = 0.0; opt_info.intercept = float (response); end; end; else if op = RESET_SYS then do; do i = 0 to MAX_IO_TYPE; /* sys_info.depth's */ disk_data.sys_info (i).depth = 0; end; end; else if op = RESET_MAX then do; disk_data.max_depth_reset_time = clock (); disk_data.free_q.max_depth = 0; do i = 1 to disk_data.subsystems; /* each sub-sys */ diskp = ptr (disksp, disk_data.array (i).offset); disktab.wq.max_depth = 0; end; end; reason = ""; ec = 0; return; bad_io_type: reason = "invalid I/O type"; ec = error_table_$bad_arg; return; bad_map_type: reason = "invalid map I/O type"; ec = error_table_$bad_arg; return; bad_io_sub_sys: reason = "unknown subsystem"; ec = error_table_$bad_arg; return; bad_io_dev: reason = "invalid device number"; ec = error_table_$bad_arg; return; response_range: reason = "response value must be >= 1"; ec = error_table_$bad_arg; return; /* SETUP - Internal Procedure to set data base pointers. */ setup: proc; disksp = addr (disk_seg$); /* Get a pointer to disk data segment. */ pvt_arrayp = addr (pvt$array); /* Get a pointer to the PVT array. */ diskp = ptr (disksp, disk_data.offset (sx)); /* Get pointer to info for this subsystem. */ return; end setup; /* DISK_NAME - Internal Procedure to generate name of disk drive. */ disk_name: proc (both) returns (char (21) aligned); dcl both bit (1) aligned; dcl pic99 pic "99"; dcl this_name char (8); dcl other_name char (12); dcl other_dev fixed bin; if dev = pdi /* If this is the priamry, we must rely on buddy */ then other_dev = disktab.devtab (pdi).buddy; else other_dev = pdi; this_name = disk_data.name (sx) || "_" || convert (pic99, dev); if other_dev = 0 then other_name = ""; else other_name = " and " || disk_data.name (sx) || "_" || convert (pic99, other_dev); if both /* return both device names, if appropriate */ then return (this_name || other_name); else return (this_name); end disk_name; /* LOCK/UNLOCK - Internal Procedures to Lock & Unlock Disk Database. */ lock: proc (lmp); dcl 1 dlm like disk_lock_meters based (lmp) aligned, /* database lock meters */ lmp ptr; dlm.count = dlm.count + 1; /* Count locking attempt. */ if ^stacq (disktab.lock, pds$processid, UNLOCK) then do; /* Attempt to lock database. */ call lock_meter_start (lmp); do while (^stacq (disktab.lock, pds$processid, UNLOCK)); end; /* Lock the disk data base. */ call lock_meter_stop (lmp); end; return; unlock: entry; if ^stacq (disktab.lock, UNLOCK, disktab.lock) then ; /* Unlock the data base. */ return; end lock; /* LOCK_METER_START / LOCK_METER_STOP - Metering Procedures. */ lock_meter_start: proc (lmp); dcl 1 dlm like disk_lock_meters based (lmp) aligned, lmp ptr; meter_start_time = clock (); /* Get time now. */ dlm.waits = dlm.waits + 1; /* Count a wait. */ return; lock_meter_stop: entry (lmp); dlm.wait_time = dlm.wait_time + (clock () - meter_start_time); /* Meter time spent waiting. */ return; end lock_meter_start; /* GET_FREE_Q - Get a Queue Entry from the Free List. */ get_free_q: proc returns (bit (1) aligned); dcl type fixed bin; /* SPIN-LOCK til queue available. */ do while (^stacq (disk_data.lock, pds$processid, UNLOCK)); end; qrp = disk_data.free_q.head; /* Get rel ptr to head of free queue. */ if qrp then do; /* queue ^empty */ qp = ptr (disksp, qrp); /* entry pointer */ disk_data.free_q.head = quentry.next; /* new Q head */ /* if queue is now empty ground the tail, else ground our next's previous */ if disk_data.free_q.head = "0"b then disk_data.free_q.tail = "0"b; else ptr (disksp, quentry.next) -> quentry.prev = "0"b; /* Compile queue statistics. Depth is really depth assigned from free_q. */ disk_data.free_q.sum = disk_data.free_q.sum + disk_data.free_q.depth; disk_data.free_q.depth = disk_data.free_q.depth + 1; if disk_data.free_q.depth > disk_data.free_q.max_depth then disk_data.free_q.max_depth = disk_data.free_q.depth; disk_data.free_q.count = disk_data.free_q.count + 1; if ^stacq (disk_data.lock, UNLOCK, disk_data.lock) then ; /* Unlock the database */ return (SUCCESS); end; else do; /* If queue is empty ... */ if ^stacq (disk_data.lock, UNLOCK, disk_data.lock) then ; /* Unlock the database */ return (FAILURE); end; /* ADD_FREE_Q - Add Entry to End of Free Queue. */ add_free_q: entry; quentry.used = "0"b; /* Queue entry is no longer in use. */ /* SPIN-LOCK til queue is available to add free entry to it. */ do while (^stacq (disk_data.lock, pds$processid, UNLOCK)); end; /* lock database */ /* If queue is ^empty, then add to tail, else create head and tail to element. */ if disk_data.free_q.tail ^= "0"b then ptr (disksp, disk_data.free_q.tail) -> quentry.next = qrp; else disk_data.free_q.head = qrp; quentry.prev = disk_data.free_q.tail; /* link to prev */ disk_data.free_q.tail = qrp; /* New tail */ quentry.next = "0"b; /* clear next ptr. */ /* Indicate element returned from system. */ disk_data.free_q.depth = disk_data.free_q.depth - 1; if ^stacq (disk_data.lock, UNLOCK, disk_data.lock) then ; /* Unlock the database */ return; /* ADD_WQ - Add Entry to End of Work Queue. */ add_wq: entry; /* Indicate requests queued for device. */ /* If queue is not empty, then add to tail, else create queue. */ disktab.dev_queued = disktab.dev_queued | dev_mask (pdi); if devtab.wq.tail ^= "0"b then ptr (disksp, devtab.wq.tail) -> quentry.next = qrp; else devtab.wq.head = qrp; quentry.prev = devtab.wq.tail; quentry.next = "0"b; devtab.wq.tail = qrp; /* Compile queue statistics. */ devtab.wq.sum = devtab.wq.sum + devtab.wq.depth; devtab.wq.depth = devtab.wq.depth + 1; if devtab.wq.depth > devtab.wq.max_depth then devtab.wq.max_depth = devtab.wq.depth; devtab.wq.count = devtab.wq.count + 1; /* Compile system loading statistics. Find map of counter to be used. */ type = quentry.type; sysp = addr (disk_data.sys_info (type)); do while (^stacq (disk_data.lock, pds$processid, UNLOCK)); end; ptr (disksp, sys_info.depth_map) -> sys_info.depth = ptr (disksp, sys_info.depth_map) -> sys_info.depth + 1.0; optp = addr (devtab.opt_info (type)); opt_info.depth = opt_info.depth + 1; /* Common processing for system IO loading and drive IO loading. */ wq_common: sys_info.fraction = (sys_info.max_depth - ptr (disksp, sys_info.depth_map) -> sys_info.depth) / sys_info.max_depth; if sys_info.fraction < 0.0 then sys_info.fraction = 0.0; if ^stacq (disk_data.lock, UNLOCK, disk_data.lock) then ; /* Unlock disk_data. */ /* Compile drive load multiplier for this IO type. The multiplier cannot drop below 1.0 to give a true PHYSICAL=LOGICAL mapping. */ opt_info.multiplier = (opt_info.intercept - float (opt_info.depth) * opt_info.slope) * sys_info.fraction; if opt_info.multiplier < 1.0 then opt_info.multiplier = 1.0; /* LIMIT to 1.0 */ return; /* DEL_Q - Delete Item from Queue. */ del_q: entry; /* Remove item from queue, fixing previous and next entries, or head or tail */ if quentry.prev = "0"b then /* head is prev */ devtab.wq.head = quentry.next; else ptr (disksp, quentry.prev) -> quentry.next = quentry.next; if quentry.next = "0"b then /* tail is next */ devtab.wq.tail = quentry.prev; else ptr (disksp, quentry.next) -> quentry.prev = quentry.prev; /* Fix queue statistics. If queue is empty, indicate this for fast check. */ devtab.wq.depth = devtab.wq.depth - 1; if devtab.wq.depth <= 0 then disktab.dev_queued = disktab.dev_queued & ^dev_mask (pdi); /* Do load statistics, use map of depth accumulator. */ type = quentry.type; sysp = addr (disk_data.sys_info (type)); do while (^stacq (disk_data.lock, pds$processid, UNLOCK)); end; /* lock disk_data */ /* prevent possible -ve depth if map is changed on the fly. */ ptr (disksp, sys_info.depth_map) -> sys_info.depth = max (0.0, ptr (disksp, sys_info.depth_map) -> sys_info.depth - 1.0); optp = addr (devtab.opt_info (type)); opt_info.depth = opt_info.depth - 1; go to wq_common; /* will unlock disk_data */ end get_free_q; /* set_pvte_inop ... Internal procedure to deal with pvte.inoperative, notifying the global disk offline event as necessary. */ set_pvte_inop: proc (setting); dcl setting bit (1) aligned; /* pvtep is set */ call set (addr (addr (pvt$array) -> pvt_array (devtab.pvtx))); /* Set the first one (^)inop */ if devtab.buddy ^= 0 /* Must also do it to the buddy */ then call set (addr (addr (pvt$array) -> pvt_array (disktab.devtab (devtab.buddy).pvtx))); set: proc (pvte_ptr); dcl pvte_ptr ptr; if pvte_ptr -> pvte.device_inoperative & ^setting then do; pvte_ptr -> pvte.device_inoperative = "0"b; call pxss$notify (page_fault$disk_offline_event); end; else pvte_ptr -> pvte.device_inoperative = setting; return; end set; end set_pvte_inop; %include device_error; %page; %include disk_error_interp; %page; %include dskdcl; %page; %include fs_dev_types; %page; %include io_manager_dcls; %page; %include io_special_status; %page; %include io_status_entry; %page; %include io_syserr_msg; %page; %include iom_dcw; %page; %include iom_pcw; %page; %include pvte; %page; %include syserr_binary_def; %page; %include syserr_constants; /* BEGIN MESSAGE DOCUMENTATION Message: disk_control: Adding channel ICC. S: $info T: $run M: A message to confirm that channel ICC has been added to the system in response to a reconfigure command. A: $ignore Message: disk_control: Reconnected IO_TYPE I/O on dskX_NN (channel ICC). S: $info and/or $log T: $run M: A disk interrupt was apparently lost. Status for the disk did not arrive within the expected time. This may be an indication of a channel or controller malfunction. The system restarts the disk operation. A: $ignore Unless these messages persist, which may indicate a hardware malfunction that needs investigation. Some types of channel adapters and/or disk controllers can be "reset" in an attempt to correct the condition. Message: disk_control: Placing dskX_NN in operation. S: $info T: $run M: A special interrupt has been received for a disk drive marked as broken. The system will attempt to use the device. A: $ignore Message: disk_control: Unexpected IOM status SSSS for dskX_NN (channel ICC). S: $info T: $run M: Status has been received from a channel which was not marked active. This is due to a disk subsystem or IOM problem, or to a logic error in the supervisor. See manual AN87, System Formats, for an interpretation of the status SSSS. The system ignores the status and attempts to continue operation. A: $ignore Message: disk_control: dskX_NN now operational. S: $info T: $run M: A disk drive which required intervention has successfully completed an I/O operation. The system will again use its contents. A: $ignore Message: disk_control: MAJOR_STAT SUBSTAT for dskX_NN (channel ICC). .br rec RRRR, sect SSSS, main AAAA .br detailed status: XX XX XX XX XX XX XX XX S: $info T: $run M: A disk error has occurred on drive dskX_NN. The major status and substatus are interpreted as character strings. The disk address is given both as a Multics record address in octal, and as an absolute sector number in octal. The main store address being used was AAAA octal. The third line gives the hexadecimal value of the detailed status in cases where this data is useful. See manual AN87, System Formats, for interpretation of this information. A: Note for Customer Service action. The segment involved in a disk error can often be identified by an application of the "record_to_vtocx" tool to the Multics record number given in the message. Message: disk_control: MAJOR_STAT SUBSTAT for dskX_NN (channel ICC). .br rec RRRR, sect SSSS, main AAAA .br subvol V, logical rec OOOO, logical sect TTTT .br detailed status: XX XX XX XX XX XX XX XX S: $info T: $run M: A disk error has occurred on drive dskX_NN. The major status and substatus are interpreted as character strings. The disk address is given both as a Multics record address in octal, and as an absolute sector number in octal. The main store address being used was AAAA octal. The subvolume name is V (the logical device name is dskX_NNV), the logical record address is OOOO octal and the logical sector number is TTTT octal. The fourth line gives the hexadecimal value of the detailed status in cases where this data is useful. See manual AN87, System Formats, for interpretation of this information. A: Note for Customer Service action. The segment involved in a disk error can often be identified by an application of the "record_to_vtocx" tool to the Multics logical record number given in the message. Message: disk_control: dskX_NN requires intervention. S: $beep T: $run M: A disk error has occurred which could have been caused by the pack or drive being broken or requiring operator attention. The system has retried the operation an appropriate number of times without success. The system will try the device periodically to check if it has been repaired. A: Inspect the device. If it is not ready, ready it. If it is ready, try unreadying and re-readying it. If the drive cannot be made ready, contact Customer Service personnel. Message: disk_control: Removing channel ICC. S: $beep T: $run M: Errors occurred indicative of a defective disk channel or MPC. The channel receiving the errors is placed offline. A: $inform Also inform Customer Service personnel. Message: disk_control: Queuing error. S: $crash T: $run M: $err A: $recover END MESSAGE DOCUMENTATION */ end disk_control;  disk_error_data.cds 10/01/90 1629.4rew 10/01/90 1627.6 170325 /* *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* HISTORY COMMENTS: 1) change(87-05-27,Fawcett), approve(87-05-27,MCR7704), audit(87-07-08,Farley), install(87-07-17,MR12.1-1043): Change the wording for the major status number 19. This is not a real major status but rather the entry uesd for I/O system faults. The old wording was just system fault. 2) change(88-02-23,Farley), approve(88-02-23,MCR7793), audit(88-02-24,Fawcett), install(88-03-01,MR12.2-1029): Removed "rsr" from the "power off" major status. If the path is bad attempting to do a RSR will only complicate things.. 3) change(89-06-23,Farley), approve(89-07-26,MCR8122), audit(89-09-11,WAAnderson), install(89-09-22,MR12.3-1072): Added functionality to seperate some of the FIPS status interpretations, while still keeping the space required to a minimum. 4) change(90-06-27,WAAnderson), approve(90-08-28,MCR8188), audit(90-09-21,Schroth), install(90-10-01,MR12.4-1035): Added substat 'count field uncorrectable'. END HISTORY COMMENTS */ /* DISK_ERROR_DATA - This is the Database for Interpreting Disk Error Status. created 5/19/76 by Noel I. Morris Last Modified: November 1982, J. Bongiovanni, to fix bug in dev busy, alt channel in control */ disk_error_data: proc; dcl 1 cdsa like cds_args aligned auto; dcl xnames (1) char (32) aligned auto init ("*"); dcl 1 data based (tempp (1)) aligned, 2 maj_array (0: 23) like disk_error_data, 2 sub_array (nsub) like disk_error_interp; dcl nsub fixed bin, /* number of substatuses */ charwds fixed bin, /* number of words of characters allocated */ tempp (2) ptr, /* temp segs pointers */ i fixed bin, /* iteration variable */ rcode fixed bin (35), /* error code */ nulldescriprel bit (18) aligned, /* rel ptr to null char string */ deirel bit (18) aligned, /* rel pointer to interpretation data */ dsdrel bit (18) aligned; /* rel pointer to charactr string */ dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)), release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)), create_data_segment_ entry (ptr, fixed bin (35)), com_err_ entry options (variable); dcl copy_chars (charwds) fixed bin (35) based; /* structure for copying characters */ dcl (NRETRIES init (5), NONE init (0), ONCE init (1)) fixed bin (5) static options (constant); dcl (addr, addrel, bin, bit, divide, hbound, index, length, rel, size, translate, string, unspec) builtin; % include disk_error_interp; % include cds_args; call get_temp_segments_ ("disk_error_data", tempp, rcode); if rcode ^= 0 then call com_err_ (rcode, "disk_error_data", "get_temp_segments_"); dedp = tempp (1); dsdp = tempp (2); nsub = 1; dskerp = addr (data.sub_array (1)); charwds = 0; nulldescriprel = allocate_dsd (""); deirel = compute_rel (dedp, dskerp); dsdrel = allocate_dsd ("error"); do i = 0 to hbound (data.maj_array, 1); data.maj_array (i).interp = deirel; data.maj_array (i).namep = dsdrel; data.maj_array (i).finterp = deirel; data.maj_array (i).fnamep = dsdrel; end; call set_substat ("XXXXXX", NONE, "", ""); call set_majstat (1, "dev busy"); call set_fmajstat (1, "dev busy"); call set_substat ("000000", NRETRIES, "dev positioning", "reseek"); call set_substat ("100000", NRETRIES, "alt chan in control", "bad_dev,reseek,rsr"); call set_substat ("XXXXXX", ONCE, "", "reseek,rsr"); call set_majstat (2, "dev attention"); call set_fmajstat (2, "dev attention"); call set_substat ("0000X1", NONE, "write inhib", "bad_dev"); call set_substat ("00001X", NRETRIES, "seek incomplete", "bad_dev,reseek,rsr"); call set_substat ("001000", NONE, "dev inop", "bad_dev,reseek,rsr"); call set_substat ("010000", NONE, "dev in standby", "bad_dev,rsr"); call set_substat ("100000", NONE, "dev offline", "bad_dev"); call set_substat ("XXXXXX", ONCE, "", "reseek,rsr"); call set_majstat (3, "dev data alert"); call set_fmajstat (3, "dev data alert"); call set_substat ("000001", NRETRIES, "xfer timing alert", "bad_path"); call set_substat ("000010", NRETRIES, "xmission parity alert", "bad_path"); call set_substat ("000100", NRETRIES, "invalid seek addr", "bad_addr,reseek,rsr"); call set_substat ("0X1000", NRETRIES, "hdr ver failure", "bad_addr,reseek,rsr"); call set_substat ("X1X000", NRETRIES, "check char alert", "bad_addr,reseek,rsr"); call set_substat ("1X0000", NRETRIES, "compare alert", "bad_addr,reseek,rsr"); call set_substat ("XXXXXX", ONCE, "", "reseek,rsr"); call set_majstat (4, "end of file"); call set_fmajstat (4, "end of file"); call set_substat ("000000", ONCE, "good track", "bad_addr,reseek,rsr"); call set_substat ("0000X1", ONCE, "last consec block", "bad_addr,reseek,rsr"); call set_substat ("00001X", ONCE, "sect limit exceeded", "bad_path,reseek,rsr"); call set_substat ("000100", ONCE, "defect trk, alt assnd", "bad_addr,reseek,rsr"); call set_substat ("001000", ONCE, "defect trk, no alt", "bad_addr,reseek,rsr"); call set_substat ("010000", ONCE, "alt trk detected", "bad_addr,reseek,rsr"); call set_substat ("XXXXXX", ONCE, "", "reseek,rsr"); call set_majstat (5, "cmd reject"); call set_substat ("000XX1", ONCE, "invalid op code", "bad_path,rsr"); call set_substat ("000010", ONCE, "invalid dev code", "bad_path,rsr"); call set_substat ("000100", NRETRIES, "invalid IDCW parity", "bad_path,rsr"); call set_substat ("001000", ONCE, "invalid instruction seq", "bad_path,reseek,rsr"); call set_substat ("XXXXXX", ONCE, "", "reseek,rsr"); call set_fmajstat (5, "cmd reject"); call set_substat ("000XX1", ONCE, "invalid op code", "bad_path,rsr"); call set_substat ("000010", ONCE, "invalid dev code", "bad_path,rsr"); call set_substat ("001000", ONCE, "invalid instruction seq", "bad_path,reseek,rsr"); call set_substat ("XXXXXX", ONCE, "", "reseek,rsr"); call set_majstat (8, "channel busy"); call set_fmajstat (8, "channel busy"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_majstat (10, "MPC attention"); call set_substat ("000001", NONE, "config switch err", "bad_path,rsr"); call set_substat ("000010", NONE, "multiple devs", "bad_path,rsr"); call set_substat ("000011", NONE, "illeg dev no", "bad_path,rsr"); call set_substat ("001011", NONE, "CA err or OPI down", "bad_path,rsr"); call set_substat ("001100", ONCE, "unexpected EN1", "bad_dev,reseek,rsr"); call set_substat ("001101", ONCE, "CA EN1 err", "bad_dev,reseek,rsr"); call set_substat ("001110", ONCE, "no EN1", "bad_dev,reseek,rsr"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_fmajstat (10, "IPC-FIPS device attention"); call set_substat ("000010", NONE, "multiple devs", "bad_path,rsr"); call set_substat ("000011", NONE, "illeg dev no", "bad_path,rsr"); call set_substat ("001011", ONCE, "usage/error stat overflow", "just_log,rsr"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_majstat (11, "MPC data alert"); call set_substat ("000001", NRETRIES, "xmission parity alert", "bad_path,rsr"); call set_substat ("000010", ONCE, "inconsistent command", "bad_path,rsr"); call set_substat ("000011", ONCE, "sum check err", "bad_path,rsr"); call set_substat ("000100", ONCE, "byte locked out", "bad_path,rsr"); call set_substat ("001010", NRETRIES, "count field uncorrectable", "bad_addr,rsr"); call set_substat ("001110", NRETRIES, "EDAC parity err", "bad_addr,rsr"); call set_substat ("010001", NRETRIES, "sect size err", "bad_addr,rsr"); call set_substat ("010010", NRETRIES, "nonstandard sect size", "bad_addr,rsr"); call set_substat ("010011", NRETRIES, "search alert (first)", "bad_addr,rsr"); call set_substat ("010100", NRETRIES, "cyclic code err", "bad_addr,rsr"); call set_substat ("010101", NRETRIES, "search err (not first)", "bad_addr,rsr"); call set_substat ("010110", NRETRIES, "sync byte not HEX 19", "bad_addr,rsr"); call set_substat ("010111", NRETRIES, "auto alt trk err", "bad_addr,rsr"); call set_substat ("011001", NRETRIES, "EDAC, last sect", "bad_addr,rsr"); call set_substat ("011010", NRETRIES, "EDAC, not last sect", "bad_addr,rsr"); call set_substat ("011011", NRETRIES, "EDAC, block count limit", "bad_addr,rsr"); call set_substat ("011100", NRETRIES, "uncorrectable err", "bad_addr,rsr"); call set_substat ("011101", NRETRIES, "EDAC, short block", "bad_addr,rsr"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_fmajstat (11, "IPC-FIPS device data alert"); call set_substat ("010001", NRETRIES, "sect size err", "bad_addr,rsr"); call set_substat ("010010", NRETRIES, "nonstandard sect size", "bad_addr,rsr"); call set_substat ("010011", NRETRIES, "search alert (first)", "bad_addr,rsr"); call set_substat ("010100", NRETRIES, "cyclic code err", "bad_addr,rsr"); call set_substat ("010101", NRETRIES, "search err (not first)", "bad_addr,rsr"); call set_substat ("010111", NRETRIES, "auto alt trk err", "bad_addr,rsr"); call set_substat ("100001", NRETRIES, "write buffer parity err", "bad_path,rsr"); call set_substat ("100010", NRETRIES, "uncorrectable read substatus", "bad_path,rsr"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_majstat (13, "MPC cmd reject"); call set_substat ("000001", NONE, "illeg procedure", "bad_path,rsr"); call set_substat ("000010", NONE, "illeg log chan", "bad_path,rsr"); call set_substat ("000011", NONE, "illeg susp log chan", "bad_path,rsr"); call set_substat ("000100", NONE, "continue bit not set", "bad_path,rsr"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_fmajstat (13, "IPC-FIPS cmd reject"); call set_substat ("000001", NONE, "invalid operation code", "bad_path,rsr"); call set_substat ("XXXXXX", ONCE, "", "bad_path,rsr"); call set_majstat (16, "power off"); call set_fmajstat (16, "power off"); call set_substat ("XXXXXX", NRETRIES, "", "bad_path"); call set_majstat (17, "chan stat"); call set_fmajstat (17, "chan stat"); call set_substat ("001000", ONCE, "connect while busy", ""); call set_substat ("010000", ONCE, "illeg chan instruct", ""); call set_substat ("011000", ONCE, "incorrect DCW", ""); call set_substat ("100000", ONCE, "incomplete instruct seq", "bad_path"); call set_substat ("110000", NRETRIES, "PSI parity err", "bad_path"); call set_substat ("111000", NRETRIES, "parity err, I/O bus to chan", "bad_path"); call set_substat ("XXXXXX", NRETRIES, "", "bad_path,rsr"); call set_majstat (18, "central stat"); call set_fmajstat (18, "central stat"); call set_substat ("111000", ONCE, "parity err, I/O bus from chan", "bad_path"); call set_substat ("XXXXXX", NRETRIES, "", "bad_path,rsr"); call set_majstat (19, "I/O system fault"); call set_fmajstat (19, "I/O system fault"); call set_substat ("XXXXXX", ONCE, "", "bad_path"); call set_majstat (20, "nonzero tally residue"); call set_fmajstat (20, "nonzero tally residue"); call set_substat ("XXXXXX", ONCE, "", "bad_dev"); call set_majstat (21, "Auto retries"); call set_fmajstat (21, "Auto retries"); call set_substat ("XXXXXX", ONCE, "", "just_log"); call set_majstat (22, "EDAC performed"); call set_fmajstat (22, "EDAC performed"); call set_substat ("XXXXXX", ONCE, "", "just_log"); call set_majstat (23, "Data parity"); call set_fmajstat (23, "Data parity"); call set_substat ("XXXXXX", ONCE, "", "bad_mem"); dskerp -> copy_chars = tempp (2) -> copy_chars; /* copy the characters now. */ nsub = nsub - 1; /* back down one */ do i = 0 to hbound (data.maj_array, 1); call relocate_rel (data.maj_array (i).namep); call relocate_rel (data.maj_array (i).fnamep); end; do i = 1 to nsub; call relocate_rel (data.sub_array (i).namep); end; cdsa.sections (1).p = tempp (1); cdsa.sections (1).len = size (data) + charwds; cdsa.sections (1).struct_name = "data"; cdsa.seg_name = "disk_error_data"; cdsa.num_exclude_names = 1; cdsa.exclude_array_ptr = addr (xnames); string (cdsa.switches) = "0"b; cdsa.switches.have_text = "1"b; call create_data_segment_ (addr (cdsa), rcode); if rcode ^= 0 then call com_err_ (rcode, "disk_error_data", "create_data_segment_"); nl_exit: call release_temp_segments_ ("disk_error_data", tempp, rcode); if rcode ^= 0 then call com_err_ (rcode, "disk_error_data", "release_temp_segments_"); return; set_majstat: proc (mjs, descrip); /* proc to fill in major status array */ dcl mjs fixed bin (5), /* major status */ descrip char (*) aligned; /* major status description */ if mjs > hbound (data.maj_array, 1) then do; call com_err_ (0, "disk_error_data", "The bounds of the major status array have been exceeded."); call com_err_ (0, "disk_error_data", "Current value = ^d, must be at least ^d.", hbound (data.maj_array, 1), mjs); go to nl_exit; end; data.maj_array (mjs).interp = compute_rel (dedp, dskerp); data.maj_array (mjs).namep = allocate_dsd (descrip); return; end set_majstat; set_fmajstat: proc (mjs, descrip); /* proc to fill in FIPS major status array items */ dcl mjs fixed bin (5), /* major status */ descrip char (*) aligned; /* major status description */ if mjs > hbound (data.maj_array, 1) then do; call com_err_ (0, "disk_error_data", "The bounds of the major status array have been exceeded."); call com_err_ (0, "disk_error_data", "Current value = ^d, must be at least ^d.", hbound (data.maj_array, 1), mjs); go to nl_exit; end; data.maj_array (mjs).finterp = compute_rel (dedp, dskerp); data.maj_array (mjs).fnamep = allocate_dsd (descrip); return; end set_fmajstat; set_substat: proc (stat, retry, descrip, errs); /* proc to allocate disk_error_interp structure */ dcl stat char (6) aligned, retry fixed bin (5), descrip char (*) aligned, errs char (*) aligned; unspec (disk_error_interp) = "0"b; disk_error_interp.bitson = bit (translate (stat, "0", "X"), 6); disk_error_interp.bitmask = bit (translate (stat, "10", "0X"), 6); disk_error_interp.max_retries = retry; if descrip ^= "" then disk_error_interp.namep = allocate_dsd (descrip); else disk_error_interp.namep = nulldescriprel; call seterr (errs, "bad_addr", disk_error_interp.bad_addr); call seterr (errs, "bad_path", disk_error_interp.bad_path); call seterr (errs, "bad_dev", disk_error_interp.bad_dev); call seterr (errs, "bad_mem", disk_error_interp.bad_mem); call seterr (errs, "just_log", disk_error_interp.just_log); call seterr (errs, "reseek", disk_error_interp.reseek); call seterr (errs, "rsr", disk_error_interp.rsr); nsub = nsub + 1; /* Count one more. */ dskerp = addr (data.sub_array (nsub)); return; end set_substat; seterr: proc (errstring, errname, errbit); /* procedure to set error bit */ dcl errstring char (*) aligned, errname char (*) aligned, errbit bit (1) unal; if index (errstring, errname) > 0 then errbit = "1"b; return; end seterr; allocate_dsd: proc (descrip) returns (bit (18) aligned); /* procedure to allocate character string */ dcl descrip char (*) aligned; dcl old_dsdp ptr, temp_dsdp ptr, chlth fixed bin; /**** Scan existing strings for a match. Allocate new string only when no match is found. */ do temp_dsdp = tempp(2) repeat addrel (temp_dsdp, divide (temp_dsdp -> disk_status_descrip.lth, 4, 17, 0) + 1) while (rel (temp_dsdp) < rel (dsdp)); if temp_dsdp -> disk_status_descrip.chr = descrip then return (compute_rel (tempp(2), temp_dsdp)); end; disk_status_descrip.lth = length (descrip); disk_status_descrip.chr = descrip; chlth = divide (length (descrip), 4, 17, 0) + 1; charwds = charwds + chlth; old_dsdp = dsdp; dsdp = addrel (dsdp, chlth); return (compute_rel (tempp (2), old_dsdp)); end allocate_dsd; compute_rel: proc (basep, strucp) returns (bit (18) aligned); /* procedure to compute relative offset */ dcl basep ptr, /* pointer to database */ strucp ptr; /* pointer to structure */ return (bit (bin (bin (rel (strucp), 18) - bin (rel (basep), 18), 18), 18)); end compute_rel; relocate_rel: proc (relp); /* proc to relocate name pointers */ dcl relp bit (18) unal; /* name relative pointer */ relp = bit (bin (bin (relp, 18) + bin (rel (dskerp), 18), 18), 18); return; end relocate_rel; end disk_error_data;  evict_page.alm 11/11/89 1105.1r w 11/11/89 0804.1 97272 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** """""""""""""""""""""""""""""""""""""""""""""""""" " " call page$evict (cmep, event); " " forces current occupant out of core pointed to by cmep " Event returned non-zero if waiting necessary. " " May take 2 calls for wired os page. " " Bernard Greenberg, May 16, 1974 " Adjusted for pc_recover_sst, BSG, 9/3/77 " Modified for cam_cache by J. Bongiovanni 2/23/81 " Modified 03/14/81, W. Olin Sibert, for ADP conversion " Modified for read_page_abs calling sequence by J. Bongiovanni 2/26/82 " Modified to move core map, E. N. Kittlitz, 6/21/82. " Modified to call page_synch$move, Chris Jones, 05/09/84. " """""""""""""""""""""""""""""""""""""""""""""""""" include ptw include sdw include aste include stack_frame include mc include null_addresses include add_type include page_info include sst include cmp include pxss_page_stack " name evict_page segdef evict,wire_abs link abs_seg_link,abs_seg$ " evict: push " set up stack frame lda evict_entry,dl set up entry flag sta entry_sw eppbp ap|2,* point to first arg eppbp bp|0,* point to cme of interest stz ap|4,* zero wait event eax4 bp|0 get cmep into x4 epbpbb sst$ bb -> SST through out page tsx6 page_fault$init_savex set up for internal calls stx4 pre_temp save cmep tsx6 make_ptw compute coreadd stq pre_temp+1 save coreadd stq core_add ldx2 page_fault$cme_ptwp,*4 see if in use tze .ret no, can return lxl3 page_fault$cme_astep,*4 pick up astep stx2 ptp_astep save page pointer sxl3 ptp_astep and astep eppbp sst|0,2 point to ptw with bp lda ptw|0 now inspect ptw cana ptw.os,dl read or write going on? tnz await_ptw yes, must wait for ptw event cana ptw.wired,dl wired page, not out of service tnz move_wired lca ptw.valid+1,dl set to turn off access ansa ptw|0 turn off access tsx7 cam_cache$cam_cache tell world, blast out of caches "core_add set by make_ptw call above lda ptw|0 look at ptw now cana ptw.phm+ptw.phm1,dl see if modified at _a_n_y time previous tze not_mod_ptw no, very easy case tsx7 page_fault$find_core_ get a page to move into tsx7 set_up_abs_seg_2 get destination abs seg on ab tsx6 make_from_abs_seg get ap abs seg together tsx7 move_page move page into new location tsx7 swap_cme fix core map lda page_fault$cme_flags,*x5 cana cme.synch_held,dl tze 2,ic tsx7 page_synch$move " update dm_journal_seg_ tsx7 swap_ptw change ptw and open it szn dev_signal did parity wipe page out? tnz parity_destroys_page tough _. .ret: return " done " not_mod_ptw: " page was not modified - make find_core_ look guilty tsx7 page_fault$cleanup_page do find-core wrap-up return await_ptw: " come here to wait for out of service eppap sp|stack_frame.arg_ptr,* get ptr to arglist sxl2 ap|4,* set wait event return move_wired: " very hard case- move wired page tsx7 page_fault$find_core_ get new place for page tsx7 set_up_abs_seg_2 get ab-based abs-seg tsx6 make_from_abs_seg set up 'from' abs seg ldx2 ptp_astep restore original ptw ptr eppbp sst|0,2 move_merge: lda ptw|0 get ptw ana ptw.phm,dl isolate mod bit sta sst|sst.evict_phmbit save for pcrsst stx2 sst|sst.evict_ptp now recoverable till stz, then ok. ersa ptw|0 possibly turn off, in an RAR way eax5 0,al save state of modified bit tsx7 cam_cache$cam_ptws drive page out of cache and ptwams tsx7 move_page tsx7 cam_cache$cam_with_wait stop the world lda ptw|0 look at ptw once more now cana ptw.phm,dl see if moved any time in between tze not_mod_during_move tsx7 move_page move with world stopped increment sst|sst.recopies meter not_mod_during_move: eaa 0,5 restore old mod bit arl 18 orsa ptw|0 stz sst|sst.evict_ptp tell pcrsst its safe. tsx7 swap_cme move core map data around. lda page_fault$cme_flags,*x5 cana cme.synch_held,dl tze 2,ic tsx7 page_synch$move " update dm_journal_seg_ tsx7 swap_ptw fix the ptw stz scs$cam_wait release everybody camp cams 4 CLEAR CACHE szn dev_signal did parity galumph the page? tnz parity_destroys_page return " and we are done " " " " Damage segment due to parity error. " Continue to use page. " parity_destroys_page: lda aste.fmchanged,du orsa ast|aste.fmchanged_word,3 "damage seg lda aste.damaged,dl orsa ast|aste.damaged_word,3 lda pre_temp+1 set up params for report call sta core_add ldx4 pre_temp old frame of interest lda ptw|0 wired case? cana ptw.wired,dl tnz page_error$wired_parity_error crash tsx7 page_error$page_move_parity tsx7 page_fault$delete_mm_frame take mem out of use tra .ret " """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " " " call page$wire_abs (cmep, event, astep, i); " " " " wires page (astep, i) into core pointed to by cmep " " may take up to 3 calls, as per convention. " " " """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" wire_abs: push "get stack together lda abs_wire_entry,dl set entry indr sta entry_sw tsx6 page_fault$init_savex set up call stack eppbp ap|6,* bp -> astep eppbp bp|0,* bp -> aste eax3 bp|0 set x3 to aste epbpbb bp|0 bb -> sst$+0 lxl0 ap|8,* x0 contains i eppbp bp|aste_size,0 bp -> ptw eax2 bp|0 x2 -> ptw stz ap|4,* init wait event epplb ap|2,* lb -> cmep eax4 lb|0,* x4 -> cme stx2 ptp_astep save x2 similarly sxl3 ptp_astep and astep lda ptw.wired,dl attempt to wire page wherever it is - "This deterministically suppresses further writes, " causes page to stay in if os on read. cana ptw|0 see if already wired tnz already_wired dont wire it, already wired orsa ptw|0 increment sst|sst.wired maintain meter already_wired: lda ptw|0 inspect the ptw cana ptw.os,dl see if reading or writing tnz await_ptw wait for ptw event cana ptw.valid,dl see if in core now tnz in_core_now already in - move if not already in place cana ptw.er,dl previous error? tze absread.not_prev_error tsx7 page_fault$disk_offlinep tra absread.await_any absread.not_prev_error: tsx7 page_fault$read_page_abs attempt to read page in tra await_a wait for event tra absread.no_wait tra absread.await_any volmap event " " If read_page_abs said no event, then page is in. " absread.no_wait: return await_a: eax2 0,au wait for event in a tra await_ptw absread.await_any: eppap sp|stack_frame.arg_ptr,* sta ap|4,* return in_core_now: "page already in core, might be in right place, "then again, might not tsx6 make_ptw get current ptw for cme era ptw|0 compare with real ptw ana ptw_add_mask,du look at only address tze .ret in core, right place, access on, abs wired. GREAT! tsx7 set_up_abs_seg_2 set up 'to' abs_seg lda ptw|0 get current home of page ana ptw_add_mask,du get only address bits arl ptw_to_coreadd.rl align to coreadd (ADP/L68 OK) sta core_add set up for set_up_abs_seg als coreadd_to_cmep.ls get in cmep units (ADP/L68 OK) eaa sst|sst.cmp,*au get cmep sta pre_temp tsx6 page_fault$set_up_abs_seg set up 'from' abs seg tra move_merge move the page " " " " " subroutines " move_page: " move a page from the ap abs seg to the ab abs seg stz dev_signal init parity check inhibit on <+><+><+><+><+><+><+><+><+><+><+><+> ldi scu.ir.bm+scu.ir.parm,dl clear out inds, set parmask lda 1024*4,dl mlr (pr,rl),(pr,rl) desc9a ap|0,al desc9a ab|0,al nop 0 nop 0 allow cp and cx boards to synchronize sti temp ldi scu.ir.bm,dl nop 0 inhibit off <-><-><-><-><-><-><-><-><-><-><-><-> lda temp get ir ana scu.ir.par,dl orsa dev_signal store it tra 0,7 set_up_abs_seg_2: " set up abs seg on ab - assumes x4 -> cme ldx0 lp|abs_seg_link adlx0 lp|abs_seg_link " get 2*segno in x0 eaa 0,x4 " Get CMEP in A, and sbla sst|sst.cmp+1 " convert to CME offset als cmep_to_sdw.ls " Convert to SDW address (ADP/L68 OK) eaq 0 " zero the q oraq sdw_bits staq dseg$+0,x0 " store in dseg iftarget l68 " CAM is different on ADP/L68 cams 0 " clear am of segs camp 0 " and poss abs-seg pages ifend iftarget adp cams 0 " clear am of segs camp 0 " and poss abs-seg pages ifend eppab lp|abs_seg_link,* " Point PR1 at the abs_seg tra 0,x7 " and return " swap_ptw: "makes ptw point at cme of x4 tsx6 make_ptw ora add_type.core,dl staddra ptw|0 store in ptw lda ptw.valid,dl get access bit orsa ptw|0 turn on access if not there already tra 0,7 swap_cme: " cleans up cme's for swap_ptw ldx2 ptp_astep restore ptw if clobbered lxl3 ptp_astep restore astep eppbp sst|0,2 ldx5 pre_temp "old" cme lda page_fault$cme_devadd,*5 get "old" (only) devadd staddra page_fault$cme_devadd,*4 move to "new" cme, which is still free. sxl3 page_fault$cme_astep,*4 still unofficial eax0 0 get a zero ready. " " The interval between the next two instructions is unsafe " with respect to pc_recover_sst. If somehow (only possibility is " operand cpu error on this cpu) we lose control between them, pcrsst " will clobber this page. This is not bad. " even inhibit on <+><+><+><+><+><+><+><+><+><+><+><+> stx0 page_fault$cme_ptwp,*5 It's not in old one, stx2 page_fault$cme_ptwp,*4 It's now in new one. inhibit off <-><-><-><-><-><-><-><-><-><-><-><-> sxl0 page_fault$cme_astep,*5 for cleanliness only. tra 0,7 make_ptw: " subr to make ptw (and addr in QL) from x4 eaa 0,x4 get cmep sbla sst|sst.cmp+1 get offset iftarget l68 " L68 & ADP shift differently here als cmep_to_ptw.ls " make PTW addr from cmep offset ifend iftarget adp arl cmep_to_ptw.rl " make PTW addr from cmep offset ifend eaq 0,au make lower in q qrl ptw_to_coreadd.rl (ADP/L68 OK) tra 0,x6 make_from_abs_seg: " Common, TSX6 subroutine, relys on page_fault to TRA back ldq pre_temp+1 get 'from' core_add stq core_add set for page_fault routine tra page_fault$set_up_abs_seg finish same " " " " constants " even sdw_bits: " Bits for abs-seg SDW -- it is " Address 0, read/write, one unpaged page iftarget L68 " SDW is different format for each vfd 18/0,18/sdw.valid vfd 1/0,14/(1024/16)-1,3/sdw.read+sdw.write,18/sdw.unpaged ifend iftarget ADP vfd 18/0,18/sdw.valid vfd 14/(1024/16)-1,4/0,18/sdw.read+sdw.write+sdw.unpaged ifend end  free_store.alm 11/11/89 1105.1r w 11/11/89 0804.2 156123 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " free_store - disk address management routines " " Entries " " " withdraw - allocate a disk address from stock/volmap " " withdraw_list_ext - allocate a bunch of disk addresses from " stock/volmap for a non-ALM-page-control caller " " deposit - return an address to stock/volmap " " deposit_list - return a list of addresses to stock/volmap " " " Rewritten for stock management by J. Bongiovanni, February 1982 " Modified July 1982, J. Bongiovanni, for scavenger " Modified 831219, E. N. Kittlitz, withdraw_list_ext " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name free_store segdef withdraw segdef withdraw_list_ext segdef deposit segdef deposit_list equ deposit_list_no_args,6 equ deposit_list_argl_chars,8+8*deposit_list_no_args even segno_offset_mask: oct 077777000000 oct 777777000000 strip_null_addr: oct 377777777777 " include add_type " include apte " include page_info " include pvte " include pxss_page_stack " include scavenger_data " include stack_frame " include stock_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw " " tsx7 free_store$withdraw " " " " " On entry, " PVTE index in pvtx " " On exit, " if must wait, event in APTE " if address allocated, in devadd " " Must be called with PTL held " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw: tsx6 page_fault$savex " Recursive use of x7 tsx6 setup " Save/establish registers lda bp|pvte.pc_vacating_word cana pvte.pc_vacating,dl tnz withdraw_oopv withdraw_retry: tsx7 stock$withdraw " Attempt to withdraw from stock tra withdraw_out_of_stock " Failed als 18 " Succeed - address in AU ora add_type.disk,dl sta devadd tsx6 check_address_range " Make sure it's in the paging region lda devadd tsx6 withdraw_scav_check " Check for conflict with online scavenge in progress tra withdraw_retry " Conflict - grab another " No conflict tsx7 lock_volmap$lock_wired_nowait " Lock volmap to check for threshold tra unsavex_2 " Couldn't get it - no problem tsx7 stock$check_low_threshold " Check stock to be replenished tra withdraw_unlocks " Doesn't need to be or can't sta free_store_temp " Volmap page number tsx7 volmap_page$start_async_read " Read in volmap page tra withdraw_in_mem " Already in memory tra withdraw_unlocks " Not in memory withdraw_in_mem: lda free_store_temp " Volmap page number tsx7 volmap$withdraw_from_volmap " Volmap to stock lda free_store_temp " Volmap page number tsx7 volmap_page$start_async_write " Write it back tra withdraw_unlocks " Unlock and return tra page_error$volmap_async_error " Not in memory withdraw_unlocks: tsx7 lock_volmap$unlock_wired tra unsavex_2 " Return with devadd " withdraw_out_of_stock: tsx7 lock_volmap$lock_wired_wait " Try for lock, state idle tra unsavex_1 " Failed - wait for it tsx7 stock$check_low_threshold " Find volmap page for withdrawal tra withdraw_unlocks_oopv " None left sta free_store_temp " Volmap page number tsx7 volmap_page$start_async_read " Read in page tra withdraw_os_in_mem " Already in memory tra withdraw_unlocks_waits " Not yet - wait for it withdraw_os_in_mem: lda free_store_temp " Volmap page tsx7 volmap$withdraw_from_volmap " Volmap to stock lda free_store_temp " Volmap page tsx7 volmap_page$start_async_write " Write it back tra withdraw_unlocks_waits " Can't go until it's done tra page_error$volmap_async_error " Not in memory withdraw_unlocks_oopv: tsx7 lock_volmap$unlock_wired lda bp|pvte.used_word " Check for out of HC PART cana pvte.used,dl tze page_error$out_of_hc_part " Indeed withdraw_oopv: tra unsavex " Normal OOPV withdraw_unlocks_waits: tsx7 lock_volmap$unlock_wired withdraw_unlocks_retry: ldq bp|pvte.volmap_idle_notify_word lda bp|pvte.volmap_idle_notify_word ora pvte.volmap_idle_notify,dl stacq bp|pvte.volmap_idle_notify_word tnz withdraw_unlocks_retry eaa bp|0 " PVTE offset arl 18 ora pvt$volmap_idle_wait_constant " Wait event eppap pds$apt_ptr,* " Stash in APTE ourselves, to sta ap|apte.wait_event " avoid race tra unsavex_1 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_list_ext " " call page$withdraw_list (pvtx, arrayp, offset, count, event, code); " " Where " pvtx = index of PVTE " arrayp = ptr to array of addresses (lbound = 0) " offset = (input) first address of array to use " (output) next address of array to use " count = (input) number of pages to withdraw " = (output) number of pages still to be withdrawn " event = non-zero => wait event " code = non-zero if allocation cannot be performed " " Must be called with PTL held " This entry is designed to be called repeatedly until count = 0. " If an out-of-volume condition arises, the caller should deposit " all addresses after releasing the PTL. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_list_ext: push tsx6 page_fault$init_savex " Recursive use of x7 stz ap|10,* " event = ""b stz ap|12,* " code = 0 lda ap|2,* " PVTE index sta pvtx lda ap|8,* " count tmoz withdraw_list_end " silly person withdraw_list_loop: tsx7 withdraw " withdraw calls setup! tra withdraw_list_oopv " foo tra withdraw_list_waits eppap sp|stack_frame.arg_ptr,* " restore ap epplb ap|4,* " pointer to arrayp epplb lb|0,* " arrayp lda ap|6,* " array offset ldq devadd " this evening's guest star stq lb|0,al " put it away aos ap|6,* " bump array offset lca 1,dl " and lower count left asa ap|8,* tpnz withdraw_list_loop " still more withdraw_list_end: tsx6 meter return withdraw_list_waits: eppap sp|stack_frame.arg_ptr,* " restore ap epplb pds$apt_ptr,* " return wait event lda lb|apte.wait_event sta ap|10,* tra withdraw_list_end withdraw_list_oopv: eppap sp|stack_frame.arg_ptr,* " restore ap lda error_table_$log_vol_full " close enough sta ap|12,* " gimme a break tra withdraw_list_end " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit " " call page$deposit (pvtx, devadd, vtocx, pageno) " " Where " pvtx = index of PVTE " devadd = address to deposit " vtocx = index of VTOCE (-1 if unknown) " pageno = page number within segment " " NOTE: vtocx and pageno are used only by the scavenger " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit: push tsx6 page_fault$init_savex " Recursive use of x7 lda ap|2,* " PVTE index sta pvtx tsx6 setup " Establish registers lda bp|pvte.deposit_to_volmap_word " Slow deposit? cana pvte.deposit_to_volmap,dl tnz call_pl1_deposit " Yes tsx6 deposit_check_scav " This volume being scavenged tra call_pl1_deposit " Yes lda ap|4,* " Record address tsx7 deposit_try " Attempt deposit to stock tra call_pl1_deposit " Too much for me tsx6 meter_deposit return call_pl1_deposit: call pc_deposit$pc_deposit(ap|0) tsx6 meter_deposit return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_list " " call page$deposit_list (pvtx, arrayp, first, last, vtocx, pagenop) " " Where " pvtx = index of PVTE " arrayp = ptr to array of addresses (lbound = 1) " first = first array element to be deposited " last = last array element to be deposited " vtocx = VTOCE index (-1 if unknown) " pagenop = ptr to array of page numbers within segment (lbound=1), " or null " " NOTE: vtocx and pagenop are used only by the scavenger " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_list: push tsx6 page_fault$init_savex " Recursive use of x7 lda ap|2,* " Index of PVTE sta pvtx tsx6 setup " Establish registers spriap free_store_temp_1 " Save argument pointer ldq ap|6,* " First element stq free_store_temp " Save lda bp|pvte.deposit_to_volmap_word " Slow deposit? cana pvte.deposit_to_volmap,dl tnz call_pl1_deposit_list " Yes tsx6 deposit_check_scav " Is this volume being scavenged tra call_pl1_deposit_list " Yes deposit_list_loop: eppap free_store_temp_1,* " Restore argument pointer ldq free_store_temp " Next element cmpq ap|8,* " Done last tpnz deposit_list_returns " Yes eppap ap|4,* " ap -> ptr -> array (1) eppap ap|0,* " ap -> array (1) lda ap|-1,ql " Next address tsx7 deposit_try " Attempt to deposit to stock tra call_pl1_deposit_list " Call the big guy aos free_store_temp " Bump to next array element tra deposit_list_loop call_pl1_deposit_list: eppap free_store_temp_1,* " Restore argument pointer ldx0 ap|0 " x0 = 2 * (# args) cmpx0 2*deposit_list_no_args,du " The right number? tnz page_error$invalid_deposit_list_args " No mlr (pr),(pr) " Copy arg list desc9a ap|0,deposit_list_argl_chars desc9a arg,deposit_list_argl_chars eppap free_store_temp " And change first spriap arg+6 stz arg+1 " No descriptors call pc_deposit$deposit_list(arg) deposit_list_returns: tsx6 meter_deposit return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_try - internal procedure to attempt a deposit to the " stock " " tsx7 deposit_try " " " " On entry, " bp -> PVTE " bb -> record stock " ab -> stock_seg$meters " Areg = disk address " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_try: tsx6 page_fault$savex " Recursive use of x7 ana strip_null_addr " Make address live cana add_type.disk,dl " Is it a disk address tze page_error$deposit_invalid_addtype " No - bad news tsx6 check_address_range " Make sure it's in the paging region arl 18 " Address to AL tsx7 stock$deposit " Attempt to deposit to stock tra page_fault$unsavex " Failed tra page_fault$unsavex_1 " Succeeded " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " setup - internal procedure to save/establish registers " " tsx6 setup " " On entry, " pvtx contains index of PVTE " " On return, " bp -> pvte " bb -> record stock " ab -> stock_seg$meters " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " setup: stx2 savx2_3 "Save PC registers sxl3 savx2_3 inhibit on <+><+><+><+><+><+><+><+><+><+><+><+><+><+><+><+> read_clock sbaq pds$cpu_time " AQ = Total CPU Time sbaq pds$virtual_delta " AQ = Total VCPU Time staq free_store_start_time " Save for metering inhibit off <-><-><-><-><-><-><-><-><-><-><-><-><-><-><-><-> eppbp pvt$array " PVTE array ldq pvte_size,dl mpy pvtx " Offset of one beyond eppbp bp|-pvte_size,ql " bp -> PVTE spribp free_store_temp_1 lprpbb bp|pvte.volmap_stock_ptr " bb -> record stock lprpab bb|record_stock.pvtep " Check synchronization epaq ab|0 " PVTE ptr eraq free_store_temp_1 " Compare with other PVTE ptr canaq segno_offset_mask " Interesting bits only tnz page_error$stock_out_of_synch " Don't point to each other epbpab bb|0 " ab -> base of stock_seg eppab ab|stock_seg.meters " ab -> meters tra 0,x6 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_address_range - internal procedure to validate that an " address is within the paging region of the device " " tsx6 check_address_range " " On entry, " bp -> pvte " AU contains non-null address (AL is not relevant) " " On return, " Areg is not changed " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_address_range: sta devadd " For page_error ldx0 bp|pvte.baseadd " Begin of paging region cmpx0 devadd " Above beginning tpnz page_error$address_out_of_range " No lxl0 bp|pvte.totrec " Size of paging region adlx0 bp|pvte.baseadd " Address 1 beyond end of region cmpx0 devadd " Below end tmoz page_error$address_out_of_range " No tra 0,x6 " Address within paging region " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_scav_check - internal procedure to check for a conflict " in the address just withdrawn with a scavenge in progress. " A conflict exists if the address is marked as in-user or " conflict. " " tsx6 withdraw_scav_check " " " " On entry, " bp -> PVTE " ab -> stock_seg$meters " AU contains non-null address " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_scav_check: lxl0 bp|pvte.scavenger_block_rel " Scavenge in progress tze 1,x6 " No ldq bp|pvte.scav_check_address_word canq pvte.scav_check_address,dl " Does scavenger want us to check the address tze 1,x6 " No aos ab|rsmeters.withdraw_check_scav " Meter eppap scavenger_data$+0,x0 " ap -> scavenger block eax0 0,au " Record address sblx0 bp|pvte.baseadd " Record address w/i paging region eppap ap|scavenger_block.records,x0 " ap -> record block for this record address withdraw_scav_lock: " Lock record block ldq ap|0 lda ap|0 canq record_block.lock,dl " Locked tnz withdraw_scav_lock " Yes ora record_block.lock,dl stacq ap|0 " Try to lock tnz withdraw_scav_lock " Failed arl record_block.state_shift " Extract state of address ana record_block.state_mask,dl tra withdraw_check_state,al " And do state-ly things withdraw_check_state: tra withdraw_unseen tra withdraw_free tra withdraw_in_use tra withdraw_conflict withdraw_unseen: withdraw_free: " Mark in use to this vtocx, page number stz free_store_temp lda vtocx " Faulting VTOCE index ana record_block.vtocx_mask,dl als record_block.vtocx_shift orsa free_store_temp lda pageno " Faulting page number ana record_block.pageno_mask,dl als record_block.pageno_shift orsa free_store_temp lda STATE_IN_USE,dl als record_block.state_shift ora free_store_temp ldq ap|0 stacq ap|0 " Unlock address tnz page_error$scav_stacq_fails tra 1,x6 withdraw_in_use: lda STATE_CONFLICT,dl " Change state to conflict ldq record_block.state_mask,dl als record_block.state_shift qls record_block.state_shift orq record_block.lock,dl erq =-1 " Q has mask to reset state, lock stq free_store_temp ldq ap|0 " Pick up address block ansq free_store_temp " Reset state, lock ora free_store_temp " Address block with state, lock reset ldq ap|0 stacq ap|0 " Unlock address block tnz page_error$scav_stacq_fails withdraw_conflict: aos ab|rsmeters.withdraw_conflict " Meter tra 0,x6 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_check_scav - Internal procedure to determine whether this " volume is being scavenged and addresses being " deposited need to be checked. " " tsx6 deposit_check_scav " " " " On entry, " bp -> PVTE " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_check_scav: lxl0 bp|pvte.scavenger_block_rel " Scavenge going on? tze 1,x6 " No ldq bp|pvte.scav_check_address_word canq pvte.scav_check_address,dl " Check addresses? tze 1,x6 " No tra 0,x6 " Yes " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Returns to page control, restoring registers " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unsavex: tsx6 restore_regs tra page_fault$unsavex unsavex_1: tsx6 restore_regs tra page_fault$unsavex_1 unsavex_2: tsx6 restore_regs tra page_fault$unsavex_2 restore_regs: ldx2 savx2_3 lxl3 savx2_3 eppbb sst$ eppbp bb|0,x2 " Fall through to meter " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " meter CPU time " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " meter: eax0 0 " Withdraw tra meter_common meter_deposit: eax0 1 " Deposit inhibit on <+><+><+><+><+><+><+><+><+><+><+><+><+><+><+><+> meter_common: read_clock sbaq pds$cpu_time " AQ = Total CPU time sbaq pds$virtual_delta " AQ = Total VCPU time sbaq free_store_start_time " AQ = VCPU in free_store eax0 0,x0 " Withdraw tnz meter_deposit_exit " No adaq ab|rsmeters.withdraw_time staq ab|rsmeters.withdraw_time increment ab|rsmeters.withdraw_calls tra 0,x6 meter_deposit_exit: adaq ab|rsmeters.deposit_time staq ab|rsmeters.deposit_time increment ab|rsmeters.deposit_calls tra 0,x6 inhibit off <-><-><-><-><-><-><-><-><-><-><-><-><-><-><-><-> end  get_ptrs_.alm 11/11/89 1105.1r w 11/11/89 0804.2 41796 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " GET_PTRS_ -- Program to remap page and segment control pointers " " Modification history: " Modified for followon by Dick Snyder Aug 5, 1972 " Modified to fix get_ptrs_$given_astep bugs by Dick Snyder Sept 6, 1972 " New Storage System. given_cmep and given_ptp deleted. March 21, 1975 by BSG. " Modified to remove SDW alignment assumption, 5/14/75 by Mabee " Modified for ADP conversion, 03/17/81, W. Olin Sibert " Modified for $given_sdw, unpaged segment check, 03/21/81, WOS " Modified for $ptw_to_cmep, 04/17/81, WOS " Modified for paged unpaged segments, October 1983, Keith Loepere. " name get_ptrs_ entry given_astep " ASTEP to SDW conversion entry given_sdw " SDW to ASTEP conversion entry given_segno " SEGNO to ASTEP conversion entry ptw_to_cmep " PTWP to CMEP conversion " " GET_PTRS_$GIVEN_ASTEP " " Returns an SDW containing the proper address for a segment, given " its ASTE pointer. Call is: " " sdw = get_ptrs_$given_astep (astep); given_astep: epp1 sst$+0 get pointer to SST epp2 ap|2,* get ptr to astep eaa pr2|0,* get word offset of aste in au ldq pr1|aste.ptsi_word,au get page table size for bound field qrs aste.ptsi_shift anq aste.ptsi_mask,dl leave only page table size index ldq sst$pts,ql pick up page table size from SST header qls page_power-4 Convert to 16 word block count sblq 1,dl Subtract 1 for bound field format qls sdw.bound_shift and put it in the right region of the SDW adla aste_size,du add in size of an AST entry arl 18 and put in AL to get page table offset adla sst$ptwbase add in absolute offset of page table array als coreadd_to_sdw.ls position page table address oraq read_write_valid set correct bits in sdw epp2 ap|4,* return the SDW to the caller sta pr2|0 in a possibly unaligned word pair stq pr2|1 return: short_return " " " GET_PTRS_$GIVEN_SDW " " Given a pointer to an SDW, returns the AST entry pointer for the " (necessarily paged) segment. Call is: " " astep = get_ptrs_$given_sdw (sdw_ptr); " " GET_PTRS_$GIVEN_SEGNO " " Like get_ptrs_$given_sdw, but returns an AST entry pointer when " given a segment number. Call is: " " astep = get_ptrs_$given_segno (segno); " given_sdw: epp2 ap|2,* Get the pointer argument epp2 pr2|0,* join_given_sdw: ldq pr2|0 Get the first (address) word of the SDW epp1 sst$+0 get pointer to SST qrl sdw_to_coreadd.rl right justify address anq =v36/coreadd_mask and leave only the address portion tze return_null cmpq unpaged_page_tables$0+upt.sst_last_loc test for pagedness -- tpl return_null this call invalid for unpaged segments sbq unpaged_page_tables$0+upt.sst_absloc make relative to SST segment tmi return_null epp3 pr1|-aste_size,ql generate final pointer return_sdwadd: spri3 ap|4,* return to user short_return given_segno: lda ap|2,* pick up the segment number als 1 multiply segno by sdw size epp2 dseg$+0,al get a pointer to the SDW, tra join_given_sdw and join common code return_null: epp3 =its(-1,1),* get a null pointer spri3 ap|4,* and return it short_return " " GET_PTRS_$PTW_TO_CMEP " " Returns a pointer to the CME describing the page frame for the given " PTW, or returns null if the PTW is not a valid (in-core) PTW " " cmep = get_ptrs_$ptw_to_cmep (ptwp); ptw_to_cmep: epp1 ap|2,* address ptw pointer lda pr1|0,* get the PTW cana ptw.valid,dl is the page in core? tze return_null nope. ana ptw_add_mask,du mask off all but the address arl ptw_to_cmep_lower.rl and convert to a CMEP epp3 sst$cmp,*al the CME pointer itself spri3 ap|4,* return it short_return " even read_write_valid: " Bits for a valid (incore) SDW with read/write access iftarget l68 " Bits are in different halfwords vfd 18/0,18/sdw.valid vfd 18/sdw.read+sdw.write,18/sdw.not_a_gate ifend iftarget adp vfd 18/0,18/sdw.valid vfd 18/0,18/sdw.read+sdw.write+sdw.not_a_gate ifend include page_info include sdw include ptw include aste include cmp include unpaged_page_tables end  hc_dm_util.pl1 11/11/89 1105.1rew 11/11/89 0804.2 174852 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-07-17,CLJones), approve(86-01-26,MCR7330), audit(86-01-16,Tague), install(86-07-17,MR12.0-1097): to perform security auditing. 2) change(86-07-10,Dupuis), approve(86-01-26,MCR7330), audit(86-07-14,GDixon), install(86-07-17,MR12.0-1097): Changed the 85-07-17 auditing code so that it wouldn't take a page fault while it had the page table locked, and to audit the GRANT'ing in all cases. END HISTORY COMMENTS */ /* format: style5,^indcomtxt */ hc_dm_util$activate: proc (Ptsi); /* DESCRIPTION: Utility routines for Data Management Support activate - note activation of a synchronized segment of a given size. allocate_journal_index - get ring-2 Data Management a free journal index. check_activate - determine whether a synchronized segment of a given size can be activated. deactivate - note deactivation of a synchronized segment of a given size. free_journal_index - free a previously allocated journal index. get_journal_stamp - given a journal index, returns the current time stamp. get_n_journals - return the number of journal slots allocated, i.e, dm_journal.n_journal. get_max_held_per_journal - returns the value of dm_journal.max_held_per_journal set_journal_stamp - set the time stamp of a journal for Page Control. validate_bj_uid - Checks the supplied uid against the uid in the dm_journal_seg_. */ /* HISTORY: Written October 1982 by J. Bongiovanni. Modified: May 1983 by E. N. Kittlitz to fix free to not write Journal_Idx. 05/13/85 by R. Michael Tague to use limit_covert_channel on calls to $allocate_journal_index. Upgraded access check in set_journal_stamp and free_journal_index to check for seg privs. Added dm_journal_seg_ locking in set_time_stamp. Generally cleaned up dm_journal_seg_ locking for all entries. Added the entries $validate_bj_uid, $get_journal_stamp, $get_n_journals, and $get_max_held_per_journal so that ring-2 DM would not need to read the dm_journal_seg_. Reformatted. 05/20/85 by R. Michael Tague to get the AIM checking on $free_journal, $get_journal_stamp, and $validate_journal_stamp right. */ /* Parameter */ dcl Code fixed bin (35) parameter; /* Standard Error Code */ dcl Journal_Idx fixed bin parameter; /* Journal Index */ dcl Ptsi fixed bin (3) parameter; /* Page Table Size index */ dcl Time_Stamp fixed bin (71) parameter; /* New time stamp */ dcl Uid bit (36) aligned; /* Ring-2 Unique ID for Journal */ /* Automatic */ dcl code fixed bin (35); dcl journal_idx fixed bin; dcl jx fixed bin; dcl me char (40); dcl old_mask fixed bin (71); dcl ptwp ptr; dcl time_stamp fixed bin (71); dcl uid bit (36) aligned; dcl validated bit (1) aligned; /* External */ dcl access_operations_$dm_journal_allocate bit (36) aligned ext static; dcl access_operations_$dm_journal_free bit (36) aligned ext static; dcl access_operations_$dm_journal_read_attr bit (36) aligned ext static; dcl access_operations_$dm_journal_write_attr bit (36) aligned ext static; dcl error_table_$bad_arg fixed bin (35) external; dcl error_table_$dm_journal_pages_held fixed bin (35) external; dcl error_table_$dm_not_enabled fixed bin (35) external; dcl error_table_$invalid_dm_journal_index fixed bin (35) external; dcl error_table_$no_journals_free fixed bin (35) external; dcl error_table_$synch_seg_limit fixed bin (35) external; dcl pds$access_authorization bit (72) aligned external; dcl pds$validation_level fixed bin (3) external; dcl sst$dm_enabled bit (1) aligned external; dcl tc_data$end_of_time fixed bin (71) external; /* Entry */ dcl access_audit_$log_obj_class entry options (variable); dcl limit_covert_channel entry (fixed bin); dcl lock$lock_fast entry (ptr); dcl lock$unlock_fast entry (ptr); dcl page_synch$unlink_journal entry (fixed bin); dcl pmut$lock_ptl entry (fixed bin (71), ptr); dcl pmut$unlock_ptl entry (fixed bin (71), ptr); dcl (read_allowed_, write_allowed_, read_write_allowed_) entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); /* Builtin */ dcl addr builtin; dcl char builtin; dcl clock builtin; dcl divide builtin; dcl ltrim builtin; /* Constants */ dcl DENY bit (1) aligned static options (constant) init ("0"b); dcl GRANT bit (1) aligned static options (constant) init ("1"b); %page; /* ************************************************************************ * $activate - Notes activation of a synchronized segment. It is * * assumed that that Global AST Lock is held by the process. * ************************************************************************ */ dm_journal_segp = addr (dm_journal_seg_$); dm_journal.per_aste_pool (Ptsi).n_active = dm_journal.per_aste_pool (Ptsi).n_active + 1; return; %page; /* ************************************************************************ * $allocate_journal_index - give ring-2 an unused journal index. * * Possible covert channel corrected by call to limit_covert_channel. * ************************************************************************ */ allocate_journal_index: entry (Uid, Journal_Idx, Code); if ^sst$dm_enabled then do; Code = error_table_$dm_not_enabled; return; end; Journal_Idx = 0; uid = Uid; journal_idx = 0; me = "hc_dm_util$allocate_journal_index"; code = 0; if uid = ""b then do; Code = error_table_$bad_arg; return; end; call limit_covert_channel (1); dm_journal_segp = addr (dm_journal_seg_$); call lock$lock_fast (addr (dm_journal.lock)); dm_journal.allocate_calls = dm_journal.allocate_calls + 1; if dm_journal.n_journals <= dm_journal.n_journals_inuse then code = error_table_$no_journals_free; else do; do jx = 1 to dm_journal.n_journals while (dm_journal.per_journal (jx).uid ^= ""b); end; if jx > dm_journal.n_journals then code = error_table_$no_journals_free; else do; dm_per_journalp = addr (dm_journal.per_journal (jx)); dm_journal.n_journals_inuse = dm_journal.n_journals_inuse + 1; dm_per_journal.time_stamp = clock (); dm_per_journal.access_class = pds$access_authorization; dm_per_journal.uid = uid; call RECOMPUTE_THRESH; journal_idx = jx; call AUDIT (GRANT, access_operations_$dm_journal_allocate, journal_idx, dm_per_journal); end; end; call lock$unlock_fast (addr (dm_journal.lock)); Journal_Idx = journal_idx; Code = code; return; %page; /* ************************************************************************ * $check_activate - checks whether a synchronized segment of a given * * size may be activated. It is assumed that the Global AST Lock is * * held. * ************************************************************************ */ check_activate: entry (Ptsi, Code); if ^sst$dm_enabled then do; Code = error_table_$dm_not_enabled; return; end; Code = 0; dm_journal_segp = addr (dm_journal_seg_$); dm_journal.activate_calls = dm_journal.activate_calls + 1; if dm_journal.per_aste_pool (Ptsi).n_active >= dm_journal.per_aste_pool (Ptsi).threshold then do; dm_journal.activate_denied = dm_journal.activate_denied + 1; Code = error_table_$synch_seg_limit; end; return; %page; /* ************************************************************************ * $deactivate - Note deactivation of a synchronized segment. * ************************************************************************ */ deactivate: entry (Ptsi); dm_journal_segp = addr (dm_journal_seg_$); dm_journal.deactivate_calls = dm_journal.deactivate_calls + 1; dm_journal.per_aste_pool (Ptsi).n_active = dm_journal.per_aste_pool (Ptsi).n_active - 1; return; %page; /* ************************************************************************ * $free_journal_index - frees a previously allocated journal index. * * Authorization check is performed. * ************************************************************************ */ free_journal_index: entry (Journal_Idx, Code); if ^sst$dm_enabled then do; Code = error_table_$dm_not_enabled; return; end; journal_idx = Journal_Idx; me = "hc_dm_util$free_journal_index"; code = 0; dm_journal_segp = addr (dm_journal_seg_$); call lock$lock_fast (addr (dm_journal.lock)); dm_journal.free_calls = dm_journal.free_calls + 1; if (journal_idx <= 0) | (journal_idx > dm_journal.n_journals) then code = error_table_$invalid_dm_journal_index; else do; dm_per_journalp = addr (dm_journal.per_journal (journal_idx)); if dm_per_journal.uid = ""b then code = error_table_$invalid_dm_journal_index; else if ^( read_write_allowed_ (pds$access_authorization, dm_per_journal.access_class) | (addr (pds$access_authorization) -> aim_template.seg)) then do; call AUDIT (DENY, access_operations_$dm_journal_free, journal_idx, dm_per_journal); code = error_table_$invalid_dm_journal_index; end; else do; call AUDIT (GRANT, access_operations_$dm_journal_free, journal_idx, dm_per_journal); code = error_table_$dm_journal_pages_held; call pmut$lock_ptl (old_mask, ptwp); if dm_per_journal.n_held = 0 then do; dm_per_journal.time_stamp = tc_data$end_of_time; dm_per_journal.uid = ""b; dm_per_journal.access_class = ""b; code = 0; end; call pmut$unlock_ptl (old_mask, ptwp); if code = 0 then do; dm_journal.n_journals_inuse = dm_journal.n_journals_inuse - 1; call RECOMPUTE_THRESH; end; end; end; call lock$unlock_fast (addr (dm_journal.lock)); Code = code; return; %page; /* ************************************************************************ * get_journal_stamp - Returns the value of the journal stamp for a * * given dm_journal_seg_ index. An access class check is performed * * before the information is returned. * ************************************************************************ */ get_journal_stamp: entry (Journal_Idx) returns (fixed bin (71)); journal_idx = Journal_Idx; time_stamp = 0; me = "hc_dm_util$get_journal_stamp"; if ^sst$dm_enabled then return (time_stamp); dm_journal_segp = addr (dm_journal_seg_$); call lock$lock_fast (addr (dm_journal.lock)); if (journal_idx > 0) & (journal_idx <= dm_journal.n_journals) then do; dm_per_journalp = addr (dm_journal.per_journal (journal_idx)); if dm_per_journal.uid ^= ""b then if read_allowed_ (pds$access_authorization, dm_per_journal.access_class) | (addr (pds$access_authorization) -> aim_template.seg) then do; /**** call AUDIT (GRANT, access_operations_$dm_journal_read_attr, journal_idx, dm_per_journal); We'd audit if the performance implications weren't horrendous. ****/ time_stamp = dm_per_journal.time_stamp; end; else call AUDIT (DENY, access_operations_$dm_journal_read_attr, journal_idx, dm_per_journal); end; call lock$unlock_fast (addr (dm_journal.lock)); return (time_stamp); %page; /* ************************************************************************ * get_max_held_per_journal - Return the value of * * dm_journal.max_held_per_journal from dm_journal_seg_. * ************************************************************************ */ get_max_held_per_journal: entry () returns (fixed bin); if ^sst$dm_enabled then return (0); else return (addr (dm_journal_seg_$) -> dm_journal.max_held_per_journal); %page; /* ************************************************************************ * get_n_journals - Return the value of dm_journal.get_n_journals from * * dm_journal_seg_. * ************************************************************************ */ get_n_journals: entry () returns (fixed bin); if ^sst$dm_enabled then return (0); else return (addr (dm_journal_seg_$) -> dm_journal.n_journals); %page; /* ************************************************************************ * $set_journal_stamp - sets the time stamp for a specified journal. * ************************************************************************ */ set_journal_stamp: entry (Journal_Idx, Time_Stamp, Code); journal_idx = Journal_Idx; time_stamp = Time_Stamp; if ^sst$dm_enabled then do; Code = error_table_$dm_not_enabled; return; end; me = "hc_dm_util$set_journal_stamp"; code = 0; dm_journal_segp = addr (dm_journal_seg_$); call lock$lock_fast (addr (dm_journal.lock)); dm_journal.set_stamp_calls = dm_journal.set_stamp_calls + 1; if (journal_idx <= 0) | (journal_idx > dm_journal.n_journals) then code = error_table_$invalid_dm_journal_index; else do; dm_per_journalp = addr (dm_journal.per_journal (journal_idx)); if dm_per_journal.uid = ""b then code = error_table_$invalid_dm_journal_index; else if ^( write_allowed_ (pds$access_authorization, dm_per_journal.access_class) | (addr (pds$access_authorization) -> aim_template.seg)) then do; call AUDIT (DENY, access_operations_$dm_journal_write_attr, journal_idx, dm_per_journal); code = error_table_$invalid_dm_journal_index; end; else do; /**** call AUDIT (GRANT, access_operations_$dm_journal_write_attr, journal_idx, dm_per_journal); We'd audit if the performance implications weren't horrendous. ****/ dm_per_journal.time_stamp = time_stamp; call pmut$lock_ptl (old_mask, ptwp); call page_synch$unlink_journal (journal_idx); call pmut$unlock_ptl (old_mask, ptwp); end; end; call lock$unlock_fast (addr (dm_journal.lock)); Code = code; return; %page; /* ************************************************************************ * validate_bj_uid - Given a dm_journal_seg_ index and BJ uid, this * * entry returns true if the supplied uid matches the uid indexed in * * the dm_journal_seg_ and the caller has authorization to know this. * ************************************************************************ */ validate_bj_uid: entry (Uid, Journal_Idx) returns (bit (1) aligned); uid = Uid; journal_idx = Journal_Idx; validated = "0"b; if ^sst$dm_enabled then return ("0"b); me = "hc_dm_util$validate_bj_uid"; dm_journal_segp = addr (dm_journal_seg_$); call lock$lock_fast (addr (dm_journal.lock)); if (journal_idx > 0) & (journal_idx <= dm_journal.n_journals) then do; dm_per_journalp = addr (dm_journal.per_journal (journal_idx)); if read_allowed_ (pds$access_authorization, dm_per_journal.access_class) | (addr (pds$access_authorization) -> aim_template.seg) then do; /**** call AUDIT (GRANT, access_operations_$dm_journal_read_attr, journal_idx, dm_per_journal); We'd audit if the performance implications weren't horrendous. ****/ if uid ^= ""b & uid = dm_per_journal.uid then validated = "1"b; end; else call AUDIT (DENY, access_operations_$dm_journal_read_attr, journal_idx, dm_per_journal); end; call lock$unlock_fast (addr (dm_journal.lock)); return (validated); %page; /* ************************************************************************ * RECOMPUTE_THRESH - Internal Procedure to recompute max held pages * * per journal, which is used by ring-2 Data Management to prevent * * flooding the system with held pages. * ************************************************************************ */ RECOMPUTE_THRESH: proc; if dm_journal.n_journals_inuse = 0 then dm_journal.max_held_per_journal = dm_journal.max_held_pages_mem; else dm_journal.max_held_per_journal = divide (dm_journal.max_held_pages_mem, dm_journal.n_journals_inuse, 17); end RECOMPUTE_THRESH; %page; /* ************************************************************************ * AUDIT - Internal procedure to audit security-related events relating * * to journals. * ************************************************************************ */ AUDIT: proc (outcome, operation, id, journal_entry); dcl outcome bit (1) aligned parameter; /* (I) signifies whether or not the operation was granted */ dcl operation bit (36) aligned parameter; /* (I) the operation in question */ dcl id fixed bin parameter; /* (I) the journal index */ dcl 1 journal_entry like dm_per_journal parameter aligned; /* (I) for auditing */ dcl event_flags bit (36) aligned; dcl object_name char (32); event_flags = ""b; /* clear all flags */ addr (event_flags) -> audit_event_flags.grant = (outcome = GRANT); object_name = "DM journal #" || ltrim (char (id)); call access_audit_$log_obj_class (me, pds$validation_level, event_flags, operation, journal_entry.access_class, object_name, 0, null (), 0, "UID=^w", journal_entry.uid); return; %include access_audit_eventflags; end AUDIT; %page; %include dm_journal_seg_; %page; %include aim_template; end hc_dm_util$activate;  lock_volmap.alm 11/11/89 1105.1r w 11/11/89 0804.2 71361 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_volmap " " Routines for manipulating the per-volume volume map lock. " Lock succeeds if the lock can be obtained and the asynchronous " state is idle. Otherwise, it fails. The asynchronous state " is protected in the following way: " " To change the state from IDLE requires both the volume map " lock and the Page Table Lock. " " To change the state from anything else requires the Page " Table Lock. " " Entries: " " lock_unwired - lock from outside of page control " lock_wired_nowait - lock from page control, don't wait " lock_wired_wait - lock from page control, set wait event " unlock_unwired - unlock from outside of page control " unlock_wired - unlock from page control " " Written February 1982 by J. Bongiovanni " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name lock_volmap segdef lock_unwired segdef unlock_unwired segdef lock_wired_nowait segdef lock_wired_wait segdef unlock_wired even notify_arg_list: vfd o18/2,o18/4,o36/0 " include apte " include page_info " include pvt " include pvte " include pxss_page_stack " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_unwired " " call page$lock_volmap (pvtep) " " pvtep -> PVTE " " Returns with lock held and async state idle " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_unwired: push eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE lock_unwired_retry: tsx7 lock_wired_wait " Try to lock lock tra lock_unwired_fails " Didn't get it return " Got it lock_unwired_fails: call pxss$wait " Wait event already set tra lock_unwired_retry " Go for it again " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unlock_unwired " " call page$unlock_volmap (pvtep) " " pvtep -> PVTE " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unlock_unwired: push eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE tsx7 unlock_wired return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_wired_nowait " " tsx7 lock_volmap$lock_wired_nowait " " " " On entry, " bp -> PVTE " " On return, " if succeeded, then lock owned by process and async state is idle " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_wired_nowait: increment pvt$volmap_lock_nowait_calls tsx6 lock_try " Attempt to lock tra lock_wired_fails " Failed tra 1,x7 " Succeeded lock_wired_fails: increment pvt$volmap_lock_nowait_fails tra 0,x7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_wired_wait " " tsx7 lock_volmap$lock_wired_wait " " " " On entry, " bp -> PVTE " " On return, " if succeeded, lock help by process and async state is idle " if failed, appropriate wait event is in APTE, notify switch set " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_wired_wait: increment pvt$volmap_lock_wait_calls tsx6 lock_try " Try to get lock tra lock_set_wait " Failed tra 1,x7 " Succeeded lock_set_wait: increment pvt$volmap_lock_wait_fails stq lock_volmap_temp " Notify switch bit eppap pds$apt_ptr,* " ap -> APTE sta ap|apte.wait_event " Set wait event lock_wired_retry: ldq bp|0,x0 " Notify switch word lda bp|0,x0 ora lock_volmap_temp " Set notify switch stacq bp|0,x0 " Into PVTE tnz lock_wired_retry " Lost race, retry tsx6 lock_try " Try again, in case race tra 0,x7 " Failed again eppap pds$apt_ptr,* " Got it this time, reset wait stz ap|apte.wait_event tra 1,x7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unlock_wired " " tsx7 lock_volmap$unlock_wired " " On entry, " bp -> PVTE " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unlock_wired: ldq pds$processid lda 0,dl stacq bp|pvte.volmap_lock " Unlock tnz page_error$volmap_stacq_fails epbpap bp|0 " ap -> PVT unlock_wired_retry: ldq ap|pvt.n_volmap_locks_held " Meter total lock time tze 0,x7 " Something wrong lda ap|pvt.n_volmap_locks_held sta lock_volmap_temp " Save old value sba 1,dl " One fewer lock held stacq ap|pvt.n_volmap_locks_held " Update tnz unlock_wired_retry " Lost race ldaq ap|pvt.last_volmap_time " Last lock/unlock staq lock_volmap_temp_1 " Save rccl sys_info$clock_,* " Current time staq ap|pvt.last_volmap_time sbaq lock_volmap_temp_1 " Delta mpy lock_volmap_temp " Integral adaq ap|pvt.total_volmap_lock_time staq ap|pvt.total_volmap_lock_time " Total integral unlock_wired_notify_retry: ldq bp|pvte.volmap_lock_notify_word " Check for notify lda bp|pvte.volmap_lock_notify_word cana pvte.volmap_lock_notify,dl tze 0,x7 " Nobody to notify era pvte.volmap_lock_notify,dl " Reset notify bit stacq bp|pvte.volmap_lock_notify_word " Into PVTE tnz unlock_wired_notify_retry " Lost race eaa bp|0 " PVTE offset arl 18 " Into AL epbpap bp|0 " ap -> PVT ora ap|pvt.volmap_lock_wait_constant " Event to notify sta arg+4 eppap arg+4 spriap arg+2 ldaq notify_arg_list staq arg call pxss$notify(arg) tra 0,x7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_try " " Internal procedure to attempt lock " " tsx6 lock_try " " " " On entry, " bp -> PVTE " " On successful return, " Lock help by process " Async state is idle " " On failure return, " Areg contains wait event " Qreg contains notify bit " x0 is offset into PVTE of notify word " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_try: epbpap bp|0 " ap -> PVT lda pds$processid cmpa bp|pvte.volmap_lock " MYLOCK? tze page_error$volmap_mylock " Yes stac bp|pvte.volmap_lock " Go for it tze lock_try_got " Got it eaa bp|0 " AU = PVTE offset arl 18 " AL = PVTE offset ora ap|pvt.volmap_lock_wait_constant " Areg = wait event ldq pvte.volmap_lock_notify,dl " Notify bit eax0 pvte.volmap_lock_notify_word " Notify word tra 0,x6 lock_try_got: ldx0 bp|pvte.volmap_async_state cmpx0 VOLMAP_ASYNC_IDLE,du " Is asynchronous state idle tnz lock_try_not_idle " No aos ap|pvt.n_volmap_locks " Meter lock_try_retry: ldq ap|pvt.n_volmap_locks_held " Meter total lock time lda ap|pvt.n_volmap_locks_held sta lock_volmap_temp " Save old value ada 1,dl " One more lock held stacq ap|pvt.n_volmap_locks_held " Update tnz lock_try_retry " Lost race ldaq ap|pvt.last_volmap_time " Last lock/unlock staq lock_volmap_temp_1 " Save rccl sys_info$clock_,* " Current time staq ap|pvt.last_volmap_time sbaq lock_volmap_temp_1 " Delta mpy lock_volmap_temp " Integral adaq ap|pvt.total_volmap_lock_time staq ap|pvt.total_volmap_lock_time " Total integral tra 1,x6 lock_try_not_idle: lrl 36 " Areg = 0, Qreg = processid stacq bp|pvte.volmap_lock " Unlock tnz page_error$volmap_stacq_fails " Bad news eaa bp|0 " AU = PVTE offset arl 18 " AL = PVTE offset ora ap|pvt.volmap_idle_wait_constant " Areg = wait event ldq pvte.volmap_idle_notify,dl " Notify bit eax0 pvte.volmap_idle_notify_word " Notify word tra 0,x6 end  page.alm 11/11/89 1105.1rew 11/11/89 0804.2 28737 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " page This program is a transfer vector to the various " component procedures referenced as entries to 'page'. " " All transfers are made to 'segdef'ed locations in " the component procedures. " " " " " " " " " " " " " " " " " " " " " " " " Last Modified (Date and Reason) " " Modified 4/8/74 by S.H.Webber as part of merging unprivileged " and privileged code of pc " Modified 6/10/74 by B. Greenberg for accessible lock/unlock and cam, " and also iobm " Modified 5/3/77 by B. Greenberg for macro alm. " Deleted unload_old_process, RE Mullen 5/16/77 " Modified 01/24/81, J. Bongiovanni, for new cam " Modified 03/29/81, W. Olin Sibert, for conditional Page Multi-level " Modified 03/07/82, J. Bongiovanni, to remove PML and for record stocks " Modified 07/28/82, J. Bongiovanni, for scavenger side-door " Modified 831219, E. N. Kittlitz, for pc withdraw side-door name page macro pagentry entry &1 &1: tra &2 &end pagentry cam_wait,cam_cache$cam_with_wait_ext pagentry cam,cam_cache$cam_ext pagentry cam_cache,cam_cache$cam_cache_ext pagentry cam_ptws,cam_cache$cam_ptws_ext pagentry deposit,free_store$deposit pagentry deposit_list,free_store$deposit_list pagentry done,page_fault$done pagentry drain_record_stock,volmap$drain_stock pagentry enter_data,page_fault$enter_data pagentry esd_reset,device_control$esd_reset pagentry evict,evict_page$evict pagentry fault,page_fault$fault pagentry free_address_for_scavenge,volmap_util$free_address_for_scavenge pagentry grab_volmap_page_unwired,volmap_page$grab_volmap_page_unwired pagentry init,device_control$init pagentry lock_ptl,page_fault$lock_ptl_ext pagentry lock_volmap,lock_volmap$lock_unwired pagentry pcleanup,page_fault$pcleanup pagentry poll_volmap_io,volmap_page$poll_io pagentry post_purge,post_purge$post_purge pagentry pre_page_info,page_fault$pre_page_info pagentry pread,page_fault$pread pagentry pwait,device_control$pwait pagentry pwrite,page_fault$pwrite pagentry reset_pvte,volmap$reset_pvte pagentry reset_working_set,page_fault$reset_working_set pagentry thread_to_lru,page_fault$thread_lru_ext pagentry time_out,device_control$time_out pagentry trace_marker,page_fault$trace_marker pagentry unlock_ptl,page_fault$unlock_ptl_ext pagentry unlock_volmap,lock_volmap$unlock_unwired pagentry wire_abs,evict_page$wire_abs pagentry withdraw_list,free_store$withdraw_list_ext pagentry withdraw_range,stock$withdraw_range_ext pagentry write_volmap_page_unwired,volmap_page$write_volmap_page_unwired end  page_error.alm 11/11/89 1105.1r w 11/11/89 0804.3 280863 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), " audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): " Correct error message documentation. " 2) change(86-05-29,Fawcett), approve(86-04-11,MCR7383), " audit(86-06-11,Coppola), install(86-07-17,MR12.0-1097): " Add subvolume to error messages. " 3) change(87-02-18,Lippard), approve(87-03-16,MCR7640), " audit(87-06-17,Farley), install(87-07-17,MR12.1-1043): " Added entry to crash system on finding invalid volmap words (fix by " Swenson). " END HISTORY COMMENTS " " " " " " " " " " " " " " " " " " " " " " " " " " page_error this procedure contains the code for outputing " error messages that are generated by the machine " language parts of page control. " " First coded by Webber at time immemorial. " Modified for NSS by B. Greenberg '75 " Mexped by VanVleck, with Greenberg, 2/77,3/77 " Macro ALM and declaration macrology by BSG 5-6/77 " Interpreter by BSG 7/17/77 " Modified for stock, -PML by J. Bongiovanni February 1982 " Modified to move core map by E. N. Kittlitz June 1982 " Modified for scavenger, J. Bongiovanni, August 1982 " Modified for page_synch, J. Bongiovanni, October 1982 " Delete sst include file, Benson Margulies, January 1984 " Added covert channel audit message, Keith Loepere, January 1985. " Converted to access_audit_bin_header, Keith Loepere, January 1985. " Modified to use syserr_constants, syserr_mmdam_msg, " and segdamage_msg incls, EJ Sharpe, March 1985 " Modified to print the subvolume with the driveno for syserr, " R. A. Fawcett, July 1985 " " " " " " " " " " " " " " " " " " " " " " " " " " GENERAL STRATEGY: " First, we "adjust" pxss_page_stack to look like the TSX that " got us here did a PL/I "call" to page_error, but _w_e save all his " registers for him at sp|0 and sp|32 (decimal). " While running in pxss_page_stack we copy anything we want into "arg". " Then we do a push to new (upper) frame. " Here we set up an arg list and call syserr. " Then we pop up to the pxss_page_stack frame and return, " reloading his registers from the pxss_page_stack frame first. " " Interpreter strategy: " " Maximum code condensation of arglist preparation is achieved by " coding 1 word per arglist element. Tsx7 to "interpreter" " builds all of syserr arg list from arg "n" on in a "k" arg list: " " tsx7 interpreter " zero endl,2*n " zero k,4 " arg_n_description " arg_n_plus_1_description " ... " arg_k_description "endl: " description is 2 halfwords, first specifies arg addr, " second descriptor addr. Address for data is negative if " offset into pxss_page_stack, + if text. Descr. addr is always text. " " How to use the page_error programming language. " " This macrology enables the maintainter of page_error to generate " calls to syserr and syserr$binary with a maximum of ease. A typical " call to syserr is written like this: " " call_syserr 1,(page_fault: this and that ^o for ^a),devadd,drivename " " being equivalent to " " call syserr (1, "page_fault: this and that ^o for ^a", devadd, drivename) " " in PL/1. The ioa_arguments must be "declared" by the dcl or dclfix " macros. Usage is: " " dcl drivename,arg+18,char,4 " " meaning " " dcl drivename char (4) based (addr (arg)+18), so to speak. " " 1st arg is variable name, second is location, which must be in pxss_page_stack, " 3rd is data type (only char, fixed, ptr, bit provided now), 4th is precision, default 17. " " dclfix declares something by its own name as fixed bin (17). " 1st argument to call_syserr (or call_syserr_binary) is interpreted as being an offset " in pxss_page_stack if not a numeric literal. " " call_syserr_binary 1,(arg+4,*),syserr_binary_code,opt_subr,(ctrlstring),args... " " is similar. 2nd arg is DATA address- pointer developed from it. 3rd arg is suffix " in syserr_binary_def.incl.alm (i.e., xx for SB_xx, SBL_xx). opt_subr is the name " of a subroutine to be called by macro in new frame (currently only gseg_info). " Omit (,,) in other cases. gseg_info formats up seg-id type message, incrs. " sst$damaged_ct. " " " Declaration/arglist macrology. " macro dcl "dcl symbol,address(rel to U),type{,prec} maclist off,save macro iword_&1 zero -(&2),=v1/1,6/&3,17/0,12/&=&4,&[17&;&4&] &&end maclist restore &end macro dclfix maclist off,save &R&( dcl &i,&i,fixed &) maclist restore &end macro message &1.msg:aci "&2" &1.dsc: vfd 1/1,6/char,1/0,4/0,24/&l2 &end macro call_syserr new_frame tsx7 interpreter zero *+2+&K,2 zero 2*&K,4 ifint &1 zero =&1,fx ifend inint &1 zero -(&1),fx ifend zero &U.msg,&U.dsc &R3&( iword_&i &) tra csys message &U,(&2) &end macro call_syserr_binary new_frame ine &4,() &(4 tsx7 &i &) ifend ifint &1 eppap =&1 ifend inint &1 eppap &1 ifend spriap sp|syserr_arg_list+2 tsx7 interpreter zero *+2+&K-2,6 zero 2*&K,4 zero &U.sbc,fx zero &U.sbl,fx zero &U.msg,&U.dsc &R6&( iword_&i &) eppap &2 tsx7 binary_setup "no return &U.sbc: vfd 36/SB_&3 &U.sbl: vfd 36/SBL_&3 message &U,(&5) &end macro savexx savexx regname stcd sp|stack_frame.return_ptr bound_page_control spri sp|0 sreg sp|32 ine &1,none stx &1,sp|stack_frame.return_ptr+1 ifend ife &1,none stc1 sp|stack_frame.return_ptr+1 set loop message ifend &end macro new_frame push syserr_arg_list+frame_size epp U,sp|stack_frame.prev_sp,* &end " " " Sundry assembler declarations " name page_error segdef bad_device_id segdef device_error,out_of_core,ptl_mylock segdef zeroing_page segdef error_in_done segdef out_of_hc_part segdef page_fault_error,non_fatal_error segdef page_move_parity,wired_parity_error,reverting_page,deleting_mm_frame segdef volmap_async_error,deposit_invalid_addtype,stock_out_of_synch segdef invalid_deposit_list_args,address_out_of_range segdef volmap_stacq_fails,volmap_mylock,deposit_zero_address segdef volmap_inconsistent,stock_inconsistent,ptl_not_locked segdef wrong_async_state,volmap_page_async_error,volmap_page_invalid_call segdef deposit_inuse_address,bad_volmap_address,volmap_io_error,poll_state_change segdef scav_stacq_fails segdef no_free_dm_entries,dm_journal_seg_problem segdef excessive_seg_state_chg segdef invalid_volmap_word equ dcb,2 equ mbx,5 equ bsd,3 equ U,2 Use bp to point at pxss_page_stack frame equ syserr_arg_list,40 The whole upper frame is arglist. equ frame_size,8*16 equ binary_buffer,6*16 " " Declarations of variables for above macros " dclfix devadd,pvtx,core_add dcl argf,arg,fixed dcl a1char,arg+1,char,1 dcl a1f,arg+1,fixed dcl t1f,temp+1,fixed dcl ctrlrtag,temp,char,1 dcl a2f,arg+2,fixed dcl a3f,arg+3,fixed dcl a4f,arg+4,fixed dcl a5f,arg+5,fixed dcl devname,arg,char,4 dcl driveno,arg+1,char,4 dcl pvtep,arg+6,ptr dcl stockp,arg+8,ptr dcl person,arg,char,32 dcl categories,arg+8,bit,18 dcl level,arg+9,fixed bad_device_id: savexx none TRA from device_control call_syserr 1,(device_control: invalid pvtx ^w),pvtx csys: call syserr$syserr(sp|syserr_arg_list) " now we are on the upper frame. Get back. exit: epbpsb sp|0 inline pop eppbp sp|stack_frame.prev_sp,* inhibit on sprisp sb|stack_header.stack_end_ptr lpri bp|0 inhibit off lreg sp|32 rtcd sp|stack_frame.return_ptr return to alm code " out_of_hc_part: savexx none TRA from free_store call_syserr 1,(free_store: out of of room in hardcore partition.) " zeroing_page: savexx .ret lda 1,dl set entry sw tra zpag_rpag_merge reverting_page: savexx .ret lda 2,dl zpag_rpag_merge: sta temp+1 tsx7 get_ast_params tsx7 get_pageno lda arg+18 tsx0 setup_pvtname call_syserr_binary 0,sp|binary_buffer,zerpag,gseg_info, (page_fault: ^[Zeroing^;Reverting^] page on ^a_^a),t1f,devname,driveno " deleting_mm_frame: savexx .ret tsx0 setup_controller call_syserr_binary 3,sp|binary_buffer,mmdam,movemm, (page_fault: Deleting main memory at ^o, SCU ^a, due to parity errors.),core_add,ctrlrtag " page_move_parity: savexx .ret lda 0,dl info code tra evpp_merge wired_parity_error: savexx none fatal lda 1,dl evpp_merge: sta temp+1 tsx0 setup_controller tsx7 get_ast_params tsx7 get_pageno lda arg+18 tsx0 setup_pvtname call_syserr_binary temp+1,sp|binary_buffer,random_segdamage,gseg_info, (evict_page: ^[fatal ^]parity error moving page, frame at ^o, SCU ^a), t1f,core_add,ctrlrtag " page_fault_error: savexx none TSX6 from page_fault, don't go lda =1,dl function ldq =1,dl crash code tra pferr.join non_fatal_error: savexx .2ret TSX6 from page_fault lda =2,dl function ldq =0,dl pferr.join: sta arg stq arg+1 stz arg+2 x5 has loc in page_fault sxl5 arg+2 call_syserr arg+1,(page_fault: ^[^;non^]fatal error at loc ^o),argf,a2f " error_in_done: savexx none TZE from page_fault stz arg sxl .ptw,arg ptr to ptw call_syserr 1,(page_fault: fatal error in done, ptp ^o),argf " out_of_core: savexx none TPL from page_fault call_syserr 1,(page_fault: out of main memory) " ptl_mylock: savexx none TZE from page_fault call_syserr 1,(page_fault: mylock on global lock) " device_error: savexx .2ret TSX6 from page_fault lda =1 "ECCH" sta arg+2 lda ast|aste.pvtx_word,.aste arl aste.pvtx_shift ana aste.pvtx_mask,dl deverr.got_pvtx: tsx0 setup_pvtname call_syserr_binary 1,U|arg+18,read_nc,gseg_info, (page_fault: device read not complete ^a_^a ^w), devname,driveno,devadd " volmap_async_error: savexx none lda pvtx tsx0 setup_pvtname call_syserr 1,(free_store: volmap_seg async error for ^a_^a),devname,driveno deposit_invalid_addtype: savexx none sta devadd spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(free_store: Deposit non-disk address ^w on ^a_^a),devadd,devname,driveno address_out_of_range: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(free_store: Deposit/withdraw address ^w out of paging region on ^a_^a.),devadd,devname,driveno stock_out_of_synch: savexx none spribp arg+6 spribb arg+8 tsx0 setup_pvtname_from_pvtep call_syserr 1,(free_store: PVTE/Stock out of synch on ^a_^a. stockp=^p.),devname,driveno,stockp invalid_deposit_list_args: savexx none call_syserr 1,(free_store: Invalid call to free_store$deposit_list.) scav_stacq_fails: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(free_store: Scavenger STACQ fails on ^a_^a.),devname,driveno no_free_dm_entries: savexx none call_syserr 1,(page_synch: Out of free entries in dm_journal_seg_.) dm_journal_seg_problem: savexx none call_syserr 1,(page_synch: dm_journal_seg inconsistent.) " volmap_stacq_fails: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(lock_volmap: STACQ fails on ^a_^a.),devname,driveno volmap_mylock: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(lock_volmap: MYLOCK on volmap lock for ^a_^a.),devname,driveno " deposit_zero_address: savexx none call_syserr 1,(stock: deposit zero address.) " volmap_inconsistent: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(volmap: Volume Map inconsistent on ^a_^a.),devname,driveno invalid_volmap_word: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(volmap: Invalid volume map word on ^a_^a.),devname,driveno stock_inconsistent: savexx none spribp arg+6 spribb arg+8 tsx0 setup_pvtname_from_pvtep call_syserr 1,(volmap: record stock inconsistent on ^a_^a. stockp=^p.),devname,driveno,stockp deposit_inuse_address: savexx .ret spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 0,(volmap: Attempt to deposit in-use address ^o on ^a_^a.),devadd,devname,driveno bad_volmap_address: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(volmap: Invalid Volume Map address computation for ^o on ^a_^a.),devadd,devname,driveno " ptl_not_locked: savexx none call_syserr 1,(volmap_page: PTL not locked to process.) wrong_async_state: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(volmap_page: Invalid async state on ^a_^a.),devname,driveno volmap_page_async_error: savexx none spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 1,(volmap_page: Async error for ^a_^a.),devname,driveno volmap_page_invalid_call: savexx none call_syserr 1,(volmap_page: Invalid call.) volmap_io_error: savexx .ret sta arg+2 Page number spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 3,(volmap_page: Unrecoverable I/O error on Volmap page ^d of ^a_^a. Addresses lost.),a2f,devname,driveno poll_state_change: savexx .ret stz arg+2 ldx1 bp|pvte.volmap_async_state sxl1 arg+2 New async state spribp arg+6 tsx0 setup_pvtname_from_pvtep call_syserr 4,(volmap_page: Async state on ^a_^a changed to ^d on poll.),devname,driveno,a2f " excessive_seg_state_chg: savexx .2ret " tsx .2ret from page_fault epp U,pds$process_group_id mlr (pr),(pr) " copy process_group_id desc9a U|0,32 desc9a arg,32 " (person) ldaq pds$access_authorization qrl 18 " level to lower half staq arg+8 call_syserr_binary 24,sp|binary_buffer,covert_seg_state,covert_audit_info, (AUDIT (page_fault): GRANTED excessive segment state changes (Moderate_cc) for ^a (^o:^.3b).),person,level,categories " " " " " " " " " " " " " " " " " " " " " " " " " " " Subroutines " " " " " " " " " " " " " " " " " " " " " " " " " " get_pageno: "Given astep, ptp, get pageno into "arg+20 upper eax0 -aste_size,.ptw stx .aste,arg+20 sblx0 arg+20 stx0 arg+20 tra 0,7 no ssx0 cause top bit oflw get_ast_params: "Get uid, vtocx, pvtx. lda ast|aste.uid,.aste get uid sta arg+21 tze get_ast_params.zuid wie noord lda ast|aste.vtocx,.aste ana -1,dl tra get_ast_params.gotvx get_ast_params.zuid: lca 1,dl get_ast_params.gotvx: sta arg+20 lda ast|aste.pvtx_word,.aste arl aste.pvtx_shift ana aste.pvtx_mask,dl sta arg+18 "Leave this in A reg. tra 0,7 " setup_controller: lda page_fault$cme_flags,*.cme get controller ana cme.contr,dl controller used here als 36-9 adla =aA " Ascii A sta temp tra 0,0 setup_pvtname_from_pvtep: "s/r to address printable pv name eppap arg+6,* tra setup_pvtname.pvtep setup_pvtname: "s/r to address printable pv name eaq 0,al mpy pvte_size,dl eppap pvt$array eppap ap|-pvte_size,qu address right pvte setup_pvtname.pvtep: ldq ap|pvte.logical_area_number_word qrl pvte.logical_area_number_shift anq pvte.logical_area_number_mask,dl stq arg+18 btd (pr),(pr) desc9a arg+18,4 desc9ls arg+19,3,0 stz arg+1 mvne (pr),(),(pr) desc9ls arg+19,3,0 desc9a microp,2 desc9a arg+1,2 mlr (pr),(pr) desc9a ap|pvte.sv_name,2 desc9a arg+1(2),2 lda ap|pvte.devname sta arg lda ap|pvte.pvid sta arg+18 lda ap|pvte.lvid sta arg+19 tra 0,0 microp: oct 070322000000 " ses ON, mvc 2 " " " " " " " " " " " " " " " " " " " " " " " " " " " Arglist interpreter " " " " " " " " " " " " " " " " " " " " " " " " " " interpreter: lda 1,7 get 2*argct with 4 eaq 0,au staq sp|syserr_arg_list eax6 2,7 point at arg lxl1 0,7 offset to first unprocessed eax1 syserr_arg_list+0,1 eax2 0,1 adlx2 1,7 -> descs interp.list: cmpx6 0,7 end of list? tze 0,6 wham lda 0,6 eppap 0,al -> desc spriap sp|0,2 eaa 0,au tpl int.txt neg 0 eppap U|0,au -> stack arg tra *+2 int.txt: eppap 0,au address text spriap sp|0,1 eax1 2,1 eax2 2,2 eax6 1,6 interp pc tra interp.list binary_setup: spriap sp|binary_buffer+22 eppap sp|binary_buffer+22 spriap sp|syserr_arg_list+2*2 ldx1 sp|syserr_arg_list eppap ptrd spriap sp|syserr_arg_list+2+2,1 tra bincall bincall: call syserr$binary(sp|syserr_arg_list) tra exit " " " New-frame subroutines " gseg_info: format_segdamage_binary: " " First copy UIDs from AST, right-justified. mlr (pr),(pr) desc9a U|arg+18,4*4 desc9a sp|binary_buffer+segdamage.pvid,4*4 "lvid immediately follows pvid aos sst$damaged_ct trigger aswering service eax4 16 assume no more stuff if lossage eax5 0 fill from 0 if lossage lxl2 U|arg+20 have vtocx? tmi gup.fillup3 no, put in zeros lxl3 U|32+1 x3 from saved regs lxl3 ast|aste.par_astep,3 check par tze gup.fillup3 c/b root! eax4 15 set to last uid word gup.lp1: lda ast|aste.uid,3 sta sp|binary_buffer+segdamage.uid_path,4 store in array lxl3 ast|aste.par_astep,3 loop up tze gup.fillup thats all on this end eax4 -1,4 count level tpl gup.lp1 normal case eax4 1,4 only if busted, do this. " Now left-justify them, pad with zeros. gup.fillup: eax5 0 destination of move gup.fillup1: lda sp|binary_buffer+segdamage.uid_path,4 get put word gup.fillup2: sta sp|binary_buffer+segdamage.uid_path,5 store in new place eax5 1,5 new target eax4 1,4 new source cmpx4 16,du ready to do over end? tmi gup.fillup1 no, do next word gup.fillup3: lda 0,dl pad out zeros cmpx5 16,du gonna store over end? tmi gup.fillup2 no, go store zero tra 0,7 good luck. movemm: "Get main mem lossage parms lda U|core_add ldq U|temp abcd etc staq sp|binary_buffer+mmdam_msg.addr "ctrltag immediately follows addr tra 0,7 even devadd_to_20: lda devadd sta arg+20 devadd_to_buf20: lda U|devadd sta sp|binary_buffer+20 tra 0,7 " covert_audit_info: mlr (),(pr) " zero all first desc9a 0,0 desc9a sp|binary_buffer,4*audit_head_size bool period,056000 scm (pr),(du) " take apart process_group_id desc9a U|arg,32 desc9a period,1 " period arg sp|binary_buffer lda sp|binary_buffer " lth of person mlr (pr,rl),(pr),fill(040) desc9a U|arg,al desc9a sp|binary_buffer+audit_head.person,22 ada 1,dl " pt at project scm (pr,al),(du) desc9a U|arg,32 desc9a period,1 " period arg sp|binary_buffer lxl3 sp|binary_buffer mlr (pr,rl,al),(pr),fill(040) desc9a U|arg,x3 desc9a sp|binary_buffer+audit_head.person+5(2),9 ada sp|binary_buffer ada 1,dl mlr (pr,al),(pr) desc9a U|arg,1 desc9a sp|binary_buffer+audit_head.person+7(3),1 lda ARH_NO_PROXY,dl als audit_head.type_shift-audit_head.version_shift ada ACCESS_AUDIT_HEADER_VERSION_3,dl als audit_head.version_shift ora audit_head.subj_process,dl sta sp|binary_buffer+audit_head.version lda sst$seg_state_chg_operation sta sp|binary_buffer+audit_head.operation_code lda audit_event_flags.grant+audit_event_flags.cc_10_100,du sta sp|binary_buffer+audit_head.event_flags lda pds$process_id sta sp|binary_buffer+audit_head.process_id ldaq pds$access_authorization staq sp|binary_buffer+audit_head.authorization staq sp|binary_buffer+audit_head.max_authorization " pds$max_auth is not wired tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " constants and descriptors " " " " " " " " " " " " " " " " " " " " " fx: vfd 1/1,6/fixed,1/0,4/0,12/0,12/35 ptrd: vfd 1/1,6/ptr,1/0,4/0,24/0 equ ptr,13 equ fixed,1 equ char,21 equ bit,19 " include access_audit_eventflags include access_audit_bin_header include aste include cmp include page_info include page_regs include pvte include pxss_page_stack include stack_frame include stack_header include syserr_constants equ SYSERR_COVERT_CHANNEL_LOG,SYSERR_COVERT_CHANNEL+LOG include syserr_mmdam_msg include segdamage_msg include syserr_binary_def equ SB_covert_seg_state,SB_access_audit equ SBL_covert_seg_state,audit_head_size " "BEGIN MESSAGE DOCUMENTATION " Message: " device_control: invalid pvtx XX " S: $crash " T: $run " M: An invalid PVT index XX was found by device control, " or an invalid device type appeared in the PVT entry of that index. " $err " A: $recover " Message: " free_store: out of room in hardcore partition. " S: $crash " T: $run " M: During bootload, the PART HC on the RLV became full. " $err " A: $recover " It may be necessary to boot with another tape. " If this error occurs with a new version of the system boot tape, " the system programming staff may determine that the size of the " hardcore partition must be increased by using the " rebuild_disk command on a copy of the RPV. " Message: " page_fault: Zeroing page on DSKX_NN{S} " S: $info " T: $run " M: A segment residing on DSKX_NN{S} " has been damaged due to a device error. " The segment damaged switch is set and a page of zeros is introduced " into the segment. " Subsequent user processes attempting to use this segment will " receive an error indication. " Binary information identifying the damaged segment is encoded into " this message for subsequent automatic processing. The pathname " of the damaged segment will appear in a message in the answering " service log, bearing the syserr_log sequence number of this " message, shortly after this message occurs. " A: Attempt to identify the damaged segment, and " inform its owner. " Message: " page_fault: fatal error at loc AAAA " S: $crash " T: $run " M: $err " A: $recover " Message: " page_fault: nonfatal error at loc AAAA " S: $info " T: $run " M: $err " The system attempts to keep running. " A: $ignore " Message: " page_fault: device read not complete DSKX_NN{S} DDDD " S: $crash " T: $run " M: This message is used for program debugging only. " A: $recover " $inform " Message: " page_fault: fatal error in done, ptp ZZZZ " S: $crash " T: $run " M: While posting an I/O completion, " the system found a page table pointer of zero, " or found that the page was not out of service. " $err " A: $recover " Message: " page_fault: mylock on global lock " S: $crash " T: $run " M: When page_fault attempted to lock the global " page control lock, it found it already locked to the same process. " $err " A: $recover " Message: " page_fault: out of main memory " S: $crash " T: $run " M: The page removal algorithm was unable to " find a removable page. Incorrect system programmer action, " damage to the AST, or an error in the " supervisor or the hardware could cause this symptom. " A: $recover " Message: " page_fault: Reverting page on DSKX_NN{S} " S: $info " T: $run " M: A segment residing on DSKX_NN{S} has had one of its " pages reverted to an earlier copy of the same page. The damaged switch " is set. This can happen due to device error or main memory errors. " Subsequent user processes attempting to use this segment " will receive an error indication. Binary information " identifying the damaged segment is encoded into this message for " subsequent automatic processing. The pathname " of the damaged segment will appear in a message in the answering " service log, bearing the syserr log sequence number " of this message, shortly after this message occurs. " A: Attempt to identify the damaged segment and inform its owner. " Message: " page_fault: Deleting main memory at AAAA, SCU TAG, " due to parity errors. " S: $beep " T: $run " M: Due to main memory parity errors, the system is automatically " removing a page of main memory from the memory in SCU TAG, " preventing further use during this bootload. " A: Inform Field Engineering personnel about possible " problems with this SCU. " Message: " evict_page: parity error moving page, frame at AAA, SCU TAG. " S: $info " T: $run " M: A parity error was encountered while moving a page within " main memory. This may occur as part of an attempt to delete that " main memory, or use it as an I/O buffer. " A: Inform Field Engineering personnel about possible problems " with this SCU. " Message: " evict_page: fatal parity error moving page, frame at AAA, SCU TAG. " S: $crash " T: $run " M: A parity error was encountered while moving a wired page " around memory. The page may not be usable. " A: Contact Field Engineering personnel about possible " problems with SCU TAG. " $recover " Message: " free_store: volmap_seg async error for dskX_NN{S} " S: $crash " T: $run " M: When attempting to write a page of the Volume Map " to dskX_NN{S}, the page was found not to be in memory. This " probably indicates a software error. " A: $recover " Message: " free_store: Deposit non-disk address XXXXXXXXXXXX on dskX_NN{S} " S: $crash " T: $run " M: free_store was called to return an address to the free " pool for dskX_NN{S}, but the address type was not disk. This probably " indicates a software error. " A: $recover " Message: " free_store: Deposit/withdraw address XXXXXX out of paging region on dskX_NN{S}. " S: $crash " T: $run " M: Address XXXXXX was being deposited to or wtihdrawn from " the pool of free addresses for dskX_NN{S}, but the address is not " within the Paging Region for the device. This probably indicates " a software error. " A: $recover " Message: " free_store: PVTE/Stock out of synch on dskX_NN{S}. stockp=YYY|YYYYY. " S: $crash " T: $run " M: The PVTE and record stock for dskX_NN{S} do not point to " each other. This indicates a hardware or software error. " A: $recover " Message: " free_store: Invalid call to free_store$deposit_list. " S: $crash " T: $run " M: free_store$deposit_list was called with the wrong " number of arguments. This is a software error. " A: $recover " Message: " free_store: Scavenger STACQ fails on dskX_NN{S}. " S: $crash " T: During a physical volume scavenge of dskX_NN{S}. " M: A STACQ instruction, used to unlock a record address " during a volume scavenge, did not operate correctly. This indicates " processor or memory malfunction. " A: $recover " Message: " lock_volmap: STACQ fails on dskX_NN{S}. " S: $crash " T: $run " M: The stacq instruction, used to lock the Volume Map on " dskX_NN{S}, did not operate correctly. This indicates processor or " memory malfunction. " A: $recover " Message: " lock_volmap: MYLOCK on volmap lock for dskX_NN{S}. " S: $crash " T: $run " M: A process attempted to lock the Volume Map lock for " dskX_NN{S} while already owning the lock. This indicates a software " malfunction. " A: $recover " Message: " stock: deposit zero address. " S: $crash " T: $run " M: An attempt was made to deposit address zero into a record " stock. This is an invalid address, and it indicates hardware or " software failure. " A: $recover " Message: " volmap: Volume Map inconsistent on dskX_NN{S}. " S: $crash " T: $run " M: An attempt to withdraw a disk address from the pool of " free addresses on dskX_NN{S} failed, although the control structures " describing the Volume Map indicated that addresses were available. " This indicates hardware or software failure. " A: $recover " Message: " volmap: Invalid volume map word on dskX_NN{S}. " S: $crash " T: $run " M: An attempt to withdraw a disk address from the pool of " free addresses on dskX_NN{S} resulted in finding a volume map word " with at least one of bits 0, 33, 34, and 35 on. These bits are " invalid for volume map words. This indicates hardware or " software failure. " A: Perform an ESD. Reboot the system and perform a " volume salvage (not a scavenge) of the disk volume dskX_NN{S}. " This may be performed at Initializer ring-1 or ring-4 command " level. Perform the salvage before adding the storage system " volume back to the system. The volume scavenger will not " detect volume map words with invalid bits enabled, so the " salvager must be used. Once the salvage is complete, the " volume may be added back to the system. " Message: " volmap: record stock inconsistent on dskX_NN{S}. stockp=YYY|YYYYY. " S: $crash " T: $run " M: An attempt to deposit a record address from the Volume " Map to the record stock failed unaccountably. This indicates " probably software failure. " A: $recover " Message: " volmap: Attempt to deposit in-use address YYYYYY on dskX_NN{S}. " S: $info " T: $run " M: An attempt was made to return disk address YYYYYY to the free " pool on dskX_NN{S}, but the address was already marked as free. This indicates " damage of some sort to the Volume Map. This damage can be repaired " by a volume salvage. " A: $inform " Message: " volmap: Invalid Volume Map address computation for YYYYYY on dskX_NN{S}. " S: $crash " T: $run " M: In attempting to place the disk address YYYYYY into the " free pool for dskX_NN{S}, an error occurred in translating the address " into a location within the Volume Map. This indicates a software " error. " Message: " volmap_page: PTL not locked to process. " S: $crash " T: $run " M: An entry in volmap_page was called which required that " the Global Page Table lock be held by the calling process. It " was not held by that process, indicating software failure. " A: $recover " Message: " volmap_page: Invalid async state on dskX_NN{S}. " S: $crash " T: $run " M: An inconsistency was discovered in the asynchronous " update state of the Volume Map on dskX_NN{S}. This is likely a " software error. " A: $recover " Message: " volmap_page: Async error for dskX_NN{S}. " S: $crash " T: $run " M: When attempting to write an updated page of the Volume Map " on dskX_NN{S}, it was found not to be in memory. This indicates a " software failure. " A: $recover " Message: " volmap_page: Invalid call. " S: $crash " T: $run " M: One of the conditions required for a call to a volmap_page " entry point was not present. This indicates a software failure in " the caller of volmap_page. " A: $recover " Message: " volmap_page: Unrecoverable I/O error on Volmap page M of dskX_NN{S}. Addresses lost. " S: $beep " T: $run " M: There was an unrecoverable I/O on a page of the Volume Map, " which describes free records on the volume. As a result, all free " records described by that page of the Volume Map have been lost. " A: It may be possible to recover the lost addresses by a " volume salvage. However, a hard device error will prevent the volume " salvage from succeeding. In this case, it will be necessary " to recover the volume to a good pack. " Message: " volmap_page: Async state on dskX_NN{S} changed to S on poll. " S: $log " T: $run " M: An interrupt for a volume map I/O was lost and was " recovered by a periodic polling routine. " A: $ignore " Message: " page_synch: Out of free entries in dm_journal_seg_. " T: $run " S: $crash " M: $err " A: $recover " Message: " page_synch: dm_journal_seg_ inconsistent. " T: $run " S: $crash " M: $err " A: $recover " Message: " AUDIT (page_fault): GRANTED excessive segment state changes " (Moderate_cc) for PROCESS_GROUP_ID (AUTHORIZATION) " T: $run " S: $security_log " M: An attempt to use the modification of various segment " attributes as a covert channel was detected. " END MESSAGE DOCUMENTATION end  page_fault.alm 11/11/89 1105.1r w 11/11/89 0804.3 739098 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(87-06-22,Fawcett), approve(87-06-23,MCR7734), " audit(87-07-14,Farley), install(87-07-17,MR12.1-1043): " Change the checking for the "mylock" on the ptl for after the first stac " instructions indicates that the lock was in fact locked. " END HISTORY COMMENTS " " " " " " " "" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " page_fault " " This is the major procedure of Multics page control. For details, see " the Storage System PLM, Order Number AN61. " " Coded 1/70 by S.Webber " Last Modified (Date and Reason): " Modified by S.Webber 07/01/71 to add page multilevel " Modified by S.Webber 07/01/72 for followon " Modified by S.Webber 10/01/73 to merge with privileged code " Modified by B. Greenberg 06/10/74 for IOBM and put all cam/lock_ptl in page. " Modified by B. Greenberg 11/12/74 for overlap-lookahead core control. " Modified by B. Greenberg 02/05/75 for new storage system. " Modified by S. Webber 02/05/76 for new reconfiguration " Modified by B. Greenberg 03/08/76 for waiting on PTL " Modified by B. Greenberg 05/13/76 for pdme's with uid/pageno " Modified by B. Greenberg 12/76 for core_queue_man delay queue. " Modified by B. Greenberg 3/31/77 for disk_emergency and new page_error. " Modified by B. Greenberg 5/03/77 for page$pcleanup, aste.damaged. " Modified by RE Mullen 5/13/77 for concurrent scheduler " Modified by B. Greenberg 8/77 for pc_recover_sst, misc. cleanups. " Modified by B. Greenberg 9/20/77 for disk offline waiting. " Modified by B. Greenberg 3/15/78 for large sst, ptw.phm1 " Modified by B. Greenberg 5/1/78 for parity errors. " Modified by D. Spector 2/20/79 for 18-bit unsigned quota " Modified by B. Greenberg 2/79 for variable write_limit " Modified by B. Greenberg 2/79 for 8-cpu port expander " Modified by J. A. Bush 3/80 to store fault time in machine conditions " Modified by B. Greenberg 6/23/80 for loop & unlock meters " Modified by J. A. Bush 8/80 for the DPS8/70M CPU " Modified by E.N. Kittlitz (per WOS) to not update PF count on gtus segments. " Modified by E.N. Kittlitz 11/17/80 for new dtu/dtm calculation. " Modified by J. Bongiovanni 1/81 for fault_counters " Modified by M. Pierret 11/80 to use page pinning algorithm " Modified by J. Bongiovanni 2/81 to remove cam/cache code " Modified by W. Olin Sibert, 2/26/81, for ADP conversion, phase one " Modified by C. Hornig, January 1982, to only CAM if segment accessible. " Modified by J. Bongiovanni, January 1982, to remove PML code, add " extended page fault trace type " Modified by J. Bongiovanni, February 1982, for stocks " Modified by E. N. Kittlitz, 6/21/82, summer solstice sacrifice of core map. " Modified by J. Bongiovanni, July 1982, scs$trouble_processid, scavenger " Modified by J. Bongiovanni, October 1982, synchronized segment support, " don't decrement quota through zero " Modified by E. N. Kittlitz (Massachusetts agent for W.O. Sibert) to pin those pages again. " Modified by Keith Loepere, October 1983, for paged unpaged dseg and " for bug fix to find_core loop. " Modified by R. Coppola 10/13/83 to meter DF1 on per-cpu basis and " added code to meter cache errors when mc_trace'ing " Modified by BIM 83-12-03 for pgt_ IPS signal. " Modified by TO 84-10-17 to remove write_limit and disk_run'ing. " Modified by Keith Loepere, December 1984, for covert channel " detection and a little cleanup. " Modified by Keith Loepere, January 1985, for updated covert " channel detection. " Modified by Keith Loepere, January 1985, for fix to aste.records race. " Modified by Tom Oke, February 1985, to remove a missed write_limit " and disk run. " " The following entries exist within this procedure (given by entry name to "page"): " " done used by the paging DIMs to signal the completion " of an I/O request. " " enter_data places an entry into the per-process trace table " " fault transferred to upon page faults from the fault vector " " lock_ptl used to lock the page table lock " " pccleanup used to get a page out of core " " pread used to read a page into core " " pwrite used to write a page out of core " " reset_working_set is obsolete and does nothing " " trace_marker places a user marker entry into the per-process " trace table " " unlock_ptl used to unlock the page table lock " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " The very beginning " name page_fault entry wait_return,pmut_unlock_ptl entry ptl_wait_return segdef check_accessible " See whether anyone can access segment segdef cleanup_page " Evict one page from memory segdef cme_offsets " Core map ITS pointers, 1 per cme word segdef cme_0,cme_bp,cme_fp " ITS to word 0 of cme segdef cme_1,cme_devadd,cme_flags " ITS to word 1 of cme segdef cme_2,cme_astep,cme_ptwp " ITS to word 2 of cme segdef cme_3,cme_pin_counter,cme_synch_page_entryp " ITS to word 3 of cme segdef delete_mm_frame " Clear out and deconfigure main memory frame segdef disk_offline_event " Wait event for disk offline segdef disk_offlinep " Check whether disk is offline segdef done " Post completion of I/O segdef done_ " Post completion with PTL locked segdef enter_data " Enter per-process trace data segdef fault " Page Fault entry segdef find_core_ " Find a frame of core segdef init_savex " Init x7 save stack segdef init_savex_bb " Init x7 save stack, set bb -> sst segdef lock_ptl " Lock PTL segdef lock_ptl_ext " Lock PTL from outside ALm PC segdef lock_ptl_no_lp " Lock PTL, don't save lp segdef my_lp " lp for bound_page_control segdef notify_return " Side-door return from pxss$notify_page segdef page_fault_error " Call to page_error - fatal segdef pcleanup " Entry to get a page out of core segdef pf_prs " Pointer to saved prs on page fault segdef pf_scuinfo " Pointer to SCU data on page fault segdef pre_page_info " Obsolete segdef pread " Entry to read a page segdef pwrite " Entry to write a page segdef read_page_abs " Same as read_page, but OOPV not allowed segdef reset_working_set " Obsolete segdef savex " Save x7 in save stack for recursive use segdef set_up_abs_seg " Setup abs_seg_1 segdef thread_in " Thread CME as MRU segdef thread_lru_ext " Thread CME as LRU, ouside of ALM PC segdef thread_out " Thread CME out of used list segdef thread_to_lru " Thread CME as LRU segdef trace_marker " Add user marker to per-process trace segdef trace_restart_fault " Add restart_fault to per-process trace segdef trace_scheduling " Add reschedule to per-process trace segdef trace_signaller " Add signaller to per-process trace segdef unlock_ptl " Unlock PTL segdef unlock_ptl_ext " Unlock PTL, outside of ALM PC segdef unsavex " Pop save stack, tra 0,x7 segdef unsavex_1 " Pop save stack, tra 1,x7 segdef unsavex_2 " Pop save stack, tra 2,x7 segdef write_page " Write page out if necessary " include page_regs " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Temporary storage, INCLUDE files, and constants " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " link prds_link,prds$ link abs_seg1_link,abs_seg1$ include stack_frame include stack_header include trace_types include sys_trouble_codes include mode_reg include pxss_page_stack include page_error_types include page_info include apte include sst include tc_meters include wcte include sdw include ptw include add_type include aste include cmp include mc include null_addresses include static_handlers include device_error include mctseg include fault_vector include unpaged_page_tables " " check for wild transfers to bound_page_control|0 tsx5 page_fault_error "ERROR - TRA TO PAGE|0" tsx5 page_fault_error "ERROR - TRA TO PAGE|1" " " " The following code (located at bound_page_control|2) is used for " hardware debugging to make it easy to restart the last page " fault via restoring the machine conditions and doing an RCU. " epplp my_lp,* restore page's linkage eppap pds$page_fault_data tra restart_fault dec 0 " (bpc|5) -- address_mask used to be here " This location (bound_page_control|6) is left unused so that " obsolete patches of run limit (write_limit) will not crash system. obsolete_wlim: dec 0 even pf_prs: its -1,1 pf_scuinfo: its -1,1 my_lp: its -1,1 cme_offsets: " set up by initialize_faults. cme_0: cme_bp: cme_fp: its -1,0 cme_1: cme_devadd: cme_flags: its -1,1 cme_2: cme_ptwp: cme_astep: its -1,2 cme_3: cme_pin_counter: cme_synch_page_entryp: its -1,3 sdw_bits: " Bits for abs-seg SDW -- it is " Address 0, read/write, one unpaged page iftarget L68 " SDW is different format for each vfd 18/0,18/sdw.valid vfd 1/0,14/(1024/16)-1,3/sdw.read+sdw.write,18/sdw.unpaged ifend iftarget ADP vfd 18/0,18/sdw.valid vfd 14/(1024/16)-1,4/0,18/sdw.read+sdw.write+sdw.unpaged ifend channel_mask_set: oct 17,17 unnull_mask: zero -1-ptw.nulled,-1 mask to resurrect an address even null: its -1,1 pc_signal_arglist: vfd 18/6,18/4,18/0,18/0 "********************************************************************* "********************************************************************* "********************************************************************* "********* ********** "********* HERE ARE THE CONSTANTS ... AND ********** "********* HERE BEGINS THE CODE OF PAGE_FAULT. ********** "********* ********** "********************************************************************* "********************************************************************* "********************************************************************* " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Subroutines: " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " lock_ptl: sprilp sp|stack_frame.lp_ptr we don't do a normal 'entry' so ... lock_ptl_no_lp: epbpbb sst$ bb -> SST through out page lda pds$processid lock the page table lock stac sst|sst.ptl tze ptl_ok branch if we think locked it read_clock meter time waiting for lock cmpa sst|sst.ptl check for mylock on page table lock tze page_error$ptl_mylock complain if lock already set staq pds$arg_1 lda pds$processid get set to lock again ptl_repeat: stac sst|sst.ptl hurry up and wait nop nop tnz ptlfail locked, see if wait needed read_clock sbaq pds$arg_1 adaq sst|sst.loop_lock_time staq sst|sst.loop_lock_time increment sst|sst.loop_locks meter times we had to loop lock ptl_ok: lda pds$processid did we lock ok? cmpa sst|sst.ptl tze *+2 tsx5 page_fault_error "ERROR - PTL STAC FAILED" tra 0,.ret ptlfail: cmpx .ret,pft_lret,du locking for page fault? tnz ptl_repeat no, loop some more read_clock account for partial pf time sbaq pds$time_1 account for partial pf time adaq tc_data$cpu_pf_time account for partial pf time staq tc_data$cpu_pf_time account for partial pf time tra pxss$ptl_wait yes, wait for lock ptl_wait_return: "return location from pxss$ptl_wait eppap pds$page_fault_data read_clock account for rest of pf time staq pds$time_1 account for rest of pf time tra masked_switched_legal pmut_unlock_ptl: push tsx .2ret,init_savex_bb tsx .ret,unlock_ptl eppap sp|stack_frame.arg_ptr,* sprisp sb|stack_header.stack_end_ptr eppsp sp|stack_frame.prev_sp,* tra pmut$unwire_unmask unlock_ptl_ext: push tsx .2ret,init_savex_bb tsx .ret,unlock_ptl unlock the ptl tra return unlock_ptl: tra core_queue_man$unlock_ptl Hoo, boy! lock_ptl_ext: eax .ret,.rt tra lock_ptl_no_lp .rt: short_return non_fatal_error: eax5 -1,.ret tsx .2ret,page_error$non_fatal_error tra 0,.ret page_fault_error: eax5 -1,5 set x5 to point to actual call to subroutine tra page_error$page_fault_error die init_savex_bb: epp sst,sst$ init_savex: eaa save_stack get address of save stack base ora stack_size*64,dl set up a tally word for storing into save_stack sta stackp stash this away tra 0,.2ret return to the caller savex: stx .ret,stackp,id store x7 in save stack using tally word ttf 0,.2ret return to the caller if tally not runout tsx5 page_fault_error "ERROR - SAVE STACK OVERFLOW" unsavex: ldx .ret,stackp,di pop value of x7 (also updating tally word properly) tra 0,.ret unsavex_1: ldx .ret,stackp,di pop value of x7 (also updating tally word properly) tra 1,.ret " """"""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " Subroutines to manage used list threading " " " " " " " """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " Move an entry to least-recently-used place " thread_to_lru: " assumes .cme -> cme cmpx .cme,sst|sst.usedp see if already at lru point tze 0,.ret leave it if so szn cme_fp,*.cme make sure threaded in (could be postpurge os) tmoz 0,.ret " " Load pointers to current brothers, thread out. " ldx .nxt,cme_fp,*.cme next lxl .lst,cme_bp,*.cme previous cmpx .cme,sst|sst.wusedp see if write point is on .cme tnz *+2 stx .nxt,sst|sst.wusedp make writes start at next " Thread out stx .nxt,cme_fp,*.lst successor(last) = successor sxl .lst,cme_bp,*.nxt last(successor) = last " Move to usedp mv_to_usedp: ldx .nxt,sst|sst.usedp point to successor to be " See if usedp at wusedp. If so, back up wusedp. cmpx .nxt,sst|sst.wusedp see if wusedp = usedp tnz *+2 no, not equal. stx .cme,sst|sst.wusedp our cme is new wused stx .cme,sst|sst.usedp in any case, our cme is new used. thread_behind: lxl .lst,cme_bp,*.nxt point to last to be " Thread to .cme stx .cme,cme_fp,*.lst successor (last) = cme sxl .cme,cme_bp,*.nxt last (successor) = cme " Thread cme to environment stx .nxt,cme_fp,*.cme successor (cme) = successor sxl .lst,cme_bp,*.cme last (cme) = last tra 0,.ret "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " " " " Thread a cme out of the used list. " " " "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " thread_out: " Point to environment ldx .nxt,cme_fp,*.cme successor = successor (cme) tpnz *+2 tsx5 page_fault_error "ERROR - THREADING OUT UNTHREADED CME" lxl .lst,cme_bp,*.cme last = last (cme) " Make sure replacement and writing pointers are not " looking at .cme. cmpx .cme,sst|sst.usedp tnz *+2 stx .nxt,sst|sst.usedp move usedp to successor if so cmpx .cme,sst|sst.wusedp tnz *+2 stx .nxt,sst|sst.wusedp " Thread out sxl .lst,cme_bp,*.nxt last (successor) = last stx .nxt,cme_fp,*.lst successor (last) = successor stz cme_fp,*.cme tra 0,.ret " "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " " " " Thread an unthreaded entry to lru " " " " " "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " thread_in: szn cme_fp,*.cme make sure not threaded in already tmoz mv_to_usedp tsx5 page_fault_error "ERROR - THREADING IN THREADED CME" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " " " Thread an unthreaded entry to MRU. " " " "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " thread_in_mru: ldx .nxt,sst|sst.wusedp thread in behind wusedp. szn cme_fp,*.cme make sure not threaded in tmoz thread_behind move behind wusedp tsx5 page_fault_error "ERROR - MRU THREADING THREADED CME" " " External entry to thread to lru. " thread_lru_ext: eppbp ap|2,* ap -> cmep eax .cme,bp|0,* epp sst,sst$ set up sst ptr tsx .ret,thread_to_lru short_return " inhibit on even meter_virtual_time: lca 1,dl check for recursive metering asa pds$vtime_count .. tpl 0,.ret yes, do no more read_clock get current value of CPU time adl 96,dl add in correction delta sbaq pds$cpu_time .. sbaq pds$time_v_temp get time used for this fault/interrupt staq pds$time_v_temp adaq pds$virtual_delta save as virtual time increment staq pds$virtual_delta .. ldaq pds$time_v_temp also calculate total vcpu adaq tc_data$+delta_vcpu staq tc_data$+delta_vcpu tra 0,.ret inhibit off set_up_abs_seg: lda core_add als coreadd_to_sdw.ls shift core addr into sdw pos eaq 0 clear q-reg oraq sdw_bits turn on other interesting bits eppap abs_seg1$ get pointer to core area ldx .tem,lp|abs_seg1_link get segno of abs_seg1 adlx .tem,lp|abs_seg1_link multiply by 2 staq dseg$,.tem store in descriptor segment cams tra 0,.2ret store_pattern: tsx .2ret,set_up_abs_seg get abs_seg1 ready ldaq =vo36/777666333222,o36/444000111555 staq ap|0 and store it into the page staq ap|1022 .. tra 0,.ret check_pattern: tsx .2ret,set_up_abs_seg ldaq =vo36/777666333222,o36/444000111555 cmpaq ap|0 if the same we have trouble tze 1,.ret take error return cmpaq ap|1022 try the last 2 words tnz 0,.ret ok if not the same tra 1,.ret bad news if the same clear_core: tsx .2ret,set_up_abs_seg make abs_seg1 point to core_add eax .tem,4096 zero out 4096 characters mlr (),(pr,rl),fill(0) desc9a 0,0 desc9a ap|0,x0 .tem tra 0,.ret check_for_zero: " assumes abs_seg1 setup eppap abs_seg1$ eax .tem,4096 number of characters in a page cmpc (),(pr,rl),fill(0) desc9a 0,0 desc9a ap|0,x0 .tem tze 1,.ret tra 0,.ret " " " The following subroutine (reset_mode_reg) is called before masking down. " It therefore must be inhibited. " inhibit on reset_mode_reg: rsw 2 get cpu type in a als mc.cpu_type_shift get the CPU type ana mc.cpu_type_mask,du stca ap|mc.cpu_type_word,70 store in machine conditions arl 18-mc.cpu_type_shift position in au lower eax4 0,au copy to x4 szn pds$mc_trace_sw is this process tracing machine conditions? tpl no_trace_mc xfer if no szn pds$mc_trace_seg Does user want to trace all M. Cs? tze cp_hregs xfer if seg number zero lda ap|mc.scu.ppr.psr_word look at the psr ana scu.ppr.psr_mask,du and out everything except psr cmpa pds$mc_trace_seg compare psr to object we are tracing tze cp_hregs xfer if psr = object we are tracing lda ap|mc.scu.tpr.tsr_word look at tsr ana scu.tpr.tsr_mask,du and out everthing except tsr cmpa pds$mc_trace_seg compare tsr to object we are tracing tnz no_trace_mc do not trace if psr and tsr don't have seg cp_hregs: scpr ap|mc.fim_temp,01 save fault register ldaq ap|mc.fim_temp note that scpr does D.P. store and sta ap|mc.fault_reg stores zeroes in mc.fault_reg qrl mc.cpu_type_shift make room for cpu type orq ap|mc.cpu_type_word or in cpu type stcq ap|mc.cpu_type_word,70 store cpu type and ext fault reg lda prds$processor_tag get cpu num xec cache_ctr_tab,al lb=> per-cpu cache err ctrs lda ap|mc.fault_reg reload PFR ana =o10,dl cache dir parity (bit 32)? tze check_efr no, go check EFR aos lb|1 yes, increment the per-cpu ctr check_efr: anq mc.ext_fault_reg_mask,du mask unwanted bits OFF tze no_efr no bits on, bypass qls 2 get EFR bits in Q 1-17 eaa 0 set up A as incrementer efr_loop: ada 1,dl increment EFR slot number qls 1 is this bit on? tpnz efr_loop no, but some other bit on tze no_efr no more EFR bits aos lb|1,al increment EFR counter tra efr_loop look for nxt EFR bit no_efr: lprplb pds$mc_trace_buf get packed ptr to wired trace buffer lxl5 lb|mctseg.hr_nxtad x5 = rel ptr to next H. R. storage location cmpx5 lb|mctseg.hr_lim do we have to roll over the trace? tmi hr_roll xfer if no ldx5 lb|mctseg.hr_strt yes, pick up initial storage location sxl5 lb|mctseg.hr_nxtad store new location hr_roll: eax5 mctseg.hr_size,5 increment storage location sxl5 lb|mctseg.hr_nxtad set rel ptr to next H. R. storage location epplb lb|-mctseg.hr_size,5 lp -> current HR storage location ldq 2,du get a 2 for stepping address eax6 4 4 blocks of scpr1: eax5 16 16 history registers eax3 0 set up for L68 CPU type initally cmpx4 1,du is this a DPS8/70M CPU? tnz scpr2 xfer if no, it is L68 eax3 48 yes, set up to skip first 48 hregs cmpx6 3,du DU hreg? Don't have one on DPS8/70M tnz scpr2 no, go execute it mlr (),(pr),fill(0) zero out this 32 word block desc9a 0,0 desc9a lb|64,32*4 eax6 -1,6 yes, skip it scpr2: lda scpr-1,6 get correct instruction sta ap|mc.fim_temp save in stack scpr3: xec ap|mc.fim_temp execute the instruction cmpx3 0,du are we through skipping hregs? tze scpr4 yes, go increment address eax3 -1,3 no, skip another tra scpr3 and go execute scpr again scpr4: asq ap|mc.fim_temp increment address of instruction eax5 -1,5 count down tnz scpr3 more of this 16 double word block eax6 -1,6 count down tnz scpr1 another kind of hreg eax5 64 initially set clear count to 64 cmpx4 1,du is this a DPS8/70M CPU? tze *+2 yes, clear all 64 hregs eax5 16 no, clear only 16 hregs lcpr 0,03 set all history regs to zero eax5 -1,5 count down tpnz *-2 xfer if more to do eawplb 0 trace_mc: lxl5 lb|mctseg.mc_nxtad x5 = rel ptr to next M. C. storage loc cmpx5 lb|mctseg.mc_lim do we have to roll over the trace? tmi mc_roll xfer if no ldx5 lb|mctseg.mc_strt yes, pick up initial storage location sxl5 lb|mctseg.mc_nxtad store new location mc_roll: eax5 mctseg.mc_size,5 increment storage location sxl5 lb|mctseg.mc_nxtad set rel ptr to next M. C. storage location epplb lb|-mctseg.mc_size,5 lp -> current MC storage location mlr (pr),(pr) move the data to wired buffer desc9a ap|0,mctseg.mc_size*4 desc9a lb|0,mctseg.mc_size*4 no_trace_mc: epplb prds$cache_luf_reg reset cache control reg lcpr lb|0,02 lcpr to reload luf and cache control lda prds$mode_reg retrieve template mode reg ora mr.enable_mr+mr.enable_hist,dl enable mode reg and hist regs sta prds$mode_reg_enabled save this mode reg value epplb prds$mode_reg_enabled get pointer to temp mode reg value lcpr lb|0,04 reload the mode register tra 0,.ret return to caller scpr: scpr lb|0,40 OU History Regs for L68, OU/DU for DPS8 scpr lb|32,20 CU History Regs scpr lb|64,10 DU History Regs for L68, not used for DPS8 scpr lb|96,00 APU History Regs cache_ctr_tab: epplb wired_hardcore_data$cpu_a_cache_err_ctr_array epplb wired_hardcore_data$cpu_b_cache_err_ctr_array epplb wired_hardcore_data$cpu_c_cache_err_ctr_array epplb wired_hardcore_data$cpu_d_cache_err_ctr_array epplb wired_hardcore_data$cpu_e_cache_err_ctr_array epplb wired_hardcore_data$cpu_f_cache_err_ctr_array epplb wired_hardcore_data$cpu_g_cache_err_ctr_array epplb wired_hardcore_data$cpu_h_cache_err_ctr_array fault_ctr_table: eppab wired_hardcore_data$cpu_a_flt_ctr_array eppab wired_hardcore_data$cpu_b_flt_ctr_array eppab wired_hardcore_data$cpu_c_flt_ctr_array eppab wired_hardcore_data$cpu_d_flt_ctr_array eppab wired_hardcore_data$cpu_e_flt_ctr_array eppab wired_hardcore_data$cpu_f_flt_ctr_array eppab wired_hardcore_data$cpu_g_flt_ctr_array eppab wired_hardcore_data$cpu_h_flt_ctr_array inhibit off get_pvtx: lda ast|aste.pvtx_word,.aste arl aste.pvtx_shift ana aste.pvtx_mask,dl sta pvtx tra 0,.ret " " " " " " " " " " " " " " " " " " enter_data -- entry to add data to the 'system trace list' " Call is: " " call page$enter_data(data_word, type) " " where data_word is a word value to be " entered into the next available slot in the trace " list. If type = 0 (page fault type) then a return is " done and the entry is not placed in the list. " " " " " " " " " " " " " " " " " " " " " " include sys_trace trace_signaller: epplp my_lp,* set linkage pointer lda pds$condition_name get first four characters of name ldq pds$condition_name+1 lls 9 shift out ACC count field ldq signaller_type,du get coded type tsx .ret,enter tra lb|0 return via special code trace_restart_fault: epplp my_lp,* eaa 0 code for restart is zero ldq restart_fault_type,du tsx .ret,enter tra lb|0 return via special code trace_marker: lda ap|2,* get char string to use as marker ldq marker_type,du set type appropriately tsx .ret,enter short_return trace_scheduling: eaa 0 code word is all zeros ldq reschedule_type,du get type code tra enter enter_data: lda ap|2,* pick up the data_word ldq ap|4,* make sure non-zero type given qls 30 left justify tze short_return return if illegal type given tsx .ret,enter short_return: short_return return: return " " Subroutine to enter a page fault into the system-trace list " page_util_enter: stx .aste,temp astep eax .tem,-aste_size,.ptw PTW addr - ASTE size sblx .tem,temp page number anx .tem,=o377,du only significant bits szn tc_data$post_purge_switch are we post-purging? tze extended_page_util_enter no -- we can stuff more data into trace " We are post-purging, so we need old format trace entry ldq pds$page_fault_data+mc.scu.tpr.tsr_word get segno in q eaa 0,.aste get astep in a-reg arl 18 lls 18 fabricate entire code word eaq 0,.tem page number (low order bits) in upper tra enter extended_page_util_enter: lda pds$page_fault_data+mc.scu.ppr.psr_word PPR in AU ana =o7777,du Low-order bits only arl 18 PPR in AL ldq pds$page_fault_data+mc.scu.ilc_word IC in QU anq -1,du strip out garbage (indicators) lls 18+6 1st 30 bits or first word sta temp lda pds$page_fault_data+mc.scu.ppr.psr_word PPR in AU ldq pds$page_fault_data+mc.scu.cu_stat_word CU status bits canq scu.cu.if,dl fault on instruction fetch tnz *+2 yes - use PPR lda pds$page_fault_data+mc.scu.tpr.tsr_word no - use TSR ana =o7777,du Low-order bits only arl 18 segno in AL eaq 0,.tem pageno in QU qls 18-8 lrl 6 qrl 6 ora temp orq extended_page_fault_type,du enter: eppap pds$trace get pointer to trace structure ldx .tem,ap|trace.next_free_word get current index to next free slot staq ap|trace.data,.tem save coded information read_clock sbaq ap|trace.ttime get incremental time stq ap|trace.temp save in temporary adaq ap|trace.ttime recalculate last fault time staq ap|trace.ttime ldq ap|trace.temp retrieve delta-time qrl 6 in terms of 64 micro-seconds cmpq =o177777,dl see if time is too large tmi *+2 no, use it ldq =o177777,dl yes, time is too large, use standard large value orsq ap|trace.data+1,.tem OR time value into trace entry eax .tem,2,.tem bump entry index cmpx .tem,ap|trace.last_available_word check for wrap-around tnz trace.no_wrap not now, though eax .tem,0 we wrapped. reset to beginning trace.no_wrap: cmpx .tem,ap|trace.threshold_word signal? tnz trace.no_signal nope lda ap|trace.send_ips_word Signals enabled? cana trace.send_ips,dl tze trace.no_signal eppbp pds$apt_ptr,* no need to lock, we use stacq trace.retry_ips: lda sys_info$pgt_mask This cannot recurse, ora bp|apte.ips_message since we only test EQUAL to ldq bp|apte.ips_message threshold. The pgt_ trace stacq bp|apte.ips_message will be GREATER. tnz trace.retry_ips lda 1,dl set ring alarm sta pds$alarm_ring store in simulated spot lra pds$alarm_ring set for real trace.no_signal: stx .tem,ap|trace.next_free_word tra 0,.ret reset_working_set: short_return pre_page_info: stz ap|4,* pre-page calls stz ap|6,* paging device page faults stz ap|8,* no pre-paging short_return " " quota primitives - check for RQO, decrement quota, increment quota check_quota: lda ptw|0 inspect ptw cana add_type.non_null,dl see if not_null address tze check_quota.real_null als 0 tpl 0,.ret real address, return check_quota.real_null: tsx .2ret,type_terminal_quota tra *+2 seg quota tra 0,.ret dir quota, skip it for now eax .tem,0,.aste loop up parents quota_c: lxl .tem,ast|aste.par_astep,.tem get father cana ast|aste.tqsw_word,.tem see if terminal tze quota_c no, loop up szn pds$quota_inhib special consideration? tnz 0,.ret yes, return lda entry_sw don't check on read entry cmpa read_entry,dl tze 0,.ret read entry, don't check lda ap|mc.scu.tpr.trr_word get ring of faulting reference cana scu.tpr.trr_mask,du see if in ring 0 tze 0,.ret yes, don't check quota ldx .2ret,ast|aste.used,.tem check seg quota for over cmpx .2ret,ast|aste.quota,.tem tnc 0,.ret not over quota, return lda PAGE_ERROR_RQO,dl type of error to signal eppab ast|0,.tem ASTE of quota account tra errquit " subtract 1 from quota cell reset_quota: eax .tem,0,.aste start at current aste tsx .2ret,type_terminal_quota find quota parent lxl .tem,ast|aste.par_astep,.tem seg quota applies to parent quota_r: xec quota.lx,ql fetch correct cell tze *+3 don't decrement thru 0 sblx .2ret,1,du xec quota.sx,ql save back cana ast|aste.tqsw_word,.tem stop at terminal account tnz 0,.ret lxl .tem,ast|aste.par_astep,.tem parent cell tra quota_r " add 1 to quota cell bump_quota: lda aste.fmchanged,du turn on fmchanged orsa ast|aste.fmchanged_word,.aste eax .tem,0,.aste start at current aste tsx .2ret,type_terminal_quota find quota parent lxl .tem,ast|aste.par_astep,.tem seg quota applies to parent quota_b: xec quota.lx,ql fetch correct cell adlx .2ret,1,du xec quota.sx,ql save back cana ast|aste.tqsw_word,.tem stop at terminal account tnz 0,.ret lxl .tem,ast|aste.par_astep,.tem parent cell tra quota_b bump_quota_covert_check: " Add 1 to quota cell, also check that there exists a terminal quota node " before the first upgraded node. This should be used only for dirs, " so that we don't require terminal dir quota for upgraded dirs. lda aste.fmchanged,du turn on fmchanged orsa ast|aste.fmchanged_word,.aste eax .tem,0,.aste start at current aste tsx .2ret,type_terminal_quota find quota parent lxl .tem,ast|aste.par_astep,.tem seg quota applies to parent ora aste.multi_class,du we will "stop" on terminal " node or upgraded node stz temp assume terminal-ness quota_bc: xec quota.lx,ql fetch correct cell adlx .2ret,1,du xec quota.sx,ql save back cana ast|aste.tqsw_word,.tem look at tqsw and multi_class tze quota_bc_next neither upgraded nor terminal lxl .2ret,ast|aste.tqsw_word,.tem terminal half-word canx .2ret,quota.tq_mask,ql tnz quota_bc_term terminal found sta temp upgraded found first quota_bc_next: lxl .tem,ast|aste.par_astep,.tem parent cell tra quota_bc quota_bc_term: lda temp tnz 0,.ret upgraded found first tra 1,.ret terminal-ness okay " determines type of quota (seg/dir), returns to call+(1/2) so depending " also sets a to have corresponding mask bit for tqsw, " q to have a 0/1 corresponding to (seg/dir) type_terminal_quota: lda ast|aste.nqsw_word,.aste special seg? cana aste.nqsw,dl .. tnz 0,.ret leave whole biz if so cana aste.dirsw,dl dirsw_word same as nqsw_word tnz type.dir_quota lda aste.tqsw,dl seg quota type ldq 0,dl tra 0,.2ret type.dir_quota: lda aste.tqsw/2,dl ldq 1,dl tra 1,.2ret quota.lx: ldx .2ret,ast|aste.used,.tem instructions to load desired lxl .2ret,ast|aste.used,.tem quota cell quota.sx: stx .2ret,ast|aste.used,.tem instructions to store desired sxl .2ret,ast|aste.used,.tem quota cell quota.tq_mask: arg aste.tqsw values for checking for tqsw arg aste.tqsw/2 in bump_quota_covert_check " " " " " " " " " " " " " " " " " " " " " " " " " " " check_accessible subroutine to check if any processor can access " the page in question. This tells us whether to " clear all the AM's. " " " " " " " " " " " " " " " " " " " " " " " " " check_accessible: ldx .tem,ast|aste.strp,.aste " get aste.strp tnz 0,.2ret " must CAM lda ast|aste.hc_sdw_word,.aste " check for HC segment cana aste.hc_sdw,du " aste.hc_sdw? tnz 0,.2ret " yes, CAM " volmap_seg_word same as hc_sdw_word cana aste.volmap_seg,dl " aste.volmap_seg? tnz 0,.2ret " yes, CAM tra 1,.2ret " we save some connects! " " " " " " " " " " " " " " " " " " " " " " " " " " " " Routines to check for pages of synchronized segments " " " On evict, do housekeeping " " tsx7 check_synch_cleanup " " On write, check if page must be held " " tsx7 check_for_synch_hold " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_synch_cleanup: lda cme_flags,*.cme cana cme.synch_held,dl synchronized page tze 0,.ret no tra page_synch$cleanup return to 0,x7 check_for_synch_hold: lda ast|aste.synchronized_word,.aste cana aste.synchronized,dl synchronized page tze 1,.ret no tsx .2ret,savex recursive use of x7 tsx .ret,page_synch$write check whether we should write tra unsavex do not write tra unsavex_1 write OK " " " " " " " " " " " " " " " " " " " " " " " " " " " update_csl subroutine to make sure the csl " for a segment is correct. It is called " when a page is found to be zero, " either by being modified to zeroes or " by being a non-modified null address. " " " " " " " " " " " " " " " " " " " " " " " " " " update_csl: stz temp zero out entire word stz temp+1 and next as well eax .tem,aste_size,.aste get a pointer to the page table stx .tem,temp save for now stx .tem,temp+1 eax .tem,1,.ptw get page number by subtracting base of PT from ptp sblx .tem,temp (add 1 to get csl ) stx .tem,temp lda ast|aste.csl_word,.aste pick up csl of segment ana aste.csl_mask_inner,du arl aste.csl_shift-18 shift to upper a, right justified cmpa temp compare with page number tnz 0,.ret not the same, don't change csl eax .tem,-1,.ptw start search at previous page cmpx .tem,temp+1 end search at first page of segment tnc up_csl.set_csl done (at page zero) ldq ptw.valid,dl get in core flag for compares csl_loop: canq sst|0,.tem is current page in core ? tnz up_csl.set_csl yes, stop and set csl here lda sst|0,.tem get ptw cana add_type.non_null,dl is there a real address? tze up_csl.dont_count als 0 test sign tpl up_csl.set_csl real disk address up_csl.dont_count: eax .tem,-1,.tem go to previous PTW cmpx .tem,temp+1 are we passed the start ? trc csl_loop no, loop back and check this page up_csl.set_csl: "update csl into AST entry eaa 1,.tem get curerrent ptp (+1 to convert to csl format) sbla temp+1 subtract out base of page table als aste.csl_shift-18 shift to position in AST entry era ast|aste.csl_word,.aste and store in AST entry ana aste.csl_mask_inner,du ersa ast|aste.csl_word,.aste tra 0,.ret return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " fault " " This entry is transferred to from the fault vector when a page fault " occurs. The pointers, registers, etc. must be saved... " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " even fault: inhibit on spri pf_prs,* eppap pf_prs,* get pointer to MC sreg ap|mc.regs save registers spl ap|mc.eis_info epplp my_lp,* set up linkage pointer read_clock start metering staq ap|mc.fault_time save fault time in machine conditions staq pds$time_1 and in pds aos pds$vtime_count check for recursive virtual metering tpnz already_metering .. sbaq pds$cpu_time calculate virtual time staq pds$time_v_temp save until RCU time already_metering: tsx .ret,reset_mode_reg reset mode register (turn on history regs) rsw 0 get set for possible tracing sta sst$+sst.trace_sw lxl1 prds$processor_tag get set for masking lprpab scs$mask_ptr,1 xec scs$read_mask,1 staq ap|mc.mask ldaq scs$sys_level xec scs$set_mask,1 xec fault_ctr_table,1 AB => per-cpu fault ctr array aos ab|0+FAULT_NO_DF1 inhibit off eppab sp|0 save sp in ab eppsp prds$+stack_header.stack_begin_ptr,* get set for push macro epbpsb sp|0 set stack base pointer push spriab sp|stack_frame.prev_sp now save previous sp lca scu.ir.parm+1,dl make sure parity mask is OFF ansa ap|mc.scu.indicators_word " " The following code checks to make sure we don't get a fault while " we're on the PRDS. " lxl7 ap|mc.prs+6*2 however, if were not in ring 0, OK canx7 =o700000,du tnz masked_switched_legal not in ring 0, OK ldx7 ap|mc.prs+6*2 get SP at time of fault cmpx7 lp|prds_link compare segment number to that of PRDS tze fault_while_on_prds bad news, return to bos masked_switched_legal: tsx .2ret,init_savex initialize save_stack for x7 tsx .ret,lock_ptl lock the page table lock pft_lret: stz entry_sw fault entry, set switch stz ap|mc.errcode zero error code for later use eppap pds$page_fault_data restore pointer to fault data epplb dseg$ get pointer to descriptor segment " If a page fault is taken during an instruction fetch then the CU status " bit IF (instruction fetch) will be ON. lxl1 ap|mc.scu.cu_stat_word Get CU status bits canx1 scu.cu.if,du Is IF bit ON? tze regular_page_fault not on, must be normal one (so use TSR) lda ap|mc.scu.ppr.psr_word For an IF page fault the PSR is valid lxl1 ap|mc.scu.apu_stat_word Reset x1 to APU status bits. tra all_page_faults Go join normal path regular_page_fault: lxl1 ap|mc.scu.apu_stat_word see what type of fault canx1 scu.apu.ptw+scu.apu.dsptw+scu.apu.ptw2,du is it a normal page fault? tnz *+2 if one of these bits is on we're OK tsx5 page_fault_error "ERROR - BAD SCU DATA NO APU BITS" lda ap|mc.scu.tpr.tsr_word This is the normal path. The segno is in TSR all_page_faults: ldq ap|mc.scu.ca_word page number is derived from CA field canx1 scu.apu.ptw2,du is it a pre-page (decimal instruction) tze *+2 no, don't increment page number adlq 1024,du yes, up the page number by 1 ana scu.tpr.tsr_mask,du leave just the segno in AU sta temp save for bound comparison. als 1 multiply by sdw size eax .tem,0,au put in x0 lda lb|1 get DSEG sdw bounds word (bound 377770) ora =o7,du convert bounds to max segno cmpa temp this is segno 377770000000 tmi bad_segno Segno out of reason. stq temp save tsr word offset ldaq lb|0 get addr of descriptor segment from its sdw (DBR) arl sdw.add_shift move to fixed bin " see if dseg paged sbla unpaged_page_tables$0+upt.sst_absloc convert to page table pointer tmi not_dseg unpaged page tables are below sst eppbp sst|0,al make bp point to first page table word eaa 0,.tem get two times segno arl 10 get page number of dseg canx1 scu.apu.dsptw,du Is this a page fault on the dseg? tnz dseg_page_fault Yes, skip the following code lda ptw|0,au get correct PTW for dseg cana ptw.valid,dl .. tze quit there is fault, go take it not_dseg: ldaq lb|0,.tem look for seg-fault, get sdw of segment cana sdw.valid,dl see if directed fault set tze quit go handle seg-fault staq pf_sdw save access fields arl 36-24 move to fixed bin sbla sst|sst.ptwbase no seg-fault, get page table index eppbp sst|0,al get the astep (+aste_size) ldq temp get back word offset qrl page_power convert to page number tra found_faulted_page skip code for dseg faults dseg_page_fault: stq pf_sdw+1 address word doesn't matter for dseg eaq 0,au copy page number into q found_faulted_page: eax .aste,ptw|-aste_size get real astep into x3 eppbp ptw|0,qu adjust ptwp to point to the actual PTW eax .ptw,ptw|0 and save it in x2 ldq ptw|0 get PTW in q-reg canq ptw.valid,dl see if fault still exists tnz quit no, return canq ptw.os,dl is the page out of service? tnz short_page_fault process short pf canq ptw.er,dl is page in error from earlier read? tnz page_read_error yes, signal an error. lda ast|aste.npfs_word,.aste see if no-page-fault-switch is on cana aste.npfs,du .. tnz create_segment_fault " " Here the commitment has been made to actually " read in one page of virtual memory. " tsx .ret,pc_trace$page_fault tsx .ret,read_page tra readin.goon must wait for page tra readin.goon tra wait_any_event_apte wait for volmap event (in APTE by now) readin.goon: tsx .ret,pc_trace$page_fault_end tsx .ret,page_util_enter enter the page in the trace list " " The following are various per-process meters about paging activity " as well as some system meters about where page faults are " happening. " lda ast|aste.per_process_word,.aste count pdir faults cana aste.per_process,du tze *+2 increment sst|sst.pdir_page_faults lxl .tem,ast|aste.par_astep,.aste count faults in segs off dirs off root lxl .tem,ast|aste.par_astep,.tem cmpx .tem,sst|sst.root_astep+1 tnz *+2 increment sst|sst.level_1_page_faults lda ast|aste.dirsw_word,.aste count dir pfts cana aste.dirsw,dl tze readin.meter_ndir_pft meter in AST increment sst|sst.dir_page_faults tra readin.meter_sgdir_join readin.meter_ndir_pft: "count in ASTE cana aste.gtus,du " gtus in same word as dirsw tnz readin.meter_sgdir_join " if transparent, can't count faults lda ast|seg_aste.usage,.aste adla 1,dl LOGICAL arith, please sta ast|seg_aste.usage,.aste readin.meter_sgdir_join: lda pds$page_fault_data+mc.scu.tpr.trr_word count ring 0 page faults cana scu.tpr.trr_mask,du tnz *+2 increment sst|sst.ring_0_page_faults aos pds$page_waits meter page waits aos pds$number_of_pages_in_use ldq sst|sst.nused number of available pages eppbb pds$apt_ptr,* can also be used to reference tc_data epbpbp bb|0 get pointer to base of apt lda tc_data$n_eligible make sure it isn't zero (can it ever be?) tze no_eligible sta temp div temp divide by the eligibility eaa 0 clear a-reg staq temp save measurement cmpq pds$number_of_pages_in_use are we in equilibrium tmi in_equilibrium yes ldq pds$number_of_pages_in_use until then use this value staq temp save it as the measure asq temp+1 which is doubled when not in equilibrium in_equilibrium: adaq bp|cumulative_memory_usage staq bp|cumulative_memory_usage ldaq temp reload measure for updating apte.paging_measure adaq bb|apte.paging_measure add the paging measure staq bb|apte.paging_measure and save it again no_eligible: ldx2 bb|apte.wct_index tze skip_pinning no WCTEs yet (initialization) " bp -> to base of apt (set above) lxl .tem,bp|wcte.pin_weight,2 get pin weight stx .tem,cme_pin_counter,*.cme skip_pinning: epp sst,sst$ restore sst ptr sxl .cme,cmep save cmep tsx .ret,claim_mod_core write out mod pages lxl .cme,cmep ldx .ptw,ptp_astep reload .ptw lxl .aste,ptp_astep and .aste eppbp tc_data$ restore tcd ptr read_clock meter page fault time sbaq pds$time_1 get cpu time for this fault adaq bp|cpu_pf_time keep sum of times staq bp|cpu_pf_time aos bp|cpu_pf_count and count of faults " " " Wait for the page fault as appropriate. " epp ptw,sst|0,.ptw wait_ret: "here to wait for non/pd i/o lda ptw|0 make this check just in case.. cana ptw.os,dl tze quit "tra to pxss to wait for PTW I/O. ldq cme.notify_requested,dl set flag for notify orsq cme_flags,*.cme .. eaa 0,.ptw create PTW event wait_page_fault_event: arl 18 right justified wait_any_event: eppap pds$apt_ptr,* get apte ptr sta ap|apte.wait_event make it where can get notified. wait_any_event_apte: store_clock pds$time_1 tsx .ret,unlock_ptl dump posting queue, possibly notifying "this event, and unlock ptl. meter_time pds$time_1,sst|sst.pf_unlock_ptl_time,sst|sst.pf_unlock_ptl_meterings tra pxss$page_wait " " " End of page fault processing here. " These labels restart the page fault. " quit: tsx .ret,unlock_ptl unlock page table lock wait_return: "return location from pxss$page_wait eppap pds$page_fault_data get pointer to fault data read_clock cmpaq pds$first_covert_event_time tpl wait_return_no_delay " must wait until first_covert_event_time is met- that is, until covert channel " time is up ldaq pds$first_covert_event_time staq pds$arg_1 tra pxss$page_pause " will return at wait_return wait_return_no_delay: inhibit on ldaq ap|mc.mask retrieve previous mask oraq channel_mask_set turn on all channel mask anaq scs$open_level turn off unconfigured channel mask bits lxl1 prds$processor_tag lprpab scs$mask_ptr,1 xec scs$set_mask,1 ldaq prds$+stack_header.stack_begin_ptr restore stack end pointer for PRDS staq prds$+stack_header.stack_end_ptr odd tsx .ret,meter_virtual_time measure time to be taken out as virtual restart_fault: lpl ap|mc.eis_info restore EIS pointers and lengths lreg ap|mc.regs lpri pf_prs,* rcu pf_scuinfo,* inhibit off " " " Error and unconventional cases in page fault processing. " fault_while_on_prds: lca trbl_prds_pf,dl flag for page fault on prds sta scs$sys_trouble_pending lda pds$processid save our process ID stac scs$trouble_processid if we're the first lxl1 prds$processor_tag cioc scs$cow_ptrs,1* send connect to self nop nop nop tra fault_while_on_prds " " Come here when fault taken on page already being read. " short_page_fault: " Compute cme addr so that wait_ret can turn on notify_requested. " increment sst|sst.short_pf_count meter iftarget l68 " Shift different on L68/ADP qrl ptw_to_cmep.rl ifend iftarget adp anq ptw_add_mask,du " Must mask off all but page number qls ptw_to_cmep.ls ifend eax .cme,sst|sst.cmp,*qu point to cme. tra wait_ret and wait for the page " " Error bit set by done_ (done_read). Signal in " faulting process. " page_read_error: tsx .ret,disk_offlinep is disk down as per pvt? tra wait_any_event yes, wait for it, event in A lca ptw.er+1,dl turn off error flag ansa ptw|0 in PTW lda PAGE_ERROR_IOERR,dl eppab ast|0,.aste ASTE tra errquit bad_segno: lda PAGE_ERROR_BADFAULT,dl eppab null,* tra errquit errquit: sta pc_err_type sprpab pc_err_astep sprp ptw,pc_err_ptwp tsx .ret,unlock_ptl " " Call pc_signal to copy machine conditions, and otherwise set " up for the signaller ldaq pc_signal_arglist staq arg eppap pc_err_type spriap arg+2 eppap pc_err_astep spriap arg+4 eppap pc_err_ptwp spriap arg+6 call pc_signal$pc_signal(arg) " " Now change the stack pointer so that if a process takes a page " fault while signalling which also gets an error (RQO possibly) " that we don't crash the system because our sp will still point " to the PRDS. " ldaq prds$+stack_header.stack_begin_ptr staq prds$+stack_header.stack_end_ptr reset stack end pointer eppap pds$signal_data eppsp ap|mc.prs+6*2,* change sp to that at time of the fault " " Now complete the virtual time calculation that were by-passed because we did " not do an RCU. " tsx .ret,meter_virtual_time tra signaller$signaller now let the signaller do the work " data for signal call. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pread " " Entry to read a page into core. " " Call is: " call page$pread(astep,pageno,waitev) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pread: push stz ap|6,* lda read_entry,dl set entry switch sta entry_sw tsx .2ret,init_savex set up stack pread.loop: "may have paged in 2 or more stages, tho. eppap sp|stack_frame.arg_ptr,* eppbp ap|2,* epp sst,sst$ eppbp bp|0,* eax .aste,bp|0 lda ap|4,* eax .ptw,bp|aste_size,al point to ptw epp ptw,sst|0,.ptw lda ptw|0 is page in? cana ptw.valid,dl tnz return yes, no problem. cana ptw.er,dl error from previous read? tze pread.read_page no, just read tsx .ret,disk_offlinep tra pread.wait_any go wait global event if needed pread.read_page: tsx .ret,read_page do some work. tra pread.wait must wait, indicate or loop tra pread.loop must check again. eppap pds$apt_ptr,* retrieve wait event lda ap|apte.wait_event tra pread.wait_any volmap event pread.wait: pread.wait_ret: arl 18 convert to wait event pread.wait_any: eppap sp|stack_frame.arg_ptr,* retrieve arg pointer sta ap|6,* return wait event tra return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pwrite " " Entry to write a page out. " " Call is: " call page$pwrite(astep,pageno) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pwrite: push lda write_entry,dl set up entry switch sta entry_sw eppbp ap|2,* get pointer to APT eppbp bp|0,* epbpbb bp|0 let bb point to base of sst eax .aste,bp|0 lda ap|4,* get page number eax2 bp|aste_size,al eppbp sst|0,.ptw make sure bp points to PTW lda ptw|0 pick up page table word iftarget l68 " Shift different on L68/ADP arl ptw_to_cmep.rl ifend iftarget adp ana ptw_add_mask,du " Must mask off all but page number als ptw_to_cmep.ls ifend eax .cme,sst|sst.cmp,*au tsx .2ret,init_savex initialize save stack for x7 tsx .ret,write_page tra return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pcleanup " " Entry to get a page out of core. " " Call is: " call page$pcleanup (astep, pageno) " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pcleanup: push lda cleanup_entry,dl sta entry_sw tsx .2ret,init_savex_bb epp ptw,ap|2,* epp ptw,ptw|0,* get astep eax .aste,ptw|0 lda ap|4,* get pageno eax .ptw,ptw|aste_size,al epp ptw,sst|0,.ptw lda ptw|0 get ptw cana add_type.disk+ptw.os,dl tze *+2 tsx5 page_fault_error "ERROR - PCLEANUP: CALLED ON BAD-STATE PAGE iftarget l68 " Shift different on L68/ADP arl ptw_to_cmep.rl ifend iftarget adp ana ptw_add_mask,du " Must mask off all but page number als ptw_to_cmep.ls ifend eax .cme,sst|sst.cmp,*au arl cmep_to_coreadd.rl sta core_add lca ptw.valid+1,dl ansa ptw|0 turn off ptw access tsx .2ret,check_accessible " only CAM if needed tsx .ret,cam_cache$cam_cache make sure it takes tsx .ret,cleanup_page do the work. return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " read_page, read_page_abs " " Subroutine called by tsx7 to read a page into core (or if " the page has never beeen referenced it will zero the core). " A free block of core is found and possibly several 'writes' are " queued in searching for the free core for the read_page entry. " For the read_page_abs entry the free block of core " specified by the caller is used. " " tsx7 read_page " " " " " The subroutine expects " " x2 = pointer to PTW " x3 = pointer to AST entry " bp = pointer somewhere into SST " bb = pointer to base of SST " " In addition, the read_page_abs entry expects " " x4 = pointer to core map entry of free block " " " " " " " " "" " " " " " " " " " " " " " " " " " " " " " " " " read_page_abs: tsx .2ret,savex recursive use of index 7 tsx .ret,check_allocation make sure we have disk. tsx5 page_fault_error "ERROR - OOPV ON EHS SEG" tra read_page_abs.apte_event volmap event tra read_page_join read_page_abs.apte_event: eppap pds$apt_ptr,* event is in APTE lda ap|apte.wait_event tra unsavex_2 return to caller read_page: tsx .2ret,savex recursive use of index 7 tsx .ret,check_quota check for quota overflow tsx .ret,check_allocation is there disk available? tra read_page.oodev no disk on this PV tra unsavex_2 must wait for volmap event stx .ptw,ptp_astep save x2 and x3 for now sxl .aste,ptp_astep .. tsx .ret,find_core find a free block of core ldx .ptw,ptp_astep restore x2 and x3 eppbp sst|0,.ptw make sure bp points to PTW as well lxl .aste,ptp_astep .. " read_page_join: " At this point, a cme to ptw binding is established. To validate the " assumptions of pc_recover_sst, it must be done in following order: " Auxiliary info into CME " cme.ptwp <= ptwp " ptw.add <= CORE lca ptw.phm+ptw.phm1+ptw.er+1,dl " turn off bad bits. ansa ptw|0 lda ptw|0 copy device address to core map entry staddra cme_devadd,*.cme store address from ptw into cme lca cme.io+cme.phm_hedge+cme.removing+cme.notify_requested+1,dl ansa cme_flags,*.cme clear random flags sxl .aste,cme_astep,*.cme Associate astep with cme, not ptp yet. " Do not store ptwp in cme until cme is ready, core clear, or ptw os. eaa 0,.cme copy rel(cmep) to a-reg sbla sst|sst.cmp+1 to get core address arl cmep_to_coreadd.rl sta core_add save core address ldq aste.init,du turn off init bit in aste orsq ast|aste.init_word,.aste .. ersq ast|aste.init_word,.aste .. ldq ast|aste.np_word,.aste increment number of pages in core anq aste.np_mask,dl tnz read.incr_np " " Reading in the first page causes dtu to advance. Also, the dtm may be " advanced. Lets see. " ldq 1,dl this will advance to 1 page szn pds$throttle_segment_state_changes tze read.set_np don't count events szn entry_sw tnz read.set_np only count on fault side " Count this event. Our assumptions: " dtm - w access implies that we can (and must assume we will) advance dtm. " Advancing dtm is always lower class visible since it propogates up " the hierarchy. However, we know that dirs advance dtm only when " they want to (in sum$dirmod), so we don't count dirs as setting " dtm here. " " dtu - w access implies that our authorization equals the access class " of the object, hence our setting dtu is not lower class visible. " However, multi-class and directories violate this rule. " " Hence: a non-directory, multi-class writable object advances dtu and dtm " in a lower class visible way. All other cases advance either dtu or dtm " but not both. lda pf_sdw+1 cana sdw.write,du check for write tze read.covert_1 no write lda ast|aste.dirsw_word,.aste " (also multi_class word) cana aste.multi_class,du tze read.covert_1 non-multi-class cana aste.dirsw,dl tnz read.covert_1 is a dir tsx .ret,limit_covert_channel both dtu and dtm set read.covert_1: tsx .ret,limit_covert_channel only dtu or dtm set ldq 1,dl advance np to 1 page tra read.set_np read.incr_np: adlq 1,dl erq ast|aste.np_word,.aste anq aste.np_mask,dl read.set_np: ersq ast|aste.np_word,.aste lda cme_devadd,*.cme pick up cme devadd cana add_type.non_null,dl is there an address? tnz *+2 must have real allocation here tsx5 page_fault_error "ERROR - NO ALLOCATION IN PTW: READ_PAGE" als 0 is it a real address? tpl must_read yes, actually read it " "Make zeroes for a predeposited address. " "tra read.create_zeros is right on the next page " " " Page had either a null or nulled address in PTW. " Create a fresh page of zeroes. " read.create_zeros: lda ast|aste.records_word,.aste adla =o001000,dl increment records used era ast|aste.records_word,.aste ana aste.records_mask_inner,dl ersa ast|aste.records_word,.aste " Adding a page can be a covert event, if this is a multi-class object " (records used, etc. lower class visible) or if this is a dir without " terminal quota between it and the nearest upgraded node. " We don't have to worry about questions of setting csl/ru since the only " cases where page creations are covert events are cases where the page " creations are performed by trusted code themselves, and in which we know " that pages are created serially. The user cannot create any random page " in these segments, only the next. Thus, csl and ru contain the same " information, even though ru may later become less than csl if some of " these new pages end up zero. szn pds$throttle_segment_state_changes tze read.bump_quota don't count events szn entry_sw tnz read.bump_quota only on fault side lda ast|aste.multi_class_word,.aste cana aste.multi_class,du tze read.create_check_dir tsx .ret,limit_covert_channel multi-class tra read.bump_quota read.create_check_dir: cana aste.dirsw,dl tze read.bump_quota non-dir " We have a dir. We shall do a special bump quota which checks for " terminal-ness. tsx .ret,bump_quota_covert_check increment used tsx .ret,limit_covert_channel upgraded found first tra read.quota_bumped read.bump_quota: tsx .ret,bump_quota increment used read.quota_bumped: increment sst|sst.new_pages meter new pages created tsx .ret,clear_core zero out the core " " Now it is safe to store .ptw in cme " stx .ptw,cme_ptwp,*.cme lda core_add pick up core address again als coreadd_to_ptw.ls ora add_type.core,dl staddra ptw|0 store in ptw lda ptw.phu+ptw.valid+df1,dl make used, accessible, refresh bit orsa ptw|0 stx .aste,temp calculate page number eax .tem,1-aste_size,.ptw by subtracting astep from (ptwp-aste_size+1) sblx .tem,temp stz temp sxl .tem,temp save in temp lda ast|aste.csl_word,.aste pick up current csl ana aste.csl_mask_inner,du arl aste.csl_shift cmpa temp compare ... tpl unsavex_1 csl already larger than this ldq temp retrieve new csl value qls aste.csl_shift position for store into ASTE erq ast|aste.csl_word,.aste anq aste.csl_mask_inner,du ersq ast|aste.csl_word,.aste tra unsavex_1 " " covert channel test - update covert channel event count, test bandwidth " limit_covert_channel: aos pds$covert_event_count tmi 0,.ret not enough events to monitor, yet " arriving here, we need to determine the bandwidth of these covert channel " events and possible audit or delay read_clock sbaq pds$first_covert_event_time cmpaq covert.big_time tpl covert.reset_clock time too great to count div sst|sst.seg_state_change_limit usecs/bit in q stq temp and temp mpy sst|sst.audit_seg_state_change_bw cmpaq covert.million tpl covert.test_delay usecs/bit*max_bps<1000000 " audit here increment sst|sst.audit_seg_state_chg tsx .2ret,page_error$excessive_seg_state_chg covert.test_delay: ldq temp mpy sst|sst.max_seg_state_change_bw cmpaq covert.million tpl covert.reset_clock usecs/bit*max_bps<1000000 " delay process increment sst|sst.delayed_seg_state_chg ldaq covert.million div sst|sst.max_seg_state_change_bw desired usecs/bit sbq temp delay as usecs/bit mpy sst|sst.seg_state_change_limit delay in aq staq pds$first_covert_event_time temp storage adlaq sst|sst.seg_state_chg_delay " this isn't really correct, " this is how long we want to delay, " not how long we will - but it's not " worth metering the real delay staq sst|sst.seg_state_chg_delay read_clock set time to delay until adaq pds$first_covert_event_time see wait_return for use of time tra covert.reset covert.reset_clock: read_clock covert.reset: staq pds$first_covert_event_time lca sst|sst.seg_state_change_limit sta pds$covert_event_count tra 0,.ret even covert.big_time: oct 0,377777777777 covert.million: dec 0,1000000 " " " Page had non-null add type. Must actually read page in. " PTW is in A register. " must_read: sta devadd save device address in stack tsx .ret,get_pvtx get segment pvtx for fault read.must_rd.merge: tsx .ret,device_control$check_ckdv see if checking device incomplete tsx .ret,store_pattern if so, store pattern " " Set up os bit before storing ptwp in cme, so page goes back in pc_r_sst. " lca cme.io+1,dl set io flag to "read" ansa cme_flags,*.cme lda ptw.os,dl turn it on orsa ptw|0 stx .ptw,cme_ptwp,*.cme lda core_add set up ptw afresh als coreadd_to_ptw.ls ora add_type.core,dl staddra ptw|0 put in coreadd tsx .ret,thread_out OS out of list lda int+pri,dl (almost) always interrupt on reads sta inter tsx .ret,device_control$dev_read read the page into core eaa 0,.ptw ptw is he wait event tra unsavex wait this event " " " Peculiar exits of read_page " read_page.oodev: "out of physical volume. "Signal a segfault. increment sst|sst.oopv meter lda aste.pack_ovfl,dl turn on aste bit orsa ast|aste.pack_ovfl_word,.aste in AST szn entry_sw better be a page_fault tze *+2 tsx5 page_fault_error "ERROR - OOPV ON READ_PAGE CALL" create_segment_fault: eppap pds$page_fault_data address mc lda ap|mc.scu.apu_stat_word cana scu.apu.dsptw,dl is this ds fault? tze *+2 tsx5 page_fault_error "ERROR - SETFAULT DESCRIPTOR SEGMENT" lxl .tem,ap|mc.scu.cu_stat_word was it IF? canx .tem,scu.cu.if,du tnz *+2 lda ap|mc.scu.tpr.tsr_word get TSR if not IF als 1 double segno ana =o177776,du iftarget l68 " On Level 68 only, must also set df_no to zero lcq sdw.valid+sdw.df_no_mask+1,dl ifend iftarget adp lcq sdw.valid+1,dl ifend ansq dseg$,au tsx .ret,cam_cache$cam tra quit seg mover will handle " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " disk_offlinep " " " " Is the seg's disk offline? " " " " tsx .ret,disk_offlinep " " tra yes, event in A " " null no " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " disk_offlinep: tsx .2ret,savex tsx .ret,get_pvtx tsx .ret,device_control$disk_offlinep tra *+2 offline tra unsavex_1 not offline lca ptw.er+1,dl turn OFF the error bit. This is ansa ptw|0 so that when the guy tries again "when the disk finally comes back, "the next call to disk_offlinep "doesnt cause a signal. lda disk_offline_event tra unsavex disk_offline_event: aci "dskw" " " " Check to see if page has allocation. Give one " if needed. " " tsx7 check_allocation " " " check_allocation: lda ptw|0 grab ptw cana add_type.core,dl tze *+2 make sure we're doing this right tsx5 page_fault_error "ERROR - CORE ADDR IN PTW: READ_PAGE" cana add_type.disk,dl " real devadd? tnz 2,.ret yes, that's fine. stx .aste,pageno ASTE offset eax .tem,-aste_size,.ptw sblx .tem,pageno Page number eaq 0,.tem qrl 18 stq pageno ldq ast|aste.vtocx,.aste anq -1,dl VTOCE Index stq vtocx tsx .2ret,savex enter free_store tsx .ret,get_pvtx get pvtx tsx .ret,free_store$withdraw get an address tra unsavex OOPV tra unsavex_1 volmap wait event " " Put nulled address where null one was. With respect to pc_recover_sst, " this is all the same. " lda devadd ora ptw.nulled,du this is semikilled address sta devadd staddra ptw|0 put in new address unsavex_2: ldx .ret,stackp,di tra 2,.ret return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " find_core_ " " Subroutine to find a block of free core. " " Call is: " tsx7 page_fault$find_core_ " " tsx7 find_core " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " equ pre_seek_limit,15 " Mod failure detection find_core_: " Externally available to ALM PC find_core: tsx .2ret,savex save index 7 increment sst|sst.needc meter times core was needed lca 1,du init ctr for out-of-core to -2**18 sta total_steps fploop: stz count zero count of steps lca pre_seek_limit,dl initialize mod failure ctr sta temp1 ldx .cme,sst|sst.usedp set cmep " re-entry from find_core.ptw_ng and find_core.skip_meter_mod fc1: lda cme_flags,*.cme check for total acceptability cana cme.removing+cme.abs_w,dl tnz find_core.cme_ng something unusable- meter & skip ldx .ptw,cme_ptwp,*.cme Is core free? Set ptp. tze found_core yes, take it. epp ptw,sst|0,.ptw point at ptw lda ptw|0 let's examine the ptw... cana ptw.phu+ptw.wired+ptw.os+ptw.phm+ptw.phm1,dl " make quick check tnz find_core.ptw_ng something in ptw is unacceptable. ldx .tem,cme_pin_counter,*.cme tpnz find_core.skip_pinned do not evict if still pinned " " Now attempt to evict the page. " " " " Here is where access is taken off for a potential eviction. " If we lose timing window, access comes back. Note that core address " in PTW stays valid until cleanup_page has run, and contents of " core page can be ignored (we are sure page is pure). lca ptw.valid+1,dl set directed fault 1 in ptw ansa ptw|0 .. lda ptw|0 make sure coreadd gets set ana ptw_add_mask,du " Mask off all but the page address bits arl ptw_to_coreadd.rl " Clear the right place in the cache sta core_add .. lxl .aste,cme_astep,*.cme " get astep tsx .2ret,check_accessible " CAM if needed tsx .ret,cam_cache$cam_cache " make sure the access gets turned off lda ptw|0 retrieve ptw for modified bit test cana ptw.phm+ptw.phm1+ptw.wired,dl has the page been modified now? or wired? tnz restore_ptw_access appear to have lost race stx .cme,sst|sst.usedp this frame now LRU tsx .ret,cleanup_page evict the page found_core: increment sst|sst.steps meter ldx .tem,cme_fp,*.cme move to MRU stx .tem,sst|sst.usedp tra unsavex find_core returns " " " PTW has some kind of unacceptable state: possibilities: " " 1. out of service- illegal- crash system " 2. wired- skip and meter " 3. modified- leave alone for claim_m_c to evict/unuse. " 4. nypd- leave alone for c_m_c to write to pd if unused. " 5. used- "unuse" for replacement algorithm. find_core.ptw_ng: cana ptw.os,dl this ought not be.. tze *+2 tsx5 page_fault_error "ERROR - FINDCORE FINDS OS ON LIST cana ptw.phm+ptw.phm1,dl has it been modified? tnz find_core.skip_meter_mod must be written, can't take. "don't care whether used or not -must leave "both bits for c_m_c, who will off them. cana ptw.wired,dl is it wired? tnz find_core.skip_wired " " Must be used, skip and meter, impl. replacement algorithm " by turning bit off. " increment sst|sst.skipu count used. lca ptw.phu+1,dl turn off phu bit in PTW ansa ptw|0 lda ptw.phu1,dl turn PHU1 ON in PTW orsa ptw|0 skip: ldx .cme,cme_fp,*.cme go to next core map entry in list increment sst|sst.steps count step aos total_steps up count of steps taken looking for core tmi fc1 if still neg, loop on. tra page_error$out_of_core Multics not in operation. restore_ptw_access: "come here when 2nd cpu mod in window lda ptw.valid,dl remove directed fault from ptw orsa ptw|0 .. find_core.skip_meter_mod: increment sst|sst.skipm count skip mod cmod1: increment sst|sst.steps ldx .tem,cme_fp,*.cme pt at next cme cmpx .tem,sst|sst.usedp have we walked whole queue? tze mods_excessive will run claim_mod_core on whole mem eax .cme,0,.tem go to next cme aos temp1 see if too many skipmods tpl mods_excessive too many tra fc1 find_core.skip_pinned: increment sst|sst.fc_skips_pinned no. of pin skips in find_core ldx .tem,cme_pin_counter,*.cme sblx .tem,1,du tmi skip never happen stx .tem,cme_pin_counter,*.cme tra skip " " " cme is unacceptable- following may be the case: " " 1. removing can't page in, must not be used. skip. " 2. abs_w IN PROCESS of being abs-wired.. may not " page in evict_page will do it by special means, " must avoid getting vol map in here by accident. find_core.cme_ng: cana cme.abs_w,dl abs wiring? tze skip no, just skip. find_core.skip_wired: increment sst|sst.skipw tra skip .. " " We arrive here when an excess of skips-mod have been made. " Potentially, every page in core can be mod and used. Hence, " tentatively, the fast find_core has failed. Do it the old way. " mods_excessive: stx .cme,sst|sst.usedp save ptr to NEXT cme increment sst|sst.pre_seeks_failed meter tsx .ret,claim_mod_core do writes, may even post. tra fploop restart find_core_ " """""""""""""""""""""""""""""""""""""""""""""""""" " " " Subroutine to evict one " " page from core. " " " """""""""""""""""""""""""""""""""""""""""""""""""" cleanup_page: tsx .2ret,savex lxl .aste,cme_astep,*.cme get astep " " Unbind core from ptw here. For validity of pc_recover_sst, this " must be done in the following order: " Put non-core address back in ptw " cme.ptwp <= 000000 " Clean up cme " lda cme_devadd,*.cme clear out ptw staddra ptw|0 lda ast|aste.np_word,.aste subtract from count of pages in core sbla 1,dl era ast|aste.np_word,.aste ana aste.np_mask,dl ersa ast|aste.np_word,.aste lda ast|aste.np_word,.aste cana aste.np_mask,dl see if any pages left in core tnz cleanup.np_nonzero yes, continue lda aste.init,du no, turn init bit ON in ASTE ora ast|aste.init_word,.aste .. sta ast|aste.init_word,.aste gtus is in same word, so... cana aste.gtus,du check gtus. If on, leave dtu alone tnz cleanup.np_nonzero nothing to do read_clock get time lls 20 convert to fstime in A sta ast|aste.dtu,.aste and drop it in cleanup.np_nonzero: tsx .ret,check_synch_cleanup do housekeeping for synchronized page lda ptw|0 if not live address, must adjust quota... cana add_type.non_null,dl and records_used. tze cleanup.rsq null, reset recs. cana ptw.nulled,du is it nulled? tze cleanup.nrsq1 not nulled, don't reset. cleanup.rsq: tsx .ret,update_csl make sure csl is correct lda ast|aste.records_word,.aste ana aste.records_mask_inner,dl sbla =o001000,dl decrement records used tpl cleanup.recused_okay szn pvt$esd_state tnz cleanup.recused_okay tsx5 page_fault_error "ERROR - RECUSED WENT NEG: CLEANUP" cleanup.recused_okay: era ast|aste.records_word,.aste ana aste.records_mask_inner,dl ersa ast|aste.records_word,.aste tsx .ret,reset_quota deduct a quotum used cleanup.nrsq1: eax .tem,0 zero ptw correspondence stx .tem,cme_ptwp,*.cme .. sxl .tem,cme_astep,*.cme zero astep correspondence too tsx .ret,thread_to_lru move to head of list lca ptw.phm+ptw.phm1+1,dl " turn off mod ansa ptw|0 tra unsavex " """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " " " " claim_mod_core " " " " Tsx .ret,claim_mod_core to sweep " " up all the writes that " " find_core chose not to do. " " " """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""" claim_mod_core: tsx .2ret,savex save return increment sst|sst.write_hunts meter mc_continue: ldx .cme,sst|sst.wusedp start at last point mclp: cmpx .cme,sst|sst.usedp are we up to find_core? tze cl_done increment sst|sst.claim_steps meter steps lda cme_flags,*.cme look at cme cana cme.removing+cme.abs_w,dl " check unacceptable states tnz cl_bad ldx .ptw,cme_ptwp,*.cme point to ptw tze cl_free this is really bad, for "this cme should be "in front of usedp. epp ptw,sst|0,.ptw point to ptw lda ptw|0 consider ptw cana ptw.os+ptw.wired,dl tnz cl_ptwbad cana ptw.phm+ptw.phm1,dl " we only care about those f_c_ skipped tze cl_notmod cana ptw.phu,dl see if used tnz cl_used turn off used if on ldx .tem,cme_pin_counter,*.cme see if page is pinned tpnz cl_pinned increment sst|sst.claim_writes meters ldx .tem,cme_fp,*.cme peek ahead to next cme stx .tem,sst|sst.wusedp save pointer lxl .aste,cme_astep,*.cme pick up astep tsx .ret,write_page write_page will do all necessary tra mc_continue mc_end: ldx .cme,cme_fp,*.cme scan on into map tra mclp cl_bad: increment sst|sst.claim_skip_cme A CME had permanent unacceptable state, or RWS tra mc_end cl_ptwbad: increment sst|sst.claim_skip_ptw PTW wired tra mc_end cl_free: increment sst|sst.claim_skip_free A CME was free to claim_mod_core tra mc_end cl_notmod: increment sst|sst.claim_notmod not modified, not interesting tra mc_end cl_used: lcq ptw.phu+1,dl mod, but used. ansq ptw|0 turn off used and pray for cam. ldq ptw.phu1,dl dont screw up working sets orsq ptw|0 increment sst|sst.claim_passed_used tra mc_end cl_pinned: increment sst|sst.cl_skips_pinned no. of pin skips in claim_mod " cme_pin_counter in x0 sblx .tem,1,du tmi mc_end never happen stx .tem,cme_pin_counter,*.cme tra mc_end cl_done: stx .cme,sst|sst.wusedp tra unsavex " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write_page " " Subroutine to check to see a page should be written out. " If so, initiate the I/O. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write_page: " " Page has been modified " tsx .2ret,savex recursive use of .ret tsx .ret,get_pvtx get pvtx from AST tsx .ret,pc_trace$write_page eaa 0,.cme compute core_add from cmep sbla sst|sst.cmp+1 arl cmep_to_coreadd.rl .. sta core_add lda cme_devadd,*.cme save devadd in stack sta devadd .. lda ptw|0 inspect ptw cana ptw.os,dl check for o/s tze *+2 tsx5 page_fault_error "ERROR - WRITE CALL ON OS PAGE" cana ptw.phm+ptw.phm1,dl " if neither on, obsolete call tze unsavex lxl .tem,ast|aste.par_astep,.aste dont update if no parent tze write.dont_set_fms ldq ast|aste.gtms_word,.aste check global-transparent-modified-switch canq aste.gtms,du tnz write.dont_set_fms if on, don't set fms cana ptw.phm,dl was fms set by pc$update_incore_fms? tze write.dont_set_fms yes, don't set it eax .tem,0,.aste copy AST parent to x0 (first time is AST) read_clock get current time lrs 16 convert to fstime in Q lda aste.fms,du get set to turn on all superior fms's write.set_parent_fms: orsa ast|aste.fms_word,.tem stq ast|aste.dtm,.tem set dtm as well lxl .tem,ast|aste.par_astep,.tem tnz write.set_parent_fms write.dont_set_fms: tsx .2ret,set_up_abs_seg abs_seg1 -> page in memory, ap -> abs_seg1 tsx .ret,check_for_synch_hold synchronized page, not to be written tra unsavex yes - don't write szn tc_data$system_shutdown don't null pages during shutdown tnz page_non_zero yes, pretend page non-zero(don't deposit anything) ldq ast|aste.dnzp_word,.aste don't null if special flag set canq aste.dnzp,du .. tnz page_non_zero lda ptw|0 Don't null wired pages. cana ptw.wired,dl tnz page_non_zero tsx .ret,check_for_zero test for a zero page tra page_non_zero return here if really not zero lca ptw.valid+1,dl set directed fault 1 in ptw ansa ptw|0 .. tsx .2ret,check_accessible " only CAM if needed tsx .ret,cam_cache$cam_cache make sure people see it tsx .ret,check_for_zero try again after turning off access tra page_non_zero_a he just modified it before we zapped access, phooey " " page was all zeroes " increment sst|sst.zero_pages tsx .ret,pc_trace$zero_page lda ptw.nulled,du null the disk addr in cme. orsa cme_devadd,*.cme lda aste.fmchanged,du turn on map changed bit orsa ast|aste.fmchanged_word,.aste tsx .ret,cleanup_page evict page from core, turns off phm. tra unsavex " " come here because the page is non-zero and must be written out " page_non_zero_a: lda ptw.valid,dl remove directed fault from ptw orsa ptw|0 .. page_non_zero: lda cme_devadd,*.cme cana add_type.non_null,dl is it real null? tnz write.pnz.to_disk " " Was a real null address- this must not be so at this point!!! " write.nz.was_real_null: " tsx5 page_fault_error "ERROR - NO ALLOCATION AT WRITE TIME" write.pnz.to_disk: lda unnull_mask unnull, but not in core map ansa devadd " " " Actually set up like we're gonna write. " Recovery strategy requires cme.io set before os set. " do_write: tsx .ret,thread_out OS out of list lda cme.io,dl turn on write bit in CME orsa cme_flags,*.cme .. lda ptw.os,dl set ptw out of service orsa ptw|0 lca ptw.phm+ptw.phm1+1,dl turn it off once ptw.os is on. ansa ptw|0 tsx .2ret,check_accessible " if needed: tsx .ret,cam_cache$cam_ptws turn it off on all cpus. do_write.not_mod: stz inter generally don't interrupt on writes lda entry_sw see if write entry cmpa write_entry,dl tnz do_write.not_pri not, continue lda int+pri,dl interrupt on write entry sta inter do_write.not_pri: tsx .ret,device_control$dev_write initiate the write tra unsavex " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " done,done_ " " Entry (subroutine) to post the completion of I/O. " Call is " call done(core_add,errcode) " or " tsx7 done_ " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " done: tra core_queue_man$disk_post done_: eppbb sst$ bb must point into SST for PAGE tsx .2ret,savex save return loc in stack lda core_add get core map entry pointer als coreadd_to_cmep.ls eax .cme,sst|sst.cmp,*au set up .cme tsx .ret,pc_trace$done " " Flags to A-reg until we know where we're headed. " lxl .tem,cme_astep,*.cme save astep for later stx .tem,done_astep lda cme_flags,*.cme see if a read/write sequence is active ldq cme_devadd,*.cme pick up device address out of CM entry stq devadd and save in stack ldx .ptw,cme_ptwp,*.cme get ptp tze page_error$error_in_done core must be used eppbp sst|0,.ptw lxl .tem,ptw|0 check for out of service canx .tem,ptw.os,du tze page_error$error_in_done lxl .aste,cme_astep,*.cme get astep cana cme.io,dl Was this a write? tnz done_write yes, go handle it "tra done_read *** is on the next page *** " " done_read -- thread core in mru, " and turn on PTW access. " done_read: tsx .ret,thread_in_mru make most recently used szn errcode check error code tnz error_on_read error ... " " Check for device incomplete " tsx .ret,device_control$check_ckdv tsx .ret,check_pattern dvctl returns here if checking on tra done.read.no_ckdv_error c_p comes here if no error. "also, dvctl comes here if not checking! tsx .2ret,page_error$device_error tra error_on_read treat as fatal error done.read.no_ckdv_error: lda ptw.valid+df1,dl turn on access orsa ptw|0 lca ptw.os+1,dl turn off os bit ansa ptw|0 " tra notify_code " (Actually, just fall through to this) " " " " " Post a read or write complete, with or without error. " Call handler for I/O to volmap_seg. " Cause a page faulter to restart his fault, and cause " call side to retry. " notify_code: " " Check for notify_requested. If none, neither notify " nor idle pre_empt. " lda cme.notify_requested,dl get flag cana cme_flags,*.cme see if on in cme tze notify_end no, just return ersa cme_flags,*.cme was on. Turn off and "notify/preempt. done.notify.uncond: szn tc_data$pre_empt_flag see if we're pre-empting (and notifying) tnz check_idle we're not pre-empting. are we an idle process ? eaq 0,.ptw get event from ptw addr qrl 18 stq pds$arg_1 save argument tra pxss$page_notify entry notify_return notify_return: epp sst,sst$ restore sst pr, possibly for done_ entry. notify_end: ldx .tem,done_astep astep lda sst|aste.volmap_seg_word,.tem see if this is a volmap_seg cana aste.volmap_seg,dl tze unsavex no - return to the caller of done lda sst|aste.pvtx_word,.tem arl aste.pvtx_shift ana aste.pvtx_mask,dl pvtx in Areg tsx .ret,volmap_page$post_io do asynchronous stuff epp sst,sst$ restore tra unsavex return to caller of done check_idle: ldaq pds$apt_ptr see if we're an idle process cmpaq prds$idle_ptr tnz notify_end no, just return lda apte.pre_empt_pending,du eppbp pds$apt_ptr,* orsa bp|apte.flags lxl1 prds$processor_tag stc2 pds$connect_pending cioc scs$cow_ptrs,1* tra notify_end " " " error_on_read - put Pdisk address back in PTW " error_on_read: increment sst|sst.page_read_errors meter tsx .ret,cleanup_page out of core lca ptw.os+1,dl Now oocore, off os. ansa ptw|0 lda ptw.er,dl mark ptw as signalable orsa ptw|0 tsx .ret,get_pvtx tsx .ret,call_disk_emergency tra done.notify.uncond " " " done_write - remove O/S status, " and thread core in LRU. " done_write: lca 1,dl decrement global count of writes. asa sst|sst.wtct tpl *+2 stz sst|sst.wtct make sure stays +. lda ptw.phm+ptw.phu,dl count uses of pages being written cana ptw|0 .. tze *+2 not used, don't count increment sst|sst.mod_during_write lca ptw.os+ptw.er+1,dl turn off OS and ERR flags. ansa ptw|0 lda ptw.valid,dl turn access on - it's off for synch pages orsa ptw|0 ldq errcode if error, go process it, passing tnz error_on_write error code in Q. lca cme.phm_hedge+1,dl turn off write ansa cme_flags,*.cme scheduler and pd_upflag " resurgo: lda cme_devadd,*.cme cana ptw.nulled,du is this null? tze rethread no, ordinary write. era ptw.nulled,du sta cme_devadd,*.cme increment sst|sst.resurrections meter resurgo.fmchanged: lda aste.fmchanged,du turn on fmc bit orsa ast|aste.fmchanged_word,.aste no_dblw: rethread: tsx .ret,thread_in insert in core map at lru tra notify_code and notify waiting processes " " " error_on_write - Zero data if data error, " but leave in core as modified if device inop. " error_on_write: "errcode passed in Q. increment sst|sst.page_write_errors meter canq errflags.memory_unusable,dl page damage or mem problem tnz done.werr.deverr " not pd case- analyze errcode canq errflags.device_inoperative,dl disk down? tnz write_device_inop yes, handle it " " Must be data error on write done.werr.deverr: " lda aste.damaged,dl orsa ast|aste.damaged_word,.aste lda aste.fmchanged,du cause vtoce update orsa ast|aste.fmchanged_word,.aste tsx .ret,thread_in get core in list lca ptw.valid+1,dl turn off access ansa ptw|0 tsx .ret,cam_cache$cam_cache tsx .ret,cleanup_page drive guy out of core lda ptw.er,dl orsa ptw|0 " " Try for an older copy of the page in any case. " eax .ret,page_error$reverting_page assume some stuff out there lda cme_devadd,*.cme get diskaddr or pdaddr cana add_type.non_null,dl any good stuff atall? tnz done.werr.deverr.printerr ptw ok eax .ret,page_error$zeroing_page ldq errcode see what case lda page_bad_null,du assume device lossage canq errflags.memory_unusable,dl tze *+2 lda page_devparity_null,du parity case staddra ptw|0 in the ptw done.werr.deverr.printerr: tsx .ret,0,.ret print barfage lda errcode do we have to make main mem vanish? cana errflags.memory_unusable,dl tze done.notify.uncond exit tsx .ret,delete_mm_frame delete this frame of main mem tra done.notify.uncond "cme has been freed, don't know whether "to notify or not, so do it. write_device_inop: tsx .ret,get_pvtx tsx .ret,call_disk_emergency lda ptw.phm1,dl turn mod bit back on orsa ptw|0 finish_write_error: tsx .ret,thread_in_mru avoid repl algorithm tra notify_code " " " Clear out and deconfigure main memory frame. " delete_mm_frame: tsx .2ret,savex tsx .ret,thread_out good move lca 1,dl just zap first word sta cme_0,*.cme asa sst|sst.nused it's not used. tsx .ret,page_error$deleting_mm_frame annuntio tra unsavex " " Subroutine to call disk_emergency on disk-errors, " So that he might make assessments of system-wide " implications of disk device status. call_disk_emergency: sta pvtx pvtx in a-reg eppap pvtx spriap arg+2 eppap errcode spriap arg+4 ldaq =v18/4,18/4,36/0 staq arg call disk_emergency$disk_emergency(sp|arg) tra 0,.ret end  page_synch.alm 11/11/89 1105.1r w 11/11/89 0804.3 102582 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " page_synch " " Module to manage Data Management synchronized pages for ALM " Page Control. " " Entries: " " cleanup when a synch page is evicted, for housekeeping " move when a synch page is moved from one frame to another " write when Page Control wants to write a synch page, to see " whether it can " unlink_journal when a journal time stamp is changed, to unlink " all held CMEs " " Written October 1982 by J. Bongiovanni " Modified June 1983 by M. Pandolf to better meter invalid formats " Modified May 1984 by Chris Jones to add move entry " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name page_synch segdef cleanup segdef move segdef write segdef unlink_journal minus_one: dec -1 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " cleanup " " Called when a synch page is evicted from memory, to do housekeeping " and reset CME bits. " " tsx7 page_synch$cleanup " " On entry, " x4 -> CME " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " cleanup: spriap page_synch_temp " Save register eppap dm_journal_seg_$ ldq page_fault$cme_flags,*x4 " CME flags canq cme.synch_held,dl " Held page? tze cleanup_not_held " No tsx6 thread_out " Yes - thread out of per-journal list cleanup_not_held: lca cme.synch_held+1,dl " Reset held bit ansa page_fault$cme_flags,*x4 tra ret_0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " move " " Called when a synch-held page is moved from one frame to another. " Its entry in dm_journal_seg_ must be updated. " " tsx7 page_synch$move " " On entry, " x4 -> new CME " x5 -> old CME " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " move: lda page_fault$cme_flags,*x5 ana cme.synch_held,dl tze 0,x7 " not held, nothing to do spriap page_synch_temp orsa page_fault$cme_flags,*x4 " turn on synch_help in new eaq 0,x5 " save this for a minute lxl5 page_fault$cme_synch_page_entryp,*qu sxl5 page_fault$cme_synch_page_entryp,*x4 eppap dm_journal_seg_$ " point to dm_page_entry stx4 ap|dm_page_entry.cme_relp,x5 eax5 0,qu " copy it back tra ret_0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write " " Called when Page Control wants to write a synch page. If the page " must be held, it is threaded to a per-journal list. " " tsx7 page_synch$write " " " " On entry, " x4 -> CME " bp -> PTW " abs_seg1 -> memory frame for page " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write: spriap page_synch_temp " Save register eppap dm_journal_seg_$ aos ap|dm_journal.synch_write_calls " Meter tsx6 page_fault$savex " Recursive use of x7 lda page_fault$cme_flags,*x4 cana cme.synch_held,dl " Page already held? tze write_not_held " No tsx6 thread_out " Yes - thread out of list write_not_held: tsx6 check_page_hold " Should we hold? tra invalid_format " Bogus synch page format tra write_hold " Hold for sure " Maybe not hold, but race exists since page is accessible to other " CPUs. Remove access and check again lca ptw.valid+1,dl ansa bp|0 " Remove access in PTW tsx6 page_fault$check_accessible " Is segment accessible? tsx7 cam_cache$cam_cache " Yes, zap AMs tsx6 check_page_hold " Check again for hold tra invalid_format " Bogus format tra write_hold " Hold tra ret_unsavex_1 " Can write - done restores access write_hold: lda ptw.valid,dl " Restore access orsa bp|0 lda ap|dm_journal.n_held_pages_mem " Check held against threshold cmpa ap|dm_journal.max_held_pages_mem tpl write_over_threshold " Exceeded aos ap|dm_journal.synch_write_holds " Meter tsx6 thread_in " Thread into list per-journal tra ret_unsavex_0 " And return invalid_format: lda ptw.valid,dl " Restore access orsa bp|0 tra ret_unsavex_1 " For now write_over_threshold: aos ap|dm_journal.synch_write_tosses " Meter tra ret_unsavex_1 " And toss by allowing write " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unlink_journal " " Called when a journal time stamp is changed to unlink all CMEs, " causing pages not to be held. Pages which should still be held " will be detected when next we try to write them. " " call page_synch$unlink_journal (Journal_Index) " " Must be called with PTL held " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " unlink_journal: push ldq ap|2,* " Journal index tmoz unlink_returns " Bogus eppap dm_journal_seg_$ cmpq ap|dm_journal.n_journals " Valid index tpnz unlink_returns " No mpy dm_per_journal_size,dl eaq ap|dm_journal.per_journal-dm_per_journal_size,ql " QU -> per journal entry stq page_synch_temp aos ap|dm_journal.unlink_calls " Meter unlink_loop: ldq page_synch_temp " QU -> per journal entry ldx0 ap|dm_per_journal.entry_relp,qu " x0 -> page entry tze unlink_returns " None left aos ap|dm_journal.unlink_steps " Meter ldx4 ap|dm_page_entry.cme_relp,x0 " x4 -> CME tze page_error$dm_journal_seg_problem " Bad news, indeed tsx6 thread_out " Unthread this entry tra unlink_loop unlink_returns: return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Return points - restore registers and return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " ret_0: lprpap page_synch_temp tra 0,x7 ret_1: lprpap page_synch_temp tra 1,x7 ret_2: lprpap page_synch_temp tra 2,x7 ret_unsavex_0: lprpap page_synch_temp tra page_fault$unsavex ret_unsavex_1: lprpap page_synch_temp tra page_fault$unsavex_1 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Internal procedure to check whether a page should be held, and " not written. " " tsx6 check_page_hold " " " " " On entry, " x4 -> CME " abs_seg1 -> main memory for page " " On exit, " ap -> dm_journal_seg_ " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_page_hold: eppap abs_seg1$ " ap -> page ldaq ap|synch_page.version_word tze null_version_word lda ap|synch_page.version_word ana synch_page.version,du cmpa SYNCH_PAGE_VERSION_1,du " Good format for header tnz invalid_version_number " No lda ap|synch_page.journal_index_word arl synch_page.journal_index_shift ana synch_page.journal_index_mask,dl " Pick up journal index tze invalid_journal_index " No good sta page_synch_index " save ldaq ap|synch_page.time_stamp_word anaq synch_page.time_stamp_mask " Get time stamp staq page_synch_time " And save rccl sys_info$clock_,* " Check for reasonable value cmpaq page_synch_time " Can't be later than clock tmi invalid_time_stamp eppap dm_journal_seg_$ ldq page_synch_index cmpq ap|dm_journal.n_journals " Index valid tpnz 0,x6 " No mpy dm_per_journal_size,dl " Convert to offset eax0 ap|dm_journal.per_journal-dm_per_journal_size,ql " x0 -> per_journal entry szn ap|dm_per_journal.uid,x0 " In use? tze 0,x6 " No - bogousity ldaq page_synch_time cmpaq ap|dm_per_journal.time_stamp,x0 " Hold page? tmoz 2,x6 " No tra 1,x6 " Yes null_version_word: eppap dm_journal_seg_$ aos ap|dm_journal.synch_write_no_stamp " Meter tra 0,x6 invalid_version_number: eppap dm_journal_seg_$ aos ap|dm_journal.synch_write_inv_vers " Meter tra 0,x6 invalid_journal_index: eppap dm_journal_seg_$ aos ap|dm_journal.synch_write_inv_ix " Meter tra 0,x6 invalid_time_stamp: eppap dm_journal_seg_$ aos ap|dm_journal.synch_write_inv_time " Meter tra 0,x6 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Internal procedure to thread an entry into a per-journal list " " tsx6 thread_in " " On entry, " ap -> dm_journal_seg_$ " x4 -> CME " x0 -> per_journal entry " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " thread_in: ldx1 ap|dm_journal.free_list_relp " Next free entry tze page_error$no_free_dm_entries " None ldq ap|0,x1 " QU -> next free stq ap|dm_journal.free_list_relp stx4 ap|dm_page_entry.cme_relp,x1 ldx5 ap|dm_per_journal.entry_relp,x0 " Entry in list tnz thread_in_non_empty " List non-empty stx1 ap|dm_per_journal.entry_relp,x0 " Save in list ptr stx1 ap|dm_page_entry.fp,x1 " Entry threads to self sxl1 ap|dm_page_entry.bp,x1 tra thread_in_done thread_in_non_empty: lda ap|dm_page_entry.fp,x5 " x5 -> an entry in the list sxl1 ap|dm_page_entry.bp,x5 " entry -> back to new entry stx5 ap|dm_page_entry.fp,x1 " new entry -> forward to entry stx1 ap|dm_page_entry.fp,al " prev entry -> forward to new entry eax5 0,al sxl5 ap|dm_page_entry.bp,x1 " new entry -> back to prev entry thread_in_done: sxl0 ap|dm_page_entry.journal_relp,x1 " pointer to per_journal sxl1 page_fault$cme_synch_page_entryp,*x4 " CME -> entry lda cme.synch_held,dl orsa page_fault$cme_flags,*x4 " Mark CME as held aos ap|dm_per_journal.n_held,x0 " Bump count of held this journal aos ap|dm_journal.n_held_pages_mem " And total held tra 0,x6 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Internal procedure to thread an entry out of a per-journal list " " tsx6 thread_out " " On entry, " ap -> dm_journal_seg_$ " x4 -> CME " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " thread_out: lda cme.synch_held,dl era minus_one ansa page_fault$cme_flags,*x4 " Mark CME as not-held lxl1 page_fault$cme_synch_page_entryp,*x4 " x1 -> entry tze page_error$dm_journal_seg_problem lda -1,du ansa page_fault$cme_synch_page_entryp,*x4 " Reset CME pointer lxl0 ap|dm_page_entry.journal_relp,x1 " x0 -> per-journal entry lxl5 ap|dm_page_entry.bp,x1 " x5 -> prev entry cmpx1 ap|dm_page_entry.fp,x1 " Thread to self? tnz thread_out_non_empty " No - list won't be empty stz ap|dm_per_journal.entry_relp,x0 " Mark list as empty tra thread_out_done thread_out_non_empty: lda ap|dm_page_entry.fp,x1 " AU -> next entry sxl5 ap|dm_page_entry.bp,au " next -> back to prev eax5 0,au " x5 -> next entry stx5 ap|dm_page_entry.fp,al " prev -> forward to next stx5 ap|dm_per_journal.entry_relp,x0 " In case it pointed to this one thread_out_done: lda ap|dm_journal.free_list_relp " Thread entry into free list sta ap|dm_page_entry.fp,x1 eaa 0,x1 sta ap|dm_journal.free_list_relp lda ap|dm_per_journal.n_held,x0 " Decrement per-journal count sbla 1,dl sta ap|dm_per_journal.n_held,x0 lda ap|dm_journal.n_held_pages_mem " Decrement total count sbla 1,dl sta ap|dm_journal.n_held_pages_mem tra 0,x6 " include cmp " include dm_journal_seg_ " include ptw " include pxss_page_stack " include synch_page end  pc.pl1.pmac 11/11/89 1105.1rew 11/11/89 0804.3 420723 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style2,indcomtxt */ /* use: pl1_macro pc.pl1.pmac -target l68 */ pc: procedure; /* * PC -- the utility procedure of pl1 page control. * * Last modified (date and reason): * * 1985-03-28, BIM: assume that all modified pages of synch segments * are synch held until proven otherwise by page$pwrite. * 841220 by Keith Loepere to count dirs pages against its own quota. * 840623 by Keith Loepere for nullify entry for bce. * 840417 E. A. Ranzenbach to correct page_read zero event problem that caused crashes in the segment mover. * 84-01-19 BIM to remove unworkable synch segmove support. * 84-01-03 BIM to finish segmove. * 831219 by E. N. Kittlitz, for segmove * 09/19/83 by E. N. Kittlitz, per UofC SGH, periodically unlock PTL during long flushes. * 08/22/83 by E. N. Kittlitz, per UofC GM&SGH, don't hedge-write per-process pages. * 10/27/82 by J. Bongiovanni to reset damaged, fm_damaged on truncate * and for synchronized pages * 08/17/82 by J. Bongiovanni for scavenger * 06/09/82 by J. Bongiovanni to fix shutdown quota problem * 03/07/82 by J. Bongiovanni for record stocks * 01/23/82 by BIM for truncate_count * 12/29/81 by C. Hornig to remove Page Multilevel and fix fencepost error in flush. * 08/11/81 by W. Olin Sibert, to fix get_file_map to not report nulled addresses as modified. * This fix actually provided by Steve Harris, University of Calgary * 02/20/81 by W. Olin Sibert, to conditionalize page-multilevel (phase one of ADP conversion) * 11/17/80 by ENK for new dtu/dtm calculation * 11/06/80 by ENK for loop_up_fms honouring of aste.gtms. * 03/16/78 by BSG for phm1, incore null non-reportage. * 08/01/77 by Greenberg for badd_types, pc_recover_sst. * 05/03/77 by BSG for page$pcleanup * 01/27/77 by TVV for non-fatal unprotected addresses * 11/01/76 by D. Vinograd to add entry for volume dumper which returns special null addresses * and does not deposit. * 10/31/76 by BSG for truncate_deposit_all entry * 05/13/76 by BSG for seg-by-seg PD flush. * 04/13/76 by REM for Cleanup Metering * 10/11/75 by BSG for fault_time_withdraws * 03/04/75 by BSG for new storage system (incl. no pdht). * 12/11/74 by BSG for new CME/PTW protocols and new core control. * 06/19/74 by BSG for page$pwait and page$cam. * 08/21/73 by RBS to put in checks for reused addresses. * 08/03/73 by RBS to cause pc$flush to index thru cmes rather than follow threads. * 08/10/73 by SHW to use 18 bit device addresses * 07/15/73 by RBS to cause pages that are in core to be written to disk by pd_flush_all * 10/04/72 by RBS to make page waits go to device control to accomodate bulk store logic * 06/06/72 by RBS to modify for follow-on * 10/26/71 by RHG to fix move_page_table for pages which are in core when moved * 10/07/71 by SHW to add ptwp to pdme (increase entry size to 3 words) * 10/05/71 by RHG to initialize pdmap and to skip the first sst.nrecs_pdmap entries in pd_flush_all * 09/22/71 by RHG to make null devadds include a ptr for page * 09/20/71 by RHG to fix bug in pc$get_file_map which lost all pages of file except first at deactivation * 09/03/71 by Steve Webber to make calls to page$withdraw be fixed bin(4), not bit(4) * 08/10/71 by Richard H. Gumpertz to add code for page multi-level */ dcl Astep ptr parameter; dcl Copy_Astep ptr parameter; dcl File_Mapp ptr parameter; dcl Listp ptr parameter; dcl Pageno_Listp ptr parameter; dcl Deposit_Count fixed bin parameter; dcl First_Page fixed bin parameter; dcl Last_Page fixed bin parameter; dcl N_Pages fixed bin parameter; dcl N_In_Core fixed bin parameter; dcl Records fixed bin parameter; dcl Pvtx fixed bin parameter; dcl Vtocx fixed bin parameter; dcl Move_Astep pointer parameter; dcl Old_Astep ptr parameter; dcl New_Astep ptr parameter; dcl Code fixed bin (35) parameter; dcl New_Vtocx fixed bin (17) parameter; dcl New_Pvtx fixed bin (17); dcl (records, first_page, last_page, i) fixed bin; dcl ind fixed bin (35); dcl temp_ind fixed bin (35); dcl pvtx fixed bin; dcl dumper bit (1); dcl return_pageno bit (1) aligned; dcl add_to_dmpr_map bit (1); dcl (getfmap_csl, getfmap_np, getfmap_nrec) fixed bin (9); dcl offed_sw bit (1); dcl j fixed bin; dcl segmove_records_used fixed bin; dcl (cmp, ptwp) ptr; dcl curtime fixed bin (71); dcl n_in_core fixed bin (18); dcl n_io_started fixed bin; dcl pageno fixed bin; dcl (from_core, count) bit (1); dcl (old_astep, new_astep, old_ptp, new_ptp, move_ptp) ptr; dcl oldmask fixed bin (71); dcl no_deposit_no_return bit (1) aligned; dcl tr_count_sw bit (1) aligned; dcl segmove_records_needed fixed bin; dcl segmove_records_in_hand fixed bin; dcl segmove_total_records fixed bin; dcl code fixed bin (35); dcl new_pvtx fixed bin; dcl new_vtocx fixed bin; dcl move_tries fixed bin; dcl 1 copy_aste like aste aligned; dcl fword (0:99) fixed bin based; dcl Address_Array (0:255) bit (22) aligned based (Listp); dcl (deposit_list, segmove_deposit_list) (0:255) bit (22) aligned; dcl rfm (0:255) bit (22) aligned; dcl 1 Devadd_Array (0:255) aligned based (Listp), 2 record_no bit (18) unaligned, 2 add_type bit (4) unaligned; dcl Pageno_List (0:255) fixed bin aligned based (Pageno_Listp); dcl pageno_list (0:255) fixed bin aligned; dcl devadd bit (22) unaligned; dcl devadd_record_no bit (18) unaligned defined (devadd); dcl devadd_record_no_proper bit (17) defined (devadd) pos (2); dcl devadd_add_type bit (4) unaligned defined (devadd) position (19); dcl devadd_null_flag bit (1) defined (devadd) position (1); dcl 1 devadd_bits unal based (addr (devadd_add_type)) like badd_type; dcl cleanup_start_time fixed bin (71); /* Cleanup Metering */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$synch_seg_segmove fixed bin (35) external static; dcl dbm_man$set_incr entry (fixed bin, fixed bin, fixed bin (35)); dcl ( lock$lock_fast, lock$unlock_fast ) entry (pointer); dcl page$cam ext entry; dcl page$deposit_list entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, ptr); dcl page$pcleanup entry (ptr, fixed bin); dcl page$pread entry (ptr, fixed bin, fixed bin (35)); dcl page$pwait ext entry (fixed bin (35)); dcl page$pwrite ext entry (ptr, fixed bin); dcl page$withdraw_list entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin (35), fixed bin (35)); dcl pmut$lock_ptl ext entry (fixed bin (71), ptr); dcl pmut$unlock_ptl ext entry (fixed bin (71), ptr); dcl pxss$notify ext entry (fixed bin); dcl pxss$relinquish_priority ext entry; dcl quotaw$cu_for_pc entry (ptr, fixed bin, bit (1) aligned); dcl syserr ext entry options (variable); dcl trace ext entry options (variable); dcl null_devadd_not_in_core bit (36) aligned internal static options (constant) init ("000000000001"b3); dcl line_of_words char (23) internal static options (constant) init ("^w ^w ^w ^w ^w ^w ^w ^w"); dcl half_line_of_words char (11) defined (line_of_words); dcl (addr, addrel, addwordno, bit, clock, divide, fixed, max, min, null, ptr, rel, size, unspec, wordno) builtin; %page; cleanup: entry (Astep); /* Entry to get segment out of core. */ /* Caller guarantees no access to segment */ /* Note that synchronized pages which are modified and cannot be written yet are left in memory. If this happens during shutdown, it is fine. Otherwise, the caller must detect this situation and handle it appropriately. It can be detected by checking that aste.np is non-zero. */ sstp = addr (sst_seg$); astep = Astep; cmp = sst.cmp; /* get a pointer to the core map */ cleanup_start_time = clock (); /* Cleanup Metering */ sst.cleanup_count = sst.cleanup_count + 1; /* Cleanup Metering */ call pmut$lock_ptl (oldmask, ptwp); /* mask */ records = 0; if pc_trace then call trace ("cleanup^-^-astep = ^p", astep); loopc: ptp = addrel (astep, sst.astsize); /* get a pointer to the page table */ ind = -1; /* index of page to wait on */ do i = 0 to sst.pts (fixed (aste.ptsi, 2)) - 1; /* loop over all pages in the segment */ if atptw.core then do; /* In core, includes all O/S */ if ^ptw.os then do; /* Not out of service */ if ^(ptw.phm | ptw.phm1) then /* Attempt to clean up the page */ call page$pcleanup (astep, i); /* Do it, cam the cache */ /* He turns off PTW access, SDW'S gone, so no race. */ else call page$pwrite (astep, i); /* Start a write */ end; if ptw.os then ind = fixed (rel (ptp), 18); /* Set wait event */ end; ptp = addrel (ptp, size (ptw)); /* Next ptw, please */ end; if ind > 0 then call wait_then_go_to (loopc); sst.cleanup_real_time = sst.cleanup_real_time /* Cleanup Metering */ + clock () - cleanup_start_time; /* Cleanup Metering */ quit: call pmut$unlock_ptl (oldmask, ptwp); /* unlock and unmask */ return; %page; nullify: entry (Astep); /* Entry to nullify a bce/hardcore segment. Part of disk optimization for bce. */ /* The idea is to mark the pages of the segment unmodified, clean them up (to disk) and then mark the disk addresses as null. This is done just to optimize the later filling in of this segment. We don't guarantee perfection in this, but it doesn't matter. Anyone who calls this ensures that the segment is not in use so we don't expect a problem with pages being referenced between ptl lockings. */ /* First unmodify the pages. Note that os pages are not affected, but these either aren't yet modified (being read) or will become unmodified (after write). */ sstp = addr (sst_seg$); astep = Astep; call pmut$lock_ptl (oldmask, ptwp); /* mask */ ptp = addrel (astep, sst.astsize); /* get a pointer to the page table */ do i = 0 to sst.pts (fixed (aste.ptsi, 2)) - 1; /* loop over all pages in the segment */ if atptw.core then /* In core, includes all O/S */ if ^ptw.os /* Not out of service */ then ptw.phm, ptw.phm1 = "0"b; ptp = addrel (ptp, size (ptw)); /* Next ptw, please */ end; call pmut$unlock_ptl (oldmask, ptwp); /* unlock and unmask */ call cleanup (astep); /* free all memory frame; make into disk addresses */ call pmut$lock_ptl (oldmask, ptwp); /* mask */ ptp = addrel (astep, sst.astsize); /* get a pointer to the page table */ do i = 0 to sst.pts (fixed (aste.ptsi, 2)) - 1; /* loop over all pages in the segment */ if atptw.disk then substr (ptw.add, 1, 1) = "1"b; /* make null */ ptp = addrel (ptp, size (ptw)); /* Next ptw, please */ end; call pmut$unlock_ptl (oldmask, ptwp); /* unlock and unmask */ return; %page; fill_page_table: entry (Astep, File_Mapp, N_Pages); astep = Astep; /* Copy args */ fmp = File_Mapp; pvtx = astep -> aste.pvtx; last_page = N_Pages - 1; /* arg is csl */ sstp = addr (sst_seg$); records = 0; ptp = addrel (astep, sstp -> sst.astsize); do i = 0 to last_page; devadd = file_map.fm (i); /* No need to lock here */ if devadd_null_flag then do; /* Outside world null address, */ devadd_null_flag = "0"b; /* This is not NULLED, but null. */ devadd_add_type = "0000"b; /* Internal null address representation */ end; else do; /* real disk address */ devadd_add_type = add_type.disk; /* Assume protected. */ records = records + 1; end; ptp -> ptwa_bits (i) = devadd | null_devadd_not_in_core; /* save final result in ptw */ end; do i = last_page + 1 to sstp -> sst.pts (fixed (astep -> aste.ptsi, 2)) - 1; /* Fill up rest of page table with nulls */ ptp -> ptwa_bits (i) = null_devadd_not_in_core; ptp -> mptwa (i).devadd = fill_page_table_null_addr; end; aste.records = bit (fixed (records, 9), 9); if pc_trace then do; call trace ("fill_page_table^-astep = ^p", astep); if last_page <= 4 then call trace (half_line_of_words, ptp -> fword (0), ptp -> fword (1), ptp -> fword (2), ptp -> fword (3)); else do; do i = 0 to last_page by 8; call trace (line_of_words, ptp -> fword (i), ptp -> fword (i + 1), ptp -> fword (i + 2), ptp -> fword (i + 3), ptp -> fword (i + 4), ptp -> fword (i + 5), ptp -> fword (i + 6), ptp -> fword (i + 7)); end; end; end; return; %page; truncate: entry (Astep, First_Page); /* entry to truncate a page table */ tr_count_sw = "0"b; go to truncate_join; truncate_count: entry (Astep, First_Page, N_In_Core); tr_count_sw = "1"b; truncate_join: sstp = addr (sst_seg$); /* get a pointer to the sst */ astep = Astep; /* copy args into wired down stack */ ptp = addrel (astep, sstp -> sst.astsize); cmp = sstp -> sst.cmp; /* and core map pointer */ first_page = First_Page; last_page = sstp -> sst.pts (fixed (astep -> aste.ptsi, 3)) - 1; /* get pt end for last page */ records = 0; if pc_trace then call trace ("truncate^-^-astep = ^p", astep); /* the segment has an AST entry -- must clean up page tables and core map */ call pmut$lock_ptl (oldmask, ptwp); /* lock and mask */ if pc_trace then do; if last_page <= 4 then call trace (half_line_of_words, ptp -> fword (0), ptp -> fword (1), ptp -> fword (2), ptp -> fword (3)); else do; do i = 0 to last_page by 8; call trace (line_of_words, ptp -> fword (i), ptp -> fword (i + 1), ptp -> fword (i + 2), ptp -> fword (i + 3), ptp -> fword (i + 4), ptp -> fword (i + 5), ptp -> fword (i + 6), ptp -> fword (i + 7)); end; end; end; n_in_core = 0; retry: ind = 0; do i = first_page to last_page; /* loop through all pages going */ if ptp -> ptwa (i).os then do; /* if out of service, must wait for io */ ind = fixed (rel (addr (ptp -> ptwa (i))), 18); /* get event to wait on */ call wait_then_go_to (retry); /* must go back to top after waiting */ end; count = "0"b; /* Assume no truncation */ /* At this point, page is not o/s. If in core, devadd has core address. */ from_core = atptwa (i).core; /* Remember in_coreness */ devadd = ptp -> mptwa (i).devadd; /* pick up the device address */ /* At this point, devadd has disk or null address, unless in core */ if from_core then do; /* Page is in core */ n_in_core = n_in_core + 1; cmep = addr (cmp -> cma (ptp -> core_ptwa (i).frame)); /* Get pointer to cme */ devadd = cmep -> cme.devadd; /* and get the devadd for cleanup */ if ptp -> ptwa (i).wired then sstp -> sst.wired = sstp -> sst.wired - 1; call page$pcleanup (astep, i); /* Fix up data bases, count quota, csl */ count = "0"b; /* page$cleanup did all work */ end; /* At this point, page is not in core. devadd has disk, null, or nulled */ if devadd_bits.disk then if ^devadd_null_flag /* if nulling ... */ then do; devadd_null_flag = "1"b; /* Null the address */ count = "1"b; end; ptp -> mptwa (i).devadd = devadd; /* Insert right devadd in ptw */ if count then records = records + 1; end; call loop_up_fms; if records ^= 0 then do; astep -> aste.fmchanged = "1"b; /* Make sure we get an update_vtoce */ if ^astep -> aste.nqsw then if astep -> aste.dirsw then call quotaw$cu_for_pc (astep, -records, "1"b); else if astep -> aste.par_astep then call quotaw$cu_for_pc (ptr (astep, astep -> aste.par_astep), -records, "0"b); astep -> aste.records = bit (fixed (fixed (astep -> aste.records, 9) - records, 9), 9); end; /* Now update the current segment length */ do i = min (first_page - 1, last_page) to 0 by -1;/* min traps truncate to addr > aste size */ devadd = ptp -> mptwa (i).devadd; if ptp -> atptwa (i).core then goto update_csl; if devadd_add_type & add_type.non_null then if ^devadd_null_flag then go to update_csl; end; update_csl: astep -> aste.csl = bit (fixed (i + 1, 9), 9); if first_page = 0 then do; astep -> aste.damaged = "0"b; /* empty is undamaged */ astep -> aste.fm_damaged = "0"b; end; call page$cam; /* make sure our work takes */ call pmut$unlock_ptl (oldmask, ptwp); /* unlock and unmask */ if tr_count_sw then N_In_Core = n_in_core; /* return for meter for callers that want. */ return; %page; dumper_get_file_map: entry (Astep, Copy_Astep, File_Mapp, Deposit_Count, Listp, Pageno_Listp); /* dumper entry for VTOCE update */ dumper = "1"b; goto get_file_map_common; get_file_map: entry (Astep, Copy_Astep, File_Mapp, Deposit_Count, Listp, Pageno_Listp); /* entry for VTOC update */ dumper = "0"b; get_file_map_common: astep = Astep; /* Copy astep */ add_to_dmpr_map = "0"b; sstp = addr (sst_seg$); /* get SST base ptr */ fmp = File_Mapp; cmp = sstp -> sst.cmp; /* get core map ptr */ last_page = sstp -> sst.pts (fixed (astep -> aste.ptsi, 2)) - 1; no_deposit_no_return = (Listp = null) | aste.ddnp; getfmap_csl, getfmap_np, getfmap_nrec = 0; /* Init counters */ offed_sw = "0"b; /* Don't need cam */ return_pageno = (Pageno_Listp ^= null ()); call pmut$lock_ptl (oldmask, ptwp); /* Lock the pagetable lock */ sstp = addr (sst_seg$); j = 0; /* Init deposit index */ do i = 0 to last_page; /* Walk the table */ ptp = addrel (astep, sstp -> sst.astsize + i); /* Get one page tbl ptr */ devadd = ptp -> mptw.devadd; /* Get address from ptw */ if devadd_bits.disk then do; /* Disk addr, could be nulled */ if devadd_null_flag & ^no_deposit_no_return then do; /* put in deposit list */ devadd_null_flag = "0"b; /* zero the special internal flag */ deposit_list (j) = devadd; /* set to give to outside world */ if return_pageno then pageno_list (j) = i; j = j + 1; /* one more depositable address processed */ devadd = get_file_map_vt_null_addr; ptp -> mptw.devadd = devadd; /* coded null to file map and page table */ end; else if devadd_null_flag & dumper then devadd = get_file_map_vt_null_addr; end; if devadd_bits.core then do; /* A core address- move on up storage levels */ if ptw.phm then do; /* Must off phm */ ptw.phm1 = "1"b; /* Mark mod status */ ptw.phm = "0"b; /* OFF PHM */ offed_sw = "1"b; end; cmep = addr (cmp -> cma (core_ptw.frame)); devadd = cmep -> cme.devadd; /* Reconsider this devadd */ if devadd_null_flag & ^ptw.phm1 & ^(ptw.os & cme.io) then devadd = get_file_map_vt_null_addr; /* This avoids damage to pure nulls incore */ end; if devadd_null_flag then if dumper then devadd = get_file_map_dumper_non_null_addr; else do; devadd = get_file_map_vt_null_addr; devadd_null_flag = "1"b; end; /* if page is not on disk yet, or trunced, we cannot fault in this page should we crash */ else devadd_null_flag = (devadd_add_type = "0000"b); /* Set outside-world null representation */ if ^devadd_null_flag then do; /* Real page */ getfmap_nrec = getfmap_nrec + 1; getfmap_csl = i + 1; if atptw.core then getfmap_np = getfmap_np + 1; end; rfm (i) = devadd; /* Send out agreed-upon devadd */ end; curtime = clock (); /* loop_up_fms MAY do this, but we must be sure */ if offed_sw then do; call loop_up_fms; /* Pages were noted as modified. */ call page$cam; /* We turned off phm bits. */ end; if aste.fms then add_to_dmpr_map = "1"b; if ^aste.gtus then if aste.np | aste.infp then /* have pages in, or subordinate astes */ aste.dtu = bit (fixed (curtime, 52), 52); /* call it -in use- */ copy_aste = astep -> aste; /* Copy ASTE structure */ /* Update perishable items consistently to caller */ astep -> aste.fms = "0"b; /* copy_aste has old value - this assignment constitutes segment control's recognition of modification */ if ^dumper then do; astep -> aste.fmchanged1 = astep -> aste.fmchanged; /* Dont' lose fmchanged until updatev turns this off, but ... */ astep -> aste.fmchanged = "0"b; /* turn off p_c maintained bit. */ end; call pmut$unlock_ptl (oldmask, ptwp); /* And unlock the pagetables */ /* Use following items to avoid damaging */ /* segments with incore nonmod nulls. */ /* Copy out data to caller */ copy_aste.np = bit (fixed (getfmap_np, 9), 9); copy_aste.records = bit (fixed (getfmap_nrec, 9), 9); copy_aste.csl = bit (fixed (getfmap_csl, 9), 9); unspec (Copy_Astep -> aste) = unspec (copy_aste); /* Copy the s into our callers copy */ do i = 0 to last_page; fmp -> file_map.fm (i) = rfm (i); /* Upper bits into file map */ end; do i = 0 to j - 1; /* copy out depositable addresses */ Address_Array (i) = deposit_list (i); if return_pageno then Pageno_List (i) = pageno_list (i); end; Deposit_Count = j; /* deposit count */ if add_to_dmpr_map & ^aste.nid & ^aste.per_process & ^aste.hc_sdw then call dbm_man$set_incr (fixed (aste.pvtx, 17), fixed (aste.vtocx, 17), (0)); if pc_trace then do; call trace ("get_file_map^-astep = ^p, fmp = ^p", astep, fmp); if last_page <= 4 then call trace (half_line_of_words, ptp -> fword (0), ptp -> fword (1), ptp -> fword (2), ptp -> fword (3)); else do; do i = 0 to last_page by 8; call trace (line_of_words, ptp -> fword (i), ptp -> fword (i + 1), ptp -> fword (i + 2), ptp -> fword (i + 3), ptp -> fword (i + 4), ptp -> fword (i + 5), ptp -> fword (i + 6), ptp -> fword (i + 7)); end; end; end; return; %page; updates: entry (Astep); /* Entry to set file modified switches. */ astep = Astep; /* Copy arg to avoid page fault. */ sstp = addr (sst_seg$); call pmut$lock_ptl (oldmask, ptwp); /* lock and mask */ call loop_up_fms; go to quit; update_incore_fms: entry (Astep); /* used to get fms as accurate as possible */ astep = Astep; sstp = addr (sst_seg$); ptp = addrel (astep, sst.astsize); if aste.np = "000"b3 then return; offed_sw = "0"b; do i = 0 to fixed (aste.csl, 9) - 1; if ptwa (i).phm then do; offed_sw = "1"b; /* remeber to cam */ ptwa (i).phm1 = "1"b; /* Needed for real write */ ptwa (i).phm = "0"b; /* This statement order is critical */ end; end; if offed_sw then do; call loop_up_fms; call page$cam; end; return; loop_up_fms: proc; /* Set fms up tree for hierarchy dumper. */ dcl astep1 pointer; if aste.gtms then return; curtime = clock (); astep1 = astep; do while (rel (astep1)); astep1 -> aste.fms = "1"b; astep1 -> aste.dtm = bit (fixed (curtime, 52), 52); astep1 = ptr (astep1, astep1 -> aste.par_astep); end; end loop_up_fms; /* You do not have to lock the page table or clear the AM for any of this. Phm1 will always be taken as a signal to write, and page$pwrite will turn them both off when camming. Once phm1 is on, failure to set phm, for not camming, is invisible. However, we do cam at the end so that the next call to this will get phms. */ %page; flush: entry; /* here to write out all of core */ /* Synchronized pages are handled as follows: flush_core - Page Control (page$pwrite) does the right thing, based on the time stamp in the page. flush - Modified synchronized pages are abandoned. This is safe, due to Ring-2 Data Management protocols. */ dcl flushing_for_pleasure bit (1); dcl hedonism fixed bin; dcl pleasure_flush_count fixed bin; flushing_for_pleasure = "0"b; go to flush_join; flush_core: entry; /* here to start writes for all core. */ flushing_for_pleasure = "1"b; flush_join: sstp = addr (sst_seg$); /* get pointers, and lock */ pvt_arrayp = addr (pvt$array); cmp = sstp -> sst.cmp; if flushing_for_pleasure then hedonism = divide (sst.write_limit, 2, 17, 0); pleasure_flush_count = 0; call pmut$lock_ptl (oldmask, ptwp); /* lock and mask */ start_flush: do i = sst.first_core_block to sst.last_core_block; /* index thru all cmes */ ind = -1; /* no wait event */ cmep = addr (cmp -> cma (i)); if (cme.ptwp ^= "000000"b3) then do; /* has real page */ ptp = ptr (sstp, cme.ptwp); /* get ptp */ astep = ptr (sstp, cme.astep); /* get astep */ if ^aste.hc_part then do; /* Don't bother with HC part segs */ if ptw.os then ind = fixed (rel (ptp), 18); /* if event, wait on it */ else do; pageno = fixed (rel (ptp), 18) - fixed (rel (astep), 18) - sstp -> sst.astsize; devadd = cme.devadd; if ptw.phm | ptw.phm1 then /* Needs writing */ if drive_ok ((aste.pvtx)) then /* dont io bad disk */ if flushing_for_pleasure then if cme.phm_hedge then do; call page$pwrite (astep, pageno); sst.hedge_writes = sst.hedge_writes + 1; pleasure_flush_count = pleasure_flush_count + 1; end; else cme.phm_hedge = ^aste.per_process; /* change when we prevail across crashes */ /* if significant, write next time, if not written */ else do; /* shutdown */ if aste.synchronized then ptw.phm, ptw.phm1 = "0"b; /* Abandon modified synch pages */ else call page$pwrite (astep, pageno); end; if ^flushing_for_pleasure /* shutdown */ then if ^(ptw.phm | ptw.phm1 | ptw.os) /* Unmodified */ then if devadd_null_flag /* Null address */ then call page$pcleanup (astep, pageno); /* Reflect quota */ if ptp -> ptw.os then /* if still being written, wait for it */ ind = fixed (cmp -> cma (i).ptwp, 18); if sstp -> sst.wtct > sstp -> sst.write_limit then /* if too many queued then */ if (ind > 0) & ^flushing_for_pleasure then call wait_then_go_to (start_flush); /* wait for one */ if pleasure_flush_count >= hedonism then do; /* All done with PTW */ pleasure_flush_count = 0; /* time for a nap */ call pmut$unlock_ptl (oldmask, ptwp); if flushing_for_pleasure then call pxss$relinquish_priority; call pmut$lock_ptl (oldmask, ptwp); end; end; end; end; end; /* end of cme array loop */ if (ind > 0) & ^flushing_for_pleasure then call wait_then_go_to (start_flush); /* Wait if shutdown and there is stuff to wait for */ go to quit; /* done */ %page; list_deposited_add: entry (Astep, First_Page, Last_Page, Records, Listp, Pageno_Listp); /* output deposits to seg ctl */ astep = Astep; /* copy params */ first_page = First_Page; /* place to start */ last_page = Last_Page; /* place to stop */ return_pageno = (Pageno_Listp ^= null ()); sstp = addr (sst_seg$); /* set up sstp */ ptp = addrel (astep, sstp -> sst.astsize); records = 0; /* init count of depositable records */ call pmut$lock_ptl (oldmask, ptwp); /* lock the PTL for real work */ if last_page < 0 /* Scan whole page table */ then last_page = sst.pts (fixed (astep -> aste.ptsi, 2)) - 1; do i = first_page to last_page; /* loop thru all ptws in ptl */ devadd = ptp -> mptwa (i).devadd; /* assume devadd in ptw -- */ /* Any page in core or on the PD which has a nulled address has a right to it: hence, we only list those in the PTW */ if devadd_bits.disk then if devadd_null_flag then do; /* a real deposited address */ deposit_list (records) = devadd; /* move to output array */ if return_pageno then pageno_list (records) = i; records = records + 1; /* bump counter */ ptp -> mptwa (i).devadd, devadd = list_deposit_null_addr; end; end; call pmut$unlock_ptl (oldmask, ptwp); /* unlock the page tables */ do i = 0 to records - 1; Address_Array (i) = deposit_list (i); /* return to argument array */ if return_pageno then Pageno_List (i) = pageno_list (i); end; Records = records; /* return the count */ return; %page; deposit_list: entry (Pvtx, Records, Listp, Vtocx, Pageno_Listp); /* entry to deposit a list of addresses */ records = Records; /* number of records to be deposited */ pvtx = Pvtx; /* phys volume index */ /* The paged fsdct strategy states that the page table lock need not be locked to deposit. Nobody can withdraw our bit unless we have a problem, and if we find an unprotected address at the time we deposit, this will be the case irrespective of the page table lock. */ do i = 0 to records - 1; Devadd_Array (i).add_type = add_type.disk; /* Make up for sins of vtoc_man */ end; call page$deposit_list ((pvtx), Listp, 1, records, Vtocx, Pageno_Listp); return; /* Auxiliary entry for truncation/deposition of vtoceless segs */ truncate_deposit_all: entry (Astep); astep = Astep; /* Copy astep */ if aste.uid then call syserr (1, "pc: truncate_deposit_all call on VTOCed seg at ^p", astep); call truncate (astep, 0); /* Clean up w.r.t. pc */ if aste.hc_sdw then return; /* Don't attempt semi-hc deposit */ call list_deposited_add (astep, 0, -1, records, addr (deposit_list), null ()); call page$deposit_list ((aste.pvtx), addr (deposit_list), 1, records, -1, null ()); return; %page; move_page_table: entry (Old_Astep, New_Astep); sstp = addr (sst_seg$); cmp = sstp -> sst.cmp; old_astep = Old_Astep; new_astep = New_Astep; call pmut$lock_ptl (oldmask, ptwp); /* lock and mask */ if pc_trace then call trace ("move_page_table^-old astep = ^p, new astep = ^p", old_astep, new_astep); old_ptp = addrel (old_astep, sstp -> sst.astsize);/* get pointer to old page table */ new_ptp = addrel (new_astep, sstp -> sst.astsize);/* get pointer to new page table */ do i = 0 to sstp -> sst.pts (fixed (old_astep -> aste.ptsi, 3)) - 1; new_ptp -> ptwa_bits (i) = old_ptp -> ptwa_bits (i); /* copy page table words */ old_ptp -> ptwa_bits (i) = null_devadd_not_in_core; old_ptp -> mptwa (i).devadd = pc_move_page_table_1_null_addr; ptp = addr (new_ptp -> ptwa (i)); /* point to specific ptw */ if atptw.core then do; /* ptw describes core */ cmep = addr (cmp -> cma (core_ptw.frame)); /* address CME */ cme.ptwp = rel (ptp); /* associate CME with new PTW */ cme.astep = rel (new_astep); /* ditto ASTE */ devadd = cme.devadd; /* get devadd from cme if in core */ if cme.notify_requested /* if someone was waiting on old PTW event, then notify .. */ then call pxss$notify (fixed (rel (addr (old_ptp -> ptwa (i))), 18)); /* him, causing him to rewait on new event */ end; else devadd = mptw.devadd; /* get devadd out of ptw if not in core */ end; do i = sstp -> sst.pts (fixed (old_astep -> aste.ptsi, 3)) to sstp -> sst.pts (fixed (new_astep -> aste.ptsi, 3)) - 1; new_ptp -> ptwa_bits (i) = null_devadd_not_in_core; new_ptp -> mptwa (i).devadd = pc_move_page_table_2_null_addr; end; /* Now copy the old ASTE into the new ASTE, except fp, bp, ptsi and marker */ new_astep -> aste_part.two = old_astep -> aste_part.two; go to quit; %page; segmove: entry (Move_Astep, Old_Astep, New_Astep, New_Pvtx, New_Vtocx, Records, Listp, Pageno_Listp, Code); astep = Move_Astep; /* aste under segmove */ old_astep = Old_Astep; /* put old addresses here for pcrsst */ new_astep = New_Astep; /* put new addresses here for pcrsst or caller to deposit */ new_pvtx = New_Pvtx; /* we can reference them without the */ new_vtocx = New_Vtocx; /* AST lock */ sstp = addr (sst_seg$); cmp = sst.cmp; new_ptp = addwordno (new_astep, sst.astsize); /* use that page table to store up addresses on new volume */ old_ptp = addwordno (old_astep, sst.astsize); /* use that page table to remember old addesses for the purposes of pcrsst */ move_ptp = addwordno (astep, sst.astsize); /* this is the page table of affliction. */ if astep -> aste.ptsi ^= new_astep -> aste.ptsi | new_astep -> aste.ptsi ^= old_astep -> aste.ptsi then do; Code = error_table_$bad_arg; return; end; last_page = sst.pts (fixed (astep -> aste.ptsi, 2)) - 1; call lock$lock_fast (addr (sst.segmove_lock)); /* Only one at a time */ sst.segmove_new_addr_astep = new_astep; /* pc_check_tables_ should deposit anything in here or at least bang on the pvte inconsistency count. */ call pmut$lock_ptl (oldmask, ptwp); /* will be unlocked if we have to wait */ /**** Note that deposit_list is declared 0:255 and page$deposit_list expects a 1:256 array. withdraw_list expects 0:255. Shouldn't be any trouble */ segmove_records_in_hand = 0; segmove_total_records, /* This many is the grand total that we have accumulated */ segmove_records_needed /** This many are the number that we need to add to the record pile */ = fixed (astep -> aste.records, 9); /* This is the first guess as to the total number of records needed */ /* However, the guess may be too low since the PTL is unlocked. So */ /* even when we get records_in_hand up and records_needed to 0, we may */ /* have to add to total_records and reset records_needed to get the rest */ move_tries = 0; augment_record_pile: /**** + Debug call syserr (ANNOUNCE, "pc: (at ARP) aste: np = ^d, records = ^d, csl = ^d", fixed (aste.np), fixed (aste.records), fixed (aste.csl)); */ code = 0; do while (segmove_records_needed > 0 & code = 0); /* keep calling until free_store gives all we want */ call page$withdraw_list (new_pvtx, new_ptp, segmove_records_in_hand, segmove_records_needed, ind, code); /* since parm(3) is zero based, zero records_in_hand is interpreted */ /* as "put the next record in slot zero" which deposit addresses as */ /* slot one. */ if ind ^= 0 then /* wait for volmap */ call wait_then_go_to (augment_record_pile); end; if code ^= 0 then do; /* out-of-volume */ Code = code; go to SEGMOVE_ABORT_RETURN; end; /**** At this point, we own all the records we need. We can release the PTL while we drag the segment into memory. */ /**** NOTE -- at this point new_ptp contains segmove_total_records records. segmove_records_needed can be re-used. if we find that we need more records, total_records will grow, but in_hand will continue to be the number of addresses in new_addr_aste. */ move_retry: segmove_records_needed = 0; /* re-count the number we need under the PTL */ /**** + Debug call syserr (ANNOUNCE, "pc: (at MRT) aste: np = ^d, records = ^d, csl = ^d", fixed (aste.np), fixed (aste.records), fixed (aste.csl)); */ move_tries = move_tries + 1; if move_tries > 1000 then go to SEGMOVE_ABORT_RETURN; n_io_started = 0; SEGMOVE_EXAMINE_PAGES: do i = 0 to last_page; /* get all pages into memory */ RE_EXAMINE_PAGE: if move_ptp -> ptwa (i).os then do; /* wait for i and also o (quiesce) */ ind = wordno (addr (move_ptp -> ptwa (i))); /* event to wait on */ n_io_started = n_io_started + 1; if n_io_started > sst.segmove_io_limit then call wait_then_go_to (move_retry); end; else if move_ptp -> atptwa (i).disk then do; sst.segmove_n_reads = sst.segmove_n_reads + 1; call page$pread (astep, i, temp_ind); /* put event into temporary... */ if temp_ind ^= 0 then do; ind = temp_ind; /* OK to mung it now... */ n_io_started = n_io_started + 1; if n_io_started > sst.segmove_io_limit then call wait_then_go_to (move_retry); end; else go to RE_EXAMINE_PAGE; /* ZERO! */ end; else if move_ptp -> atptwa (i).core then do; /* in memory - keep it there */ segmove_records_needed = segmove_records_needed + 1; /* got another real one in memory */ cmep = addr (cmp -> cma (move_ptp -> core_ptwa (i).frame)); cme.pin_counter = 1000; if astep -> aste.synchronized & (move_ptp -> core_ptwa (i).phm | move_ptp -> core_ptwa (i).phm1) /* any modified page of a synch segment is held until proven elsewise */ then call segmove_synch_page (astep, cmep, i); end; else if move_ptp -> ptwa (i).add_type ^= "0000"b /* mysterious non-null */ then /* but unknown! */ call syserr (CRASH, "pc$segmove: unexpected address type ^4b", move_ptp -> ptwa (i).add_type); end SEGMOVE_EXAMINE_PAGES; /**** At arrival here, the PTL is locked (nothing can be evicted) and either all the pages are in memory, or we have some read-ahead activity. */ if n_io_started > 0 then call wait_then_go_to (move_retry); /* ind is last read ahead page */ sst.segmove_max_tries = max (move_tries, sst.segmove_max_tries); /**** No read aheads. all pages found in core, PTL is locked. Start final countdown. Unless, somehow, the segment grew ... */ if segmove_records_needed > segmove_total_records then do; /* When we counted under the PTL and made them stand still, we found more of them. */ segmove_total_records = segmove_records_needed; /* new count is the right count */ segmove_records_needed = segmove_records_needed - segmove_records_in_hand; /* count of additional records required */ go to augment_record_pile; /* get 'em */ end; /**** We have an adequate supply of records on the new volume, and everything is in memory. Here we go... */ /**** Since the move segment page table is in its final state (all addresses null or in core) we can copy all the ptw's to the old_addr_aste. pcrsst will find them there and put them back. All the new addreses have been accumulated in the new_addr_aste, where shutdown can deposit them. Thus the rules are: if new_addr_astep ^= null (), deposit all the non-null addresses in its page table. pc_check_tables_ does not currently concern itself with deposits, so these addresses are abandoned. if the move_astep ^= null (), then copy the page table from the old_addr_aste to the move_aste. The old_addr_astep is guaranteed to be non-null. if the old_addr_astep ^= null(), then zap all its ptw's to be null addresses. */ sst.segmove_old_addr_astep = old_astep; /* still full of nulls */ /* now, pcrsst will zero all these ptw's */ begin; /* copy the page table wholesale from move to old astep */ declare pt (0:last_page) bit (36) aligned based; old_ptp -> pt = move_ptp -> pt; end; /* this can be copied back verbatim by pc_check_tables_ since we are under the PTL and nothing can change. */ sst.segmove_pvtx = astep -> aste.pvtx; sst.segmove_vtocx = astep -> aste.vtocx; sst.segmove_astep = astep; /* now, pcrsst will copy all the devadds from old to here */ /**** Now it only takes one loop to put the new disk devadds into the move aste. */ segmove_records_used = 0; if segmove_total_records < fixed (aste.np) then call syserr (CRASH, "pc$segmove: miscounted pages."); do i = 0 to last_page; /* now swap addresses */ devadd = move_ptp -> mptwa (i).devadd; /* either core or null */ /**** + Debug call syserr (ANNOUNCE, "sgm: page ^d ptw devadd ^.3b", i, devadd); */ if (devadd_add_type & add_type.core) ^= ""b /* core */ then do; if segmove_records_used > segmove_records_in_hand then call syserr (CRASH, "pc$segmove: out of records during move"); cmep = addr (cmp -> cma (move_ptp -> core_ptwa (i).frame)); move_ptp -> core_ptwa (i).phm1 = "1"b; /* modify! */ /* it will get hierarchy incrementalled, which is unfortunate */ segmove_deposit_list (segmove_records_used) = cme.devadd; /**** + Debug call syserr (ANNOUNCE, "sgm: old cme devadd ^.3b", cme.devadd); */ pageno_list (segmove_records_used) = i; devadd = new_ptp -> mptwa (segmove_records_used).devadd; /* new record address + disk flag */ /**** + Debug call syserr (ANNOUNCE, "sgm: new devadd ^.3b", devadd); */ new_ptp -> mptwa (segmove_records_used).devadd = segmove_new_addr_null_addr; /* order here is noncritical, pc check tables will zonk all of these anyway */ devadd_null_flag = "1"b; /* you're not on disk yet, buddy! */ cme.devadd = devadd; cme.phm_hedge = "1"b; /**** + Debug call syserr (ANNOUNCE, "sgm: new devadd in CME ^.3b", devadd); */ cme.pin_counter = 0; /* don't hold page any longer */ segmove_records_used = segmove_records_used + 1; end; end; if sst.crash_test_segmove then call syserr (CRASH, "pc$segmove: crashing in segment mover."); astep -> aste.pvtx = new_pvtx; /* finish the swap */ astep -> aste.vtocx = new_vtocx; /* ... */ astep -> aste.fmchanged = "1"b; /* ... */ sst.segmove_astep = null; /* dont fix addresses, pvtx, or vtocx. and dont copy page table from old_addr_aste */ sst.segmove_pvtx = 0; sst.segmove_vtocx = 0; /**** Now cleanup the old addresses, unbinding them from PTW's etc. */ begin; declare pt (0:last_page) bit (36) based; declare px fixed bin; declare 1 nptw aligned like l68_ptw; declare ptwp pointer; unspec (nptw) = ""b; nptw.add = segmove_old_addr_null_addr; /* thats whats left */ do px = 0 to last_page; ptwp = addr (old_ptp -> pt (px)); /* all are core addresses, we are under PTL after verifying that */ devadd = ptwp -> mptw.devadd; if (devadd_add_type & add_type.non_null) ^= ""b then do; if (devadd_add_type & add_type.core) = ""b then call syserr (CRASH, "pc$segmove: non-memory PTW in old_addr_aste."); old_ptp -> pt (px) = unspec (nptw); end; end; end; sst.segmove_old_addr_astep = null (); call pmut$unlock_ptl (oldmask, ptwp); if segmove_records_in_hand > segmove_records_used then /* some records on new pvt left over */ call page$deposit_list (new_pvtx, new_ptp, segmove_records_used + 1, segmove_records_in_hand - segmove_records_used, -1, null ()); call lock$unlock_fast (addr (sst.segmove_lock)); Address_Array = segmove_deposit_list; /* out from under PTL */ Pageno_List = pageno_list; /* so we can copy to unwired stack_0 */ Records = segmove_records_used; /* starts at zero, used as index to zero-based array, then bumped. */ return; SEGMOVE_ABORT_RETURN: call pmut$unlock_ptl (oldmask, ptwp); if segmove_records_in_hand > 0 then call page$deposit_list (new_pvtx, new_ptp, 1, segmove_records_in_hand, -1, null ()); /* Abandon all the records that we collected */ if Code = 0 then /** we may have a specific code */ Code = error_table_$action_not_performed; call lock$unlock_fast (addr (sst.segmove_lock)); return; segmove_synch_page: procedure (astep, cmep, pagex); declare (astep, cmep) pointer; declare pagex fixed bin; /**** Call page control to write the page itself. If the synch_hold is legit, then .synch_hold will still be on when pwrite returns. If .synch_hold is off, the page is no longer held. */ call page$pwrite (astep, pagex); if ^cmep -> cme.synch_held then do; sst.segmove_synch_disappeared = sst.segmove_synch_disappeared + 1; return; /* page is fine, we can move it */ end; Code = error_table_$synch_seg_segmove; go to SEGMOVE_ABORT_RETURN; end segmove_synch_page; %page; drive_ok: proc (pvtx) returns (bit (1) aligned); /* test drive state */ dcl pvtx fixed bin; return (^pvt_array (pvtx).device_inoperative); end drive_ok; %page; wait_then_go_to: procedure (lab); /* quick internal proc to trace and wait for page control events */ dcl lab label local; if ind = 0 then call syserr (CRASH, "pc: waiting for zero event."); if pc_trace then call trace ("wait for i/o"); call page$cam; /* make sure any work done so far gets done */ call page$pwait (ind); /* wait for event */ go to lab; end wait_then_go_to; /* format: off */ %page; %include sst; %page; %include pvte; %page; %include cmp; %page; %include aste; %page; %include fm; %page; %include null_addresses; %page; %include add_type; %page; %INCLUDE "ptw.macro"; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: pc: unprotected address DDDDD in DSKX_NN VTOCX S: $info T: $run M: The disk address DDDDD is not marked as protected in the record usage map for the volume mounted on DSKX_NN. This condition has been discovered while activating the segment with VTOC index VTOCX. The segment's damaged switch is turned on, and a page of zeros will replace the bad address. This condition may be symptomatic of disk or other hardware failure. A: $inform Message: pc: truncate_deposit_all call on VTOCed seg at ASTEP S: $crash T: $run M: A call to pc$truncate_deposit_all has been made on a segment for which this operation is not allowed. The AST entry at ASTEP should have a zero unique ID but it does not. $err $crashes A: $recover END MESSAGE DOCUMENTATION */ end pc;  pc_abs.pl1.pmac 11/11/89 1105.1rew 11/11/89 0804.3 97794 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ /* use: pl1_macro pc_abs.pl1.pmac -target l68 */ pc_abs: procedure; /* This procedure is responsible for adding and removing blocks of memory and for abs-wiring memory for I/O segments. The original pc_abs was written by Roger R. Schell in September 1970. Rewritten 6/3/74 by Bernard S. Greenberg for evict_page and page$pwait. Abs-wire functions removed 6/3/74 by B. Greenberg for I/O Buffer manager. Totally rewritten for new cme protocols, no remove list, and 75% code reduction, 03/12/75, BSG. Modified to allow evict_page to delete, for automatic parity deletion, BSG, 05/11/78. Modified to handle case when pages to be deleted are already gone, Chris Jones, 8/84 Modified 1984-10-26 BIM to pay attention to the first argument to wire/unwire. Modified 1984-12-07, Keith Loepere, to not avoid abs wiring in low 256K. */ /****^ HISTORY COMMENTS: 1) change(86-10-07,Farley), approve(86-11-20,MECR0002), audit(86-11-19,Fawcett), install(86-11-20,MR12.0-1222): Added three checks to the unwire_abs entry. First verify that the Astep parameter is non-null. Second verify that the page table word does really define a wired/in-core page. Third verify that the CME is really abs wired. Crash if any of these are incorrect. 2) change(86-12-19,Farley), approve(86-12-19,MCR7587), audit(86-12-19,Fawcett), install(87-01-05,MR12.0-1253): Formal installation to close out above MECR0002. END HISTORY COMMENTS */ dcl Code fixed bin (35) parameter; dcl Absaddr fixed bin (26) parameter; dcl Fpage fixed bin (9) parameter; /* zero based */ dcl Npages fixed bin (9) parameter; dcl Fframe fixed bin (16) parameter; dcl Nframes fixed bin (16) parameter; dcl Modulus fixed bin (16) parameter; dcl Astep pointer parameter; dcl astep ptr; dcl (ind, aind) fixed bin (35); dcl (fframe, nframes, frame, modulus) fixed bin (16); dcl (fp, np, page) fixed bin (9); dcl frames (0:255) fixed bin (16); dcl oldmask fixed bin (71) aligned; dcl sptp ptr; dcl based_word fixed bin (35) aligned based; dcl page$evict entry (ptr, fixed bin (35)); dcl page$pwait entry (fixed bin (35)); dcl page$wire_abs entry (ptr, fixed bin (35), ptr, fixed bin (9)); dcl pmut$lock_ptl entry (fixed bin (71) aligned, ptr); dcl pmut$unlock_ptl entry (fixed bin (71) aligned, ptr); dcl syserr entry options (variable); dcl ALL_ONES fixed bin (35) static options (constant) init (-1); dcl CORE bit (4) static options (constant) init ("8"b4); dcl error_table_$out_of_main_memory fixed bin (35) external static; dcl sst$abs_wired_count fixed bin (35) external; dcl sst$astsize fixed bin (17) external; dcl sst$cmp ptr external; dcl sst$first_core_block fixed bin (16) external; dcl sst$last_core_block fixed bin (16) external; dcl sst$nused fixed bin (35) external; dcl sst$usedp bit (18) aligned external; dcl sst$wusedp bit (18) aligned external; dcl sst$wired fixed bin (35) external; dcl sys_info$page_size fixed bin (17) external static; dcl (addr, addrel, binary, max, mod, null, ptr, rel, wordno) builtin; remove_core: entry (Fframe, Nframes, Code); Code = 0; fframe = Fframe; nframes = Nframes; call lock; /* wire and lock */ do frame = 1 to nframes; /* make sure it is not in use */ if sst$cmp -> cma (fframe + frame - 1).abs_w then do; call unlock; Code = 2; /* return error code */ return; end; end; call remove_frames; /* get rid of them */ call unlock; return; %skip (3); remove_core_mod: entry (Nframes, Modulus, Absaddr, Code); nframes = Nframes; modulus = Modulus; Absaddr = -1; Code = 0; call lock; call find_frames; call remove_frames; call unlock; Absaddr = fframe * sys_info$page_size; return; wire_abs_contig: entry (Astep, Fpage, Npages, Code); astep = Astep; /* Copy args before locking page table lock */ fp = Fpage; np, nframes = Npages; Code = 0; call lock; modulus = 1; retry_contig: call find_frames; if fframe >= 256 then goto noalloc; /* must keep I/O buffers low */ /* see iom_connect.alm for details. */ do frame = 0 to nframes - 1; frames (frame) = fframe + frame; end; if ^abs_wire_frames () then goto retry_contig; call unlock; return; wire_abs: entry (Astep, Fpage, Npages, Code); astep = Astep; fp = Fpage; np, nframes = Npages; Code = 0; call lock; retry: page = 0; do fframe = max (sst$first_core_block, 256) to sst$last_core_block while (page < np); /* save low 256K for wire_abs_contig */ cmep = addr (sst$cmp -> cma (fframe)); if (cmep -> based_word ^= ALL_ONES) & ^cme.abs_w & ^cme.removing & cme.abs_usable & ((cme.fp ^= ""b) | (cme.ptwp ^= ""b)) then do; frames (page) = fframe; page = page + 1; end; end; if page < np then do; noalloc: call unlock; Code = error_table_$out_of_main_memory; return; end; if ^abs_wire_frames () then goto retry; call unlock; return; unwire_abs: entry (Astep, Fpage, Npages); astep = Astep; fp = Fpage; np = Npages; if astep = null () then do; call syserr (CRASH, "pc_abs$unwire_abs: Called with NULL astep."); return; end; do page = fp to fp + np - 1; /* unwire the pages */ ptp = addrel (astep, sst$astsize + page); if (ptw.add_type = CORE) & ptw.wired then do;/* valid PTW */ frame = core_ptw.frame; /* find the core frame */ cmep = addr (sst$cmp -> cma (frame)); if ^cme.abs_w then call syserr (CRASH, "pc_abs$unwire_abs: Attempt to unwire inconsistent CME at ^p.", cmep); /* reset wired & abs_w here */ ptw.phm = "1"b; /* in case the IOM modified it */ ptw.wired = "0"b; /* not wired any more */ cme.abs_w = "0"b; sst$wired = sst$wired - 1; sst$abs_wired_count = sst$abs_wired_count - 1; end; else call syserr (CRASH, "pc_abs$unwire_abs: Attempt to unwire inconsistent PTW at ^p.", ptp); end; return; find_frames: procedure; dcl j fixed bin (16); do fframe = sst$first_core_block + mod (-sst$first_core_block, modulus) by modulus to sst$last_core_block; /* find a possible first page */ j = 0; if mod (fframe + nframes - 1, 256) < (nframes - 1) then goto will_not_do; /* and we won't cross 256K boundary */ do j = 0 to nframes - 1; /* check each page */ cmep = addr (sst$cmp -> cma (fframe + j)); /* get ptr to cme */ if (cmep -> based_word = ALL_ONES) | cme.abs_w | cme.removing | (^cme.abs_usable) | ((cme.fp = ""b) & (cme.ptwp = ""b)) then go to will_not_do; /* OS are just fine, as long as... */ end; return; will_not_do: fframe = fframe + j - mod (j, modulus); end; goto noalloc; end find_frames; remove_frames: procedure; do frame = 1 to nframes; /* mark all frames */ sst$cmp -> cma (fframe + frame - 1).removing = "1"b; end; ind = -1; /* do at least one pass */ do while (ind ^= 0); /* loop until it's done */ ind = 0; do frame = 1 to nframes; /* for each frame to be evicted */ cmep = addr (sst$cmp -> cma (fframe + frame - 1)); /* find CME */ if cmep -> based_word ^= ALL_ONES then do; /* it has not yet been deleted */ call page$evict (cmep, aind); /* start it out */ if (cmep -> based_word ^= ALL_ONES) & (aind = 0) then do; ptr (cmep, cme.fp) -> cme.bp = cme.bp; /* unthread it */ ptr (cmep, cme.bp) -> cme.fp = cme.fp; if sst$usedp = rel (cmep) then sst$usedp = cme.fp; if sst$wusedp = rel (cmep) then sst$wusedp = cme.fp; cmep -> based_word = ALL_ONES;/* mark it gone */ cme.abs_usable, cme.removing = "0"b; sst$nused = sst$nused - 1; end; else if ind = 0 then ind = aind; /* multiplex waits */ end; end; if ind ^= 0 then call page$pwait (ind); end; if (fframe + nframes) > sst$last_core_block then sst$last_core_block = fframe - 1; return; end remove_frames; abs_wire_frames: procedure returns (bit (1) aligned); /**** In this procedure, "page" is the index (from zero) into the array of abs_usuable pages found in the core map, and fp + page is the index into the segment's page table. */ do frame = 1 to nframes; /* mark them used */ sst$cmp -> cma (frames (frame - 1)).abs_w = "1"b; end; ind = -1; do while (ind ^= 0); ind, aind = 0; do page = 0 to np - 1; cmep = addr (sst$cmp -> cma (frames (page))); if (wordno (astep) + sst$astsize + fp + page) ^= binary (cme.ptwp, 18) then call page$evict (cmep, aind); if cmep -> based_word = ALL_ONES then do; call syserr (CRASH, "pc_abs: Parity error in I/O buffer."); return ("0"b); end; if aind = 0 then call page$wire_abs (cmep, aind, astep, fp + page); if ind = 0 then ind = aind; end; if ind ^= 0 then call page$pwait (ind); end; sst$abs_wired_count = sst$abs_wired_count + nframes; return ("1"b); end abs_wire_frames; lock: procedure; call pmut$lock_ptl (oldmask, sptp); /* lock the ptl */ return; end lock; unlock: procedure; call pmut$unlock_ptl (oldmask, sptp); /* almost done */ return; end unlock; %include syserr_constants; %page; %include cmp; %INCLUDE "ptw.macro"; /* BEGIN MESSAGE DOCUMENTATION Message: pc_abs: Parity error in I/O buffer. S: $crash T: $run M: $err A: $recover Message: pc_abs$unwire_abs: Called with NULL astep. S: $crash T: $run M: $err A: $inform $recover Message: pc_abs$unwire_abs: Attempt to unwire inconsistent CME at CMEP. S: $crash T: $run M: The core map entry for the page being abs unwired did not have the abs_w flag on, which indicates that it was properly abs wired. $err A: $inform $recover Message: pc_abs$unwire_abs: Attempt to unwire inconsistent PTW at PTP. S: $crash T: $run M: A page at PTP, within the range of pages being unwired for, was found to either not be wired or no longer in memory. $err A: $inform $recover END MESSAGE DOCUMENTATION */ end pc_abs;  pc_deposit.pl1 11/11/89 1105.1r w 11/11/89 0804.3 137385 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style3 */ pc_deposit: proc (Pvtx, Devadd, Vtocx, Pageno); /* Routine to deposit an address or a list of addresses to the Volume Map. It is called from ALM Page Control when the address or addresses cannot be deposited into the record stock. This can happen only if the record stock is full. Asynchronous record stock management will deposit excess addresses to the Volume Map as we update each Volume Map page. This routine is also called during a volume scavenge, when addresses are to be deposited to the volume being scavenged. Asynchronous scavenger action is done here (that is, the scavenger data block for this volume is updated - addresses being deposited are checked for conflicts and their states are updated). Written March 1982 by J. Bongiovanni Modified July 1982 by J. Bongiovanni for the scavenger */ /****^ HISTORY COMMENTS: 1) change(86-06-10,Hartogs), approve(86-06-10,MCR7383), audit(86-06-11,Coppola), install(86-07-17,MR12.0-1097): Calls to syserr modified to report on subvolumes. END HISTORY COMMENTS */ /* Parameter */ dcl Pvtx fixed bin parameter; /* PVTE index */ dcl Devadd bit (36) aligned parameter; /* Single address to deposit */ dcl Vtocx fixed bin; /* VTOCE index (used by scavenger) */ dcl Pageno fixed bin; /* Page number within segment (used by scavenger) */ dcl List_ptr ptr parameter; /* Pointer to list of addresses */ dcl First fixed bin; /* First element to deposit in array */ dcl Last fixed bin; /* Last element to deposit in array */ dcl Pageno_list_ptr ptr; /* Pointer to list of page numbers */ /* Automatic */ dcl check_scavenger bit (1) aligned; dcl conflict bit (1) aligned; dcl grabbed_vpage fixed bin; dcl listx fixed bin; dcl listx1 fixed bin; dcl p99 pic "99"; dcl pageno fixed bin; dcl pages fixed bin; dcl pf_begin fixed bin (35); dcl pf_end fixed bin (35); dcl Single_addressp ptr; dcl this_vpage fixed bin; dcl vcpu_begin fixed bin (71); dcl vcpu_end fixed bin (71); dcl volmap_locked bit (1); dcl vpage_found bit (1); dcl vpage_list (256) fixed bin; dcl vpage_no fixed bin; dcl vpage_ptr ptr; dcl vtoc_index fixed bin; /* Static */ dcl NULL_SDW fixed bin (71) int static options (constant) init (0); dcl RECORDS_PER_WORD fixed bin int static options (constant) init (32); /* Based */ dcl 1 List (Last) aligned like Single_address based (List_ptr); dcl Pageno_list (Last) fixed bin based (Pageno_list_ptr); dcl 1 Single_address aligned based (Single_addressp), 2 Null_flag bit (1) unaligned, 2 Address fixed bin (17) unsigned unaligned, 2 Pad bit (18) unaligned; /* External */ dcl volmap_abs_seg$ external; /* Entry */ dcl page$grab_volmap_page_unwired entry (ptr, fixed bin, ptr); dcl page$lock_volmap entry (ptr); dcl page$unlock_volmap entry (ptr); dcl page$write_volmap_page_unwired entry (ptr, fixed bin); dcl pmut$swap_sdw entry (ptr, ptr); dcl syserr entry options (variable); dcl usage_values entry (fixed bin (35), fixed bin (71)); /* Condition */ dcl cleanup condition; dcl page_fault_error condition; /* Builtin */ dcl addr builtin; dcl convert builtin; dcl divide builtin; dcl mod builtin; dcl null builtin; dcl ptr builtin; dcl stacq builtin; dcl unspec builtin; %page; /* Deposit a single record address into the Volume Map */ call usage_values (pf_begin, vcpu_begin); pages = 1; pvtep = addr (addr (pvt$array) -> pvt_array (Pvtx)); record_stockp = pvte.volmap_stock_ptr; Single_addressp = addr (Devadd); volmap_locked = "0"b; grabbed_vpage = -1; call CHECK_FOR_SCAVENGE; vtoc_index = Vtocx; pageno = Pageno; call FIND_VOLMAP_PAGE (Single_addressp, vpage_no, pageno, conflict); if conflict then goto RETURN; on cleanup call UNLOCK_RESET; call LOCK_SETUP; on page_fault_error begin; call IO_ERROR; goto RETURN; end; call page$grab_volmap_page_unwired (pvtep, vpage_no - 1, vpage_ptr); grabbed_vpage = vpage_no - 1; call DEPOSIT_TO_PAGE ((Single_address.Address), vpage_no, vpage_ptr); call page$write_volmap_page_unwired (pvtep, vpage_no - 1); grabbed_vpage = -1; RETURN: revert page_fault_error; call UNLOCK_RESET; call METER; return; %page; /* Deposit a list of addresses into the Volume Map. Go through the list some number of times. For each candidate found, compute the Volume Map page number, grab the page, and deposit all addresses in the list which belong to that page. */ pc_deposit$deposit_list: entry (Pvtx, List_ptr, First, Last, Vtocx, Pageno_list_ptr); call usage_values (pf_begin, vcpu_begin); pages = Last - First + 1; pvtep = addr (addr (pvt$array) -> pvt_array (Pvtx)); record_stockp = pvte.volmap_stock_ptr; volmap_locked = "0"b; grabbed_vpage = -1; call CHECK_FOR_SCAVENGE; vtoc_index = Vtocx; do listx = First to Last; if Pageno_list_ptr = null () then pageno = -1; else pageno = Pageno_list (listx); call FIND_VOLMAP_PAGE (addr (List (listx)), vpage_list (listx), pageno, conflict); if conflict then vpage_list (listx) = -1; end; on cleanup call UNLOCK_RESET; call LOCK_SETUP; on page_fault_error begin; dcl pagex fixed bin; if grabbed_vpage >= 0 then do; do pagex = First to Last; if vpage_list (pagex) = grabbed_vpage + 1 then vpage_list (pagex) = -1; end; call IO_ERROR; end; goto VPAGE_RETRY; end; VPAGE_RETRY: vpage_found = "0"b; do listx = First to Last; if vpage_list (listx) > 0 then do; vpage_found = "1"b; this_vpage = vpage_list (listx); call page$grab_volmap_page_unwired (pvtep, this_vpage - 1, vpage_ptr); grabbed_vpage = this_vpage - 1; do listx1 = listx to Last; if vpage_list (listx1) = this_vpage then do; call DEPOSIT_TO_PAGE ((List (listx1).Address), this_vpage, vpage_ptr); vpage_list (listx1) = -1; end; end; call page$write_volmap_page_unwired (pvtep, grabbed_vpage); grabbed_vpage = -1; end; end; if vpage_found then goto VPAGE_RETRY; revert page_fault_error; call UNLOCK_RESET; call METER; return; %page; /* Internal Procedure to find the Volume Map page associated with a given address */ FIND_VOLMAP_PAGE: proc (Devaddp, Volmap_pageno, Page_no, Conflict); dcl Devaddp ptr parameter; dcl Volmap_pageno fixed bin parameter; dcl Page_no fixed bin parameter; dcl Conflict bit (1) aligned parameter; dcl vpagex fixed bin; dcl vpage_found bit (1); dcl address fixed bin; dcl 1 Devaddr aligned like Single_address based (Devaddp); vpage_found = "0"b; address = Devaddr.Address; Conflict = "0"b; if address < pvte.baseadd | address >= pvte.baseadd + pvte.totrec then call syserr (CRASH, "pc_deposit: Address ^o out of paging region on ^a_^a^[^a^;^s^].", address, pvte.devname, convert (p99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name); do vpagex = record_stock.n_volmap_pages to 1 by -1 while (^vpage_found); if address >= record_stock.volmap_page (vpagex).baseadd then do; vpage_found = "1"b; Volmap_pageno = vpagex; end; end; if ^vpage_found then call syserr (CRASH, "pc_deposit: Invalid address ^o on ^a_^a^[^a^;^s^].", address, pvte.devname, convert (p99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name); if check_scavenger then Conflict = CHECK_ADDRESS_FOR_SCAVENGER (address, Page_no); return; end FIND_VOLMAP_PAGE; %page; /* Internal Procedure to deposit a single record address to the Volume Map */ DEPOSIT_TO_PAGE: proc (Record_address, Vpage_no, Vpage_ptr); dcl Record_address fixed bin; dcl Vpage_no fixed bin; dcl Vpage_ptr ptr; dcl bit_no fixed bin; dcl word_no fixed bin; dcl 1 Vm_page aligned based (Vpage_ptr), 2 Word (0:1023) aligned, 3 Pad1 bit (1) unaligned, 3 Bit (0:31) bit (1) unaligned, 3 Pad2 bit (3) unaligned; word_no = divide (Record_address - record_stock.volmap_page (Vpage_no).baseadd, RECORDS_PER_WORD, 17); if word_no < 0 | word_no > 1023 | (Vpage_no = 1 & word_no < 64) then call syserr (CRASH, "pc_deposit: Invalid address ^o on ^a_^a^[^a^;^s^].", Record_address, pvte.devname, convert (p99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name); bit_no = mod (Record_address - record_stock.volmap_page (Vpage_no).baseadd, RECORDS_PER_WORD); if Vm_page.Word (word_no).Bit (bit_no) then do; call syserr (ANNOUNCE, "pc_deposit: Deposit in-use address ^o on ^a_^a^[^a^;^s^].", Record_address, pvte.devname, convert (p99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name); pvte.vol_trouble_count = pvte.vol_trouble_count + 1; /* Add to inconsistency count */ end; else do; Vm_page.Word (word_no).Bit (bit_no) = "1"b; pvte.nleft = pvte.nleft + 1; record_stock.volmap_page (Vpage_no).n_free = record_stock.volmap_page (Vpage_no).n_free + 1; end; return; end DEPOSIT_TO_PAGE; %page; /* Internal Procedure to handle I/O Error on the Volume Map */ IO_ERROR: proc; pvte.vol_trouble_count = pvte.vol_trouble_count + 1; if grabbed_vpage >= 0 then if record_stock.volmap_page (grabbed_vpage + 1).n_free > 0 then do; record_stock.volmap_page (grabbed_vpage + 1).n_free = 0; call syserr (BEEP, "pc_deposit: Unrecoverable I/O error on Volmap page ^d of ^a_^a^[^a^;^s^]. Addresses lost.", grabbed_vpage, pvte.devname, convert (p99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name); end; end IO_ERROR; %page; /* Internal procedure to see whether there's a scavenge goin' on for this physical volume and set a flag accordingly. */ CHECK_FOR_SCAVENGE: proc; check_scavenger = "0"b; scavenger_blockp = null (); scavenger_datap = addr (scavenger_data$); if pvte.scavenger_block_rel ^= ""b then if pvte.scav_check_address then do; check_scavenger = "1"b; scavenger_blockp = ptr (scavenger_datap, pvte.scavenger_block_rel); end; end CHECK_FOR_SCAVENGE; %page; /* Internal Procedure to check an address against the scavenger block for this physical volume. The state is updated and conflicts marked appropriately. Indication of conflict is returned to the caller, so that the address is not deposited. */ CHECK_ADDRESS_FOR_SCAVENGER: proc (Record_address, Page_no) returns (bit (1) aligned); dcl Record_address fixed bin parameter; dcl Page_no fixed bin parameter; dcl 1 A_record_block aligned like record_block; dcl Ap ptr; dcl conflict bit (1) aligned; dcl locked bit (1) aligned; dcl 1 Q_record_block aligned like record_block; dcl Qp ptr; dcl Wp ptr; dcl A bit (36) aligned based (Ap); dcl Q bit (36) aligned based (Qp); dcl W bit (36) aligned based (Wp); record_blockp = addr (scavenger_block.records (Record_address - pvte.baseadd + 1)); locked = "0"b; Ap = addr (A_record_block); Qp = addr (Q_record_block); Wp = record_blockp; do while (^locked); unspec (Q_record_block) = unspec (record_block); unspec (A_record_block) = unspec (Q_record_block); if ^A_record_block.lock then do; A_record_block.lock = "1"b; locked = stacq (W, A, Q); end; end; if record_block.state = STATE_UNSEEN then record_block.state = STATE_FREE; else if record_block.state = STATE_FREE then record_block.state = STATE_CONFLICT; else if record_block.state = STATE_IN_USE then do; if Page_no >= 0 & vtoc_index >= 0 & record_block.vtocx = vtoc_index & record_block.pageno = Page_no then do; record_block.vtocx = 0; record_block.pageno = 0; record_block.state = STATE_FREE; end; else record_block.state = STATE_CONFLICT; end; if record_block.state = STATE_CONFLICT then conflict = "1"b; else conflict = "0"b; record_block.lock = "0"b; return (conflict); end CHECK_ADDRESS_FOR_SCAVENGER; %page; /* Internal Procedure to lock the Volume Map lock, setup volmap_abs_seg */ LOCK_SETUP: proc; call page$lock_volmap (pvtep); volmap_locked = "1"b; call pmut$swap_sdw (addr (volmap_abs_seg$), addr (pvte.volmap_seg_sdw)); end LOCK_SETUP; %page; /* Internal Procedure to Cleanup */ UNLOCK_RESET: proc; if grabbed_vpage ^= -1 then call page$write_volmap_page_unwired (pvtep, grabbed_vpage); grabbed_vpage = -1; call pmut$swap_sdw (addr (volmap_abs_seg$), addr (NULL_SDW)); if volmap_locked then call page$unlock_volmap (pvtep); volmap_locked = "0"b; end UNLOCK_RESET; %page; /* Internal Subroutine to meter CPU time, number of calls, and number of pages whose addresses were deposited */ METER: proc; stock_segp = addr (stock_seg$); stock_seg.meters.pc_deposit_calls = stock_seg.meters.pc_deposit_calls + 1; stock_seg.meters.pc_deposit_pages = stock_seg.meters.pc_deposit_pages + pages; call usage_values (pf_end, vcpu_end); stock_seg.meters.pc_deposit_time = stock_seg.meters.pc_deposit_time + vcpu_end - vcpu_begin; end METER; %page; %include pvte; %page; %include scavenger_data; %page; %include stock_seg; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: pc_deposit: Address XXXXXX out of paging region on dskX_NN{s}. S: $crash T: $run M: An attempt was made to return disk address XXXXXX on device dskX_NN{s} to the free pool. The address is not in the paging region. A: $recover It may be necessary to run the physical volume salvager on the device. Message: pc_deposit: Invalid address XXXXXX on dskX_NN{s}. S: $crash T: $run M: In attempting to deposit address XXXXXX on device dskX_NN{s}, an invalid volume map offset was computed. A: $recover It may be necessary to run the physical volume salvager on the device. Message: pc_deposit: Deposit in-use address XXXXXX on dskX_NN{s}. S: $beep T: $run M: An attempt was made to return address XXXXXX on device dskX_NN{s} to the free record pool, but the address was already marked as free. This indicates damage to control structures on the device. This damage can be corrected by a physical volume salvage. A: $inform Message: pc_deposit: Unrecoverable I/O error on Volmap page M of dskX_NN{s}. Addresses lost. S: $beep T: $run M: There was an unrecoverable I/O error on a page of the Volume Map, which describes free records of the volume. All free records described by that page have been lost. A: It may be possible to recover the lost addresses by a volume salvage. If there is a hard device error, the volume salvage will fail. In this case, it will be necessary to recover the volume onto a good pack. END MESSAGE DOCUMENTATION */ end pc_deposit;  pc_signal.pl1 11/11/89 1105.1r 11/11/89 0804.3 27792 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style3 */ pc_signal: proc (Error_Type, Astep, Ptwp); /* Program to build structures for the signaller when a signallable error is detected by Page Control. Written October 1982 by J. Bongiovanni */ /* Parameter */ dcl Error_Type fixed bin parameter; /* Index of error */ dcl Astep ptr unaligned parameter; /* -> ASTE of interest */ dcl Ptwp ptr unaligned parameter; /* -> PTW of interest */ /* Automatic */ dcl error_type fixed bin; dcl 1 page_fault_error_code aligned, /* Error code hack until info structure implemented */ 2 add bit (18) unaligned, 2 add_type bit (4) unaligned, 2 pad bit (5) unaligned, 2 pvtx fixed bin (9) unsigned unaligned; dcl ptwp ptr; /* Static */ dcl SIGNAL_NAME (0:3) char (32) internal static options (constant) init ("record_quota_overflow", "page_fault_error", "invalid_page_fault", "invalid_page_error"); /* Based */ dcl 1 Aste aligned like aste based (Astep); dcl 1 Ptw aligned like ptw based (Ptwp); /* External */ dcl 1 pds$condition_name aligned external, 2 len fixed bin (8) unaligned, 2 chars char (21) unaligned; dcl 1 pds$page_fault_data aligned like mc external; dcl 1 pds$signal_data aligned like mc external; dcl sst$rqover fixed bin (35) external; /* Builtin */ dcl bin builtin; dcl bit builtin; dcl length builtin; dcl rtrim builtin; dcl unspec builtin; %page; if (Error_Type < 0) | (Error_Type > PAGE_ERROR_MAXTYPE) then error_type = PAGE_ERROR_INVERROR; else error_type = Error_Type; unspec (pds$signal_data) = unspec (pds$page_fault_data); pds$condition_name.len = length (rtrim (SIGNAL_NAME (error_type))); pds$condition_name.chars = rtrim (SIGNAL_NAME (error_type)); goto TYPE_SPECIFIC (error_type); TYPE_SPECIFIC (0): /* record quota overflow */ pds$signal_data.fim_temp.fcode = bit (bin (record_quota_overflow_sct_index, 17), 17); pds$signal_data.errcode = sst$rqover; return; TYPE_SPECIFIC (1): /* page I/O error */ pds$signal_data.fim_temp.fcode = bit (bin (page_fault_error_sct_index, 17), 17); unspec (page_fault_error_code) = ""b; page_fault_error_code.add = Ptw.add; page_fault_error_code.add_type = Ptw.add_type; page_fault_error_code.pvtx = Aste.pvtx; unspec (pds$signal_data.errcode) = unspec (page_fault_error_code); return; TYPE_SPECIFIC (2): /* bad machine conditions */ TYPE_SPECIFIC (3): /* Invalid error type */ return; /* format: off */ %page; %include aste; %page; %include mc; %page; %include page_error_types; %page; %include ptw; %page; %include static_handlers; end pc_signal;  pc_trace.alm 11/11/89 1105.1r w 11/11/89 0804.3 48474 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " pc_trace tracing routine called by the alm " part of page control to print out tracing " information by calling pc_trace_pl1 with " pre-canned arument lists. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Written sometime by somebody, whose august identity is now sadly " lost in the dim mists of antiquity. " Modified 03/01/81, W. Olin Sibert, for new sst include file and ADP conversion " name pc_trace include pxss_page_stack include sst include page_info segdef move_page,zero_page,no_paging_device,rws_truncated segdef done,page_fault,page_fault_end,write_page segdef abort_complete,running,rws_complete segdef tr_pd_delete_,tr_rws,rehash,depositing,withdrawing " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " page_fault: ldq sst|sst.trace_sw canq sst.pc_trace_pf,dl tze 0,7 spribp arg+18 tsx5 setup_argl_4 call pc_trace_pl1$page_fault(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " page_fault_end: ldq sst|sst.trace_sw canq sst.pc_trace_pf,dl tze 0,7 spribp arg+18 tsx5 setup_argl_4 call pc_trace_pl1$page_fault_end(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write_page: ldq sst|sst.trace_sw canq sst.pc_trace_pf,dl tze 0,7 eppap sst|0,4 spriap arg+18 tsx5 setup_argl_4 call pc_trace_pl1$write_page(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " done: ldq sst|sst.trace_sw canq sst.pc_trace_pf,dl tze 0,7 eppap sst|0,4 spriap arg+18 tsx5 setup_argl_4 call pc_trace_pl1$done(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " abort_complete: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 eppap sst|0,1 get a pointer to the pdmep spriap arg+18 spribp arg+20 save ptp tsx5 setup_argl_1 call pc_trace_pl1$abort_complete(arg) tra 0,7 setup_argl_1: epplb arg+18 sprilb arg+2 epplb arg+20 sprilb arg+4 ldaq argl1 staq arg tra 0,5 even argl1: zero 4,4 zero 0,0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " move_page: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 tsx5 setup_argl_2 call pc_trace_pl1$move_page(arg) tra 0,7 setup_argl_2: epplb devadd sprilb arg+2 ldaq argl2 staq arg tra 0,5 even argl2: zero 2,4 zero 0,0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " zero_page: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 spribp arg+18 save ptp tsx5 setup_argl_3 call pc_trace_pl1$zero_page(arg) tra 0,7 even setup_argl_3: epplb arg+18 sprilb arg+4 epplb devadd sprilb arg+2 ldaq argl3 staq arg tra 0,5 even argl3: zero 4,4 zero 0,0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " no_paging_device: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 spribp arg+18 save ptp tsx5 setup_argl_3 call pc_trace_pl1$no_pd_(arg) tra 0,7 " " " " " " " " "" " " " " " " " " " " " " " " " " " " " " rws_truncated: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 eppap sst|0,1 spriap arg+18 save pointer to pdme tsx5 setup_argl_3 call pc_trace_pl1$rws_truncated(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " tr_pd_delete_: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 eppap sst|0,0 spriap arg+18 tsx5 setup_argl_4 call pc_trace_pl1$tr_pd_delete_(arg) tra 0,7 setup_argl_4: epplb arg+18 sprilb arg+2 ldaq argl2 staq arg tra 0,5 even argl4: zero 2,4 zero 0,0 argl0: zero 0,0 zero 0,0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " tr_rws: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 eppap sst|0,1 spriap arg+18 tsx5 setup_argl_4 call pc_trace_pl1$tr_rws(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " rehash: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 lda ap|2,* old devadd sta arg+18 lda ap|4,* sta devadd tsx5 setup_argl_3 call pc_trace_pl1$rehash(arg) tra 0,7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " depositing: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,0 tsx5 setup_argl_2 call pc_trace_pl1$depositing(arg) tra 0,0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdrawing: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,0 tsx5 setup_argl_2 call pc_trace_pl1$withdrawing(arg) tra 0,0 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " running: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,6 call pc_trace_pl1$running(argl0) tra 0,6 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " rws_complete: ldq sst|sst.trace_sw canq sst.pc_trace,dl tze 0,7 eppap sst|0,1 spriap arg+18 tsx5 setup_argl_4 call pc_trace_pl1$rws_complete(arg) tra 0,7 " end  pc_trace_pl1.pl1 11/11/89 1105.1r w 11/11/89 0804.3 44334 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ pc_trace_pl1: proc; /* RE Mullen, v2pl1, oct 1973 */ /* RE Mullen, v2pl1, oct 1973 */ dcl (cmep, pdmep, ptp, a_pdmep, a_ptp) ptr, format1 char (22) aligned static init (" ^w"), format4 char (34) aligned static init (" ^w ^w ^w ^w"), fword (0:10) fixed bin based, (devadd, a_devadd, bdevadd, b_devadd) fixed bin, trace entry options (variable); done: entry (a_pdmep); cmep = a_pdmep; call trace ("done cmep = ^p", cmep); call trace (format4, cmep -> fword (0), cmep -> fword (1), cmep -> fword (2), cmep -> fword (3)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ page_fault: entry (a_pdmep); ptp = a_pdmep; call trace ("page fault ptp = ^p", ptp); call trace (format1, ptp -> fword (0)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ page_fault_end: entry (a_pdmep); ptp = a_pdmep; call trace ("end page fault ptp = ^p", ptp); call trace (format1, ptp -> fword (0)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ write_page: entry (a_pdmep); cmep = a_pdmep; call trace ("write page cmep = ^p", cmep); call trace (format4, cmep -> fword (0), cmep -> fword (1), cmep -> fword (2), cmep -> fword (3)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ abort_complete: entry (a_pdmep, a_ptp); pdmep = a_pdmep; ptp = a_ptp; call trace ("abort complete pdmep = ^p, ptw = ^w", pdmep, ptp -> fword (0)); call trace (format4, pdmep -> fword (0), pdmep -> fword (1), pdmep -> fword (2), pdmep -> fword (3)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * */ move_page: entry (a_devadd); devadd = a_devadd; call trace ("moving page ^w", devadd); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * */ zero_page: entry (a_devadd, a_ptp); devadd = a_devadd; ptp = a_ptp; call trace ("zero page ptw = ^w, devadd = ^w", ptp -> fword (0), devadd); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ no_pd_: entry (a_devadd, a_ptp); devadd = a_devadd; ptp = a_ptp; call trace ("no paging device ptw = ^w, devadd = ^w", ptp -> fword (0), devadd); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ rws_truncated: entry (a_devadd, a_ptp); devadd = a_devadd; pdmep = a_ptp; /* on purpose ... for efficiency */ call trace ("rws truncated pdmep = ^p, devadd = ^w", pdmep, devadd); call trace (format4, pdmep -> fword (0), pdmep -> fword (1), pdmep -> fword (2), pdmep -> fword (3)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ withdrawing: entry (a_devadd); devadd = a_devadd; call trace ("withdrawing devadd = ^w", devadd); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ depositing: entry (a_devadd); devadd = a_devadd; call trace ("depositing devadd = ^w", devadd); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ tr_pd_delete_: entry (a_pdmep); pdmep = a_pdmep; call trace ("pd_delete_ pdmep = ^p", pdmep); call trace (format4, pdmep -> fword (0), pdmep -> fword (1), pdmep -> fword (2), pdmep -> fword (3)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ tr_rws: entry (a_pdmep); pdmep = a_pdmep; call trace ("read/write start pdmep = ^p", pdmep); call trace (format4, pdmep -> fword (0), pdmep -> fword (1), pdmep -> fword (2), pdmep -> fword (3)); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ rehash: entry (a_devadd, b_devadd); devadd = a_devadd; bdevadd = b_devadd; call trace ("rehashing old devadd = ^w, new devadd = ^w", devadd, bdevadd); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ running: entry; call trace ("running the devices"); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ rws_complete: entry (a_pdmep); pdmep = a_pdmep; call trace ("rws complete pdmep = ^p", pdmep); call trace (format4, pdmep -> fword (0), pdmep -> fword (1), pdmep -> fword (2), pdmep -> fword (3)); return; end;  pc_wired.pl1.pmac 11/11/89 1105.1r w 11/11/89 0804.3 66042 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* use: pl1_macro pc.pl1.pmac -target l68 */ pc_wired: proc; /* RE Mullen, v2pl1, oct 1973 */ /* Modified for unified page wait primitive, B. Greenberg 6/6/74 */ /* write_wait_uid for new lock, 11/3/75 by BSG */ /* Modified for ADP conversion, 03/03/81, W. Olin Sibert */ /* Modified for unwire_write_wait, February 1982, J. Bongiovanni */ /* Modified for write_wait_uid_list, November 1982, J. Bongiovanni */ dcl a_astep pointer parameter; /* pointer to AST entry */ dcl first_page fixed bin parameter; /* first page affected */ dcl no_pages fixed bin parameter; /* number of pages, or -1 if all remaining */ dcl a_uid bit (36) aligned parameter; /* arg uid of segment */ dcl a_listp ptr parameter; /* pointer to list of pages */ dcl a_list (0:255) fixed bin based (a_listp); /* list of pages */ dcl fp fixed bin; /* first page */ dcl waitev fixed bin (35); /* wait event from pread */ dcl i fixed bin; /* loop index */ dcl (j, k) fixed bin (35); /* temporary wait indices */ dcl rptp fixed bin (18); /* offset of page table */ dcl lp fixed bin; /* last page */ dcl np fixed bin; /* number of pages */ dcl max_page fixed bin; /* highest page number allowed */ dcl increment fixed bin; /* do loop increment */ dcl uid bit (36) aligned; /* uid of segment */ dcl oldmask fixed bin (71); /* saved interrupt mask */ dcl ptwp ptr; /* saved pointer to ptw for wired stack pages */ dcl do_io bit (1) aligned; /* flag on if I/O is to be done */ dcl io bit (1) aligned; /* ="1"b for read, "0"b for write */ dcl must_wait bit (1) aligned; /* on if must wait for I/O to complete */ dcl set_wired bit (1) aligned; /* on if wired bit is to be set */ dcl wired bit (1) aligned; /* value of wired bit, if to be set */ dcl uent bit (1) aligned; /* on if must check uid before looking around */ dcl have_list bit (1) aligned; /* on if we were passed a list of pages */ dcl page_no fixed bin; /* current page number */ dcl wptwp ptr; /* pointer to current PTW */ dcl list (0:255) fixed bin; /* copy of list of pages */ dcl 1 wptw aligned like ptw based (wptwp); /* working PTW */ dcl pmut$lock_ptl entry (fixed bin (71), ptr); dcl pmut$unlock_ptl entry (fixed bin (71), ptr); dcl page$pread entry (ptr, fixed bin, fixed bin (35)); dcl page$pwrite entry (ptr, fixed bin); dcl page$pwait entry (fixed bin (35)); dcl sst$astsize fixed bin external static; dcl sst$pts (0 : 3) fixed bin external static; dcl sst$wired fixed bin external static; dcl (addrel, binary, min, rel) builtin; /* */ pc_wired$wire_wait: entry (a_astep, first_page, no_pages); /* entry to get pages into core and wire down */ io = "1"b; do_io = "1"b; must_wait = "1"b; set_wired = "1"b; wired = "1"b; uent = "0"b; have_list = "0"b; go to join; pc_wired$wire: entry (a_astep, first_page, no_pages); /* entry to wire pages */ do_io = "0"b; must_wait = "0"b; set_wired = "1"b; wired = "1"b; uent = "0"b; have_list = "0"b; go to join; pc_wired$read: entry (a_astep, first_page, no_pages); /* entry to read pages */ io = "1"b; do_io = "1"b; must_wait = "0"b; set_wired = "0"b; uent = "0"b; have_list = "0"b; go to join; pc_wired$unwire: entry (a_astep, first_page, no_pages); /* entry to turn off wired bit */ io = "0"b; must_wait = "0"b; set_wired = "1"b; wired = "0"b; uent = "0"b; have_list = "0"b; go to join; pc_wired$write_wait: entry (a_astep, first_page, no_pages); /* entry to issue write and wait for I/O */ io = "0"b; do_io = "1"b; must_wait = "1"b; set_wired = "0"b; uent = "0"b; have_list = "0"b; go to join; pc_wired$write: entry (a_astep, first_page, no_pages); /* entry to issue a write */ io = "0"b; do_io = "1"b; must_wait = "0"b; set_wired = "0"b; uent = "0"b; have_list = "0"b; go to join; pc_wired$write_wait_uid: entry (a_astep, first_page, no_pages, a_uid); /* For cleanup */ io = "0"b; do_io = "1"b; must_wait = "1"b; set_wired = "0"b; uent = "1"b; uid = a_uid; have_list = "0"b; go to join; pc_wired$write_wait_uid_list: entry (a_astep, a_listp, first_page, no_pages, a_uid); io = "0"b; do_io = "1"b; must_wait = "1"b; set_wired = "0"b; uent = "1"b; uid = a_uid; have_list = "1"b; goto join; pc_wired$unwire_write_wait: entry (a_astep, first_page, no_pages); io = "0"b; do_io = "1"b; must_wait = "1"b; set_wired = "1"b; wired = "0"b; uent = "0"b; have_list = "0"b; join: astep = a_astep; /* Copy args. */ np = no_pages; max_page = sst$pts (binary (astep -> aste.ptsi, 3)) - 1; /* Highest valid page number */ fp = first_page; if have_list then do; list = a_list; lp = fp + np - 1; end; else do; if np = -1 then lp = binary (astep -> aste.csl, 9) - 1; else lp = fp + np - 1; end; call pmut$lock_ptl (oldmask, ptwp); /* lock and mask */ ptp = addrel (astep, sst$astsize); /* get a pointer to the page table */ rptp = binary (rel (ptp), 18); /* get offset for pwait calls */ if set_wired then do i = fp to lp; /* Unwire/wire all needed pages. */ if have_list then page_no = list (i); else page_no = i; if page_no <= max_page then do; wptwp = addr (ptp -> ptwa (page_no)); if wired ^= wptw.wired /* if changing wired bit */ then if wired then sst$wired = sst$wired + 1; /* change total */ else sst$wired = sst$wired - 1; wptw.wired = wired; /* Wire/unwire as needed. */ end; end; loop: k, j, waitev = -1; /* Set out of service indicator. */ if uent then /* Racing with cleanup, but we are in same racket */ if uid ^= astep -> aste.uid then go to nomore; do i = lp to fp by -1; /* Loop backwards to optimize disk spiral */ if have_list then page_no = list (i); else page_no = i; if page_no <= max_page then do; wptwp = addr (ptp -> ptwa (page_no)); if wptw.os then k = page_no + rptp; /* If out of service remember to wait. */ else if do_io then do; if ^wptw.valid then do; /* Try to read in a page. */ if io then call page$pread (astep, page_no, waitev); /* try to read the page */ if waitev > 0 then j = waitev;/* use new wait event */ end; else do; /* page is in core, probably want to write */ if ^io then if (wptw.phm | wptw.phm1) then call page$pwrite (astep, page_no); /* issue the write request */ if wptw.os then j = page_no + rptp; end; end; end; end; if k ^= -1 then do; j = k; go to wait1; end; if must_wait & j ^= -1 then do; /* See if we must wait */ wait1: call page$pwait (j); /* wait for event */ go to loop; end; nomore: call pmut$unlock_ptl (oldmask, ptwp); /* unlock and unmask */ return; %page; %include aste; %page; %INCLUDE "ptw.macro"; end pc_wired;  post_purge.alm 11/11/89 1105.1r w 11/11/89 0803.8 66447 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(85-10-28,Fawcett), approve(86-04-03,MCR7277), " audit(86-04-03,Farley), install(86-04-07,MR12.0-1036): " Fix a looping problem that caused the system to hang " END HISTORY COMMENTS " " " " " " " " " " " " " " " " " " " " " " " " " " " post_purge -- This entry contains the code to post purge a process. " " Last Modified (Date and Reason) " 4/8/74 by S.H.Webber to change decision tree and add scheduling trace " 03/18/81, W. Olin Sibert, for ADP conversion " 06/21/82, E. N. Kittlitz, to move core map. " 83-12-03 BIM to sys_trace.incl.alm " " This program was originally part of pre_page but has since been renamed " as we no longer do anything about pre_paging. " " " " " " " " " " " " " " " " " " " " " " " " " " name post_purge segdef post_purge include pxss_page_stack include add_type include page_info include sst include sys_trace include aste include sdw include ptw include cmp include apte " " The following is the decision tree used " at post-purge time. " " The current algorithm is as follows: " " post_purge never " move if per-process and in core " used bit off never " working set if used in quantum by some process " " bool working_set,000010 " How to interpret the bits bool used_bit_off,000004 bool post_purge_bit,000002 bool moved_bit,000001 equ ptw.pre_paged,ptw.er " Special use for this bit here code_tree: oct 020042104200 oct 020042104200 oct 020042104200 oct 020042104200 oct 020042104200 oct 062146314620 oct 020042104200 oct 062146314620 post_purge: push tsx6 page_fault$init_savex initialize x7 save stack lda post_purge_entry,dl set entry switch sta entry_sw tsx7 page_fault$lock_ptl lock the page table lock read_clock meter post-purge time staq pre_time save start time in stack fld 0,dl initialize counters staq pre_temp staq pre_temp+2 staq pre_temp+4 " " The post purge code starts searching the post purge trace list from "trace_index" " to "trace_size" -- watching out for possible wrap-around. " eppap pds$trace get pointer to trace data ldx0 ap|trace.index_word get starting index post_loop: cmpx0 ap|trace.next_free_word are we done? tze done_post yes, finish up increment sst|sst.post_list_size count number of pages in core at purge sxl0 pre_temp+1 save current index lda ap|trace.data+1,0 get page number from entry cana =o770000,du this better be a page fault list entry tnz next_entry it isn't, skip it sta temp save it for a second ldx3 ap|trace.data,0 get current AST entry pointer eax2 aste_size,3 fabricate page table pointer adlx2 temp add in word number to get ptwp eppbp sst|0,2 get a pointer to the PTW lda ptw.pre_paged,dl check if we've already looked at this ptw cana ptw|0 .. tze looked we haven't, continue increment sst|sst.thrashing count thrashing tra next_entry and skip this one looked: orsa ptw|0 turn on pre_paged bit (already looked) lda ptw|0 refetch the ptw " " Now get decision index " ldq 0,dl The object of this game is to make Q1, Q2, cana ptw.phu1,dl and Q3 contain PHU, PHM, and PHU1, resp. tze *+2 We accomplish this by inspecting each PTW bit orq =o040000,du and setting the appropriate bit in Q. cana ptw.phm+ptw.phm1,dl tze *+2 orq =o100000,du cana ptw.phu,dl tze *+2 orq =o200000,du cana add_type.core,dl check if core address tze not_in_core if not skip cme stuff " " It's in core, get CMEP " orq =o400000,du turn on the in core bit for decision arl 3-1 compute core map entry pointer eax4 sst|sst.cmp,*au increment sst|sst.post_in_core meter lda page_fault$cme_devadd,*4 extract device ID from core map entry not_in_core: cana add_type.pd,dl is this on pd? tnz pp.yes_pd eaa 0 tra *+2 pp.yes_pd: lda 1,dl lrl 1 lda ast|aste.per_process_word,3 get aste word cana aste.per_process,du is it p/p? tnz pp.yes_pp eaa 0 tra *+2 pp.yes_pp: lda 1,dl lrl 1 shift in mlsw bit to complete index qrl 30 right justify the decision index increment sst|sst.tree_count,ql meter the decision stq pre_temp+5 save index in stack lls 33 split the index into wordno and shift value qrl 15 lrl 3 qrl 15 " " QU now contains the word offset " QL contains the shift index " lda code_tree,qu get code word in a arl code_shift,ql* shift to lower a ana =o17,dl leave only decision bits sta pre_temp cana working_set,dl should we count this page in working set ? tze *+2 no, skip count instruction aos pre_temp+4 yes, count it cana post_purge_bit,dl should we purge the page? tze check_move no, go check if we should move the core map entry lxl0 ptw|0 see if page is out of service canx0 ptw.os,du .. tnz check_move yes, skip write request canx0 ptw.valid,du see if page not in core tze check_move yes, skip write request increment sst|sst.post_purgings tsx7 page_fault$write_page see if must write the page and do so if must eppap pds$trace get pointer to array again check_move: lda pre_temp see if we should move in list cana moved_bit,dl tze check_used no, look at next entry tsx7 page_fault$thread_to_lru yes, move in core map check_used: lda pre_temp retrieve coded value again cana used_bit_off,dl tze next_entry lcq ptw.phu+ptw.phu1+1,dl turn OFF used bit in PTW ansq ptw|0 next_entry: lxl0 pre_temp+1 get next free slot in pre-page list eax0 2,0 increment to next entry cmpx0 ap|trace.last_available_word tmi *+2 eax0 0 yes, reset index tra post_loop loop back for another entry done_post: " " Now reset all pre-paged flags " lca ptw.pre_paged+1,dl get mask to turn off flag ldx0 ap|trace.index_word start at beginning of list again turn_off: cmpx0 ap|trace.next_free_word are we done? tze mtime yes, abort loop ldq ap|trace.data+1,0 get word 1 for page number canq =o770000,du see if page fault entry tnz next_turn_off no, skip the entry stq temp save for subtract ldx3 ap|trace.data,0 get astep eax2 aste_size,3 fabricate ptp adlx2 temp .. ansa sst|0,2 turn off pre-paged bit next_turn_off: eax0 2,0 go to next entry cmpx0 ap|trace.last_available_word wrap-around? tmi *+2 no, eax0 0 yes tra turn_off loop back mtime: ldx0 ap|trace.next_free_word reset pointer to start of active list stx0 ap|trace.index_word eppap pds$apt_ptr,* set pre-page-size in APT entry ldq pre_temp+4 mpy tc_data$working_set_factor qrl 18 adq tc_data$working_set_addend stq ap|apte.ws_size asq sst|sst.pre_page_size read_clock meter time sbaq pre_time adaq sst|sst.post_purge_time staq sst|sst.post_purge_time increment sst|sst.post_purge_calls tsx7 page_fault$trace_scheduling tsx7 page_fault$unlock_ptl return code_shift: arg 32 arg 28 arg 24 arg 20 arg 16 arg 12 arg 8 arg 4 end  quotaw.pl1 11/11/89 1105.1r 11/11/89 0804.7 70623 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ quotaw: proc; /* RE Mullen, v2pl1, oct 1973 */ /* Modified by Bernard Greenberg, 04/28/75 for New Storage System */ /* Modified by Bernard Greenberg, 02/18/77 for online quota reconstructor */ /* Modified by David Spector, 02/18/79 for 18 bit quota */ /* Modified by Keith Loepere, 12/13/84 to count dirs pages against its own dir quota. */ dcl (a_astep, a_astep2) ptr, a_t fixed bin (1), (csw, a_csw) fixed bin (2); dcl a_q fixed bin (18); dcl a_code fixed bin (17); dcl a_uc fixed bin (18); dcl (addr, fixed, ptr) builtin; dcl (astpp, astep1, astep2, ptwp) ptr, (uchange, tchange, qchange, quota) fixed bin (34), code fixed bin, (tsw, ct, nt, qt) fixed bin (1), (a_osu, osu, a_odu, odu, a_nsu, nsu, a_ndu, ndu) fixed bin (34), new_quota fixed bin (34), pcsw bit (1), a_qt bit (1) aligned, pds$processid ext bit (36), pds$quota_inhib ext fixed bin (17), oldmask fixed bin (71), privileged_mode_ut$lock_ptl ext entry (fixed bin (71), ptr), privileged_mode_ut$unlock_ptl ext entry (fixed bin (71), ptr); % include aste; declare sst$rqover fixed bin (35) external static; declare sst_seg$ external static; declare sstp pointer; /* entry to changed used records for an active account */ cu: entry (a_astep, a_uc, a_qt, a_csw, a_code); csw = a_csw; /* check switch: = 1 check only, = 0 check and make change */ /* 2 = make change and dont complain */ pcsw = "0"b; go to cum; cu_for_pc: entry (a_astep, a_uc, a_qt); /* Special side-door for pc$truncate */ pcsw = "1"b; csw = 0; /* Do it */ cum: astep = a_astep; /* ptr to AST entry of dir in which file resides */ uchange = a_uc; /* change to used */ qt = fixed (a_qt, 1); /* quota type, 0 = segs, 1 = dirs */ code = 0; sstp = addr (sst_seg$); if ^pcsw then call privileged_mode_ut$lock_ptl (oldmask, ptwp); /* lock, switch_stack and mask */ cu1: astpp = astep; cu2: if csw ^= 1 then astpp -> aste.used (qt) = astpp -> aste.used (qt) + uchange; if csw = 2 then do; if uchange > 0 & astpp -> aste.used (qt) > aste.quota (qt) then code = sst$rqover; go to finish; end; if astpp -> aste.tqsw (qt) = "0"b then do; astpp = ptr (sstp, astpp -> aste.par_astep); /* loop over parents */ go to cu2; end; if pds$quota_inhib ^= 0 then go to finish; /* Patch for reloader, etc */ if code ^= 0 then go to finish; /* second time thru the loop */ if uchange <= 0 then go to finish; /* don't check quota when decreasing */ if csw = 1 then tchange = uchange; /* change has not been added in */ else tchange = 0; /* change has been added in */ if astpp -> aste.quota (qt) < (astpp -> aste.used (qt) + tchange) then do; /* change is not ok */ uchange = -uchange; /* prepare to remove change */ code = sst$rqover; if csw = 0 then go to cu1; /* loop thru and undo change if any */ end; finish: if pcsw then return; call privileged_mode_ut$unlock_ptl (oldmask, ptwp); /* unlock, switch back and unmask */ a_code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* entry to set a quota and change the terminal state of an active AST */ sq: entry (a_astep, a_q, a_qt, a_t); astep = a_astep; /* ptr to ast entry to set quota on */ quota = a_q; /* new quota */ qt = fixed (a_qt, 1); tsw = a_t; /* = 1 if quota is being changed from non-term to term */ /* = 0 if quota is being changed from term to non-term */ sstp = addr (sst_seg$); call privileged_mode_ut$lock_ptl (oldmask, ptwp); /* mask, switch stack and lock */ if tsw = 1 then uchange = astep -> aste.used (qt); /* used records that will no longer be carried up */ else uchange = -astep -> aste.used (qt); /* used records will be added sup acct */ astpp = astep; sq1: astpp = ptr (sstp, astpp -> aste.par_astep); /* loop to find terminal account */ astpp -> aste.used (qt) = astpp -> aste.used (qt) - uchange; /* subtract used from parents */ if astpp -> aste.tqsw (qt) = "0"b then go to sq1; astep -> aste.quota (qt) = quota; astep -> aste.tqsw (qt) = (tsw = 1); call privileged_mode_ut$unlock_ptl (oldmask, ptwp); /* unlock, switch back and unmask */ return; /* * * * * * * * * * * * * * * * * * */ /* entry to move quota from parent ast (ast1) to inferior ast (ast2) */ mq: entry (a_astep, a_astep2, a_q, a_qt, a_code); astep1 = a_astep; /* ptr to parent ast entry */ astep2 = a_astep2; /* ptr to target ast entry */ qchange = a_q; /* amount of quota to be moved from ast1 to ast2 */ qt = fixed (a_qt, 1); code = 0; sstp = addr (sst_seg$); call privileged_mode_ut$lock_ptl (oldmask, ptwp); /* mask, switch stack and lock */ ct = fixed (astep2 -> aste.tqsw (qt), 1); /* ct = 1 if ast2 currently has term quota */ if astep2 -> aste.quota (qt) + qchange ^= 0 then do; /* ast2 will have terminal quota */ nt = 1; if astep2 -> aste.quota (qt) + qchange < astep2 -> aste.used (qt) then go to error; /* new quota must cover used */ if ct = 0 then uchange = -astep2 -> aste.used (qt); /* subtract used from current terminal quota */ else uchange = 0; /* no change from terminal state */ end; else do; /* ast2 will not have terminal quota */ nt = 0; if ct = 1 then uchange = astep2 -> aste.used (qt); /* add used into new terminal quota */ else uchange = 0; end; new_quota = astep1 -> aste.quota (qt) - qchange; if new_quota <= 0 then go to error; /* Insure no zero terminal quota */ if new_quota < astep1 -> aste.used (qt)+uchange then go to error; astep1 -> aste.quota (qt) = new_quota; /* Change quota */ astep1 -> aste.used (qt) = astep1 -> aste.used (qt)+uchange; /* change parent used */ astep2 -> aste.quota (qt) = astep2 -> aste.quota (qt)+qchange; /* change target quota */ astep2 -> aste.tqsw (qt) = (nt = 1); mqfinish: call privileged_mode_ut$unlock_ptl (oldmask, ptwp); /* unlock, switch back and unmask */ a_code = code; return; error: code = sst$rqover; go to mqfinish; /* * * * * * * * * * * * * * * * * * * * * * * * * */ rvq: entry (a_astep, a_osu, a_odu, a_nsu, a_ndu); /* Entry to determine active inferior and current active quota totals for revalidator */ astep = a_astep; sstp = addr (sst_seg$); call privileged_mode_ut$lock_ptl (oldmask, ptwp); /* mask, lock */ osu = aste.used (0); odu = aste.used (1); /* Copy current, incorrect totals */ nsu = 0; /* Zero totals to be accumulated */ ndu = fixed (aste.records, 9); /* dirs records count towards itself */ do astep = ptr (sstp, aste.infp) repeat ptr (sstp, aste.infl) while (astep ^= sstp); /* Map over inferiors */ if aste.dirsw then do; if ^aste.tqsw (0) then nsu = nsu + aste.used (0); /* Add inferior dir totals */ if ^aste.tqsw (1) then ndu = ndu + aste.used (1); /* records of dir already counted in quota used */ end; else nsu = nsu + fixed (aste.records, 9); /* Account to right place */ end; call privileged_mode_ut$unlock_ptl (oldmask, ptwp); a_osu = osu; /* Copy out answers */ a_odu = odu; a_nsu = nsu; a_ndu = ndu; return; end quotaw;  stock.alm 11/11/89 1105.1r w 11/11/89 0804.7 133290 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " stock " " Record Stock Management Routines " " Entries: " " withdraw - withdraws a single record address from a stock " " withdraw_range - withdraws a single record address from " a stock within a range of addresses " " withdraw_range_ext - same as withdraw_range, available " outside ALM Page Control " " deposit - deposits a single record address into a stock " " reset_os - resets all out-of-service bits in a stock " " flush_os - removes all out-of-service entries from a stock. " Called when there is an unrecoverable I/O error " on a Volume Map page. " " check_low_threshold - checks for stock below threshold and " selects a volume map page to replenish it " " recover - adjust stock counts (called during ESD) " " Written January 1982 by J. Bongiovanni " Modified July 1982, J. Bongiovanni, for withdraw_range_ext " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name stock segdef deposit segdef withdraw segdef withdraw_range segdef withdraw_range_ext segdef reset_os segdef flush_os segdef check_low_threshold segdef recover bool live_address,377777 bool os_address,400000 reset_os_upper_bits: oct 377777777777 " reset_os oct 000000777777 " flush_os reset_os_lower_bits: oct 777777377777 " reset_os oct 777777000000 " flush_os high_record_address: oct 377777000000 " include aste " include page_info " include ptw " include pvte " include pxss_page_stack " include stack_frame include stock_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw - routine to withdraw a single record address " " tsx7 stock$withdraw " " " " On entry " ab -> stock_seg$meters " bb -> stock of interest " " On exit " Areg contains address " " " withdraw_range - routine to withdraw a single record address " within a range specified " " Same as above, except on entry " AU = high address (rec < high address) " AL = low address (rec >= low address) " " withdraw_range_ext - withdraw range accessible outside " ALM Page control " " call page$withdraw_range (pvtep, low_address, high_address, record_address) " " No locks are required by this routine. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_range_ext: push stz ap|8,* " Clear returned address tsx6 page_fault$init_savex eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE lprpbb bp|pvte.volmap_stock_ptr " bb -> stock epbpab bb|0 " ab -> base of stock_seg eppab ab|stock_seg.meters " ab -> meters lda ap|6,* " AL = high address als 18 " AU = high address ora ap|4,* " AU = high address, AL = low address tsx7 withdraw_range " Try for an address tra withdraw_range_ext_ret " None eppap sp|stack_frame.arg_ptr,* " Restore argument list ptr sta ap|8,* " Record address withdraw_range_ext_ret: return withdraw: eax6 0 " withdraw stz stock_temp_1 " low address lda high_record_address sta stock_temp_2 " high address increment ab|rsmeters.n_withdraw_attempt tra withdraw_join withdraw_range: eax6 1 " withdraw_range increment ab|rsmeters.n_withdraw_range sta stock_temp_2 " high address ana -1,dl als 18 " low address sta stock_temp_1 withdraw_join: lxl0 bb|record_stock.stock_offset eppap bb|0,x0 " ap -> stock eax6 0,x6 " withdraw_range? tnz withdraw_set_begin " Yes lxl0 bb|record_stock.search_index " Roving pointer eax0 -1,x0 tra withdraw_common withdraw_retry: eax6 0,x6 " withdraw_range? tze withdraw_set_begin " No eax6 1,x6 " Bump bail-out counter cmpx6 2,du " Gone through once tpl 0,x7 " Yes -- once is enough withdraw_set_begin: ldx0 -1,du " Start at the beginning withdraw_common: ldx1 bb|record_stock.n_free_in_stock " Any free? tze 0,x7 " No -- give up withdraw_loop: increment ab|rsmeters.withdraw_stock_steps " Meter eax0 1,x0 " Next 2 entires cmpx0 bb|record_stock.n_words_in_stock " Any left tpl withdraw_retry " No - retry from the top withdraw_loop_retry: ldq ap|0,x0 " Next 2 entries tze withdraw_loop " Both empty lda ap|0,x0 " Protected by Q, stacq eax1 0,au " Check upper address tmoz withdraw_check_lower " Empty or out-of-service cmpx1 stock_temp_1 " >= low address tmi withdraw_check_lower " No cmpx1 stock_temp_2 " < high address tpl withdraw_check_lower " No ana -1,dl " Mark upper as empty tra withdraw_try " And attempt lockless withdraw withdraw_check_lower: eax1 0,ql " Look at lower entry tmoz withdraw_loop " Empty or out-of-service cmpx1 stock_temp_1 " >= low address tmi withdraw_loop " No cmpx1 stock_temp_2 " < high address tpl withdraw_loop " No ana -1,du " Mark lower as empty withdraw_try: stacq ap|0,x0 " Attempt lockless withdraw tze withdraw_succeed " Made it increment ab|rsmeters.withdraw_stock_losses tra withdraw_loop_retry " Meter and retry withdraw_succeed: eax6 0,x6 " withdraw_range ? tnz withdraw_leave_pointer " Yes -- don't adjust pointer sxl0 bb|record_stock.search_index " Roving pointer withdraw_leave_pointer: ldq bb|record_stock.n_free_in_stock " Adjust count lockless lda bb|record_stock.n_free_in_stock sba 1,du " One fewer free record stacq bb|record_stock.n_free_in_stock tnz withdraw_leave_pointer " Lost race, retry eaa 0,x1 " Record address arl 18 " Areg = record address increment ab|rsmeters.n_pages_withdraw_stock tra 1,x7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit - routine to deposit a single address " " tsx7 stock$deposit " " " " On entry, " Areg = address to deposit " ab -> stock_seg$meters " bb -> stock of interest " " No locks are required by this routine. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit: cana live_address,dl " Valid record address tze page_error$deposit_zero_address " No - bad lossage sta stock_temp_1 " Record address als 18 " Into upper sta stock_temp_2 increment ab|rsmeters.n_deposit_attempt lxl0 bb|record_stock.stock_offset eppap bb|0,x0 " ap -> stock lxl0 bb|record_stock.search_index " Roving pointer eax0 1,x0 " Adjust for initial decrement tra deposit_common deposit_retry: ldx0 bb|record_stock.n_words_in_stock " Start at the top deposit_common: lxl1 bb|record_stock.n_os_in_stock " Check whether any free slots adlx1 bb|record_stock.n_free_in_stock " exist cmpx1 bb|record_stock.n_in_stock tpl 0,x7 " None free deposit_loop: increment ab|rsmeters.deposit_stock_steps eax0 -1,x0 " 2 entries/word tmi deposit_retry " None left deposit_loop_retry: ldq ap|0,x0 " Next 2 entries lda ap|0,x0 " Protected by Qreg, stacq tze deposit_try_upper " Both entries free eax1 0,au " Check upper entry tnz deposit_check_lower " Not free deposit_try_upper: ora stock_temp_2 " Dep address into upper tra deposit_try deposit_check_lower: eax1 0,al " Check lower entry tnz deposit_loop " Not empty ora stock_temp_1 " Dep address into lower deposit_try: stacq ap|0,x0 " Lockless deposit tze deposit_succeed " We win increment ab|rsmeters.deposit_stock_losses tra deposit_loop_retry " Lose - meter and retry deposit_succeed: lda 1,dl " Set up to increment number OS ldx1 stock_temp_2 " Address just deposited tmi deposit_os " An out-of-service address lda 1,du " Set up to increment number free sxl0 bb|record_stock.search_index " Roving pointer deposit_os: sta stock_temp_2 " Save for lost race deposit_os_retry: ldq bb|record_stock.n_free_in_stock lda stock_temp_2 " Restore adla bb|record_stock.n_free_in_stock stacq bb|record_stock.n_free_in_stock " Lockless update tnz deposit_os_retry " Lost - retry increment ab|rsmeters.n_pages_deposit_stock tra 1,x7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " reset_os - routine to reset all out-of-service bits " " tsx7 stock$reset_os " " On entry, " ab -> stock_seg$meters " bb -> stock of interest " " No locks are required by this routine " " flush_os - routine to remove all out-of-service entries " from a stock. " " On entry, same as above " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " reset_os: eax6 0 " reset_os tra reset_os_common flush_os: eax6 1 " flush_os reset_os_common: increment ab|rsmeters.reset_os_calls lxl0 bb|record_stock.stock_offset eppap bb|0,x0 " ap -> stock ldx0 bb|record_stock.n_words_in_stock reset_os_loop: eax0 -1,x0 " One less tmi 0,x7 " Done - exit reset_os_loop_retry: ldq ap|0,x0 " Next 2 addresses ldx1 0,du " Count of OS reset lda ap|0,x0 " Protected by Qreg, stacq tze reset_os_loop " None in use tpl reset_os_check_lower " High address not OS ldx1 1,du " Count of OS reset ana reset_os_upper_bits,x6 " Reset/Flush reset_os_check_lower: cana =o400000,dl " Low address OS tze reset_os_try " No adlx1 1,du " Bump counter ana reset_os_lower_bits,x6 " Reset/Flush reset_os_try: eax1 0,x1 " Any to reset tze reset_os_loop " No stacq ap|0,x0 " Lockless tze reset_os_update_count " Won increment ab|rsmeters.reset_os_losses " Lost - meter and retry tra reset_os_loop_retry reset_os_update_count: stz stock_temp_1 stz stock_temp_2 sxl1 stock_temp_2 " To decrement count of OS eax6 0,x6 " Flush call tnz reset_os_update_retry " Yes - don't increment free count stx1 stock_temp_1 " To increment count of free reset_os_update_retry: ldq bb|record_stock.n_free_in_stock " Change count of OS, free lda bb|record_stock.n_free_in_stock " Lockless adla stock_temp_1 sbla stock_temp_2 stacq bb|record_stock.n_free_in_stock tnz reset_os_update_retry " lost race tra reset_os_loop " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_low_threshold - routine to check whether a stock is below " threshold, and (if so) to select a volmap page to " replenish it " " tsx7 stock$check_low_threshold " " " " On entry, " ab -> stock_seg$meters " bb -> stock of interest " bp -> pvte " " On exit, " if page selected, page number is in Areg " " This routine requires the Global Page Table Lock, the per-volume " volume map lock (with async state idle) " " A volmap page is selected as follows: " " 1. If a page is in memory, it is selected " 2. If no page is in memory, the lowest page which can replenish " the stock to target is selected " 3. Otherwise, the page with the largest number of free records " is selected " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_low_threshold: lxl0 bb|record_stock.n_os_in_stock adlx0 bb|record_stock.n_free_in_stock cmpx0 bb|record_stock.low_threshold " Below threshold tpl 0,x7 " No aos ab|rsmeters.low_thresh_detected " Meter stx0 stock_temp_1 " Free + OS ldx0 bb|record_stock.target " Target for Free + OS sbx0 stock_temp_1 " Shortfall stx0 stock_temp_1 lprpap bp|pvte.volmap_astep " ap -> ASTE for volmap_seg eppap ap|aste_size " ap -> Page Table for volmap_seg lxl0 bb|record_stock.n_volmap_pages stz stock_temp_2 sxl0 stock_temp_2 lda 0,dl " Page number ldx1 -1,du " First page which can replenish ldx2 -1,du " Page with largest number free check_low_mem: ldx0 bb|record_stock.n_free,al " Number free records this page tze check_low_next " None - skip ldq ap|0,al " Qreg = PTW canq ptw.valid,dl " In memory tnz 1,x7 " Yes - exit with page number in Areg cmpx0 stock_temp_1 " Enough to replenish to target tmi check_low_not_enough " No eax1 0,x1 " Found such yet tpl check_low_next " Yes - use first such eax1 0,al " No - this is such tra check_low_next check_low_not_enough: eax2 0,x2 " Largest number records so far tpl check_low_highest " One such found eax2 0,al " This is it tra check_low_next check_low_highest: cmpx0 bb|record_stock.n_free,x2 " Is this one higher tmoz check_low_next " No eax2 0,al " Yes check_low_next: ada 1,dl " Bump page number cmpa stock_temp_2 " Done all pages tmi check_low_mem " No eaa 0,x1 " First which can replenish tpl check_low_got " One was found eaa 0,x2 " Largest number records tpl check_low_got " Somebody found aos ab|rsmeters.low_thresh_fails " Nobody found - meter tra 0,x7 " And exit check_low_got: arl 18 " Page number in AL tra 1,x7 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " recover - routine to recompute counts in the record stock for ESD. " The system may have crashed due to a stock inconsistency, " and this may allow ESD to succeed. Of course, major " trashage to the stock cannot be bypassed. " " On entry, " ab -> stock_seg$meters " bb -> stock of interest " bp -> pvte " " This routine should be called only during ESD " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " recover: stz stock_temp_1 " Number free stz stock_temp_2 " Number out-of-service sprpbp bb|record_stock.pvtep " Restore pointer to PVTE lxl0 bb|record_stock.stock_offset eppap bb|0,x0 " ap -> stock array ldx0 bb|record_stock.n_words_in_stock recover_loop: eax0 -1,x0 " Index into stock array tmi recover_done " None left lda ap|0,x0 " Next 2 entries tze recover_loop " Both empty tpl recover_check_upper " Upper not out-of-service aos stock_temp_2 " Upper out-of-service tra recover_check_lower recover_check_upper: cana live_address,du " Upper empty tze recover_check_lower " Yes aos stock_temp_1 " No recover_check_lower: cana os_address,dl " Lower out-of-service tze recover_check_lower_inuse " No aos stock_temp_2 " Yes tra recover_loop recover_check_lower_inuse: cana live_address,dl " Lower empty tze recover_loop " Yes aos stock_temp_1 " No tra recover_loop recover_done: lda stock_temp_1 " Number free als 18 " Align ora stock_temp_2 " Merge in number out-of-service sta bb|record_stock.n_free_in_stock " And set count into stock tra 0,x7 end  thread.alm 11/11/89 1105.1r w 11/11/89 0803.8 56106 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " THREAD " " This procedure is used by the supervisor to manage threaded lists of " objects. Every such object should have a declaration which begins: " " dcl 1 thing aligned based, " 2 forward_ptr bit (18) unaligned, " 2 back_ptr bit (18) unaligned, " " The first word of each object must contain two eighteen bit pointers " (segment-base relative) to the next and previous objects in the list. " " This procedure also maintains a pointer into the list. It must be an " 18 bit relative offset, and appear in the upper halfword of a word. " The caller of thread may therefore declare it aligned. " " No checking is done to insure that these requirements for alignment " and location are being followed. " " 10/03/73, R. E. Mullen, in v2pl1 " 04/17/75, A. Bensoussan, to zero the fp and bp when threading out. " 03/26/81, W. Olin Sibert, to re-code in ALM " name thread segdef lin " Thread in, to linear list segdef cin " Thread in, to circular list segdef out " Thread out, of either type equ thread,1 " PR1 points to thread word throughout equ object,2 " PR2 points to object equ base,3 " PR3 points to base of segment containing " the object (though perhaps not the thread) equ .object,0 " X0 is offset of object equ .next,1 " X1 is offset of next object equ .prev,2 " X2 is offset of previous object equ .thread,3 " X3 is the value of the thread word (on entry) " " " THREAD$LIN -- Thread object into linear list " " dcl thread$lin entry (pointer, bit (18) unaligned); " " call thread$lin (astep, sst.ausedp (0)); " lin: epp object,ap|2,* epp thread,ap|4,* " Pointer to thread word epp object,object|0,* " Pointer to object eax .object,object|0 " Offset of object ldx .thread,thread|0 " Current value of thread (next_object) " Is list empty now? tnz lin.non_empty " No -- go thread into nonempty list " It was empty, so the thing we're threading in will be the only thing in the list. stx .object,thread|0 " object.bp = null, object.fp = null stz object|0 " thread = object_ptr short_return " " Since it was nonempty, we thread this object in at the end of the list. The " thread ends up pointing at the object we are threading in, and the object " it used to point to is adjusted to point (back) at the new one. lin.non_empty: epbp base,object|0 " Get a pointer to the base of the segment stz object|0 " object.bp = null stx .thread,object|0 " object.fp = thread (prev_object_ptr) stx .object,thread|0 " thread = object_ptr sxl .object,base|0,.thread " prev_object.bp = object_ptr short_return " " " THREAD$CIN -- Thread object into circular list " " dcl thread$cin entry (pointer, bit (18) unaligned); " " call thread$cin (astep, sst.ausedp (0)); " cin: epp object,ap|2,* " (pointer argument) epp thread,ap|4,* " Pointer to thread word epp object,object|0,* " Pointer to object eax .object,object|0 " Offset of object ldx .thread,thread|0 " Current value of thread (next_object) " Is list empty now? tnz cin.non_empty " No -- go thread into nonempty list " It was empty, so all threads point to it stx .object,object|0 " object.fp = object_ptr sxl .object,object|0 " object.bp = object_ptr stx .object,thread|0 " thread = object_ptr short_return " Since it was not empty, we will now thread in the new object between the "previous" " and "next" objects -- the thread is always considered to point to the "next" " object. After our object has been threaded in, it will be at the very end of " the list. cin.non_empty: epbp base,object|0 " Get a pointer to the base of the segment stx .thread,object|0 " object.fp = thread (next_object_ptr) lxl .prev,base|0,.thread " prev_object_ptr sxl .prev,object|0 " object.bp = prev_object.bp stx .object,base|0,.prev " prev_object.fp = object_ptr sxl .object,base|0,.thread " next_object.bp = object_ptr short_return " " " THREAD$OUT -- Thread object out of the list " " dcl thread$out entry (pointer, bit (18) unaligned); " " call thread$out (astep, sst.ausedp (0)); " out: epp object,ap|2,* " (pointer argument) epp thread,ap|4,* " Pointer to thread word epp object,object|0,* " Pointer to object eax .object,object|0 " Offset of object ldx .thread,thread|0 " Current value of thread (next_object) epbp base,object|0 " Get a pointer to the base of the segment ldx .next,object|0 " and pointers to the previous and next object lxl .prev,object|0 tze out.no_previous " if prev pointer is non-null, " rethread forward pointer for prev object stx .next,base|0,.prev " prev_object.fp = next_object_ptr " (fall through) out.no_previous: canx .next,=o777777,du " if next pointer is non-null, rethread tze out.no_next " backward pointer for next object sxl .prev,base|0,.next " next_object.bp = prev_object_ptr " (fall through) out.no_next: cmpx .object,thread|0 " If thread pointed to object we are threading tnz out.not_this_one " out, adjust it to point to the next, instead stx .next,thread|0 " thread = next_object_ptr out.not_this_one: " If this object points to itself, we are cmpx .object,object|0 " removing the only object on a circular tze out.last_in_list " list, so we should zero the thread word stz object|0 " Finally, zero the threads in the object " being removed. short_return out.last_in_list: " Can't use an STZ here, because there may ldx .thread,0,du " be something else in the lower halfword stx .thread,thread|0 " thread = null stz object|0 " Finally, zero the threads in the object " being removed. short_return end  volmap.alm 11/11/89 1105.1r w 11/11/89 0804.6 100701 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(87-02-18,Lippard), approve(87-03-16,MCR7640), " audit(87-06-17,Farley), install(87-07-17,MR12.1-1043): " Added volmap word validity check (fix by Swenson). " END HISTORY COMMENTS " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " volmap " " Routines for manipulating the volume map, migrating record addresses " between the volume map and the stock. " " Entries: " withdraw_from_volmap - volmap into stock " deposit_to_volmap - stock into volmap " drain_stock - empty stock into volmap " reset_pvte - reset lock, state for ESD " " These routines are controlled by threshold values in the stock. " " This version has some quick kludges for the old volmap format. " It will be changed for the new format. " " Written February 1982 by J. Bongiovanni " Modified December 1982 by J. Bongiovanni to reset ovfl before fno " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name volmap segdef withdraw_from_volmap segdef deposit_to_volmap segdef drain_stock segdef reset_pvte equ word_to_record.ls,5 equ volmap_page_high,1024 equ volmap_first_page,64 bool high_record_address,377777 bool os_address,400000 bool volmap_word_mask,400000000007 link volmap_abs_seg_link,volmap_abs_seg$ " include page_info " include pvte " include pxss_page_stack " include stock_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_from_volmap " " tsx7 volmap$withdraw_from_volmap " " On entry, " bp -> pvte " ab -> stock_seg$meters " bb -> record_stock " Areg contains page number in volmap_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " withdraw_from_volmap: increment ab|rsmeters.n_v_withdraw_attempts ldx0 bb|record_stock.volmap_page,al " Number free records this page tze 0,x7 " None to be had ldx0 bb|record_stock.target " Is volume shut down tze 0,x7 " Yes tsx6 page_fault$savex sta volmap_temp tsx6 setup_abs_seg " To read volmap_seg lda volmap_temp " Page number in volmap_seg als page_power " Offset within segment eppap volmap_abs_seg$ " ap -> base of volmap_seg eppap ap|0,al " ap -> page of volmap spriap volmap_save_ptr withdraw_loop: lca 1,dl " Bail-out counter sta volmap_temp+1 lxl0 volmap_temp " Page number ldx1 bb|record_stock.volmap_page,x0 " Records left this page tmoz withdraw_returns " None ldx1 bb|record_stock.old_volmap_page,x0 " Roving pointer eppap volmap_save_ptr,* eax0 0,x0 " Page number tnz withdraw_inner_loop " Not first page cmpx1 volmap_first_page,du " Kludge for old volmap tpl withdraw_inner_loop " Above bound ldx1 volmap_first_page,du " Set to minimum value withdraw_inner_loop: increment ab|rsmeters.withdraw_volmap_steps lda ap|0,x1 " Any free this word tnz withdraw_got " Yes eax1 1,x1 " Bump to next word cmpx1 volmap_page_high,du " End of page tmi withdraw_inner_loop " No aos volmap_temp+1 " Bump bail-out counter tpnz page_error$volmap_inconsistent ldx1 0,du " Start at the beginning eax0 0,x0 " Unless its page 0 tnz withdraw_inner_loop ldx1 volmap_first_page,du tra withdraw_inner_loop withdraw_got: cana =v36/volmap_word_mask " Check validity of word tnz page_error$invalid_volmap_word " mbz bits are not ldi 0,dl " Let fno work as expected, not as advertised lde 0,du " Find first bit on fno stz volmap_temp_1 ste volmap_temp_1 lda volmap_temp_1 neg arl 17-7 " Record within word sta volmap_temp_1 arl 18 " AL = Record within word eaq 0,x1 " QU = Word offset within volmap page lrl 18 " QU = Record within word " QL = Word offset within volmap page eaa 0,x1 " Word offset within volmap page als word_to_record.ls " Record offset of begin of word asa volmap_temp_1 " Record offset within volmap page lxl2 bb|record_stock.volmap_page,x0 " Base address of page adlx2 volmap_temp_1 " True address eaa 0,x2 arl 18 ora os_address,dl " Out-of-service until write completes stx1 bb|record_stock.old_volmap_page,x0 " Roving pointer stq volmap_temp_1 " QU = Record within word " QL = Word offset within volmap page tsx7 stock$deposit tra withdraw_returns " Stock is full eppap volmap_save_ptr,* " ap -> page of volmap lda volmap_temp_1 " AU = Record within word " AL = Word offset within volmap page ldq =o200000,du " Reset bit in volmap qrl 0,au ersq ap|0,al increment ab|rsmeters.n_pages_withdraw_async ldx0 bp|pvte.nleft sblx0 1,du tmi page_error$volmap_inconsistent stx0 bp|pvte.nleft lxl1 volmap_temp ldx0 bb|record_stock.volmap_page,x1 sblx0 1,du tmi page_error$volmap_inconsistent stx0 bb|record_stock.volmap_page,x1 lxl0 bb|record_stock.n_os_in_stock adlx0 bb|record_stock.n_free_in_stock cmpx0 bb|record_stock.target " Are we there yet tmi withdraw_loop " No withdraw_returns: tsx6 restore_abs_seg tsx6 page_fault$unsavex " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_to_volmap " " tsx7 volmap$deposit_to_volmap " " On entry, " bp -> pvte " ab -> stock_seg$meters " bb -> record_stock " Areg contains page number in volmap_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " deposit_to_volmap: increment ab|rsmeters.n_v_deposit_attempts tsx6 page_fault$savex eax0 0,al " Page number stx0 volmap_temp tsx6 setup_abs_seg lda volmap_temp " Page number ana -1,du " in AU arl 18-page_power " Offset in AL eppap volmap_abs_seg$ eppap ap|0,al " ap -> base of page ldx0 volmap_temp " Page number lda bb|record_stock.volmap_page,x0 ana -1,dl " AL = base address sta volmap_temp+1 ldx1 high_record_address,du " Set for last page lxl2 bb|record_stock.n_volmap_pages " Number of pages in volmap sblx2 1,du " Index of last page cmpx2 volmap_temp " Is this page the last tze deposit_last " Yes lxl1 bb|record_stock.volmap_page+1,x0 " Pick up base address of next deposit_last: stx1 volmap_temp+1 " Low address in lower/high address is upper spriap volmap_save_ptr deposit_loop: lxl0 bb|record_stock.n_os_in_stock adlx0 bb|record_stock.n_free_in_stock cmpx0 bb|record_stock.target " Are we done tmoz deposit_returns " Yes lda volmap_temp+1 " Range of addresses this page tsx7 stock$withdraw_range " Get an address within the rage tra deposit_returns " None left eppap volmap_save_ptr,* ldx0 volmap_temp " Page number lxl1 bb|record_stock.volmap_page,x0 " Base address of page stz volmap_temp_1 stx1 volmap_temp_1 sta devadd " Save address for page_error als 18 " Address in AU sbla volmap_temp_1 " Relative address within page tmi page_error$bad_volmap_address " Bogus arl 18 " Address in AL ldq 0,dl lrl word_to_record.ls " Word offset in AL qrl 18-word_to_record.ls " Bit within word in QU eax1 0,qu " Bit within word in x1 ldq =o200000,du " Mask to set bit qrl 0,x1 " Shift to the right bit cmpa 1024,dl " Within a page tpl page_error$bad_volmap_address " No canq ap|0,al " Already marked as free tze deposit_valid " No szn pvt$shutdown_state " In ESD? tnz deposit_loop " Yes, this can happen normally ldx1 1,du asx1 bp|pvte.vol_trouble_count " Add to inconsistency count tsx7 page_error$deposit_inuse_address " And tell the world tra deposit_loop deposit_valid: orsq ap|0,al " Mark address as free increment ab|rsmeters.n_pages_deposit_volmap ldx0 1,du asx0 bp|pvte.nleft ldx1 volmap_temp asx0 bb|record_stock.volmap_page,x1 tra deposit_loop deposit_returns: tsx6 restore_abs_seg tsx6 page_fault$unsavex " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " drain_stock " " call page$drain_record_stock (pvtep) " " Where " pvtep -> PVTE " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " drain_stock: push tsx6 page_fault$init_savex eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE lprpbb bp|pvte.volmap_stock_ptr " bb -> record stock epbpab bb|0 " ab -> base of stock_seg eppab ab|stock_seg.meters " ab -> meters drain_retry: tsx7 lock_volmap$lock_wired_wait " Get lock, async idle tra drain_waits " Failed, wait event in APTE ldx0 0,du " Succeeded stx0 bb|record_stock.low_threshold " Clear thresholds sxl0 bb|record_stock.high_threshold " And deposit will do the rest stx0 bb|record_stock.target lda bb|record_stock.n_volmap_pages ana -1,dl " Areg = number of pages in volmap sta volmap_temp_2 drain_loop: lda volmap_temp_2 sba 1,dl " Next page to drain sta volmap_temp_2 tmi drain_returns " Done tsx7 deposit_to_volmap " Clear this page tra drain_loop drain_returns: tsx7 lock_volmap$unlock_wired " Unlock return drain_waits: call pxss$wait " APTE already has event tra drain_retry " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " reset_pvte " " call page$reset_pvte (pvtep) " " Where " pvtep -> PVTE " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " reset_pvte: push eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE stz bp|pvte.volmap_lock " Clear lock stz bp|pvte.volmap_async_state " Set state to Idle, page to 0 stz bp|pvte.vtoc_map_lock " Clear lock lda bp|pvte.volmap_stock_ptr " See whether stock exists tze reset_pvte_returns " No ana =o007777,du " Check for null pointer cmpa =o007777,du tze reset_pvte_returns " Is null - no stock lprpbb bp|pvte.volmap_stock_ptr " bb -> record stock epbpab bb|0 " ab -> base of stock seg eppap ap|stock_seg.meters " ab -> meter area tsx7 stock$recover " Attempt to fix any damage tsx7 stock$reset_os " Reset any out-of-service " Safe since ESD doesn't withdraw reset_pvte_returns: return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " Internal procedure to set up and restore the volmap_abs_seg " " tsx6 setup_abs_seg " bp -> PVTE " " tsx6 restore_abs_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " setup_abs_seg: ldx0 lp|volmap_abs_seg_link " Segment number in x0 adlx0 lp|volmap_abs_seg_link " Offset in dseg ldaq dseg$0,x0 " Previous SDW staq volmap_save_sdw " Save into stack ldaq bp|pvte.volmap_seg_sdw " Volmap seg of interest staq dseg$0,x0 " Set the SDW cams " And the SDWAM camp " And the PTWAM tra 0,x6 restore_abs_seg: ldx0 lp|volmap_abs_seg_link " Segment number in x0 adlx0 lp|volmap_abs_seg_link " Offset in dseg ldaq volmap_save_sdw " Previous value staq dseg$0,x0 " Set the SDW cams " And the SDWAM tra 0,x6 end  volmap_page.alm 11/11/89 1105.1r w 11/11/89 0804.2 133362 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " volmap_page " " Routines to act on single pages of a volume map " " Entries: " " grap_volmap_page_unwired - wires and reads in a volmap page " deposits excess stock to volume map " " write_volmap_page_unwired - writes and unwires a volmap page " " start_async_read - starts an asynchronous read cycle to " the volume map " " start_async_write - starts an asynchronous write cycle to " the volume map " " post_io - posts a volume map i/o " " poll_io - polls for complete volume map i/os " " Written February 1982 by J. Bongiovanni " Modified September 1982, J. Bongiovanni, not to do read on OS page " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name volmap_page segdef grab_volmap_page_unwired segdef write_volmap_page_unwired segdef start_async_read segdef start_async_write segdef post_io segdef poll_io link volmap_abs_seg_link,volmap_abs_seg$ even pc_wired_arg_list: vfd 18/6,18/4,36/0 pread_arg_list: vfd 18/6,18/4,36/0 pwrite_arg_list: vfd 18/4,18/4,36/0 notify_arg_list: vfd 18/2,18/4,36/0 one: dec 1 " include aste " include page_info " include ptw " include pvte " include pxss_page_stack " include stock_seg " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " grab_volmap_page_unwired " " call page$grab_volmap_page_unwired (pvtep, page_no, page_ptr) " " pvtep = pointer to PVTE (Input) " page_no = page number in volume map (Input) " page_ptr = pointer to page in volume map (Output) " " The volume map must be locked to this process with asynchronous " state of idle. volmap_abs_seg must be set to refer to this volume " map. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " grab_volmap_page_unwired: push tsx6 page_fault$init_savex " Recursive use of x7 eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE tsx6 check_valid_call " Check lock, async state, abs seg lprpab bp|pvte.volmap_astep " ab -> ASTE for volume map spriab arg+8 eppab arg+8 spriab arg+2 eppab ap|4,* " Page number spriab arg+4 eppab one " Number of pages spriab arg+6 ldaq pc_wired_arg_list staq arg call pc_wired$wire_wait(arg) lda ap|4,* " Page number als page_power " Offset in segment eppab volmap_abs_seg$0,al " ab -> page spriab ap|6,* " Return to caller lprpbb bp|pvte.volmap_stock_ptr " bb -> record stock lxl0 bb|record_stock.high_threshold " Above high threshold cmpx0 bb|record_stock.n_free_in_stock tpl grab_volmap_returns " No epbpab bb|0 " ab -> base of stock_seg eppab ab|stock_seg.meters " ab -> meters aos ab|rsmeters.high_thresh_detected lda ap|4,* " Page number tsx7 volmap$deposit_to_volmap " Deposit excess for this page grab_volmap_returns: return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write_volmap_page_unwired " " call page$write_volmap_page_unwired (pvtep, page_no) " " pvtep = pointer to PVTE (Input) " page_no = page number in volume map (Input) " " The volume map must be locked to this process with asynchronous " state of idle. volmap_abs_seg must be set to refer to this volume " map. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " write_volmap_page_unwired: push eppbp ap|2,* " bp -> ptr -> PVTE eppbp bp|0,* " bp -> PVTE tsx6 check_valid_call " Check lock, async state, abs-seg lprpab bp|pvte.volmap_astep " ab -> ASTE for volmap_seg spriab arg+8 eppab arg+8 spriab arg+2 eppab ap|4,* " Page number spriab arg+4 eppab one " One page spriab arg+6 ldaq pc_wired_arg_list staq arg call pc_wired$unwire_write_wait(arg) return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " start_async_read " " tsx7 volmap_page$start_async_read " " " " On entry, " bp -> PVTE " ab -> stock_seg.meters " Areg = page number in volume map " Volume map locked to this process, async state idle " PTL locked to this process " " On exit, " Async state is Read " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " start_async_read: tsx6 page_fault$savex " Recursive use of x7 increment ab|rsmeters.async_read_calls sta volmap_page_temp " Page number lda pds$processid " Check PTL cmpa sst$ptl tnz page_error$ptl_not_locked cmpa bp|pvte.volmap_lock " Volmap lock held tnz page_error$volmap_page_invalid_call " No ldx0 bp|pvte.volmap_async_state " State idle cmpx0 VOLMAP_ASYNC_IDLE,du tnz page_error$volmap_page_invalid_call " No lda volmap_page_temp " Page number ana -1,dl " Just to be sure ora VOLMAP_ASYNC_READ,du " New async state sta bp|pvte.volmap_async_state lda volmap_page_temp " Page number lprpap bp|pvte.volmap_astep " ap -> ASTE for volmap_seg ldq ap|aste_size,al " PTW canq ptw.valid,dl " In memory tnz page_fault$unsavex " Yes canq ptw.os,dl " I/O already in progress? tnz page_fault$unsavex_1 " Yes - should never happen increment ab|rsmeters.async_page_reads increment sst$volmap_seg_page_faults spriap arg+8 eppap arg+8 spriap arg+2 eppap volmap_page_temp " Page number spriap arg+4 eppap arg+10 spriap arg+6 ldaq pread_arg_list staq arg call page_fault$pread(arg) tsx7 post_io_pvtep " Check for screw case tra page_fault$unsavex_1 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " start_async_write " " tsx7 page_fault$start_async_write " " " " On entry, " bp -> PVTE " Volmap async state is Read " PTL locked to process " " On exit, " Volmap async state is Write " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " start_async_write: tsx6 page_fault$savex " Recursive use of x7 sta volmap_page_temp " Page number lda pds$processid cmpa sst$ptl " PTL held tnz page_error$ptl_not_locked ldx0 bp|pvte.volmap_async_state cmpx0 VOLMAP_ASYNC_READ,du tnz page_error$wrong_async_state lda volmap_page_temp " Page number ana -1,dl " Just in case ora VOLMAP_ASYNC_WRITE,du " New state sta bp|pvte.volmap_async_state lda volmap_page_temp " Page number lprpap bp|pvte.volmap_astep " ap -> ASTE for volmap_seg ldq ap|aste_size,al " PTW canq ptw.valid,dl " In memory tze page_fault$unsavex_1 " No canq ptw.os,dl " Someone else writing it? tnz page_fault$unsavex " Yes - skip call to pwrite spriap arg+6 " astep eppap arg+6 spriap arg+2 eppap volmap_page_temp " Page number spriap arg+4 ldaq pwrite_arg_list staq arg call page_fault$pwrite(arg) tsx7 post_io_pvtep " Check for screw case tra page_fault$unsavex " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " post_io " " tsx7 volmap_page$post_io " " On entry, " Areg = pvtx " PTL locked to process " " post_io_pvtep - internal procedure, registers already setup " " tsx7 post_io_pvtep " " On entry, " bp -> PVTE " PTL locked to process " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " post_io: eax0 0 " Pvtx given sta volmap_page_temp " pvtx tra post_io_join post_io_pvtep: eax0 1 " Pvtep given post_io_join: read_clock staq post_io_start_time " For metering eax0 0,x0 " Pvtep given tpnz post_got_pvtep " Yes ldq pvte_size,dl " Compute pvtep mpy volmap_page_temp " Offset in array, one too high eppbp pvt$array eppbp bp|-pvte_size,ql " bp -> PVTE post_got_pvtep: lda bp|pvte.volmap_async_state " State in AU, page in AL tra post_io_state,au " Do what's appropriate post_io_state: tra 0,x7 " Idle tra post_read " Read tra post_write " Write post_read: tsx6 page_fault$savex " Recursive use of x7 lprpap bp|pvte.volmap_astep " ap -> ASTE for volmap_seg ldq ap|aste_size,al " PTW canq ptw.er,dl " I/O Error tze post_read_noerr " No tsx7 io_error " Yes - handle tra post_idle " Set state to idle and notify post_read_noerr: canq ptw.valid,dl " In memory tnz post_read_in_mem " Yes canq ptw.os,dl " Did we lose the I/O? tnz page_fault$unsavex " No tra post_idle " Yes, reset it..time will cure all post_read_in_mem: ana -1,dl " Page number lprpbb bp|pvte.volmap_stock_ptr " bb -> record stock epbpab bb|0 " ab -> base of stock seg eppab ab|stock_seg.meters " ab -> meters tsx7 volmap$withdraw_from_volmap " Replenish stock lda bp|pvte.volmap_async_page ana -1,dl " Page number tsx7 start_async_write " Write it back tra post_meter_exit tra page_error$volmap_page_async_error " Not in memory post_write: tsx6 page_fault$savex " Recursive use of x7 lprpap bp|pvte.volmap_astep " ap -> ASTE for volmap_seg ldq ap|aste_size,al " PTW canq ptw.er,dl " I/O Error tze post_write_noerr " No tsx7 io_error " Yes - handle tra post_idle " Set state to idle and notify post_write_noerr: canq ptw.os,dl " I/O finished tnz page_fault$unsavex " No canq ptw.valid,dl " In memory tze post_write_not_mod " No, write surely done canq ptw.phm+ptw.phm1,dl " Page modified tze post_write_not_mod " No, write completed " Write posted but page modified. Possibly a race, although the locking " strategy should prevent this. More likely, the disk went offline. " In this case, the write is notified with no error by page control. " We recover by re-issuing the I/O spriap arg+6 " ptr -> ASTE of volmap_seg eppap arg+6 spriap arg+2 lda bp|pvte.volmap_async_page " Page number in lower ana -1,dl sta arg+8 eppap arg+8 spriap arg+4 ldaq pwrite_arg_list staq arg call page_fault$pwrite(arg) tra page_fault$unsavex post_write_not_mod: lprpbb bp|pvte.volmap_stock_ptr " bb -> record stock epbpab bb|0 " ab -> base of stock seg eppab ab|stock_seg.meters " ab -> meters tsx7 stock$reset_os " Write finished, OK to use addresses post_idle: stz bp|pvte.volmap_async_state " Idle post_write_retry: ldq bp|pvte.volmap_idle_notify_word " Anybody waiting for idle lda bp|pvte.volmap_idle_notify_word cana pvte.volmap_idle_notify,dl tze post_meter_exit " No era pvte.volmap_idle_notify,dl " Reset notify switch stacq bp|pvte.volmap_idle_notify_word tnz post_write_retry " Lost race eaa bp|0 " AU = PVTE offset arl 18 " AL = PVTE offset ora pvt$volmap_idle_wait_constant " Areg = wait event sta arg+4 eppap arg+4 spriap arg+2 ldaq notify_arg_list staq arg call pxss$notify(arg) post_meter_exit: increment ab|rsmeters.async_post_io_calls read_clock sbaq post_io_start_time adaq ab|rsmeters.async_post_io_time staq ab|rsmeters.async_post_io_time tra page_fault$unsavex " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " poll_io " " call page$poll_volmap_io " " Called with no locks held, wired and masked " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " poll_io: push tsx6 page_fault$init_savex " Recursive use of x7 tsx7 page_fault$lock_ptl " Spin lock ldq pvte_size,dl " Index to last PVTE mpy pvt$n_entries eax0 0,ql " x0 -> one beyond end stx0 volmap_page_temp_1 " Save poll_loop: ldx0 volmap_page_temp_1 " Restore PVTE index eax0 -pvte_size,x0 " One fewer to go tmi poll_done stx0 volmap_page_temp_1 " Save index to PVTE eppbp pvt$array eppbp bp|0,x0 " bp -> PVTE ldq bp|pvte.used_word canq pvte.used,dl " PVTE in use tze poll_loop " No - skip ldx1 bp|pvte.volmap_async_state " Asynchronous activity state cmpx1 VOLMAP_ASYNC_IDLE,du " Idle tze poll_loop " Yes - skip sxl1 volmap_page_temp_1 " Save async state tsx7 post_io_pvtep " Try to post the I/O lxl1 volmap_page_temp_1 " Restore async state cmpx1 bp|pvte.volmap_async_state " Did state change? tze poll_loop " No tsx7 page_error$poll_state_change " Yes - report it tra poll_loop poll_done: eppbb sst$ " Needed by unlock_ptl tsx7 page_fault$unlock_ptl return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " io_error - internal procedure to handle unrecoverable I/O error " " tsx7 io_error " " On entry, " bp -> PVTE " Areg = page number in volmap_seg " " The strategy is to lose all free addresses on the page with the " I/O error. Any OS pages are flushed from the stock, and the " count of free addresses on that page is set to zero. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " io_error: tsx6 page_fault$savex " Recursive use of x7 sta volmap_page_temp lprpbb bp|pvte.volmap_stock_ptr " bb -> Record stock epbpab bb|0 " ab -> base of stock_seg eppab ab|stock_seg.meters " ab -> stock_seg$meters tsx7 stock$flush_os " Flush any out-of-service addresses lda volmap_page_temp " Page number ldx0 bp|pvte.nleft " Total number records left sblx0 bb|record_stock.volmap_page,al " Minus number free this page tpl io_error_nleft_ok " If positive eax0 0 io_error_nleft_ok: stx0 bp|pvte.nleft " Becomes new number left eax0 0 stx0 bb|record_stock.volmap_page,al " Clear count of free this page ldx0 bp|pvte.vol_trouble_count " Increment the trouble count adlx0 1,du stx0 bp|pvte.vol_trouble_count tsx7 page_error$volmap_io_error " Tell the world tra page_fault$unsavex " And return " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_valid_call - internal procedure to validate that " volume map is locked to this process, async state is idle, " and volmap_abs_seg is setup. " " tsx6 check_valid_call " " On entry, " bp -> PVTE " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " check_valid_call: ldx0 lp|volmap_abs_seg_link " Segment number of volmap_abs_seg adx0 lp|volmap_abs_seg_link " Offset of SDW in DSEG ldaq dseg$0,x0 " SDW cmpaq bp|pvte.volmap_seg_sdw " The right one tnz page_error$volmap_page_invalid_call lda pds$processid cmpa bp|pvte.volmap_lock " Volmap lock held tnz page_error$volmap_page_invalid_call ldx0 bp|pvte.volmap_async_state " State idle cmpx0 VOLMAP_ASYNC_IDLE,du tnz page_error$volmap_page_invalid_call tra 0,x6 end  volmap_util.pl1 11/11/89 1105.1r w 11/11/89 0804.7 49590 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ volmap_util$free_address_for_scavenge: proc (Pvtx, Record_Address); /* Volume Map Utilities free_address_for_scavenge - ensures that a record address is not free by removing from stock and volume map Written July 1982 by J. Bongiovanni Modified November 1982, J. Bongiovanni, to check stock under volmap lock */ /* Parameter */ dcl Pvtx fixed bin; /* PVTE index */ dcl Record_Address fixed bin (18); /* Automatic */ dcl bit_no fixed bin; dcl page_no fixed bin; dcl p99 pic "99"; dcl record_address fixed bin (18); dcl volmap_locked bit (1) aligned; dcl vpage_ptr ptr; dcl word_no fixed bin; /* Static */ dcl NULL_SDW fixed bin (71) int static options (constant) init (0); dcl RECORDS_PER_WORD fixed bin int static options (constant) init (32); /* Based */ dcl 1 vpage aligned based (vpage_ptr), 2 word (0:1023) aligned, 3 pad1 bit (1) unaligned, 3 bits (0:31) bit (1) unaligned, 3 pad2 bit (3) unaligned; /* External */ dcl volmap_abs_seg$ external; /* Entry */ dcl condition_ entry (char (*), entry); dcl page$grab_volmap_page_unwired entry (ptr, fixed bin, ptr); dcl page$lock_volmap entry (ptr); dcl page$unlock_volmap entry (ptr); dcl page$withdraw_range entry (ptr, fixed bin (18), fixed bin (18), fixed bin (18)); dcl page$write_volmap_page_unwired entry (ptr, fixed bin); dcl pmut$swap_sdw entry (ptr, ptr); dcl syserr entry options (variable); %page; record_address = Record_Address; page_no = -1; volmap_locked = "0"b; call SETUP_LOCK; call condition_ ("page_fault_error", PAGE_FAULT_ERROR); call FIND_VOLMAP_PAGE (record_address, page_no); call page$grab_volmap_page_unwired (pvtep, page_no - 1, vpage_ptr); call page$withdraw_range (pvtep, record_address, record_address + 1, (0)); word_no = divide (record_address - record_stock.volmap_page (page_no).baseadd, RECORDS_PER_WORD, 17); bit_no = mod (record_address - record_stock.volmap_page (page_no).baseadd, RECORDS_PER_WORD); vpage.word (word_no).bits (bit_no) = "0"b; call page$write_volmap_page_unwired (pvtep, page_no); page_no = -1; call UNLOCK_RESET; return; %page; /* Internal Procedure to setup pointers and lock the volume map */ SETUP_LOCK: proc; pvtep = addr (addr (pvt$array) -> pvt_array (Pvtx)); record_stockp = pvte.volmap_stock_ptr; call page$lock_volmap (pvtep); volmap_locked = "1"b; call pmut$swap_sdw (addr (volmap_abs_seg$), addr (pvte.volmap_seg_sdw)); end SETUP_LOCK; /* Internal Procedure to reset and unlock */ UNLOCK_RESET: proc; if page_no > 0 then call page$write_volmap_page_unwired (pvtep, page_no - 1); page_no = -1; if volmap_locked then call page$unlock_volmap (pvtep); volmap_locked = "0"b; call pmut$swap_sdw (addr (volmap_abs_seg$), addr (NULL_SDW)); end UNLOCK_RESET; %page; /* Internal Procedure to find the Volume Map page associated with a given address */ FIND_VOLMAP_PAGE: proc (Devadd, Page_no); dcl Devadd fixed bin (18) parameter; dcl Page_no fixed bin parameter; dcl vpagex fixed bin; dcl vpage_found bit (1); dcl address fixed bin; vpage_found = "0"b; address = Devadd; if address < pvte.baseadd | address >= pvte.baseadd + pvte.totrec then call syserr (CRASH, "volmap_util: Address ^o out of paging region on ^a_^a.", address, pvte.devname, convert (p99, pvte.logical_area_number)); do vpagex = record_stock.n_volmap_pages to 1 by -1 while (^vpage_found); if address >= record_stock.volmap_page (vpagex).baseadd then do; vpage_found = "1"b; Page_no = vpagex; end; end; if ^vpage_found then call syserr (CRASH, "volmap_util: Invalid address ^o on ^a_^a.", address, pvte.devname, convert (p99, pvte.logical_area_number)); return; end FIND_VOLMAP_PAGE; %page; /* Internal Procedure to clean up and continue signalling of page_fault_error */ PAGE_FAULT_ERROR: proc (Mcptr, Condition, Coptr, Infoptr, Continue) options (non_quick); dcl Mcptr ptr; dcl Condition char (*); dcl Coptr ptr; dcl Infoptr ptr; dcl Continue bit (1) aligned; call UNLOCK_RESET; Continue = "1"b; end PAGE_FAULT_ERROR; %page; %include pvte; %page; %include stock_seg; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: volmap_util: Address XXXXXX out of paging region on dskX_NN. S: $crash T: During a physical volume scavenge M: The scavenger attempted to remove an invalid address from the volume map. A: $recover Message: volmap_util: Invalid address XXXXXX on dskX_NN. S: $crash T: During a physical volume scavenge M: In attempting to deposit address XXXXXX on device dskX_NN, an invalid volume map offset was computed. A: $recover END MESSAGE DOCUMENTATION */ end volmap_util$free_address_for_scavenge; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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