" *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " PTPKG - Print Package for Producing On-line Dumps. " Modified 9/79 by R.J.C. Kissel try 800, 1600 and 6250 bpi densities. " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " Last modified 2/11/81 by Sherman D. Sprague for support of tst3bt name ptpkg equ words_per_line,22 Num words per line. include bosequ include pt_equ " org printon tra printon_ org tapeon tra tapeon_ org wteof tra wteof_ org space tra space_ org headform tra headform_ org print tra print_ org ptblock tra ptblock_ org initprint tra initprint_ org print_edited tra print_edited_ org ptbfirst oct 0 org ptsegno zero 0 org pthdr bci ' ',6*words_per_line " " Entry to turn on printer. printon_: stx2 pox "may be called stc1 prtsw "all set, set switches stz prtno reset channel number tsx2 initprint pox: tra * "return "entry to turn on tape dump tapeon_: stx2 tox lda darg+1 "get tape number in decimal tpnz *+2 "if all ones, use one lda =1,dl als 12 stca tapeno,04 "store in tape channel number stz prtsw tsx2 itapew arg tapeno arg tapeden "try 800 bpi tra try1600 Error return tra tox Normal return try1600: sta st800 Save status lda =o65,dl Try 1600 bpi sta tapeden tsx2 itapew arg tapeno arg tapeden tra try6250 Error return tra tox Normal return try6250: sta st1600 Save status lda =o41,dl sta tapeden tsx2 itapew arg tapeno arg tapeden tra denerr Error return tox: tra * Normal return denerr: sta st6250 Save status tsx2 erpt acc "ptpkg: Unable to set density. (800 status=^w, 1600 status=^w, 6250 status=^w)." arg st800 arg st1600 arg st6250 tra tox Return st800: oct 0 st1600: oct 0 st6250: oct 0 " " Entry to Decide if tape or printer in use. torp: stz pterrsw clear error switch szn prtsw printing? tze 0,2 if not, return to first arg szn prtno printing. Do we know channel? tnz 1,2 if so, return to second arg stx2 torpx2 save X2 tsx2 getprt get a printer channel sta prtno and save torpx2: eax2 * tra 1,2 " "entry to write eof wteof_: stx2 wtex2 tsx2 torp "decide if tape or printer tra eoftp tra eofpt eoftp: ldx1 =5,du wteof_write: tsx2 xio_wait zero zero tapeno,45 "write eof commnad tra wteof_write sbx1 =1,du tnz wteof_write tsx2 xio_wait "and unload tape zero zero tapeno,58 tra check_tape_status tsx2 printon go back to printer tra wtex2 eofpt: ldx1 =6,du "eject paper ejl: tsx2 xio_wait zero zero prtno,51 tra printerr sbx1 =1,du tnz ejl "do it 10 times wtex2: tra * " " stc1 ptbfirst before first call " tsx2 ptblock to print n word block " zero fetchout,n ptblock_: stx2 ptbx2 "save xr stx0 ptbx2+1 sprp5 ptsavp5 ldx7 0,2 stx7 ptbiw lxl0 0,2 "if only 8 words, dont print addrs stx0 ptbcount stz ptbsupno cmpx0 =9,du tpl *+2 stc1 ptbsupno eax0 0 "word counter epp5 ptbiw,* "pr5 -> data to be printed szn ptbfirst If 1st call, skip check for repeated lines tze ptbloop stz ptbsup stz ptbfirst stc2 ptbtmp insure that first line is printed tra *+2 ptbloop: stz ptbtmp clear duplicate switch eaa prtflt sta wantflt,* and get faults cmpc (pr),() compare against last desc9a pr5|0,8*4 desc9a ptbold,8*4 tze ptb1 stc2 ptbtmp set non-zero if different mlr (pr),() copy data into old desc9a pr5|0,8*4 desc9a ptbold,8*4 ptb1: stz wantflt,* faults now stop szn ptbtmp any different? tze ptbsame if not, tra mlr (),(),fill(20) "blank out most of line desc6a *,0 desc6a line+3,(words_per_line-3)*6 eaa 0,0 "get block location tsx2 octwd szn ptbsupno "if not to print locs tze *+3 ldq line+2 lls 12 ldq =h " "and store in line szn ptbsup tze *+3 stz ptbsup "if suppressed lines, add * ldq =h * " lrl 12 stq line+2 eax7 0 "here to format and convert line eax5 0 ptbcl: mvt (x5),() "unpack and translate desc6a ptbold,6 desc9a ptbword,6 arg octtab mlr (),(x7),fill(20) "move into line and pad with blanks desc4a ptbword,12 desc6a line+3,14 eax7 14,7 "step offset 14 chars eax0 1,0 "step to next word ptbcount: cmpx0 *,du tpl ptbout eax5 6,5 "step to next word cmpx5 8*6,du tmi ptbcl ptbout: tsx2 print tra ptbend ptbsame: stc1 ptbsup "same, suppress line eax0 8,0 "skip words ptbend: epp5 pr5|8 cmpx0 ptbcount tmi ptbloop tsx2 check_status "poll for status arg =0 tra *+2 tra *+1 ptbx2: eax2 * "restore and return eax0 * lprp5 ptsavp5 tra 1,2 prtflt: sreg ptbregs save regs lda fltscu+scu.fault_data_word here for fault in ptblock ana scu.fi_num_mask,dl test for parity fault cmpa =o22,dl tnz * if not, loop absa ptbiw,* get absolute address ldq 0,dl lrl 12+18 adl ptbiw+1 lls 18 sta ptbo store abs loc tsx2 erpt print error message acc 'memory parity at ^o, word ^w' arg ptbo arg ptbregs+4 a reg lreg ptbregs restore and return tra ptb1 ptsavp5: bss ,1 ptbo: oct 0 ptbsup: oct 0 ptbtmp: oct 0 ptbsupno: oct 0 ptbiw: arg *,* ptbword: bss ,2 octtab: vfd 5/0,4/0,5/0,4/1,5/0,4/2,5/0,4/3,5/0,4/4,5/0,4/5,5/0,4/6,5/0,4/7 vfd 5/1,4/0,5/1,4/1,5/1,4/2,5/1,4/3,5/1,4/4,5/1,4/5,5/1,4/6,5/1,4/7 vfd 5/2,4/0,5/2,4/1,5/2,4/2,5/2,4/3,5/2,4/4,5/2,4/5,5/2,4/6,5/2,4/7 vfd 5/3,4/0,5/3,4/1,5/3,4/2,5/3,4/3,5/3,4/4,5/3,4/5,5/3,4/6,5/3,4/7 vfd 5/4,4/0,5/4,4/1,5/4,4/2,5/4,4/3,5/4,4/4,5/4,4/5,5/4,4/6,5/4,4/7 vfd 5/5,4/0,5/5,4/1,5/5,4/2,5/5,4/3,5/5,4/4,5/5,4/5,5/5,4/6,5/5,4/7 vfd 5/6,4/0,5/6,4/1,5/6,4/2,5/6,4/3,5/6,4/4,5/6,4/5,5/6,4/6,5/6,4/7 vfd 5/7,4/0,5/7,4/1,5/7,4/2,5/7,4/3,5/7,4/4,5/7,4/5,5/7,4/6,5/7,4/7 eight bss ptbregs,8 bss ptbold,8 "last 8 words " " tsx2 space spacefill line space_: mlr (),(),fill(20) "fill with blanks desc6a *,0 desc6a line,words_per_line*6 stc1 ptbfirst "don't check for dup line tra 0,2 "return " "printing subroutines " tsx2 print prints line print_: lda printone,dl get print cmd print_merge: stca print_cmd_loc,01 stx2 pretn "save return tsx2 torp "decide tape or printer tra nopa tsx2 xio_wait " Print line. vfd 18/line,12/words_per_line "words_per_line words beginning at line print_cmd_loc: zero prtno,*-* "print and slew one line tra printerr " Keep trying until it works. tra no_tape nopa: mlr (),() "copy line with carriage control desc6a pagectl(5),words_per_line*6+1 "so that it starts on word boundary desc6a tbuff,words_per_line*6 tsx2 xio_wait "write bcd record vfd 18/tbuff,12/words_per_line "include page control char zero tapeno,12 tra check_tape_status Bad status, could be end of tape. no_tape: lda =h " Set page control word. sta pagectl reset page control to one space aos prlinecnt "update line count lda prlinecnt "check for end of page cmpa prmaxline tpl *+2 "need new page pretn: tra * "return tsx2 headform tra pretn print_edited_: lda printone_edited,dl tra print_merge " " tsx2 headform slew to top of page headform_: stc1 ptbfirst Don't supress dup lines stx2 headretn tsx2 torp " Decide tape or printer tra noph tsx2 xio_wait oct 0 zero prtno,skiphead "slew to new page tra printerr "if error retry noph: lda =2,dl sta prlinecnt "set line count lda =h " sta pthdr+19 sta pthdr+20 sta pthdr+21 lda ptsegno "if printing a segment tze nosegnumber tsx2 octwd tsx2 bzel " supress leading zeros alr 6 " make line end with blank sta pthdr+21 lda =h s sta pthdr+19 lda =hegment sta pthdr+20 nosegnumber: btd (),() desc9a binpage,4 desc9ns pagenum,8 aos binpage mvne (),(),() " insert page number in output desc9ns pagenum+1(1),3 desc9a pgedit,4 desc6a pthdr+19,3 lda =h page " sta pthdr+18 szn prtsw "if printing tze nopb mlr (),(),fill(20) "copy header without carriage control desc6a pthdr(1),words_per_line*6-1 desc6a tbuff,words_per_line*6 tsx2 xio_wait vfd 18/tbuff,12/words_per_line "print heading zero prtno,printtwo "print and slew two lines tra printerr " Repeat until successful. tra tapesw_off nopb: tsx2 xio_wait "write header on tape vfd 18/pthdr,12/words_per_line zero tapeno,12 tra check_tape_status " Check for EOT or other status. tapesw_off: lda =0,dl sta pagectl Set for double space headretn: tra * "return " " tsx2 initprint initprint_: lda 1,dl sta binpage stz prlinecnt "reset line count tra 0,2 "return prlinecnt: oct 0 "currentline count prmaxline: dec 58 "max lines per page prtsw: oct 1 "normal to print prtno: bss ,1 "channel no of printer tapeno: bss ,1 "tape channel tapeden: oct 60 "set density command--800 bpi ptstat: bss ,1 "I/O status word pterrsw: bss ,1 "to suppress redundant errors bool printone,11 "print one line and slew one l bool printone_edited,31 "same, edited bool printtwo,12 "print and slew two lines bool skiphead,63 "slew to top of page bool wef,55 "write EOF on tape bool run,72 "rewind and unload tape binpage: oct 0 pagenum: aci "00000000" pgedit: vfd 9/lte+1,o9/20,9/mvzb+2,9/mvc+1 tbuff: bss ,words_per_line " check_tape_status: stx2 ctp_x2 stx1 ctp_x2+1 sta ptstat ana =o174000,du cmpa =o034000,du " Check for data alert - end of tape. tnz taperr " Not EOT, repeat xio_move call. eax1 5-1 " Write 5 EOF's. ctpeof: tsx2 xio_wait zero zero tapeno,wef " Write EOF - 55 octal. tra *+1 sbx1 1,du tpl ctpeof tsx2 xio_wait " Unload tape. zero zero tapeno,run " Rewind and unload - 72 octal. tra *-3 tsx2 erpt " Request next tape. acc "Tape full. Mount next tape." tsx2 itapew arg tapeno arg tapeden use 800 bpi ctp_x2: eax2 * eax1 * tra -1,2 " Write data record again anyway. taperr: szn pterrsw tnz ctp_x2 " suppress redundant messages stc1 pterrsw tsx2 erpt acc "tape error. status = ^w." arg ptstat tra ctp_x2 " printerr: szn pterrsw tnz printer0 stc2 pterrsw stop redundant errors stx2 ptex2 sta ptstat tsx2 erpt acc "printer error. status = ^w." arg ptstat ptex2: eax2 * lda ptstat status in A printer0: ldq =o607777777777 mask in Q cmk =o030000,du device data alert? tnz printer1 if not, skip following cana =o000200,du error before printing commenced? tze 3,2 if not, take normal return tra -1,2 printer1: cana =o2,du error during initiation? tze 3,2 no, take normal return tra -1,2 " include mc include eis_micro_ops 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 " "