" *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " PATCH - BOS command program to do core + drum patching " " " " THVV 4/68 " " " Last modified on 11/06/71 by N. I. Morris " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** equ dmpbufl,64 Length of dump buffer. include bosequ stx2 x2 tsx2 initint set up fault and int vectors arg execint tsx2 init_io initialize the iom routines tsx2 ttyinit init tty for requests arg ttyrequest tsx2 cvinit lda =h apnd "apnd" in A eaq apnd_org origin of appending package in QU tsx2 ldcom load the appending package tra x2 .. ldaq com|dbr grab dbr staq cmdbr eaa dmpbufl length of appending buffer in AU tsx2 getinit init appending package tra cycle and then read commands from cards execint: ttyrequest: cycle: tsx2 nextline get next input line again: ldx1 0,du lda arg rpt ncoms/2,2,tze cmpa comtab,1 ttf gotoit if found go szn punchsw should we punch card tze peek tsx2 punch tra peek ... else look some more gotoit: lda -1,1 rpd left x1, use it to get subr cana =o1,dl tze ptlb1 szn punchsw should we punch card tze ptlb1 tsx2 punch ptlb1: lda -1,1 tsx2 0,au may be subroutine tra cycle " " Peek commands. " 1. absadr -n- " 2. seg | loc -n- " 3. regnam " 4. bos command offset -n- " 5. regblk offset " 6. VOL -n- " 7. PHY -n- " 8. PART
-n- peek: tsx2 dotfill replace dot with old addr eax0 0 start arg index stz setsw no set tra common set: tsx2 dotfill eax0 1 skip set stc1 setsw common: stx0 dotstart remember where addr starts eax1 0 lda arg,0 rpt nads/2,2,tze cmpa addtab,1 ttf getadr if found go do ldx0 dotstart restore x0 after repeat " lda arg,0 is it to the bos area cmpa =h bos tnz notbos lda arg+1,0 if so, pickup bos command offset tsx2 search look up command tra qm .. als 6 ana =-1,dl cmpa arg+2,0 check bounds tze badoff tmi badoff lda arg+2,0 tmi badoff sta offset als 12-6 get sector number ana =o777777770000 ada com|1,7 and then dev addr stca devadd,74 lxl7 arg+2,0 and then get offset in sector anx7 =o77,du stx7 fetchout+1 eax0 3,0 tsx2 fetch_use_buffer set seg 1 to dmpbuf tra *+1 lda devadd is sector already in buffer lcq =1,dl cmpaq read_args tze bnr staq read_args no, mark new cont tsx2 rdsec and read nop tmp|0 nop "ignore errors bnr: tsx2 pcom do common stuff, print and patch tsx2 unfetch write buffer out tra werr tra mores " notbos: "check if argbos deal cmpa =h dev check if patching device tnz notdev eax0 1,0 step over "dev" tsx2 argbos arg dvt arg pnum tra notdev if error, must not be drum/disk stz pdmep clear map entry ptr eax7 0,al set count in X7 anx7 =o7777,du cmpx7 2,du a request for a Multics address ? tmi notmult if noyt then no PML tsx2 pd_check search for pdmap entry arg dvt arg pdmep tra *+1 notmult: stca devadd,74 else, save addr als 6 check offset ana =-1,dl cmpa arg,0 tmoz badoff szn setsw test for setting tze nomod no so skip setting modify bit in map lda pdmep pick up map entry ptr tze nomod if zero skip it tsx2 pd_modify go set modify bit in map entry tra *+1 nomod: lda arg,0 tmi badoff sta offset store for printing als 12-6 add in any small sectors ana =o777777770000 asa devadd lxl7 arg,0 get small sector offset anx7 =o77,du stx7 fetchout+1 eax0 1,0 make arg index right tsx2 fetch_use_buffer tra *+1 lda devadd and check if buffer already loaded ldq dvt cmpaq read_args tze dnr staq read_args if not same, mark new cont tsx2 rdev read sector arg dvt arg tmp|0 nop dnr: tsx2 pcom print and patch tsx2 unfetch write out buffer tra werr tra mores " notdev: eax7 0,0 collect_segname wants it in x7 tsx2 collect_segname see if name given cmpa =-1 if not, tze qm ... i want no part of it sta arg,0 save segment number ldq arg+1,0 see if segment | offset cmpq =h |" tnz absfet no, must be absolute add. ldq 0,dl clear the Q getoff: adlq arg+2,0 pick up offset canq =o777700,du check again for fence or alpha tnz badoff ... sta segno save for setting stq offset save for printing als 18 segment number in AU tsx2 getsdw get SDW for segment tra nowd tra nowd staq sdw save SDW ldq offset get offset qls 18 tsx2 apnd go get word. arg sdw tra nowd eax0 3,0 make argi right tsx2 pcom tsx2 unapnd write out buffer and set modified tra werr tra mores " absfet: lda arg,0 here for new page sta offset eax1 0,al anx1 =o77,du get offset in page als 18-6 Only high 18 bits used. sta fetchin store page number tsx2 fetch get page zero outbnds stx1 fetchout+1 eax0 1,0 tsx2 pcom tsx2 unfetch tra werr tra mores prfet: ldx2 -1,1 get loc'n in common for pr fetch cmpx2 prs,du are we pointing to a pr? tmi qm if not, cmpx2 prs+16+2,du not a legal request tpl qm .. ldaq com|0,2 get contents of desired pr arl 18 shift segno to AL qrl 18 and offset to QL tra getoff now go to add in offset " getadr: ldx0 dotstart restore x0 from repeat ldq arg+1,0 look at next argument cmpq =h |" is it up arrow? tze prfet fetch offset from pr contents eax0 1,0 tsx2 dotend lda -1,1 table points to reg, has fmt eax2 0,au eax3 0,al ldq com|0,2 get reg. from comm. region szn setsw type 3 or 5 tnz set1 peek or patch tra *+1,3 dispatch on format tra getfull tra getlh tra getrh tra getfull tra getinx tra getdbl getinx: arl 18 indexed get. save base in 6 sta temp eax0 1,0 make argi right tsx2 dotend lda arg+1 get offset cmpa =32,dl check size trc badoff ada temp ldq com|0,al get word from comm. seg getfull: stq old print full word tsx2 erpt acc '^g ^w' arg arg arg old tra cycle getlh: qrl 18 print left half getrh: anq =-1,dl or right stq old tsx2 erpt acc '^g ^o' arg arg arg old tra cycle getdbl: stq old ldq com|1,2 stq old+1 tsx2 erpt acc "^g ^w ^w" arg arg arg old arg old+1 tra cycle " set1: lda arg+2 new value tra *+1,3 index into format tra setfull tra setlh tra setrh tra orin tra setinx tra setdbl orin: stq temp ora temp tra setfull setinx: eax0 1,0 change mind about end of addr tsx2 dotend lda arg+2 get offset cmpa =32,dl check offset trc badoff als 18 ada -1,1 gen proper offset in common eax2 0,au ldq com|0,2 q now has old contents lda arg+3 a has new tra setfull do it. setlh: eax6 0,al patch quantity in l. h. stq new stx6 new lda new tra setfull setrh: eax6 0,al stq new sxl6 new lda new setfull: sta com|0,2 set new value sta new stq old szn com|quietsw tnz cycle tsx2 erpt print message acc '^g from ^w to ^w' arg arg+1 arg old arg new tra cycle setdbl: eax0 1,0 inc arg offset sta com|0,2 sta new stq old ldq com|1,2 lda arg+3 sta com|1,2 sta new+1 stq old+1 szn com|quietsw tnz cycle tsx2 erpt acc "^g from ^w ^w to ^w ^w" arg arg+1 arg old arg old+1 arg new arg new+1 tra cycle " dotend: stx0 dotlast here to remember args in addr dotstart: eax6 * points to start of addr eax7 0 copy from arg to dotl dotlp: lda arg,6 sta dotl,7 eax6 1,6 eax7 1,7 dotlast: cmpx6 *,du tmi dotlp stx7 dfe tra 0,2 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " dotfill: eax6 0 here to look for .'s eax5 0 and replace them with the saved string dfl1: lda arg,6 eax6 1,6 cmpa =h . if dot, copy dotl tnz dnfnd eax7 0 dfe: cmpx7 *,du tpl dfl1 lda dotl,7 sta dotemp,5 into temp list eax7 1,7 eax5 1,5 cmpx5 arglen,du tmi dfe dnfnd: sta dotemp,5 eax5 1,5 cmpx5 arglen,du tmi dfl1 eax7 0 now copy dotemp into arg eax6 0 processing + and - dfl2: ldq dotemp,7 lda dotemp+1,7 in case of + or - cmpq =h - tnz *+3 neg tra *+3 if -, neg and then add cmpq =h + tnz dfpl1 asa arg-1,6 add to previous number eax7 2,7 tra dfpl2 dfpl1: stq arg,6 else, store old eax6 1,6 eax7 1,7 dfpl2: cmpx7 arglen,du tmi dfl2 lca =1,dl fill out with -1 dffill: cmpx6 arglen,du tpl dfend sta arg,6 eax6 1,6 tra dffill dfend: mlr (),() copy args into darg as well desc9a arg,4*(arglen+1) desc9a darg,4*(arglen+1) tra 0,2 return to caller bss dotemp,arglen bss dotl,arglen " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " pcom: stx2 pcx2 here to do actual peek or patch tsx2 dotend close out addr list szn setsw tnz pcoms lda fetchout,* get word sta old to print tsx2 erpt acc '^o ^w' arg offset arg old lda arg,0 look for count of prints sba =1,dl tmoz cycle sta arg,0 reduce count tra bmpadd and tgo to bump addr pcoms: lda fetchout,* get old sta old lda arg,0 get new sta new sta fetchout,* szn com|quietsw don't print if on tnz pcx2 tsx2 erpt acc '^o from ^w to ^w' arg offset arg old arg new pcx2: tra * werr: tsx2 erpt error writing acc 'io error patching' tra cycle " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " mores: lda arg+1,0 if patch, get possible next patch cmpa =-1 tze cycle eax7 0,0 if any, move down list morel: lda arg+1,7 sta arg,7 cmpa =-1 tze bmpadd eax7 1,7 tra morel bmpadd: ldx7 dotlast move up dot addr aos arg-1,7 ldx7 dfe and addr in list aos dotl-1,7 tra again and scan line again " " DBR absaddr - bound/stack newdbr: null lda arg+1 get dbr val cana =o777700,du check for alpha or too big tnz qm ... als 12 Shift into DBR.ADDR position. ora sdw.df,dl Turn ON F bit. sta cmdbr Store as DBR word 1. lda arg+2 Get BOUND, U, & STACK fields. cmpa =-1 Check to see if arg given. tze oldval If not DBR word 2 is unchanged. ana =o377770207777 Clear all but BOUND, U, & STACK. ora =o000005,du Turn ON R & W bits. sta cmdbr+1 Store as DBR word 2. oldval: tsx2 getinit reset segnos of sst, etc tra cycle " FILL - set new parameters gofill: tsx2 fill call fill proc tra qm tra cycle " " SEGNO - Print Segment Number. psegno: eax7 1 look at first arg tsx2 collect_segname look up segment name cmpa =-1 did we find it? tze qm if not, complain sta segno save segment number tsx2 erpt print it out acc "^o" arg segno tra cycle that's all " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " NAME - Print Segment Name. psegnm: tra *+1 execute following code once only lda =h sstn load SST name table filler eaq sstn_org .. tsx2 ldcom .. tra *+2 if successful, tsx2 sstn_org fill SST name table tsx2 initsstnt initialize SST name table primitives eax7 *+2 avoid initialization again stx7 psegnm .. lda arg+1 get segment number als 18 in AU tsx2 getsdw get SDW for segment tra qm abort if error tra qm .. tsx2 getsstntname try to get name from SST name table desc6a line,84 tra *+2 if failure, try the SLT tra psegnm1 go print the name lda arg+1 get segment number again als 18 in AU tsx2 getsltname get name for SLT desc6a line,84 tra qm abort if error psegnm1: scm (),(du) look for first blank desc6a line,84 bci " " arg temp lda temp offset of blank in A ldq 84,dl remaining length in Q sbq temp .. mlr (),(al,rl),fill(20) blank out rest of string desc6a *,0 desc6a line,ql tsx2 type print out segment name zero line,14 tra cycle " " DUMP - chains to dumper " QUIT - returns to BOS " GO - restarts core image godump: cntin: lda -2,1 get argument tra *+2 join common exit code quit: lca =1,dl fence, no chaining szn punchsw if punching tze x2 sta temp tsx2 space punch blank cards tsx2 punch lda temp x2: eax2 * if so, return tra mem|1,2 punchset: stz punchsw punch on/off lda arg+1 cmpa =h on tnz *+3 stc1 punchsw tra cycle tsx2 space feed out cards tsx2 punch tra cycle punchsw: oct 0 " addtab: null bci " a" vfd 18/regs+4,18/full_word bci " q" vfd 18/regs+5,18/full_word bci " e" vfd 18/regs+6,18/full_word bci " tr" vfd 18/regs+7,18/full_word bci " x0" vfd 18/regs+0,18/left_half bci " x1" vfd 18/regs+0,18/right_half bci " x2" vfd 18/regs+1,18/left_half bci " x3" vfd 18/regs+1,18/right_half bci " x4" vfd 18/regs+2,18/left_half bci " x5" vfd 18/regs+2,18/right_half bci " x6" vfd 18/regs+3,18/left_half bci " x7" vfd 18/regs+3,18/right_half bci " pr0" vfd 18/prs,18/double_word bci " pr1" vfd 18/prs+2,18/double_word bci " pr2" vfd 18/prs+4,18/double_word bci " pr3" vfd 18/prs+6,18/double_word bci " pr4" vfd 18/prs+8,18/double_word bci " pr5" vfd 18/prs+10,18/double_word bci " pr6" vfd 18/prs+12,18/double_word bci " pr7" vfd 18/prs+14,18/double_word bci " ap" vfd 18/prs,18/double_word bci " ab" vfd 18/prs+2,18/double_word bci " bp" vfd 18/prs+4,18/double_word bci " bb" vfd 18/prs+6,18/double_word bci " lp" vfd 18/prs+8,18/double_word bci " lb" vfd 18/prs+10,18/double_word bci " sp" vfd 18/prs+12,18/double_word bci " sb" vfd 18/prs+14,18/double_word bci " psr" vfd 18/scu,18/full_word bci " ilc" vfd 18/scu+scu.ilc_word,18/full_word bci " dsbr" note difference vfd 18/dbr,18/double_word bci " mcm" vfd 18/mcm,18/indexed bci " int" vfd 18/intrpts,18/full_word bci " orint" vfd 18/intrpts,18/ored equ nads,*-addtab bool full_word,0 bool left_half,1 bool right_half,2 bool ored,3 bool indexed,4 bool double_word,5 " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "/ comtab: null bci " go" zero cntin,0 bci " set" zero set,1 bci " dump" zero godump,0 bci " dbr" zero newdbr,1 bci " quit" return to BOS zero quit,0 bci " fill" zero gofill,1 bci " punch" zero punchset,0 bci " name" zero psegnm,0 bci " segno" zero psegno,0 equ ncoms,*-comtab " " error rtnes qm: tsx2 erpt type "?" acc '^g' arg =h!!???? tra cycle back to work. outbnds: lda fetchin get bad abs addr arl 12 sta fetchin tsx2 erpt acc '^w out of bounds' nop fetchin tra cycle nowd: tsx2 erpt acc 'loc not in core' tra cycle badoff: tsx2 erpt acc 'bad offset' tra cycle " "space spacefill line space: lda =h " ldq sptally0 init tallyword stq sptally spaceloop: null sta sptally,id store space word ttf spaceloop tra 0,2 return sptally: oct 0 sptally0: vfd 18/line,12/14 " even sdw: oct 0,0 segno: oct 0 offset: oct 0 setsw: oct 0 devadd: zero 0,1 dvt: oct 0 pdmep: oct 0 pnum: oct 0 new: oct 0,0 last: oct 0 old: oct 0,0 temp: oct 0 " " INCLUDE FILES. include bos_sdw include bos_ptw include mc include fill " include bos_page_info include sst include aste include sstnt include bos_sstnt_man include segname include apnd_equ include sstn_equ include bos_tv include bos_common end " " " ----------------------------------------------------------- " " " " Historical Background " " This edition of the Multics software materials and documentation is provided and donated " to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. " as a contribution to computer science knowledge. " This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, " Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull " and Bull HN Information Systems Inc. to the development of this operating system. " Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), " renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership " of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for " managing computer hardware properly and for executing programs. Many subsequent operating systems " incorporated Multics principles. " Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., " as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . " " ----------------------------------------------------------- " " Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without " fee is hereby granted,provided that the below copyright notice and historical background appear in all copies " and that both the copyright notice and historical background and this permission notice appear in supporting " documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining " to distribution of the programs without specific prior written permission. " Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. " Copyright 2006 by Bull HN Information Systems Inc. " Copyright 2006 by Bull SAS " All Rights Reserved " "