import "util" import "heap" export { writech, readch, unreadch, close, writestr, writeno, readno, readstr, readline, write, write_date_time, illegal_readch, illegal_writech, illegal_unreadch, tty, tape_open_r, tape_open_w, at_eof, abandon_input_line, writech_visible, iosb_ichar, iosb_bchar, iosb_ochar, iosb_close, iosb_unit, iosb_buffer, iosb_pos, iosb_size, iosb_extra_1, iosb_extra_2, iosb_extra_3, iosb_extra_4, iosb_extra_5, iosb_extra_6, iosb_extra_7, iosb_extra_8, sizeof_iosb, EOF } manifest { iosb_ichar = 0; iosb_bchar = 1; iosb_ochar = 2; iosb_close = 3; iosb_unit = 4; iosb_buffer = 5; iosb_pos = 6; iosb_size = 7; iosb_extra_1 = 8; iosb_extra_2 = 9; iosb_extra_3 = 10; iosb_extra_4 = 11; iosb_extra_5 = 12; iosb_extra_6 = 13; iosb_extra_7 = 14; iosb_extra_8 = 15; sizeof_iosb = 16; EOF = -999 } static { caphexstr = "0123456789ABCDEF" } manifest { tty_buff_words = 301, tty_buff_max = (tty_buff_words - 1) * 4 } static { tty_buffer = vec tty_buff_words } let readch_tty(iosb) be { if iosb ! iosb_pos < iosb ! iosb_size then { let c = byte iosb ! iosb_pos of iosb ! iosb_buffer; iosb ! iosb_pos +:= 1; resultis c } iosb ! iosb_pos := 1; iosb ! iosb_size := 0; while true do { let c; assembly { inch R1 jpos R1, PC+2 pause 10 jump PC-4 store R1, [] } if c = 8 then { if iosb ! iosb_size > 0 then { iosb ! iosb_size -:= 1; assembly { type 8 type ' ' type 8 } } loop } assembly { type [] } byte iosb ! iosb_size of iosb ! iosb_buffer := c; unless iosb ! iosb_size >= tty_buff_max do iosb ! iosb_size +:= 1; if c = '\n' then resultis byte 0 of iosb ! iosb_buffer } } let unreadch_tty(iosb) be { if iosb ! iosb_pos > 0 then iosb ! iosb_pos -:= 1 } let writech_tty(iosb, c) be { assembly { type [] } } let close_tty(iosb) be { } let tty = table readch_tty, unreadch_tty, writech_tty, close_tty, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; let pre_start() be { tty ! iosb_buffer := tty_buffer } let tapes = table 1, 0, 0, 0, 0, 0, 0, 0, 0; let find_free_tape_unit() be { for i = 1 to 8 do if tapes ! i = 0 then { tapes ! i := 1; resultis i } resultis err$software } let close_writetape(iosb) be { let r; if iosb ! iosb_pos /= 0 then { let r = devctl(dc$tapewrite, iosb ! iosb_unit, iosb ! iosb_buffer, iosb ! iosb_pos); if r < 0 then resultis r } r := devctl(dc$tapeunload, iosb ! iosb_unit); if r < 0 then resultis r; tapes ! (iosb ! iosb_unit) := 0; freevec(iosb ! iosb_buffer); freevec(iosb); resultis 1 } let close_readtape(iosb) be { let r = devctl(dc$tapeunload, iosb ! iosb_unit); if r < 0 then resultis r; tapes ! (iosb ! iosb_unit) := 0; freevec(iosb ! iosb_buffer); freevec(iosb); resultis 1 } let writechar_tape(iosb, ch) be { if iosb ! iosb_pos = iosb ! iosb_size then { let r = devctl(dc$tapewrite, iosb ! iosb_unit, iosb ! iosb_buffer, iosb ! iosb_size); if r < 0 then resultis r; iosb ! iosb_pos := 0 } byte (iosb ! iosb_pos) of (iosb ! iosb_buffer) := ch; iosb ! iosb_pos +:= 1; resultis 1 } let readchar_tape(iosb) be { let c; if iosb ! iosb_pos >= iosb ! iosb_size then { let r = devctl(dc$taperead, iosb ! iosb_unit, iosb ! iosb_buffer); if r < 0 then resultis r; iosb ! iosb_pos := 0; iosb ! iosb_size := r } if iosb ! iosb_pos = iosb ! iosb_size then { iosb ! iosb_size := -1; resultis EOF; } c := byte (iosb ! iosb_pos) of (iosb ! iosb_buffer); iosb ! iosb_pos +:= 1; resultis c } let unreadchar_tape(iosb) be { if iosb ! iosb_pos > 0 then iosb ! iosb_pos -:= 1; resultis 1 } let illegal_unreadch(iosb) be { emergency_outs("Unreadch performed on write-only file\n"); resultis err$software } let illegal_writech(iosb, ch) be { emergency_outs("Write performed on read-only file\n"); resultis err$software } let illegal_readch(iosb) be { emergency_outs("Read performed on write-only file\n"); resultis err$software } let at_eof(iosb) be { resultis iosb ! iosb_size < 0 } let tape_open_w(fname) be { let t = find_free_tape_unit(); let r = devctl(dc$tapeload, t, fname, 'W'); if r < 0 then resultis r; r := newvec(sizeof_iosb); r ! iosb_ichar := illegal_readch; r ! iosb_bchar := illegal_unreadch; r ! iosb_ochar := writechar_tape; r ! iosb_close := close_writetape; r ! iosb_unit := t; r ! iosb_buffer := newvec(128); r ! iosb_pos := 0; r ! iosb_size := 512; resultis r; } let tape_open_r(fname) be { let t = find_free_tape_unit(); let r = devctl(dc$tapeload, t, fname, 'R'); if r < 0 then resultis r; r := newvec(sizeof_iosb); r ! iosb_ichar := readchar_tape; r ! iosb_bchar := unreadchar_tape; r ! iosb_ochar := illegal_writech; r ! iosb_close := close_readtape; r ! iosb_unit := t; r ! iosb_buffer := newvec(128); r ! iosb_pos := 512; r ! iosb_size := 512; resultis r; } let writech(iosb, ch) be { resultis (iosb ! iosb_ochar)(iosb, ch) } let readch(iosb) be { resultis (iosb ! iosb_ichar)(iosb) } let unreadch(iosb) be { resultis (iosb ! iosb_bchar)(iosb) } let close(iosb) be { resultis (iosb ! iosb_close)(iosb) } let writestr_internal(iosb, fn, s) be { let i = 0, r; while true do { let c = byte i of s; if c = 0 then break; r := fn(iosb, c); if r < 0 then resultis r; i +:= 1 } resultis 1 } let writech_visible(iosb, c) be { if c = '\\' then { writech(iosb, '\\'); resultis writech(iosb, '\\') } if c > ' ' /\ c <= '~' then resultis writech(iosb, c); writech(iosb, '\\'); test c = ' ' then resultis writech(iosb, 's') or test c = '\n' then resultis writech(iosb, 'n') or test c = '\r' then resultis writech(iosb, 'r') or test c = '\t' then resultis writech(iosb, 't') or { writech(iosb, byte ((c >> 4) bitand 0xF) of caphexstr); resultis writech(iosb, byte (c bitand 0xF) of caphexstr) } } let writestr(iosb, s) be { resultis writestr_internal(iosb, iosb ! iosb_ochar, s) } let writestr_length(iosb, fn, s, leadz, len) be { let i = 0, r, max = 0x7FFFFFFF, min = 0x80000000; if len = 0 then resultis writestr_internal(iosb, fn, s); test leadz then { if len < 0 then len := - len; min := len; max := len } or test len < 0 then max := - len or min := len; while true do { let c = byte i of s; if i = max \/ c = 0 then break; r := fn(iosb, c); if r < 0 then resultis r; i +:= 1 } while i < min do { r := fn(iosb, ' '); if r < 0 then resultis r; i +:= 1 } resultis 1 } let writeno_basic(iosb, n) be { let r; if n > 9 then { r := writeno_basic(iosb, n / 10); if r < 0 then resultis r } resultis writech(iosb, '0' + n rem 10) } let badstring = "2147483648"; let writeno(iosb, n) be { let r; if n = 0x80000000 then { writech(iosb, '-'); resultis writestr(iosb, badstring) } if n < 0 then { writech(iosb, '-'); n := - n } resultis writeno_basic(iosb, n) } let write_badun(iosb, leadz, len) be { let r; if len < 0 /\ leadz then len := - len; test leadz then { writech(iosb, '-'); while len > 11 do { writech(iosb, '0'); len -:= 1 } r := writestr(iosb, badstring) } or test len < 0 then { writech(iosb, '-'); r := writestr(iosb, badstring); while len < -11 do { r := writech(iosb, ' '); len +:= 1 } } or { while len > 11 do { writech(iosb, ' '); len -:= 1 } writech(iosb, '-'); r := writestr(iosb, badstring) } resultis r } let writeno_formatted(iosb, n, leadz, len) be { let natlen = 1, r = 1, temp, neg = false, fill = ' '; if n = 0x80000000 then resultis write_badun(iosb, leadz, len); if leadz then { fill := '0'; if len < 0 then len := - len } if n < 0 then { natlen := 2; neg := true; n := -n } temp := n; while temp > 9 do { natlen +:= 1; temp /:= 10 } test leadz /\ neg then { writech(iosb, '-'); while natlen < len do { writech(iosb, '0'); len -:= 1 } r := writeno_basic(iosb, n) } or test len >= 0 then { while natlen < len do { writech(iosb, fill); len -:= 1 } if neg then writech(iosb, '-'); r := writeno_basic(iosb, n) } or { len := - len; if neg then writech(iosb, '-'); r:= writeno_basic(iosb, n); while natlen < len do { r := writech(iosb, ' '); len -:= 1 } } resultis r } let write_hex_formatted(iosb, n, ch, leadz, num) be { let alpha, mask = 0xF0000000, lz = 0, digs, pad = ' ', sh, r; test ch = 'x' then alpha := "0123456789abcdef" or alpha := caphexstr; while (n bitand mask) = 0 /\ lz < 7 do { mask >>:= 4; lz +:= 1 } digs := 8 - lz; sh := (digs - 1) << 2; if num < 0 /\ leadz then num := - num; if num >= 0 then { if leadz then pad := '0'; while digs < num do { writech(iosb, pad); digs +:= 1 } } while sh >= 0 do { let dig = (n >> sh) bitand 0xF; r := writech(iosb, byte dig of alpha); sh -:= 4 } if num < 0 then { num := - num; while digs < num do { r := writech(iosb, ' '); digs +:= 1 } } resultis r } let write_date_time(iosb, dttm) be { let wr2(iosb, c, n) be { writech(iosb, c); if n < 10 then writech(iosb, '0'); resultis writeno(iosb, n) } let v = vec(7), dt; test numbargs() < 2 then dt := seconds() or dt := dttm; datetime(dt, v); writeno(iosb, v ! 0); wr2(iosb, '-', v ! 1); wr2(iosb, '-', v ! 2); wr2(iosb, ':', v ! 4); wr2(iosb, ':', v ! 5); resultis wr2(iosb, ':', v ! 6) } let write(iosb, format, first) be { let i = 0, used = 0, paramptr = @ first, avail = numbargs() - 2, r = 1; while true do { let c = byte i of format; if c = 0 then break; test c = '%' then { let param = paramptr ! used, good = true, hasnum = false, leadz = false, neg = false, num = 0; if used >= avail then { r := writech(iosb, '%'); break; } i +:= 1; c := byte i of format; if c = '-' then { neg := true; hasnum := true; i +:= 1; c := byte i of format } while c = '0' do { leadz := true; hasnum := true; i +:= 1; c := byte i of format } test c = '*' then { num := param; used +:= 1; hasnum := true; if used >= avail then break; param := paramptr ! used; i +:= 1; c := byte i of format } or while c >= '0' /\ c <= '9' do { num := num * 10 + c - '0'; hasnum := true; i +:= 1; c := byte i of format } if neg then num := - num; if c = 0 then break; test c = 's' then r := writestr_length(iosb, iosb ! iosb_ochar, param, leadz, num) or test c = 'S' then r := writestr_length(iosb, writech_visible, param, leadz, num) or test c = 'd' then test hasnum then r := writeno_formatted(iosb, param, leadz, num) or r := writeno(iosb, param) or test c = 'x' \/ c = 'X' then test hasnum then r := write_hex_formatted(iosb, param, c, leadz, num) or r := write_hex_formatted(iosb, param, c, false, 0) or test c = 'c' then r := writech(iosb, param) or test c = 'C' then r := writech_visible(iosb, param) or test c = 't' then r := write_date_time(iosb, param) or { writech(iosb, '%'); r := writech(iosb, c); good := false } if good then used +:= 1 } or r := writech(iosb, c); if r < 0 then resultis r; i +:= 1; } resultis r } let readno(iosb) be { let n = 0, c = readch(iosb), s = 1; while c >= 0 /\ c <= ' ' do c := readch(iosb); if c = '-' then { s := -1; c := readch(iosb) } while c >= '0' /\ c <= '9' do { n := n * 10 + c - '0'; c := readch(iosb) } unreadch(iosb); resultis n * s } let readstr(iosb, string, numwords) be { let pos = 0, max = 4 * numwords - 1, c = readch(iosb); while c <= ' ' /\ c <> EOF do c := readch(iosb); if c = EOF then resultis EOF; while true do { if pos < max then { byte pos of string := c; pos +:= 1 } c := readch(iosb); if c <= ' ' then break } unreadch(iosb); byte pos of string := 0; resultis 1 } let readline(iosb, string, numwords) be { let pos = 0, max = 4 * numwords - 1, c; while true do { c := readch(iosb); if c <= '\n' \/ c = EOF then break; if pos < max then { byte pos of string := c; pos +:= 1 } } byte pos of string := 0; if c = EOF /\ pos = 0 then resultis EOF; resultis 1 } let abandon_input_line(iosb) be { while true do { let c = readch(iosb); if c = '\n' \/ c = EOF then break } } let start() be { let fi, fo, min, max, fname = vec(20); init(); writestr(tty, "file name for limits: "); readstr(tty, fname, 20); writestr(tty, "The program is creating table.txt\n"); fi := tape_open_r(fname); fo := tape_open_w("table.txt"); min := readno(fi); max := readno(fi); for cent = min to max do { let fahr = cent * 9 / 5 + 32; writeno(fo, cent); writestr(fo, " centigrade is "); writeno(fo, fahr); writestr(fo, " fahrenheit\n") } close(fi); close(fo) }