/* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ edm: proc; /* recoded to take advantage of eis and to be less memory intensive: RMullen 1/74 */ /* move request added: RMullen Autumn '75 */ /* Sept 1983 C Spitzer: bug fixes applied. phx2205: terminate segs when cleaning up. phx3368, phx13842: use terminate_file_ to zero chars in last word phx6041: use check_entryname_ on requested path on command line. phx6407: move data then truncate so don't get rqo in ring 0. */ %include set_wakeup_table_info; %include access_mode_values; %include terminate_file; dcl 1 swt aligned static like swt_info; dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); dcl iox_$user_io ptr ext; dcl error_table_$bad_mode fixed bin (35) ext; dcl waketable_is_set bit (1) init (""b); dcl readysw bit (1) aligned init ("0"b); dcl cv_dec_check_ entry (char (*)aligned, fixed bin (35)) returns (fixed bin); dcl (M, N) fixed bin (21); dcl ready ext entry; dcl 1 edata aligned, /* info about state of temp files */ 2 upper, /* these items sometimes saved seperately */ 3 fptr ptr, /* points to base of fromfile */ 3 indf fixed bin (21) init (0), /* current position in fromfile */ 3 iflag bit (1) aligned init ("1"b), /* "1" => nothing is in fromfile yet */ 3 csize1 fixed bin (24) init (0), /* offset of last char in fromfile */ 3 pad1 fixed bin, 2 tptr ptr, /* points to base of tofile */ 2 indt fixed bin (21) init (0), /* current position in tofile */ 2 eof_ bit (1) aligned init ("0"b), /* "1"b => at end of fromfile */ 2 changed bit (1) aligned init ("0"b), /* "1"b => text changed since last write */ 2 lngth fixed bin (17) init (0), /* length of current line in chars */ 2 curlino fixed bin (21) init (1), /* if not -1, is current line number */ 2 isok fixed bin (17) init (0); /* if not -1, is number of chars in tofile ident to fromfile */ dcl line char (152) aligned; dcl 1 Edata_pi like edata aligned; /* edata placed here, in case of pi */ dcl pi_allowed bit (1) aligned init ("0"b); dcl Line_pi char (152) aligned; dcl 1 move_data aligned, /* info to undo move at pi-time */ 2 (x1, x2, xlen, y1, y2, ylen) fixed bin (21); dcl did_move bit (1) aligned init ("0"b); dcl buffer char (152) aligned; dcl bufp ptr; dcl sptr ptr init (null), orig_ptr ptr; dcl b168cu char (168) unal based; dcl b32cu char (32) unal based; dcl scanlen fixed bin (17); dcl (g_lines, g_chars, mg_lines, mg_chars) fixed bin (21); dcl (mc_skip, mc_chars) fixed bin (21); dcl chunk fixed bin (21) init (512); /* try to deal with about this many chars */ dcl (bkover, cgscanlen, xxxx, tnx) fixed bin (21); dcl (bklen, nbk, nxlen) fixed bin (21); dcl printing fixed bin; dcl locating fixed bin; dcl locstring char (152) aligned init (" "); dcl (loclen, locend) fixed bin; dcl skipblank fixed bin; dcl where_found fixed bin; dcl locp pointer; dcl trick_ptr ptr; dcl me char (4) static aligned init ("edm "); dcl active fixed bin static init (0); /* Are there active invocations of edm */ dcl status bit (72) aligned, (m, ij, ii) fixed bin (21), error_message char (33) aligned init ("Line too long. Max length is 152.") static, string char (262144) aligned based, arg char (lname) based (np) unaligned, /* input argument */ xarg char (lprinam) based (np) unal, /* pathname arg of merge, write, or split request */ (error_table_$noentry, error_table_$noarg) fixed bin (35) ext, error_table_$no_w_permission fixed bin(35) ext static, (iox_$user_input, iox_$user_output) ptr ext, code fixed bin (35), type fixed bin (2), (edct, num_err, cm1) fixed bin (17), (i, j, k, n) fixed bin (21), l fixed bin (17), sw_pi bit (1) aligned init ("0"b), gotlino fixed bin (21), prc fixed bin (17), count fixed bin (17), (lname, lprinam) fixed bin (17), located bit (1), temp1 bit (1), brief bit (1), break char (1) aligned, cwd char (1) aligned, (rrs init (""), brs init (""), nl init (" ")) char (1) aligned static, /* Color-shift, chars */ saveflag fixed bin (17), tlin char (152), olin char (456) aligned, /* TEDLIN char (152), */ int_lab label init (pedit); /* non_local go to from program interrupt handler */ dcl np ptr; dcl (ptr1 init (null), ptr2) int static ptr; dcl iox_$get_line entry (ptr, ptr, fixed bin (17), fixed bin (17), fixed bin (35)), hcs_$truncate_seg entry (ptr, fixed bin (21), fixed bin (35)), cu_$cp entry (ptr, fixed bin (17), fixed bin (35)), hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), cu_$arg_ptr entry (fixed bin (17), ptr, fixed bin (17), fixed bin (35)), (com_err_, command_query_) entry options (variable), iox_$control entry (ptr, char (*) aligned, ptr, fixed bin (35)), ioa_ entry options (variable), initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)), terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)), expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)), check_entryname_ entry (char (*), fixed bin (35)), hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)), iox_$put_chars entry (ptr, ptr, fixed bin (17), fixed bin (35)); dcl segsize fixed bin (21); dcl merge_bc fixed bin (24); dcl (cleanup, program_interrupt) condition; dcl (addr, divide, fixed, index, min, mod, null, reverse, substr, unspec, verify) builtin; dcl 1 query_info static aligned, 2 version fixed bin init (2), 2 yes_no bit (1) unal init ("1"b), 2 suppress_name bit (1) unal init ("0"b), 2 status fixed bin init (0), 2 query fixed bin init (0); dcl answer char (4) varying; dcl com_line char (cm1) aligned based (bufp); dcl (dnp, enp) ptr; /* to point at dirname(o), ename(o) */ dcl (ename, enameo) char (32), (dirname, dirnameo) char (168); dcl pad_count fixed bin; /* number of pad zeros that go in last word */ /* */ lname = 0; brief = "0"b; prc = 152; bufp = addr (buffer); /* Now get pointers to the buffers */ Edata_pi.changed = "0"b; if ptr1 = null then do; /* First time, get permanent pointers */ call hcs_$make_seg ("", "temp1_", "", 1010b, ptr1, code); call hcs_$make_seg ("", "temp2_", "", 1010b, ptr2, code); end; else if active ^= 0 then do; call command_query_ (addr (query_info), answer, me, "Pending work in previous invocation will be lost if you proceed;^/do you wish to proceed?"); if answer ^= "yes" then go to return; else go to truncate_temp; end; else do; truncate_temp: call clean; end; active = active + 1; /* Set flag saying we're now working */ /* Now establish a handler for cleanup condition */ on cleanup call clean; /* */ /* Now check to see if an input argument was given */ call cu_$arg_ptr (1, np, lname, code); if code ^= 0 then if code = error_table_$noarg then go to finput; /* if no arguments, go to input mode */ else do; call com_err_ (code, me); go to exit; end; if lname = 0 then go to finput; /* If none given, go to input mode */ /* Now get a pointer to the segment to be edited */ call expand_pathname_ (arg, dirnameo, enameo, code); if code ^= 0 then do; call com_err_ (code, me, "^a", arg); go to exit; end; /* Is it a valid entry name? */ call check_entryname_ (enameo, code); if code ^= 0 then do; call com_err_ (code, me, "^a", enameo); goto exit; end; call initiate_file_ (dirnameo, enameo, RW_ACCESS, sptr, edata.csize1, code); /* Initiate the segment */ /* Check to see that the segment is there */ if sptr = null then do; if code = error_table_$no_w_permission then do; call initiate_file_ (dirnameo, enameo, R_ACCESS, sptr, edata.csize1, code); if sptr ^= null then goto have_seg_ptr; end; if code = error_table_$noentry then do; call ioa_ ("Segment not found."); orig_ptr = null; go to finput; end; else do; /* bad news indeed */ dnp = addr (dirnameo); enp = addr (enameo); call COM_DE; go to exit; end; end; have_seg_ptr: edata.csize1 = divide (edata.csize1, 9, 24, 0); /* change bit count to char count */ if edata.csize1 ^= 0 then if substr (sptr -> string, edata.csize1, 1) ^= nl then call com_err_ (0, me, "Warning --- ^a does not end in newline.", enameo); /* */ /* Dispatch on the command character */ edata.fptr, orig_ptr = sptr; edata.tptr = ptr1; edata.iflag = "0"b; on program_interrupt call interrupt; sw_pi = "1"b; /* note pi_handler set up */ pedit: /* here from input,comment,pi */ call SAVE; /* save info about buffers */ call ioa_ ("Edit."); next: /* DEBUGGING if readysw then call ready (); if cklinsw then call CKLINO; if ckisoksw then call CKISOK; if dumpsw then call EDUMP; /* END DEBUGGING */ call iox_$get_line (iox_$user_input, bufp, prc, count, code); cm1 = count - 1; if cm1 = 0 then go to next; /* if null line then get another line, don't print error */ /* pi can undo last request until SAVE */ call SAVE; /* save info about buffers */ if substr (buffer, 1, 1) = "E" then go to callms; i = verify (substr (buffer, 2, count - 1), " "); /* find first nonblank char */ if i = 0 then i = 152; /* SIMULATE old edm */ if substr (buffer, 1, 1) = "w" then do; edct = i; /* if w then all else is path */ go to wsave; end; num_err = 0; /* Set flag saying number OK */ if cm1 = 1 /* If single character line, numeric value is 1 */ then go to got_num_1; /* End of line, no number, set it to 1 */ n = 0; /* this section looks for and converts numbers after the */ /* command letter. It leaves edct pointing to the first non- */ /* blank, non-numeric character. First we initialize the value */ num_err = num_err + 1; /* Increment it, will be cleared if # OK */ /* now we do the numeric conversion */ num_loop: j = fixed (unspec (substr (buffer, i + 1, 1)), 9) - 110000b /* ASCII value of "0" */; if j<0 then go to got_num; /* if not "0-9" then end of numeric field */ if j>9 then go to got_num; n = 10 * n + j; /* add value found to 10*number so far */ i = i + 1; if i") */ /* */ edct = i - 1 + verify (substr (buffer, i+1, count - i), " "); /* find first nonblank after numbers */ cwd = substr (buffer, 1, 1); /* cmd char in col 1 */ if cwd = "i" then go to insert; if cwd = "r" then go to retype; if cwd = "l" then go to locate; /* */ if cwd = "p" then go to print; /* */ if cwd = "n" then go to nexlin; if cwd = "-" then go to backup; if cwd = "c" then go to change; if cwd = "d" then go to dellin; /* */ if cwd = "t" then go to top; if cwd = "b" then go to bottom; if cwd = "f" then go to find; /* */ if cwd = "s" then go to change; if cwd = "v" then go to veron; /* DEBUGGING if cwd = "o" then go to otize; /* DEBUGGING */ if cwd = "k" then go to veroff; if cwd = "." then do; if cm1 = 1 then go to pinput; go to request_err; end; if cwd = "=" then go to equals; /* */ if cwd = "," then go to comment_init; if count >= 3 then if substr (buffer, 1, 2) = "qf" then go to q_force; if cwd = "q" then go to quit; if count >= 6 then if substr (buffer, 1, 5) = "merge" then go to insert_file; if count >= 5 then if substr (buffer, 1, 4) = "move" then go to move_; /* MOVE */ if count >= 8 then if substr (buffer, 1, 7) = "upwrite" then go to save_top; if count >= 9 then if substr (buffer, 1, 8) = "updelete" then go to delete_top_init; call com_err_ (0, me, "Not a request: ^a", com_line); reset_io: call iox_$control (iox_$user_input, "resetread", null (), code); go to next; numeric_err: call com_err_ (0, me, "Non-numeric characters in numeric argument: ^a", com_line); go to reset_io; request_err: call com_err_ (0, me, "Text follows logical end of request, request ignored: ^a", com_line); go to reset_io; /* */ /* ********* verify -- on and off ********* */ veron: if cm1 ^= 1 then go to request_err; else do; brief = "0"b; go to next; end; veroff: if cm1 ^= 1 then go to request_err; else do; brief = "1"b; go to next; end; /* ********* input mode ********* */ finput: edata.fptr = ptr1; edata.tptr = ptr2; call SAVE; /* save info about buffers */ if ^sw_pi then do; on program_interrupt call interrupt; sw_pi = "1"b; end; pinput: call ioa_ ("Input."); /* print word "Input" */ call INPUT; go to pedit; /* retn to editing */ /* ********** comment ******************* */ comment_init: if cm1 ^= 1 then go to request_err; comment: if edata.eof_ then go to eof; /* stop commenting at end of file */ if edata.lngth = 1 then go to cnoline; /* don't print blank lines */ if edata.lngth = 0 then go to cnoline; /* ignore no lines */ call iox_$put_chars (iox_$user_output, addr (line), edata.lngth-1, code); /* write line minus NL */ call iox_$get_line (iox_$user_input, bufp, prc, count, code); /* read addition to line */ if count = 2 then /* check for mode change */ if substr (buffer, 1, 1) = "." then go to pedit; if count > 1 then do; edata.changed = "1"b; edata.isok = -1; end; substr (line, edata.lngth, count) = substr (buffer, 1, count); /* add new part to line */ edata.lngth = edata.lngth + count - 1; /* update count */ cnoline: call PUT; /* add to main file */ call GET; /* get next line for commenting */ go to comment; /* repeat */ /* */ /* ********** print line number ********* */ equals: if cm1 ^= 1 then go to request_err; /* = alone on line */ if edata.curlino = -1 then do; /* ! */ call GET_LINO; /* ! */ GET_LINO: proc; if edata.isok ^= -1 then trick_ptr = edata.fptr; /* touch from file preferentially */ else trick_ptr = edata.tptr; /* unless tofile is different from fromfile */ i = 1; k = edata.indt; do gotlino = 1 by 1 while (k ^= 0); /* count number of nls */ k = index (substr (trick_ptr -> string, i, edata.indt-i), nl); i = i + k; end; if edata.indt = 0 then if edata.indf ^= 0 then gotlino = 1; /* begining of file */ end GET_LINO; edata.curlino = gotlino; /* ! */ end; /* ! */ else do; /* ! */ gotlino = edata.curlino; /* ! */ if gotlino = 0 then gotlino = 1; /* ! */ end; /* ! */ call ioa_ ("^d", gotlino); go to next; /* ! */ /* */ /* ********* delete ********* */ dellin: if num_err ^= 0 then go to numeric_err; /* use getlines, dont move to tofile */ if edata.eof_ then go to eof; if edata.lngth ^= 0 then do; edata.changed = "1"b; edata.isok = -1; edata.lngth = 0; /* leave him at Noline. */ end; if n - 1 > 0 then do; /* if more than current line to delete */ mg_lines = n-1; /* delete this many more */ mg_chars = edata.csize1 - edata.indf; /* up to eof */ call GET_LINES; /* setting g_chars, g_lines */ if g_chars = 0 then g_chars = mg_chars; /* no newlines found */ if g_chars ^= 0 then do; /* actually deleted something */ edata.changed = "1"b; edata.isok = -1; end; if g_lines ^= mg_lines then do; /* wanted more than got */ edata.indf = edata.csize1; /* swallow rest of fromfile */ edata.eof_ = "1"b; go to eof; end; else edata.indf = edata.indf + g_chars; end; go to next; /* else keep quiet */ /* ********* insert ********* */ insert: call PUT; /* add current line to file */ retype: /* doubles as retype com. without above */ if substr (buffer, 2, 1) = " " then skipblank = 1;else skipblank = 0; edata.lngth = count - skipblank - 1; if edata.lngth ^= 0 then substr (line, 1, edata.lngth) = substr (buffer, skipblank + 2, edata.lngth); /* add replaced (inserted) line */ edata.changed = "1"b; /* text changed */ edata.eof_ = "0"b; /* not EOF now */ edata.isok = -1; go to next; /* */ /* ********* next + print ********* */ nexlin: printing = 0;go to NPSET; /* go to nth follwing line */ print: printing = 1; /* print curline + n-1 following lines */ /* There are two obvious strategies. */ /* One is to move the lines to tofile as */ /* they are counted. That way we never have */ /* to double back and touch the same text twice. */ /* The other way is to count ahead n lines, */ /* and then move them all at once to the tofile. */ /* That way the move part of the operation is faster. */ /* On balance the first way is cheaper, at least for */ /* large n. However it uses measurably more cpu */ /* and so the following compromise was devised which */ /* has the advantages of both, taking the */ /* lesser working set of the first method */ /* and the increased speed of the second. */ /* This is basicaly the first method, taking */ /* account of the fact that an "mlr" of one line */ /* (say 8 words) is about half as efficent */ /* as a long "mlr", by moving approx chunk chars */ /* when possible. */ NPSET: if num_err ^= 0 then go to numeric_err; /* p, n take number only */ if printing ^= 0 then do; if n = 1 then go to NPFIN; /* just print current line */ else do; if edata.eof_ then go to eof; /* make wure not at eof already */ n = n - 1; /* print 10 touches one less line than next 10 */ call PRINT_CURLINE; /* because it prints and counts the curline */ end; end; call PUT; /* put away curline */ mg_lines = n - 1; tnx = edata.csize1 - edata.indf; /* max num of chars to move */ g_chars = 0; /* this many done so far */ g_lines = 0; /* " */ NPLOOP: mg_lines = mg_lines - g_lines; /* find num of lines left to move */ if mg_lines = 0 then go to NPGET; /* have done all lines requested, less one */ mg_chars = min (chunk, tnx); /* max num to move at once is chunk */ if mg_chars = 0 then go to NPGET; call GET_LINES; /* get up to mg_lines, totaling <= mg_chars */ if g_chars = 0 then g_chars = mg_chars; /* no more , take all */ if printing ^= 0 then call iox_$put_chars (iox_$user_output, addr (substr (edata.fptr -> string, edata.indf+1, 1)), (g_chars), code); call MOVE_CHARS; /* moves these lines, step ptrs & curlino */ tnx = tnx - g_chars; go to NPLOOP; NPGET: call GET; /* always get line, except for p1 */ NPFIN: if edata.eof_ then go to eof; else if printing ^= 0 then call PRINT_CURLINE; /* print req, must print */ else if ^brief then call PRINT_CURLINE; /* next req, maybe print */ go to next; /* */ /* ********* locate & find ********* */ find: locating = 0; go to FLSET; locate: locating = 1; /* locstring has last string specified for */ /* find or locate, with a newline tacked on the */ /* front of the string. If we are to do a */ /* locate, we just set a pointer and a length */ /* so as to not see that newline. */ /* After we have tried to locate the string */ /* the idea is to move as little text around */ /* as possible. Clearly when the search fails */ /* no text need be moved at all. */ FLSET: if count ^= 2 then do; /* new string given to be located */ if substr (buffer, 2, 1) = " " then skipblank = 1; else skipblank = 0; locend = count - 1 - skipblank; /* not counting cmd char, , or poss blank */ /* but counting the canned newline */ substr (locstring, 2, locend - 1) /* follow canned leading newline in locstring */ = substr (buffer, 2 + skipblank, locend - 1); /* with string to be found */ end; else if locend = 1 then go to incmplt; /* has never been set evidently */ locp = addr (substr (locstring, 1 + locating, 1)); /* no leading for locate */ loclen = locend - locating; /* so string is one char shorter for now */ call FIND_LOCATE; if where_found = 0 then do; /* not found */ call com_err_ (0, me, "Search failed."); go to reset_io; end; if where_found = 1 then do; /* found in fromfile */ call PUT; /* put away curline */ if k ^= 0 then do; g_chars = k; /* set arg for move */ edata.curlino = -1; /* lose track of line num */ call MOVE_CHARS; end; end; else do; /* found in tofile */ edata.curlino = -1; /* lose line num */ if edata.isok ^= -1 then do; /* tofile identical to fromfile, dont move text */ edata.indf, edata.indt = k; /* presto, changeo */ go to FLFIN; /* where we pick up new curline */ end; bkover = edata.indt - k; /* compute amount to back up over */ if edata.fptr ^= orig_ptr then /* not users file */ if bkover + edata.lngth < edata.indf then /* and will fit in fromfile */ if bkover < edata.csize1 - edata.indf + k /* and cheaper */ then do; /* then take shortcut */ call COPY_BACK; go to FLFIN; end; call COPY; call SWITCH; g_chars = k; /* set arg for move */ call MOVE_CHARS; end; FLFIN: call GET; /* pick up new current line */ if ^brief then call PRINT_CURLINE; go to next; /* */ /* ********* change ********* */ change: located = "0"b; if edct = cm1 then do; incmplt: call com_err_ (0, me, "Incomplete request: ^a", com_line); go to reset_io; end; break = substr (buffer, edct + 1, 1); i = index (substr (buffer, edct+2, count-edct-2), break); if i = 0 then go to incmplt; j = index (substr (buffer, i+edct+2, count-edct-i-2), break); if j = 0 then j = count-i-edct-1; /* Final break char not required */ else if (edct + i + j + 2) ^= count then go to request_err; /* Extra stuff in request line */ if edata.lngth = 0 then go to chnoline; /* no current line */ ch1: temp1 = "0"b; /* to indicate if anything was c'd on line */ m, ij, l = 1; /* indexes to strings */ if i = 1 then do; /* add to begining of line */ ij = j + edata.lngth -1; if ij > 152 then do; LONG_ERROR: call com_err_ (0, me, "Change would result in too long a line. Max length is 152. Request ignored:^/ ^a", com_line); go to reset_io; end; temp1, located = "1"b; if j ^= 1 then substr (tlin, 1, j-1) = substr (buffer, edct+i+2, j-1); /* copy part to be added */ substr (tlin, j, edata.lngth) = substr (line, 1, edata.lngth); /* copy old line */ if ^brief then do; substr (olin, 1, 1) = rrs; /* shift to red for printed line */ if j ^= 1 then substr (olin, 2, j-1) = substr (buffer, edct+i+2, j-1); /* copy */ substr (olin, j+1, 1) = brs; /* black */ substr (olin, j+2, edata.lngth) = substr (line, 1, edata.lngth); l = j + edata.lngth +1; end; end; else do; /* string to other string */ ch2: if edata.lngth = m then k = 0; else k = index (substr (line, m, edata.lngth-m), substr (buffer, edct+2, i-1)); /* locate what is to be changed */ if k ^= 0 then do; if (ij+k-2) > 152 then go to LONG_ERROR; if k ^= 1 then substr (tlin, ij, k-1) = substr (line, m, k-1); /* copy line up to change */ if j ^= 1 then substr (tlin, ij+k-1, j-1) = substr (buffer, edct+i+2, j-1); /* put in change */ if ^brief then do; if k ^= 1 then substr (olin, l, k-1) = substr (line, m, k-1); substr (olin, l+k-1, 1) = rrs; /* red */ if j ^= 1 then substr (olin, l+k, j-1) = substr (buffer, edct+i+2, j-1); substr (olin, l+k+j-1, 1) = brs; /* black */ l = l + k + j; end; m = m + k + i - 2; /* increment indexes */ ij = ij + k + j - 2; temp1, located = "1"b; /* indicate that you did someting */ go to ch2; end; ii = ij + edata.lngth - m; if ii > 152 then go to LONG_ERROR; if temp1 then do; if edata.lngth-m+1 ^= 0 then substr (tlin, ij, edata.lngth-m+1) = substr (line, m, edata.lngth-m+1); /* copy rest of line */ ij = ii; if ^brief then do; if edata.lngth-m+1 ^= 0 then substr (olin, l, edata.lngth-m+1) = substr (line, m, edata.lngth-m+1); l = l + edata.lngth - m; end; end; end; if temp1 then do; substr (line, 1, ij) = substr (tlin, 1, ij); edata.lngth = ij; edata.changed = "1"b; /* the text has been changed */ edata.isok = -1; /* tofile ^= fromfile anymore */ if ^brief then call iox_$put_chars (iox_$user_output, addr (olin), l, code); end; chnoline: if n = 1 then do; /* finished */ if ^located then do; call com_err_ (0, me, "Substitution failed."); go to reset_io; end; go to next; end; n = n-1; call PUT; /* NEW FAST CODE */ if ^temp1 then do; /* Dual purpose test: always fails for s//string/ */ /* and prevents bad performance in case where change */ CGLOOP: /* will be made on more than half the lines of a group. */ if n > 1 then /* If not line to be stopped on */ if edata.csize1 - edata.indf > 0 then do; /* If not impending eof */ cgscanlen = min (edata.csize1 - edata.indf, chunk); xxxx = index (substr (edata.fptr -> string, edata.indf + 1, cgscanlen), substr (buffer, edct +2, i -1)); if xxxx ^= 0 then mg_chars = xxxx; else mg_chars = cgscanlen; mg_lines = n - 1; call GET_LINES; if g_chars = 0 then /* if no between here and xxxx */ if xxxx ^= 0 then /* and not just flushing along */ go to CGGET; /* then better pick up line */ call MOVE_CHARS; n = n - g_lines; if xxxx = 0 then go to CGLOOP; end; end; CGGET: /* END NEW FAST CODE */ call GET; if edata.eof_ then go to eof; go to ch1; /* */ /* ******** quit ********* */ quit: if cm1 ^= 1 then go to request_err; /* if user has made changes ask */ if edata.changed then do; /* if he really wants to quit */ call command_query_ (addr (query_info), answer, me, "Changes to text since last ""w"" request will be lost if you quit;^/do you wish to quit?"); if answer ^= "yes" then go to pedit; end; q_force: if cm1 > 2 then go to request_err; call clean; exit: active = 0; /* Reset flag */ go to return; /* */ /* ********* top ********* */ top: if cm1 ^= 1 then go to request_err; /* must be only a "t" */ if edata.isok >= 0 then do; edata.indt, edata.indf = 0; go to TSET; end; if edata.indf >= edata.indt + edata.lngth /* poss to copy back */ then if edata.indt < edata.csize1 - edata.indt /* worth copying back */ then if edata.fptr ^= orig_ptr /* and not back to users file */ then do; bkover = edata.indt; /* backup over whole to file */ call COPY_BACK; /* copy top of to to from */ TSET: edata.lngth = 0; /* we're at Noline */ edata.eof_ = "0"b; /* no way at eof */ edata.curlino = 1; go to next; end; call COPY; call SWITCH; edata.curlino = 1; go to next; /* ********* bottom ********* */ bottom: if cm1 ^= 1 then go to request_err; edata.curlino = -1; call COPY; edata.lngth = 0; go to pinput; /* */ /* ********* backup ********* */ backup: /* backup n lines */ if num_err ^= 0 then go to numeric_err; /* b takes a number only */ edata.eof_ = "0"b; /* no way to remain at eof */ scanlen = edata.indt - 1; /* nchars in tofile, less last nl */ if edata.curlino ^= -1 then do; /* if we know current line num */ if edata.curlino <= n then do; /* if we are sure to hit top-Noline */ bklen = 0; scanlen = -1; /* so new indt = 0, bkover = edata.indt */ nbk = edata.curlino - 1; go to BKDO; /* that was easy */ end; end; if edata.isok ^= -1 /* if files the same */ then trick_ptr = edata.fptr; /* then touch pages of fromfile */ else trick_ptr = edata.tptr; /* else must touch tofile pages */ do nbk = 0 to n - 1; /* see how far back to go */ if scanlen <= 0 then do; /* at first line, its a newline only */ bklen = scanlen + 1; if bklen = 0 then go to BKDO; /* can't back up any further */ end; else do; /* there is more to scan back */ bklen = index (reverse (substr (trick_ptr -> string, 1, scanlen)), nl); /* if nl found, line is this long */ if bklen = 0 then bklen = scanlen + 1; /* length is what we scanned plus one */ end; scanlen = scanlen - bklen; /* start next scan before it */ end; /* unless we've backed up enough already */ BKDO: /* note, line stopped on has length of bklen */ g_chars = scanlen + 1; /* will be new indt */ bkover = edata.indt - g_chars; /* chars between curlne and start of new curline */ if edata.isok >= 0 then do; /* must be >= edata.indt ... */ edata.indt, edata.indf = g_chars; /* no copying needed, top of tofile is identical to fromfile */ go to BKFIN; /* go to load line */ end; if edata.fptr ^= orig_ptr /* if not copying back to users file */ then if edata.indf >= bkover + edata.lngth /* if possible to copy back to fromfile */ then if edata.csize1 - edata.indf + edata.indt - bkover > bkover /* and a shorter move */ then do; /* then ok to take shortcut */ call COPY_BACK; /* use bkover to modify edata, do job */ go to BKFIN; end; /* must do it the hard way */ call COPY; /* copy the rest of fromfile to tofile */ call SWITCH; /* switch buffers */ call MOVE_CHARS; /* load new tofile, mung line num */ BKFIN: if bklen = 0 then edata.lngth = 0; /* at top/Noline. */ else call GET; /* go thr GET for new curline */ if Edata_pi.curlino ^= -1 then do; /* update line number if possible */ edata.curlino = Edata_pi.curlino - nbk; end; if ^brief then call PRINT_CURLINE; go to next; /* */ /* ********** move ********** */ move_: /* code to do "move M N */ if count = 5 then go to incmplt; /* set i to be chars gone by */ i = 4; call GET_NUM; /* pickup starting linno */ M = N; /* subr sets N */ i = i + j; if i = count - 1 then N = 1; else do; call GET_NUM; if j ^= count - i - 1 then go to request_err; end; /* Determine if move is legal */ if edata.curlino = -1 then do; call GET_LINO; edata.curlino = gotlino; end; if M <= edata.curlino then if M+N > edata.curlino then do; call com_err_ (0b, me, "Text overlaps current line."); go to reset_io; end; Edata_pi.isok = -1; /* soon buffers no longer match */ call CHECK_ORIG; /* must not store into orig */ if edata.curlino > M then do; /* move from above */ /* copy tail of fromfile to tofile */ /* (will replace if pi taken) */ /* switch buffers */ /* set up the new tofile, rearranged */ i = GET_BLOCK (edata.tptr, 0, edata.indt, M-1); j = GET_BLOCK (edata.tptr, i, edata.indt - i, N); k = edata.indt - i - j; substr (edata.tptr -> string, edata.indt+edata.lngth+1, edata.csize1- edata.indf) = substr (edata.fptr -> string, edata.indf+1, edata.csize1-edata.indf); move_data.x1 = edata.indf; move_data.x2 = edata.indt + edata.lngth; move_data.xlen = edata.csize1 - edata.indf; move_data.y1, move_data.y2, move_data.ylen = 0; /* nothing else to note */ did_move = "1"b; /* now can start clobbering fromfile */ if edata.isok < 0 then /* else >indt so >i so no copy needed */ substr (edata.fptr -> string, 1, i) = substr (edata.tptr -> string, 1, i); substr (edata.fptr -> string, i+1, k) = substr (edata.tptr -> string, i+j+1, k); substr (edata.fptr -> string, i+k+1, edata.lngth) = substr (line, 1, edata.lngth); substr (edata.fptr -> string, edata.lngth+i+k+1, j) = substr (edata.tptr -> string, i+1, j); edata.indt, edata.indf = i+j+k+edata.lngth; edata.csize1 = edata.indf + move_data.xlen; edata.fptr = Edata_pi.tptr; edata.tptr = Edata_pi.fptr; end; else do; /* move from below */ /* let tofile have block A, line has L, from has XYZ */ /* assume we want to move block of lines Y */ /* to line from */ /* current state is A L XYZ */ /* change to ALY(X) - XYZ */ /* change to ALY(X) - XZ */ /* (use Y & X in tofile to restor fromfile if pi) */ /* this has been optimized by nudging Z instead */ /* of X when Z is much smaller. Since X has just been */ /* referenced and since shortening fromfile */ /* will tend to prevent COPY_BACK, moving X is */ /* favored unless Z is half as large as X. */ /* note that the existance of (X) is known only */ /* by the pi-handler. note that we needed (X) */ /* for the nudge of X anyway. */ /* at noline => go further */ i = GET_BLOCK (edata.fptr, edata.indf, edata.csize1-edata.indf, M-edata.curlino-min (1, edata.lngth)); if i < 0 then do; nonesuch: call com_err_ (0, me, "Specified lines do not exist."); go to reset_io; end; if edata.csize1 - edata.indf - i <= 0 then go to nonesuch; /* nothing left */ j = GET_BLOCK (edata.fptr, edata.indf+i, edata.csize1-edata.indf-i, N); if j < 0 then do; j = edata.csize1 - edata.indf - i; /* take all for "move 75 9999" */ edata.curlino = -1; /* dunno how many lines */ end; else edata.curlino = edata.curlino + N; /* N lines inserted above us */ substr (edata.tptr -> string, edata.indt+1, edata.lngth) = substr (line, 1, edata.lngth); edata.indt = edata.indt + edata.lngth; move_data.y1 = edata.indf + i; move_data.y2 = edata.indt; move_data.ylen = j; move_data.x2 = edata.indt + j; k = edata.csize1 - edata.indf - i - j; /* get len of Z block */ if i < 2 * k then do; /* if clearly cheaper to nudge X .. */ move_data.x1 = edata.indf; move_data.xlen = i; edata.indf = edata.indf + j; i = 0; end; else do; move_data.x1 = edata.indf + i + j; move_data.xlen = k; edata.csize1 = edata.csize1 - j; end; substr (edata.tptr -> string, move_data.x2 + 1, move_data.xlen) = substr (edata.fptr -> string, move_data.x1 + 1, move_data.xlen); substr (edata.tptr -> string, move_data.y2 + 1, move_data.ylen) = substr (edata.fptr -> string, move_data.y1 + 1, move_data.ylen); did_move = "1"b; /* now can start clobbering fromfile */ substr (edata.fptr -> string, edata.indf + i + 1, move_data.xlen) = substr (edata.tptr -> string, move_data.x2 + 1, move_data.xlen); edata.indt = move_data.y2 + move_data.ylen; end; /* now set items in control structure */ if edata.curlino ^= -1 then if edata.lngth ^= 0 then edata.curlino = edata.curlino + 1; /* have PUT ^noline */ edata.isok = -1; edata.lngth = 0; /* leave him at noline */ edata.changed = "1"b; /* remind him to write this opus */ go to next; /* */ /* ********** write save ********** */ wsave: saveflag = 0; go to scan_path; /* ********** delete top ********** */ delete_top_init: if cm1 ^= 8 then go to request_err; delete_top: edata.indt = 0; edata.changed = "1"b; /* text edata.changed */ edata.isok = -1; edata.curlino = 1; /* set line number */ go to next; /* ********** save the top of the file ********** */ save_top: saveflag = 2; edct = 7; /* Set scan pointer */ go to long_scan; /* ********** insert a file after the current line ********** */ insert_file: saveflag = 3; edct = 5; /* .. */ go to long_scan; ret_insert: call initiate_file_ (dirname, ename, RW_ACCESS, sptr, merge_bc, code); if sptr = null then do; /* try for just r access */ call initiate_file_ (dirname, ename, R_ACCESS, sptr, merge_bc, code); if sptr = null then go to new_error; /* Now print message */ end; ret_insert_default: segsize = divide (merge_bc+ 8, 9, 21, 0); call PUT; edata.lngth = 0; if segsize ^= 0 then do; substr (edata.tptr -> string, edata.indt + 1, segsize) = substr (sptr -> string, 1, segsize); edata.indt = edata.indt + segsize; edata.changed = "1"b; /* text edata.changed */ edata.isok = -1; edata.curlino = -1; end; go to next; /* ********* save ********* */ long_scan: edct = edct - 1 + verify (substr (buffer, edct + 1, count - edct), " "); /* do edct = edct to cm1 while (ed.lin (edct) = " "); end; */ scan_path: /* Code used to be here to guarantee no blanks in pathname */ lprinam = cm1 - edct; /* Derive length of rest of line (from first non-blank) */ if (lname + lprinam) = 0 then do; /* no default name, no given name => lose */ call com_err_ (0, me, "No segment name given in ^a request.", com_line); go to reset_io; end; if lprinam ^= 0 then do; /* use name given in this request */ np = addr (substr (buffer, edct + 1, 1)); /* get ptr to segname */ call expand_pathname_ (substr (buffer, edct+1, lprinam), dirname, ename, code); if code ^= 0 then do; /* funny path => lose */ badname: call com_err_ (code, me, "^a", xarg); go to reset_io; end; call check_entryname_ (ename, code); /* Is good name? */ if code ^= 0 then go to badname; if saveflag = 3 then go to ret_insert; /* "merge" request, initiate it above */ else do; /* write or upwrite */ call hcs_$make_seg (dirname, ename, "", 01010b, sptr, code); /* create if not found */ if sptr = null then go to new_error; /* can't do it => lose */ end; end; else do; /* use default name */ sptr = orig_ptr; /* see about default pointer */ if sptr = null then do; /* not good */ if saveflag = 3 then do; /* merge */ call com_err_ (0, me, "No default segment for merge request."); /* nothing there */ go to reset_io; /* lose */ end; else do; /* write or upwrite */ call hcs_$make_seg (dirnameo, enameo, "", 01010b, sptr, code); /* create if not found */ if sptr = null then go to error; /* can't do it -> lose */ end; end; else if saveflag = 3 then do; /* merge, pointer good, check access */ call hcs_$status_mins (sptr, type, merge_bc, code); /* and get bit count */ if code ^= 0 then go to error; /* no bit count, no editing */ else go to ret_insert_default; /* good news */ end; end; edata.curlino = -1; /* safety: assume line number is lost */ if saveflag = 0 then do; i = edata.indt; /* remember where we were */ call COPY; /* "w" request, note syntax check before copy */ end; else do; /* saveflag = 2, "upwrite" case */ i = 0; /* forget where we were */ if sptr = edata.fptr then /* if about to write into fromfile */ call CHECK_ORIG; /* must not use orig as fromfile */ end; /* "w" always does COPY so check not needed */ if edata.indt > i then substr (sptr -> string, i + 1, edata.indt - i) = /* first write block just COPY'd */ substr (edata.tptr -> string, i + 1, edata.indt - i); if i > 0 then substr (sptr -> string, 1, i) = /* now write the head */ substr (edata.tptr -> string, 1, i); call terminate_file_ (sptr, edata.indt*9, TERM_FILE_TRUNC_BC, code); if code ^= 0 then go to test_error; if saveflag = 2 then go to delete_top; edata.changed = "0"b; /* no unsaved changes after "w" */ Edata_pi.changed = "0"b; /* if "w" completes then pi won't undo it */ if edata.isok >= 0 then edata.isok = edata.indt; /* now have two identical buffers, and a file */ /* which is also identical. This is only possible */ /* with a virtual memory */ go to next; /* ********** call the command processor ********** */ callms: substr (buffer, 1, 1) = " "; /* no E */ call cu_$cp (addr (buffer), count, code); if active = 0 /* Did it get reset while we were out */ then call com_err_ (0, me, "Working buffers have been destroyed."); active = active + 1; /* In any case, say we are still active */ go to pedit; /* ********* eof ********* */ eof: call ioa_ ("EOF"); go to next; /* ********** FILE SYSTEM ERROR ********** */ test_error: if lprinam = 0 then do; /* see which name got error */ error: dnp = addr (dirnameo); enp = addr (enameo); end; else do; new_error: dnp = addr (dirname); enp = addr (ename); end; call COM_DE; /* print the error message */ go to reset_io; /* ********** return ********** */ return: return; /* ********* " I N T E R N A L P R O C E D U R E S " ********* */ FIND_LOCATE: proc; /* locate string, wraparound if necess */ dcl lptr ptr; dcl indl fixed bin (21); dcl lscan fixed bin (21); lptr = edata.fptr; /* search fromfile */ indl = edata.indf; lscan = edata.csize1 - edata.indf; where_found = 1; /* assume found in fromfile */ FLLOOP: /* try to find the string */ if locating = 0 then do; /* if finding */ if substr (lptr -> string, indl + 1, loclen - 1) /* then at top or next line */ = substr (locp -> string, 2, loclen - 1) then do; /* do not expect a prceeding newline */ i = 0; go to FLGOT; end; end; i = index (substr (lptr -> string, indl + 1, lscan), substr (locp -> string, 1, loclen)); if i = 0 then do; if where_found = 1 then do; where_found = -1; if edata.isok ^= -1 /* if fromfile = tofile */ then lptr = edata.fptr; /* touch pages of fromfile */ else lptr = edata.tptr; /* must touch tofile */ indl = 0; lscan = edata.indt; go to FLLOOP; end; else do; /* nowhere else to look */ where_found = 0; /* found nowhere */ return; end; end; FLGOT: if locating = 1 then do; /* if locating, we must get start of line */ k = index (reverse (substr (lptr -> string, indl + 1, i)), nl); if k ^= 0 then k = i - k + 1; /* chars to kopy */ end; else do; /* find */ k = i; /* kopy up to & inclding at start of found string */ end; end FIND_LOCATE; /* */ CHECK_ORIG: proc; if edata.fptr = orig_ptr /* if we are still using orig seg as fromfile */ then do; /* use a real fromfile in pdir */ edata.fptr = ptr2; /* note: at entry edata.tptr = ptr1, thus use other */ substr (edata.fptr -> string, 1, edata.csize1) /* now fill the new fromfile */ = substr (orig_ptr -> string, 1, edata.csize1); /* from his orig segment */ Edata_pi.fptr = ptr2; /* dont pi back to other */ end; end CHECK_ORIG; GET_BLOCK: proc (xp, xo, xc, xl) returns (fixed bin (21)); dcl xp ptr; /* points to base of some seg */ dcl xo fixed bin (21); /* offset where we start looking */ dcl xc fixed bin (21); /* is max nchars to examine */ dcl xl fixed bin (21); /* is number of lines to scan past */ dcl xx fixed bin (21); /* returned: is number of chars in block */ dcl (i, j, k) fixed bin (21); /* keep these real local */ if xl = 0 then return (0); /* not want any */ xx = 0; i = 0; do while (i < xl & xc-xx>0); j = index (substr (xp -> string, xo+xx+1, xc-xx), nl); if j = 0 then xx = xc; /* take all the rest */ else xx = xx + j; i = i + 1; end; if i < xl then return (-1); else return (xx); end GET_BLOCK; GET_NUM: proc; /* called by move_ to get extents */ i = i + verify (substr (buffer, i + 1, count - i), " ") -1; j = index (substr (buffer, i+1, count-i), " ") -1; if j < 0 then j = count - i - 1; N = cv_dec_check_ (substr (buffer, i+1, j), code); if code ^= 0 then go to numeric_err; if N < 0 then go to numeric_err; if N = 0 then go to nonesuch; end GET_NUM; /* */ clean: proc; /* cleanup handler for edm */ /* invoked when quit is done in edm and not started */ /* handler just truncates temporary segments */ /* in order to conserve pdir space */ /* and terminates input segment */ /* also used when exiting from edm */ dcl code fixed bin (35); call hcs_$truncate_seg (ptr1, 0, code); call hcs_$truncate_seg (ptr2, 0, code); if sptr ^= null then call terminate_file_ (sptr, 0, TERM_FILE_TERM, code); active = 0; /* Clear flag */ end clean; interrupt: proc; /* program interrupt handler */ /* if ^pi_allowed then user quit while Edata_pi being filled in, */ /* so we cant use Edata_pi, so we leave at state defined by edata. Note we were */ /* in the process of making a pi impossible anyway (since we were */ /* filling Edata_pi from edata) so the user has only lost the ability */ /* to quit/pi during a few microsec interval when the results would have been */ /* indeterminate anyway. */ /* Otherwise we use the Edata_pi to undo the last edit request. */ /* If did_move is on, then the last request was a move and we must */ /* put some text back where we got it. did_move is */ /* turned on AFTER move_data is safe to use, but BEFORE move_data is */ /* necessary to use for recovery. Further note that the moves made here */ /* using move_data are to locations which do not overlap sending locations */ /* which means that quit/pi occuring in this procedure */ /* are as so many NOP's */ if pi_allowed then do; edata = Edata_pi; if edata.lngth ^= 0 then substr (line, 1, edata.lngth) = substr (Line_pi, 1, edata.lngth); if did_move then do; /* restor buffs needed */ if move_data.xlen > 0 then substr (edata.fptr -> string, move_data.x1 +1, move_data.xlen) = substr (edata.tptr -> string, move_data.x2 +1, move_data.xlen); if move_data.ylen > 0 then substr (edata.fptr -> string, move_data.y1 +1, move_data.ylen) = substr (edata.tptr -> string, move_data.y2 +1, move_data.ylen); did_move = ""b; end; end; go to int_lab; /* go to pedit in initial invocation */ end interrupt; /* */ COM_DE: proc; /* errprint for truncate & bitcount errs */ call com_err_ (code, me, "^a>^a", dnp -> b168cu, enp -> b32cu); end COM_DE; /* */ /* FOLLOWING IP's are at end of pgm to be near pile of constants */ COPY: proc; /* copy rest of from file into to file */ call PUT; edata.lngth = 0; if ^edata.iflag then do; /* else new input, nothing to copy */ ij = edata.csize1 - edata.indf; if ij > 0 then do; if edata.isok >= 0 then do; mc_chars = edata.csize1 - edata.isok; edata.isok = edata.isok + mc_chars; end; else mc_chars = ij; mc_skip = ij - mc_chars; if mc_chars > 0 then substr (edata.tptr -> string, edata.indt + mc_skip + 1, mc_chars) = substr (edata.fptr -> string, edata.indf + mc_skip + 1, mc_chars); edata.indt = edata.indt + ij; edata.indf = edata.indf + ij; end; end; end COPY; COPY_BACK: proc; if edata.lngth ^= 0 then do; edata.indf = edata.indf - edata.lngth; substr (edata.fptr -> string, edata.indf + 1, edata.lngth) = substr (line, 1, edata.lngth); /* put current line back in from */ end; if bkover > 0 then do; /* move from tofile to fromfile */ edata.indf = edata.indf - bkover; /* set pointers */ edata.indt = edata.indt - bkover; substr (edata.fptr -> string, edata.indf + 1, bkover) = substr (edata.tptr -> string, edata.indt + 1, bkover); end; end COPY_BACK; /* */ SWITCH: proc; /* make from-file to-file, and v.v. */ if edata.tptr = ptr1 then do; edata.tptr = ptr2; edata.fptr = ptr1; end; else do; edata.tptr = ptr1; edata.fptr = ptr2; end; edata.csize1 = edata.indt; edata.isok, edata.lngth, edata.indt, edata.indf = 0; edata.iflag, edata.eof_ = "0"b; return; end SWITCH; PRINT_CURLINE: proc; /* print the current line or "Noline." */ if edata.lngth = 0 then call ioa_ ("No line."); else call iox_$put_chars (iox_$user_output, addr (line), edata.lngth, code); end PRINT_CURLINE; /* */ GET_LINES: proc; /* get not more than mg_lines totalling <= mg_chars */ g_chars = 0; g_lines = 0; GLOOP: nxlen = index (substr (edata.fptr -> string, edata.indf + 1 + g_chars, mg_chars - g_chars), nl); if nxlen ^= 0 then do; g_chars = g_chars + nxlen; g_lines = g_lines + 1; if g_lines < mg_lines then go to GLOOP; end; end GET_LINES; MOVE_CHARS: proc; /* move block of lines, keep linno if possible */ if g_chars ^= 0 then do; if edata.isok >= 0 then do; /* if not -1 then >= edata.indt */ mc_chars = edata.indf + g_chars - edata.isok; if mc_chars < 0 then mc_chars = 0; else edata.isok = edata.isok + mc_chars; end; else mc_chars = g_chars; mc_skip = g_chars - mc_chars; if mc_chars >0 then substr (edata.tptr -> string, edata.indt + mc_skip + 1, mc_chars) = substr (edata.fptr -> string, edata.indf + mc_skip + 1, mc_chars); edata.indt = edata.indt + g_chars; edata.indf = edata.indf + g_chars; end; if edata.curlino ^= -1 then do; edata.curlino = edata.curlino + g_lines; end; end MOVE_CHARS; INPUT: proc; /* IP for input mode, near PUT to save pageflts */ if ^waketable_is_set then do; /* first time input */ unspec (swt) = ""b; swt.version = swt_info_version_1; swt.new_table.wake_map (46) = "1"b; /* octal 56 a period */ call iox_$control (iox_$user_io, "set_wakeup_table", addr (swt), code); waketable_is_set = "1"b; end; call iox_$modes (iox_$user_io, "wake_tbl", "", (0)); input: call iox_$get_line (iox_$user_input, bufp, prc, count, code); /* read a line */ if count = 2 then /* check for mode change */ if substr (buffer, 1, 1) = "." then do; /* ret to caller, thence editing */ call iox_$modes (iox_$user_io, "^wake_tbl", "", code); return; /* from internal proc */ end; call PUT; /* pseudo call */ edata.changed = "1"b; edata.isok = -1; edata.eof_ = "0"b; edata.lngth = count; substr (line, 1, edata.lngth) = substr (buffer, 1, edata.lngth); /* move line inputted into intermediate storage */ go to input; /* repeat 'til "." */ end INPUT; PUT: proc; /* put current "line" into to-file */ if edata.lngth ^= 0 then do; /* ignore Nolines. */ if edata.curlino ^= -1 then do; if index (substr (line, 1, edata.lngth), nl) ^= edata.lngth then edata.curlino = -1; /* we could try harder here */ else edata.curlino = edata.curlino + 1; end; if edata.indt >= edata.isok then do; substr (edata.tptr -> string, edata.indt+1, edata.lngth) = substr (line, 1, edata.lngth); end; edata.indt = edata.indt + edata.lngth; /* set counters */ if edata.isok >= 0 then if edata.isok < edata.indt then edata.isok = edata.indt; end; return; end PUT; GET: proc; /* load next line from from-file into "line" */ scanlen = edata.csize1 - edata.indf; if scanlen = 0 then do; edata.eof_ = "1"b; edata.lngth = 0; return; end; else if scanlen > 152 then scanlen = 152; edata.eof_ = "0"b; edata.lngth = index (substr (edata.fptr -> string, edata.indf + 1, scanlen), nl); if edata.lngth = 0 then do; edata.lngth = min (151, scanlen); /* leave room to for user to add newline */ if scanlen = 152 then /* were >= 152 chars but no newline */ call com_err_ (0, me, error_message); /* complain */ end; substr (line, 1, edata.lngth) = substr (edata.fptr -> string, edata.indf + 1, edata.lngth); edata.indf = edata.indf + edata.lngth; /* now set indf */ end GET; /* */ SAVE: proc; /* IP to make pi possible */ pi_allowed = ""b; /* dont allow while munging data */ Edata_pi = edata; substr (Line_pi, 1, edata.lngth) = substr (line, 1, edata.lngth); did_move = ""b; /* edata, Edata_pi do not differ by a move to undo */ /* In fact they dont differ at all */ /* did_move ^= ""b when a move must */ /* be undone to make Edata_pi come true */ pi_allowed = "1"b; /* now pi is ok, a NOP until edata changes */ end SAVE; /* */ /* DEBUGGING CODE -- better to rob a pyramid than delete this code -- REM CKLINO: proc; call GET_LINO; if edata.curlino = -1 then do; edata.curlino = gotlino; end; else do; if edata.curlino ^= gotlino then do; call ioa_ ("curlino ^d should be ^d", edata.curlino, gotlino); edata.curlino = gotlino; end; end; end CKLINO; CKISOK: proc; if edata.isok < -1 then call ioa_ ("isok = ^d", edata.isok); else if edata.isok ^= -1 then do; if edata.indt + edata.lngth ^= edata.indf then call ioa_ ("indt = ^d, lngth = ^d, indf = ^d", edata.indt, edata.lngth, edata.indf); else do; if substr (edata.tptr -> string, 1, edata.indt) ^= substr (edata.fptr -> string, 1, edata.indt) then call ioa_ ("files differ, but isok = ^d", edata.isok); if substr (line, 1, edata.lngth) ^= substr (edata.fptr -> string, edata.indf + 1 - edata.lngth, edata.lngth) then call ioa_ ("line and fromfile differ, edata.isok = ^d", edata.isok); end; end; end CKISOK; EDUMP: proc; call ioa_ ( "fptr ^p, indf ^d, iflag ^w, csize1 ^d, tptr ^p, indt ^d, eof ^w, changed ^w, lngth ^d, curlino ^d, isok ^d", edata.fptr, edata.indf, edata.iflag, edata.csize1, edata.tptr, edata.indt, edata.eof_, edata.changed, edata.lngth, edata.curlino, edata.isok); end EDUMP; otize: if num_err ^= 0 then go to numeric_err; dcl (cklinsw, ckisoksw, dumpsw) bit (1) aligned init ("0"b); if n = 1 then do; readysw = "1"b; cklinsw = "0"b; ckisoksw = "0"b; dumpsw = "0"b;end; else if n = 2 then readysw = "0"b; else if n = 3 then do; cklinsw = "1"b; readysw = "0"b; end; else if n = 4 then cklinsw = "0"b; else if n = 5 then do; ckisoksw = "1"b; readysw = "0"b; end; else if n = 6 then ckisoksw = "0"b; else if n = 7 then do ; dumpsw = "1"b; readysw = "0"b; end; else if n = 8 then dumpsw = "0"b; else if n > 9 then do; if n < 64 then chunk = divide (chunk, 4, 17, 0); else chunk = n; call ioa_ ("^d word chunks", chunk); chunk = chunk * 4; end; go to next; /* END DEBUGGING CODE */ end edm; */ ----------------------------------------------------------- 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 */