MVOLSYSX,-. 31-MAR-90.Generated by mvol on Mon Apr 09 12:57:57 2012[ {plh[J ah[h-h[0bh[WQh[Wzh[ gh[ L h[ Azh[ h[a h[|_h[u]m+h[cBfh[; iKh[a h[iKVOh[MiKh[|iK h[h[nqh[%List; %list; %list %include "ACCNT:specs.inc" %include "ACCNT:DA.inc" %include "ACCNT:recordIO.inc" %external %integer %fn %spec SIZE OF (%name object) %record %format parm fm (%short dsno, dact, ssno, sact, (%integer p1,p2,p3,p4,p5,p6 %or %string(23) text)) %record %format pack fm (%integer unit, user, f1, f2, %string(31) string) %begin; !EDIT updates/listing !streams, files %const %integer command = {input} 1, report = {output}0, listing = {output}1 %const %string(3) LP dev = "LP:" %const %string(31) account file = "ACCNT:MAIN" %string(63)%name out1 == string (comreg(4)) out1 = LP dev %if out1 = "" !globals %record %format group (%integer unit, user, %byte size, {no. in group} from, to,{bounds: FRED01..10} single) {TRUE: no suffix "nn"} %const %integer true = 0, false = 1 %const %integer fault = {event} 11, to director = {svc} 20 %own %integer no list = true; !no listing file generated yet %const %record(*)%name null == (0) %record(account)%name hdr; !account file header record %const %integer last cmd = 4 %own %string(15) %array cmd(1:last cmd+1) = "NEW", "EXILE", "SHOW", "EXIT", "" %own %record(account)%name dummy == null %const %integer file = {DA channel no} 1 %own %integer sep = NL; !after TOKEN !specs %routine %spec bit set (%integer j); !bitmap access procedures %routine %spec bit clear (%integer j);!(Map is held n HDR record) %routine %spec set bit (%integer j) %string(15) %fn %spec itos (%integer n,places) %routine %spec error (%string(63) mess); !log MESS & %signal FAULT %routine %spec skip; !ignore spaces/control chars %routine %spec token (%string(15)%name s); !letters/digits: sets SEP %integer %fn %spec lookup (%string(15) s, %string(155)%arrayname table) %routine %spec get names (%record(group)%name g); !encode "FRED[m..n]" %routine %spec for all (%record(group)%name g, %routine X (%record(pack fm)%name u)) %routine %spec create user (%record(pack fm)%name u) %routine %spec exile user (%record(pack fm)%name u) %routine %spec printaccount(%record(pack fm)%name u) %routine %spec paccnt (%record(account) A) %routine %spec suffix (%string(*)%name s, %integer suffix) !"FRED",3 -> "FRED03" !open files open (file,SIZE OF(dummy),account file) hdr == REC (file,0) prompt ("EDIT:") %record(account)%name A %integer j %string(15) s %record(group) g %switch C(1:last used) %label CC %cycle skip symbol %and skip %while next symbol = NL token (s) j = look up (s,cmd) %if j < 0 %start C(*): error (s . "?") %finish -> C(j) C(1): !new get names (g); ! for all (g,create user) ->CC C(2): !exile get names (g) for all (g,exile user) ->CC C(3): !show skip %if next symbol = NL %start %for j = offset, 1, max user + offset %cycle %if bit set (j) %start A == REC (file,j) Paccnt (A) %if A_user # 0 %finish %repeat %else get names (g) for all (g,print account) %finish ->CC C(4): !exit close account file close (file) select output (listing) %if no listing = true %then abandon output %c %else close output %stop CC: skip error (" ignored") %if next symbol # NL %repeat %routine error (%string(63) mess) print symbol ('*') %if next symbol # NL %start print symbol ('"') %while next symbol # NL %cycle print symbol (next symbol) skip symbol %repeat print symbol ('"') space %finish print string (mess) newline %signal fault %end %routine skip skip symbol %while next symbol <= ' ' %end %routine token (%string(15)%name t) %integer ch t = ""; skip %cycle ch = next symbol ch = ch - 'a' + 'A' %if 'a' <= ch <= 'z' %exit %unless 'A' <= ch <= 'Z' %or '0' <= ch <= '9' t <- t . to string (ch) %repeat sep = ch skip symbol %if ch # NL skip %end %integer %fn lookup (%string(15) s, %string(15)%arrayname table) %string(15)%name t %integer j = 0 %cycle j = j + 1; t == table(j) %result = -1 %if t = "" %result = j %if s = t %repeat %end %routine get names (%record(group)%name g) %record(pack fm) u,v %string(15) t %label NO DOT u_string = "" g = 0; g_size = 1; g_single = true %cycle token (t); u_string <- u_string . t %exit %if sep = NL %or sep = ',' %or sep = '[' u_string <- u_string . to string (sep) %repeat u_string = u_string . ":" %if u_string = "" %or char no (u_string,length(u_string)) # ':' pack (u) error (u_string . " invalid username") %if u_user < 0 %or u_f1 # 0 %or u_f2 # 0 g_unit = u_unit; g_user = u_user %if sep = '[' %start g_single = false v = 0; v_user = u_user; unpack (v) suffix (v_string,99); !FAULT signalled if too long token (t) g_from = stoi (t) %if sep # '.' %start NO DOT: error ("expecting '.'") %finish token (t); -> NO DOT %if t # "" %or sep # '.' token (t); g_to = stoi (t) g_size = g_to - g_from + 1 error ("Bounds inside-out") %if g_size <= 0 error ("expecting ']'") %if sep # ']' token (t) error (t . "?") %if t # "" %finish %return %if sep = ',' %or sep = NL error (to string(sep) . "?") %if sep # ':'; !optional : in username token (t) error (t . "?") %if t # "" %end %routine for all (%record(group)%name g, %routine X (%record(pack fm)%name u)) !G is expanded as a list of packed usernames. !We call X to process each user in the list. %record(pack fm) u = 0 %integer who = g_user, j %string(31) s u_unit = g_unit; u_user = who %if g_single = true %then X(u) %else %start unpack (u) s = u_string length(s) = length(s) - 1; !lose ':' from username %for j = g_from, 1, g_to %cycle u_string = s suffix (u_string,j) pack (u) X(u) %repeat %finish %end %routine suffix (%string(*)%name s, %integer n) %string(63) u = s; length(u) = length(u) - 1 %string(3) t error (itos(suffix,0) . " not in 0..99") %unless 0 <= suffix <= 99 t = itos (suffix,2) char no (t,1) = '0' %if char no (t,1) = ' ' error (u . t . ": too long") %if length(u) + length(t) > 6 s = u . t . ":" %end %string(15) %fn itos (%integer n,places) %string(15) s = "" %integer sign = n; n = |n| %cycle s = to string (rem(n,10)+'0') . s n = n // 10 %repeat %until n = 0 s = "-" . s %if sign < 0 s = " " . s %while length(s) < places %result = s %end %routine paccnt (%record(account) A) %record(pack fm) u = 0 u_unit = A_unit; u_user = A_user unpack (u) print string (u_string) newline %end %routine print account (%record(pack fm)%name u) %record(account)%name A == USER INFO (u_user) %return %if A_user = 0; !non-existant user paccnt (A) %end %routine create user (%record(pack fm)%name u) %record(account)%name new == USER INFO (u_user) %record(parm fm) P P_p1 = u_unit; P_p2 = u_user; P_p3 = packed PASS P_dact = 31; !new user SVC (to director,P) %if P_p6 # 0 %start unpack (u) print string ("*Create " . u_string . " fails -- ") print string (P_text) newline %return %finish %if new_user # 0 %start unpack (u) print string (u_string . " already exists") newline %return %finish new_unit = u_unit; new_user = u_user set bit (new_index); !accnt record holds own index %end %routine exile user (%record(pack fm)%name u) %record(account)%name who == USER INFO (u_user) %record(parm fm) P %integer index P_p1 = u_unit; P_p2 = u_user P_dact = 32; !EXILE SVC (to director,P) %if P_p6 # 0 %start unpack (u) print string ("*Exile " . u_string . " fails -- ") print string (P_text) newline %return %finish %if who_user = 0 %start print string ("*Exile fails -- ") unpack (u) print string (u_string . " does not exist") newline %return %finish index = who_index; !splat account, preserve INDEX who = 0 who_index = index clear bit (who_index) %end %routine set bit (%integer j) %integer k = j>>3, m = j&7 hdr_abyte(j) = hdr_abyte(j) ! 1<>3, m = j&7 hdr_abyte(j) = hdr_abyte(j) & (\(1<>3, m = j&7 %true %if hdr_abyte(j) & 1< ".header); newline f_unit = 0; f_owner = 0 unpack(f, new file) open output(2, new file) %if comreg(0) # 0 %start report("Cannot create ".new file, 0) %return %finish select output(2) %cycle read tape(addr(b(0)), 2048) k = 1 limit = 2048 %if b(0) = 0 %start limit = limit-1 %while b(limit-1) = 4 %finish %while k # limit %cycle printsymbol(b(k)) k = k+1 %repeat %exit %if b(0) = 0 %repeat close output select output(1) %end %routine restore user files(%string(63) which, %integer x) %record(blockfm) BL %record(packfm) f %if which = "" %or x # 0 %start f = 0 %else pack(which, f) %finish %cycle skip forward read tape(addr(bl), 63) %exit %if bl_text = eot printstring("Label: ".bl_text); newline %cycle read tape(addr(bl), 63) %exit %if bl_text = em %or int # "" %if x = 0 %or bl_index&H = x %start read file(bl_text, f) %return %if x # 0 %finish skip forward %repeat %exit %if int # "" %repeat int = "" rewind %end %routine analyse tape(%record(packfm)%name f) %record(blockfm) BL %string(63) label %record(packfm) ff %integer k rewind read tape(addr(bl), 63) printstring("Tape identifier: ".bl_text); newlines(2) %cycle skip forward read tape(addr(bl), 63) ->err %if error # 0 %exit %if bl_text = eot label = bl_text %cycle %if int # "" %start int = "" rewind %return %finish read tape(addr(bl), 63) %if error # 0 %start err: report("Tape read error ", error) %return %finish %exit %if bl_text = em pack(bl_text, ff) %if ff_owner >= 0 %start %if (f_unit = 0 %or f_unit = ff_unit) %and %c (f_owner = 0 %or f_owner = ff_owner) %start %if label # "" %start newlines(2); printstring("Label: ".label) newline k = 0 label = "" %finish newline %and k = 3 %if k <= 0 k = k-1 write(bl_index&H, -8); space print string (bl_text); spaces (30 - length(bl_text)) %if k # 0 %finish %finish skip forward %repeat %repeat newline; printstring("***end of tape***"); newline %end int == string(comreg(15)) printstring("Archive version ".version); newlines(2) claim tape prepare terminal rewind %if exclam = 0 %start; !old tape read tape(addr(bl), 63) printstring("Tape ".bl_text); newline skip forward %finish prompt("Archive:") %cycle used = 0 int = "" read word(word) %if word = "DUMP" %start read word(word) %if word = "USER" %start read word(word) pack(word.":", f) dump user files(F) %else %if word = "UNIT" read word(word) pack(word."_x:", f) f_owner = 0 dump user files(f) %else report("UNIT or USER wanted", 0) %finish %else %if word = "IDUMP" read word(word) pack(word."_X:", f) f_owner = 0 used = 1 dump user files(f) %else %if word = "RESTORE" rewind x = 0 read sym %while sym = ' ' %if sym = '#' %start read(x) restore user files("", x) %if x > 0 %else read word(key) read word(word) %if key = "UNIT" %start restore user files(word."_:", 0) %else %if key = "USER" restore user files(word.":", 0) %else %if key = "FILE" restore user files(word, 0) %else report("UNIT, USER, or FILE wanted", 0) %finish %finish %else %if word = "ANALYSE" read word(word) f = 0 pack(word.":", f) %unless word = "" analyse tape(f) %else %if word = "LABEL" sp = 0; read word(head text) length(head text) = 31 %if length(head text) > 31 %else %if word = "INITIALISE" %if exclam = 0 %start printstring("Initialise not permitted"); newline %continue %finish rewind sp = 0; read word(word) word = word." - Dated ".date." at ".time rewind tape mark skip reverse write tape(addr(word), 63) tape mark BL_text = EOT; BL_index = 0; BL_spare = 0 write tape(addr(BL), 63) printstring("Tape identified as ".word); newline %else %if word = "HELP" %or word = "?" select output(0) printstring(" Analyse Analyse unit extn Analyse user fred Dump unit extn Dump user sys5_fred Idump unit Exit Help Initialise tape-id Label anything Restore unit extn Restore user extn_fred Restore file extn_fred:file1.imp Restore # filnum ") selectoutput(1) %else stop %if word = "EXIT" %or word = "STOP" report("Unknown command ".word, 0) %unless word = "" %finish read sym %while sym # nl sym = ' ' %repeat %endofprogram H?K@?@ZI! !The currently available disc utility commands are: ! ! DISC(TEST) disc/,listing ! Check the integrity of logical disc unit 'disc'. A listing ! of the names and sizes {FILENAME (blocks,extents)} of all ! files on that disc are sent to output stream 2 ('listing') ! 'Disc' is either the logical name of a loaded disc unit, ! (e.g. "SYS7","EXTN") or the unit number of the drive the ! logical disc is mounted on, preceded by a '#'. E.g. '#1' ! (the first cartridge disc, device address X'C6'). ! 'Listing' may be any valid output stream destination, a ! queue, (LP:, PP:) a file (FRED.LST, $1) or a device (T:). ! ! DISC(COMPRESS) disc1/disc2,listing ! The logical contents of 'disc1' are copied onto 'disc2', ! being compressed into a minimally fragmented form in the ! process. A 'listing' of the output disc may be produced ! if required. Examples: ! DISC(COMPRESS) SYS7/#5 ! DISC(COMPRESS) #1/JIM,LP:newJIM.lst ! ! DISC(COPYUSERS) disc1/disc2,listing ! DISC(COPYUSER) disc2/disc2,listing ! These two are synonymous, and perform the same function as ! COMPRESS, on a selected group of users from 'disc1'. When ! the program starts, you will be prompted "Copy:", to which ! you should reply with a list of usernames from 'disc1', seperated ! by commas or newlines, and terminated by the dummy name ".END". ! E.g. DISC(COPYUSER) FRED/JIM ! Copy: XXX, YYY ! Copy: A, BB ! Copy:.end ! (This will copy users FRED_XXX, FRED_YYY, FRED_A and FRED_BB ! onto disc JIM. ***JIM WILL BE OTHERWISE EMPTY AFTER THIS ! OPERATION***, i.e. any existing users on JIM will be overwritten). ! ! DISC(TIDY) disc ! The free list on 'disc' is reconstructed. As many 'lost blocks' ! as possible are reclaimed and put on the new free list. ! ! DISC(COPY) disc1/disc2 ! This operation is a mindless track-by-track image dump of disc1 ! onto 'disc2'. No compression is performed. Note that if an ! attempt is made to copy a disc onto a different physical type ! of unit, block zero in the dumped disc will indicate the old ! type of drive, this should be avoided. COPY is mainly to ! enable the operator make copies of discs not recorded in MOUSES ! format. (Any disc may be copied since no interpretation is placed ! on the data on the disc: the number of blocks to be copied is ! prompted for at the operator's console). ! ! DISC(INITIALISE) /disc ! The operator supplies various bits of information to be recorded ! on block zero of 'disc' to identify it in the future. (Volume ! serial number, disc name and description etc). The directory ! structure of the 'disc' is then wiped clean, leaving no users ! with no files on the disc. ! All 'blank' discs when received by an installation must be ! initialised before the system will LOAD them. ! ! DISC(WIPE) /disc ! As for initialise, except that the contents of block zero remain ! unaltered. Used to clean out a corrupted disc. ! ! DISC(ZERO) /disc ! Allows the operator to alter the contents of block zero. ! (In order to resurrect dead discs). Pointers in block zero ! (to free list etc) are simply set to their preferred values ! while keeping fingers firmly crossed... ! ! DISC(KILL) /disc ! Block zero of the 'disc' is overwritten with an invalid pattern. ! All data on the disc is destroyed. The disc can no longer be LOADed ! by the system. (It must be re-INITIALISEd first). !\ ! !New MOUSES disc utility program. A. Culloch, July 1980. %const %string(31) version = "V2.02" !2.02: Bug fix in COPY SYSTEM. 30-JUN-81 (ADC) %include "sysinc:command.inc" %const %string(31) program source = "crash:DISC" %external %routine %spec doing (%string(12) activity) !User may interrogate current value of ACTIVITY by !using the system's '^G' facility. !System message format %include "SYSINC:PARMFM.INC" !File system disc block formats %record %format extent (%short length, {# of contiguous blocks in extent} %short base) {disc addr of first block} %record %format spine (%short extents, {# of extents in file} %byte access permissions, check, {should always be '?'} %integer blocks,{# of blocks in file} %record(extent) %array extent (1:126)) %record %format file (%integer name1, name2, {packed filename} %short spine block, {disc addr of file's spine} %short day) {date last written} %const %integer dollar hash = x'C000 0000' {&NAME1#0 => temp file} %record %format directory(%short files, {# of files in directory} %byte access rights, {user access} %byte check, {always '?'} %short unused, %byte spare, %byte access permissions,{directory access} %record(file) %array file (1:42)) %record %format user (%integer name, password, %short dir block, {disc addr of user dir} %short spare) %record %format userlist(%short users, spare1, {# of users on unit} %integer spare2, %record(user) %array user (1:42)) !Block zero on every logical disc %record %format zero fm (%integer vol id, {m'VOLN'} %string(7) disc id, {"SVOL"} %integer free list, {free blocks spine} user list, {user catalog} defective list,{bad blocks list} %integer system area, {start of system image} system size, {N contiguous blocks} %string(11)initialisation date, %integer tracks, {physical disc info} blocks per cylinder, heads, %integer initialised, {=0 => Disc WIPED O.K.} %integer copied, %integer checksum, {sum(blockzero)-1 = 0} %string(187) description,{of logical disc contents} %integer marked, {V2.00+: Disc INITIALISED O.K.} %byte %array spare (1:252)) %record %format block (%record(spine) S %or %record(directory) D %or %record(user list) U %or %record(zero fm) Z) {bad blocks list and free {list are just perverted {spine blocks !System constants %const %integer disc read = 101 {read from absolute disc address} %const %integer disc write = 102 {write absolute disc block} %const %integer read segment = 106 {read N contiguous blocks at abs disc ad} %const %integer write segment = 107 {write N contiguous blocks} %const %integer disc status = 108 %const %integer pack filename = 17 %const %integer unpack filename = 18 %const %integer to director = 20 %const %integer unit name = 40 %const %integer find disc = 45 {map packed disc-id => unit#} %begin !Events trapped in program %const %integer input ended = 9 {end of file} %const %integer total failure = 11 {signalled by GET space routine} {I/O stream names} %const %integer console = 0, listing = 2, help text = 3 %record %format disc (%integer unit no, {unit# disc is mounted on} %integer unit, {packed unit-name} %integer blocks, {size of logical disc} %integer FP, {first free block pointer} %integer prot, {non-zero => write-prot disc} %integer errors, {# of errors found on disc} %record(zero fm) zero,{copy of block zero} %integer %array bitmap (0:2047)) %record(disc) in, out {disc descriptors} %const %integer H = 16_FFFF {halfword mask} %const %integer non zero = 1 %const %integer sys size = 256 {size of system image on disc} %const %integer default free list=300 {preferred value} %const %string(31) corrupt = " corrupt pointer to ", nocheck = " invalid check byte in " {error messages} %const %integer commands = 13 %const %string(15) %array command word (1:commands) = "TEST", {perform integrity checks on disc} "COMPRESS", {copy & compress logical disc unit} "INITIALISE", {let operator set up disc block zero} "WIPE", {clear directory structure on disc} "KILL", {write bad block zero onto disc} "ZERO", {alter selected fields in block 0} "COPY", {brainless copy of N blocks} "HELP", {copy the start of the source to TTY} "COPYUSER", {compress selected users from a disc} "COPYUSERS", {synonymous with COPYUSER} "TIDY", {recreate free list on disc} "RENAME", {alter logical name of a disc} "LIST" {just user listing} %const %integer single block = 1 {mnemonic} %integer errors = 0 {see ERROR logging routine} %integer testing = 0 {#0 => "TEST" parameter given} %integer splatting = 0 {#0 to inhibit block-0 validation {in the SET DISC routine} %integer copy user {flag} = 0 {#0 => only copy selected users} %integer wanted users = 0 {number of the chosen few} %integer exclam = COMMAND_modifier %integer %array wanted user (1:42) {Their packed names} %routine clear out errors = 0 testing = 0 splatting = 0 copy user = 0 wanted users = 0 %end %predicate wanted (%integer packed name) %integer j %for j = 1,1,wanted users %cycle %true %if packed name = wanted user (j) %repeat %false %end !Utility routines %integer %fn stoi (%string(15) s) %byte %name b %integer j = 0, k, sign = 1 %result = 0 %if s = "" sign = -sign %if s -> ("-") . s %for k = 1,1,length(s) %cycle b == char no (s,k) %result = -1 %unless '0' <= b <= '9' j = 10*j + (b-'0') %repeat %result = sign*j %end %string(15) %fn itos (%integer j) %string(15) s = "" %integer n = | j | %cycle s = to string (rem(n,10)+'0') . s n = n // 10 %repeat %until n = 0 s = "-" . s %if j < 0 %result = s %end %routine normalise (%string(*)%name s) {Kill ' 's & force upper case} %string(63) t %byte %name b %integer j s = s . t %while s -> s . (" ") . t %for j = 1,1,length(s) %cycle b == char no (s,j) b = b - 'a' + 'A' %if 'a' <= b <= 'z' %repeat %end %routine scan (%string(*)%name s) %on %event input ended %start s = s . ",.END"; %return %finish s <- "" skip symbol %while next symbol <= ' ' %while next symbol >= ' ' %cycle s <- s . to string (next symbol) skip symbol %repeat normalise (s) %end %routine set bit (%integer %array %name bitmap, %integer index) %integer j = index>>5, k = index&31 bitmap(j) = bitmap(j) ! 1<>5, k = index&31 bitmap(j) = bitmap(j) & (\(1<>5, k = index&31 %true %if bitmap(j) & 1< 0 %and 0 <= base < D_blocks %and base + length <= D_blocks %for j = base, 1, base + length - 1 %cycle %false %if bit set (D_bitmap,j) {overlaps blocks on other files?} set bit (D_bitmap,j) %repeat %true %end %integer %fn checkword (%record(zero fm)%name Z) !Calc check word for block zero %integer j, k = 0 k = k + integer(j) %for j = addr(Z), 4, addr(Z) + 512 - 4 %result = 1 - k %end %byte %fn checksum (%record(*)%name spine) %integer j, k k = 0; k = k + byte integer(j) %for j = addr(spine),1,addr(spine) + 511 %result = (-k) & 16_FF %end %routine read block (%record(disc)%name D, %integer block no, %record(*)%name buffer) %record(parm fm) P P_p1 = block no&H; P_p2 = addr(buffer); P_p3 = D_unit no; P_p4 = 0 SVC (disc read,P) %if P_p1 # 0 %start report ("Disc read error " . itos(P_p1) . " from unit #" . %c itos(D_unit no) . " at block #" . itos(block no)) %finish %end %routine write block (%record(disc)%name D, %integer block no, %record(*)%name buffer) %record(parm fm) P %return %if D_unit no = 0 {null} P_p1 = block no&H; P_p2 = addr(buffer); P_p3 = D_unit no; P_p4 = 0 SVC (disc write,P) %if P_p1 # 0 %start report (D_zero_disc id . " protected") %and %stop %if D_prot # 0 report ("Disc write error " . itos(P_p1) . " to unit #" . %c itos(D_unit no) . " at block #" . itos(block no)) %stop %finish %end %routine list (%record(disc)%name D) !Uses CLEAR BIT rather than splatting D_BITMAP !before traversing the disc so that the operation !is transparent as far as the bitmap is concerned %record(parm fm) P %record(spine) spine block %record(user list) users %integer j, k, files, user count, blocks, total, free %string(63) s %record(user)%name u %record(directory) dir %record(file)%name f doing ("Disc listing") select output (listing) report ("Dump of " . D_zero_disc id) clear bit (D_bitmap,D_zero_user list) %return %unless valid block (D,D_zero_user list) read block (D,D_zero_user list,users) user count = 0; total = 0 %for j = 1,1,42 %cycle u == users_user(j) %if u_name # 0 %start user count = user count + 1 newline P = 0; P_p2 = u_name; SVC (unpack filename,P) report (P_filename) clear bit (D_bitmap,u_dir block) %if 0 <= u_dir block < D_blocks %return %unless valid block (D,u_dir block) read block (D,u_dir block,dir) files = 0; blocks = 0 %for k = 1,1,42 %cycle f == dir_file(k) %if f_name2 # 0 %start newline %if rem(files,3) = 0 files = files + 1 P = 0; P_p3 = f_name1; P_p4 = f_name2 SVC (unpack filename,P) P_filename = " " . P_filename %while length(P_filename) < 15 print string (P_filename) %if 0 <= f_spine block < D_blocks %start clear bit (D_bitmap,f_spine block) %finish %if %not valid block (D,f_spine block) %start error (P_filename . " corrupt") s = "*CORRUPT*" %else read block (D,f_spine block,spine block) blocks = blocks + spine block_blocks&H s = " (" . itos (spine block_blocks&H) . "," . %c itos (spine block_extents). ")" %finish s = s . " " %while length(s) < 10 print string (s) %finish %repeat blocks = blocks + files {remember spines themselves} newline write (files,8); print string (" file") print symbol ('s') %if files # 1; print symbol (',') write (blocks,1); print string (" block") print symbol ('s') %if blocks # 1 newline total = total + blocks %finish %repeat total = total + user count {directory blocks} %c + single block {block zero} %c + 3 * single block {free,user,defective} total = total + D_zero_system size newlines (3); spaces (3) print string (D_zero_disc id . ": "); write (user count,0) print string (" users") newline write (total,8); print string (" blocks in use"); newline free = D_blocks - total {used blocks} write (free,8); print string (" free blocks (") free = 100*free//D_blocks {%} free = 0 %if free < 0 write (free,0); print string ("%)"); newline select output (console) {again} %end %routine tidy (%record(disc)%name D) !Creates a new free list on D holding all blocks !not claimed so far (BITMAP entries not SET). %record(extent) e, swap %integer j, k, flag, lost = 0 %record(spine) new free list = 0 %return %if D_unit no <= 0 %record(extent)%name this, that, victim doing ("free list") k = 0; k = k + 1 %while \D_bitmap(k) = 0 {find a clear bit} j = 32*k %while j < D_blocks %cycle %if %not bit set (D_bitmap,j) %start {start of a free extent} e_base <- j; e_length = 0 %cycle e_length <- e_length&H + 1 j = j + 1 %repeat %until j >= D_blocks %or bit set (D_bitmap,j) !now put this extent in NEW FREE LIST %if new free list_extents < 126 %start new free list_extents = new free list_extents + 1 new free list_extent(new free list_extents) = e %else !Free list full -- throw away smallest !existing extent (the VICTIM) if it's smaller than 'E'. victim == new free list_extent(1) {perhaps} %for k = 1,1,126 %cycle this == new free list_extent(k) victim == this %if this_length&H < victim_length&H %repeat %if e_length&H <= victim_length&H %start {VICTIM is spared} lost = lost + e_length&H %else report ("reject") lost = lost + victim_length&H victim = e %finish %finish %finish j = j + 1 %repeat !Sort new free list by ascending base address %if new free list_extents = 0 %start error(d_zero_disc id.": empty free list?") %else %cycle flag = 0 this == new free list_extent(1) %for j = 2,1,new free list_extents %cycle that == new free list_extent(j) %if this_base&H > that_base&H %start swap = this; this = that; that = swap flag = non zero %finish this == that %repeat %repeat %until flag = 0 %finish new free list_check = 0 !DIRECTOR uses FREE_EXTENTS really as a !lost blocks counter, which we must initialise. new free list_extents = lost new free list_check = checksum (new free list) write block (D, D_zero_free list, new free list) %end %routine validate free list (%record(disc)%name D) %record(spine) free %record(extent)%name e %integer j, free blocks = 0, last !This routine checks that no blocks allegedly !on the free list are in fact part of the !directory structure of the disc. (In which !case their bits in the bitmap will be SET). doing ("freelist chk") read block (D, D_zero_free list, free) report (D_zero_disc id . ": ". itos(free_extents) . " lost blocks") %c %if free_extents # 0 {DIRECTOR counts lost blocks there} %if checksum (free) # 0 %start error (D_zero_disc id . ": " . no check . "free list") %return %finish last = 0 %for j = 1,1,126 %cycle e == free_extent(j) %if e_base = 0 %start %cycle %if e_base # 0 %or e_length # 0 %start error(d_zero_disc id.": incomplete free list") %return %finish %exit %if j = 126 j = j+1 e == free_extent(j) %repeat %exit %finish %if e_base&H <= last %start error (D_zero_disc id . ": free list out of order") %finish last <- (e_base + e_length)&H %if valid extent (D,e) %start free blocks = free blocks + e_length&H %else error (D_zero_disc id . ": corrupt free list") %finish %repeat report ("free blocks: " . itos(free blocks)) %end %routine get (%record(disc)%name D, %record(extent)%name free, %integer max size) !A contiguous extent of up to MAX SIZE blocks !is claimed from the OUTPUT disc, and an extent !descriptor for it returned in FREE. free = 0 %and %return %if D_unit no <= 0 {NULL disc} %cycle {find a single free block on OUTPUT} %if D_FP >= D_blocks %start error ("Output disc too small") %signal total failure {trapped in SQUEEZE: forces a return} %finish %exit %if %not bit set (D_bitmap,D_FP) D_FP = D_FP + 1 %repeat free_base <- D_FP; free_length = 0 %cycle %exit %if D_FP >= D_blocks %or bit set (D_bitmap,D_FP) {block in use} %or free_length&H >= max size {got all we wanted} set bit (D_bitmap, D_FP) free_length <- free_length&H + 1 D_FP = D_FP + 1 %repeat %end %routine %spec set disc (%record(disc)%name D, %string(25) id) %routine wipe (%record(disc)%name D) report ("***WIPING " . D_zero_disc id) %record(parm fm) P {D.I.Y. disc I/O - dont abort on errs} %integer j, k, block, left, N %record(spine) bad = 0 {new defective blocks list} %record(spine) user {new (empty) user list} %record(zero fm)%name Z == D_zero %record(extent) free %record(extent)%name this %on %event total failure %start {GET failed to claim system area} report ("No space for system area") -> NO SYS %finish %if Z_marked # -1 %start {disc not properly initialised} report ("Unit #" . itos(D_unit no) . " not initialised") %stop %finish !Create defective list doing ("badblock chk") report ("blocks: ".itos(D_blocks)) D_bitmap(j) = 0 %for j = 0, 1, 2047 {splat the bitmap} set bit (D_bitmap,0) {don't scribble on block zero!} block = 0 %cycle left = D_blocks&H - block {# of blocks left to test} %exit %unless left > 0 N = buf len; N = left %if N > left {test in N-block chunks} P_p1 = block; P_p2 = addr(buf(1)) P_p3 = D_unit no; P_p4 = N SVC (read segment,P) %if P_p1 # 0 %start {I/O err => 1 or more bad blocks} %for j = block, 1, block + N - 1 %cycle P_p1 = j {test individual blocks in chunk} P_p2 = addr(buf(1)) P_p3 = D_unit no; P_p4 = 0 SVC (disc read,P) %if P_p1 # 0 %start {block #J is duff} set bit (D_bitmap,j) bad_extents = bad_extents + 1 {use one extent for each} %if bad_extents > 126 %start report ("Too many bad blocks!") %stop %finish this == bad_extent (bad_extents) this_base = j; this_length = single block %if j = 0 %start error ("Block zero is defective!!") %stop %finish %finish %repeat %finish block = block + N %repeat report ("Bad blocks: " . itos(bad_extents)) %if bad_extents # 0 !Allocate system area D_FP = 0 %if Z_system area # 0 # Z_system size %start %cycle get (D,free,sys size) %exit %if free_length&H = sys size !chunk not big enough - forget it clear bit (D_bitmap,j) %for j = free_base&H, 1, free_base&H + free_length&H - 1 %repeat Z_system area = free_base&H Z_system size = free_length&H %finish NO SYS: !Allocate free, user, defective blocks !(normally 300,301 and 302) D_FP = default free list %if %not valid block (D,Z_free list) %start get (D,free,single block) Z_free list = free_base&H %finish %if %not valid block (D,Z_user list) %start get (D,free,single block) Z_user list = free_base&H %finish user = 0; write block (D,Z_user list,user) %if %not valid block (D,Z_defective list) %start get (D,free,single block) Z_defective list = free_base&H %finish bad_check = 0; bad_check = checksum (bad) write block (D,Z_defective list,bad) bad = 0; !use BAD as free list now bad_check = checksum (bad) write block (D,Z_free list,bad) D_FP = 0 {put things back} tidy (D) {create new free list} Z_initialisation date = DATE Z_initialised = 0 {DONE} Z_checksum = 0; Z_checksum = checkword (Z) write block (D,0,Z) %end %routine read page (%record(disc)%name D, %integer disc addr, blocks, buf start) %record(parm fm) P P_p1 = disc addr&H; P_p2 = addr(buf(buf start)); P_p3 = D_unit no P_p4 = blocks&H; SVC (read segment,P) %if P_p1 # 0 %start report ("Read page fails on unit #" . itos(D_unit no) . %c ", status: " . itos(P_p1)) %finish %end %routine write page (%record(disc)%name D, %integer disc addr, blocks, buf start) %record(parm fm) P %return %if D_unit no = 0 P_p1 = disc addr&H; P_p2 = addr(buf(buf start)); P_p3 = D_unit no P_p4 = blocks&H; SVC (write segment,P) %if P_p1 # 0 %start report (D_zero_disc id . " protected") %and %stop %if D_prot # 0 report ("Write page fails on unit #" . itos(D_unit no) . %c ", status: " . itos(P_p1)) %stop %finish %end %routine merge (%record(userlist)%name new, %record(disc)%name D) !Create a new userlist from the old one on 'D' !and the NEW one passed to us. Return merged !list in NEW. %record(userlist) old %integer j,k %record(user)%name u, slot %return %if D_unit no <= 0 read block (D,D_zero_user list,old) j = 1 %for k = 1,1,42 %cycle u == new_user(k) %if u_name # 0 %start %while j <= 42 %cycle slot == old_user(j) j = j + 1 %if slot_name = 0 %start slot = u %exit %finish %repeat %finish %repeat new = old %end %routine squeeze (%record(disc)%name input, output) !The logical contents of the INPUT disc are !copied to the OUTPUT disc. As the files are !being written sequentially, the output disc !will be minimally fragmented after the operation, !with all free space in one or two extents. %routine copy system %integer done %return %if input_zero_system size <= 0 %or output_zero_system size <= 0 doing ("Copy system") %if input_zero_system size > output_zero_system size %start report ("Not enough space for system area on " . %c output_zero_disc id) %return %finish %integer j, k %integer pages = input_zero_system size // buf len, odd blocks = rem (input_zero_system size,buf len) %for j = input_zero_system area, buf len, input_zero_system area + (pages-1)*buf len %cycle read page (input, j, buf len, 1) writepage(output, j, buf len, 1) %repeat done = input_zero_system area + pages*buf len; !block %for j = done, 1, done + odd blocks - 1 %cycle read block (input, j, buf(1)) writeblock(output, j, buf(1)) %repeat report ("System area: " . itos(input_zero_system size)) %end %integer %fn squeezed file (%integer {packed} user {name}, %record(file)%name F) !Result is disc addr in OUTPUT disc of new spine !block for the copied file. %integer bufp = 1, free buf = buf len, base %integer last, left, xfer len, j, extents %record(spine) old spine, new spine; new spine = 0 %integer {flag} empty spine = non zero %record(extent)%name e %record(extent) free %record(parm fm) P = 0; P_p1 = input_unit; P_p2 = user P_p3 = F_name1; P_p4 = F_name2 %routine output buf !The contents of BUF, from block 1 to BUFP is !written to the OUTPUT disc in as many extents !as required. Each new extent is added to the !NEW SPINE block being created. %own %record(extent)%name last extent %record(extent) free %integer p = 1 bufp = bufp - 1 {index of next free block->#of blocks} %while p <= bufp %cycle {more to write} get (output, free, {extent of size up to # of blocks left} bufp - p + 1) write page (output, free_base, free_length, {buf start} P) %if empty spine # 0 %or {not contiguous with last ext} free_base&H # last extent_base&H + last extent_length&H %start empty spine = 0 new spine_extents = new spine_extents + 1 %if new spine_extents > 126 %start error ("Spine block full!!") %stop %finish last extent == new spine_extent(new spine_extents) last extent = free %else {merge with LAST EXTENT} last extent_length = (last extent_length + free_length)&H %finish p = p + free_length %repeat free buf = buf len {buffer empty now} bufp = 1 %end read block (input, F_spine block, old spine) %unless 0 <= old spine_extents <= 126 %start SVC (unpack filename,P) error (P_filename . itos(old spine_extents) . " extents?") old spine_extents = 126 %finish %if old spine_check # '?' %start SVC (unpack filename,P) error (P_filename . no check . "spine block") %finish extents = 0 %for j = 1,1,old spine_extents %cycle e == old spine_extent(j) %if e_length # 0 %start extents = extents + 1 %if %not valid extent (input,e) %start P = 0; P_p1 = input_unit; P_p2 = user SVC (unpack filename,P) error (P_filename . corrupt . "extent") %if %not (0 <= e_base&H < input_blocks %and 0 <=(e_base+e_length)&H < input_blocks) %or e_length&H > 200 {arbitrary} %start !all is lost report ("(Not copied)") %continue %finish !copy poss. duff extent %finish new spine_blocks <- (new spine_blocks + e_length)&H %if testing = 0 %start {actually copy the file?} base = e_base&H; last = (e_base + e_length)&H left = e_length&H {# of blocks yet to be transferred} %cycle output buf %if free buf <= 0 xfer len = left {Try to read in all the other blocks} xfer len = free buf %if xfer len > free buf read page (input, base, xfer len, bufp) bufp = bufp + xfer len; left = left - xfer len free buf = free buf - xfer len{less space left in buffer} base = base + xfer len {next disc addr} %repeat %until base >= last {read in whole extent?} %finish %finish %repeat output buf {flush} P = 0; P_p1 = input_unit; P_p2 = user; P_p3 = F_name1; P_p4 = F_name2 %if new spine_blocks # old spine_blocks %start SVC (unpack filename,P) error (P_filename . " block count wrong in spine") %else %if extents # old spine_extents SVC (unpack filename,P) error (P_filename . " zero length extent in spine?") %finish %result = 0 %if new spine_extents = 0 get (output, free, single block) new spine_check = '?' new spine_access permissions = old spine_access permissions write block (output, free_base, new spine) %result = free_base %end %integer %fn squeezed user (%integer {packed} name {of user}, {disc addr of user's} dir block) !Result is disc addr (on OUTPUT) of copied directory. %record(directory) D, new dir %record(spine) S %record(parm fm) P = 0; P_p1 = input_unit; P_p2 = name %record(extent) free %record(file)%name F %integer j read block (input, dir block, D); new dir = D %unless 0 <= D_files <= 42 %start SVC (unpack filename,P) error (P_filename . itos(D_files) . " files?") D_files = 42 %finish new dir_files = 0 %for j = 1,1,42 %cycle F == new dir_file(j) %if f_name2 # 0 %and f_name1&dollar hash = 0 %start %if %not valid block (input,F_spine block) %start P = 0; P_p1 = input_unit; P_p2 = name P_p3 = f_name1; P_p4 = f_name2 SVC (unpack filename,P) error (P_filename . corrupt . "spine block") %if %not (0 <= f_spine block < input_blocks) %start report ("(Not copied)") F = 0 %continue %finish; !might be OK read block (input,f_spine block,S) %if S_check # '?' %start report ("(Not copied)") F = 0 %continue %finish; !plausible %finish !spine OK f_spine block <- squeezed file (name,f) &H %if f_spine block # 0 %start; !exists new dir_files = new dir_files + 1 %finish %else f = 0 %finish %else f = 0 %repeat get (output, free, single block) write block (output, free_base, new dir) %result = free_base %end !SQUEEZE input => output disc %record(user list) catalog {users on input disc} %record(user list) new cat %record(user)%name U %record(parm fm) P %string(63) s %integer j %on %event total failure %start {Detected in GET space routine} %return {ERROR was called in GET, %finish {so main program will produce the {FAULTY OUTPUT DISC message} wipe (output) %if output_errors # 0 read block (input, input_zero_user list, catalog) %unless 0 <= catalog_users <= 42 %start error (input_zero_disc id . ": " . itos(catalog_users) . %c " users?") %finish copy system new cat = catalog; new cat_users = 0 %for j = 1,1,42 %cycle U == new cat_user(j) %if U_name # 0 %start P = 0; P_p1 = input_unit; P_p2 = U_name SVC (unpack filename,P) s <- P_filename %if %not valid block (input,U_dir block) %start error (P_filename . corrupt . "directory") !no hope U = 0 %continue %finish %if copy user = 0 {do everyone} %or wanted(U_name) %start doing (s) %if exclam # 0 %start %if testing # 0 %then report ("testing " . s) %c %else report ("copying " . s) %finish new cat_users = new cat_users + 1 U_dir block <- squeezed user (U_name,U_dir block)&H %finish %else U = 0 %finish %repeat merge (new cat,output) %if copy user # 0; !combine with old catalog write block (output, output_zero_user list, new cat) tidy (output) %if output_unit no > 0 %end {of SQUEEZE} %routine validate block zero (%record(disc)%name D) %record(zero fm)%name Z == D_zero %record(spine) bad blocks %record(extent) temp %integer j,k %if exclam = '?' %start {print interpreted block zero} report ("Unit " . Z_disc id . ", " . Z_description) report ("Free list at " . itos(Z_free list)) report ("User list at " . itos(Z_user list)) report ("Bad blocks list at " . itos(Z_defective list)) report ("System area at " . itos(Z_system area)) report ("System size: " . itos(Z_system size)) report ("Tracks: " . itos(Z_tracks)) report ("Blocks per cylinder: " . itos(Z_blocks per cylinder)) report ("Heads: " . itos(Z_heads)) %finish k = checkword(Z) error("Block zero checksum fault ".itos(k)) %if k # 0 %if %not valid block (D,Z_free list) %start error (Z_disc id . corrupt . "free list") Z_free list = default free list {& hope for the best} %finish %if %not valid block (D,Z_user list) %start error (Z_disc id . corrupt . "user list") Z_user list = default free list + 1 %finish %if %not valid block (D,Z_defective list) %start error (Z_disc id . corrupt . "bad blocks list") Z_defective list = default free list + 2 %finish %if Z_system size # 0 %start {unit holds a system image} temp_base = Z_system area temp_length = Z_system size %if %not valid extent (D,temp) %start error (Z_disc id . corrupt . "system area") Z_system area = 1; Z_system size = sys size %finish %finish %if Z_tracks <= 0 %or Z_blocks per cylinder <= 0 %or Z_heads <= 0 %start error ("-ve no. of tracks, sectors, heads?") D_blocks = x'FFFF' {max poss disc addr} %finish %if errors = 0 %then read block (D, Z_defective list, bad blocks) %c %else bad blocks = 0 %if 0 <= bad blocks_extents <= 126 %start %if checksum (bad blocks) # 0 %start error (Z_disc id . ": defective list checksum error") %else %for j = 1,1,bad blocks_extents %cycle %if bad blocks_extent(j)_length # 0 %and (%not valid extent(D,bad blocks_extent(j))) %start error (Z_disc id . ": Defective list" . %c corrupt . "an extent") %finish %repeat %finish %else error (Z_disc id . ": " . %c itos (bad blocks_extents) . " bad blocks?") %finish %end %routine set disc (%record(disc)%name D, %string(25) id) %string(63) S %record(parm fm) P = 0 %integer j, old errors = errors D = 0 %return %if id = "" %if id -> ("#") . id %start {unit# given numerically} j = stoi (id); id = "#" . id %else P_filename = id . "_:" SVC (pack filename,P) j = -1 P_dact = find disc {packed disc name => unit#} SVC (to director,P) j = P_p1 %if P_p6 = 0 %finish error ("Invalid disc name " . id) %and %stop %if j < 0 D_unit no = j P_p3 = D_unit no SVC (disc status,P) error ("Unit #" . itos(D_unit no) . " offline") %and %stop %if P_p6&3 # 0 D_prot = P_p6 & 4 read block (D,0,D_zero) D_blocks <- D_zero_tracks * D_zero_blocks per cylinder set bit (D_bitmap,0) length(D_zero_disc id) = 4 %if length(D_zero_disc id) > 4;!!!!!!!!!!!!! s <- D_zero_disc id s <- s . "_:" P_filename <- s SVC (pack filename,P) D_unit = P_p1 P_dact = unit name; P_p1 = D_unit no SVC (to director,P) D_prot = non zero %if P_p6 = 0 %and P_p2 # 0 {prot in director?} %return %if splatting # 0 validate block zero (D) D_errors = errors - old errors %end !field number mnemonics on block zero %const %integer vol id = 1 %const %integer disc id = 2 %const %integer sys area = 3 %const %integer make = 4 %const %integer descr = 5 %const %integer fields = 5 %routine set zero (%record(disc)%name D, %integer mask, to do) !Alter fields indicated by mask in disc block zero from data !supplied by operator at the console. !No. of fields TO DO passed as a parameter. %string(63) atom %const %integer parms = 5 {fields in block zero} %const %string(15) %array parm id (1:parms) = "Phy. disc name:", "Log. disc name:", "System area? ", "Disc type:", "Description:" %const %integer {disc} types = 5, last type = types %const %string(9) %array type id (1:types) = "DIABLO", {5MB cartridge disc} "TELEFILE", {300MB fixed disc unit} "MSM80", {Perkin-Elmer 67MB disc} "CALCOMP", {Calcomp 67M disc} "UNKNOWN" {track size/cyls etc explicit} !*** UNKNOWN must be last type *** %const %integer %array tracks (1:types) = 400,100,815//3,815//3,0(*) %const %integer %array blocks per cylinder (1:types) = 2*12,19*32,5*26,5*26, 0(*) %const %integer %array heads (1:types) = 2,19,5,5,0(*) %integer j,k,m %switch F (1:parms) %record(zero fm)%name Z == D_zero %record(parm fm) P = 0 Z_marked = -1; Z_system area = -1; Z_system size = -1 Z_initialisation date = DATE %while to do > 0 %cycle {fields left to fill} j = 1 %while j <= parms %cycle %if mask & 1< F(j) F(vol id): %if length(atom) > 4 %start report ("Volume-id too long") %continue %finish Z_vol id = 0 atom = atom . " " %while length(atom) < 4 Z_vol id = Z_vol id<<8 ! char no (atom,k) %for k = 1,1,4 mask = mask & (\(1<stop %if parm = "STOP" %or PARM = "QUIT" %for j = 1,1,commands %cycle %if parm = command word(j) %start Ctype = j %exit %finish %repeat report (parm . "?") %and %stop %if Ctype <= 0 -> C (Ctype) C(1): !TEST testing = non zero check in (in1); set disc (in,in1); set disc (out,null) squeeze (in,out) validate free list (in) list (in) %if listing file # null -> STOP C(9): !COPYUSER C(10):!COPYUSERS copy user = non zero; wanted users = 0 prompt ("Copy: ") %cycle scan (line); line = line . "," %while line -> parm . (",") . line %and parm # ".END" %cycle %continue %if parm = "" P_filename = parm . ":"; SVC (pack filename,P) %if P_p2 < 0 %start report ("Illegal name: " . parm) %else wanted users = wanted users + 1 wanted user(wanted users) = P_p2 %finish %repeat %repeat %until parm = ".END" !drop thru.. C(2): !COMPRESS check in (in1); check out (out1) set disc (out,out1) make sure (out) %if copy user = 0 set map (out) %if ctype = 9 %or ctype = 10 set disc (in,in1) error ("Input = output?") %if in_unit no = out_unit no squeeze (in,out) validate free list (in) %if errors # 0 %start error ("***FAULTY INPUT DISC***") %stop %if exclam # '!' {explictly ignore errors with '!'} errors = 0 %finish report ("Testing output disc") testing = non zero set disc (in,null) set disc (out,out1) {clears bitmap in OUT} squeeze (out,in) validate free list (out) report ("***FAULTY OUPUT DISC PRODUCED***") %and %stop %if errors # 0 list (out) %if listing file # null -> STOP C(3): !initialise splatting = non zero check out (out1); set disc (out,out1) make sure (out) out_zero_free list = -1 {these blocks are allocated by WIPE} out_zero_user list = -1 out_zero_defective list = -1 out_zero_initialised = -1 {only after wiping} set zero (out,all,fields) C(4): !WIPE check out (out1); set disc (out,out1) make sure (out) %if ctype = 4 wipe (out) -> stop C(5): !KILL check out (out1); set disc (out,out1) make sure (out) out_zero = 0; out_zero_initialised = non zero {now wont LOAD ok} out_zero_checksum = checkword(out_zero) + 1 {checksum wrong too!} write block (out,0,out_zero) -> STOP C(6): !ZERO splatting = non zero check out (out1); set disc (out,out1) make sure (out) set zero (out, all, fields) !set preferred pointers out_zero_free list = default free list out_zero_user list = default free list + 1 out_zero_defective list= default free list + 2 %if out_zero_system area # 0 %start out_zero_system area = 1 out_zero_system size = sys size %finish PUT ZERO: out_zero_checksum = 0; out_zero_checksum = check word (out_zero) write block(out,0,out_zero) -> STOP C(7): !COPY splatting = non zero {suppress block zero checking} check out (out1); set disc (out,out1) check in (in1); set disc (in,in1) make sure (out) set zero (out, 1< STOP C(8): !HELP open input (help text, program source) select input (help text) skip symbol {first '!'} %cycle read symbol (j) %exit %if j = '\' {terminating character} print symbol (j) skip symbol %if j = NL {past '!'} %repeat newline close input; -> STOP C(11):!TIDY check in (in1); set disc (in,in1) set disc (out,null) -> STOP %if errors # 0 testing = non zero squeeze (in,out) {check input disc for errors} %if errors # 0 %start report("***Faulty input disc") errors = 0 %if exclam # 0 %finish tidy(in) %if errors = 0 -> STOP C(12):!RENAME check in (in1); set disc (in,in1) check out (out1) length(out1) = 4 %if length(out1) > 4; in_zero_disc id = out1 report (in1 . " renamed " . in_zero_disc id) -> PUT ZERO C(13):!LIST check in (in1); set disc (in,in1) list (in) -> STOP STOP: doing ("") %if errors = 0 %then parm = "No" %else parm = itos (errors) parm = parm . " error"; parm = parm . "s" %if errors # 1 report (parm) ->again %if keep # 0 %end %of %program H?nni8C!<7 |}!OC !NWfSX`QKxgQKfZJ_fZX}w:`wag\`EXg\`EY}wZ}wp`q["iZ}q["op`~u@<@U~u@%qOqIfZfZKyAyAX_Lv@X_Lv"8"Z%Qv#p}SId:w RaX!aaaa"!ABaaA !a! $Aa  !ba!A !!A!!!!!'A/A3!BA;" H"aO"U#A c`#! b n,A!!!AAa!!ba!aA$a"A"baC!!AA!ABaBa!a!!abAc2#e"ba!aaBa!ABAbAb .%aAcaAI!C!bAa!!Aa!aADBABAag!b!b!b!a!!K#ac#!! '!a!a!"B"aCB!'abaa!!Aa $c!5aa!aDAaaA!A8s%%!a!a!B!D!!A$胬!cAa!!BCA"!!a!"aAaA.BaAaAAA!aAAaa&F:aaAABBaBB!AACaAABB!AAaH"!a '! A!!!aabaaa+!Aa!!d!Aa!"AD!!AD!!a!CaAAA!C!!!C!a!!C!!!!CA!C!C!#dQ@D"Z$h%Qv `}d+EW@,>y8@,vŐ< @>DDHx/W;ov>,vw9WÐv w :t#4>8D ;`:t#4>8D w:t#4>8DqX`,Rv@ ""`,Rv@ 8M[DĐo]8%ZĐĐ, @0K.聐4>`Đ,>0DHĐyIXH,>0DqI\^CĐo]Đ,&Z0d}M[DĐo]Đ,&Z0dL{}Đ,dTyIXJM[DT=sxT>XD\&"8`=qdohl l(U@pvĐ@zĐ%E~l@Đ,@0zYd4>8D<'a+@Mk}DX_(U!)yĐD~IvĐH~A}ĐL~u38}qMĐ,(U@Đ,@0>4(U^Cv8K;},ĐĐ(U@,QxB@8@Đ,dT>XD\ox`K}dWh h=pĐhl(U@Đp~Iv5qI,Đ{,o0ys4d}]Đ{,o0ys4dR,ĐX_Đ,_,>0DĐ4@Đ8x}!(QyQ@,f@0>4D8d/"8<^doag\DK;}}},(U@0dy} ":%=pĠ%,d0(U%4 @8K;}H#!vL_yIXHLX_yIXHL!Xev@ĠP@T(U@XdQy} "wW@zox,,X_z,v,dT(U@ĠX%\>+y} "@Đ:`Đag\,/+,X_Đ,@0dXv>'8}M[ĐĐ,0 o0}d4>8Dw{Đ,8Hvd>_""`wZ]ĐQ{D,\]0 oQ@p>tDxQ@Đ|d)Qs"MqHĐ,qXN wQxĐ,(U@Đ,@0>4DxÐv,Rv WÐv `Ðv ox,:p"DaD\""`D`}~v+DdyL t:wDh("Dl}̆=sxDp#K5DKցDEdÀDd:Q@CDL{~v,KÀD:ÀDaDd/"8D^doD>DdȃDLv@E dates errorNo renamed ***Faulty input disc ***FAULTY OUPUT DISC PRODUCED***Testing output disc***FAULTY INPUT DISC***Input = output?.ENDIllegal name: :.END,,Copy: ?QUITSTOPParam: KEEP Output disc? Input disc?  #B#$$$%%h&q#w#w&&'< buffers claimed DISC : no such discYESYes/no? ?%**Are you sure you want to overwrite "UNKNOWN to spec disc parms by handValid types are:Heads:Blocks per cylinder:Tracks:NOIllegal disc name_: Volume-id too long6a`dDIABLOptiTELEFILEiMSM80ILEiCALCOMPEiUNKNOWNEi_e Phy. disc name:Log. disc name: System area? e: Disc type:a? e: Description: e:er_: offlineUnit #Invalid disc name _:## bad blocks?: an extent: Defective list: defective list checksum error"-ve no. of tracks, sectors, heads? system areabad blocks list user list free listBlock zero checksum fault Heads: Blocks per cylinder: Tracks: System size: System area at Bad blocks list at User list at Free list at , Unit copying testing directory users?: (Not copied) (Not copied) spine block files? zero length extent in spine? block count wrong in spine (Not copied)extent spine block extents?Spine block full!! System area: $Not enough space for system area on Copy system , status: Write page fails on unit # protected , status: Read page fails on unit # Bad blocks: Block zero is defective!!Too many bad blocks!blocks: badblock chk not initialisedUnit #No space for system area ***WIPING Output disc too small free blocks: : corrupt free list: free list out of order: incomplete free list free list: lost blocks: freelist chk: empty free list?reject free list%) free blocks ( blocks in use users:  block file ), ( *CORRUPT* corrupt Dump of Disc listing at block # to unit #Disc write error protected at block # from unit #Disc read error *,.END --TESTalid check COMPRESS check INITIALISEheck WIPEIALISEheck KILLIALISEheck ZEROIALISEheck COPYIALISEheck HELPIALISEheck COPYUSERSEheck COPYUSERSEheck TIDYUSERSEheck RENAMEERSEheck LISTMEERSEheck   invalid check byte in  corrupt pointer to * * ~ crash:DISC  V2.02  |'?$$A>,XM#7PPP$ȧ@$AAA \U#?A PH&RRXZE"B"s   1#,H#8zs   @!8X5(X$C,sn@ f sN V P !# !(e",$$U nH!3410!81!5$$A>#$$A>&C?134C0DD C H!3410!81!5$$A>$@#0#DD&A'1"CH!3410!81!5$$A>B@!4B"; C@!$$A> #$$A>B C B$P#EE&Q'1"Cs_eX!34RUUh!34dffзӳŰ!4Գ#9!8!5$$A> B$C08L#9&"C" 'MM >' ("#4\BbD#: nBJ"#<#MM'"DC0 $# MM&'"%ѷC$"ѷ$$A>$A1 0# # QDRD?&A'"3$$A>X#Y!Y!&\ ZB!$$A>З$1$HHX[&B0P [,&' ?P *&30HPїCKї$$A> Y #%$$A> qPrPB&(pX ?$P S?PE&T 41I2!,K2! 3s3B#9 3 >!$$A>!$$A>A>?&?$$A>O$$A>?$$A>"#: !?$$A>?$$A>GHOs/" B 'X=2#$$A>&r0U> ?P7D&D"$2#XCPC'4"2$#PC'4" ?$$A>H!34"#(!BC$$A>X$$A>wAX, X $0P8@D\P8@D`P8@DdP8@DhP8@Dly gAX,X X8@DlP94$@$!A0PI,C4&API,PI08DAXYXalV!5%yUI0ANUI4B0P0$"< w),AAX<X !A$0P9@$APIHY,U!5y9,$ `CA#5[)HP)HcPiP$ $!A0PDCP&PDPL,+AP<ӡɠ0!ɠ9#$%CXY@$jFA ʠ ZPY@ULANUPB0PLXH\ @A CVt gAX,X $09,F#c dPi&PpPtX*APlA@a!@z!%DAXpUtANUxB0PtyS gAX, X Py,#Xy,X9#VAfy$@FW$ !'W0" W$ BHW$@ 0XY',A0AfX)A"W0CXiACr_  gAX4X ePi4X90P989,AP<AXALX)8A$QRXi<EPFy4 gAX4X ePi4X90P989,AP<AX)8A$ABXQ\%a dXI<VPTy3 gAX4X ePi4X90P989,AXALX)8A$QRE#5%y$", w),AAXlX !A?,WHW,y# w),AAXlX !A?',TA,AfAzX8@D\&1P8@D\y, WAX, X PPYB(X6< S!/Z P,X P0eA#5$yX Z P,X P0XiA%C? WAX,X H50P9,HE@PI0#,3!XV\ 5# 4 5#%$yX9, 4'1P9',A',A,AfAZCn: WAX0 X X6<3!(%$1AyXX XKL !AH$ $ A Z P,X P0jA!2#XY\Xe l&aPe CX9<XX @XIL$P@TXilX6 <X ;C4Z P,X P0cA!=XHJ@YI,!CZXY\Z P,X P0Xe lAXilH60&1@6XX &P CPC gAX, X ',AAfA)h0AX9<ȳPhPyt# XytACXŠC0FXclA ',A',A,Af~AfA2$ ApWXILXdlA',A',fA,AfA%Q&QPYTPYx=AXil$PXYTUYxANPB0PxX Z P,X P0$`A^$@PI\XY\Xel`X9\< cPi`!#CX@DPd ##PidP94$8DAP8XP$QPY,$`&aPi0Pi<=AXP4XC0LXI,L@*B <=A4P8&API,XQ\U!;X4X)8$3A#CXi0UiXJ<LPJ@YJ0#%XJ0PJ@PG,XZ,PW0XZ4\XiAXj,X:@< cPj,X< PAX*X,$3ACTXZX\XjAXJXL@XZX\He#7H:,&1@:,#%$3A#X*X,$3AXJ\UJ`AN@*B0`P`$P,ZTXiAJ,PG,HZVXiA>HVzI WAX,)X Py#XyyX9<X#4cAȩ,P,XILXT(\dAHY,!P*C JeAՂ',AXil',AAf,AfAfAA,),0A$0@9,&PP=A4P,XC0N)0$:AXILXT\PY8PX9<3#8X$PXH@Dd#3CTXiA2XY\Xh@D\[iPeC2 WAX0-X 6P9|)$:AXI|%1P4X|%PXI|L%QPTWXi|l& A X9,C ~$PpXpɠB d*A$ABTIC0>=AWXYp\P#6i?0AXp.*Ai0`#'ĄCX9|<$Pө0ɠ#)0Af?" $@&APItPIXY|\Xel0$A?h1cPeXItUIAN@B0PX)p,A$% TPXI,'API,CZ',0AAf)Ar q XY\U#7ACXi|l&0AX)p,A$12% TPX,'P,C0.A!?XI|L$PPTXi|l$0P6X)p,A$% TPXI,'API,CzXY|\$`eDW$ C0RW$@ X9|<',DAAfX|+DA"W0CW0X)p,A$%A JTIPIXY,'QPY,C$`&aPitPi=A)0AB0=AX|XP,Xt=AXI|LXQPT0Xt=AXi|lXP4X)p,A$%A JTIPIXY,'QPY,X9t<0B0Wi?0A0A~X|P,Wi?0AǠ0ARX|P0Wi?0At0A&XI|LP4Ch`B0LA0$P&QPYxPY=AAXYxUYANPB0PAi?0AXitUiAN`B0^PX)p,A$abTi#3C$1P8@DWX@DP,ȰP0WX@DjAAX@D.A#6.A!7$P@DC$@&APH@DPH@EH=AP@ELX@DX(@ELA!8XX@DPX@D# XH@DUH@EHAN@ B0P@EHXh@DlfB $',AAfAv$ A.A$1P8@D`X@DkAX@Dh,Afh"DAX"Dh,Ah,ARX@D.fA#5h,AJC$P@Dh$P@DlWhPDA(DAfP8DX(@DCAPC0.AC0XH@DTU!3Cz',AAf(E"Ar@E q@E Xh@E,lfC ',AX@DAfA,#X8@Dl&1P8@Dl8DAPaCHX@D.A#3CX@DkAX@DjAX@Dh"DAX@Dh!5h"DA\XH@DL@ #4@ !5h"DAX@Dh,AXX,\Xh"DlV!5AX"Dh,A*h,AЎX8@D\C0&AX@DpŰ!#6$ A$P@D\A$P@D`fh,A^X@Dh"DALX,h"DAh"DAXH@D\#:^A$ AX@D.fA#5h"DACf$QPX@DdXh@DlAhX@Dh"DAh"DA %1P8"hP8"lP8"pP8"$P,Sh"DAX@DjAX@Dh"DAX@DŐ!5h"DAh"DA6CXH@DLdAX@Dh"DADh"DA("\0A$QPX"bA&P"h"\Pg,$Ph"DAôCp$1P8@DdX@DkApX@Dh"DAh"DA($P,%Qh"DAȐ,P"h@-PH"lP.PX"pXh"tlf#8$aPh"t0P8"x$P"h"\AAfHAfA C0X@DiAX@Dh,Ah,A#bWXH@D\!9X(@D:A# dAX(@DA2AfXX@D\P#:Xh@D&0AfX@DA X8@D#3Cnxd pointers out_zero_free list = default free list out_zero_user list = default free list + 1 out_zero_defective list= default free list + 2 %if out_zero_system area # 0 %start out_zero_system area = 1 out_zero_system size = sys size %finish PUT ZERO: out_zero_checksum = 0; out_zero_checksum = check word (out_zero) write block(out,0,out_zero) -> STOP C(7): !COPY splatting = non zero {suppress block zero checking} check out (out1); set disc (out,out1) check in (in1); set disc (in,in1) make sure (out) set zero (out, 1< STOP C(8): !HELP open input (help text, program source) select input (help text) skip symbol {first '!'} %cycle read symbol (j) %exit %if j = '\' {terminating character} print symbol (j) skip symbol %if j = NL {past '!'} %repeat newline close in $(,$$0**400866<<<@BBDHHHNNLTTPZZT``Xff\ll`rrdxxh~~lptx|tT48|Xp4L`H?<<C!~0}&NWfSX`QKxgQKfZJ_fZX}w:`wag\`EXg\`EY}wZ}wp`q["iZ}q["op`~u@<@U~u@%qOqIfZfZKyAyAX_Lv@X_Lv"8"Z%Qv#p}SId:w R`EX!qIw@eE;ovBaaA!BAPAV!Z#aaA!!!aAAAAbAAaaaA7"A!a! /AA "A%a!a!a"!! ~aaaEBaKFaa!AB!aEAaaaBa!baAAaaa!AAaaBUdQ@D"ZPZx7W$%Qvy8@,vŐ< @>DWH @qX`,Rv@ U^ed:Q@,vl}>X*,>0DUd;1*y@,>0Df[}W,> fŹW(_Q@,>0DqI\^Co],dox,ox,dL^wPd:Q@#K5d/ Lv"(>['q3&ythrvXy!$v&yK;}eYx+ ąy}y} "@^iXЏLv"8`EXLKo}o]DQ@v@$EPG,$PBlock # Won't fit! fails -- *Dump , status: from unit*cannot read block??=?Dumping unit #_:#DISCWIDTHPAGE=?....PAGEDASCIIOCTALHEX,,  d 0 w?$$A>,XM#7PPP$ȧ@$AAA \U#?A PH&RRXZE"B"s   1#,H#8zs   @!8X5(X$C,sn@ f sN V P !# !(e",$$U nH!3410!81!5$$A>#$$A>&C?134C0DD C H!3410!81!5$$A>B@!4B"; C@!$$A> #$$A>B C B$P#EE&Q'1"Cs_eX!34RUUh!34dffзӳŰ!4Գ#9!8!5$$A> B$C08L#9&"C" 'MM >' ("#4\BbD#: nBJ"#<#MM'"DC0 $# MM&'"%ѷC$"ѷ$$A>$A1 0# # QDRD?&A'"3X#Y!Y!&\ ZB!$$A>A>?&?$$A>?$$A>"#: !?$$A>?$$A>GHOs/" B 'X=2#$$A>&r0U> ?P7D&D"$ ?$$A>H!34"#(!BC$$A>рw),AA.<X !A$0P9D$JPIHY,PYPc$!APi@C&aPi@PiL,&AzP<10 !#C00!09!'31CR0_0AB"0Z!/ӱİ_ȫҡàAC$A@_#5%yXYDPYH$PPYDC,Xi<l6Y9H!%CXYH\IDA SPYDXi@UiLA$UiPB0.PLXDC w),AA.lX !A?,WHW,y# wA., X W,X8<&1P8y wA.,-X X8#9XHL@PH(PA"?8P),CA??C0Y,U!3C,.A!;Xhl`PhC.A!;X8<0P8C.A!;XưPC.A!6$PC1!IlA??C0YlU!?$P`W)lA?,AJPlA>PXhlf!C<',,AA"lA"A"A$$ AC,A!,APPC9,#IlA??C0~.A!9lAPC(,.A!9lA~PC .AB0$1P89l$ CA?#8AJPC~',AA"(2Ar,q,Ȱ-@.r,q,XHC0"4WHW,$ AXH4LPHtWH$PXhlWTW,C(',,ApA"A$ AXX!XhC(',lAnA"An$ AC(',,AlA"AB$ ACX8<0!50P8$P&PPXHL*Al$QRE#8Xhl&aPhUA$ŠB0Py߀ gA.,X $0&1P:,P:4XZE@Ȱ%KPJ0X:# +P:D!8WC$@!)d@W<#dW<X:,U:4A$0B0P4zM WA.,X X8<3#7XŰ?C0t$&P,P4XiW XI@@PI0XYXPY@ !@!7W#dW<X,U4A$ŠB0P4C6XY$dFAeW Xi`AXi`Ayo gA., X 0!'3P9,P90#AlXİk0W<X9,U90A$3B0P0y0 WA.,X $1P8$dW `|W<$&P,P4X+Al$ABC0+Al$QRP!7$bW XiZi'aPiXml $P$aW$1P=XcW$aWl$lW<ABX'PX&PXHL ##CiAFXX\Xhl VYXB(X8<3!<$lW<W,$PAWH$PXhlWTAA$PLXPJ$!APHC:&APHPHX8L<$T%AcW`|W<$`&aPhPh&Al$120!=Xð#6WXX(,Al$C0JWXHLLPHXX\PX$`$!APhC&aPhPhX(,Al$120B06WXL=A,$XXalWCAl$ŰB0.WXL=A,XalACHAl$ŠB0$XL=A,$PXalAv# $ %AAXL&PLXhUhA$UhB0PXHLPHLXhUhA$`B0NPAXX\P#=XXL\XhlA0AbXhLlX8< cPhLXHUHA$UHB0PCx@Q94 %SETTYPE [1 - fixing type] 195 %OPER [8 - check operator type] 196 %PARAM [10- set parameter type & check] 197 %BLOCK [7 - check block type] 198 %OTHER [3,4,9 - sundry others] 199 %COMPILE [compile phrase] [phrasal=200] 200 APP *** used by compile *** 201 BASEAPP 202 APP2 203 APP3 204 APP4 205 APP5 206 APP6 207 ADEFN 208 NPARM 209 SWDEF 210 SWIDS 211 CIEXP 212 RCONST 213 SCONST 214 ARRAYP 215 XIMP 216 IMP 217 COND 218 SCOND 219 EXP1 220 EXP2 221 SEXP 222 IEXP 223 IEXP1 224 IEXP2 225 ISEXP 226 SEQ 227 FDEF 228 EXP 229 NARRAYP 230 STRUCT 231 RESEXP 232 BPL 233 CONSTB 234 FITEM 235 MOREA 236 CLIST 237 FPP 238 FPP0 239 FPP1 240 FPP2 241 INITVAR 242 RECEXP 243 EIMP 244 IDENTS 245 RANGE 246 RCONSTB 247 VARP 248 INITDEC 252 ESCDEC 253 ESCPROC 254 ESCARRAY 255 ESCREC /RULES SS -> %DECL (VDEC< IDENT INITDEC (COMMA IDENT INITDEC)* T, ADEC ADEFN (COMMA ADEFN)* T, (PROC<<, PROCSPEC<<) PIDENT ALIAS ACONST< %OTHER[1] & (LB Z FPP RB, %PIN Z %POUT) T, (PROC<<, PROCSPEC<<) PIDENT (LB Z FPP RB, %PIN Z %POUT) T, EXTVSPEC< IDENT (A $(,$$0**400866<<<@BBDHHHNNLTTPZZT``Xff\ll`rrdxxh~~lptx|(pre-release) vsn 2.1HTPP]y[`lH?%begin; !disc recovery program %recordformat parmfm(%short dsno, dact, ssno, sact, %integer p1,p2,p3,p4,p5,p6) %record(parmfm) p %integer this unit = 0 %integer from %integer max block = 32000 %recordformat filefm(%integer name1, name2, %short spine, day) %recordformat dirfm(%short files, %byte access, check, %short chain, %byte spare, daccess, %record(filefm)%array file(1:42)) %recordformat blockfm(%short size, addr) %recordformat spinefm(%short last, %byte access, check, %integer size, %record(blockfm)%array b(1:126)) %routine read block(%integer block number, %record(*)%Name block) %record(parmfm) p p_sact = 1 p_p1 = block number p_p2 = addr(block) p_p3 = this unit p_p4 = 0 svc(101, p) %if p_p1 # 0 %start printstring("Cannot read block") write(block number, 1) write(p_p1, 6) newline %signal 13,0 %finish %end %routine print file(%record(filefm)%Name f) %string(27)%name sn %record(parmfm) p p_p1 = 0 p_p2 = 0 p_p3 = f_name1 p_p4 = f_name2 svc(18, p) sn == string(addr(p_sact)) printstring(Sn) spaces(15-length(sn)) %end %integer n,j,k,l,z %record(dirfm) dir %record(filefm)%Name f %record(spinefm) spine %on 13 %start newline printstring("End of disc at block") write(n, 1) newline %stop %finish prompt("Unit: "); read(this unit) prompt("From block: "); read(n) n = n-1 %cycle n = n+1 read block(n, dir) ! %continue %unless -100 <= dir_files <= 100 l = 0; z = 0 %for j = 1,1,42 %cycle f == dir_file(j) %continue %If f_name2 = 0 ->no %if f_name1 # 0 %and f_name1&X'FFFF' = 0 read block(f_spine&X'FFFF', spine) z = z+1 %if spine_check # '?' z = z+1 %if f_name1&X'C0000000' # 0; !dubious l = l+1 ->no %if z > 8 %repeat %continue %if l = 0 printstring("Directory found at block") write(n, 1) newline k = 0 %for j = 1,1,42 %cycle f == dir_file(j) %continue %If f_name2 = 0 k = k-1 %if k <= 0 %start k = 4 newline spaces(10) %finish print file(f) %repeat newlines(2) no:%repeat %endofprogram H?*%begin; !disc recovery program %integer owner, file1, file2 %recordformat parmfm(%short dsno, dact, ssno, sact, %integer p1,p2,p3,p4,p5,p6) %record(parmfm) p %integer this unit = 0 %integer max block = 32000 %recordformat filefm(%integer name1, name2, %short spine, day) %recordformat dirfm(%short files, %byte access, check, %short chain, %byte spare, daccess, %record(filefm)%array file(1:42)) %recordformat blockfm(%short size, addr) %recordformat spinefm(%short last, %byte access, check, %integer size, %record(blockfm)%array b(1:126)) %record(dirfm) dir %record(filefm)%name f %integer j,n %string(15) username %routine write block(%record(*)%Name block) %record(parmfm) p p_sact = 1 p_p1 = 301 p_p2 = addr(block) p_p3 = this unit p_p4 = 0 svc(102, p) %if p_p1 # 0 %start printstring("Cannot write block") write(p_p1, 6) newline %signal 13,0 %finish %end %routine pack(%string(15) file) %record(parmfm) p string(addr(p_sact)) = file svc(17, p) owner = p_p2; file1 = p_p3; file2 = p_p4 %end prompt("Unit: "); read(this unit) dir = 0 %for j = 1,1,42 %cycle prompt("User name: "); read(username) %exit %if username = "." prompt("Directory block: "); read(n) pack(username.":PASS") f == dir_file(j) f_name1 = owner; f_name2 = file2; f_spine = n; f_day = b'01000000' %repeat write block(dir) %endofprogram H?0!VECCE: Screen editing implementation of ECCE for VAX, EMAS and ! Perkin-Elmer 32-bit machines running MOUSES. ! Files addressed in virtual memory ! Hamish Dewar -- February 1981 ! V00: 09/02/81 ! V01: Bantam/hardcopy support added ! %begin; !MOUSES version, A.Culloch %constinteger rt=13, esc=27, tab=9; !ASCII %constinteger EOT = 4, ctrl X = 24, DEL = 127, BS = 8, CR = 13, LF = NL !*System-dependent %externalroutinespec Temp library (%string(27) lib) Temp library ("ECCE:VM"); !dynamic linking with BYTEINTEGER etc %externalpredicatespec Exists (%string(31) file) %externalroutinespec CPU limit (%integer seconds) CPU limit (65535) %externalroutinespec Terminal mode (%integer bits) Terminal mode (3) !(Binary input/output - no echoing) %routine newline print symbol (CR); print symbol (LF); print symbol (-1) %end %routine newlines (%integer n) newline %and n = n - 1 %while n > 0 %end %constinteger maxname=127; !max file name length %recordformat file(%string(maxname) name, %integer chan, %integer top,lim,vmtop,vmlim,flag) %record %format blockfm (%byte %array B(0:511)) %record %format buffm(%integer from,to, {block maps these V.addrs} %integer chan, {paged in from here} %integer block, {block in paging file} %record(buffm)%name link, {circular list} %record(blockfm) blk) %include "NewSrc:Command.inc" !*These procedures in ECCE:VM.EXE %external %routine %spec Close Off %external %byte %map %spec byte integer (%integer index) %external %routine %spec move (%integer length, from, to) %string(72) sys mess = "*unknown error*" %external %routine %spec connect input (%record(file)%name f) %external %integer buffers buffers = (Free Space - 3000) // (512 + 5*4) %record(buffm) %array buffr(1:buffers) %external %record(buf fm) %array %name buffer; buffer == buffr %external %record(buf fm) %name buf buf == buffr(buffers) !!!!!!!!!!!!!!!!!!! Start of Editor proper !!!!!!!!!!!!!!!!!!! ! Low High ! addresses addresses ! _______________________________________________________________________ ! | | | | | | |/|//////////| | | | ! | | |C|urrent line |NL| |/|//////////| | NL|NL| ! |_|______|_|____________|__|______|_|__________|_|___________________|__| ! ^ ^ ^ ^ ^ ^ ! NEWTOP LBEG LEND GAPTOP GAPLIM FLIM ! ! FP (The file pointer) may point above, below or at the gap (shaded area). ! When the gap has been moved onto the file pointer (necessary for I/.../, ! E,G etc), FP equals GAPLIM & characters may be inserted at GAPTOP. ! (The "move gap onto FP" operation is performed by SPLIT). Consolidate ! Moves the gap to a line boundary. %integer i,j,f,l,sym,default %external %record(file) in,sec,out %string(63) parm parm = command_parameter %routine edi(%record(file)%name old,sec,new, %integer video,rows,cols) ! Only the TOP and LIM components of the file info records are ! relevant for editing (except when referencing secondary input) ! In the EMAS version the original file is not copied into the ! working space (NEW) prior to entry, so that OLD_LIM is not ! equal to NEW_LIM: on VAX, OLD_LIM is equal to NEW_LIM (except ! when just 'showing' in which case NEW_TOP = NEW_LIM = 0). ! The parameter VIDEO defines terminal characteristics: ! signbit: Can DELETE-LINE & INSERT-LINE ! 4000000: Can reverse/reduce/underline arbitrary character ! 2: VT52-compatible ! 1: Bantam compatible ! all zero: hardcopy %constinteger cbound=50; !command cell array bound %constinteger tbound=120; !quoted text array bound %constinteger stopper=-10000; !loop stop %constinteger casebit=32 %integer cmax; !command cell max %integer ci; !command index %integer ti; !text index %integer code; !command code %integer ref; !text or bracket pointer %integer scope; !search limit %integer num; !repetition number %integer sym,sym1,pend %integer casemask; !\0(\CASEBIT) to respect(ignore) case %integer width; !line width (default 80) %integer dir; !current direction of movement %integer sin; !0(1) for main(secondary) input %integer macpos; !macro index values (3-byte nest) !File pointers (byte addresses) %integer lbeg; !line start position %integer fp; !current file position %integer lend; !line end position %integer flim; !limit of current infile %integer gaptop; !start of gap %integer gaplim; !limit of gap %integer mstart,msize; !match start/size %integer sfp,slim; !saved FP/LIM for switching %integer newtop,newlim; !copies of NEW_TOP,NEW_LIM ! Video control variables %integer line; !line number of current line %integer winline; !line number of top line on screen %integer limline; !limit line number (if known) %integer breaks,joins; !count of lines added/removed %integer vrow,vcol; !video cursor position %own %integer zrow = 0 %own %integer mon = 1 %integer fprow %own %integer print line = 0, printed = 0 %integer wintop, winbot; !first/last window row !the variable size window extends !from floating WINTOP to fixed WINBOT %integer winlim; != WINBOT+1 %integer minwin; !minimum window size %integer changemin,changelbeg; !alteration positions %integer vp %integer endon ! ! %ownstring(9)%array prom(0:3) = ">", "^X ^I >", "^Y ^x>", "^Y ^x>" %ownstring(3)%array gprom(0:3)= ":", "^A ", "", ""; !*MOUSES* %byteintegerarray macstore(1:192) %recordformat commandcell(%byteinteger code,ref, %c %shortinteger scope, %integer count) %record(commandcell) %array r(1:cbound) %byteintegerarray text(1:tbound); !text strings ! ! V i d e o c o n t r o l r o u t i n e s ! %routine at(%integer row,col) ! Set cursor to row ROW (0:ROWS-1) and column COL (0:COLS-1) %if video # 0 %start vrow = row; vcol = col col = cols - 1 %if col >= cols print symbol (ESC) %if video&2 # 0 %start; !VT52 print symbol ('Y'); print symbol (' '+row) %finish %else %start; !Bantam print symbol ('X'); print symbol (' '+row) print symbol (ESC); print symbol ('Y') %finish print symbol (' '+col) %finish %end ! %routine clear line ! Clear rest of current line %if video # 0 %and vcol < cols %start print symbol (ESC) %if video&2 # 0 %then print symbol ('x') %c %else print symbol ('I') %and print symbol (0) %finish %end ! %routine vnewline vrow = vrow+1; vcol = 0 newline %end ! %routine insert line(%integer row) %if video < 0 %start at (row,0) %if vrow # row vcol = 0 print symbol (ESC); print symbol ('L') %finish %end ! %routine delete line(%integer row) %if video < 0 %start at (row,0) %if vrow # row vcol = 0 print symbol (ESC); print symbol ('M') %finish %end ! %const %integer clear = 1, inc = 2 ! %routine display line (%integer mode) %integer k %if video<<1 > 0 %and vcol = 0 %start print symbol (' '); vcol = 1 %finish %cycle vp = gaplim %if vp = gaptop %if vp = flim %start %if endon = 0 %start print string(" **END**") limline = winline + vrow - wintop %finish endon = 1 %exit %finish k = byteinteger(vp); vp = vp+1 %exit %if k = nl print symbol(k) %if vcol < cols vcol = vcol+1 %repeat clear line %if mode&clear # 0 vnewline %if mode&inc # 0 %end ! %routine update ! If a change has been made to the file ! update screen image, but only if current line is on screen ! CHANGEMIN identifies the earliest point in the file affected ! by alterations %integer l,d,j,nop %return %if changemin = newlim; !no change => %return %if video = 0 joins = joins-breaks; l = line - winline + wintop - breaks %if l >= wintop %and l < winlim %start; !within window vp = changemin; endon = 0 changemin = changemin-1 %while changemin # newtop %c %and byteinteger(changemin-1) # nl %if video < 0 %then at(l,vp-changemin) %c %else at(l,vp-changemin+1) nop = 1 %if changelbeg # lbeg %or vp # changemin %start nop = 0 display line (clear+inc) l = l+1 %finish -> done %if l = winlim %if joins < 0 %and video < 0 %start; !net expansion j = joins %cycle %if wintop > zrow %start delete line(zrow) wintop = wintop-1; l = l-1 %finish %else %start delete line(winbot) %finish j = j+1 %repeat %until j = 0 %cycle insert line(l) joins = joins+1 %repeat %until joins = 0 %finish %while vrow # winlim %c %and (newtop<=vp 0 %start display line (clear+inc) %while vrow # winlim %finish %else %start j = joins %cycle delete line(vrow) j = j-1 %repeat %until j = 0 %cycle %cycle vp = gaplim %if vp = gaptop endon = 1 %and %exit %if vp = flim vp = vp + 1 %repeat %until byteinteger(vp-1) = NL d = d-1 %repeat %until d = 0 at(winlim-joins,0) %cycle insert line(vrow) display line(clear+inc) %repeat %until vrow = winlim %finish %finish %finish done: changemin = newlim; joins = 0; breaks = 0 %end ! %routine display ! Update screen & ensure that current line is on screen %integer pre,k ! %routine scanback %while pre > 0 %cycle vp = gaptop %if vp = gaplim %exit %if vp = newtop %cycle vp = vp-1 vp = gaptop %if vp = gaplim %repeat %until vp = newtop %or byteinteger(vp-1) = nl pre = pre-1 %repeat %end ! update vp = lbeg; endon = 0 vp = vp-gaplim+gaptop %if vp < gaplim <= fp %if video = 0 %start; !hardcopy vcol = 0; printline = line; printed = gaptop+fp %if vp # fp %and num = 1 %start %cycle print symbol (byteinteger(vp)) vp = vp + 1 vp = gaplim %if vp = gaptop %repeat %until vp = fp print symbol ('^') %finish display line (inc) %return %finish pre = line - winline %if pre < 0 %start; !before start of window %if pre > -minwin %and (video<0 %or wintop+pre>=zrow) %start !worth prefixing wintop = wintop+pre; !decrease wintop (PRE neg) %while wintop < zrow %cycle delete line(winbot) insert line(zrow) wintop = wintop+1 %repeat %if wintop > zrow %start at(wintop-1,0) print symbol('='); clear line %finish at(wintop,0) %cycle display line (clear) pre = pre+1 %exit %if pre >= 0 vnewline %repeat winline = line %return %finish %finish %else %start pre = pre+wintop-winlim %return %if pre < 0; !within window => %if pre < minwin %start; !worth appending k = pre scanback at (winlim,0) %if video > 0 %cycle delete line(zrow) %if wintop > zrow %then wintop = wintop-1 %c %else winline = winline+1 insert line(winbot) display line (clear+inc) k = k-1 %repeat %until k < 0 NEWLINE %IF VIDEO > 0; !*MOUSES*/*VAX* %return %finish %finish pre = minwin-1 pre = pre//2 %if fp # flim winline = line-pre scanback winline = winline+pre wintop = winlim-minwin %if wintop > zrow %start at(wintop-1,0) print symbol('='); clear line vnewline %finish %else %start at(zrow,0) %finish %cycle display line (clear) %exit %if vrow >= winbot vnewline %repeat %end ! ! F i l e m o d i f y i n g r o u t i n e s ! %routine split ! Create gap in file if gap is not at FP %integer j,diff,unit %if newtop <= fp < gaptop %start; !FP in upper half !?????? !?????? %if flim # newlim %start; !Lower half still in old !?????? j = flim - gaplim; ! so must now copy across !?????? ->abdn %if newlim - j < gaptop !?????? move (j,gaplim,newlim-j) !?????? gaplim = newlim - j !?????? flim = newlim !?????? %finish !?????? j = gaptop-fp; !amount to shift down diff = gaplim-gaptop %cycle; !shift in units <= gapsize unit = j; unit = diff %if diff < unit gaptop = gaptop-unit; gaplim = gaplim-unit move(unit,gaptop,gaplim) j = j-unit %repeat %until j = 0 mstart = gaplim %if mstart = fp lbeg = lbeg+diff; lend = lend+diff fp = gaplim %finish %else %start j = fp-gaplim %if j > 0 %start ->abdn %if gaptop+j >= newlim move(j,gaplim,gaptop) %finish gaptop = gaptop+j; gaplim = fp %finish %if gaptop < changemin %start changemin = gaptop; changelbeg = lbeg %finish j = gaplim; j = newlim %if flim # newlim %return %if gaptop+256 < j abdn: print string(" ** File too big ") %stop %end ! %routine consolidate ! Ensure that the gap lies on a line boundary ! by copying up the remainder of a split line %integer diff %if gaptop # newtop %and byteinteger(gaptop-1) # nl %start %cycle byteinteger(gaptop) = byteinteger(gaplim) %if gaplim = fp %start diff = gaplim-gaptop lbeg = lbeg-diff; fp = fp-diff lend = lend-diff; mstart = fp %if mstart = gaplim %finish gaptop = gaptop+1; gaplim = gaplim+1 %repeat %until byteinteger(gaptop-1) = nl %finish %end ! %routine join ! Erase from FP to end of line AND the line terminator ! (covers Kill, Join, Uncover) ! NB LEND not updated split lbeg = lbeg+(lend-fp+1); fp = lend+1 changelbeg = lbeg gaplim = fp %if line >= winline %then joins = joins+1 %c %else winline = winline-1 limline = limline-1 %end ! %routine switch ! Switch between main and secondary input ! Create false bottom if switching from main and lower half is in NEW %integer i split newlim = gaplim %if flim = newlim; !create false bottom i = sfp; sfp = fp; fp = i i = slim; slim = flim; flim = i sin = sin!!1 lbeg = lbeg-sfp+fp; gaplim = fp newlim = flim %if newlim = gaplim; !remove false bottom lend = fp lend = lend+1 %while lend # flim %and byteinteger(lend) # nl joins = 999 limline = 99999 %end ! ! C o m m a n d i n p u t routines ! %integer type,chain,hold,echo ! %routine print code(%integer k) ! Print command letter (mapping 'minus' values) print symbol(k-casebit) %and k='-' %if k >= 'a' print symbol(k) %end ! %own %string(80) com line = "" %own %integer com pos = 1 %own %string(15) prompt ! %routine report bells(%integer N) %cycle printsymbol(7) printsymbol(-1) %exit %if n <= 0 n = n-1 skipsymbol %repeat %end %routine read line ! Binary input burdens us with line editing %integer sym print string (prompt) com line = "" %cycle print symbol (-1); !force output read symbol (sym); sym = sym&127 %if sym = ctrl X %start; !line cancel com line = "" print symbol (CR); clear line; newline print string (prompt); print symbol (-1) %else %if sym = DEL %or sym = BS %if com line # "" %start length(com line) = length(com line) - 1 print symbol (BS) print symbol (' ') print symbol (BS); !erase char on screen %finish %else %if sym = TAB print symbol (' '); print symbol (' '); print symbol (' ') com line = com line . " " %else %if sym = CR %start print symbol (CR); sym = NL print symbol (LF) %else %if sym = NL report bells(0) %and %continue %if Com Line # "" sym = CR %else %if sym = ESC !no echo report bells(1) %and %continue %if Com Line # "" %else %if sym < ' ' %continue %finish %else print symbol (sym) com line = com line . to string (sym) %exit %if sym < ' ' %finish %repeat print symbol (-1) com pos = 1 %end ! %routine read sym ! Read next command symbol to SYM (maybe from macro def) %if pend # 0 %start sym = pend; pend = 0 %finish %else %start %while macpos # 0 %cycle; !expanding macro sym = macstore(macpos&255) macpos = macpos+1 %return %unless sym = nl; !(NL is definition terminator) macpos = macpos>>8 %repeat read line %if com pos > length(com line) sym = char no (com line,com pos) com pos = com pos + 1 print symbol (sym) %if echo # 0 %and sym >= ' ' %finish %end ! %routine ignore echo = 0 read sym %while sym # nl %end ! !Symbol types:- ! 0:numeric 1:terminator 2:illegal 3:quote ! 4:DU 5:IS 6:E 7:KJBGC@$ ! 8:F 9:TV 10:M 11:LR ! 12:( [ 13:, 14:) ] 15:? \ !High order bits relevant following percent %constbyteintegerarray symtype(32:95) = %c 16_03,16_03,16_03,16_03,16_07,16_02,16_03,16_03, 16_0C,16_0E,16_00,16_03,16_0D,16_02,16_03,16_03, 16_00,16_00,16_00,16_00,16_00,16_00,16_00,16_00, 16_00,16_00,16_03,16_01,16_02,16_02,16_02,16_0F, 16_07,16_87,16_07,16_17,16_54,16_06,16_08,16_07, 16_02,16_05,16_07,16_07,16_6B,16_4A,16_02,16_02, 16_0B,16_02,16_0B,16_25,16_09,16_34,16_49,16_70, 16_70,16_70,16_70,16_0C,16_0F,16_0E,16_03,16_03 ! sp ! " # $ % & ' ! ( ) * + , - . / ! 0 1 2 3 4 5 6 7 ! 8 9 : sc < = > ? ! @ A B C D E F G ! H I J K L M N O ! P Q R S T U V W ! X Y Z ( \ ) ^ _ ! %routine read item ! Read symbol to SYM and codify in TYPE ! intercept macro letters ('W', 'X', 'Y', 'Z') ! assemble numeric items in NUM %cycle type = 1; !for terminator read sym %until sym # ' '; !ignore spaces %return %if sym < ' '; !terminator (any control) => sym = sym&95 %if sym >= 96; !ensure upper case (and more) type = symtype(sym)&15 %return %if type # 0; !not numeric or macro => %exit %if sym < 'W' %if macpos>>24 # 0 %then macpos = 0 %c %else macpos = (macpos<<2+(sym-'W'))<<6+1; !push down any existing calls %repeat num = 0 %return %if sym = '*' %cycle num = num*10+sym-'0' read sym %repeat %until %not '0' <= sym <= '9' pend = sym %end ! %routine minus ! Test for minus: map CODE if so %if sym = '-' %start code = code+casebit; !lower-case read item %finish %end ! %routine unchain ! Insert forward references in left bracket and comma cells %cycle ref = chain %return %if ref = 0 chain = r(ref)_ref r(ref)_ref = ci %repeat %until r(ref)_code = '[' %end ! ! %const %byte %array immed('A':'D') = 'm', 'M', 'R', 'L' !up down right left !escA escB escC escD (fn keys on input) %switch c(4:15), pc(0:15), s('$':'p') %integer i,j,p,fp1 %shortinteger forced ! ! I n i t i a l i s a t i o n ! mstart = 0; cmax = 0 r(cbound-1) = 0; !'immediate-action' cell r(cbound-1)_count = 1 r(cbound) = 0 r(cbound)_code = ']'; !terminating cell for i-a r(cbound)_count = stopper+1 macpos = 0 macstore(1) = nl; macstore(65) = nl macstore(129) = nl; macstore(192) = nl casemask = \casebit; !ignore case distinctions (default) width = 80; dir = 0 newtop = new_top; gaptop = newtop newlim = new_lim fp = old_top gaplim = fp; lbeg = fp; lend = fp flim = old_lim lend = lend+1 %while lend # flim %and byteinteger(lend) # nl sin = 0; sfp = sec_top; slim = sec_lim changemin = newlim; changelbeg = 0 joins = 0; breaks = 0 line = 1; winline = 0; limline = 999999 WINLIM = ROWS-2; !VAX/MOUSES winbot = winlim-1; wintop = winbot minwin = 3 vrow = 99 newlines (rows-winlim-1) %if video # 0 %for i = 0,1,3 %cycle %for j = 1,1,length(prom(i)) %cycle charno(prom(i),j) = esc %if charno(prom(i),j) = '^' %repeat charno(prom(i),3) = ' '+winlim %if i > 0 CHARNO(GPROM(I),1) = ESC %IF I > 0; !VAX/MOUSES %repeat charno(prom(1),4) = rt; charno(prom(1),7) = rt %IF NEW_LIM > OLD_LIM %START; !MOUSES GAPTOP = OLD_LIM; GAPLIM = NEW_LIM FLIM = GAPLIM BYTEINTEGER(GAPLIM) = NL FP = GAPLIM %IF FP = GAPTOP LBEG = FP; LEND = FP %FINISH LEND = LEND+1 %WHILE LEND # FLIM %AND BYTEINTEGER(LEND) # NL sym = nl ! ! R e a d n e w c o m m a n d l i n e ! read: %if sin = 0 %then prompt = prom(video&3) %c %else prompt = prom(video&3).">" pend = 0; sym1 = sym r(cbound-1)_count = 1 %if sym = nl %start %if video = 0 %start num = 1 display %if (mon=0 %and printline#line) %c %or (mon>0 %and printed#gaptop+fp) %finish %else %start display ! show position of pointer fprow = line-winline+wintop at(fprow,fp-lbeg) %if video > 0 %start print symbol ('^') sym1 = ' ' %if fp # lbeg %start %if fp # gaplim %then sym1 = byteinteger(fp-1) %c %else sym1 = byteinteger(gaptop-1) %finish %finish %else %start print symbol(esc); print symbol('4'); !reduced intensity sym1 = ' '; sym = '|' %if fp # lend %and byteinteger(fp) # ' ' %start sym1 = byteinteger(fp); sym = sym1 %finish print symbol(sym) print symbol(esc); print symbol('3'); !normal intensity %finish NEWLINE; !VAX to flush %finish %finish %else %start read sym pend = sym %if sym # nl; !NL not significant %finish ! Deal with special cases ci = 0; ti = 0; chain = 0 echo = 0 %cycle read item %exit %if sym # '-' dir = dir!!casebit; !toggle direction %repeat %if type = 1 %and sym = ESC %start; !fn key input read symbol (sym) r(cbound-1)_code = immed(sym) %if 'A' <= sym <= 'D' %if sym = 'P' %start r(cbound-1)_code = 'W'; r(cbound-1)_count = 0 %finish ci = cbound - 2 sym = NL; !force display later ->restore %finish %if type = 1 %start ->read %if cmax = 0 %or sym # CR type = 0; num = 1 r(cmax)_count = num sym = NL; ->restore %finish; !LF->CR (in READLINE) -> "1" (again) %if type = 0 %and cmax # 0 %start; !repetition r(cmax)_count = num read item; -> er1 %if type # 1 -> restore %finish %if sym = '%' %start read sym; -> erq %if sym < 'A' code = sym&95; !upper-case read sym -> pc(symtype(code)>>4&15) %finish dir = 0 %if video > 0 %start clear line; print symbol('=') print symbol(sym) echo = 1 %finish ! C o m m a n d i n p u t: m a i n l o o p more: !(command code has been read) hold = type; -> er2 %if hold < 4 -> er0 %if hold < 8 %and newtop = 0; !'change' command when Showing ci = ci+1; -> er6 %if ci >= cbound-3 code = sym; !command letter ref = 0; num = 1; scope = 1; !default values read item -> c(hold) c(8): !Find minus scope = 0 c(4): !+ Delete, Uncover c(9): !+ Traverse, Verify %if type = 0 %start; !followed by number scope = num read item %finish num = 0; !as indicator (not I,S) c(5): !+ Insert, Substitute hold = sym; -> er4 %if type # 3; !not valid quote mark -> ti = ti+1; ref = ti; !REF indexes first quoted symbol %cycle read sym %if sym = nl %start; !closing quote omitted -> er4 %if num = 0; !allowed only for I,S pend = sym; sym = hold %finish %exit %if sym = hold -> er6 %if ti > tbound-2 sym = sym&casemask %if 'a' <= sym <= 'z' %and num = 0 text(ti) = sym; ti = ti+1 %repeat -> er4 %if ti = ref %and num = 0; !null allowed only for I,S text(ti) = 0; !end-marker num = 1; !restore default read item -> nput c(6): !Erase c(10): !+ Move, Print minus c(7): !+ Get, Kill, etc c(11): !+ Left, Right, etc -> er1 %if type = 3; !(redundant, but better report) -> nput c(12): !open bracket code = '[' -> comma c(13): !comma code = '^' ! read item %if type = 1; !permit line break (better not?) comma: ref = chain; chain = ci -> put c(14): !close bracket unchain; -> er3 %if ref = 0 code = ']'; r(ref)_count = num nput: read item %if type = 0; !get next item if number c(15): !invert, query put: r(ci)_code = code; r(ci)_ref = ref r(ci)_scope = scope; r(ci)_count = num -> more %unless type = 1 ci = ci+1; cmax = ci unchain; -> er3 %if ref # 0 r(ci)_code = ']'; r(ci)_ref = 0 r(ci)_count = 1 ci = 0 insert line(winlim); !preserve command line restore: %if sym1 # nl %start at(fprow,fp-lbeg) print symbol(sym1) %finish -> next ! er0:print symbol(' '); print code(sym) print string(" when showing") -> erq er1:print symbol(' '); print symbol(code) er2:code = sym -> er5 er3:printstring(" ()") -> erq er4:printstring(" Text for") pc(0): er5:print symbol(' '); print code(code) -> erq er6:printstring(" Size") erq:print symbol('?') %if video # 0 %then clear line %else newline cmax = 0 %if ci > 1 ignore -> read ! ! Percent commands pc(1): !%C: close switch %if sin # 0 new_flag = 1 %if changelbeg # 0 new_lim = gaptop old_top = gaplim; old_lim = flim clear line %return pc(2): !%S: switch inputs switch %if sin # 0 %if sym = '=' %start i = 0 %cycle read sym %exit %if sym = ';' %or sym = nl -> er6 %if i = maxname i = i+1; charno(sec_name,i) = sym %repeat %if i # 0 %start length(sec_name) = i ->erq %unless exists (sec_name) connect input(sec) %finish %finish sfp = sec_top; slim = sec_lim -> erq %if sec_top = sec_lim switch -> read pc(3): !%U: ignore/respect case casemask = \casebit casemask = \0 %and read sym %if sym = '-' -> read pc(4): !%M (%V) %if code = 'M' %start mon = 0 mon = 1 %and read sym %if sym = '+' mon = -1 %and read sym %if sym = '-' %finish %else %start read item -> erq %if type # 0 video = (num&x'C')<<28+num&3 winline = -99 %finish -> read pc(5): !%D: define window size %if sym = '=' %start read item -> erq %if type # 0 -> er6 %unless num <= winlim minwin = num video = 0 %if num <= 0 %finish winline = -99 -> read pc(6): !%L: define line length -> erq %if sym # '=' read item -> erq %if type # 0 -> er6 %unless 5 <= num <= 256 width = num -> read pc(7): !%W, %X, %Y, %Z i = (code-'W')<<6+1; !64-byte increments %if sym = '=' %start; !definition %cycle read sym macstore(i) = sym %exit %if sym = nl i = i+1 %if i # 255 %repeat %finish %else %start; !enquiry -> er1 %if sym # nl print symbol(code); print symbol('=') %cycle sym = macstore(i) %exit %if sym = nl print symbol(sym) i = i+1 %repeat %if video # 0 %then clear line %else newline %finish -> read ! pc(8): !%A: abandon edit out_name = ""; !force SHOW %return; !back from EDI ! pc(*): ->er5 ! ! C o m m a n d e x e c u t i o n ! %integerfn matched %integer i,j,k i = fp-1; j = ref-1 %cycle i = i+1; j = j+1 k = byteinteger(i) k = k&casemask %if 'a' <= k <= 'z' %repeat %until k # text(j) %result = 0 %if text(j) # 0 mstart = fp; msize = i-fp %result = 1 %end ! ! Extract next command ! next: s('?'): ci = ci+1 code = r(ci)_code; ref = r(ci)_ref num = r(ci)_count; forced = 0 -> s(code) ! ! Successful return after Move etc ! FP has been advanced into next line, new LEND to be determined lok: lend = fp %if lend # flim %start lend = lend+1 %while byteinteger(lend) # nl %finish ! Successful return from execution ok: num = num-1 -> next %if num = 0 -> s(code) fail: num = 1 ! Failure return no: s('\'): %cycle -> next %if num <= 0; !indefinite repetition -> ci = ci+1 -> next %if r(ci)_code = '\'; !invert immediately after -> -> next %if r(ci)_code = '?'; !query immediately after -> %while r(ci)_code # ']' %cycle -> next %if r(ci)_code = '^'; !comma -> ci = r(ci)_ref %if r(ci)_code = '[' ci = ci+1 %repeat num = r(ci)_count %repeat %until ci >= cmax -> read %if num <= 0 ! !E x e c u t i o n e r r o r ! at(winlim+1,40) printstring(" Failure: ") print code(code) %if ref # 0 %start print symbol('''') %while text(ref) # 0 %cycle print symbol(text(ref)) ref = ref+1 %repeat print symbol('''') %finish %if video # 0 %then clear line %else newline ignore -> read ! !I n d i v i d u a l c o m m a n d s ! s('['): !open bracket r(ref)_count = num; !restore count on ']' -> next ! s(']'): !close bracket num = num-1 %if num # 0 %and num # stopper %start r(ci)_count = num; !update ci = ref; !position of '[' %finish %else %start -> read %if ci >= cmax %finish -> next ! s('^'): !comma ci = ref-1; !position of ']' - 1 -> next ! s('P'): display ->ok %if num = 1 s('M'): !Move -> no %if fp = flim update fp = lend+1 fp = gaplim %if fp = gaptop line = line+1 fp = flim %and line = limline %if num = 0 %and code = 'M' lbeg = fp -> lok ! s('m'): !Move back -> no %if lbeg = newtop %or sin # 0 update consolidate mstart = 0 %if num = 0 %start; !M-* lbeg = newtop lbeg = gaplim %if lbeg = gaptop fp = lbeg line = 1; num = 1 -> lok %finish %if lbeg = gaplim %start -> no %if gaptop = newtop lbeg = gaptop %finish line = line-1; !there is a line there lend = lbeg-1 lbeg = lbeg-1 %until lbeg=gaplim %or lbeg=newtop %or byteinteger(lbeg-1)=nl fp = lbeg -> ok ! s('c'): !Left-shift then case flip s('L'): !Left-shift left: -> no %if fp = lbeg %or sin # 0 consolidate %if fp = gaplim mstart = 0 fp = fp-1 forced = 0 %and ->ok %if forced # 0 %or code = 'L' ! s('C'): !Case-change with right-shift -> no %if fp = lend %if 'A' <= byteinteger(fp)&95 <= 'Z' %start split byteinteger(gaptop) = byteinteger(fp)!!casebit gaptop = gaptop+1; gaplim = gaplim+1 %finish ! s('R'): !Right-shift -> no %if fp = lend fp = fp+1 forced = 1 %and ->left %if code = 'c' -> ok ! s('E'): !Erase -> no %if fp = lend split lbeg = lbeg+1; fp = fp+1 gaplim = fp -> ok ! s('e'): !Erase back -> no %if fp = lbeg split lbeg = lbeg+1; gaptop = gaptop-1 changemin = gaptop %if gaptop < changemin -> ok ! s('V'): !Verify -> no %if fp = lend -> no %if (byteinteger(fp)!!text(ref))&casemask # 0; !quick check -> no %if matched = 0 -> next ! s('D'): !Delete s('T'): !+ Traverse fp1 = fp -> find ! s('F'): !Find s('U'): !+ Uncover fp1 = fp fp = fp+1 %if fp = mstart find: scope = r(ci)_scope; !number of lines to search sym1 = text(ref); !first symbol of quoted text %while fp # flim %cycle %while byteinteger(fp) # nl %cycle %if (byteinteger(fp)!!sym1)&casemask = 0 %start -> found %if matched # 0 %finish fp = fp+1 %repeat lend = fp scope = scope-1 %exit %if scope = 0 %if code # 'U' %start update fp = fp+1 fp = gaplim %if fp = gaptop lbeg = fp line = line+1 %finish %else %start fp = fp1; join %finish fp1 = fp %repeat lend = fp; fp = fp1 -> no found: %if code = 'D' %start split lbeg = lbeg+msize; fp = fp+msize gaplim = fp %finish fp = fp+msize %if code = 'T' %if code = 'U' %start i = fp-fp1; fp = fp1 split lbeg = lbeg+i; fp = fp+i gaplim = fp %finish -> lok ! s('f'): !Find back scope = r(ci)_scope update consolidate %cycle %while fp # lbeg %cycle fp = fp-1 -> ok %if matched # 0 %repeat scope = scope-1 -> no %if scope = 0 %or fp = newtop %if fp = gaplim %start -> no %if gaptop = newtop fp = gaptop %finish lbeg = fp fp = fp-1; lend = fp line = line-1 lbeg = lbeg-1 %until lbeg=gaplim %or lbeg=newtop %or byteinteger(lbeg-1)=nl %repeat ! s('S'): !Substitute -> no %if fp # mstart split lbeg = lbeg+msize; fp = fp+msize gaplim = fp ! s('I'): !+Insert -> ok %if text(ref) = 0 -> no %if fp-lbeg > width %or fp = flim split j = ref %cycle byteinteger(gaptop) = text(j) gaptop = gaptop+1; j = j+1 %repeat %until text(j) = 0 lbeg = lbeg-(j-ref) -> ok ! s('W'): !immediate insert split display at (line-winline+wintop,fp-lbeg) print symbol (-1) %cycle read symbol (sym); sym = sym&127 %if sym = ESC %start read symbol (Sym); %continue %unless Sym&127 = 'H' print symbol (ESC); print symbol ('j'); !out of insert mode consolidate sym = NL ->no %finish %if sym = DEL %or sym = ctrl X %start %while gaptop # newtop %and byteinteger(gaptop-1) # NL %cycle gaptop = gaptop - 1 print symbol (BS); print symbol (ESC); print symbol ('O') print symbol (-1) lbeg = lbeg + 1 %repeat %until sym = DEL %continue %finish %if sym = CR %start consolidate display ->s('B') %finish %if sym = TAB %start %for j = 0,1,2 %cycle byte integer (gaptop+j) = ' ' print symbol (' ') %repeat print symbol (-1) gaptop = gaptop + 3 %continue %finish print symbol (ESC); print symbol ('i'); !into insert mode print symbol (sym) sym = NL %and print symbol (sym) %if sym = CR print symbol (ESC); print symbol ('j'); !& out again print symbol (-1) byte integer (gaptop) = sym gaptop = gaptop + 1 lbeg = lbeg - 1 {?} %repeat ! s('G'): !Get (line from terminal) -> no %if sin # 0 %and fp # lbeg consolidate fp = lbeg split %if video # 0 %start %if video < 0 %start display fprow = line-winline+wintop delete line(winlim) insert line(fprow) %finish %else %start byteinteger(gaptop) = nl; gaptop = gaptop+1 breaks = breaks+1 line = line+1; limline = limline+1 update fp = gaptop-1; lbeg = fp line = line-1 display fprow = line-winline+wintop gaptop = gaptop-1 fp = gaplim; lbeg = fp limline = limline-1 at(fprow,0) %finish NEWLINE; !VAX %finish prompt = gprom(video&3) read sym vrow = 999 %if sym = ':' %start read sym %until sym = nl %if video # 0 %start %if video < 0 %start delete line(fprow) insert line(winlim) %finish %else %start changemin = gaptop; changelbeg = lbeg joins = joins+1 %finish %finish -> no %finish line = line+1; limline = limline+1 %cycle byteinteger(gaptop) = sym; gaptop = gaptop+1 %exit %if sym = nl read sym %repeat %if video < 0 %and fprow = winbot %start; !bring back delete line(zrow) %if wintop > zrow %then wintop = wintop-1 %c %else winline = winline+1 insert line(winlim) %finish -> ok ! s('B'): !Break num = 66 %if num = 0 %or num > 66 split break: byteinteger(gaptop) = nl; gaptop = gaptop+1 breaks = breaks+1 line = line+1; limline = limline+1 lbeg = fp -> ok ! s('K'): !Kill -> no %if fp = flim fp = lbeg join -> lok ! s('J'): !Join fp = lend -> no %if fp = flim %or fp-lbeg > width join -> lok ! s('A'): !Adjust -> s('M') %if lend = lbeg consolidate %while lend-lbeg <= width %cycle fp = lend+1 %if fp = gaptop %start fp = gaplim; lbeg = lbeg+(gaplim-gaptop) %finish lend = fp lend = lend+1 %while lend # flim %and byteinteger(lend) # nl %if fp = lend %or byteinteger(fp) = ' ' %start update lbeg = fp; line = line+1 ->no %finish split byteinteger(gaptop-1) = ' ' changemin = gaptop-1 %if changemin >= gaptop joins = joins+1; limline = limline-1 %repeat consolidate fp = lbeg+width+1 %cycle fp = fp-1 -> no %if fp = lbeg %repeat %until byteinteger(fp) = ' ' split fp = fp+1 gaplim = fp -> break ! ! s('@'): !'at' Column NUM -> fail %if lend = flim i = width-(lend-fp) num = i %if i < num i = fp-lbeg-num -> next %if i = 0 split %cycle %if i < 0 %start; !left of it byteinteger(gaptop) = ' '; gaptop = gaptop+1 lbeg = lbeg-1; i = i+1 %finish %else %start -> fail %if fp = lbeg %or byteinteger(gaptop-1) # ' ' gaptop = gaptop-1; lbeg = lbeg+1 changemin = gaptop %if gaptop < changemin i = i-1 %finish %repeat %until i = 0 -> next s('$'): switch -> next %end; !END OF EDI ! ! in = 0; sec = 0; out = 0 l = 0 IN_NAME = COMMAND_IN1 SEC_NAME = COMMAND_IN2 out_name = in_name; default = 1 OUT_NAME = COMMAND_OUT1 %AND DEFAULT = 0 %IF COMMAND_OUT1 # "" IN_NAME = "" %IF IN_NAME = "n:" OUT_NAME = "" %IF OUT_NAME = "n:" %IF OUT_NAME = "" %START CONNECT INPUT(IN); !WITHOUT EXTRA %STOP %IF IN_FLAG # 0 %FINISH %ELSE %START IN_FLAG = 20; !EXTRA BLOCKS CONNECT INPUT(IN) %STOP %IF IN_FLAG # 0 %IF SEC_NAME # "" %START CONNECT INPUT(SEC) %STOP %IF SEC_FLAG # 0 %FINISH OUT_TOP = IN_VMTOP; OUT_LIM = IN_ LIM; !VAX in_top = in_lim %if in_name = "" %finish newline %if command_modifier # 0 %then EDI(in,sec,out,0,24,80) %c %else edi (in,sec,out,x'C0000002'{vt52},24,80) %if (default # 0 %and out_flag = 0) %or out_name = "" %start print string("No changes") out_top = 0 %finish Terminal mode (0); !back to normal %if out_top # 0 %start i = in_lim-in_top; move(i,in_top,out_lim) out_lim = out_lim+i CLOSE OFF %finish %if out_flag # 0 %and out_name # "" %start print string (out_name . " complete") newline %finish %endofprogram H?RR5@?@+Ig:W:)sa/{a4%begin %option "Noopen" ! Implementation of Edinburgh Compatible Context Editor in IMP ! K.Adam & R. Thonnes (April 1977) ! based on that for DEC PDP-9/15 by H.Dewar (June 1970) ! Updated for Mouses P. Robertson (June 1980) ! with: Re-implementation of - commands using lower-case controls ! Plus: J- K- C C- L- R- O %OWNINTEGER BUFFER SIZE = 3000 %CONSTINTEGER MIN=1; !MAIN INPUT STREAM %CONSTINTEGER MOUT=1; !MAIN OUTPUT STREAM %CONSTINTEGER SIN=2; !SECONDARY INPUT STREAM ! Secondary input is not a standard feature of ECCE %CONSTINTEGER STOP=-5000; !LOOP STOP VALUE %OWNINTEGER IN=MIN; !CURRENT INPUT STREAM %OWNINTEGER MON=1; !MONITOR INDICATOR %OWNINTEGER PRINT1=0,PRINT2=0; !PRINT INDICATORS %OWNINTEGER SYM = NL %BYTEINTEGERARRAY MAP(0:127); !UPPER/LOWER CASE MAP %INTEGER I,J,K,PP1 %CONSTINTEGER SEXTRA=180; !EXTRA BUFFER FOR SIN %INTEGERNAME MAINFP; ! == FP OR MFP (FOR SIN) ! The command input phase reads and checks a complete !command line, forming up an internal representation !as a sequence of fixed-length command units. !The basic components of a command unit are: %externalstring(17) %spec Console int %INTEGER CODE; !COMMAND CODE SYMBOL %INTEGER TEXT; !TEXT POINTER (0 IF NOT RELEVANT) %INTEGER NUM; !REPETITION NUMBER !Command units are stored sequentially from the start !of array C (CBASE): text strings are stored backwards !from the end of the same array (TBASE). !Parentheses and commas occurring in commands are also !transformed to command units. The TEXT component of !open bracket and comma units points to the corresponding !close bracket: the TEXT component of close bracket !units points back to the first enclosed unit. %INTEGERARRAY C(0:119) %INTEGER CBASE; CBASE = ADDR(C(0)); !(CONST AD) %INTEGER TBASE; TBASE = CBASE+119*4; !(CONST AD) %INTEGER CI; !COMMAND INDEX (AD) %INTEGER TI; !TEXT INDEX (AD) %OWNINTEGER CMAX=0; !COMMAND MAX (AD) ! Macro definitions (optional feature) %INTEGERARRAY STORED(1:192); !DEFS OF X,Y,Z %OWNINTEGER POS1=0, POS2=0, POS3=0; !DEF POINTERS %owninteger null file = 0 %include "sysinc:command.inc" %begin %integer j %externalintegerfnspec out type %on 9 %start select output(0) printstring("Edit ".Command_In1." fails -- ".Event_message) newline %stop %finish buffer size = freespace-1000 %signal 1,0 %if buffer size < 1000 map(j) = j %for j = 0, 1, 127 map(j+32) = j %for j = 'A', 1, 'Z'; !start with lower=upper (%u) command_in1 = "n:" %if command_in1 = "" command_in2 = command_in1 %if command_in2 = "" command_out1 = command_in1 %if command_out1 = "" open input(1, command_in1) open input(2, command_in2) open output(1, command_out1) select output(1); null file = 1 %if out type = 0 select output(0) %end %BYTEINTEGERARRAY A(0:BUFFER SIZE) ! The following variables are pointers to the main array A !Their values are interpreted as byte addresses by !the machine-code byte-accessing routines LOAD PP, LOAD !FP and BYTE. !The addresses of the left and right bytes of a word are !2W and 2W+1 respectively: hence incrementation and comparison !properties are preserved. %OWNINTEGER TOP=1; !TOP OF BUFF (CONST) %INTEGER BOT; BOT=BUFFER SIZE-sextra-1; !BOTTOM OF BUFF (CONST) %INTEGER LBEG; !LINE START %INTEGER PP; !PREVIOUS POINTER %OWNINTEGER FP=0; !FILE POINTER %INTEGER LEND; !LINE END %OWNINTEGER FEND=0; !END OF FILE IN BUFF %OWNINTEGER MS=0; !MATCH START %OWNINTEGER ML=0; !MATCH LIMIT %OWNINTEGER CASE = 95; !%U DEFAULT %owninteger gprompt = 1; !zero to inhibit any prompt for G ! The (part of the) file held in the array A is !stored as a top half (from TOP inclusive to PP exclusive) !and a bottom half (from FP inclusive to FEND exclusive). !The gap corresponds to the position of the file-pointer. !Text location operations do not therefore simply involve !moving a pointer: the text passed over is moved across !the gap. The additional processing overhead is relatively !small and is outweighed by the simplification of insertion and !deletion operations that is achieved by this technique. ! Illustration of pointer significance: ! [NL] O N E NL T W . . . O NL N E X T NL . . NL L A S T NL [NL] ! ! ! ! ! ! ! ! T L P F L F ! O B P P E E ! P E N N ! G D D %INTEGER TYPE,CHAIN %OWNINTEGER PEND=0 %SWITCH T(0:14) %SWITCH S('(':126) %ROUTINESPEC PRINT LINE ! Symbol classification codes are 16X+Y, where Y !is the basic code and X is used to sub-classify !when necessary (eg percent command letters). %OWNINTEGERARRAY SYMTYPE(33:95) = 64, 3, 3, 3, 2, 3, 3,11, 9,64, 3,12, 2, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 3, 3, 3,64, 3, 18,10,24, 5, 8,52,234, 2, 6, 8, 8,120,56, 2, 13, 10,50, 8,22, 5,117, 6, 2,32,32,32, 3,10, 3, 3, 3 ! ! " # $ % & ' ( ) * + , - . / ! 0 1 2 3 4 5 6 7 8 9 : ;! < = > ? ! @ A B C D E F G H I J K L M N O ! P Q R S T U V W X Y Z [ \ ] ^ _ %on %event 9 %start ->er7 %finish %ROUTINE READ SYM %on %event 9 %start sym = '%' pend = 'C' %return %finish ! Read command symbol %IF PEND # 0 %THEN SYM=PEND %AND PEND=0 %ELSE %START %WHILE POS3 # 0 %CYCLE; !MACRO EXPANSION SYM = STORED(POS3); POS3 = POS3+1 %RETURN %UNLESS SYM = 0 POS3 = POS2; POS2 = POS1; POS1 = 0 %REPEAT READ SYMBOL(SYM) %signal 9 %if sym < 0 %FINISH %END %ROUTINE READ ITEM ! Read command item (symbol or number), skipping leading !spaces, standardising case and detecting macro letters. !Set up the type (ie SYMTYPE) of the item in TYPE. !For a 'numeric' item, assemble sequence of digits !as necessary and return value in NUM. !Note that NUM is not altered for a non-numeric item. %CYCLE TYPE = 1; !DEFAULT FOR NL READ SYM %UNTIL SYM # ' ' %RETURN %IF SYM < ' '; !TREAT ANY CONTROL AS NL SYM = SYM-32 %IF SYM >= 96; !ENSURE UPPER CASE TYPE = SYMTYPE(SYM) %RETURN %UNLESS TYPE&15 = 0; !RETURN UNLESS NUMERIC OR X,Y,Z %EXIT %UNLESS TYPE = 32; !X,Y,Z (MACRO LETTERS) POS1 = POS2; POS2 = POS3 POS3 = (SYM-'X')<<6+1 %REPEAT %IF TYPE = 0 %START; !DECIMAL DIGIT NUM = SYM-'0' %CYCLE READ SYM %EXIT %UNLESS '0' <= SYM <= '9' NUM = NUM*10-'0'+SYM %REPEAT PEND = SYM %FINISH %ELSE %START TYPE = 0 NUM = 0; %RETURN %IF SYM = '*' NUM = STOP+1; %RETURN %IF SYM = '?' NUM = STOP; ! '!' %FINISH %END %ROUTINE UNCHAIN ! Use temporary links to locate last unmatched !open bracket (if any), fixing up any comma !units en route. %CYCLE TEXT = CHAIN; %RETURN %IF TEXT = 0 CHAIN = INTEGER(TEXT+4); INTEGER(TEXT+4) = CI %RETURN %IF INTEGER(TEXT) = '(' %REPEAT %END %ROUTINE STACK(%INTEGER V) INTEGER(CI) = V; CI = CI+4 %END %ROUTINE READ LINE %INTEGER K %on %event 9 %start ->eof %finish ! Read line from file (if bottom part of buffer empty) %IF FP # FEND %START; !LINE AVAILABLE LEND = FP LEND = LEND+1 %WHILE A(LEND) # NL %FINISH %ELSE %START SELECT INPUT(IN); FP = BOT-181 %CYCLE %IF FP # BOT %THEN%START READSYMBOL(K) %FINISHELSE K = NL A(FP)=K&127; FP = FP+1 %exit %if k = nl %repeat FEND = FP; LEND = FEND-1 FP = BOT-181 ->L1 EOF: FP = BOT; LEND = FP; FEND = LEND A(FP)=NL L1: SELECT INPUT(0) MS = 0; PRINT1 = 0; PRINT2 = 0 %FINISH %END %ROUTINE BREAK A(PP)=NL; PP = PP+1; LBEG = PP %END !INITIALISE SELECT INPUT(0); SELECT OUTPUT(0) STORED(0<<6+1) = 0 STORED(1<<6+1) = 0 STORED(2<<6+1) = 0 PP = TOP-1; BREAK; !FOR BOUNCING OFF MAINFP == FP READ LINE ->MONITOR READ COMMAND: Console int = "" CI = CBASE; TI = TBASE; CHAIN = 0 %IF IN#SIN %THEN PROMPT(">") %ELSE PROMPT(">>") READ ITEM %IF TYPE = 1 %AND SYM = NL %START I = NUM NUM = 0; PRINT LINE NUM = I %FINISH ->READ COMMAND %IF TYPE = 1;!IGNORE BLANK LINES %IF TYPE = 0 %AND CMAX # 0 %START INTEGER(CMAX+8) = NUM READ ITEM; ->ER2 %IF TYPE # 1 ->EXECUTE %FINISH ->NEXT UNIT %UNLESS SYM = '%' READ SYM; SYM = SYM-32 %IF SYM >= 96 CODE = SYM; ->ER5 %IF CODE < 'A' READ ITEM ->T(SYMTYPE(CODE)>>4); !SWITCH ON EXT TYPE !T(1) AT END OF PROGRAM T(2): !%X, %Y, %Z (MACRO DEFINITION) ->ER1 %IF SYM # '=' I = (CODE-'X')<<6+1 %CYCLE READ SYM %EXIT %IF SYM = NL STORED(I) = SYM ->ER6 %IF I&63 = 0 I = I+1 %REPEAT STORED(I) = 0 ->READ COMMAND T(3): !%M, %F, %Q (MONITOR CONTROL) MON = 'M'-CODE ->READ COMMAND T(7): CASE = -32 CASE = 0 %IF CODE = 'L' MAP(J) = J+CASE %FOR J = 'a', 1, 'z' ->READ COMMAND t(14):gprompt = 1-gprompt ->read command NEXT UNIT: !FIRST ITEM ALREADY READ I = TYPE&15; ->ER2 %IF I < 4 CODE = SYM; TEXT = 0; NUM = 1; !DEFAULT VALUES READ ITEM ->T(I); !SWITCH ON BASIC TYPE T(13):!OBSERVE T(4): !+FIND NUM = 0 %UNLESS TYPE = 0 T(5): !+DEL,TRAV,UNCOVER CODE = NUM<<7+CODE; !PACK LIMIT NUMBER NUM = 1; !RESET DEFAULT REPETITION READ ITEM %IF TYPE = 0 T(6): !+INSERT,SUBST,VERIFY ->ER4 %IF TYPE # 3; !NOT LEGIT QUOTE SYMBOL -> TEXT = TI; I = SYM %CYCLE READ SYM %EXIT %IF SYM = I PEND = SYM %AND %EXIT %IF SYM = NL ->ER6 %IF TI <= CI INTEGER(TI) = SYM; TI = TI-4 %REPEAT ->ER4 %IF (SYM=NL %OR TI=TEXT) %AND CODE # 'I' %AND CODE # 'S' INTEGER(TI) = -1; TI = TI-4; !TEXT END MARKER ->RI T(8): !MOVE,ERASE ->NQ %UNLESS SYM = '-' CODE = CODE+32; !to lower case RI: READ ITEM ->RN T(9): !CLOSE BRACKET UNCHAIN; ->ER3 %IF TEXT = 0 INTEGER(TEXT+8) = NUM TEXT = TEXT+12 T(10): !+GET,KILL,ETC. NQ: ->ER1 %IF TYPE = 3; !WOULD FAIL LATER BUT WITH LESS HELPFUL RE RN: READ ITEM %IF TYPE = 0 ->PUT T(12): !COMMA READ ITEM %IF TYPE = 1; !IGNORE FOLLOWING NL T(11): !OPEN BRACKET TEXT = CHAIN; CHAIN = CI NUM = 0 PUT:STACK(CODE); STACK(TEXT); STACK(NUM) ->ER6 %IF CI+8 >= TI ->NEXT UNIT %UNLESS TYPE = 1 UNCHAIN; ->ER3 %IF TEXT # 0 CMAX = CI STACK(')'); STACK(CBASE); STACK(1); !EXTRA ')' STACK(0) ->EXECUTE !COMMAND INPUT ERROR REPORTS ER1:SPACE; PRINT SYMBOL(CODE) ER2:CODE = SYM ->ER5 ER3:PRINT STRING(" ()") ->ER7 ER4:PRINT STRING(" TEXT FOR") T(0): ER5:SPACE; PRINT SYMBOL(CODE&127) ->ER7 ER6:PRINT STRING(" SIZE") ER7:PRINT SYMBOL('?') NEWLINE; CMAX = 0 %IF CI # CBASE READ SYM %WHILE SYM # NL ->read command %ROUTINE LEFT STAR %CYCLE %RETURN %IF PP = LBEG FP = FP-1; PP = PP-1 A(FP)=A(PP) %REPEAT %END %ROUTINE RIGHT STAR %CYCLE %RETURN %IF FP = LEND A(PP)=A(FP) PP = PP+1; FP = FP+1 %REPEAT %END %ROUTINE MAKE SPACE %INTEGER K,P1,P2 ! Check that sufficient breathing space remains !in the internal file buffer. If not, expel part !of the file. %RETURN %IF MAINFP-PP > 240 P1 = TOP; P2 = (P1+LBEG)>>1; !OUTPUT ABOUT HALF P2 = LBEG %IF CODE = 'C' %OR CODE = 'A'; !BUT ALL IF CLOSING %if null file = 0 %start select output(mout) %CYCLE K = A(P1); PRINT SYMBOL(K); P1 = P1+1 %exit %if k = nl %and p1 >= p2 %repeat SELECT OUTPUT(0) %else p1 = p2; p1 = p1+1 %while a(p1) # nl p1 = p1+1 %finish LBEG = TOP+LBEG-P1; P2 = PP; PP = TOP %WHILE P1 # P2 %CYCLE; !COPY UP REMAINDER A(PP)=A(P1) PP = PP+1; P1 = P1+1 %REPEAT %END %ROUTINE REFRESH FP = FP+1; MAKE SPACE; READ LINE %END %ROUTINE PRINT LINE %INTEGER P PRINT1 = LEND; PRINT2 = FP+PP P = LBEG %CYCLE %IF P = PP %START PRINT SYMBOL('^') %IF P # LBEG %AND NUM = 0 P = FP %FINISH %EXIT %IF P = LEND PRINT SYMBOL(A(P)) P = P+1 %REPEAT PRINT STRING("**END**") %IF P = FEND NEWLINE %END %PREDICATE MATCHED %INTEGER I,J,K,L,T1,FP1,LIM ! Used for Find, Uncover, Delete, Traverse LIM = INTEGER(CI-12)>>7; !SEARCH LIMIT T1 = MAP(INTEGER(TEXT)); !EXTRACT FIRST CHAR FOR SPEED %CYCLE PP1 = PP; FP1 = FP %WHILE FP # LEND %CYCLE K = A(FP) %IF MAP(K) = T1 %AND (FP#MS %OR CODE='D' %OR CODE='T') %START I = FP; J = TEXT %CYCLE I = I+1; J = J-4; L = INTEGER(J) %IF L < 0 %START; !COMPLETE STRING MATCHED MS = FP; ML = I PRINT LINE %IF CODE = 'O' %TRUE %FINISH %REPEAT %UNTIL MAP(L) # MAP(A(I)) %FINISH A(PP)=K PP = PP+1; FP = FP+1 %REPEAT LIM = LIM-1 %EXIT %IF LIM = 0 %OR FP = FEND %OR Console int # "" %IF CODE = 'O' %START J = NUM; NUM = 1; PRINT LINE; NUM = J %FINISH %IF CODE # 'U' %THEN BREAK %ELSE PP = PP1 REFRESH %REPEAT PP = PP1; FP = FP1 %FALSE %END EXECUTE: Console int = "" CI = CBASE GET:CODE = INTEGER(CI)&127; ->MONITOR %IF CODE = 0 TEXT = INTEGER(CI+4) NUM = INTEGER(CI+8) CI = CI+12 REP:NUM = NUM-1 ->HALT %UNLESS Console int = "" ->S(CODE) OK: ->REP %UNLESS NUM = 0 %OR NUM = STOP ->GET S('\'): !INVERT NO: ->GET %IF NUM < 0 CI = CI+12 %AND ->GET %IF INTEGER(CI) = '\' SKP:I = INTEGER(CI); CI = INTEGER(CI+4) %IF I = '(' CI = CI+12 NUM = INTEGER(CI-4)-1 %AND ->NO %IF I = ',' %OR I = ')' ->SKP %IF I # 0 !EXECUTION ERROR HALT: PRINT STRING("FAILURE: ") %if code >= 'a' %start PRINT SYMBOL(CODE-32); CODE = '-' %FINISH PRINT SYMBOL(CODE) %IF TEXT # 0 %and code # ')' %START PRINT SYMBOL('''') %WHILE INTEGER(TEXT) >= 0 %CYCLE PRINT SYMBOL(INTEGER(TEXT)) TEXT = TEXT-4 %REPEAT PRINT SYMBOL('''') %FINISH NEWLINE PRINT1 = 0 MONITOR: ->READ COMMAND %IF SYM # NL %OR MON < 0 ->READ COMMAND %IF PRINT1 = LEND %AND (MON = 0 %OR PRINT2 = FP+PP) NUM = 0; PRINT LINE ->READ COMMAND !INDIVIDUAL COMMANDS S('('): !OPEN BRACKET !RESET REPETITION NUMBER ON CLOSE BRACKET INTEGER(TEXT+8) = NUM+1 ->GET S(')'): !CLOSE BRACKET ->GET %IF NUM = 0 %OR NUM = STOP INTEGER(CI-4) = NUM; !UPDATED REPETITION NUMBER S(','): !+COMMA CI = TEXT ->GET S('C'):!CASE SHIFT J = A(FP) J = J!!32 %IF 'A' <= J&95 <= 'Z' A(FP) = J s('l'):!left minus S('R'): !RIGHT SHIFT ->NO %IF FP = LEND A(PP)=A(FP) PP = PP+1; FP = FP+1 ->OK s('c'):!c- s('r'):!R- S('L'): !LEFT SHIFT ->NO %IF PP = LBEG %OR IN = SIN FP = FP-1; PP = PP-1 j = a(pp) j = j!!32 %if code = 'c' %and 'A' <= j&95 <= 'Z' a(fp) = j MS = 0 ->OK S('E'): !ERASE ->NO %IF FP = LEND FP = FP+1 ->OK S('e'): !ERASE BACK ->NO %IF PP = LBEG PP = PP-1 ->OK S('V'): !VERIFY I = FP-1; J = TEXT+4 V1: I = I+1; J = J-4 K = MAP(INTEGER(J)) ->V1 %IF MAP(A(I)) = K ->NO %IF K >= 0 MS = FP; ML = I ->OK S('O'):!OBSERVE S('F'): !+FIND ->NO %UNLESS MATCHED ->OK S('U'): !UNCOVER ->NO %UNLESS MATCHED; PP = PP1 ->OK S('D'): !DELETE ->NO %UNLESS MATCHED; FP = ML ->OK S('T'): !TRAVERSE ->NO %UNLESS MATCHED FP = ML I = MS %CYCLE ->OK %IF I = FP A(PP) = A(I) PP = PP+1; I = I+1 %REPEAT S('S'): !SUBSTITUTE ->NO %IF FP # MS FP = ML S('I'): !+INSERT MAKE SPACE ->NO %IF PP-LBEG+LEND-FP > 160 I = TEXT %CYCLE ->OK %IF INTEGER(I) < 0 A(PP)=INTEGER(I) PP = PP+1; I = I-4 %REPEAT S('G'): !GET (LINE FROM TT) %if gprompt = 0 %then prompt("") %else PROMPT(":") MAKE SPACE READ SYMBOL(I) %IF I = ':' %START SYM = NEXTSYMBOL SKIPSYMBOL %IF SYM = NL ->NO %FINISH LEFT STAR %WHILE I # NL %CYCLE A(PP)=I; PP = PP+1 READ SYMBOL(I) %REPEAT S('B'): !+BREAK (INSERT NEWLINE) BREAK MAKE SPACE ->OK S('P'): !PRINT PRINT LINE ->GET %IF NUM = 0 S('M'): !+MOVE RIGHT STAR ->NO %IF FP = FEND BREAK M1: REFRESH ->OK S('K'): !KILL (LINE) k0: PP = LBEG; FP = LEND K1: ->NO %IF FP = FEND ->M1 S('J'): !JOIN (DELETE NEWLINE) j0: RIGHT STAR ->NO %IF PP-LBEG > 160 ->K1 s('k'):!K- s('j'):!J- S('m'): !MOVE BACK ->NO %IF IN = SIN MAKE SPACE ->NO %IF LBEG = TOP LEND = FP-PP+LBEG-1 %CYCLE K = A(PP-1) %EXIT %IF K = NL %AND PP # LBEG FP = FP-1; PP = PP-1; A(FP)=K %REPEAT LBEG = PP; MS = 0 ->K0 %if code = 'k' ->J0 %if code = 'j' ->OK s(*):->NO %ROUTINE SWITCH INPUTS %OWNINTEGER MFP,MLEND,MEND,SFP=0,SEND=0 %string(63) file %on 9 %start printstring("*Cannot open ".file." -- ".event_message) newline %return %finish %IF IN = MIN %START %if sym = '=' %start; !redefine secondary input file = "" %cycle readsym %exit %if sym = nl file = file.tostring(sym) %repeat open input(sin, file) sfp = 0; send = 0 %finish LEFT STAR IN = SIN MFP = FP; MLEND = LEND; MEND = FEND MAINFP == MFP BOT = BOT+SEXTRA; FP = SFP; FEND = SEND READ LINE %FINISH %ELSE %START PP = LBEG IN = MIN BOT = BOT-SEXTRA; SFP = FP; SEND = FEND FP = MFP; LEND = MLEND; FEND = MEND MAINFP == FP %FINISH %END T(1): !%C, %S, %A %if type # 1 %start ->er2 %if sym # '=' %or in=sin %or code # 'S' %finish %IF CODE = 'S' %START SWITCH INPUTS ->MONITOR %FINISH !CLOSE FILE (+EOF ON COMMAND STREAM) %if null file = 0 %start SWITCH INPUTS %IF IN = SIN %CYCLE RIGHT STAR %EXIT %IF FP = FEND BREAK REFRESH %REPEAT SELECT OUTPUT(MOUT) %WHILE TOP # PP %CYCLE PRINT SYMBOL(A(TOP)); TOP = TOP+1 %REPEAT %finish %SIGNAL 0, 1 %IF CODE = 'A' select output(0) printstring(command_out1. " complete") %and newline %if null file = 0 %endofprogram H?&&C!t`} NWfSX`QKxgQKfZJ_fZX}w:`wag\`EXg\`EY}wZ}wp`q["iZ}q["op`~u@<@U~u@%qOqIfZfZKyAyAX_Lv@X_Lv"8"Z&y$ }%Qva@ complete -- *Cannot open : FAILURE: **END** SIZE TEXT FOR ()>>>!_(~ & y  g S B 3 g , n 1  % ` ` ` } =Een: fails -- Edit  w 9` ,H!3410!81!5$$A>rB@!4B"; C@!$$A>r #$$A>rB C B$P#EE&Q'1"C,XM#7PPP$ȧ@$AAA \U#?A PH&RRXZE"B"s   1#,H#8zs   @!8X5(X$C,sn@ f sN V P !# !(e",$$U nЗ$1$HHX[&B0P [,&' ?P *&30HPїCKї$$A>r Y #%$$A>r qPrPB&(pX ?$P S?PE&T 4A>r?1&034C0DD C X$$A>rwp4Py0CbXy0$`Wl',AX AAX=L AWHW,$ AAȱPPɰ#$ $A%&P,Z,XI,JŠ XPP0$PPAX0PPXHH@U#4A#XX@PXACXh@PhX@P$C8ˀ wppPylCNXyl',|A,AvAXL AWHW,yX=T0B0XdŰ=B0D$ҩ,A2XMd@ !2# Y,&QIE,Y,C,$bWx$`PmPmA<$PTX=P=XPXPMPHDPQXXmPmXPACFXP$1P=T0LQ8XPXPXPXMPHXP]PXDC qwP(pNPH0pP,NPHXpPTXTP\<P8`NPHppPlAHt$PX=PP4A*(AX]P5KP8Px#XxCf$`W`$`WlXl$0P<P<P<X'PAȭPDACXp$@IXX\PXdXh`PhhPHXT#9W#WAX80B0$XdŰ !>XPP4$PPAX4PPXH@!3CxDB0&X]tC0XhPPeAX#3CCX=d0%#3CAXdɰ`!ȻPdPHɰA#C A8XHZX sI~  XMd@=#3CXXHPV&QPX4ARXmd` !3C&X4ZlPlX840?!3C&1P84CX4Zl$PCȐM[HPXC~@PMXXHPL!4$@PM``&aPh8Zh,X8ZXh8`z ?C>$1[=P=C0XİP4ɰ#CXdPH$PL$APHPA$XX4 UsE~  Xh#4$PPX8P7Z8HP8H$PPX!3AXŐ#3CXHhPHLX]dPX4A XmdUh4!3C(` !4Pm#XhYd!#CPl'PhC` #6X8hU8L!;XHŰI#6ŰS#3C.Xh%P'Ph# XMd@-#3C,P QXHA@C*A:XhL!3CXPP&lPhLX80!3CX!3AC$XŠ!3AXPLXdP$@PHPXhHAXhLAXhPAXXd&XYXh!CXh`#3CXAXL#3CLX8dP=t`)AXh\A$aA$`ACWXhHW<XdPHC WHC:WHWXhH`W<#WH`?W<W,XdU\#4$PtXMd@ #4A("CXp$0<X\PdXdXĐPH!3CPXJPHLXZPXP&Pd%aQhPXp<3#3CXH sK|  XP#6Šx#3CCXP#CXHdXTP\!6&LPHdCvXhdXP4(!5XfPhd&lPhd,#4)!9X6@'1P8PC#3CWHXHɰa!kW<Ƞ-PHXhHW<XLC0DXHH@)C08`'W<XXLXe!W<%QL" `'W<W,$0P=\XdŰ !4XX#CX\U!=#9XM`X]ZXE!3C$`PhPA|CXLX8P&1P<CDXP#4Űx!3C4XdP@XLPdCXHZMTPX8P_PA!PZ!'Xh8` Ph8XZX88<XU!3C`j!3CVCtCXC0"X=d0=!;XTŰ#6XHŠS#3CHXHŐS!5A`j!3CVCtCXC0"X=d0=!;XTŰ#6XHŠS#3CHXHŐS!5A", {Bantam} "^Y ^x>", {VT52} "^[rrH^[2K>", {VT100} "see below", {VC404} ""(*) !%OWNSTRING(3)%ARRAY GPROM(0:3) = ":", "^A ", "^A", "^A"; !*VAX* !%OWNSTRING(1)%ARRAY GPROM(0:3) = ":", " ", "", ""; !*EMAS* %constSTRING(3)%ARRAY GPROMS(0:7) = ":", "^A ", "^A", "^M", "H? C! ,p}  NWfSX`QKxgQKfZJ_fZX}w:`wag\`EXg\`EY}wZ}wp`q["iZ}q["op`~u@<@U~u@%qOqIfZfZKyAyAX_Lv@X_Lv"8"Z%Qv#p}SId:w R# y`EX!qVM&@ e&@"e&@qI}@#!t(w@)+D File unchanged = Creating  to = Editing = Showing NULL:N:NULL:N: $ECCE.  f Failure:  Size Text for Brackets when Showing[m[1;7m$pDR;zq/~@KjfU]m {   TkJ  % 4Ipppp  _ ** File too big  **END**[;r[;r1x2:ee^A ^A ^M     >#4X=!3C^X ^I >3C^Y ^x>>3C ^[rrH^[2K> see below>see below>see below>see below>  9pH!3410!81!5$$A>rB@!4B"; C@!$$A>r #$$A>rB C B$P#EE&Q'1"C,XM#7PPP$ȧ@$AAA \U#?A PH&RRXZE"B"s   1#,H#8zs   @!8X5(X$C,sn@ f sN V P !# !(e",$$U n$A1 0# # QDRD?&A'"3$$A>r!8!5$$A>r"#&!2#C$$A>r !1#CC'1"A>r2$#PC'4"?134C0DD C gp4$,`d!*, AfPj` B2VE@$:CPZ0Ӻ,&E0JK,Һ,RZZ0 U ePjZ,&Q0E,Z,,$ATzF Wp<*,A0[B&A2DBf#>AB',A*,,AZ,&QXjjE,Z,,WHz: WpD*0A0[B&A2DBf#>A',A*0,AXZC0FeA',A',0Ab&a;FbP*@!X@A,A:0&1X,ҺC0:00WHza wp,X0!?PJ$bA0HP7,$PXi4A z Wp,X0C0PiPYYY8!XY8'QPZ!<0HP7,&Q&aAzB02`W<`YW<Xj` W<CvB0$`W<Xj` W<CJ`W<`XW<Xj` W<`W<`YW<Xj` W<C2 wp,X0C0X9Y98C!8PK$`AJCzB0 `W<`xW<CPB0 `W<`W<C(`W<`IW<$`W<z\ wp,$Q$0P9W,z gp0X0CX96#4$PA$PXI0@B0`W<`7W<Xj&aPrPW,$PA`W<`8W<`W<`MW<',AAWH`W<`8W<#`W<`LW<z gp,X0CX96#4$PA$PXI0@B0`W<`7W<Xj&aPrPW,$PA`HPg,$PXi4A`W<`DW<',AAWH`W<`8W<#`W<`MW<z| gp0X0 #.X!;` W<$1P9XU!5XPUB00XIB0WHXYZY[YPY$aPiC>kAP,$1Q9 !3C XY8#lW<$AQICxXZP#3AbXj`#3A zm wp'aA #6%1Q9CX0#XY[YXj,A# XI[ITXj,A$QPZ8XiUix!6XU#:$PPZ8$cAT$1Q:,X,U!3C\XICXXY0CPPJ4XiYmP#+XmPA"%QQ,#XiA$1Q:4X4#3CXj,A$AQIXY#2" XiUiC0,XY!Y!U!%AQIXYUY!5XYPYUY#[P,C "XI LYI!C`XYPW,XYlAXj,QiX|PX9Y9#P9XxPXiPj,XIUI#5XiPj,S V#zWH$ AȀ wp4XUC0lAP10 C0XiAkAA@ #6$QQYC`PiPz^ gp,`a!fW<-PXjW<z wp0Pz,#Xz,X`#8PX$P`CXX9tC0*ZKPIX&1P9t@ #4z8P9tCW PXXY<#: !aW<CD wp,$P2&1BC2z wp8X|'P,X9L'1P:0$Q,Q0Xj,AXAPJ4@a!@z!%TIdPJ4XYZZ0eF!3CXZ0<3#5$zX|PXJ, KPI$" I WpTNDPIpP N4PIpP N$PIpxP $PPcAӱŰ #6$QC$@PIpXYXe PiX$PX9P9PIPIPI$PPIB?PXI4'DPI'APIPIPPY`PicPX90#ҢKҲW$@PI`XYXPY\P B0NXi0B02$PTX=T!6XXU!;3#+X\XZ|#3A CAX[ZPXY|[YxjA^XI0C t@B0`W<`W<#`^W<P PY\Xi|UixC0(Ui#9'aA<P\# Xi'aA(1P9\Cj WHȰ P\Ƞ|PXXI|UIC0$dAQP #;Xi|AaPi\PiXXiXW<(WHW,# A>XX #3P`$0P9@P9DP94P9AXXA#Cz_PHAX=pZ9Hӳİ sKx  $PlXY0C &A`=W<XiXW<$aPiXiA>10 #5$Q" %QTXIT!3C~XYH UsE  $aPiTXT!#C\$1Q9@X@ZӫŠ\!3C>XI@CZITP?!3C&Xi@cZi]C0HX9@3Z9ӳŰ^!3CX@ZJ@[!:XY@SZYePi@$Q@CX9@3Z9XPTX@Y<#CB!#CXi&aP(AWHXiHAxXILC0N`'W<XYZYLefC0 XZLlW<$1Q9LC`'W<X0#4A#W,ACXXLZXITPJC%QQYTXiTC0`#=X@ZPlX9LP9@#X@YXHŰM!9XiPi|XPPixCXIxUI#4XYp#3CARAP$`PiXTB0(X9P9xU9!5X9P9xP9|$PPTC4XxU!:XIUI!3ClPIx%QQYX9x'1P9%QxXxU#?U#A@ #3CXYxPY|CXi|Ui!3CA_AB:ZB 2AXiAXi|PPA1XP0 ;$QQXI|UI!3C&API|CXY|UYx#4Xip#3CUY!3A$$P%1Q9|CVX|U!3CpAr$QxQ|XI|PIC.XY|UYx!3CHAJ$aQix%QX9Y9#P9CX|U!3CkAXZLAZETId#3CAn!3CCLXi|PiL# X|PLU!4&P|X9@3Z9HPPXZLJPI\XY|UYC0Xi|Aa` C0,Xi|AW\Td!7A#3C$1Q9|CX|P%QPXIP!3CJXYHPUC0&A$aQi|X|U!5XP|PxQi#X9LP9|APX|PLCRX|PXLP|CXIH@D!=AXYQYxQY|Xi|PiXHT!5X9Q9|UB0,X|[LP@XLP|AXI@QIxQI|XY|PYC(Xi@cZiHPPAAX9|U9x#;'1P9|A#3C"%QPXP#4U9!3C*U9!:XIUI!3CPI|XY|PYx'QPY|PYQ%aQixXxU#?U#CXUx!7s@,  AjX[xYhB XI&API|UI!;XIPI|[IZIxPIxXY|PYXiUi#` aXY!X'P$1Q9%QC:AXxZh&P|%AQI|XY|UYx!3CeAa` #3CA$Q|X9|P9CbXU!3C[|Xh P@YT#PTXI|[Ix[TP@!3CAXY@C$XiAp` a$Q%1Q9xQ@C@X|Ux#;Xi'aA@ӡŠ #3C(%AQI$QQYxXiYi#PiQI@X@#3CChAC` wpP@.r ,q ,s9BP9@r ,q ,ȹ2PL;$"Ab$ATy+ wp4$&P00 r <q r <q r <q htA Xh#6$ A',AtAWHCPX;0!!5dPhtAX#6$ AӨ#=hAX#6$ AXHPHXXPXhtfC0H',AtAWHXp!?WHWHC"',AAWHW,8P7,p`Ap`P0ȰP4ȠPP8XhtAXpC04XH B0,WHW,$PPXWXhC0X[P`X8P7,XXlAX`Q(2Ar,q,$cW$cWlX'PX'P`C&P`iA8aW<X`UB0W$aW@W#Wxgram is limited and even if a school invests in a printer for it, the cost of paper needed for this will be extremely high. $p If, as is likely in the near future, exams are introduced at other grades the problems are going to be exacerbated and serious thought will have to be given to providing adequate computer power in the school at reasonable cost. $a indent=0 $p 4. %Use %as %a %Teaching %Aid. $a indent=1 $p Most of the packages at present available and most being developed are teaching aids in the various subject disciplines. Unfortunately, a large number of these require a one to one situation and are therefore unsuitable in the present situation. Others, which are suitable for classroom presentation, simulate a situation which can be demonstrated better by other means. Too often, we find packages being produced for the wrong educational reason. They are produced because they are easy to do. The question which the teacher of every subject discipli $(,$$0**400866<<<@BBDHHHNNLTTPZZT``Xff\ll`rrdxxh~~lptx|Tt||lFailure: ingbig XZ,PPT 4 schools throughout the country with the first exam in 1984. There is, however, no commitment to extend the exam to all schools after that date. No doubt this will eventually happen but as mentioned earlier the drawback is going to be lack of reasonable equipment. The syllabus is still in the process of being finalised and is being kept a closely guarded secret. From what has been divulged the exam will be like the CSYS Maths IV paper in that part of it will be project work. Whether fourth year pupils are mature enough to cope with this is a debatable point. There will be a large measure of appreciation and package running in the course as well as programming. $p In the realms of appreciation courses, a seminar was held in Glasgow at the beginning of March under the auspices of the Project Steering Committee of the Microelectronics, Computing and the Curriculum (MCC) Project set up by the Consultative Committee on the Curriculum. This seminar produced plans for a general appreciation course for %all pupils, to be taught either during year 1 or 2. It was realised that materials had to be produced and a proposal has been submitted to the CCC that at least two teachers be seconded to produce the materials and that backup support for programming should be provided. It is hoped to have this material ready for session 1983-84. $a indent=0 $p %Maintenance. $a indent=1 $p The problem of breakdown of machinery is one which can cause problems for the teacher. This is bound to happen with the amount of hard use to which the computers are subjected. So far, schools have found that a machine may be out of action for some considerable time. Since schools cannot have extra computer power to cover this eventuality, some consideration will have to be made at Regional level to the desirability of employing technicians who can deal with the schools problems immediately. $e H?((!Virtual memory support for visual ECCE !A.D. Culloch. March 1981 !Large byte address space mapped over a large !temporary DA file. %const %integer CR = 13 %const %integer maxname=127; !max file name length %recordformat file(%string(maxname) name, %integer chan, %integer top,lim,vmtop,vmlim,flag) %include "Sysinc:Command.INC" %include "sysinc:DA.inc" %own %integer maxVM = 400 {blocks} %ownintegerarray bitmap(0:50) = 0(*) %routine set bit (%integer index) %integer j = index>>5, k = index&31 bitmap(j) = bitmap(j) ! 1<>5, k=index&31 %true %if bitmap(j) & 1<>5, k = index&31 bitmap(j) = bitmap(j) & (\(1<0) %string(4) %function Unique Extension %record(parm fm) P P_dact = 25; SVC (20,P); !Director call for unique ext P_p4 = P_p4&x'FFFF' SVC (18,P); !Unpack filename -> ".EXT" %result = string(addr(P_sact)) %end %external %byte %map byte integer (%integer index);!into notional VM in DA file %integer block = index>>9, offset = index&511, chan %record(buffm)%name prev, p p == buf_link; !hd of circ. list %cycle; !id BLOCK in buffer chain? %if p_from <= index <= p_to %start !promote this buffer to hd of list !(most recently used) %if p == buf %start; !tl becomes hd buf == prev %else %if p ## buf_link; !already hd? prev_link == p_link p_link == buf_link buf_link == p %finish %result == p_blk_B(offset) %finish %exit %if p == buf prev == p p == p_link %repeat !block not in store.. replace last page in list %if buf_block >= 0 %and buf_chan # sec chan %start write DA (paging file, buf_block, buf_blk) %finish !promote last buffer buf == prev chan = paging file %if %not bit set (block-1) %start; !not in paging file - which chan? chan = chan + 1 %until chan={last}connected %or index < base(chan+1) %finish p_from = 512*block p_to = p_from + 512 - 1 p_chan = chan read DA (chan,(p_from - base(chan))>>9,p_blk) p_block = block - 1 {offset for initial free VM=512} set bit (p_block); !used %result == p_blk_B(offset) %end %external %routine connect input (%record(file)%name f) %own %integer first {call} = 1 {nonzero: true} %integer j,k, size %const %integer to Director = 20, pack filename = 17, get status = 18; !magic nos for svcs %recordformat parmfm ( %c %short dsno,dact, %short ssno, sact, %integer p1,p2,p3,p4,p5,p6 %or %integer frig, %short ssno2,sact2,%string(23) text %or %integer frig2,%short ssno3,%string(25) fname) %record(parm fm) Q %if f_top # 0 %start; !previous secondary input file %for j = 1,1,buffers %cycle; !free any buffers in use buffer(j)_to = -1 %if buffer(j)_from >= f_top %repeat close DA (f_chan) connected = connected - 1 %finish !get size of file (blocks) from Director %if f_name = "" %then size = 0 %else %start Q_fname = f_name SVC (pack filename,Q) Q_text = "illegal filename" %and ->fail %if Q_p1 < 0 %or Q_p2 < 0 Q_dact = get status SVC (to Director,Q) %if Q_p6 # 0 %start fail: print symbol (CR); print symbol (NL); !cr/lf print string ("*Edit " . f_name . " fails -- " . Q_text) %stop %finish size = Q_p2; !blocks %finish %record(buffm) %name p %if first # 0 %start first = 0 %for j = 1,1,buffers %cycle p == buffer(j) p_from = 0; p_to = -1; p_chan = -1; p_block = -1 %if j = buffers %then p_link == buffer(1) %c %else p_link == buffer(j+1) p_blk_B(k) = '@' %for k = 0,1,511; !warning of problems %repeat page file name = "$ECCE" . unique extension create file (page file name, max VM, max VM) Write(Max VM, 1); Printstring(" blocks created"); Newline open DA (paging file, read write, page file name) %finish f_flag = -1 %and %return %if size < 0 connected = connected + 1 f_chan = connected open DA (f_chan,read only,f_name) %if f_name # "" %monitor %if f_chan > max con base(f_chan) = free VM; f_top = free VM f_lim = free VM + 512*size free VM = free VM + 512*(size + f_flag) %if f_flag # 0 %start; !mark extra pages as 'in file' set bit (j-1) %for j = f_top>>9 + size, 1, free VM>>9 - 1 %finish f_flag = 0 f_VM top = f_top; f_VM lim = free VM - 1; !VAX f_lim = f_lim - 1 %while f_lim # f_top %and byte integer (f_lim-1) # NL %end %external %routine move (%integer length, from, to) %return %if from = to %if to <= from %start %while length > 0 %cycle byte integer (to) = byte integer (from) from = from + 1 to = to + 1 length = length - 1 %repeat %else from = from + length; !move from back to front to = to + length %while length > 0 %cycle from = from - 1 to = to - 1 byte integer (to) = byte integer (from) length = length - 1 %repeat %finish %end %external %routine close off %external %record(file) %spec in, out, sec %integer flim = out_lim, size %record(buffm)%name this %integer k %integer j = flim - out_top; !out size %const %integer eot = 4 ! Dump last couple of blocks on the console ! k = flim - 1024; k = 512 %if k < 512 ! %while k # flim %cycle ! print symbol (byteinteger(k)) ! k = k + 1 ! %repeat %while j&511 # 0 %cycle; !fill last block j = j + 1 byte integer (flim) = EOT flim = flim + 1 %repeat size = j>>9 {blocks} !fill paging file %for j = 512,512,512*size %cycle %unless bit set (j>>9-1) %start; !block not used yet k = byte integer (j); !access it %finish %repeat %for j = 1,1,buffers %cycle; !flush buffers this == buffer(j) write DA (paging file,this_block,this_blk) %if this_block >= 0 %repeat extend DA (paging file,size - max VM,size); !truncate close DA (j) %for j = 1,1,max con delete file (out_name) %if out_name # "" %and exists (out_name) rename file (page file name,out_name) write (size,0); print string (" block") print symbol ('s') %if size # 1; print symbol (':'); space %end %end %of %file H?%externalroutine Help(%string(28) Wanted) %recordformat hfm(%string(31-9) Key, %byte Flag, %integer start, finish) %externalroutinespec To Upper(%string(*)%name S) %externalroutinespec open da(%integer chan, rw, %string(25) file) %externalroutinespec read da(%integer chan, block, %name to) %externalroutinespec close da(%integer chan) %routinespec Copy(%integer from, to) %routinespec find topic(%integername start, finish) %routinespec show all %integer start, finish, l, control %byteintegerarray b(0:511) %string(28) Topic, Topics Open Da(1, 0, "Help:Help.dat") control = 0 %if wanted # "" %start control = Charno(wanted, length(wanted)) %if control = '!' %start length(wanted) = length(wanted)-1 %else control = 0 %finish %finish %if wanted = "?" %start show all %return %finish Topic = wanted To Upper(Topic) find topic(start, finish) %if start # 0 %start copy(start, finish) %else printstring("No information about ".wanted); newline printstring("Help ? will give a list of the topics available") New Line %finish %return %record(hfm)%map R(%integer n) %owninteger previous = -1 %integer block, byte n = n*32 block = n>>9 read da(1, block, b(0)) %unless previous = block previous = block byte = n&511 %result == record(addr(b(byte))) %end %routine show all %integer j,n %record(hfm)%name H %routine Add(%string(31) s) %owninteger n = 3 %owninteger pending = 0 %return %if s = "" spaces(pending); pending = 0 printstring(S) n = n-1 n = 0 %if length(s) >= 22 %if n <= 0 %start newline n = 3 %else pending = 24-length(s) %finish %end printstring("Help is available on the following topics:"); newline n = R(0)_Finish %for j = 1,1,n %cycle h == r(J) add(H_key) %if H_Flag = '+' %repeat newline %end %routine find topic(%integername start, finish) %integer High, Low, P %record(hfm)%name H low = 1; high = r(0)_finish %while low <= high %cycle p = (low+high)>>1 H == R(P) %if H_Key = Topic %start start = H_Start; Finish = H_finish %return %finish %if H_Key > Topic %then High = p-1 %else Low = P+1 %repeat start = 0; finish = 0 %end %routine copy(%integer from, to) %integer last = nl, sym %integer quiet = 0 %integer n, byte, block, next block, next byte Block = from>>9 Byte = from&511 Next Block = to>>9 Next Byte = to&511 n = (next block-block)*512-byte+next byte quiet = 1 %if control = '!' %cycle read da(1, block, b(0)) %cycle sym = b(byte) %if last = nl %and sym = '?' %start {more detailed info} %return %if control # '!' quiet = 0 %else printsymbol(sym) %if quiet = 0 %finish last = sym byte = byte+1 n = n-1 %repeat %until byte = 512 %or n = 0 %exit %if n = 0 block = block+1 byte = 0 %repeat %end %end %begin %include "Sysinc:command.inc" Help(Command_Parameter) %endofprogram H?@?@-c/-c/://:?ANYTHINGiBELwE_KTAPE DUMPS These describe the available archiver commands separately, but in fact sequences of commands (e.g. to dump several discs then generate a listing) are commonly entered. The Archive program prompts "Archive: " when it wants a command. Reply with EXIT to return to MOUSES command level. +Archive_Initialise &Archive_initialize To create an empty archive tape, mount a scratch tape in the drive with a write ring fitted. Enter the command: Command: ARCHIVE! In reply to the "Archive:" prompt, enter: Archive: initialise ...text... The text following "INITIALISE" is recorded in the tape label and appears on listings of the contents of the tape. (See HELP ARCHIVE_ANALYSE). At this point, either reply EXIT to the "Archive:" prompt to return to command level, or enter another archiver command. +Archive_analyse A listing of the contents of an archive tape can be produced by the following sequence of commands: Command: archive / listing-file Archive version 1.5 Program announces itself Archive: analyse Archive: exit When the EXIT command is entered, the 'listing-file' is closed and control returns to command level. The 'listing-file' may be any file or device, e.g. Command: archive /$temp Command: Archive /LP: Command: ARCHIVE/LP:LISTING +Archive_Dump The archiver command: DUMP UNIT disc is used to dump all the files on the named disc unit to the mounted archive tape. To dump only the files belonging to a single user, use the command: DUMP USER who As each file is archived, a message line is written on the operator's console of the form: <- filename Reply "EXIT" to the "Archive:" prompt to return to MOUSES command level. Examples: Archive: dump unit sys Archive: DUMP USER User_Fred Archive: Dump user Alan Archive: Dump unit PAK4 +Archive_Restore_User The archiver command: RESTORE USER who causes the mounted archive tape to be searched for any files belinging to the specified user. They are reloaded onto the disc. Where they are put depends on how the archiver was started. By default, the files are loaded into the directory currently being used by the operator, so to reload FRED's files, do: Command: Be Fred {switch to right directory} Fred: Archive Archive version 1.5 Archive: restore user fred Archive: exit Fred: Be {Become OPER again} +Archive_Restore_Unit The archiver command: RESTORE UNIT disc causes the program to read through an entire archive tape, reloading any files which were originally dumped from the named 'disc'. Users will automatically be created on the disc to read the files into. For example the disc PAK5 could be restored to the state it was in when last dumped by mounting the dump tape, re-initialising PAK5 (see Help Disc_initialise) then entering :- Command: Archive Archive version 1.5 Archive: restore unit pak5 Archive: exit +Archive_Restore Files can be retored to disc from an archive tape either singly, or grouped per user or per disc unit. See one of: o Help Archive_restore_file o Help Archive_restore_user o Help Archive_restore_unit +Archive_restore_file To restore the latest version of a file from an archive tape, use: Command:archive Archive:restore file user:filename e.g. Archive:restore file pak5_fred:program.imp If you have an analysis (see Help Archive_analyse) of the tape, the version of the file as it was when dumped on a particular date at a particular time may be restored. First find the serial number of the required version from the analyse listing, then: Command: Archive Archive: Restore #nnn Where 'nnn' is the sequence number of the file. +Utilities &utility programs Information about several system utilities is available. See: Help Disc - The disc backup/copy utility. Help Archive - The magnetic tape disc backup utility Help Tapes - Utilities to process tapes (including IBM tapes) +Disc &Disc utility &Disc checks &Disc checking &Disc copying &Disc compression &compressing discs ©ing discs The disc utility supports the following operations. o Initialise 'raw' discs with an empty file system. o Perform self-consistency checks on the directories on a disc. o Copying one disc straight onto another. o Copy a disc, compressing the free space on the disc into a single area. (May have to deal with corrupt input discs). o Compare the contents of two discs. (Verify copy). See: Help Disc_initialise Help Disc_Test Help Disc_copy Help Disc_compress Help Disc_Compare +Disc_test Checking of a disc is initiated by the command: Command: disc(test) Program prompts for disc to test Or:- Command: disc(test) xx Disc to test specified in command line 'xx' is the disc unit to be tested: either a unit number '#n' or the name of a loaded disc. (See Help Disc units). Any errors detected are logged on the console. More logging output is produced if a question mark '?' is appended to the command line. The enquiry facility (see Help ENQ) may be used to discover the directory currently under test. Examples: Command: disc(test) Program prompts for disc to test. Command: disc(test) #1 Test disc on unit one. Command: disc(test) Sys Test disc with logical name "SYS". +Disc_Initialise &Disc_initialize The command: Disc(initialise) / xxxx is used to start initialisation of the disc 'xxxx', which may be specified either as the logical name of a loaded disc or as a unit number '#n' (see under Help Disc units). The program prompts for certain parameter values. Sample dialogue: Command: disc(initialise) /#1 {init disc on unit one} Are you sure you want to overwrite OLD? Yes/no? yes {reply NO to abort program} Phy. disc name: NEW {any four letters/digits} Log. disc name: NEW {Logical name as used in LOAD etc} System area? yes {reserve an area for a system image?} Disc type: Diablo {or HELP/MSM80/CALCOMP/TELEFILE} Description: any text supplied by the operator ***WIPING NEW Blocks: 9600 No errors The valid replies to "Disc type:" are: DIABLO 10MB cartridge disc MSM80 P-E 67MB drive TELEFILE 300MB drive CALCOMP 67MB drive with TDC controller UNKNOWN Specify no. of tracks, blocks per cylinder and heads by hand. If the command line "Disc(initialise)" on its own is given, the program will prompt "Output disc?" for the name of a unit to initialise. +Disc_Copy The command: Disc(copy) xxxx / yyyy will cause the program to copy the contents of disc 'xxxx' block by block over the contents of disc 'yyyy'. No interpretation is placed on the blocks, i.e. non-MOUSES discs may be copied. The disc identifiers 'xxxx' and 'yyyy' are either logical disc names or disc unit numbers (see Help Disc units). Either may be omitted, in which case the program prompts for "Input disc?" or "Output disc?".After the program starts it will prompt the operator for the type of disc to be copied. (Answer DIABLO for cartridge discs, MSM80 for P-E 67MB drives, CALCOMP for TDC 67MB drives or TELEFILE for 300MB drives). Examples: Command: Disc(copy) Sys/#3 DISC COPY V2.0 Disc type: Diablo Command: disc(copy) /#4 DISC COPY V2.0 Input disc? #3 Disc type: MSM80 Command: DISC(copy) Fred/Jim DISC COPY V2.0 Disc type: telefile +Disc_Compare &Disc_Verify &verify &disc verify To discover whether two discs are identical, use the command: DISC(COMPARE) xxxx, yyyy 'xxxx' and 'yyyy' are logical disc names or disc unit numbers '#n', see Help Disc units. Either may be omitted, in which case the program prompts for "Input disc?" and "Output disc?". The program will prompt "Disc type:" to find out how many blocks are to be compared. Reply DIABLO for cartridge discs, MSM80 for Perkin-Elmer 67MB drives, CALCOMP for TDC 67MB drives or TELEFILE for 300MB drives. Examples: Command: disc(compare) #1, #2 Command: DISC(COMPARE) SYS0, SYS1 +Disc_Compress &Disc_squeeze The command: DISC(COMPRESS) xxxx / yyyy will copy all user directories and files from disc 'xxxx' to disc 'yyyy'. 'xxxx' and 'yyyy' may be either the logical names of two loaded discs or disc unit numbers '#n' (see Help Disc units). Either may be omitted, in which case the prompts "Input disc?" or "Output disc?" will be output. A listing of the contents of the generated output disc can be produced: DISC(COMPRESS) xxxx / yyyy, listing-file If the file system on the input disc is not self-consistent, the program stops with the message: ***FAULTY INPUT DISC If it is necessary to attempt to 'rescue' a corrupt disc, append an exclamation mark "!" to the command line, and the program will attempt to copy any good data remaining on the faulty disc: DISC(COMPRESS) xxxx / yyyy, listing ! (The ", listing" part is optional). The operation of the program can be inspected using the ENQ facility (see Help ENQ). Examples: Command: disc(compress) {Prompts for disc names} Command: disc(compress) user/arch Command: Disc(compress) DEAD / #5, LP:listing ! Command: disc(compress) user/back, List +Ctrl+D &EOT &end of file &end of input The end of file condition can be signalled to a program reading from a terminal by striking the Ctrl+D (EOT) key. This is echoed by the system as "[]". +Ctrl+H &Backspace &rubout &DEL &erase DEL and Ctrl+H (backspace) have identical effects. The last character on the current input line is erased. Pressing DEL 'n' times erases the last 'n' characters from the current line. This is obvious on a VDU. On hardcopy devices the characters cannot be physically rubbed out, so the group of characters being erased are echoed on the terminal (backwards as they are deleted), enclosed between a pair of backslash "\" characters. +Can &Ctrl+X This character causes the whole of the current line to be erased. On fast VDU terminals, the line is visibly erased. On slower hardcopy terminals, a '#' is printed, a carriage return/line feed sequence is output and the command prompt is reissued. (See also: Set_erase) +CR &return &newline Striking the CR (carriage return, RET) key causes the current line to be entered and processed by the system. A carriage-return/linefeed is output to put the cursor at the start of the next line. An IMP program reading from the console will read this as a single NEWLINE (LF) character, Pascal and FORTRAN programs see 'end of record' (EOLN). +LF &linefeed &Ctrl+Q &DC1 Linefeed and Ctrl+Q have identical properties. Output to the terminal is re-initiated after being suspended for one of the following reasons: o End of page on VDU. See: Help Set_Page o Output suspended manually by user pressing Ctrl+S. See: Help Ctrl+S o Output being discarded. See: Help Ctrl+T +Ctrl+S &DC3 &hold output Striking the Ctrl+S key causes output to the terminal to be immediately paused. (Output is resumed by pressing linefeed, LF, or Ctrl+Q). +Ctrl+R &DC2 &retype The current line being input by the user is retyped by the system. This is most useful on hardcopy terminals where a proliferation of '\' characters echoed by DEL can obscure the meaning of the line. +Ctrl+T &DC4 This character causes the system to start THROWING AWAY terminal output. Output is resumed either by pressing Ctrl+Q or Linefeed (LF), or when the running program stops to ask for input from the console. +Ctrl+I &TAB &tabulation &tabs The system provides a 'tab stop' facility for user console input. By default pressing TAB (i.e. Ctrl+I) is equivalent to entering three space characters. The user may alternatively set tab stops at particular columns, see: Help Set_Tabs Help Set_Tab +Ctrl+E &ENQ Pressing ENQ (Ctrl+I) causes the system to display a short message indicating the operation that is currently being performed in the form: ***System: text By default, "text" is the name of the program currently running or null if the system is waiting for a command. User programs and utilities (e.g. the IMP-77 compiler, the DISC utility etc) may set this string to indicate the operation currently being performed. E.g. the compiler indicates which pass it is performing. There is no restriction on when ENQ may be used, during console output, while the system is waiting for input or while there is no console activity. +Ctrl+U &NAK The current line is erased as for CAN (Ctrl+X). Additionally any lines which have been typed ahead by the user and have not yet been processed by the system are discarded. NAK (Ctrl+U) echoes as '#', CR, LF. +Ctrl+O &SI The console is shifted into the normal (default) mode, where upper and lower case letters are distinct. (Although all system programs treat upper and lower case identically). See also: Help SO +Ctrl+N &SO The console is shifted out of normal mode. Henceforth, all lower case letters typed will be echoed as the corresponding upper case character and any program reading from the terminal will see the upper case character. This effect may be cancelled by striking the SI (Ctrl+O) key to shift back into normal mode. +Ctrl+P &DLE &Binary input To allow the input of any ASCII character to a program reading from the console it must be possible to disable the standard interpretation of characters like ESC and TAB. Any character may be entered in thsi way by prefixing it with DLE (Ctrl+P). Examples: - to enter the ESC character - to enter two consecutive DLE chars. F - to enter 'F' BEL. (The before the 'F' is redundant since 'F' has no special significance. - EOT normally causes end-of-file. +Operator commands &ops The operator has access to several privileged commands: Catalog - List usernames on a particular disc. State - Gives status of system/discs/spoolers. Broadcast - Send a short message text to all terminals. Close - Prevent users from logging in. Shutdown - Automatically close after broadcasting warnings. Open - Stop any pending shutdown, and allow user logins. Dateis - Set the date and time counters used by the system. Protect - Set software protection on a disc unit. Hazard - Reset software protection on a disc unit. Load - Make a disc unit available to users. Unload - Used before putting a disc offline. Pass - Set a global system password. Reprime - All spooled files are revoked. Restart - Reboot the system. Type: Help 'command' for further information, e.g. Help broadcast See also: Help utilites Help disc units +Catalog The command: CATALOG disc will generate a listing of the names of all users whose directories reside on the specified disc. 'Disc' is either the name of a logical disc unit, or a disc unit number "#n" in which case the analysis is of the disc mounted on unit "n". (See also: Help disc units). Examples: Command: catalog sys what users are on the system disc? Command: catalog #1 Who is on the disc mounted on unit 1? +Disc units &discs MOUSES accesses discs internally by 'logical disc unit number'. More than one logical disc may be mapped onto a single physical disc unit. (E.g. a 67MB drive is normally partitioned into three logical discs). Usually, the operator will refer to discs by name, but it is possible with most commands to quote the unit number instead in the form "#n". The correspondance between the numbers and real disc drives varies from system to system. For example: #1: Cartridge disc C6: #5: 67MB drive, first partition. #2: " " C7: #6: " " second " #3: " " D6: #7: " " third " #4: " " D7: +State &Status This command has several forms: Command: state - This form produces information about the user who runs it (e.g. amount of CPU time used, username etc). Command: state system - This displays information about all active users. Command: state discs - This lists the names of the online discs. Command: state discs! - As above with extra information - free blocks etc. Command: state discs? - As for STATE DISCS, with disc description displayed. Command: state queues - Display a list of all spooled files. +Broadcast The command: BROADCAST text causes the message "text" to be displayed on all terminals in the form: ***OPER: text Text longer than 23 characters will be truncated on the right. +Close The command: CLOSE will prevent users other than OPER logging in to the system. Attempts to do so will produce the "No user service" message. See also: Help open Help shutdown +Open The command: OPEN allows users other than the operator to log in to the system. The system is normally opened automatically as part of the startup sequence. It should therefore only be necessary to use the OPEN command: o After an explicit CLOSE o If the normal startup sequence has been bypassed by logging in as OPER in the interval between system startup and the message "OPER starts" appearing on the system log. OPEN also cancels the effect of any pending SHUTDOWN command. See also: Help close Help shutdown +Shutdown &Shut &Closedown The command: SHUTDOWN nn causes an orderly shutdown of the system in 'nn' minutes. A warning message is sent to all terminals when the command is entered, and after successively shorter intervals before the deadline. The messages are of the form: ***OPER: Close in nn minutes When the deadline is reached, processing of the spooler queues is halted and a final warning is issued: ***OPER: Closing down NOW!! After a further minute of grace all logged on users except OPER are forcibly logged off. +Protect &write protect &prot When the system starts up, all discs whose logical names start with "SYS" and all hardware-protected discs are automatically software-protected. To software write-protect a disc manually, use the command: PROTECT disc 'Disc' is either the logical name of the disc (e.g. Sys, User) or a unit number '#n' (see Help disc units). After execution of the command, users may no longer create or alter files on the disc in question. The disc need not be hardware protected. Note that if a disc is hardware protected but is NOT software protected then attempts to write to the disc cannot be detected at the user level, but will be reported on the logging device as disc errors. (The attempted write will be retried until either the disc is made unprotected again or the fifteenth retry fails, in which case the attemped operation is abandoned). Disc protection can be reset using the HAZARD command. Examples: Command: Protect SYS Command: protect #1 The protection status of the discs can be displayed with the STATE DISCS command. See also: Help state Help Hazard +Hazard &unprotect &deprotect To remove any software write-protection on a disc, use the command: HAZARD disc 'Disc' is either the logical name of a disc, or a disc unit number '#n'. Hazarding a hardware-protected disc is not advised, since any user who then attempts to write to the disc will not be trapped until the lowest level of the system is reached, where the attempted write will be rejected by the hardware, resulting in a series of up to fifteen retries before it fails). The PROTECT command is used to set software protection. Examples: Command: hazard sys Command: hazard #5 The current protection status of the discs may be inspected by the STATE DISCS command. See also: Help state Help protect +Load &mark on &mark Not all discs physically online to the system are available to users. To make a disc available, the operator must LOAD it. This is done automatically at system startup for all discs online at the time. Discs can be made inaccessible by UNLOADing them (see 'help unload'). The form of command is: LOAD disc 'Disc' is either the logical name of the disc to be loaded or a unit number of the form '#n'. The system will report the fact that the disc has been loaded on the logging device. If the name of the disc begins with "SYS", or the disc device is hardware protected, the loaded disc will automatically be software protected. The command STATE DISCS (see "help state") will display a list of the discs which are currently loaded. Examples: Command: load pak2 Command: load #1 +Unload &Mark off To make a disc which is currently online inaccessible to user processes, use the command: UNLOAD disc where 'disc' is either the logical name of the disc to be unloaded or a disc unit number '#n'. (See "help disc units"). The command STATE DISCS (see "help state") will display a list of the discs which are currently loaded. Examples: Command: unload arch Command: unload #5 +Pass The command: PASS ... allows the operator to set a global system password. The text string "..." should be from one to six letters or digits. After execution of this command a user may log in to ANY user's account by quoting either its the correct password, or the global password. A user may also log in when the system is closed (see 'help close') by quoting the system password. If the command PASS is entered on its own (with no "..." part) the global password is removed. Examples: Command: pass twit Command: pass xyz123 Command: pass {revoke global password} Note: For security reasons this command should be used infrequently and with caution. +Reprime The command: REPRIME causes all files spooled to any queue (e.g. LP:, PP:, BATCH:) to be deleted. The spoolers are reinitialised. It should not normally be necessary to use this command unless the queues become corrupt. +Restart &Reboot &rebooting &boot &bootstrap &booting &reloading The system can by booted either from the front panel with the 50-sequence loader and the MOUSES bootstrap papertape/magtape or while the system is running (e.g. to test new versions of the system). To boot from disc 'xx' from a running system, use the command: RESTART xx (See also: Help disc units). Examples: RESTART #1 Restart SYS The system will go into an loop waiting for a valid system disc to be put online on the nominated disc. (See: Help 50-sequence for details of front panel booting) +50-Sequence &50 sequence To boot from the high speed paper tape reader or the magnetic tape unit, set up the store locations using the front panel, then run from location X'50' after clearing the PSW (press DTA ADR FN SEL on the front panel). Address Contents (both hexadecimal) 50 D500 52 CF 54 4300 56 80 78 1399 {To boot from the high speed paper tape reader} 78 85A1 {To boot from the default magnetic tape drive} 7A dd00 {'dd' is the cartridge disc address, e.g. C6} 7C ccss {'cc': disc controller address, normally B6 {'ss': SELCH address, normally F0 7E 0 +Dateis &set date &time &date The current date and time (as displayed by the STATE program, see: Help state) are set using the operator command: DATEIS date 'Date' is of the form: dd-mmm-yy e.g. 15-Sep-81 Or DATEIS date time 'Time' has the form: hh:mm e.g. 13:10 (ten past one PM) or: hh:mm:ss e.g. 10:11:30 Examples: Command: dateis 25-Dec-81 Command: DateIs 13-Jun-79 11:30 Command: Dateis 13-Jul-80 12:00:02 +COMMANDS &Command &Command format &format The general form of a command line is:- CommandVerb {command parameter} {stream definition} If no stream definition is required the rest of the command line may be used to specify the parameter by using the form: CommandVerb-{command parameter} Examples: E file1/file2 COPY file2/LP:file SET TIME=10 SET-stack=32,password=FRED The way in which the command line is interpreted may be controled by options set in the object file corresponding to the command. See also: Help Streams Help Option Help ? Help Stream Definition Help Command parameter +Creating files &Create &Creation &new files Files are created automatically when they are specified as outputs for programs. Commonly files are created using either the COPY program or the editor. See also: Help Copy Help Files Help Edit Help Filenames +EDIT &Editing &Editing files &E &ECCE The Edinburgh Compatible Context Editor, ECCE, is called using a command of the general form: E input,input2/output where: input: is the primary or only input stream (default N:). input2: is an optional secondary input (defaults to input). output: the file for the edited output (defaults to input). E.g. e fred modify existing file called fred e fred/jim modify fred - output into jim e /fred create a new file fred e tom,dick/harry produce harry from pieces of tom & dick e fred/n: examine FRED without being able to modify it. For full information on ECCE see separate documentation. Help about individual Ecce commands may be obtained by typing: Help E_command-letter e.g. Help E_M Ecce commands are: B C C- D E E- F G I J K L M M- P R S T U V X Y Z %C %F %L %M %N %Q %S %U %X %Y %Z , * 0 ? () \ +E_B Editor command BREAK: B breaks the current line at the file pointer. +E_C Editor command CASE SHIFT: C Moves right and inverts the case of letters. +E_C- Editor command CASE SHIFT BACK: C- Moves left and inverts the case of letters. +E_D Editor command DELETE: D/text/ deletes the next occurrance of text on the current line. +E_E Editor command ERASE: E erases the character to the right of the pointer. +E_E- Editor command ERASE BACK: E- erases the character to the left of the pointer. +E_F Editor command FIND: F/text/ locates the next occurrance of text. +E_G Editor command GET: G inserts the next complete line typed at the console in front of the current line. G* to input multiple lines terminated by a colon. Failure Condition: The line starts with a colon (:). +E_I Editor command INSERT: I/text/ inserts the text to the left of the pointer. +E_J Editor command JOIN: J joins the next line onto the end of the current line. +E_K Editor command KILL: K deletes the current line. +E_L Editor command LEFT SHIFT: L moves the pointer left one character. +E_M Editor command MOVE: M moves the pointer is moved the the start of the next line. +E_M- Editor command MOVE BACK: M- moves the pointer to the start of the previous line. +E_P Editor command PRINT: P prints the current line on the console. When repeated (e.g. P4) a MOVE is performed before the second and subsequent printings. +E_R Editor command RIGHT SHIFT: R moves the pointer right one character. +E_S Editor command SUBSTITUTE: S/text/ substitutes text for the text string last located using F, V, or U. +E_T Editor command TRAVERSE: T/text/ moves the pointer past the next occurrance of text. +E_U Editor command UNCOVER: U/text/ deletes characters up to but not including the next occurrance of text. +E_V Editor command VERIFY: V/text/ does nothing. Failure condition: the pointer is not immediately to the left of the given text. +E_X &E_Y &E_Z User-defined editor command: X,Y and Z replaced by the string previously specified by an editor command %X=......., %Y=......., or %Z=....... +E_%C Editor command CLOSE: %C terminates the editing session and causes the updated output file to be generated. +E_%F Editor command FULL MONITORING: %F enables full command monitoring. +E_%L Editor command LOWER CASE: %L causes subsequent text locating commands to distinguish between upper and lower case letters. +E_%Q Editor command QUIET: %Q turns off command monitoring. +E_%S Editor command SWITCH INPUTS: %S switches between primary and secondary input. +E_%X &E_%Y &E_%Z Editor macro definition commands: %X, %Y and %Z are used to specify strings to be used whenever X, Y, or Z are used as commands. E,g, %X=f/jim/s/bert/ +E_() &E_( &E_) Editor brackets: A sequence of editor commands in brackets is treated as a single command for the interpretation of failure conditions of commands within the brackets. +E_, Editor comma: A comma separates alternative command sequences. +E_* &E_0 Editor indefinite repetition: A repetition count of * or 0 causes the command to be repeated until it fails. +E_\ Editor failure inversion: \ after a command produces a new command which has the same effect as the original command except that the new command fails if the original command would have succeeded. +E_? Editor ignore failure: Any failure condition caused by the previous command is ignored. +COMPARE &Comparing files &File comparison &Differences &changes This command causes the contents of the two text files specified as inputs to be compared and any discrepancies to be noted on the output stream. COMPARE file.new,file.old Compare file.new,file.old/lp:differs +Compilation &Compilers &compiling &compiling programs &compiling programmes Source programs may be compiled using a general command of the form: Compiler(parameters) Source/Object,Listing where 'compiler' stands for one of the supported compilers. The currently supported compilers are: Imp - The IMP77 compiler Fortran - The Fortran77 compiler (pre-release only) Pascal - The Pascal compiler (pre-release only) See also: Help Imp Help Fortran Help Pascal Help Compilation parameters Help Run +IMP The IMP compiler is called using a command of the form: IMP(compilation parameters) source/object,listing The executable object file is given the same name as the source file but with the extension .EXE unless explicitly specified otherwise. If the source file specifed does not exist and has no extension, .IMP is appended then that file is tried. +Compilation parameters &Compilation parameter &Compiler parameters &Compiler parameter &compiler options &Compiler option &Compilation options The optional parameter to commands which invoke the standard compilers comprises a list of options. Three basic compilation options specify an initial state which may be modified by further options - the order is thus significant. Initial states are defined by: DEFAULT: include all checking code and full diagnostic data tables OPT: remove all checking code and reduce size of diagnostic tables TRUSTED: as OPT but diagnostic tables completely removed Modifiers are: (can be inverted by prefix NO) ASSIGN: check for use of unassigned variables ARRAY: check for array subscripts out-of-bounds CAPACITY: check for truncation when storing strings, shorts, bytes BRIEF: generate a summary listing with only procedure headings For example: IMP(ARRAY,NOASSIGN,BRIEF) pgm1/,t: +Fortran77 This command is not generally available yet. +Pascal This command is not generally available yet. +run &running programs &running programmes &execute &executing programmes &executing programs &do Programs are run by giving a command of the form: PROG ............... which causes the file "PROG.EXE" to be loaded and run. The interpretation of the remainder for the line (.......) is dependent on the options set in the object file (PROG.EXE); By default the interpretation is the the line is either of the form:- (parameter) or:- or:- -parameter The parameter (or the null string) is made available to the program and the required streams are set up. Input stream 1 and output stream 1 are selected before the program is entered. See also: Help Streams Help Set Help Option Help Files +STOP &Stopping &logging off &finishing &QUIT &quitting &BYE The command STOP stops the process and logs the user off. All temporary and volatile files are deleted. However, if this command is given from within a command file, see HELP COMMAND FILE, the effect is simply to terminate the execution of that file. Subsequent commands are taken from the user's terminal. +FILES &Files &DIRECTORY &index The format of the FILES command is: FILES - for a listing of the names of all of your own files FILES fred: - for a listing of another user's files. The command produces the listing in alphabetical order in several columns across the page. The output produced may be altered (with both of the above forms), by appending a '!' or '?' to the command, as shown below: FILES! or FILES fred: ! - An extended listing is produced, one file per line, with additional information. FILES? or FILES jim: ? - A '2-D' listing: filenames vertically, with extensions horizontally. A star (*) may be used as a wild-card to select the owner, filename or extension for all the files which match the rest of the parameter. E.g. Files *.imp will list the names of all of the files in the current directory with the extension .imp; Files *:RULES.* will list the names of all the files in the whole file system with filename RULES and any extension. See also: Help Fileinfo Help Filenames Help Temporary files +FILEINFO A FILE is an ordered collection of data bytes (8 bit quantities). The interpretation of these bytes is totally dependant on the program using the file; the system imposes no restrictions on the contents of files. See also: Help Creating files Help Editing Help Delete Help Rename Help Files Help Dump Help Filenames Help Directory +MAIL &Messages &MESSAGE Text messages may be sent between users. (See HELP TELL). If a message is received while a user is logged on, the line "***ACOUNT: mail from ???" will be displayed on the recipient's console. (Where "???" is the sender's username). Messages sent to users when they are not logged on are queued up. When the user next logs on a the message "You have new mail" will be displayed on the console. Mail sent at any time may be read by giving the command MAIL. The program steps through all pending messages. Once a message has been read it may be deleted. If it is not deleted it will continue to appear when the MAIL program is run in future. Two variants of the MAIL command are provided. MAIL? - This simply displays the number of queued messages MAIL! - This shows when and from whom any pending messages were sent. +TELL &SEND &NOTIFY The command TELL may be used to send messages to other users. Command: TELL username e.g. TELL ALAN or TELL THU5 The user is then invited to type a message in on the console. No prompt is issued for the lines of the message. When the entire message has been typed the program is stopped by typing Ctrl+D. To mark a message as being about a particular subject, use: Command: TELL(subject) username e.g. TELL(bug report) FRED To send files to other users, the full form of the TELL command is: Command: TELL(subject) file / username e.g. Command: tell(compiler bug) testprog / IMPD or Command: tell /fred: {file defaults to T:, the user's console, colons in usernames are optional} For very short messages consisting only of a 'subject' line that the user wishes broadcast immediately to the recipient's console rather than being queued as normal mail, use: Command: TELL(up to 19 chars) username! e.g. TELL(coffee time?) fred! +FILENAME &Filenames &file &NAME In general filenames take the form: UNIT_OWNER:FILE.EXT where: UNIT is the name of the disc unit on which the file resides OWNER is the name of the owning process FILE is the file name, which comprises a letter or a dollar optionally followed by up to seven letters or digits. EXT is an optional extension of up to 3 letters or digits. Within filenames lower case letters are treated as upper case. If the UNIT is not specified all available units are searched until the specified OWNER is discovered. If the OWNER is not specified the current user is assumed. On creation the system marks files as being volatile by following the name with a hash(#). Only when the file is closed will the file be renamed properly and any old version deleted. Filenames starting with a dollar are considered temporary. Temporary and volatile files are deleted when the process logs off, or the command PURGE is given. Examples of filenames: DATA NEWS.TXT PETER:prog.IMP SYSTEM:NEWS arch_system:help.txt ARCH_PETER:VERSION1 $program.tst +Ctrl &Ctrl+ &Control &Control characters &Control Character The notation Ctrl+A is used to specify characters generated at the terminal by typing the letter specified (in this case A) while holding down the CONTROL shift key (commonly marked CTRL). E.g. Ctrl+X is generated by holding down CTRL and typing X. +rename &newname &change The command RENAME may be used to change the name of a file. The form of the command is: RENAME oldname/newname The command will fail with an error message if file NEWNAME already exists. Wildcards may be used: Command: rename *.imp/*.old All .IMP files become .OLD files Command: rename xxx.imp/yyy.* XXX.IMP renamed YYY.IMP +CONSOLE &Keyboard &console conventions &TT &T &TTY &input &terminal Information about the special characters which are used to control the operation of interactive terminals may be obtained by giving the command HELP special-character, where 'special-character' is one of the following mnemonics: Backspace BS CAN Cancel CR Ctrl+D Ctrl+E Ctrl+G Ctrl+N Ctrl+O Ctrl+P Ctrl+Q Ctrl+R Ctrl+S Ctrl+T Ctrl+X DC1 DC2 DC3 DC4 DEL DLE ESC Escape LF Line feed Return SI SO TAB +Copy ©ing files &C &transfer The command COPY may be used to copy any input stream to any output stream. Data from a second input stream, if specified, will be concatenated onto the end of the output stream. The command takes the form: COPY input1,input2/output The files take defaults as follows: input1 = T: the user's terminal input2 = N: the null file output = T: the user's terminal Examples: Copy file1/file2 Copy heading,letter/final Copy t:/newfile +Be &become &change hats The system allows a user to pretend to be logged on as a different user. This is useful if a lot of work is to be done in a short period on another user's files. The command: BECOME Fred will prompt you for Fred's password (which is not echoed). Subsequently all unqualified filenames refer to files in FRED's directory. Your own files may be referred to by using the "USER:file" notation. To remind you of the changed state of the process, the subsystem command prompt becomes the appropriate username. In the example, the prompt would change to "Fred:". The STATE command will indicate the directory currently in use at any time. The command: BECOME with no username parameter specified will return the process to its 'home' directory. The command prompt is restored to its original value. The form: BECOME user,pass may be used for brevity. +line printer &lp: &lp &printer Any output files specified as having the owner LP: will be offered to the printer spooler when the file is closed. e.g. COPY FRED.IMP/LP:OUTPUT.XXX will send a copy of the file "FRED.IMP" to the printer and label it "OUTPUT.XXX". If no name is required on the output the form "LP:" may be used. e.g. COPY FRED.IMP/LP: A file may be sent to the printer without copying (resulting in the file being deleted) by offering the file to the printer using the command OFFER. e.g. OFFER FRED.IMP/LP:OUTPUT.XXX +paper tape punch &pp: &pp &punch &paper punch &paper tape Files may be sent to the paper tape punch in a manner analogous to that from sending files to the printer; see HELP LP. e.g. COPY FILE/PP:FILE OFFER TAPE.TMP/PP:OUT.ABC +stream &Streams &environment &Logical units The environment for a program may be specified in the command which invokes the program. This is done using a stream specification of the form: INPUT1,INPUT2,INPUT3/OUTPUT1,OUTPUT2,OUTPUT3 where INPUTx defines input stream 'x' and OUTPUTx defines output stream 'x'. If any of the streams is not specified the default stream assignment is taken. The defaults are: T:, Null:, Null: / T:, Null:, Null: +PASSWORD &PASS The user's password may be changed by a command of the form: SET PASSWORD= is any sequence of up to 6 letters or digits starting with a letter. e.g. SET PASSWORD=SECRET +delete &destroy &remove &del &purge &kill &deleting files &destroying files &removing files The command: DELETE where is a list of file names separated by commas, can be used to delete unwanted files. If the command is given as DELETE *, a prompt is given for every file in the owner's index. A reply of YES causes the file to be deleted, any other reply leaves the file alone. The command PURGE may be used to delete temporary and volatile files. +null &Null: &n: &n &null stream &null file &null input &null output &Drain &Sink The null file is represented by N: or Null:. On input it immediately signals end-of-file, and any output sent to it is discarded. +ESC &Escape &BEL &Ctrl+G ESC and BEL (Ctrl+G) are equivalent. Both signal to the system that the user wants to interrupt the currently executing program, either to halt it or to convey some information to it asynchronously. The system responds to ESC by prompting "Int:" at the start of a new line. See "Help int" for details of the valid replies to this prompt. (The normal reply is "." full stop followed by carriage return, which aborts the currently executing program). +interrupt &Interrupts &int &Break The replies to the prompt Int: (see HELP ESC) are normally made available to a process in the external string variable Console Int. However several of the replies are reserved for use by the system. These are: Int:. (Int full stop) Terminates the running program and returns the process to command level. Int:? (Int question mark) Terminates the running program and invokes the run-time monitor to produce diagnostics (if they are available). Int:! (Int exclamation mark) For convenience this interrupt may be generated by striking the escape key () twice in which case no is necessary. It has the normal significance of any other interrupt, except that it is used in the editor to force the command currently being executed to fail, and hence request another command. +option &Options &command interpretation The command OPTION may be used to modify the interpretation of the command line associated with the execution of an object file. The command takes the form: OPTION(