" *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " BOSTAP - Command to Generate BOS System Tape from BOS Directory. " Bernard Greenberg, 11/01/75 " Modified by Noel I. Morris, 3/19/76 " Modified 9/79 by R.J.C. Kissel to handle 6250 bpi tapes. " Modified 7/81 by J. A. Bush to merge writape.incl.alm into bostap " and copy the boslab file from the command directory, for new BOS " tape labels. " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** name bostap include bosequ " include slte " stx2 x2 do the honors tsx2 init_io tsx2 ttyinit arg x2 ldx2 x2 ldx7 mem|0,2 get arg word lda mem|1,7 get arg 1 cana -1,du alph or fence? tnz *+3 tra if tape is not given eax7 1,7 skip arg tra *+2 tape no is in a lda 1,dl if none, we give one als 35-23 tape #'s go in strange places sta tapeno arglp: lda mem|1,7 get an arg cmpa =-1 end of args? tze argend cmpa =h brief don't report? tnz *+3 stc1 bfsw tra nxtarg cmpa =hruncom write runcoms only? tnz *+3 stc1 runcomsw tra nxtarg eax1 dentb process any density argument rpt (dentbend-dentb)/2,2,tze search for arg cmpa 0,1 ttn badreq lda tapeden got one, make sure no others tnz denerr it was already set lda -1,1 get the right command sta tapeden tra nxtarg badreq: sta lose_temp tsx2 erpt acc "bostap: unknown request: ^g." arg lose_temp tra x2 denerr: tsx2 erpt acc "bostap: only one density may be specified." tra x2 nxtarg: eax7 1,7 tra arglp " argend: "All args gotten lda geastab get the translate set up sta geas1 sta geas2 sta geas3 eaa 32768 length of segment in AU tsx2 makesdw make buffer segment following program tra x2 Gave up on wiping out core. staq ds|tmp*2 store completed SDW cams 0 for good luck lda tapeden set the default density if not already set tnz *+3 lda =o60,dl 800 bpi default sta tapeden tsx2 scan_dir find the bos label in the cmd dir arg must_be It must be there, if not complain arg =hboslab tra 0,2 tsx2 writape_init the "boslab" file is in tmp|0 desc9a bos_tape_label,16 tra no_init Error initializing tape stc1 lblsw we have written label szn runcomsw runcoms only? tze do_all if not, write everything tra do_runcoms no_init: tsx2 erpt acc "bostap: Could not initialize tape." tra x2 " " " Write out runcom files only. " do_runcoms: tsx2 scan_dir search dir arg is_it_bcd for BCD files arg 0 tra *+1 tra finish_up then finish up tape " " Write out all files. " do_all: tsx2 scan_dir write out fwload arg must_be this particular judge arg =hfwload tra 0,2 tsx2 scan_dir arg must_be arg =h util tra 0,2 not got, not so hot. tsx2 scan_dir write out all firmware arg is_it_firmware arg 0 no meaning here tra *+1 end of dir is ok tsx2 scan_dir do all else arg do_all_else arg 0 tra *+1 finish_up: tsx2 writape_end alles ist getan, so gehe. x2: eax2 *-* lca 1,dl good fences etc. tra mem|1,2 bfsw: oct 0 n/z if not to write mess runcomsw: oct 0 n/z if to write only runcoms lblsw: oct 0 n/z when not writing tape label " " " tsx2 scan_dir " arg judge, who passes on what is at com|0,7 " arg something he might want to see, passed in a " tra end_of_dir default return to judge is 0,2 scan_dir: stx2 scan_dir.x2 eax7 cmdlst start at the top scan_dir.lp: szn com|0,7 something here? tze scan_dir.next stx7 scan_dir.x7 save this interesting thing " " Invoke specific judge " ldx2 scan_dir.x2 lda 1,2* get param tsx2 0,2* call the guy tra scan_dir.fine guy liked it, wants to give up scan_dir.x7: eax7 *-* scan_dir.next: eax7 2,7 cmpx7 dir+dirlen,du are we thru? tmi scan_dir.lp "There must have been at least 1 thing in dir, hence x2 at 2d return ldx7 scan_dir.x2 get caller parms lda 1,7* get parm for error mess tra 2,7 go back into judge or finish scan_dir.x2: scan_dir.fine: "the judge liked 1 thing. eax2 *-* tra 3,2 " " " Judges I, II, III, & IV. " " " Judge who only likes thing in A " must_be: cmpa com|0,7 tze write_file return at 0,2 to scan_dir tsx2 1,2 try another, friend sta lose_temp tsx2 erpt acc "cannot find ^g." arg lose_temp tra x2 lose_temp:oct 0 " " Judge who likes firmware " is_it_firmware: ldq com|1,7 canq firmware_bit,dl It is better to light a candle tze 1,2 than to curse the dark. eax2 1,2 set good return tra write_file " " Judge who likes only runcoms and CONFIG decks " is_it_bcd: ldq com|1,7 get info word canq runcom_bit,dl is it BCD? tze 1,2 no, not interested eax2 1,2 set good return if so tra write_file get it out " " Judge who likes anything we haven't done yet " do_all_else: eaa -cmdlst,7 get comdlist offset arl 18+1 get bit index sztl (),(al),bool(05) descb *,0 descb bitlist,1 comparing against 1 tnz 1,2 not interested eax2 1,2 set good return tra write_file bitlist: bss ,5 bit map of commands done " " " Come here via tsx2 with X7 -> dirloc to write out a file " write_file: stx2 wf.x2 ldaq com|0,7 get dir goods staq dir_goods eaa -cmdlst,7 get dir offset arl 18+1 get bit index csl (),(al),bool(17) turn on bit for this command descb *,0 descb bitlist,1 lda dir_goods+1 get address of file cana runcom_bit,dl runcom? tnz runcom_to_ascii convert into ASCII file ana =o777777770777 mask out extraneous bits tsx2 rdsec arg tmp|0 tra fatal_read_error szn lblsw are we writing tape label? tze wf.x2 return if yes ldq dir_goods+1 anq =o777,dl mpy 36*64,dl stq slte+slte.bit_count_word easy case, BOS pgm " " We have all the stuff in tmp, the bc is in bit_count. " wf.cv_name: lda dir_goods tsx2 ljust sta wf.temp tsx2 stripg desc6a wf.temp,6 get real length mvt (rl),(),fill(20) desc6a wf.temp,al desc9a name,32 geas1: arg *-* ldq dir_goods+1 is this firmware file? canq firmware_bit,dl .. tnz adjust_firmware if so, get real length and name canq runcom_bit,dl is this runcom? tze set_namelen if not, just set length of name mlr (),(al) desc9a .ascii,6 desc9a name,6 ada 6,dl set_namelen: sta namelen put in header record ldq slte+slte.bit_count_word adlq 35,dl div 36,dl stq wf.temp save object len orq 1,du upper cw bit stq sgcw szn bfsw should we report? tnz no_report tsx2 erpt say what we are doing acc "^g ^o" arg dir_goods arg wf.temp no_report: tsx2 writape_data arg =v36/slthdrlen arg slthdrbegin tsx2 writape_data arg wf.temp length arg =its(tmp,0,n),* wf.x2: eax2 *-* tra 0,2 done " runcom_to_ascii: era runcom_bit,dl turn off runcom bit tsx2 rdsec read in the runcom file arg bf|0 into 1024-word buffer tra fatal_read_error eax1 0 X1 is input character offset eax0 0 X0 is input word offset eax3 0 X3 is output character offset runcom_loop: ldq bf|0,0 get control word cmpq =-1 end of runcom? tze runcom_end if so, tra qrl 18 isolate word count mpy 6,dl compute character count mlr (pr,rl,x1),(),fill(20) copy the runcom line desc6a bf|1,ql desc6a line,80 qls 18 character count in QU stq wf.temp store it adx1 wf.temp bump input character offset adx1 6,du be sure to include control word adx0 bf|0,0 bump input word offset adx0 1,du include control word itself tsx2 stripg strip trailing blanks from line desc6a line,80 mvt (rl),(pr,rl,x3) copy into output as ASCII desc6a line,al desc9a tmp|0,al geas2: arg *-* als 18 character count in AU sta wf.temp store adx3 wf.temp bump output character offset mlr (),(pr,x3),fill(012) finish off line with NL char desc9a *,0 desc9a tmp|0,1 adx3 1,du bump output character offset tra runcom_loop and loop runcom_end: eaq 0,3 output character count in QU qrl 18 shift to QL mpy 9,dl compute bit count stq slte+slte.bit_count_word save the bit count tra wf.cv_name now, take care of segment name " adjust_firmware: ldq slte+slte.bit_count_word get bit count of file div 36,dl compute word count eax7 -64,ql go back at least 64 words lda =hmpcbot and look for MPCBOT eax7 1,7 step until found cmpa tmp|0,7 .. tnz *-2 .. eaq 1,7 word count in QU qrl 18 shift to QL mpy 36,dl compute real bit count stq slte+slte.bit_count_word and save lda tmp|-9,7 get name of device sta wf.temp save temporarily mrl (),(),fill(040) move the name down 10 places desc9a name,4 desc9a name,14 mlr (),() insert prefix of "fw." desc9a fw.,3 desc9a name,3 mvt (),(),fill(33) copy device name plus "." desc6a wf.temp,6 desc9a name(3),7 geas3: arg *-* lda 14,dl set new length of name tra set_namelen .. " fatal_read_error: tsx2 erpt acc "Fatal disk error reading command ^g." arg dir_goods tsx2 tprew tra x2 dentb: "Density argument table bci " d=556" oct 61 bci " d=800" oct 60 bci "d=1600" oct 65 dentbend: wf.temp: oct 0 even dir_goods:bss ,2 stuff from directory .ascii: aci ".ascii" fw.: aci "fw." bos_tape_label: aci "BOSTAP_Tape",16 " " SLT template, with MST header word " oct 0 TEMP DEBUG slthdrbegin: hcw: zero 0,slthdrlen-2 2 for 2 c.w.'s slte: bss ,4 oct 1 # of names namelen: oct 0 size of name name: aci " ",32 the name itself sgcw: oct 0 cw for seg equ slthdrlen,*-slthdrbegin " " End of template " writape.incl.alm merged into bostap.alm by J. A. Bush 7/28/81 for " new MST label format. " Borrowed from ntape.incl.alm by Bernard Greenberg, 11/01/75 " Modified 5/79 by R.J.C. Kissel to use a user specified set density command for writing. equ tpn,1024 length of tape record bool lhdr,0 Location of v1 label record header bool v2hdr,10 Location of v2 label record header bool ltlr,2010 Location of label record trailer bool reel_id,20 Location of reel_id field within label record " " tsx2 writape_init to open tape " desc9a label,n writape_init: stx2 optw.x2 stx3 optw.x2+1 stz tperrors no errors tsx2 itapew set up for writing arg tapeno arg tapeden tra bad_den error return lda phyrecl*4,dl set length to move mlr (pr,rl),(rl) copy tape label into label buffer desc9a tmp|0,al desc9a labbuf,al eax6 labbuf eax3 0 assume v1 label ldx7 labbuf load first word of label cmpx7 4,du is it a v2 label? tnz v1lbl no, version 1 label eax6 v2hdr,6 eax3 v2hdr set v2 hdr offset v1lbl: stx6 lcksum+1 set label address in cksum call rscr 4*8 read the clock sta labbuf+lhdr+1,3 USE for unique ID stq labbuf+lhdr+2,3 .. sta labbuf+ltlr+1 .. stq labbuf+ltlr+2 .. sta hdr+1 use for unique ID in normal hdrs & tlrs too stq hdr+2 .. sta tlr+1 .. stq tlr+2 .. eax6 labbuf+reel_id,3 develop addr of reel # stx6 set_lab+2 and store ldx2 optw.x2 restore X2 set_lab: mlr (id),(),fill(040) arg 0,2 desc9a 0,32 lcksum: tsx2 tpcks_new compute checksum zero 0,labbuf+ltlr sta labbuf+lhdr+6,3 eax3 tlw_retry set retry address tlw_retry: tsx2 tprew make sure we are on BOT wlab: tsx2 xio_wait write the label record vfd 18/labbuf,12/phyrecl zero tapeno,13 write tape binary tra check_tape_status stz tpfirsterr reset first error switch aos tlr+6 good write bump record nos lda =1,du asa hdr+3 stz tbufoff start next buffer at 0 lda tpn,dl sta tbufleft tsx2 tpweof write label EOF optw.x2: eax2 *-* eax3 *-* tra 2,2 Normal return bad_den: tsx2 erpt acc "writape_init: Could not set density using ^w." arg tapeden ldx2 optw.x2 Get stroed x2 tra 1,2 Error return " " " Subroutine to move data to tape buffer " " tsx2 writape_data " arg length_word " arg address " writape_data: stx2 ws.x2 save exit lda 0,2* get length of request sta ws.rql epp xs1,1,2* get address of request ws.loop: cmpa tbufleft will it fit in current record? tmoz *+2 if not, lda tbufleft take as much as will fit ldq tbufoff get buffer offset lls 2 make chars mlr (pr,rl),(rl,ql) desc9a xs1|0,al move from xs1 desc9a tpbuf,al to buffer a9bd xs1|0,al increment data arl 2 get word count in AL asa tbufoff bump buffer offset neg 0 complement asa ws.rql decrement request length asa tbufleft and remaining buffer length tpnz ws.x2 if room left, just return eax7 tpn*36 set up record stx7 hdr+4 stz hdr+5 no error, label, or end tsx2 tpwrit write it out lda ws.rql get remaining left of request tpnz ws.loop continue writing ws.x2: eax2 *-* tra 2,2 return ws.rql: oct 0 " " End of logical tape. " " tsx2 writape_end to close out tape writape_end: stx2 tpeot.x2 here to end a tape stx0 tpeot.x2+1 ldq tbufoff lda tbufleft lls 2 get char length and offset als 0 set indicators from A tze tpeot.1 no mlr if nothing to move mlr (),(rl,ql),fill(777) pad rest of record with 1's desc9a *,0 desc9a tpbuf,al tpeot.1: lls 18 move to uppers mpy 36/4,dl compute bits in last record stcq hdr+4,70 and place in tape header stz hdr+5 tsx2 tpwrit write record tsx2 tpweof write eof eax7 0 then write end of tape label stx7 hdr+4 reset bit count lda =o500000,du set end of tape sta hdr+5 eaa tpn*4 character length of tape buffer in AU mlr (),(rl),fill(777) fill the buffer with 1's desc9a *,0 desc9a tpbuf,au tsx2 tpwrit write EOR record eax0 3 write 3 eofs tsx2 tpweof eax0 -1,0 tpl *-2 tsx2 dotape set file protect oct 62 tra *+1 tsx2 tprew Rewind, dont unload tsx2 erpt print total errors on tape acc "tape errors = ^d." arg tperrors tpeot.x2: eax2 *-* eax0 *-* tra 0,2 " tpwrit: stx2 tpwx2 here to write a record stx3 tpwx2+1 lda hdr+4 set total number of bits arl 18 asa tlr+3 tprewt: lda hdr+1 bump the unique ID ldq hdr+2 .. adl 1,dl by 1 sta hdr+1 replace in header stq hdr+2 .. sta tlr+1 and in trailer stq tlr+2 .. tsx2 tpcks_new compute checksum zero hdr,tlr sta hdr+6 eax3 tprewt set error retry address tsx2 xio_wait vfd 18/phyrec,12/phyrecl zero tapeno,13 write tape binary tra check_tape_status stz tpfirsterr reset first error switch aos tlr+6 good write bump record nos lda =1,du asa hdr+3 ldx7 hdr+3 is it time to write eof cmpx7 =o200,du tnz *+2 tsx2 tpweof stz tbufoff start next buffer at 0 lda tpn,dl sta tbufleft tpwx2: eax2 *-* eax3 *-* tra 0,2 " " " Error routine for tpwrit " check_tape_status: staq tpstatus szn tpfirsterr First error this try. tnz tpquiet If not, skip error message. tsx2 erpt acc "writape: tape status = ^w." arg tpstatus tpquiet: lda tpstatus Status in A. ldq =o647777007777 See if device attention. cmk =o020000,du .. tze 0,3 Retry until attention condition goes away. aos tperrors tpwbad: lda =o14,du set retry flag orsa hdr+5 aos hdr+5 and count tra 0,3 " tpweof: stx2 tpwex2 here to write eof tsx2 dotape oct 55 wef tra *-2 try again if error aos tlr+5 bump file count aos hdr+3 eax7 0 stx7 hdr+3 zero record count tpwex2: tra * tprew: stx2 rewx here to rew log tape stz hdr+3 reset record and file counts stz tlr+3 stz tlr+5 stz tlr+6 tsx2 dotape oct 70 rewind tape tra *-2 rewx: tra * " tsx2 dotape to perform non-data transfer operation " oct command " tra error dotape: stx2 dx lda 0,2 stca do_command,01 tsx2 xio_wait zero 0,0 do_command: zero tapeno,*-* tra dobad dx: eax2 * tra 2,2 dobad: ldx2 dx tra 1,2 " " tsx2 tpcks_new to compute tape checksum tpcks_new: "See MPM Ref. Data 5.3 stx0 tpckx0 X0 gets clobbered by RPD ldx7 0,2 routine to compute multics checksum lxl6 0,2 X6 is trailer pointer eax5 1 X5 is shift index ldi =o4000,dl lda =0,dl odd; rpda 6,1 do the header awca 0,7 alr 0,5 awca 1,7 get the last word alr 0,5 odd; rpda 8,1 do the trailer awca 0,6 alr 0,5 awca =0,dl get any remaining carry tpckx0: eax0 * restore X0 tra 1,2 " " Storage and Constants. tbufleft: oct 0 number of words left in phys record tbufoff: oct 0 next available word in buffer tapeno: bss ,1 current tape handler # tapeden: oct 0 contains the density setting device command tpfirsterr: bss ,1 nonzero after first error on a record tpstatus: bss ,1 tperrors: bss ,1 count of errors on tape " " Tape Buffer " eight phyrec: hdr: oct 670314355245 phy rec header vfd 72/0 vfd 18/0,18/0 phyrec,phyfil vfd 18/0,18/36*tpn ndata bits vfd 36/0 flags vfd 36/0 checksum oct 512556146073 bss tpbuf,tpn tlr: oct 107463422532 vfd 72/0 mul id vfd 36/0 ndata bits of log tape vfd 36/0 padding bits vfd 18/0,18/0 reel number,phy file in log tape vfd 36/0 record in log tape oct 265221631704 equ phyrecl,*-phyrec labbuf: bss ,phyrecl buffer for label record " include bos_sdw include bos_tv include bos_common bss patch,150 this things gonna work! 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 " "