From 131a087d8574ec120ed940436e8c84e573e90b88 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Wed, 4 May 2016 14:28:52 -0700 Subject: [PATCH] Commit initial files for Ron Brody's R/C (Remote/Card) program, transcribed by Rich Cornwell of Durham, North Carolina, US, and donated to the project. --- RC-Ron-Brody/RC-Compile.card | 12 + RC-Ron-Brody/RC-Manual.txt_m | 772 +++++++ RC-Ron-Brody/RC.alg_m | 4098 ++++++++++++++++++++++++++++++++++ RC-Ron-Brody/README.txt | 33 + 4 files changed, 4915 insertions(+) create mode 100644 RC-Ron-Brody/RC-Compile.card create mode 100644 RC-Ron-Brody/RC-Manual.txt_m create mode 100644 RC-Ron-Brody/RC.alg_m create mode 100644 RC-Ron-Brody/README.txt diff --git a/RC-Ron-Brody/RC-Compile.card b/RC-Ron-Brody/RC-Compile.card new file mode 100644 index 0000000..6be30e9 --- /dev/null +++ b/RC-Ron-Brody/RC-Compile.card @@ -0,0 +1,12 @@ +?COMPILE R/C WITH ALGOL FOR LIBRARY +?ALGOL FILE TAPE = symbol/rcsy94 DISK SERIAL +?ALGOL FILE LINE = PRINT BACK UP DISK +?ALGOL STACK = 1024 +?STACK = 256 +?CORE = 2800 +?PRIORITY = 1 +?DATA CARD +$ SET TAPE SEQXEQ +$ TAPE LIST SINGLE + 99999999 +?END diff --git a/RC-Ron-Brody/RC-Manual.txt_m b/RC-Ron-Brody/RC-Manual.txt_m new file mode 100644 index 0000000..ad3e528 --- /dev/null +++ b/RC-Ron-Brody/RC-Manual.txt_m @@ -0,0 +1,772 @@ +?EXECUTE XREF/JONES +? FILE LINE = XREF/LISTING PRINT BACK UP DISK +? DATA CARD +$ CARD DOCUMENT FINAL DOCONLY SIX SINGLE +COMMENT DOCUMENT +* skip 10 center underline 3 + r/c + reference + manual +* skip 20 indent 50 double + by + ron brody + 12/22/71 version 94 +* single page no +* define 1 = skip 2 paragraph 5,68 * +* define 2 = skip 2 paragraph 10,68 * +* define 3 = paragraph 7,68,4 * +* define 4 = skip 2 paragraph 6,68 * +* define 5 = skip 2 indent 15 * +* define 6 = skip 2 indent 5 index only underline * +* define 7 = page index center underline * +* define 8 = skip 1 indent 15 * +* 7 +introduction +* 1 +r/c permits a user at a remote teletypewrite to create and +maintain source or data files on the b5500 system disk. file +types created and maintained with r/c are: algol, xalgol, cobol, +fortran, basic, and data. these files represent normal (80 +character-per-card) punched card decks except that they are +stored on the disk. each record can be thought of as one card. +* 1 +r/c allows the user to: +* skip 1 paragraph 7,68,4 + * create a variety of files +* 3 + * resequence files +* 3 + * print or punch files +* 3 + * delete or insert records into a file +* 3 + * modify records within a file +* 3 + * scan a file for the occurrence of a string +* indent 12 + (optionally replacing it with another string) +* 3 + * remove files +* 3 + * compile files +* 3 + * perform many other functions +* 1 +the teletypewriter (in conjunction with the program r/c) can be +considered a keyboard extension which eliminates punched cards. +it offers great flexibility in file handling. +* 3 +r/c has two major restictions: +* 2 +while the sequence number 99999999 is permitted for convenience, +the maximum sequence number is 2097151 (2*21-1). +* 2 +the maximum number of records permitted in a file is 8191. +* 1 +in the discussion of certain r/c verbs, some of the elements of the +syntax are given as , , , or . in each case, these +elements represent integer values which much be provided by the user. +the value may be a record number for some verbs, the sequence number +for others, or an increment amount. the bracked construct is only a +form of notation used to represent an integer parameter. +* 7 +program operation and record sequencing +* 1 +during creation and file maintenance, r/c automatically advances (by +the current value of the "increment") the sequence number of each +record that is input. the user my set this increment to any desired +value through use of the "*inc" verb (see below). the increment value +is initialized to 100 when the user first runs r/c. +* 1 +the initial sequence number is set to the increment when a new file is +opened by a user. for example, if the current increment were 100, the +first sequence number in the file would be "100:". this initial +sequence number may be changed by the user through the use of the +construct "*", (see below). +* 1 +after each record is typed into the file, the sequence number of the +next record in the file is set to the last sequence number plus the +increment. this sequence number is next typed on the teletypewriter. +* 1 +if the file type is not "cobol", the sequence number is followed by +a colon. if a record already exists with this sequence number, leading +zeros are typed as a warning; otherwise leading zeros are suppressed. +after the sequence number is typed out, the user may then enter the +desired contents for that sequence number of may enter a verb to +perform some other function. +* 1 +alternatively, the user may set the sequence to some other value +through the use of the construction "*", where is the desired +sequence number. note that leading zeros are accepted but not +necessary with this construct. +* 1 +by use of the "*" construct and the "*inc" verb to set the sequence +number increment, the user may set up his own numbering sequence +throughout his file. +* 1 +the examples illustrate the sequence number of the record typed on the +left side of the page as it appears on the teletypewriter and the +manner in which these records are incremented. although algol, xalgol, +basic and fortran files actually carry the sequence number in character +positions 73-80 of the record, r/c types the number on the left margin +of the teletypewriter. +* 7 +program execution +* 6 +initial remote terminal operations +* 1 +for logging-in to a teletypewriter, press the "orgi" button, wait for +a dial tone from the speaker, and dial the computer number. the b5500 +responds with the message: +* skip 2 underline center +burroughs b-5500: / +* 2 +(the station number is / where is the terminal number and + is the buffer number.) +* 4 +you may type: +* skip 2 underline indent 11 +* invalid 1 +q li: /~ +* skip 2 +* 2 +* invalid 50 +this log-in message may have been preceded by a "qbo~" message which +would have blacked out the line on which the log-in message was typed. +* 2 +the b5500 validates the and and +responds by typing out the station number and the time of day of the +log-in. +* 1 +to connect a remote terminal to r/c, enter: +* skip 2 center underline +* invalid 1,2 +qq run r/c;end.~ +* 1 +the b555 responds by either typing out a "boj" (beginning of job) +message, a "scheduled" message, or a "running" message. a "boj" +message indicates that r/c was not previously running but has now been +entered into the mix and is ready for use. a "scheduled" message +indicates that r/c was not previously running and is scheduled. in +this case, r/c is not brought into the mix until other system users +complete their work. the "running" message indicates r/c is already +in the mix. +* 1 +with r/c in the mix, it automatically searches out and locks onto +remote terminals which have requested connection (by "run r/c"). as +soon as your terminal is locked, r/c types one of the following +message sequences, according to the manner in which r/c ended during +your last r/c run (first-time users are considered to have caused +normal last entries): +* 4 +initial message after normal termination of last run: +* 5 + + hello + + hello+ + : +* 4 +or if no file is open +* skip indent 10 + version number> + hello+ + : +* 1 +if a message has been sent from another user to your usercode (see the +mail verb), "mail %" is typed instead of "hello". +* 4 +examples: +* 5 + version # + hello blum + : +* 5 +this is the normal initial sequence from r/c. +* 5 + version # + hello+ wilner + : +* 1 +this sequence indicates that r/c remembers the users state from +previous run. the state indicates the increment value, tab amount, +save factor, percent on-off, and verb replacements. +* 5 + version # + file/name + hello+ sharpe + 00050600: +* 1 +this sequence indicates that user has the file "file/name" open and is +at the record with sequence number 50600. the leading zeros indicate +that a record already exists with that number. +* 6 +final remote terminal operations +* 1 +the user should terminate his use of r/c with the "* end" command (see +below). r/c will respond with "good bye." +* 1 +after he has ened r/c, if the user is done with the remote terminal he +* invalid 30 +should log-out by entering: "Qlo~" +* 6 +r/c input +* 1 +input to r/c is either commands or records. +* 1 +commands are indicated by the character "*" in the first input position. +(if there is no open file, the "*" is optional.) all other input is +considered records to be placed in the open file. the format for a +command is the "*" followed by an r/c verb and, if needed, its +parameters. the verb and its parameter must be separated by a delimiter. +* 1 +a delimiter is either a space or any special character except a ";", a +""", a ".", a "(", or a "[". multiple delimiters are treated as a +single delimiter. +* 1 +a command may be followed by another input (either a command or a +record) if it is terminiated by a ";". an error in a command of a +multiple input inhibits the processing of the rest of that input. +* 5 +examples: +* 5 +100:* inc 50~ +* 2 +this is an example of one of the input commands. +* 5 +100:begin~ +* 2 +this is an example of placing a record at sequence number 100. +* 5 +100:* inc 3;* reseq~ +* 2 +this is an example of multiple commands. +* 5 +100:*35; this record goes at 35~ +* 2 +this is an example of a command followed by a record of input. +* 5 +100:* open a/b data;* print for me;*close~ +* 2 +this is another example of multiple commands. note that the "*" must +appear in the next character position following the semicolon or +remainder of the record is treated as data. +* 1 +an input line is sent to the computer by typing the character "~". +typing errors can be corrected, by backspacing and line erasing, +before a message is sent. the backspace character is apostrophe +(shift 7) and the line erase character is the up-arrow (shift n). +all the following lines of input are equivalent (note the underlined +characters represent use of the shift): +* 5 +100:this is it~ +* 5 +100:this is not,butnthis is it~ +*indent 34 +- +* 5 +100:this7is it~ +*indent 23 +- +* 5 +100:these777is is it~ +*indent 24 +--- +* 1 +if, after backspacing and line erasing, the input line contains more +then 240 characters, the input is discarded with an "input overflw" +error message. data records are als discarded (with the error message) +if they are too large for the file. (i.e. gtr 66 for cobol files; +gtr 80 for data files; and gtr 72 for all other files) +* 1 +there are two classes of requests to r/c: long and short. long +operations are those that usually are slow to execute and are +characterized by the "wait..." message. all other requests are +classified as short operations. long operations are sometimes queued +before the "wait..." message, to be executed one at a time. short +requests are done as they are received. the users in the long +request queue (and the user performing a long operation if it is not +typing on the remote) periodically receives a few "rubout" charcters +of reassurance. r/c ignores any input sent by users in the queue or +by the user whose long operation is being processed. +* 1 +if the user produces no input for five minutes, he is sent the +message "look alive". if he does not respond within another five +minute period, r/c processes a "*end ds" for that user. +* 6 +r/c output +* 1 +output to the teletypewriter of the specail characters ~, !, <, {, >, +and } is replaced by the "$" character in order that they do not evoke +teletypewriter control functions with which they are associated. +(these include line-feed, carriage-return, message-end, and +paper-tape-on.) +* 1 +when the "break" key is depressed during output, the output is +terminated with the message "break". +* 7 +r/c files +* 1 all files created by r/c are permanent disk files. the save factor +is normally 7 days, but it may be changed by the save verb (see below). +* 6 +file types +* 1 +r/c enables the user to create and maintain algol, cobol, fortran, +xalgol, basic, and data files. these files have 80 character-long +records, (one card image). +* 1 +xalgol, basic, algol and fortran files contain eight digit sequence +numbers located in the positions 73-80 of the card image. +* 1 +cobol files contain six-digit sequence numbers, placed in positions +1-6 of the record. +* 1 +data files are not physically sequenced although r/c maintains an +internal, eight-digit number for each record. +* 6 +file names +* 1 +file names must be supplied to r/c. the form of a name is + / . throughout this document, +is used to specify and should be in the form above. the +and the may each be no longer than 7 characters. +* 4 +examples: +* 5 +a/b +* 8 +grimy/gulch +* 8 +zap/1 +* 8 +16jan/suffix +* 8 +0000000/disk +* 6 +record referencing +* 1 +records in the open file (see open below) are referred to by their +sequence number. "data" files are implicitly sequenced by the value +of the increment when they are opened. +* 1 +an alternative method of referencing records in the open file is +relative sequence numbers. a relative sequence number is an integer +preceeded by a + or - sign. it may be used anyplace a sequence number +is used. it is translated to a sequence number by moving forward or +backward the indicated number of records and using the sequence number +of that record. +* 1 +records in a non-open file (external file) are referred to by their +relative position within the file. the first record is 1, the second +2, etc. any sequence that may be on the records is ignored. +* 7 +file-handling verbs +* 1 +this section describes versb that handle files as a whole, rather than +records within a files. however, a few versb have options in r/c syntax +that permit access to records within the file. the complete syntax is +given for each verb as well as a discussion and examples of its use. an +asterisk ("*") must always be the first character in the input string +when a command is entered. if this is not followed, an existing record +may be overwritten by the command itself. +* page 1 +* 6 +file opening and creation (open) +* glossary 12,10,68 +* skip 2 glos underline + * open new = +* skip 2 glos underline + * open old = +* skip 2 glos underline + * open = +* 1 +the "* open " verb attaches the user to the disk file . the + must be either "algol", "cobol", "fortran", "xalgol", +"basic", or "data". if the is "new", a new disk file is +created. if the is "old", the disk file is +opened and resequenced by the current value of the increment. if the + is neither "new" or "old" the disk file is +opened ad it is read to ddetermine its sequence numbers. this latter +form is slower than the open "old". +* 4 +examples: +* skip 2 indent 15 +:* open program/source algol new~ +* indent 20 +100: +*5 +this creates a new disk file called program/source. +* skip 2 indent 18 +63500:* open another/prog data old~ +* indent 19 +4500: +*5 +this opens the file another/prog sequencing it by the current increment +value. note that the file that was open is first closed before the next +file is opened. +* skip 2 indent 15 +:* open yet/another cobol~ +* indent 15 +wait... +* indent 15 +read only file. +* indent 17 +7504 +* 5 +this opens the file yet/another using the sequence numbers within the +file. the message "read only file" indicates that the user is forbidden +(by the file security system) to modify the file. +* 5 + errors: +* 8 +dup file: +* 5 +a file, , alredy exists and the user is trying to create a +file with that name with an "* open ... new". +* 8 +no file: +* 5 +the user is trying to open a file, , and it does not exist +on disk. +* 8 +bad file: +* 5 +the file which the user is trying to open is not blocked +correctly. the correct blocking is 10-word records with multiple of +3 records per block. +* 8 +inv user: +* 5 +the user is trying to open a file to which he has no access. if the +user has either secondary or tertiary access, the message: +"read only file" is typed. +* 8 +file too long +* 5 +the user is trying to open a file with more then 8191 records. +* 8 +seq overflow +* 5 +the files the user is opening cause the sequence counter to exceed +2,097,151. the file is opened, but the user should resequence it. +* 8 +seq err- +* 5 +the file contains a record whose sequence number is less than +the sequence number of the preceeding record. the file is not opened. +* 8 +bad file type: +* 5 + is not "algol", "cobol", "fortran", "xalgol", "basic", or +"data". +* page 1 +* 6 +file closing (close) +* skip 2 glos underline + * close = +* 6 +this verb detatches the open file, from r/c. +* 5 +examples: +* 8 +5600:* close~ + : +* 5 +this is an example of closing a file that is in the correct order. +* 8 + 450:* reseq 100~ + 9000:* close~ + wait... + : +* 5 +this is an example of closing a file that is not in order. +* 5 +error: +* 8 +no file open: close +* 8 +there is no open file to close +* page 1 +* 6 +listings on the teletypewriter (list) +* 1 +to list files or any of their separate records, the following +constructs apply: +* skip 2 glos underline + * list +* skip 2 glos underline + * list +* skip 2 glos underline + * list no +* skip 2 glos underline + * list +* skip 2 glos underline + * list +* skip 2 glos underline + * list +* skip 2 glos underline + * list +* 1 +the "list" verb casuse an entire file or portions of a file to be +listed on the teletypewriter. listing may be discontinued by pressing +the break key on the teletypewriter. +* 5 +the first form lists the open file. +* 5 +the second form lists the file . +* 5 +the third form lists the file , without the record numbers. +* 5 +the fourth form lists from the th record to the end. +* 5 +the fifth form lists from the th to the th records. +* 5 +the sixth form lists sequence number of the open file. +* 5 +the last form lists sequence numbers through of the open file. +* 4 +examples: +* 6 + 500:* list~ + 100:begin + 200: integer i, j, k ; + 300: real x, y, z ; + 400: array a [0 : 9] ; + 500: +* skip +* 6 + 5500:* list 8900,+3~ + 8950: i := i + 5 ; + 9125: go to next ; + 9300: help: + 9400: +* skip + 300* list 60~ + 000060 move a to b. + 000070 +* skip +:* list some/file~ + 1:begin + 2: integer i, j, k ; + 3: real x, y, z ; + 4: array a [0 : 9] ; + 5: a [i] := x ; + 6:end. +: +*skip + 500:* list some/file no~ + begin + integer i, j, k ; + real x, y, z ; + array a [0 : 9] ; + a [i] := x ; + end. + 500: +:* list library/file 2,4~ + 2:procedure readdata 567,653 + 3:procedure writedata 654,789 + 4:procedure data 790,808 +: +*skip +:* list some/file 5~ + 5: a [i] := x ; + 6:end. +: +*skip +:* list some/file 200,500~ +use record #s. +: +*5 +the last example illustrates the common error of referencing +an external file with sequence numbers instead of record numbers. +*7 +compressed file listings (quick) +*1 +a compressed file listing may be obtained from r/c by use of the +constructs: +*skip + * quick +*skip + * quick +*skip + * quick no +*skip + * quick +*skip + * quick +*skip + * quick +*skip + * quick +* 1 +the "* quick" verb lists on the teletypewriter deleting all contiguous +blanks except the first. the file is not affected by the verb. +* 5 +example: +* skip +4500:* list 4300,4400~ +4300: for i := a step -1 until 0 do +4400: x [i] := sin (y) ; +4500:*quick -2 + 1~ +4300: for i := a step -1 until 0 do +4400: x [i] := sin (y) ; +4500: +*7 +file removal (remove) +*1 +to remove a file use the following construct: +*skip +* remove +* 5 +the remove verb removes the file from disk. +*skip +* remove listing +* 5 +remove line/, the listing file from the last compilation. +*skip +examples: +* skip +3200:* remove a/b~ +3200: +*skip +546:* remove another/file~ +no file: another/file +546: +*skip +:* open example/x cobol old~ +46500* remove example/x~ +: +* 7 +line-printer file reproduction (print) +* 5 +the print verb: +*skip + *print +*5 +prints the opened file on the line printer (labeled ). if "" +is "double" the double spacing is used. +*skip + * print +* 5 +as above, starting with sequence number . +* skip + * print , +*5 +as above, stopping with sequence number . +*5 +examples: +*skip +:* open test/case data; *print tc double;* close~ +: +*5 +this example illustrates an instance where a sequence file should be +treated as data to shorten the operation. if the file was opened +"algol old" it would have been resequenced by the current value of +increment and then when it was closed it would have been recopied. +if it was opened "algol" it would have been read to determine its +sequence numbers. either way would have made the whole operation +much slower than opening the file "data". +*skip + 8700:* print for user~ +wait... + 8700: +* 7 +punched-card file reproduction (punch) +*5 +to punch a file: +*5 underline + * punch +* 5 +punches a card deck (labeled ) of the opened file. +* 5 underline + * punch +*5 +as above, starting with sequence number . +*5 underline + * punch +*5 +as above, stopping with sequence number . +*5 +example: +*5 +7600:* punch a b 100,+10~ +wait.. +7600: +*7 +file compilation (compile) +*5 +files may be compiled to tyhe b5500 library by the following construct: +*5 underline + * compile +* 5 +this verb initiates the compilation of the open file to library using +the compiler indicated in the open statement. the object code is named +. the listing output of the compilation is equated to +"line/" on disk. the "* listing" verb may be used to list +the syntax errors. +* 5 underline + * compile +*5 +compiles the open file using specified compiler. +*5 +examples: +*5 +5700:* compile object/code~ +wait... +: +479:* compile test/object eztran~ +queued( 1).wait... +: +*5 +in the last example, the "eztran" compiler (eztran/disk) will be used. +if the file is not in order, it will be reordered. since this is a +long operation the user gets a "wait" message. the "queued" message +indicates that another users long operation is being processed and +that this long operation is queued until the other is done. the "1" +indicates that this is the first request in the queue. +*7 +output of the compilation (listing) +*5 +the listing file of the compiler is equated to line/ on disk. +the file may be accessed by the use of the listing verb: +*5 underline + * listing , , +*5 +lists the sequence numbers related to segment from relative address + to relative address . is algol, xalgol, basic, +cobol,or fortran and indicates which compiler created the listing file +"line/". (this file is automatically generated by the +compile verb). +* 5 underline + * listing errors +* 5 +lists the syntax errors of your last compilation. +*5 underline + * listing +*5 +prints the line file of your last compilation on the printer. +*5 +examples: +*5 +:* listing algol 5, 25, 35~ +wait... segment = 5: + 4300: rel. addr. = 26. + 4400: rel. addr. = 29. + 9200: rel. addr. = 32. + 9300: rel. addr. = 35. +:* listing algol errors~ +wait... + 7800:error 100 i, +: + 8900:* listing~ + 8900: + +* finish +?END diff --git a/RC-Ron-Brody/RC.alg_m b/RC-Ron-Brody/RC.alg_m new file mode 100644 index 0000000..c327ab7 --- /dev/null +++ b/RC-Ron-Brody/RC.alg_m @@ -0,0 +1,4098 @@ +?execute object/reader +?common=3 +?file newtape = symbol/rcsy94 serial +?data card + r / c -- a multi user remote/card. 00000500 + written by ron brody; burroughs corp.; paoli, pa. 215-ni4-4700 x219 00001000 +begin 00001500 + define version = 94#; % november 18, 1971. 00002000 + define maxusers = 8#, maxuser = 7#; 00002500 + define chrsperbuffer = 56 #, % or 28 00002600 + wordsperbuffer = 8#, % or 5 00002700 + wdsperbuffer = 7# ; % or 4 00002800 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00003000 +alpha file in twxinput 14 (maxuser + maxuser, 8); 00003500 +alpha file out twxoutput 14 (maxusers, wordsperbuffer) ; 00004000 +define twxout = twxoutput (stationi, 0)# ; 00008500 +array pretank [0 : 3], 00009500 + buffers [0 : maxusers, 0 :44] ; 00010000 +define buffer [buffer1] = buffers [user, buffer1]#, 00010200 + bloc = buffer [29]#, 00010300 + buff [buff1] = buffers [maxusers, buff1]# ; 00010400 +integer array readyq [0 : maxusers] ; 00011000 +define rattleindex = readyq [maxusers]# ; 00011500 +integer user, 00012000 + user32, 00012200 + clock, 00013000 + readyqtop, 00013500 + nextclock, 00014500 + tink, 00015000 + bigbird ; 00016000 +boolean globalbool ; 00016500 +define 00017000 + tankedoutput = globalbool . [47 : 1]#, 00017010 + outputready = (globalbool)#, 00017020 + q = globalbool . [46 : 1]#, 00017100 + locked = globalbool . [45 : 1]#, 00017200 + xlocked = globalbool . [44 : 1]#, 00017210 + ylocked = globalbool . [43 : 1]#, 00017220 + qinput = globalbool . [42 : 1]#, 00017300 + errtog = globalbool . [1 : 1]#; 00017500 +array input [0 : 14] ; 00018000 +define t0 = input [10]#, 00018100 + t1 = input [11]#, 00018200 + tn = input [12]#, 00018300 + freehead = input[13]#, 00018400 + maxfreehead = input[14]# ; 00018500 +define chrs = buffer [30]#, 00019000 + nchrs = buffer [31]#, 00019100 + usercodei = buffer [32]#, 00019500 + stationi = buffer [33]#, 00020000 + breaki = buffer [34]#, 00020500 + abnormalend = buffer [35]#, 00020600 + inreadyq = buffer [36]#, 00020700 + firstchance = buffer [37]#, 00020710 + ilfcri = buffer [38]#, 00020800 + translatei = buffer [39]#, 00020900 + headi = buffer [40]#, 00021000 + timei = buffer [41]#, 00021100 + taili = buffer [42]#, 00021500 + sloti = buffer [43]#, 00022000 + block = buffer [44]#, 00022100 + counti = buffer [0]# ; 00022500 +alpha array record [0 : 9] ; 00023000 +real array linklists [0 : 32 | maxusers - 1, 0 : 255] ; 00023500 +define timex = time (1)#, 00023600 + first = linklists [user32, 0]#, 00023800 + last = linklists [user32, 1]#, 00023900 + leftside = [35 : 5]#, 00024000 + rightside = [40 : 8]#, 00024500 + ll [ll1] = 00025000 + linklists [(tink := ll1).leftside + user32, tink.rightside]#, 00025500 + s = [1 : 21]#, 00026000 + sf = 1 : 27 : 21#, 00026500 + f = [22 : 13]#, 00027000 + ff = 22 : 35 : 13#, 00027500 + t = [35 : 13]#, 00028000 + tf = 35 : 35 : 13#, 00028500 + infinity = 2097151#, %maximum sequence number = 2*21-1. 00029000 + finity = 2097160#, 00029010 + maxfilelength = 8191# ;% = 2*13-1. 00029500 +define modify (modify1) = 00029700 + modified := modified or two ((modify1).leftside)# ; 00029800 +define waitflag = bool . [47 : 1]#, waiting = (bool)#, 00030500 + inlinetog = bool . [46 : 1]#, 00031000 + extralfcr = bool . [45 : 1]#, 00031500 + executeecho = bool . [44 : 1]#, 00032000 + translating = bool . [43 : 1]#, % initially on 00032500 + xecho = bool . [42 : 1]#, 00033000 + num1 = bool . [36 : 2]#, 00035500 + num2 = bool . [34 : 2]#, 00036000 + num3 = bool . [32 : 2]#, 00036500 + num4 = bool . [30 : 2]#, 00037500 + empty1 = bool . [36 : 1]#, 00037500 + empty2 = bool . [34 : 1]#, 00038000 + empty3 = bool . [32 : 1]#, 00038500 + empty4 = bool . [30 : 1]#, 00039000 + nostar = bool . [29 : 1]#, 00039500 + moreinput = bool . [23 : 1]#, 00042500 + notfirstinput = bool . [22 : 1]#, 00043000 + inlineecho = bool . [21 : 1]#, % initially on 00043010 + changeecho = bool . [20 : 1]#, 00043020 + editecho = bool . [19 : 1]#, 00043030 + copyclobber = bool . [18 : 1]#, 00043040 + dittoclobber = bool . [17 : 1]#, 00043050 + temptog = bool . [16 : 1]#, 00043060 + tabon = bool . [15 : 1]#, % initially on 00043070 + columns = bool . [12 : 1]#, 00043100 + inorder = bool . [1 : 1]#, 00043500 + initialbool = boolean ("44000+")# ; 00043600 +array controls [0 : 90] ; 00043700 +define vn = controls [89]#, 00043800 + stringi = controls [88]#, 00043900 + stringid = controls [87]#, 00044000 + stringileft = controls [86]#, 00044100 + stringirepeat = controls [85]#, 00044200 + stringj = controls [84]#, 00044300 + stringjd = controls [83]#, 00044400 + stringjleft = controls [82]#, 00044500 + stringjrepeat = controls [81]#, 00044600 + character = controls [80]#, 00044700 + maxcolstop = controls [79]#, 00044800 + colstops = controls [78]#, 00044900 + colstop4 = controls [77]#, 00045000 + colstop3 = controls [76]#, 00045100 + colstop2 = controls [75]#, 00045200 + colstop1 = controls [74]#, 00045300 + colstop [colstop1] = controls [73 + colstop1]#, 00045400 + relativenumber = controls [73]#, 00045500 + string = controls [30]# ; % - controls [37] 00046000 +real parameter0, % controls [38] 00046610 + parameter1, % controls [39] 00046620 + parameter2, % controls [40] 00046630 + parameter3, % controls [41] 00046640 + parameter4, % controls [42] 00046650 + usercode, % controls [43] 00046700 + station, % controls [44] 00046800 + prefix, % controls [45] 00046900 + suffix, % controls [46] 00047000 + macrolibrary ; % controls [47] 00047100 +boolean modified ; % controls [48] 00047200 +integer fileinfo, % controls [49] 00047300 + tabamount, % controls [50] 00047400 + fileaccess, % controls [51] 00047500 + savefactor, % controls [52] 00047600 + prewhere, % controls [53] 00047700 + xdex, % controls [54] 00047800 + n, % controls [55] 00047900 + at, % controls [56] 00048000 + d, % controls [57] 00048100 + m, % controls [58] 00048200 + inc, % controls [59] 00048300 + i, % controls [60] 00048400 + resetn ; % controls [61] 00048500 +boolean bool ; % controls [62] 00048800 +define cobolfile = boolean (fileinfo)#, 00048820 + datafile = fileinfo = data#, 00048830 + algolfile = fileinfo geq algol#, 00048840 + compiler = fileinfo#, 00048850 + length = (if algolfile then 72 else if cobolfile then 66 else 80)#, 00048860 + halflength=(if algolfile then 36 else if cobolfile then 33 else 40)#, 00048870 + fulllength = (if datafile then 80 else 72)#, 00048880 + halffulllength = (if datafile then 40 else 36)#, 00048890 + cobol = 1#, 00049600 + data = 2#, 00049610 + algol = 4#, 00049620 + xalgol = 6#, 00049630 + fortran = 8#, 00049640 + basic = 10#, 00049650 + fileopen = fileaccess gtr 0#, 00050710 + fileclosed = fileaccess leq 0#, 00050720 + readonlyfile = fileaccess = 2#, 00050730 + readwritefile = fileaccess geq 3# ; 00050740 +save array image [0 : 29] ; 00058000 +define rswdm = 27#, 00058500 + rswd [rswd1] = controls [rswd1]#, 00061500 + rwteach = rswd [24]# ; 00062000 +file disc disk serial (2, 10, 30) ; 00064000 +file library disk serial (2, 10, 30) ; 00065500 +file r1 disk serial "r/c" "#1" (1, 90) ; 00069500 +file r2 disk serial "r/c" "#2" (1, 256) ; 00070000 +file io disk random [20:150] (1, 30) ; 00070500 +array zippy [0 : max (29, maxusers + maxusers + 1)] ; 00071500 +format zipper ("cc compile ", a1, a6, "/", a1, a6, " with ", 00072000 + a1, a6, " library; algol file card=", a1, a6, "/", a1, a6, 00072500 + "serial; algol file line=line/", a1, a6, "serial; end."), 00073000 + eoj ("{!good bye{!!!~"), 00073600 + noroom (x8, "sorry, full up.{!bye{!~"), 00073700 + userun (x8, "use:{!?? run ...~"), 00078600 + star ("*", x79), 00079000 + date (x6, a1, a6, "/", a1, a6, " listed at", i3, ":", i2, " on ", 00079300 + a6, "day ", o, " by ", a1, a6, x62), 00079400 + waitf ("wait...~"), 00085000 + rattle (x8, "<<<~"), 00087000 + teach1 ("{!the valid verbs are:~"), 00087500 + teach2 (7 (a1, a6, x2)), 00088000 + teach3 ("for syntax of a verb (e.g. tab), input: * teach", 00088500 + " verb. (e.g. * teach tab) *"), 00089000 + broken (x8, "{!breaks{!~") ; 00092000 +define onoff (onoff1) = (if onoff1 then " on " else " off ")# ; 00097100 +define xmax = 5# ; 00099600 +array xarray [0:maxuser, 0:xmax | 13 - 1] ; 00099700 +define 00099800 + xsub = xdex | 13#, 00099810 + xparameters [xparameters1] = xarray [user, xsub + xparameters1]#, 00099900 + xstart = xarray [user, xsub + 5]#, 00100000 + xlast = xarray [user, xsub + 6]#, 00100100 + xn = xarray [user, xsub + 7]#, 00100200 + xrepeat = xarray [user, xsub + 8]#, 00100300 + xprefix = xarray [user, xsub + 9]#, 00100400 + xsuffix = xarray [user, xsub + 10]#, 00100500 + xfiletype = xarray [user, xsub + 11]#, 00100600 + xnchrs = xarray [user, xsub + 12]# ; 00100700 +procedure program ; forward ; 00101000 +alpha procedure octdecimal (n, m, f) ; 00101100 +value n, f ; 00101200 +integer n, m, f ; 00101300 +begin 00101400 +alpha stream procedure octdecx (n, f, q, t) ; 00101500 +value f, q, t ; 00101600 + begin 00102500 +label exit ; 00102600 + di := loc octdecx ; 00103000 + si := n ; 00103100 + t (q (ds := f oct ; jump out 2 to exit) ; 00103200 + skip f db ; ds := set ; jump out to exit) ; 00103500 + q (f (si := si + 2 ; ds := 2 chr ; ds := lit "/" ; ds := 2 chr ; 00103600 + ds := lit "/" ; ds := 2 chr ; jump out 2 to exit) ; 00103700 + di := di + 7 ; ds := chr ; jump out to exit) ; 00103800 + ds := 8 dec ; 00104000 + f (di := di - 7 ; ds := 6 fill) ; 00104100 +exit: 00104200 + end octdecx; 00104300 + if f leq 1 then 00104400 + begin 00104500 + n := n ; 00104600 + octdecimal := octdecx (n, f, 0, 0) ; 00104700 + end else if f = 2 then 00104800 + octdecimal := octdecx (m, 0, 1, 0) 00104900 + else if f = 3 then 00104910 + octdecimal := octdecx (n, 1, 1, 0) 00104920 + else if f = 4 then 00104930 + octdecimal := octdecx (m, n, 1, 1) 00104940 + else 00105000 + octdecimal := octdecx (m, n:= 47 - n, 0, 1) ; 00105100 +end octdecimal ; 00105200 +define octdec (octdec1) = octdecimal (octdec1, m, 0)#, 00105300 + octdex (octdex1) = octdecimal (octdex1, m, 1)#, 00105400 + firstchar (firstchar1) = octdecimal (0, firstchar1, 2)#, 00105500 + mmddyy = octdecimal (time (5), m, 3)#, 00105600 + dec (dec1, dec2) = octdecimal (dec2, dec1, 4)#, 00105700 + two (two1) = boolean (octdecimal (two1, m, 5))# ; 00105800 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00120500 +define sequence = 00121000 + if algolfile then 00121500 + image [9] := octdec (if n = finity then 99999999 else n) 00122000 + else if cobolfile then 00122500 + begin 00123000 + image [0].[1:35] := octdec (n) ; 00124000 + image [9] := suffix & "."[1:43:5] ; 00124500 + end# ; 00125000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00126000 +procedure stationfix (station, i) ; 00126500 +value station, i ; 00126500 +real station ; 00126700 +integer i ; 00126800 +begin 00126900 +real x ; 00127000 + if i leq 4 then 00127100 + x := status (station, i) 00127200 + else if i leq 6 then 00127300 + release (station) 00127400 + else if i leq 8 then 00127500 + begin 00127600 + seek (twxinput (station)) ; 00127625 + x := status (station, 0) ; 00127650 + end 00127675 + else if i = 9 then 00127700 + begin 00127800 + write (twxoutput (station), noroom) ; 00127900 + release (station) ; 00128000 + end 00128100 + else if i = 10 then 00128200 + begin 00128300 + if boolean (status (station, 0)).[30:1] or 00128400 + usercodei neq status (station) then 00128500 + abnormalend := 1 ; 00128600 + end ; 00128700 +end stationfix ; 00128800 +define charge (charge1) = stationfix (charge1, 0)#, 00128900 + freefile (freefile1) = stationfix (freefile1, 3)#, 00129000 + unfreefile (unfreefile1) = stationfix (unfreefile1, 4)#, 00129100 + forget (forget1) = stationfix (forget1, 5)#, 00129200 + detach = stationfix (station, 6)#, 00129300 + attach = stationfix (station, 7)#, 00129400 + reattach = stationfix (station, 8)#, 00129500 + nomoreroom = stationfix (station, 9)#, 00129600 + check (check1) = stationfix (check1, 10)# ; 00129700 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00129800 +procedure output ; 00130000 + begin 00130200 +stream procedure move (s, d, w, c) ; value w, c ; 00130400 +begin 00130600 + si := s ; 00130800 + di := d ; 00131000 + ds := w wds ; 00131200 + ds := c chr ; 00131400 +end move ; 00131600 +integer user, 00131800 + t, 00132200 + spot ; 00132400 +boolean x ; 00132600 +label fakeout, 00132800 + next ; 00133000 +define a = input# ; 00133200 + charge (0) ; 00133400 + tankedoutput := false ; 00133600 + a [wdsperbuffer] := "~ " ; 00133800 + for user := 0 step 1 until bigbird do 00134000 + begin 00134200 + if counti geq 0 then 00134600 + begin 00134800 + if timei - timex gtr 180 then 00135000 + go to fakeout ; 00135200 + spot := headi ; 00135400 + if real ((x := boolean (status (stationi, 0)).[22:9]) 00135600 + and boolean ("6a")) neq 0 then 00135800 + begin 00136000 + if x.[39:1] then % busy 00136200 + begin 00136400 + t := 15 ; 00136600 + go to fakeout ; 00136800 + end ; 00137000 + if real (x and boolean (10)) neq 0 and not x then 00137200 + write (twxout, broken) ; % clear write ready 00137400 + if spot geq 0 then 00137600 + begin 00137800 + a [0] := freehead ; 00138000 + write (io [taili], 1, a [*]) ; 00138200 + freehead := spot ; 00138400 + end ; 00138600 + counti := xdex := -1 ; 00138800 + timei := 0 ; 00139000 + breaki := 1 ; 00139200 + moreinput := false ; 00139400 + go to next ; 00139600 + end ; 00139800 + if spot geq 0 then 00140000 + begin 00140200 + read (io [spot], 30, buff [*]) ; 00140400 + move (buff [block], a [1], 0, chrsperbuffer) ; 00140600 + write (twxout, wordsperbuffer, a [*]) [fakeout] ; 00140800 + t := chrsperbuffer ; 00141000 + if block := block + wdsperbuffer geq 29 then 00141200 + begin 00141400 + block := 1 ; 00141600 + a [0] := freehead ; 00141800 + write (io [spot], 1, a [*]) ; 00142000 + headi := buff[0] ; 00142200 + end ; 00142400 + end else 00142600 + begin 00143000 + move (buffer [1], a [1], 0, chrsperbuffer) ; 00143200 + write (twxout, wordsperbuffer, a [*]) [fakeout] ; 00143400 + if bloc := bloc - wdsperbuffer lss 1 then 00143600 + begin 00143800 + counti := -1 ; 00144000 + if abnormalend geq 2 then 00144200 + abnormalend := abnormalend + 1 ; 00144400 + go to next ; 00144600 + end ; 00144800 + t := chrsperbuffer ; 00145000 + move (buffer[wordsperbuffer],buffer[1],29-wordsperbuffer,0); 00145200 + end; 00145400 +fakeout: 00145600 + if timei:=max(timei,timex)+t|6 lss tn or not outputready then 00145800 + begin 00146000 + tn := timei ; 00146200 + tankedoutput := true ; 00146400 + end ; 00146600 +next: 00146800 + end ; 00147000 + end ; 00147200 + if outputready then 00147400 + nextclock := clock - t0 | (tn - timex - 90) / 150 00147600 + else 00147800 + nextclock := -99 ; 00148000 + charge (station) ; 00148200 + end output ; 00148400 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00148600 +procedure writetwx ; 00148800 + begin 00149200 +integer stream procedure count (s) ; 00149400 +begin 00149600 + si := s ; 00149800 + 28 (if sc = "~" then 00150000 + jump out ; 00150200 + tally := tally + 1 ; 00150400 + si := si + 1) ; 00150600 + s := si ; 00150800 + di := s ; 00151000 + ds := lit "~" ; 00151200 + count := tally ; 00151400 +end count ; 00151600 +stream procedure move (s, d, skps, skpd, n) ; 00151800 +value skps, skpd, n ; 00152000 +begin 00152200 + si := s ; 00152400 + di := d ; 00152600 + si := si + skps ; 00152800 + di := di + skpd ; 00153000 + ds := n chr ; 00153200 +end move ; 00153400 +integer c, j, k ; 00153600 +define a = pretank# ; 00153700 +label noskip, 00153800 + skip ; 00154000 + if boolean (ilfcri) then 00154200 + begin 00154400 + ilfcri := 0 ; 00154600 + if firstchar (a [0]) = "{" then 00154800 + j := 2 ; 00155000 + end ; 00155200 + if c := count (a) - j neq 0 and not boolean (breaki) then 00155400 + begin 00155600 + if k := counti lss 0 then 00155800 + begin 00156000 + buffer [4] := "~ " ; 00156200 + move ( a [0], buffer [1], j, 0, 28); 00156400 + if timei - timex geq 180 then 00156600 + go to noskip ; 00156800 + write (twxout, 5, buffer [*]) [noskip : noskip] ; 00157000 + timei := max (timei, timex) + c | 6 ; 00157200 + go to skip ; 00157400 +noskip: 00157600 + counti := c ; 00157800 + block := bloc := 1; 00158000 + headi := -1 ; 00158200 + if timei lss tn or not outputready then 00158400 + begin 00158600 + nextclock := clock - t0 | ((tn:=timei)-timex-120) / 150 ; 00158800 + tankedoutput := true ; 00159000 + end ; 00159200 + go to skip ; 00159400 + end ; 00159600 + if k lss chrsperbuffer then 00159800 + begin 00160000 + move (a, buffer [bloc], j, k, chrsperbuffer - k) ; 00160200 + j := j + chrsperbuffer - k ; 00160400 + if counti := k := k + c lss chrsperbuffer then 00160600 + go to skip ; 00160800 + c := k - chrsperbuffer ; 00161000 + end ; 00161200 + if bloc := bloc + wdsperbuffer geq 29 then 00161400 + begin 00161600 + bloc := 1 ; 00161800 + if freehead neq maxfreehead then 00162000 + begin 00162200 + read (io [freehead], 1, buffer [*]) ; 00162400 + k := buffer [0] ; 00162600 + end else 00162800 + k := maxfreehead := maxfreehead + 1 ; 00163000 + buffer [0] := -1 ; 00163200 + write (io [freehead], 1, buffer [*]) ; 00163400 + if headi geq 0 then 00163600 + begin 00163800 + read (io [taili], 30, buffer [*]) ; 00164000 + buffer [0] := freehead ; 00164200 + write (io [taili], 30, buffer [*]) ; 00164400 + end else 00164600 + headi := freehead ; 00164800 + taili := freehead ; 00165000 + freehead := k ; 00165200 + end ; 00165400 + move (a, buffer [bloc], j, 0, 29) ; 00165600 + counti := c ; 00165800 + end ; 00166000 +skip: 00166200 + end writetwx ; 00166400 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00170000 +define itsold (itsold1) = boolean (kount (itsold1, 0, 0))#, 00170010 + loc (loc1) = kount (loc1, 1, 0)# ; 00170020 +integer procedure kount (n, m, kk) ; 00170030 +value n, m, kk ; 00170040 +integer n, m, kk ; 00170050 + begin 00170060 +integer k ; 00170070 +real l ; 00170080 + while n lss (l := ll [at]).s do 00170090 + at := l.f ; 00170100 + while n gtr (l := ll [at]).s do 00170110 + at := l.t ; 00170120 + if kk neq 0 then 00170130 + begin 00170140 + if m = infinity then m := m - 1 ; 00170150 + while m geq (l := ll [at]).s and k := k + 1 neq kk do 00170160 + at := l.t ; 00170170 + kount := k - real (m lss l.s) ; 00170180 + end else 00170190 + if boolean (m) then 00170200 + kount := at 00170210 + else 00170220 + kount := real (n = l.s) ; 00170230 + end kount ; 00170240 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00170500 +define 00175000 + writesequence = writealine (0)#, 00175100 + writelfcr = writealine (1)#, 00175200 + writeseq = writealine (2)#, 00175300 + writequeued = writealine (5)#, 00175600 + writesegment = writealine (6)#, 00175700 + writereladdr = writealine (7)# ; 00175800 +procedure writealine (k) ; 00175900 +value k ; 00176000 +integer k ; 00176100 + begin 00176200 +stream procedure form (pretank, n, k, lfcr, colon, f) ; 00176300 +value n, k, lfcr, colon, f ; 00176400 +begin 00176500 +label exit ; 00176600 + di := pretank ; 00176700 + lfcr (ds := 2 lit "{!" ; 00176800 + k (si := loc n ; 00176900 + ds := k dec ; 00177000 + f (pretank := di ; 00177100 + di := di - k ; 00177200 + ds := k fill ; 00177300 + di := pretank) ; 00177400 + jump out) ; 00177500 + colon (ds := lit ":") ; 00177600 + jump out to exit) ; 00177700 + colon (si := loc n ; 00177800 + f (ds := 7 lit "queued(" ; 00177900 + ds := 2 dec ; 00178000 + ds := lit ")" ; 00178100 + jump out 2 to exit) ; 00178200 + k (ds := 9 lit "rel addr=" ; 00178300 + ds := 4 dec ; 00178400 + jump out 2 to exit) ; 00178500 + ds := 8 lit "segment=" ; 00178600 + ds := 4 dec ; 00178700 + jump out to exit) ; 00178900 + f (n (ds := lit " ") ; jump out to exit) ; 00178000 + ds := lit ">" ; 00179100 +exit: 00179200 + ds := lit "~" ; 00179300 +end form ; 00179400 +define xon = form (pretank, 0, 0, 0, 0, 0)#, 00179500 + tabit = form (pretank, i, 0, 0, 0, 1)#, 00179600 + lfcr = form (pretank, 0, 0, 1, 0, 0)#, 00179700 + colon = form (pretank, 0, 0, 1, 1, 0)#, 00179800 + seq = form (pretank, if n = infinity then 99999999 else n, 00179900 + if cobolfile then 6 else 8, 1, 00180000 + if cobolfile then 0 else 1, 1)#, 00180100 + oldseq = form (pretank, if n = infinity then 99999999 else n, 00180200 + if cobolfile then 6 else 8, 1, 00180300 + if cobolfile then 0 else 1, 1-real(itsold (n)))#, 00180400 + queform = form (pretank, readyqtop, 0, 0, 1, 1)#, 00180500 + segment = form (pretank, parameter2, 0, 0, 1, 0)#, 00180600 + reladdr = form (pretank, parameter3, 1, 0, 1, 0)#, 00180700 + twx (twx1) = begin twx1 ; writetwx ; end# ; 00180800 + if k = 0 then 00181000 + begin 00181100 + if fileopen then 00181200 + begin 00181300 + twx (oldseq) ; 00181400 + if inlinetog and extralfcr then 00181500 + twx (lfcr) ; 00181600 + if tabon and tabamount neq 0 then 00181700 + begin 00181800 + if i := tabamount gtr 27 then 00181900 + begin 00182000 + i := i - 27 ; 00182100 + twx (tabit) ; 00182200 + i := 27 ; 00182300 + end ; 00182400 + twx (tabit) ; 00182500 + end ; 00182600 + end 00182700 + else 00182800 + twx (colon) ; 00182900 + if xdex lss 0 and not errtog then 00183000 + twx (xon) 00183100 + else 00183200 + errtog := false ; 00183300 + end 00183400 + else if k = 1 then 00183500 + begin 00183600 + twx (lfcr) ; 00183700 + ilfcri := 1 ; 00183800 + end 00183900 + else 00184000 + twx (if k=2 then seq else if k=5 then queform else 00184100 + if k=6 then segment else if k=7 then reladdr) ; 00184200 + end writealine ; 00184300 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00198900 +procedure writerow (row, q, f) ; 00190500 +value q, 00191000 + f ; 00191500 +boolean q ; 00192000 +integer f ; 00192500 +array row [0] ; 00193000 + begin 00193500 +stream procedure move (s, d, skps, n) ; 00193600 +value skps, n ; 00193700 +begin 00193800 + si := s ; 00193900 + di := d ; 00194000 + si := si + skps ; 00194100 + ds := n chr ; 00194200 +end move ; 00194300 +stream procedure blankoutspecialcharacters (s, d, n, k) ; 00194400 +value n, 00150500 + k ; 00155600 + begin 00156000 + di := loc n ; ds := 6 lit "!><}{~" ; 00197500 + di := d ; 00198000 + ds := 8 lit " " ; 00198500 + si := d ; 00199000 + ds := 9 wds ; 00199500 + si := s ; 00200000 + di := d ; 00200500 + 2 (k (if sc = " " then 00201000 + begin 00201500 + n (si := si - 1 ; 00202000 + if sc = " " then 00202500 + di := di - 1 ; 00203000 + si := si + 1) ; 00203500 + ds := chr ; 00204000 + end else 00204500 + if sc = alpha then 00205000 + ds := chr 00205500 + else 00206000 + begin 00206500 + d := di ; 00207000 + di := loc n ; 00207500 + 6 (if sc = dc then jump out ; si := si - 1) ; 00208000 + di := d ; 00208500 + if toggle then 00209000 + ds := 1 lit "$" 00209500 + else 00210000 + ds := chr ; 00210500 + end)) ; 00211000 + end blankoutspecialcharacters ; 00219000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00219500 +boolean stream procedure allblank (s, skp, n) ; 00200000 +value skp, 00220500 + n ; 00221000 + begin 00221500 +label grpmkit ; 00222000 + si := s ; 00222500 + si := si + skp ; 00223000 + si := si + n ; 00223500 + n (si := si - 1 ; 00224000 + if sc neq " " then 00224500 + jump out to grpmkit) ; 00225000 + tally := 1 ; 00225500 + si := si - 1 ; 00226000 +grpmkit: 00226600 + si := si + 1 ; 00227000 + n := si ; 00227500 + di := n ; 00228000 + ds := 1 lit "~" ; 00228500 + allblank := tally ; 00229000 + end all blank ; 00229500 +boolean datum ; 00229600 +define fileinfo = f# ; 00229700 +integer z ; 00229800 + blankoutspecialcharacters (row, input, q, halffulllength) ; 00230000 + if datafile then 00230100 + begin 00230200 + move (input [9], zippy [15], 0, 8) ; 00230300 + datum := not allblank (zippy [15], 0, 8) ; 00230400 + end ; 00230500 + extralfcr := not (cobolfile or q:=allblank (input [z:=7], 7, 9)) ; 00231000 + if extralfcr or cobolfile then 00231500 + writelfcr ; 00232000 + if q then 00232500 + if q := allblank (input [7], 0, 7) then 00233000 + if q := allblank (input [z:=3], 4, 28) then 00233500 + q := allblank (input [z:=0], 0, 28) ; 00234000 + if not q then 00234500 + for f := 0 step 3 until z do 00235000 + begin 00235500 + move (input [f], pretank [0], 4 | f div 3, 28) ; 00236000 + writetwx ; 00236500 + end ; 00237000 + if datum then 00237050 + begin 00237100 + writelfcr ; 00237200 + move (zippy [15], pretank, 0, 9) ; 00237300 + writetwx ; 00237400 + end ; 00237450 + writelfcr ; 00237460 + end writerow ; 00237500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00237510 +procedure errorx (k, a, b) ; 00237512 +value k, 00237514 + a, 00237516 + b ; 00237518 +integer k ; 00237520 +real a, 00237522 + b ; 00237524 + begin 00237526 +stream procedure crunch (s, k, a, b) ; value k, a, b ; 00237528 +begin 00237530 +label e0, e1, e2, e3, e4, e5, e6, filename, crunch, deblank ; 00237532 + si := loc a ; 00237534 + si := si + 1 ; 00237536 + di := s ; 00237538 + ds := 2 lit "{!" ; 00237540 + ci := ci + k ; 00237542 + go to e0 ; 00237544 + go to e1 ; 00237546 + go to e2 ; 00237548 + go to e3 ; 00237550 + go to e4 ; 00237552 + go to e5 ; 00237554 + go to e6 ; 00237556 + go to e0 ; 00237558 + go to e0 ; 00237560 +e1: 00237562 + ds := 10 lit "inv user: " ; 00237564 + go to e6 ; 00237566 +e2: 00237568 + ds := 2 lit "no" ; 00237570 + go to filename ; 00237572 +e3: 00237574 + ds := 3 lit "bad" ; 00237576 + go to filename ; 00237578 +e5: 00237580 + ds := 8 lit "no file " ; 00237582 +e0: 00237584 + ds := 7 chr ; 00237586 + si := si + 1 ; 00237588 + ds := 7 chr ; 00237590 + go to crunch ; 00237592 +e4: 00237594 + ds := 3 lit "dup" ; 00237596 +filename: 00237598 + ds := 7 lit " file: " ; 00237600 +e6: 00237602 + ds := 7 chr ; 00237604 + ds := lit "/" ; 00237606 + si := si + 1 ; 00237608 + ds := 7 chr ; 00237610 +crunch: 00237612 + ds := lit "~" ; 00237614 + si := s ; 00237616 + di := s ; 00237618 + 28 (if sc = " " then 00237620 + begin 00237622 +deblank: 00237624 + si := si + 1 ; 00237626 + if sc = " " then 00237628 + go to deblank ; 00237630 + if sc = alpha then 00237632 + ds := 1 lit " " ; 00237634 + end else 00237636 + ds := chr) ; 00237638 +end crunch ; 00237640 + if a = "#000000" then a := " " ; 00237642 + if b = "#000000" then b := " " ; 00237644 + crunch (pretank, k, a, b) ; 00237646 + writetwx ; 00237648 + if k leq 6 then 00237650 + begin 00237652 + errtog := true ; 00237654 + moreinput := false ; 00237656 + nostar := false ; 00237658 + xdex := -1 ; 00237660 + end else if k = 8 then 00237662 + ilfcri := 1 ; 00237664 + end errorx ; 00237666 +define error (error1, error2, error3, error4) = 00237668 + begin 00237670 + errorx (error2, error3, error4) ; 00237672 + go to error1 ; 00237674 + end error#, 00237676 + show (show1, show2) = errorx (8, show1, show2)# ; 00237678 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00237700 +boolean procedure filecheck (b) ; 00237740 +value b ; 00237750 +boolean b ; 00237760 +begin 00237770 +label next ; 00237780 + if b then 00237790 + begin 00237800 + if fileclosed then 00237810 + error (next, 5, " open: ", parameter0) ; 00237820 + if b.[46:1] and readonlyfile then 00237830 + error (next, 0, "read on", "ly file") ; 00237840 + end else 00237850 + if fileopen then 00237860 + begin 00237870 + search (disc, input [*]) ; 00237880 + if input [0] lss fileaccess then 00237890 + begin 00237900 + charge (station) ; 00237905 + close (disc) ; 00237910 + fill disc with prefix, suffix ; 00237920 + search (disc, input [*]) ; 00237930 + if input [0] lss fileaccess then 00237940 + begin 00237950 + fileaccess := 0 ; 00237960 + inorder := true ; 00237970 + error (next, 1 + real (input [0] lss 0), prefix, suffix) ; 00237980 + end ; 00238000 + end ; 00238010 + end ; 00238020 + if false then 00238040 +next: 00238050 + filecheck := true ; 00238050 +end filecheck ; 00238060 +define opencheck = if filecheck (true) then go to next#, 00238070 + readonlycheck = if filecheck (boolean (3)) then go to next#, 00238080 + securitycheck = if filecheck (false) then go to next# ; 00238090 +procedure state (s) ; 00238100 +value s ; 00238200 +boolean s ; 00238300 + begin 00238400 +stream procedure stuffstate (n, record, p0, c) ; 00208500 +value n ; 00208600 + begin 00239000 +label exit ; 00239100 + n (di := c ; 00239200 + si := p0 ; 00239300 + ds := 25 wds ; 00239400 + si := record ; 00239600 + ds := 10 wds ; 00239700 + jump out to exit) ; 00240400 + si := c ; 00240500 + di := p0 ; 00240600 + ds := 25 wds ; 00240700 + di := record ; 00240900 + ds := 10 wds ; 00241000 +exit: 00241700 + end stuffstate ; 00246000 +integer i, k ; 00247500 + close (disc) ; 00248000 + k := if s.[46:1] then sloti else 46 ; 00248500 + if s then 00248600 + begin 00248700 + stuffstate (1, record, parameter0, controls [38]) ; 00250000 + write (r1 [k], 90, controls [*]) ; 00250600 + if s.[46:1] and fileopen and real (modified) neq 0 then 00251000 + begin 00251500 + k := d.leftside ; 00252000 + for i := 0 step 1 until k do 00252500 + begin 00253000 + if modified then 00253100 + write (r2 [32|sloti + i], 256, linklists [user32+i, *]) ; 00253200 + modified := modified.[16:31] ; 00253500 + end ; 00254000 + modified := false ; 00254100 + end ; 00254200 + end savestate else 00254500 + begin 00255500 + read (r1 [k], 90, controls [*]) ; 00256500 + stuffstate (0, record, parameter0, controls [38]) ; 00257500 + fill disc with prefix, suffix ; 00258500 + if s.[46:1] then 00259000 + modified := false ; 00259500 + user32 := user | 32 ; 00260000 + end restorestate ; 00260500 + prewhere := -1 ; 00261000 + end state ; 00262000 +define savestate = state (boolean(3))#, 00262500 + restorestate = state (boolean (2))#, 00263000 + unswapstate = state (false)#, 00263500 + swapstate = state (true)# ; 00264000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00264500 +define wait (wait1, wait2) = 00265000 + begin 00265100 + if not waiting then 00265150 + if waitx (wait1, wait2) then 00265200 + go to next ; 00265250 + end# ; 00265300 +boolean procedure waitx (tocks, forced) ; 00265500 +value tocks, 00265600 + forced ; 00265700 +integer tocks ; 00265800 +boolean forced ; 00265900 + begin 00266000 +define segment = #; 00266100 + if tocks geq clock or forced then 00266200 + if q then 00266300 + begin 00266400 + readyq [readyqtop := readyqtop + 1] := user ; 00266500 + inreadyq := 1 ; 00266600 + writequeued ; 00266700 + n := resetn ; 00266900 + if notfirstinput then 00267000 + savestate ; 00267100 + station := 0 ; 00267200 + waitx := true ; 00267300 + end else 00267400 + begin 00267500 + if forced.[46:1] then 00267600 + begin 00267700 + waitx := boolean (user := readyq [1]) ; 00267800 + charge (stationi) ; 00267900 + inreadyq := 0 ; 00268000 + for i := 2 step 1 until readyqtop do 00268100 + readyq [i - 1] := readyq [i] ; 00268200 + readyqtop := readyqtop - 1 ; 00268300 + restorestate ; 00268400 + read (io [user], 30, image [*]) ; 00268410 + end ; 00268500 + write (pretank [*], waitf ) ; 00268600 + writetwx ; 00268700 + waitflag := true ; 00268800 + readyq [0] := user ; 00268900 + end ; 00269300 + end waitx ; 00269400 +define interrupt (interrupt1) = interupt (interrupt1, 0, 0)#, 00282000 + interupt (interupt1, interupt2, interupt3) = 00282100 + begin 00282500 + if clock := clock - interupt1 leq nextclock then 00283000 + output ; 00283100 + if clock leq 0 then 00283200 + if interrupts (interupt2, interupt3) then 00283500 + go to next ; 00284000 + end# ; 00284500 +boolean procedure interrupts (lib, loc) ; 00285000 +value lib, loc ; 00285100 +integer lib, loc ; 00285200 +begin 00285500 +label newbird, none, next ; 00286000 + t0 := clock := max (50, t0 | 150 / (-t1 + t1 := timex)) ; 00286500 + if waiting then 00287000 + begin 00287500 + input [5] := 0 & "~"[1:43:5] ; 00288000 + read (twxinput (0, 0), 8, input [*]) [none] ; 00288500 + qinput := true ; 00289000 +newbird: 00289500 + swapstate ; 00290000 + close (library) ; 00290100 + charge (station := 0) ; 00290500 + inreadyq := 3 ; 00291000 + q := true ; 00291500 + program ; 00292000 + q := false ; 00292500 + user := readyq [0] ; 00293000 + charge (stationi) ; 00295500 + inreadyq := 0 ; 00296000 + unswapstate ; 00296500 + securitycheck ; 00297000 + if lib neq 0 then 00297100 + begin 00297200 + fill library with if boolean (lib) then parameter1 else prefix, 00297300 + if boolean (lib) then parameter2 else suffix ; 00297400 + read seek (library [loc]) ; 00297500 + end ; 00297600 +none: 00297700 + if rattleindex := rattleindex + 1 = 5 then 00298000 + begin 00298500 + for tink := 0 step 1 until readyqtop do 00299000 + begin 00299500 + user := readyq [tink] ; 00300000 + if counti lss 0 then 00300500 + if real (boolean (status (stationi, 0)).[22:9] and 00301000 + boolean ("6c")) = 0 then 00301100 + write (twxout, rattle) ; 00301500 + end ; 00302000 + user := readyq [rattleindex := 0] ; 00302500 + charge (station) ; 00302700 + if 2 | bigbird + 2 lss status (zippy [*]) then 00303000 + go to newbird ; 00303500 + if false then 00304000 +next: 00304500 + interrupts := true ; 00305000 + end ; 00305500 + end ; 00306000 + clock := t0 ; 00306100 + t1 := timex ; 00306200 + if outputready then 00306300 + nextclock := clock - t0 | (tn - t1 - 90) / 150 ; 00306400 +end interrupts ; 00307000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00318000 +integer procedure xfile (p, s, fs) ; 00318100 +value p, s, fs ; 00318110 +real p, s, fs ; 00318120 +begin 00318130 +define segment = # ; 00318140 + if p = 12 then 00318150 + begin 00318160 + if num1 then 00318170 + begin 00318180 + num1 := false ; 00318190 + p := parameter1 := octdec (parameter1) ; 00318200 + end else 00318210 + p := parameter1 ; 00318220 + if num2 then 00318230 + begin 00318240 + num2 := false ; 00318250 + s := parameter2 := octdec (parameter2) ; 00318260 + end else 00318270 + s := parameter2 ; 00318280 + end ; 00318290 + fill library with p, s ; 00318300 + search (library, input [*]) ; 00318310 + if xfile := input [0] lss fs then 00318320 + errorx (1 + real (input [0] lss 0), p, s) ; 00318330 +end xfile ; 00318350 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00318360 +procedure readin ; 00319000 + begin 00319100 +boolean procedure more ; 00319210 +begin 00319220 +label next, 00319230 + exit ; 00319240 +integer stream procedure trailingblanks (s, n) ; 00319250 +value n ; 00319260 +begin 00319270 +label done ; 00319280 + si := s ; 00319290 + si := si + 7 ; 00319300 + s := tally ; 00319310 + di := s ; 00319320 + 2 (n (if sc neq " " then jump out 2 to done ; 00319330 + si := si - 1 ; 00319340 + di := di + 8)) ; 00319350 +done: 00319360 + trailingblanks := di ; 00319370 +end trailingblanks ; 00319380 +integer xsub ; 00319390 +define fileinfo = xfiletype# ; 00319400 + if fileopen then 00319410 + begin 00319420 + if n gtr finity then 00319430 + if n := ll [last.f].s + inc gtr finity then 00319440 + begin 00319450 + n := finity ; 00319460 + error (next, 0, "seq. ov", "er-flow") ; 00319470 + end ; 00319480 + if n leq 0 then 00319490 + n := 1 ; 00319500 + end ; 00319510 + if moreinput then 00319520 + begin 00319530 + read (io [user + maxusers], 30, image [*]) ; 00319540 + chrs := nchrs ; 00319550 + go to exit ; 00319560 + end ; 00319570 + if xdex lss 0 then 00319580 + begin 00319590 +next: 00319600 + if not nostar then 00319610 + writesequence ; 00319620 + chrs := 0 ; 00319630 + savestate ; 00319640 + end else 00319650 + begin 00319660 + xsub := xdex | 13 ; 00319670 + while xn := xn + 1 gtr xlast do 00319680 + if xrepeat := xrepeat - 1 gtr 0 then 00319690 + xn := xstart 00319700 + else 00319710 + begin 00319720 + if xsuffix = "#macro#" then 00319730 + begin 00319740 + if xfile (xprefix, xsuffix, 7) lss 7 then 00319750 + go to next ; 00319760 + read (library) ; 00319770 + detach ; 00319780 + close (library, purge) ; 00319790 + end ; 00319800 + if boolean (xnchrs.[1:1]) then 00319810 + begin 00319820 + read (io [2|maxusers+xmax|user+xdex], 30, image [*]) ; 00319830 + chrs := abs (xnchrs) ; 00319840 + xdex := xdex - 1 ; 00319850 + go to exit ; 00319860 + end ; 00319870 + if xdex := xdex - 1 lss 0 then 00319880 + go to next ; 00318890 + xsub := xdex | 13 ; 00319900 + end ; 00319910 + if xfile (xprefix, xsuffix, 2) lss 2 then 00319920 + go to next ; 00319930 + if xecho then 00319940 + writesequence ; 00319950 + savestate ; 00319960 + interrupt (3) ; 00319970 + read (library [xn - 1], 10, image [*]) ; 00319980 + close (library) ; 00319990 + chrs := (i := fulllength) - 00320000 + trailingblanks (image [i.[41:4]-1], i.[41:6]) ; 00320010 + if xecho then 00320000 + writerow (image [*], false, xfiletype) ; 00320030 +exit: 00320040 + more := true ; 00320050 + end ; 00320060 +end more ; 00320070 +boolean stream procedure lineedit (s, d, c, chrs, p, over80, eighty1) ; 00321000 +value c, 00321100 + p, 00321200 + over80, 00321300 + eighty1 ; 00321400 + begin 00321500 +local t, 00321600 + percent1, percent ; 00321700 +label around, next ; 00321800 + p (di := loc percent ; ds := 14 lit "%?-~=!(<)>[{]}") ; 00321900 + si := loc c ; 00322000 + di := loc t ; 00322100 + si := si + 6 ; 00322200 + di := di + 7 ; 00322300 + ds := chr ; 00322400 + si := s ; 00322500 + di := d ; 00322600 + t (di := di + 32 ; di := di + 32) ; 00322700 + di := di + c ; 00322800 + 56(if sc = "~" then 00322900 + go to around ; 00323000 + if sc = "}" then% disconnect or exclamation 00323010 + begin 00323020 + tally := 1 ; 00323030 + go to around ; 00323040 + end ; 00323050 + if sc = "!" then% line erase 00323100 + begin 00323200 + c := tally ; 00323300 + over80 := tally ; 00323400 + di := d ; 00323500 + go to around ; 00323600 + end ; 00323700 + if sc = "{" then% backspace 00323800 + begin 00323900 + s := si ; 00324000 + t := di ; 00324100 + si := loc c ; 00324200 + di := loc lineedit ; 00324300 + if 8 sc neq dc then 00324400 + begin 00324500 + over80 (si := si - 8 ; 00324600 + di := loc eighty1 ; 00324700 + if 8 sc = dc then 00324800 + over80 := tally) ; 00324900 + si := c ; 00325000 + si := si - 8 ; 00325100 + c := si ; 00325200 + di := t ; 00325300 + di := di - 1 ; 00325400 + end else 00325500 + di := t ; 00325600 + si := s ; 00325700 +around: 00325800 + end else 00325900 + begin 00326500 + s := si ; 00326600 + over80 (di := di + 1 ; 00326700 + si := c ; 00326900 + si := si + 8 ; 00327000 + c := si ; 00327100 + si := s ; 00327200 + jump out to around) ; 00327300 + t := di ; 00327500 + p (di := s ; 00327600 + si := t ; 00327700 + si := si - 1 ; 00327800 + if sc = "%" then 00327900 + begin 00328000 + si := loc percent ; 00328100 + 7 (if sc = dc then 00328200 + begin 00328300 + di := t ; 00328400 + di := di - 1 ; 00328500 + ds := chr ; 00328600 + si := s ; 00328700 + jump out 2 to around ; 00328900 + end ; 00328000 + si := si + 1 ; 00329100 + di := di - 1) ; 00329200 + end) ; 00329300 + si := c ; 00330600 + si := si + 8 ; 00330700 + c := si ; 00330800 + si := loc c ; 00330900 + di := loc eighty1 ; 00331000 + if 8 sc = dc then 00331100 + begin 00331200 + tally := 1 ; 00331300 + over80 := tally ; 00331400 + tally := 0 ; 00331500 + end ; 00331600 + si := s ; 00331700 + di := t ; 00331800 + if toggle then 00331900 + di := di + 1 00332000 + else begin 00332100 + ds := chr ; 00332200 + si := si - 1 ; 00332300 + end ; 00332400 + go to next ; 00332500 + end ; 00332550 + if sc = "~" then jump out ; 00332560 + if sc = "}" then jump out ; 00332570 +next: 00332580 + si := si + 1) ; 00332600 + si := loc c ; 00332700 + di := chrs ; 00332800 + ds := wds ; 00332900 + lineedit := tally ; 00332100 +end lineedit ; 00333200 +boolean procedure finalanalysis ; 00333210 +begin 00333220 +stream procedure move (s, d, skps, skpd, n) ; 00333230 +value skps, skpd, n ; 00333240 + begin 00333250 +local t ; 00333260 + si := loc n ; 00333270 + di := loc t ; 00333280 + si := si + 6 ; 00333290 + di := di + 7 ; 00333300 + ds := chr ; 00333310 + si := s ; 00333320 + di := d ; 00333330 + si := si + skps ; 00333340 + di := di + skpd ; 00333350 + t (ds := 32 chr ; ds := 32 chr) ; 00333360 + ds := n chr ; 00333370 + end move ; 00333380 +integer stream procedure hunt (s, d, c, n) ; 00333390 +value c, 00333400 + n ; 00333500 + begin 00333600 +label again, 00333700 + xit ; 00333800 + si := d ; 00333900 + di := d ; 00334000 + ds := 8 lit " " ; 00334100 + ds := 9 wds ; 00334200 + d := tally ; 00334300 + di := loc d ; 00334400 + si := loc c ; 00334500 + si := si + 7 ; 00334600 + ds := chr ; 00334700 +again: 00334800 + si := loc n ; 00334900 + si := si + 1 ; 00335000 + if 7 sc = dc then 00335100 + go to xit ; 00335200 + si := n ; 00335300 + si := si - 8 ; 00335400 + n := si ; 00335500 + si := s ; 00335600 + di := loc d ; 00335700 + if sc = dc then 00335800 + go to xit ; 00335900 + s := si ; 00336000 + si := hunt ; 00336100 + si := si + 8 ; 00336200 + hunt := si ; 00336300 + go to again ; 00336400 +xit: 00336500 + end hunt ; 00336600 +boolean stream procedure more (image, input, c, chrs) ; 00344000 +value c ; 00344010 + begin 00344500 +local quotes, 00345000 + endquote, 00345500 + zero, 00345510 + temp ; 00346000 +label nothingyet, 00346500 + bump, 00347000 + foundquote, 00347500 + foundsemicolan, 00348000 + loop, 00348500 + xit, 00349000 + exit ; 00349100 + si := image ; 00349500 + di := loc quotes ; 00350000 + ds := 2 lit """ ; 00350500 + ds := 6 lit "..()[]" ; 00351000 + di := loc endquote ; 00351100 + ds := 2 lit ";;" ; 00351200 +loop: 00351300 + image := si ; 00351310 + si := loc c ; 00351330 + di := loc zero ; 00351340 + if 8 sc = dc then 00351350 + go to xit ; 00351360 + si := c ; 00351370 + si := si - 8 ; 00351380 + c := si ; 00351390 + si := image ; 00351400 + ci := ci + more ; 00351500 + go to nothingyet ; 00352000 + go to loop ; 00352500 + go to foundquote ; 00353000 +nothingyet: 00353500 + if sc = alpha then 00354000 + go to bump ; 00354500 + if sc = " " then 00355000 + go to bump ; 00355500 + di := loc quotes ; 00356000 + 4 (if sc = dc then 00356500 + begin 00359000 + temp := si ; 00359500 + endquote := di ; 00360000 + di := loc endquote ; 00360500 + si := endquote ; 00361000 + ds := 1 chr ; 00361500 + tally := 2 ; 00362000 + more := tally ; 00362500 + si := temp ; 00363000 + jump out to loop ; 00363500 + end ; 00364000 + si := si - 1 ; 00364100 + di := di + 1) ; 00364200 + if sc = ";" then 00365500 + go to foundsemicolan ; 00369000 +bump: 00371500 + si := si + 1 ; 00372000 + go to loop ; 00372500 +foundquote: 00374500 + di := loc endquote ; 00375000 + if sc = dc then 00375500 + begin 00376000 + di := di - 1 ; 00376100 + ds := lit ";" ; 00376200 + tally := 0 ; 00376500 + more := tally ; 00377000 + end ; 00377500 + go to loop ; 00378000 +xit: 00378500 + si := loc endquote ; 00378600 + di := image ; 00378700 + ds := 2 chr ; 00378800 + go to exit ; 00378900 +foundsemicolan: 00378910 + tally := 1 ; 00378920 + more := tally ; 00378930 + si := loc c ; 00378940 + di := chrs ; 00378950 + ds := wds ; 00378960 + si := loc c ; 00378970 + di := loc temp ; 00378980 + si := si + 6 ; 00378990 + di := di + 7 ; 00379000 + ds := chr ; 00379010 + si := image ; 00379020 + si := si + 1 ; 00379030 + di := input ; 00379040 + temp (ds := 32 chr ; ds := 32 chr) ; 00379050 + ds := chr ; 00379060 +exit: 00379070 + end more ; 00379500 +integer stream procedure fix (im, tab, c, z, p, q) ; 00380000 +value tab, 00380500 + c, 00381500 + p, 00381000 + q ; 00381100 + begin 00381200 +local t ; 00381500 + p (si := im ; 00382000 + if sc = "%" then 00382100 + begin 00382110 + si := si + 1 ; 00382120 + if sc = "*" then 00382130 + begin 00382140 + si := c ; 00382150 + si := si - 8 ; 00382180 + c := si ; 00382190 + tally := 1 ; 00382000 + fix := tally ; 00382210 + end ; 00382220 + end) ; 00382230 + si := z ; 00382240 + di := z ; 00383000 + ds := 8 lit " " ; 00383500 + ds := 9 wds ; 00384000 + si := loc c ; 00384100 + di := loc t ; 00384200 + si := si + 6 ; 00384300 + di := di + 7 ; 00384400 + ds := chr ; 00384500 + si := im ; 00384600 + si := si + fix ; 00384650 + di := z ; 00384700 + di := di + tab ; 00384800 + t (ds := 32 chr ; ds := 32 chr) ; 00384900 + ds := c chr ; 00385000 + si := z ; 00389000 + di := im ; 00389500 + ds := 10 wds ; 00390000 + q (di := im ; ds := 1 lit "0") ; 00390100 + end fix ; 00390500 +integer c, 00390505 + h, 00390508 + k ; 00390510 +label err, next ; 00390520 + nostar := (firstchar (image [0]) neq "*" or h := chrs = 0) 00390540 + and readwritefile ; 00390550 + notfirstinput := moreinput ; 00390560 + if nostar then 00390570 + begin 00390580 + i := if cobolfile then 6 else 0 ; 00390590 + if xdex geq 0 then if boolean (xfiletype) then i := 0 ; 00390595 + moreinput := false ; 00390600 + if h + tabamount gtr length then 00390610 + go to err ; 00390630 + h := h + tabamount + i - fix (image, tabamount + i, h, 00390640 + zippy, translating and h geq 2, i = 6) ; 00390650 + if columns then 00390660 + begin 00390670 + for k := 1 step 1 until colstops do 00390680 + if i := min (h, maxcolstop) neq 00390690 + c := hunt (image, zippy, character, i) then 00390700 + begin 00390710 + while c geq i := colstop [k] do 00390720 + k := k + 1 ; 00390730 + i := i - 1 ; 00390760 + move (image, zippy, 0, 0, c) ; 00390770 + if h := h + i - (c := c + 1) gtr fulllength then 00390780 + begin 00390785 +err: 00390790 + finalanalysis := true ; 00390795 + error (next, 0, "input ", "overflw") ; 00390800 + end ; 00390805 + move (image [c.[41:4]], zippy [i.[41:4]], c.[45:3], 00390810 + i.[45:3], h - i) ; 00390820 + move (zippy, image, 0, 0, 80) ; 00390840 + end else 00390850 + k := 5 ; 00390860 + end ; 00390870 + chrs := h ; 00390875 + if xdex lss 0 and not inlinetog and n := n+inc lss infinity then 00390880 + writesequence ; 00390910 + n := n - inc ; 00390920 + end 00391110 + else 00391120 + begin 00391130 + if h gtr 240 then 00391140 + go to err ; 00391150 + inlinetog := false ; 00391160 + moreinput := more (image, zippy, h, nchrs) ; 00391170 + if moreinput then 00391175 + write (io [user + maxusers], 30, zippy [*]) ; 00391180 + end ; 00391190 +next: 00391210 +end finalanalysis ; 00391230 +integer c, 00391240 + lastuser ; 00391250 +real x ; 00391260 +label again, 00392000 + inputfull, 00392500 + exit, 00394500 + next, 00394600 + escape ; 00394700 +integer procedure readtwx ; 00394800 +begin 00394900 +label none, trouble, exit ; 00395000 +real timeout, x ; 00395100 + input [5] := 0 & "~"[1:43:5] ; 00395200 + if not q then 00395300 + timeout := if outputready then max(0,min(15,(tn-timex-60)/60)) 00395400 + else 15 ; 00395500 + read (twxinput (0, timeout), 8, input [*]) [none:trouble] ; 00395600 + go to exit ; 00395700 +none: 00395800 + if q then 00395900 + begin 00396000 + user := maxusers ; 00396100 + readtwx := 1 ; % escape 00396200 + go to exit ; 00396300 + end ; 00396400 + if outputready then 00396500 + output ; 00396600 + t1 := timex ; 00396700 + for user := 0 step 1 until bigbird do 00396800 + begin 00396900 + check (stationi) ; 00397100 + if boolean (abnormalend) then 00397200 + begin 00397300 + readtwx := 1 ; 00397400 + go to exit ; 00397500 + end ; 00397600 + if x := (t1 - timei)/1000 lss 0 then 00397700 + x := x + 5184 ; 00397800 + if x gtr 15 and x lss 100 then 00397900 + begin 00398000 + if x lss 18 then 00398100 + firstchance := 0 00398200 + else if x geq 36 then 00398300 + begin 00398400 + write (pretank [*], eoj) ; 00398500 + writetwx ; 00398600 + abnormalend := readtwx := 1 ; 00398700 + go to exit ; 00398800 + end else if firstchance = 0 then 00398900 + begin 00399000 + firstchance := 1 ; 00399100 + x := timei ; 00399200 + errorx (7, "look ", "alive.") ; 00399300 + timei := x ; 00399400 + end ; 00399500 + end ; 00399600 + end ; 00399700 + readtwx := 2 ; 00399800 + go to exit ; 00399900 +trouble: 00400000 + read (twxinput (0, 0), 1, input [*]) ; 00400100 + input [1] := "}" ; 00400200 +exit: 00400300 +end readtwx ; 00400400 +procedure initialize ; 00406000 + begin 00407000 +monitor intovr, flag ; 00407500 +integer i, 00408000 + c ; 00408100 +real u ; 00408200 +boolean olduser ; 00408500 +define dirctry = controls# ; 00408600 +label old, 00409000 + fault, 00409500 + new, 00410000 + mailcall, 00410500 + next ; 00410600 + user := bigbird := bigbird + 1 ; 00420000 + attach ; 00421000 + stationi := station ; 00421500 + if usercodei := usercode = -1 then 00422500 + usercode := octdex (100|station.[9:4]+station.[14:4]) ; 00423000 + counti := -1 ; 00426000 + ilfcri := 1 ; 00426100 + errorx (7, "version", octdex (version)) ; 00427900 +fault: 00427910 + read (r1 [45], 90, dirctry [*]) ; 00427920 + if olduser then 00427930 + begin 00427940 + olduser := false ; 00427950 + i := c + c ; 00427960 + error (old, 0, "backup ", "error. ") ; 00427970 + end ; 00427980 + c := 200 ; 00428000 + for i := 0 step 2 while u := dirctry [i] neq 12 do 00428100 + if usercode = u then 00428200 + begin 00428300 + olduser := true ; 00428400 + if station = dirctry [i + 1] then 00428500 + go to old ; 00428600 + c := i ; 00428700 + end else 00428800 + if u = 0 and not olduser then 00428900 + c := i ; 00429000 + if c neq 200 then 00429100 + i := c 00429300 + else if i leq 88 then 00432500 + dirctry [i + 2] := 12 00433500 + else 00434500 + while dirctry [i := i - 2] lss 0 do ; 00435000 +old: 00436400 + c := sloti := i / 2 ; 00437800 + dirctry [i] := - usercode ; 00437500 + dirctry [i + 1] := station ; 00438000 + write (r1 [45], 90, dirctry [*]) ; 00438500 + if not olduser then 00438600 + go to new ; 00438700 + intovr := fault ; 00439500 + flag := fault ; 00440500 + restorestate ; 00441000 + station := stationi ; 00441500 + if vn lss 94 or vn gtr version then 00441800 + go to fault ; 00441900 + if fileclosed then 00443000 + go to mailcall ; 00444500 + if d gtr maxfilelength then 00445100 + go to fault ; 00445200 + read seek (r2 [32 | c]) ; 00445300 + securitycheck ; 00447000 + if input [5] + 2 lss d or input [3] neq 10 then 00450000 + error (mailcall, 3, prefix, suffix) ; 00452500 + at := d.leftside ; 00453000 + for i := 0 step 1 until at do 00453100 + read (r2, 256, linklists [user32 + i, *]) [fault] ; 00453200 + at := 0 ; 00453500 + for i := 1 step 1 until d do 00454000 + begin 00454100 + if at neq ll [at := ll [at] . t] . f then 00454500 + i := d 00454600 + else if at = 1 then 00455000 + error (next, 6, prefix, suffix) ; 00455100 + end ; 00456500 + error (mailcall, 7, "linklis", "t error") ; 00458500 +new: 00459500 + write (r2 [32 | c + 31], 1, image [*]) ; 00460000 + lock (r2) ; 00468200 + user32 := user | 32 ; 00460300 + bool := initialbool ; 00461000 + inc := 100 ; 00462500 + macrolibrary := "macro " ; 00462900 + character := "#" ; 00463000 + savefactor := 7 ; 00463500 + colstops := stringi := 0 ; 00465000 + fill rswd [*] with "execute", "ditto ", "copy ", "inline ", 00466000 + "zip ", "change ", "edit ", "save ", "reseq ", 00466500 + "punch ", "print ", "delete ", "close ", "compile", 00467000 + "column ", "scan ", "listing", "inc ", "tab ", 00467500 + "percent", "quick ", "list ", "open ", "mail ", 00468000 + "teach ", "remove ", "replace", "end " ; 00468500 +mailcall: 00469000 + fileaccess := 0 ; 00469100 + inorder := true ; 00469200 +next: 00469300 + translatei := real (translating) ; 00472100 + vn := version ; 00472200 + errorx (0, (if xfile ("mail % ", usercode, -1) = 7 then "mail % " 00489500 + else "hello ") & real (not olduser)[42:47:1], usercode) ; 00490000 + end initialize ; 00490500 + lastuser := maxusers ; 00490600 + if qinput then 00491000 + begin 00491100 + qinput := false ; 00491200 + go to inputfull ; 00491300 + end ; 00491400 + if station neq 0 then 00493200 + begin 00493400 + lastuser := user ; 00493410 +next: 00493500 + if more then 00494000 + go to exit ; 00494400 + end ; 00494600 + if not q and readyqtop gtr 0 then 00494700 + begin 00494800 + lastuser := real (waitx (0, boolean (3))) ; 00494900 + securitycheck ; 00495000 + go to exit ; 00495100 + end ; 00495200 +again: 00495300 + charge (0) ; 00495400 + if 2 | bigbird lss c := status (zippy [*]) - 2 then 00495500 + begin 00495600 + lastuser := bigbird + 1 ; 00495650 + for x := 0 step 2 until c do 00495700 + begin 00495800 + station := 0 & zippy [x] [9:9:9] ; 00495900 + for user := 0 step 1 until bigbird do 00496000 + if station = stationi then 00496100 + user := maxusers ; 00496200 + if user leq maxusers then 00496300 + begin 00496400 + if bigbird lss maxuser then 00496500 + begin 00496600 + usercode := zippy [x + 1] ; 00496700 + initialize ; 00496800 + go to next ; 00496900 + end ; 00497000 + nomoreroom ; 00497100 + end ; 00497300 + end ; 00497400 + end ; 00497500 + if x := readtwx neq 0 then 00497600 + begin 00497700 + if x = 2 then 00497800 + go to again ; 00497900 + go to escape ; 00498100 + end ; 00498300 +inputfull: 00506000 + x := input [0] ; 00506100 + user := 0 ; 00506500 + while stationi neq 0 & x[9:9:9] do 00507000 + if user := user + 1 gtr bigbird then 00507500 + go to again ; 00507600 + charge (x) ; 00508000 + if c := chrs neq 0 then 00508500 + read (io [user], 30, image [*]) ; 00509000 + breaki := 0 ; 00511000 + if lineedit (input [1], image, c, c, 00512000 + translatei, c gtr 240, 241) then 00512100 + error (again, 7, "del{!~ ", chrs := 0) ; 00512300 + if boolean (x.[25:1]) then 00512500 + begin 00512600 + if firstchar (input [5]) = "~" then 00513000 + c := c - 4 ; 00513500 + chrs := c ; 00513700 + write (io [user], 30, image [*]) ; 00514000 + go to again ; 00520000 + end ; 00520500 + if boolean (inreadyq) then 00520600 + error (again, 7, "please ", "wait...") ; 00520700 + writelfcr ; 00520800 + chrs := c ; 00520810 + clock := t0 ; 00520850 + t1 := timex ; 00520900 + if outputready then 00520950 + nextclock := clock - t0 | (tn - t1 - 90) / 150 ; 00520960 + if lastuser neq lastuser := user then 00522000 + restorestate ; 00522500 + securitycheck ; 00522600 + waitflag := false ; 00522700 +exit: 00532000 + if finalanalysis then 00532500 + go to next ; 00533500 + if outputready then 00533600 + if tn - 60 leq timex then 00533700 + output ; 00533800 +escape: 00534500 + end readin ; 00546500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00547000 +define rdisc (rdisc1, rdisc2) = 00547100 + if rdiscx (rdisc1, rdisc2) then go to next# ; 00547200 +boolean procedure rdiscx (where, image) ; 00547500 +value where ; 00548800 +integer where ; 00548500 +array image [0] ; 00549000 + begin 00549500 +label eof ; 00549600 +stream procedure zot (d) ; 00549710 +begin 00549720 + di := d ; 00549730 + ds := reset ; 00549740 +end zot ; 00549750 + if prewhere + 1 neq prewhere := abs (where) - 2 then 00550000 + read seek (disc [prewhere]) ; 00550500 + read (disc, 10, image [*]) [eof] ; 00551000 + if cobolfile then 00551010 + zot (image) ; 00551020 + if where lss 0 then 00551030 + sequence ; 00551040 + if false then 00551100 + begin 00551150 +eof: 00551200 + errorx (5, "at seq#", octdex (n)) ; 00551250 + rdiscx := true ; 00551350 + prewhere := -2 ; 00551400 + end ; 00551450 + end rdisc ; 00551500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00552000 +define writeat = 00552500 + if writeatx (quick, -n, record) then 00552800 + go to next# ; 00552900 +boolean procedure writeatx (quick, nn, record) ; 00553000 +value quick, nn ; 00553100 +boolean quick ; 00553200 +integer nn ; 00553300 +array record [0] ; 00553400 + begin 00554000 +label next ; 00554100 + n := abs (nn) ; 00555500 + if not cobolfile then 00556000 + writeseq ; 00556500 + if nn lss 0 then 00556600 + rdisc (at, record) ; 00557000 + if cobolfile then 00557500 + record [0].[1:35] := octdec (n) ; 00558000 + writerow (record, quick, fileinfo) ; 00558500 + if boolean (breaki) then 00559600 +next: 00559700 + writeatx := true ; 00559800 + end writeax ; 00560000 +define writeme (writeme1, writeme2) = 00560100 + if writeatx (quick, writeme1, writeme2) then 00560200 + go to next# ; 00560300 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00560500 +boolean procedure toggle (oldvalue, i) ; 00561000 +value oldvalue, 00561500 + i ; 00562000 +boolean oldvalue ; 00562500 +real i ; 00563000 +begin 00563500 +label next ; 00564000 + if i = 3 then 00564100 + begin 00564110 + if real (oldvalue) = "algol " then 00564120 + toggle := boolean (algol) 00564130 + else if real (oldvalue) = "xalgol " then 00564140 + toggle := boolean (xalgol) 00564150 + else if real (oldvalue) = "data " then 00564160 + toggle := boolean (data) 00564170 + else if real (oldvalue) = "fortran" then 00564180 + toggle := boolean (fortran) 00564190 + else if real (oldvalue) = "cobol " then 00564200 + toggle := boolean (cobol) 00564210 + else if real (oldvalue) = "basic " then 00564220 + toggle := boolean (basic) ; 00564230 + go to next ; 00564240 + end ; 00564250 + if (if i = 1 then empty1 else empty2) then 00564500 + error (next, 7, parameter0, onoff (toggle := oldvalue)) ; 00565000 + i := if i = 1 then parameter1 else parameter2 ; 00565100 + if not (toggle := i = "on ") then 00565500 + if i neq "off " then 00566000 + errorx (0, "missing", " on/off") ; 00566500 +next: 00567000 +end toggle ; 00567500 +define filetype (filetype1) = real (toggle (boolean (filetype1), 3))# ; 00567600 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00568200 +boolean procedure verifax (xerox, dd) ; 00680000 +value xerox, dd ; 00680500 +integer xerox, 00681000 + dd ; 00681100 + begin 00681500 +define 00681600 + printing = xerox = 2#, 00681700 + punching = xerox = 4#, 00681800 + zipping = xerox = 8# ; 00681900 +file copy disk serial [20:dd] (2, 10, 150, save savefactor) ; 00682000 +boolean b ; 00683500 +real l ; 00684000 +label next ; 00684500 + xlocked := true ; 00687000 + if boolean (xerox) then 00687500 + begin 00688000 + fill copy with prefix, suffix, *, *, *, 12 ; 00689000 + l := first ; 00691000 + while at := l.t neq 1 do 00692100 + begin 00692500 + n := (l := ll [at]).s ; 00693300 + rdisc (-at, zippy) ; 00693500 + write (copy, 10, zippy [*]) ; 00695500 + interrupt (1) ; 00696000 + end ; 00696500 + read (disc [0]) ; 00697500 + detach ; 00690800 + close (disc, purge) ; 00698500 + lock (copy) ; 00699500 + reattach ; 00700000 + inorder := true ; 00702500 + fileaccess := 0 ; 00705500 + savestate ; 00706000 + end xerox 00706500 + else 00707000 + begin 00708000 + fill copy with parameter1, parameter2, *, *, *, 00709000 + if printing then 15 else if punching then 22 else 12 ; 00709500 + if printing then 00713000 + begin 00713500 + write (zippy [*], date, prefix.[6:6], prefix, 00714000 + suffix.[6:6], suffix, (l := time (1)) div 216000, 00714500 + l div 3600 mod 60, time (6), mmddyy, 00715000 + usercode.[6:6], usercode) ; 00715500 + detach ; 00716000 + write (copy [dbl], 17, zippy [*]) ; 00716500 + reattach ; 00719000 + end ; 00720000 + l := n ; 00720500 + dd := m := 0 ; 00721000 + b := printing and parameter2 = "double " ; 00721100 + while n := ll [dd := ll [dd].t].s leq parameter4 do 00721500 + if parameter3 leq n then 00722000 + begin 00723000 + rdisc (dd & (real (not zipping))[1:47:1], zippy) ; 00723500 + if printing then 00724000 + zippy [14] := octdex (m := m + 1) & "#"[1:43:5] ; 00724500 + if b then 00726000 + write (copy [dbl], 17, zippy [*]) 00726500 + else write (copy, 17, zippy [*]) ; 00727000 + interrupt (1) ; 00727500 + end 00728000 + else m := m + 1 ; 00728500 + if zipping then 00729000 + zip with copy ; 00729500 + lock (copy) ; 00730000 + n := l ; 00730500 + end thermofax ; 00731000 + if false then 00731100 +next: 00731200 + verifax := true ; 00731300 + xlocked := false ; 00731400 + end verifax ; 00731500 +define thermofax (thermofax1, thermofax2) = 00731600 + begin 00731650 + wait (kount (parameter3, parameter4, clock), xlocked) ; 00731700 + if verifax (thermofax1, thermofax2) then 00731750 + go to next ; 00731800 + end#, 00731850 + createfile (createfile1) = 00731900 + begin 00731950 + library.areas := 20 ; 00732000 + library.areasize := createfile1 ; 00732010 + library.save := savefactor ; 00732020 + write (library, 10, record [*]) ; 00732030 + lock (library) ; 00732040 + library.areasize := 0 ; 00732050 + library.areas := 0 ; 00732060 + end#, 00732100 + closemyfile = 00732150 + begin 00732200 + if not inorder then 00732250 + begin 00732300 + wait (kount (1, finity, clock), xlocked) ; 00732350 + if verifax (17, (d + 14) div 15 | 15) then 00732400 + go to next ; 00732450 + end else 00732500 + begin 00732550 + fileaccess := 0 ; 00732600 + close (disc) ; 00732650 + end ; 00732700 + end# ; 00732750 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00733000 +define wdisc = if wdiscx (image) then go to next# ; 00733500 +boolean procedure wdiscx (image) ; 00734000 +array image [0] ; 00734500 + begin 00735000 +real l ; 00735100 +label eot, 00735500 + next ; 00735600 + while n gtr (l := ll [at]).s do 00743500 + at := l.t ; 00744000 + while n lss (l := ll [at]).s do 00744500 + at := l.f ; 00745000 + if n neq l.s then 00745500 + begin 00746000 + if d geq maxfilelength then 00746500 + error (next, 0, "file to", " long. ") ; 00747000 + if prewhere neq prewhere := d - 2 then 00747100 + read seek (disc [prewhere + 1]) ; 00747200 + l := ll [d := d + 1] := (l.t) & n [sf] & at [ff] ; 00747500 + modify (d) ; 00748000 + ll [at] . t := d ; 00748500 + modify (at) ; 00748600 + at := l.t ; 00749000 + if at neq 1 then 00749500 + inorder := false ; 00750000 + ll [at] .f := d ; 00750500 + modify (at) ; 00750600 + at := d ; 00751000 + end ; 00751500 + sequence ; 00752000 + if prewhere + 1 neq prewhere := at - 2 then 00752500 + write (disc [prewhere], 10, image [*]) 00753000 + else write (disc, 10, image[*]) [eot] ; 00753500 + n := n + inc ; 00753510 + if false then 00753600 + begin 00753610 +eot: 00753620 + ll [l.f] . t := at := l.t ; 00753630 + ll [at] . f := l.f ; 00753640 + d := d - 1 ; 00753650 + inorder := false ; 00753660 + show ("file ", "full. ") ; 00753670 + errorx (0, "please ", "reopen.") ; 00753690 +next: 00753700 + wdiscx := true ; 00753800 + end ; 00753900 + end wdisc ; 00754000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00754500 +integer procedure getparameters (n) ; value n ; integer n ; 00754600 + begin 00754650 +integer stream procedure star (s, d, e) ; value e ; 00754700 + begin 00754750 +local n, 00754800 + plus, 00754850 + minus, 00754900 + crosshatch, 00754950 + k ; 00755000 +label deblank, 00755050 + nalpha, 00755100 + blank, 00755150 + numalpha, 00755200 + getrepeat ; 00755250 + si := s ; 00755300 + si := si - 1 ; 00755350 + di := d ; 00755400 + 5 (ds := 8 lit "+#000000") ; 00755450 + di := d ; 00755500 + e (if sc = "(" then jump out ; 00755550 + if sc = "@" then jump out to getrepeat ; 00755600 + if sc = ";" then jump out to getrepeat ; 00755650 + si := si + 1) ; 00755700 + 5 (tally := 0 ; 00755750 + k := tally ; 00755800 + plus := tally ; 00755850 + minus := tally ; 00755900 + crosshatch := tally ; 00755950 + tally := 1 ; 00756000 +deblank: 00756050 + si := si + 1 ; 00756100 + if sc = " " then 00756150 + go to deblank ; 00756200 + if sc = alpha then 00756250 + tally := 0 00756300 + else 00756350 + begin 00756400 + if sc = ";" then 00756450 + jump out to getrepeat ; 00756500 + if sc = """ then 00756550 + jump out to getrepeat ; 00756600 + if sc = "(" then 00756650 + jump out to getrepeat ; 00756700 + if sc = "[" then 00756750 + jump out to getrepeat ; 00756800 + if sc = "." then 00756850 + jump out to getrepeat ; 00756900 + if sc = "@" then 00757950 + jump out to getrepeat ; 00757000 + if sc = "/" then 00757050 + k := tally 00757100 + else if sc = "+" then 00757150 + plus := tally 00757200 + else if sc = "#" then 00757250 + crosshatch := tally 00757300 + else if sc = "-" then 00757350 + minus := tally ; 00757400 + go to deblank ; 00757450 + end ; 00757500 + if sc geq "0" then 00757550 + begin 00757600 + k (jump out to nalpha) ; 00757650 + k := si ; 00757700 + 8 (if sc lss "0" then 00757750 + jump out ; 00757800 + tally := tally + 1 ; 00757850 + si := si + 1) ; 00757900 + n := tally ; 00757950 + if toggle then 00758000 + begin 00758050 + if sc = alpha then 00758100 + go to numalpha ; 00758150 +blank: 00758200 + if sc = " " then 00758250 + begin 00758300 + si := si + 1 ; 00758350 + go to blank ; 00758400 + end ; 00758450 + if sc = "/" then 00758500 + begin 00758550 +numalpha: 00758600 + si := k ; 00758650 + go to nalpha ; 00758700 + end ; 00758750 + end ; 00758800 + si := k ; 00758850 + ds := n oct ; 00758900 + end 00758950 + else 00759000 + begin 00759050 +nalpha: 00759100 + ds := 1 lit "+" ; 00759150 + 7 (if sc = alpha then 00759200 + ds := 1 chr 00759250 + else ds := 1 lit " ") ; 00759300 + end ; 00759350 + di := di - 8 ; 00759400 + skip 2 db ; 00759450 + ds := plus set ; 00759500 + di := di - 1 ; 00759550 + skip 3 db ; 00759600 + ds := minus set ; 00759650 + di := di - 1 ; 00759700 + skip 3 db ; 00759750 + ds := crosshatch set ; 00759800 + di := di + 7 ; 00759850 + si := si - 1) ; 00759900 +getrepeat: 00759910 + e (if sc = ")" then jump out ; 00749950 + if sc = ";" then jump out ; 00760000 + if sc = "@" then jump out ; 00760050 + si := si + 1) ; 00760100 + e (di := loc star ; 00760200 + ds := 8 lit "00000001" ; 00760250 + di := di - 8 ; 00760300 + 10 (if sc = ";" then jump out ; 00760350 + if sc geq "0" then 00760400 + begin 00760450 + tally := 1 ; 00760500 + 3 (si := si + 1 ; 00760550 + if sc lss "0" then jump out ; 00760600 + tally := tally + 1) ; 00760650 + k := tally ; 00760700 + si := si - k ; 00760750 + ds := k oct ; 00760800 + jump out ; 00760850 + end ; 00760900 + si := si + 1) ; 00760950 + jump out) ; 00761000 +end star ; 00761050 +define xsub = (xdex + 1) | 13# ; 00761100 + if n = 0 then 00761150 + getparameters := star (image, parameter0, 0) 00761200 + else 00761250 + getparameters := star (image, xparameters [0], 63) ; 00761300 +end get parameters ; 00761350 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00761400 +integer procedure verb ; 00763900 +begin 00764000 +boolean procedure number (n, c) ; 00764100 +integer n ; 00764300 +real c ; 00764400 + begin 00764500 +integer xdexx ; 00764510 +label zero ; 00764520 + if xdex geq 0 then 00764530 + begin 00764540 + xdexx := xdex + 1 ; 00764550 + while boolean (c.[4:1]) and xdexx := xdexx - 1 geq 0 do 00764560 + c := xarray [user, xdexx|13 + abs (c&0[1:44:4]-1) mod 5] ; 00764570 + end ; 00764580 + c.[4:1] := 0 ; 00764600 + if number := (not boolean (c.[1:1])) & (c = -"#000000")[46:47:1] then 00764610 + begin 00764620 + if c . [2:2] neq 0 and fileopen then 00764700 + begin 00764800 + c . [1:3] := c . [3:3] ; 00764900 + if c = 0 then 00765100 + begin 00765200 + c := n ; 00765300 + go to zero ; 00765400 + end ; 00765500 + if not (itsold (n) or boolean (c . [1:1])) then 00765600 + c := c - 1 ; 00765700 + for n := 1 - c step 1 until 0 do 00765800 + if at := ll [at] . t = 1 then 00765900 + begin 00766000 + n := 0 ; 00766100 + at := last . f ; 00766200 + end ; 00766300 + for n := c + 1 step 1 until 0 do 00766400 + if at := ll [at] .f = 0 then 00766500 + begin 00766600 + n := 0 ; 00766700 + at := first . t ; 00766800 + end ; 00766900 + c := ll [at] . s ; 00767000 + end else c.[2:2] := 0 ; 00767100 +zero: 00767200 + c := min (finity, max (1, n := c)) ; 00767300 + end else 00767310 + c.[1:3] := 0 ; 00767320 + end number ; 00767400 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00767500 +integer stream procedure inlineedit (s, d, t, c, n, bidr, initial) ; 00767600 +value initial, 00767700 + c, 00767800 + n, 00767900 + bidr ; 00768000 + begin 00768100 +label search, 00768200 + insert, 00768300 + delete, 00768400 + replace, 00768500 + wrapup, 00768600 + loop, 00768700 + error1, 00768710 + here, 00768720 + there, 00768730 + idr, 00768800 + xit ; 00768900 + bidr (si := s ; si := si + 6 ; s := si ; 00769000 + si := d ; si := si + 6 ; d := si ; 00769100 + di := t ; ds := 6 lit "0" ; t := di ; 00769200 + si := c ; si := si - 48 ; c := si) ; 00769300 + di := loc bidr ; 00769400 + ds := 4 lit " idr" ; 00769500 + di := t ; 00769600 + si := t ; 00769700 + ds := 8 lit " " ; 00769800 + ds := 9 wds ; 00769900 + 2 (n (ci := ci + initial ; 00770400 + go to search ; 00770500 + go to idr ; 00770600 + go to idr ; 00770700 + go to idr ; 00770800 + go to wrapup ; 00770900 +search: 00771000 + si := loc c ; 00771100 + si := si + 6 ; 00771200 + di := loc n ; 00771300 + if 2 sc = dc then 00771400 + go to error1 ; 00771500 + si := c ; 00771900 + si := si - 8 ; 00772000 + c := si ; 00772100 + si := d ; 00772200 + di := t ; 00772300 + ds := 1 chr ; 00772400 + d := si ; 00772500 + t := di ; 00772600 + si := s ; 00772700 + di := loc bidr ; 00772800 + 4 (if sc = dc then 00772900 + jump out ; 00773000 + si := si - 1 ; 00773100 + tally := tally + 1) ; 00773200 + if toggle then 00773300 + else 00773400 + begin 00773500 +error1: 00773510 + tally := 1 ; 00773600 + jump out 2 to here ; 00773700 + end ; 00773800 + initial := tally ; 00773900 + tally := 0 ; 00773000 + s := si ; 00774100 + go to loop ; 00774200 +idr: 00774300 + si := loc c ; 00774400 + si := si + 6 ; 00774500 + di := loc n ; 00774600 + if 2 sc = dc then 00774700 + begin 00774800 + si := d ; 00774900 + di := t ; 00775000 + tally := 4 ; 00775100 + initial := tally ; 00775200 +wrapup: 00775300 + ds := 1 chr ; 00775400 + go to loop ; 00775500 + end ; 00775600 + si := c ; 00775700 + si := si - 8 ; 00775800 + c := si ; 00775900 + si := s ; 00776000 + ci := ci + initial ; 00776100 + go to wrapup ; 00776200 + go to insert ; 00776300 + go to delete ; 00776400 + go to replace ; 00776500 +insert: 00776600 + di := t ; 00776700 + ds := 1 chr ; 00776800 + s := si ; 00776900 + t := di ; 00777000 + di := inlineedit ; 00777100 + di := di + 8 ; 00777200 + inlineedit := di ; 00777300 + go to loop ; 00777400 +delete: 00777500 + di := d ; 00777600 + di := di + 1 ; 00777700 + d := di ; 00777800 + si := si + 1 ; 00777900 + s := si ; 00778000 + go to loop ; 00778100 +replace: 00778200 + di := t ; 00778300 + ds := 1 chr ; 00778400 + s := si ; 00778500 + t := di ; 00778600 + si := d ; 00778700 + si := si + 1 ; 00778800 + d := si ; 00778900 +loop: 00779000 + )) ; 00779100 + go to there ; 00779110 +here: 00779120 + go to xit ; 00779130 +there: 00779140 + tally := 0 ; 00779200 + s := si ; 00779300 + si := loc inlineedit ; 00779400 + di := loc bidr ; 00779500 + si := si + 6 ; 00779600 + di := di + 7 ; 00779700 + ds := 1 chr ; 00779800 + si := s ; 00779900 + bidr (2 (32 (if sc neq " " then 00780000 + begin 00780100 + tally := 2 ; 00780200 + jump out 3 to xit ; 00780300 + end ; 00780400 + si := si + 1))) ; 00780500 + inlineedit (if sc neq " " then 00780600 + begin 00780700 + tally := 2 ; 00780800 + jump out 1 to xit ; 00780900 + end ; 00781000 + si := si + 1) ; 00781100 +xit: 00781200 + inlineedit := tally ; 00781300 + end inline ; 00781400 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00781500 +label next, 00786000 + verbexit ; 00786110 +define quick = false# ; 00886100 +next: 00806500 + readin ; 00807000 + if boolean (abnormalend) or user = maxusers then 00807500 + begin 00808000 + verb := rswdm + real (user = maxusers) ; 00809000 + go to verbexit ; 00809500 + end ; 00810000 + if inlinetog then 00811000 + begin 00811500 + inlinetog := false ; 00811600 + if m := inlineedit (image, record, zippy, chrs, 00813000 + halflength, fileinfo = cobol, m) = 0 then 00813500 + begin 00814000 + if inlineecho eqv temptog then 00814100 + writeme (n, zippy) ; 00814200 + if wdiscx (zippy) then ; 00814500 + nostar := false ; 00815000 + go to next ; 00815200 + end ; 00815500 + if m = 2 then 00816000 + error (next, 0, parameter0, " ovrflw") ; 00816100 + error (next, 0, "needs i", ",r or d") ; 00816500 + end ; 00817500 + if nostar then 00818000 + begin 00818500 + if wdiscx (image) then ; 00822500 + go to next ; 00826000 + end ; 00826500 + write (io [user], 30, image [*]) ; 00827000 + i := getparameters (0) ; 00828000 + temptog := parameter0.[2:2] = 0 ; 00828100 + if number (n, parameter0) then 00837000 + begin 00837100 + if fileclosed then 00837500 + error (next, 5, " open:", octdex (parameter0)) ; 00838000 + if not moreinput and itsold (n := parameter0) then 00838500 + writeat ; 00838600 + go to next ; 00839000 + end ; 00839500 + m := resetn := n ; 00839700 + for i := 0 step 1 until rswdm do 00840000 + if parameter0 = rswd [i] then 00840500 + begin 00840600 + relativenumber := parameter1; 00840605 + num1 := number (m, parameter1) ; 00840610 + num2 := number (m, parameter2) ; 00840620 + num3 := number (m, parameter3) ; 00840630 + num4 := number (m, parameter4) ; 00840640 + verb := i ; 00840700 + go to verbexit ; 00841000 + end ; 00841010 + if i := xfile (parameter0, macrolibrary, -1) lss 2 00841100 + and macrolibrary neq "macro " then 00841200 + i := xfile (parameter0, "macro ", -1) ; 00841220 + if i lss 2 or input [3] neq 10 then 00841300 + begin 00841320 + show (parameter0, " invali") ; 00841360 + error (next, 0, "d:* ", rwteach) ; 00841400 + end ; 00841500 +verbexit: 00844500 + end ; 00845000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00846000 +define quicklist = listit (1)#, 00850000 + scan = listit(2)#, 00850100 + change = listit(4)#, 00850200 + edit = listit(8)# ; 00850300 +procedure listit (listtype) ; value listtype ; integer listtype ; 00850400 + begin 00850500 +label next ; 00850600 +define quick = boolean (listtype) and true#, 00850700 + scantog = listtype = 2#, 00850800 + changetog = listtype = 4#, 00850900 + edittog = listtype = 8#, 00851000 + posting = listtype geq 16# ; 00851100 +boolean procedure stringfound ; 00851110 +begin 00851120 +boolean stream procedure present (s, r, i, sr, t, id, k) ; 00851200 +value i, 00851300 + sr, 00851400 + id, 00851500 + k, 00851600 + t ; 00851700 + begin 00851800 +label xit ; 00851900 + si := s ; 00852000 + si := si + k ; 00852100 + s := si ; 00852200 + si := loc sr ; 00852300 + di := loc k ; 00852400 + si := si + 6 ; 00852500 + di := di + 7 ; 00852600 + ds := chr ; 00852700 + di := r ; 00852800 + k (di := di + 32 ; di := di + 32) ; 00852900 + di := di + sr ; 00853000 + r := di ; 00853100 + tally := 1 ; 00853200 + si := loc t ; 00853300 + di := loc k ; 00853400 + si := si + 6 ; 00853500 + di := di + 7 ; 00853600 + ds := 1 chr ; 00853700 + di := r ; 00853800 + k (2 (32 ( 00853900 + si := s ; 00854000 + if i sc = dc then 00854100 + begin 00854200 + id (jump out 4 to xit) ; 00854300 + r := di ; 00854400 + si := r ; 00854500 + if sc = alpha then else 00854600 + begin 00854700 + si := si - i ; 00854800 + si := si - 1 ; 00854900 + if sc = alpha then else 00855000 + jump out 3 to xit ; 00855100 + end ; 00855200 + end ; 00855300 + di := di - i ; 00855400 + di := di + 1))) ; 00855500 + t ( 00855600 + si := s ; 00855700 + if i sc = dc then 00855800 + begin 00855900 + id (jump out 2 to xit) ; 00856000 + r := di ; 00856100 + si := r ; 00856200 + if sc = alpha then else 00856300 + begin 00856400 + si := si - i ; 00856500 + si := si - 1 ; 00856600 + if sc = alpha then else 00856700 + jump out to xit ; 00856800 + end ; 00856900 + end ; 00857000 + di := di - i ; 00857100 + di := di + 1) ; 00857200 + tally := 0 ; 00857300 +xit: 00857400 + present := tally ; 00857500 + end present ; 00857600 + if present (string, zippy, stringi, stringileft, stringirepeat, 00857610 + 1-stringid, 0) eqv temptog then 00857620 + stringfound := true 00857630 + else if stringj neq 0 then 00857640 + stringfound := 00857650 + present (string, zippy, stringj, stringjleft, stringjrepeat, 00857660 + 1-stringjd, stringi) eqv temptog ; 00857670 +end stringfound ; 00857680 +define getstrings = if isolatestrings (listtype) then go to next# ; 00857700 +boolean procedure isolatestrings (listtype) ; 00857800 +value listtype ; 00857900 +integer listtype ; 00858000 +begin 00858100 +stream procedure isolate (s, d, l1, l2) ; 00858200 + begin 00858300 +local stopchr, 00858400 + dx, 00858500 + quotes ; 00858600 +label ok, 00858700 + nostring, 00858800 + string, 00858900 + jumpout, 00858910 + no, 00859000 + nextno ; 00850100 + tally := 63 ; 00859200 + stopchr := tally ; 00859300 + di := loc quotes ; 00859400 + ds := 2 lit """ ; 00859500 + ds := 6 lit "..()[]" ; 00859500 + 2 (si := s ; 00859700 + 63 (si := si + 1 ; 00859800 + if sc = alpha then 00859900 + else if sc neq " " then 00860000 + begin 00860100 + di := loc quotes ; 00860200 + 4 (if sc = dc then jump out 2 to ok ; 00860300 + si := si - 1 ; 00860400 + di := di + 1) ; 00860500 + if sc = ";" then jump out ; 00860600 + end) ; 00860700 + go to nostring ; 00860800 +ok: 00861200 + dx := di ; 00861300 + si := si - 1 ; 00861400 + if sc = "." then 00861500 + begin 00861600 + di := l1 ; 00861700 + ds := lit "+" ; 00861800 + end ; 00861900 + si := si + 1 ; 00862000 + tally := 0 ; 00862100 + stopchr (di := dx ; 00862200 + if sc = dc then 00862300 + jump out 1 to string ; 00862400 + si := si - 1 ; 00862500 + di := d ; 00862600 + ds := 1 chr ; 00862700 + d := di ; 00862800 + tally := tally + 1) ; 00862900 +nostring: 00863000 + di := l1 ; 00863010 + ds := 8 lit "00000010" ; 00863020 + go to jumpout ; 00863030 +string: 00863100 + di := l1 ; 00863200 + di := di + 2 ; 00863300 + 2 (dx := di ; 00863400 + 10 (if sc geq "0" then 00863500 + begin 00863600 + di := dx ; 00863700 + ds := lit "0" ; 00863800 + ds := chr ; 00863900 + if sc geq "0" then 00864000 + begin 00864100 + si := si - 1 ; 00864200 + di := di - 2 ; 00864300 + ds := 2 chr ; 00864400 + end ; 00864500 + jump out 1 to nextno ; 00864600 + end ; 00864700 + if sc = alpha then 00864800 + else if sc neq " " then 00864900 + begin 00865000 + if sc = ";" then jump out 2 to no ; 00865100 + di := loc quotes ; 00865200 + 4 (if sc = dc then 00865300 + begin 00865400 + si := si - 1 ; 00865500 + jump out 3 to no ; 00865600 + end ; 00865700 + si := si - 1 ; 00865800 + di := di + 1) ; 00865900 + end ; 00866000 + si := si + 1) ; 00866100 + jump out to no ; 00866200 +nextno: 00866300 + ) ; 00866400 + go to no ; 00866410 +jumpout: 00866420 + jump out ; 00866430 +no: 00866500 + si := si - 1 ; 00866600 + s := si ; 00866700 + di := l1 ; 00866800 + l1 := tally ; 00866900 + tally := stopchr ; 00867000 + l1 (tally := tally + 63) ; 00867100 + stopchr := tally ; 00867200 + si := loc l1 ; 00867300 + di := di + 7 ; 00867400 + si := si + 7 ; 00867500 + ds := 1 chr ; 00867600 + di := l2 ; 00867700 + l1 := di) ; 00867800 + end isolate ; 00867900 +label next ; 00868000 +integer procedure definestring (i, left, right) ; 00868010 +value left, right ; integer i, left, right ; 00868020 +begin 00868030 + if left := 10|i.[12:6] + i.[18:6] = 99 then 00868060 + begin 00868070 + left := 1 ; 00868080 + right := 80 ; 00868090 + end else 00868100 + if right := 10|i.[24:6] + i.[30:6] = 99 then 00868110 + right := left ; 00868120 + i := fulllength + 1 - stringi ; 00868130 + left := min (max (left, if cobolfile then 6 else 1), i) ; 00868140 + right := min (max (left,right), i) ; 00868150 + definestring := left - 1 ; 00868160 + i := right - left + 1 ; 00868170 +end definestring ; 00868190 + if not scantog then 00868200 + begin 00868300 + if parameter1 = "echo " then 00868400 + begin 00868500 + if changetog then 00868600 + changeecho := toggle (changeecho, 2) 00868700 + else 00868800 + editecho := toggle (editecho, 2) ; 00868900 + go to next ; 00869000 + end ; 00869100 + readonlycheck ; 00869200 + end ; 00869300 + if edittog then 00869400 + begin 00869500 + if not (num1 and num2 and num3) then 00869600 + error (next, 0, parameter0, " error.") ; 00869700 + if not itsold (n := parameter3) then 00869800 + error (next, 0, "missing", " format") ; 00869900 + rdisc (at, record) ; 00870000 + if cobolfile then 00870100 + record [0].[1:35] := "@@@@@@" ; 00870200 + end else 00870300 + begin 00870400 + i := m := 0 & "9999" [12:24:24] ; 00870500 + isolate (image, string, i, m) ; 00870600 + if i neq 64 then 00870700 + begin 00870800 + relativenumber := fileinfo ; 00870900 + if scantog then 00871000 + if not (empty1 or (num1 and (num2 or empty2))) then 00871100 + fileinfo := data ; 00871200 + stringi := i.[41:7] ; 00871300 + stringid := real (i lss 0) ; 00871400 + stringileft := definestring (i, 0, 0) ; 00871500 + stringirepeat := i ; 00871600 + if m neq 64 then 00871700 + begin 00871800 + stringj := m.[41:7] ; 00871900 + stringjd := real (m lss 0) ; 00872000 + stringjleft := definestring (m, 0, 0) ; 00872100 + stringjrepeat := m ; 00872200 + end else 00872300 + stringj := 64 ; 00872400 + fileinfo := relativenumber ; 00872500 + end ; 00874100 + if stringi = 0 or (changetog and stringj = 64) then 00874200 + error (next, 0, "missing", " string") ; 00874300 + if stringj = 64 then 00874400 + stringj := 0 ; 00874500 + end ; 00874600 + if false then 00874700 +next: 00874800 + isolatestrings := true ; 00874900 +end isolatestrings ; 00875000 +procedure externalfile (listtype) ; 00875100 +value listtype ; integer listtype ; 00875200 + begin 00875300 +file ro disk serial (2, input [3], input [4]) ; 00875400 +label more, 00875600 + eof, 00875700 + next ; 00875800 +boolean posted, 00875900 + b ; 00876000 + locked := true ; 00876100 + resetn := n ; 00876300 + fill ro with input [1], input [2], *, *, *, 00876400 + 12 + real (posted := parameter1 = "mail % ") ; 00876500 + n := 0 ; 00876600 + m := input [5] + 1 ; 00876700 + b := posting ; 00876800 + if num3 then 00876900 + begin 00877000 + if n := parameter3 - 1 geq m then 00877100 + error (next, 0, "use rec", "ord #s.") ; 00877110 + read seek (ro [n]) ; 00877120 + if num4 then 00877200 + m := parameter4 ; 00877300 + end 00877400 + else if not empty3 then 00877500 + b := true ; 00877600 + i := if posting then algol else data ; 00877700 + write (zippy [*], star) ; 00877750 +more: 00877800 + interrupt (1) ; 00877900 + if n := n + 1 gtr m then 00878000 + go to eof ; 00878100 + read (ro, 10, zippy [*]) [eof] ; 00878200 + if scantog then 00878300 + if not stringfound then 00878400 + go to more ; 00878500 + if b then 00879100 + begin 00879200 + if posting and firstchar (zippy [0]) = "*" then 00879300 + go to more ; 00879400 + writelfcr ; 00879500 + end else writeseq ; 00879600 + writerow (zippy, quick, i) ; 00879700 + if posted then 00879800 + write (ro, star) ; 00879900 + if breaki = 0 then 00880000 + begin 00880100 + go to more ; 00880200 +eof: 00880300 + if posted then 00880400 + begin 00880500 + detach ; 00880600 + close (ro, purge) ; 00880700 + reattach ; 00880800 + end ; 00880900 + end ; 00880910 +next: 00881000 + n := resetn ; 00881100 + locked := false ; 00881200 + end externalfile ; 00881300 +procedure special (listtype, echo) ; 00881400 +value listtype, echo ; integer listtype ; boolean echo ; 00881500 + begin 00881600 +label 00881700 + rewrite, 00881800 + overflow, 00881900 + next ; 00881950 +define quick = false# ; 00882100 +integer stream procedure changed (s,d,i,j,string,ss,t,t1,sr,m,n,id) ; 00882200 +value i, 00882300 + j, 00882400 + ss, 00882500 + t, 00882600 + t1, 00882700 + sr, 00882800 + id, 00882900 + m, 00883000 + n ; 00883100 + begin 00883200 +local k, 00883300 + total ; 00883400 +label around, 00883500 + xit, 00883600 + no, 00883700 + underflow, 00883800 + here, 00883900 + there, 00883910 + exit ; 00883920 + di := d ; 00884000 + ds := 8 lit " " ; 00884100 + si := d ; 00884200 + ds := 9 wds ; 00884300 + si := loc ss ; 00884400 + di := loc k ; 00884500 + si := si + 6 ; 00884600 + di := di + 7 ; 00884700 + ds := chr ; 00884800 + si := s ; 00884900 + di := d ; 00885000 + k (ds := 32 chr ; ds := 32 chr) ; 00885100 + ds := ss chr ; 00885200 + s := si ; 00885300 + d := di ; 00885400 + k := tally ; 00885500 + 2 (t (k (ds := n chr ; 00885600 + tally := k ; 00885700 + jump out to here) ; 00886000 + di := s ; 00886100 + si := string ; 00886200 + if i sc neq dc then 00886300 + begin 00886400 +no: 00886500 + si := s ; 00886600 + di := d ; 00886700 + ds := chr ; 00886800 + s := si ; 00886900 + d := di ; 00887000 + si := sr ; 00887100 + si := si - 8 ; 00887200 + sr := si ; 00887310 + tally := 1 ; 00887300 + go to here ; 00887400 + end ; 00887500 + id (ss := di ; 00887600 + si := ss ; 00887700 + if sc = alpha then 00887800 + jump out to no ; 00887900 + si := si - i ; 00888000 + si := si - 1 ; 00888100 + if sc = alpha then 00888200 + jump out to no ; 00888300 + si := string ; 00888400 + si := si + i) ; 00888500 + tally := 1 ; 00888600 + changed := tally ; 00888700 + s := di ; 00888800 + di := d ; 00888900 + go to there ; 00888910 +here: 00888920 + go to around ; 00888930 +there: 00888940 + n (di := di + j ; 00889000 + d := di ; 00889100 + di := total ; 00889200 + 8 (di := di + j ; 00889300 + di := di - i) ; 00889400 + total := di ; 00889500 + di := sr ; 00889600 + 8 (di := di - j) ; 00889700 + sr := di ; 00889800 + di := d ; 00889900 + di := di - j ; 00890000 + ds := chr ; 00890100 + tally := j ; 00890200 + jump out to around) ; 00890300 + ds := j chr ; 00890400 + d := di ; 00890500 + si := sr ; 00890600 + 8 (si := si - i) ; 00890700 + sr := si ; 00890800 + tally := i ; 00890900 +around: 00891000 + tally := tally + 63 ; 00891100 + k := tally) ; 00891200 + tally := t1 ; 00891600 + t := tally) ; 00891700 + ci := ci + changed ; 00891800 + go to exit ; 00891900 + m (k (ds := n chr ; 00892000 + tally := k ; 00892100 + tally := tally + 63 ; 00892200 + k := tally ; 00892300 + jump out)) ; 00892400 + tally := 2 ; 00892500 + k (changed := tally ; 00892700 + jump out to exit) ; 00892700 + si := loc sr ; 00892800 + di := loc ss ; 00892900 + 6 (if sc neq "0" then jump out to underflow ; si := si + 1) ; 00893000 + di := di + 7 ; 00893100 + ds := chr ; 00893200 + si := s ; 00893300 + di := d ; 00893400 + ss (ds := 32 chr ; ds := 32 chr) ; 00893500 + ds := sr chr ; 00893600 + s := si ; 00893700 + go to underflow ; 00893710 +exit: 00893720 + go to xit ; 00893730 +underflow: 00893800 + n (si := loc total ; 00893900 + di := loc k ; 00894000 + si := si + 6 ; 00894100 + di := di + 7 ; 00894200 + ds := 1 chr ; 00894300 + si := s ; 00894400 + k (2 (32 (if sc neq " " then 00894500 + begin 00894600 + changed := tally ; 00894700 + jump out 4 to xit ; 00894800 + end ; 00894900 + si := si + 1))) ; 00895000 + total (if sc neq " " then 00895100 + begin 00895200 + changed := tally ; 00895300 + jump out 2 to xit ; 00895400 + end ; 00895500 + si := si + 1)) ; 00895600 +xit: 00895700 + end changed ; 00895800 +boolean stream procedure edits (f, s, d, n) ; 00895900 +value n ; 00895000 + begin 00896100 +label xit ; 00896200 + di := d ; 00896300 + ds := 8 lit " " ; 00896400 + si := d ; 00896500 + ds := 9 wds ; 00896600 + di := d ; 00896700 + d := tally ; 00896800 + 2 (n (si := f ; 00896900 + if sc = "@" then 00897000 + begin 00897100 + si := si + 1 ; 00897200 + f := si ; 00897300 + si := s ; 00897400 + ds := chr ; 00897500 + s := si ; 00897600 + end 00897700 + else if sc = "#" then 00897800 + begin 00897900 + si := si + 1 ; 00898000 + f := si ; 00898100 + si := s ; 00898200 + si := si + 1 ; 00898300 + s := si ; 00898400 + end 00898500 + else 00898600 + begin 00898700 + ds := chr ; 00898800 + f := si ; 00898900 + si := d ; 00899000 + si := si + 8 ; 00899100 + d := si ; 00899200 + end)) ; 00899300 + si := loc d ; 00899400 + di := loc n ; 00899500 + si := si + 6 ; 00899600 + di := di + 7 ; 00899700 + ds := 1 chr ; 00899800 + si := s ; 00899900 + n ( 2 ( 32 (if sc neq " " then 00900000 + begin 00900100 + tally : = 1 ; 00900200 + edits := tally ; 00900300 + jump out 3 to xit ; 00900400 + end ; 00900500 + si := si + 1))) ; 00900600 + d (if sc neq " " then 00900700 + begin 00900800 + tally := 1 ; 00900900 + edits := tally ; 00901000 + jump out ; 00901100 + end ; 00901200 + si := si + 1) ; 00901300 +xit: 00901400 + end edits ; 00901500 +real l ; 00901600 + if changetog then 00901700 + begin 00901710 + parameter1 := stringirepeat div 2 ; 00901720 + parameter2 := stringirepeat - parameter1 ; 00901730 + parameter3 := fulllength - stringileft ; 00901740 + parameter4 := min (parameter3, 63) ; 00901750 + end ; 00901760 + while n := (l := ll [at]).s leq m do 00901900 + begin 00902000 + rdisc (at, zippy) ; 00902100 + if scantog then 00902200 + begin 00902300 + if stringfound then 00902400 + begin 00902700 + writeme (n, zippy) ; 00902900 + n := n + 1 ; 00903000 + go to next ; 00903100 + end ; 00903700 + end 00903800 + else if changetog then 00903900 + begin 00904000 + if i := changed (zippy, image, stringi, stringj, 00904100 + string, stringileft, parameter1, parameter2, 00904200 + parameter3, parameter4, stringi lss stringj, 00904300 + stringid) = 1 then 00904400 + begin 00904500 + resetn := n ; 00904600 +rewrite: 00904700 + if echo then 00904800 + writeme (n, image) ; 00904900 + wdisc ; 00905000 + end else 00905100 + if i = 2 then 00905200 +overflow: 00905250 + error (next, 0, parameter0, "ovrflw") ; 00905300 + end 00905400 + else 00905500 + begin 00905600 + if edits (record, zippy, image, halffulllength) then 00905700 + go to overflow ; 00905800 + go to rewrite ; 00905900 + end ; 00906000 + interrupt (1) ; 00906100 + at := l.t ; 00906110 + end ; 00906200 + if scantog then 00906300 + errorx (0, "eof no ", "string.") ; 00906400 +next: 00906500 + if changetog then 00906600 + n := resetn ; 00906700 + end special ; 00906800 +boolean complex ; 00906900 +real l ; 00906910 + if complex := scantog or changetog or edittog then 00907000 + getstrings ; 00907100 + if num1 and (num2 or empty2 or changetog) then 00907200 + begin 00907300 + n := parameter1 ; 00907400 + if num2 then 00907500 + m := parameter2 00907600 + else if scantog then 00907700 + m := finity 00907800 + else m := n ; 00907900 + end 00908000 + else if not (empty1 or changetog) then 00908100 + begin 00908200 + if xfile (12, 0, 2) lss 2 then 00908300 + go to next ; 00908400 + if locked or not posting then 00908500 + wait ((if num3 and num4 then 00908600 + min (parameter4, input [5]) else input [5]) - 00908700 + (if num3 then parameter3 else 0), locked) ; 00908800 + externalfile (listtype) ; 00908900 + go to next ; 00909000 + end 00909100 + else 00909200 + begin 00909300 + if not complex then 00909400 + begin 00909500 + at := 0 ; 00909600 + n := 1 ; 00909700 + end ; 00909800 + if changetog then 00909900 + m := n 00910000 + else 00910100 + m := finity ; 00910200 + end ; 00910300 + opencheck ; 00910400 + if complex then 00910500 + wait (kount (n, m, clock), false) ; 00910600 + if itsold (n) then ; 00910700 + if complex then 00910900 + special (listtype, temptog eqv (if changetog then changeecho 00911000 + else editecho)) 00911050 + else 00911100 + begin 00911200 + while n := (l := ll [at]).s leq m do 00911300 + begin 00911310 + writeat ; 00911400 + interrupt (1) ; 00911410 + at := l.t ; 00911420 + end ; 00911500 + n := ll [l.f].s + inc ; 00911600 + end ; 00911700 +next: 00911800 + end listit ; 00911900 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00912000 +procedure execute ; 00950000 +begin 00950100 +label next ; 00950200 +integer xsub ; 00950300 +real ystart, 00950400 + ylast, 00950500 + yfiletype, 00950600 + yrepeat, 00950700 + ynchrs ; 00950800 +boolean verbisexecute ; 00950900 + if verbisexecute := parameter0 = rswd [0] then 00951000 + if parameter1 = "library" then 00951100 + begin 00951200 + if empty2 then 00951300 + error (next, 7, "macro=/", macrolibrary) ; 00951400 + if num2 then 00951500 + macrolibrary := octdec (parameter2) 00951600 + else 00951700 + macrolibrary := parameter2 ; 00951800 + go to next ; 00951900 + end else 00952000 + if parameter1 = "echo " then 00952100 + begin 00952200 + executeecho := toggle (executeecho, 2) ; 00952300 + go to next ; 00952400 + end ; 00952500 + if xdex + 1 geq xmax then 00952600 + error (next, 0, parameter0, " ovrflw") ; 00952700 + xsub := (xdex + 1) | 13 ; 00952800 + yfiletype := data ; 00952900 + if not verbisexecute then 00953000 + begin 00953100 + xparameters [0] := parameter1 ; 00953200 + xparameters [1] := parameter2 ; 00953300 + xparameters [2] := parameter3 ; 00953400 + xparameters [3] := parameter4 ; 00953500 + xparameters [4] := -"#000000" ; 00953600 + yrepeat := 1 ; 00953700 + parameter2 := input [2] ; 00953800 + parameter1 := parameter0 ; 00953900 + ylast := input [5] + 1 ; 00954000 + end else 00954100 + if fileopen and (num1 or empty1) and (num2 or empty2) then 00954200 + begin 00954300 + if num1 then 00954400 + begin 00954500 + parameter3 := parameter1 ; 00954600 + if num2 then 00954700 + parameter4 := parameter2 00954800 + else 00954900 + parameter4 := parameter3 ; 00955000 + end else 00955100 + begin 00955200 + parameter3 := 1 ; 00955300 + parameter4 := infinity ; 00955400 + end ; 00955500 + parameter1 := octdec(xdex+1+10|station.[14:4]+1000|station.[9:4]);00955600 + parameter2 := "#macro" ; 00955700 + if yfiletype := xfile (parameter1, parameter2, -1) = 7 then 00955800 + begin 00955900 + read (library) ; 00956000 + detach ; 00956100 + close (library, purge) ; 00956200 + reattach ; 00956300 + end else 00956400 + if yfiletype geq 0 then 00956500 + error (next, 4, parameter1, parameter2) ; 00956600 + ylast := kount (parameter3, parameter4, -1) ; 00956700 + i := savefactor ; 00956710 + freefile (station) ; 00956800 + thermofax (savefactor := 0, (ylast + 14) div 15 | 15) ; 00957900 + unfreefile (station) ; 00957000 + savefactor := i ; 00957010 + yfiletype := fileinfo ; 00957100 + end else 00957200 + begin 00957300 + if xfile (12, 0, 2) lss 2 then 00957400 + go to next ; 00957500 + ylast := input [5] + 1 ; 00957600 + if num3 then 00957700 + begin 00957800 + if ystart := parameter3 - 1 gtr ylast then 00957900 + error (next, 0, "use rec", "ord #s.") ; 00958000 + if num4 then 00958100 + if parameter4 lss ylast then 00958200 + ylast := parameter4 ; 00958300 + end ; 00958400 + end ; 00958500 + if xdex lss 0 then 00958600 + xecho := temptog eqv executeecho ; 00958700 + if verbisexecute then 00958800 + if yrepeat := getparameters (63) = 0 then 00958900 + go to next ; 00959000 + wait ((ylast - ystart) | yrepeat | 3, false) ; 00959100 + if moreinput then 00959200 + begin 00959300 + read (io [user + maxusers], 30, image [*]) ; 00959400 + write (io [2|maxusers+xmax|user+xdex+1], 30, image [*]) ; 00959410 + ynchrs := nchrs & 1[1:47:1] ; 00959500 + moreinput := false ; 00959600 + end ; 00959700 + xdex := xdex + 1 ; 00959800 + xn := xstart := ystart ; 00959900 + xlast := ylast ; 00960000 + xfiletype := yfiletype ; 00960100 + xrepeat := yrepeat ; 00960200 + xnchrs := ynchrs ; 00960300 + xprefix := parameter1 ; 00960400 + xsuffix := parameter2 ; 00960500 +next: 00960600 +end execute ; 00960700 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00970000 +procedure xverbs (k) ; value k ; integer k ; 00970100 +begin 00970200 +define 00970300 + replace = 00970400 + begin 00970500 + if num2 or empty2 then 00970600 + error (next, 0, parameter2, " is bad") ; 00970700 + m := -1 ; 00970800 + for i := 0 step 1 until rswdm do 00970900 + if parameter0 := rswd [i] = parameter1 then 00971000 + m := i 00971100 + else if parameter0 = parameter2 then 00971200 + error (next, 0, "dup ", parameter2) ; 00971300 + if m lss 0 then 00971400 + error (next, 0, "no verb", parameter1) ; 00971500 + rswd [m] := parameter2 ; 00971600 + end#, 00971700 + delete = 00971800 + begin 00971900 + opencheck ; 00972000 + if not num1 then 00972100 + parameter1 := n ; 00972200 + inorder := readonlyfile ; 00972300 + if not num2 or parameter2 lss parameter1 then 00972400 + parameter2 := parameter1 ; 00972500 + i := ll [loc (parameter1)] . f ; 00972600 + if itsold (parameter2) then 00972700 + at := ll [at] . t ; 00972800 + ll [i] . t := at ; 00972900 + modify (i) ; 00973000 + ll [at] . f := i ; 00973100 + modify (at) ; 00973200 + n := ll [i] .s + inc ; 00973300 + end#, 00973400 + printorpunch = 00973500 + begin 00973600 + opencheck ; 00973700 + if not num3 then 00973800 + parameter3 := 1 ; 00973900 + if not num4 then 00974000 + parameter4 := finity ; 00974100 + thermofax (k, 0) ; 00974200 + end# ; 00974300 +label next ; 00974400 + if boolean (k) then 00974500 + if k = 1 then 00974600 + replace 00974700 + else 00974800 + delete 00974900 + else if k = 0 then 00975000 + closemyfile 00975100 + else 00975200 + printorpunch ; 00975300 +next: 00975400 +end xverbs ; 00975500 +define closefile = xverbs (0)#, 00975600 + replace = xverbs (1)#, 00975700 + print = xverbs (2)#, 00975800 + delete = xverbs (3)#, 00975900 + punch = xverbs (4)# ; 00976000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00973100 +procedure mail ; 01023000 + begin 01023500 +label next ; 01024000 +boolean stream procedure postfrom (sender, message, z) ; 01024500 + begin 01025000 +label ok, 01025500 + exit ; 01026000 + si := z ; 01026500 + di := z ; 01027000 + ds := 8 lit " " ; 01027500 + ds := 8 wds ; 01028000 + si := message ; 01028500 + 20 (if sc = ":" then 01029000 + jump out to ok ; 01029500 + si := si + 1) ; 01030000 + tally := 1 ; 01030500 + postfrom := tally ; 01031000 + go to exit ; 01031500 +ok: 01032000 + si := si + 1 ; 01032500 + di := z ; 01033000 + 63 (if sc = ";" then 01033500 + jump out ; 01034000 + ds := 1 chr) ; 01034500 + ds := 1 lit "-" ; 01035000 + si := sender ; 01035500 + si := si + 1 ; 01036000 + ds := 7 chr ; 01036500 +exit: 01037000 + end postfrom ; 01037500 + if num2 then 01038000 + parameter2 := octdec (parameter2) ; 01038500 + i := xfile ("mail % ", if empty1 then usercode else parameter2, 01039000 + -1) ; 01039500 + if empty1 then 01040500 + begin 01041000 + if i lss 7 then 01041500 + error (next, 0, "sorry, ", "no mail") ; 01042500 + parameter1 := "mail % " ; 01043500 + num1 := false ; 01043500 + parameter2 := usercode ; 01044000 + num2 := false ; 01045000 + num3 := false ; 01045500 + listit (17) ;%posting and quick 01046000 + end 01047000 + else 01047500 + begin 01048000 + if parameter1 neq "to " then 01048500 + error (next, 0, "missing", " to. ") ; 01049000 + if postfrom (usercode, image, record) then 01049500 + error (next, 0, "missing", " colon.") ; 01050000 + if i lss 0 then 01050500 + begin 01051000 + freefile (station) ; 01051500 + parameter1 := "mail % " ; 01052000 + createfile (15) ; 01053000 + unfreefile (station) ; 01053500 + end 01054000 + else if i gtr 2 then 01054500 + begin 01055000 + write (library [input [5] + 1], 10, record [*]) ; 01055500 + close (library) ; 01056000 + end else 01056500 + errorx (1, "mail % ", parameter2) ; 01056600 + end ; 01057500 +next: 01058000 + end postman ; 01058500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01059000 +procedure copy ; 01059500 + begin 01060000 +boolean b, 01060100 + merge ; 01060200 +label next ; 01060500 + if parameter1 = "overite" then 01060550 + begin 01060600 + copyclobber := toggle (copyclobber, 2) ; 01060700 + go to next ; 01060850 + end ; 01060900 + readonlycheck ; 01060950 + if xfile (12, 0, 2) lss 2 then 01061500 + go to next ; 01062000 + if input [3] neq 10 or input [4] mod 30 neq 0 then 01063500 + error (next, 3, parameter1, parameter2) ; 01064000 + if num3 then 01064500 + begin 01065000 + i := parameter3 - 1 ; 01065500 + if i gtr input [5] then 01066000 + error (next, 0, "use rec", "ord #s.") ; 01066500 + if num4 then 01067000 + m := min (parameter4 - 1, input [5]) 01067500 + else m := i ; 01070000 + end 01070400 + else 01071000 + begin 01071500 + i := 0 ; 01072000 + m := input [5] ; 01072500 + if datafile and merge := parameter3 = "merge " then 01072600 + error (next, 5, " type: ", parameter3) ; 01072700 + end ; 01073000 + wait (m - i, false) ; 01073500 + read seek (library [i]) ; 01075000 + b := not (copyclobber eqv temptog) ; 01075100 + for i := i step 1 until m do 01075500 + begin 01076000 + read (library, 10, image [*]) ; 01076100 + if merge then 01076200 + n := if cobolfile then dec (image [0], 6) 01076300 + else dec (image [9], 8) ; 01076400 + if itsold (n) and b then 01076500 + error (next, 0, "overite", " is off") ; 01076600 + wdisc ; 01077000 + interupt (1, 1, i + 1) ; 01078000 + end ; 01078500 +next: 01079500 + close (library) ; 01079600 + end ; 01080000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01086500 +procedure zipit ; 01087000 + begin 01087500 +alpha stream procedure endcheck (s) ; 01087550 +begin 01087600 + si := s ; 01087650 + if sc = "?" then 01087700 + begin 01087710 + di := loc endcheck ; 01087750 + di := di + 3 ; 01087800 + ds := chr ; 01087810 + 63 (if sc neq " " then jump out ; 01087850 + si := si + 1) ; 01087900 + 4 (if sc = alpha then ds := 1 chr else jump out) ; 01087950 + end ; 01087960 +end endcheck ; 01088000 +label next ; 01088050 + readonlycheck ; 01088100 + rdisc (first . t, record) ; 01089500 + if endcheck (record) = 0 then 01090000 + error (next, 0, "inv fir", "st card") ; 01090500 + rdisc (last . f, image) ; 01092000 + if endcheck (image) neq "?end0" then 01093100 + error (next, 0, "no end ", "card. ") ; 01093200 + wait (kount (1, finity, clock) | 2, xlocked) ; 01095500 + fill library with prefix, suffix ; 01096000 + read seek (library [m := (at := first.t) - 2]) ; 01096500 + i := 0 ; 01096600 + while at := ll [at] . t neq 1 do 01097000 + begin 01097500 + rdisc (at, image) ; 01098000 + i := i + 1 ; 01098100 + if endcheck (image) neq 0 then 01098500 + begin 01099000 + record [9] := i ; 01100000 + write (library, 10, record [*]) ; 01100500 + if m + 1 neq m := at - 2 then 01100510 + read seek (library [m]) ; 01100600 + read (image [*], 10, record [*]) ; 01101600 + end ; 01102000 + interupt (1, 2, m) ; 01102500 + end ; 01103000 + image [9] := i ; 01104000 + write (library, 10, image [*]) ; 01104500 + close (library) ; 01104600 + if not empty1 then 01105000 + begin 01105500 + parameter3 := 1 ; 01106100 + parameter4 := finity ; 01106200 + thermofax (8, (d + 14) div 15 | 15) ; 01107500 + end 01108500 + else 01109000 + begin 01109500 + fileinfo := data ; 01109600 + closefile ; 01110000 + zip with disc ; 01111000 + end ; 01111500 +next: 01111600 + close (library) ; 01111700 + end ; 01112000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01113000 +define closeit = 01113500 + begin 01113600 + opencheck ; 01113700 + closefile ; 01113800 + end# ; 01116500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01117000 +procedure open ; 01117500 + begin 01118000 +label next ; 01118500 + if fileopen then closefile ; 01119000 + tabamount := 0 ; 01119500 + prewhere := -1 ; 01121000 + if fileinfo := filetype (parameter3) = 0 then 01122100 + error (next, 5, " type: ", parameter3) ; 01126600 + i := xfile (12, 0, -1) ; 01126100 + fill disc with prefix := parameter1, suffix := parameter2 ; 01126200 + if parameter4 = "new " then 01126500 + begin 01127000 + if i geq 0 then 01128500 + error (next, 4, parameter1, parameter2) ; 01129000 + createfile (450) ; 01130000 + fileaccess := 7 ; 01130500 + first := d := 1 ; 01130650 + last := 1 & infinity [sf] ; 01130700 + modified := true ; 01130750 + n := 0 ; 01130800 + inorder := false ; 01130850 + go to next ; 01130900 + end ; 01131000 + if i leq 0 then 01133500 + error (next, 1 - i, parameter1, parameter2) ; 01134000 + if input [3] neq 10 or input [4] mod 30 neq 0 then 01134500 + error (next, 3, parameter1, parameter2) ; 01135000 + if input [6] neq 0 then 01135500 + error (next, 0, "file in", " use. ") ; 01136000 + if d := input [5] + 2 gtr maxfilelength then 01146000 + error (next, 0, "file to", " long. ") ; 01147500 + if parameter4 = "old " or datafile then 01155000 + begin 01155500 + inorder := datafile or readonlyfile ; 01156000 + n := 0 ; 01157500 + for at := 2 step 1 until d do 01157600 + ll [at] := (at+1) & (n:=n+inc)[sf] & (at-1)[ff] ; 01157700 + end else 01158000 + begin 01158500 + wait (d, false) ; 01158600 + m := 0 ; 01159000 + for at := 2 step 1 until d do 01160000 + begin 01160500 + read (library, 10, image [*]) ; 01161000 + n := if cobolfile then dec (image [0], 6) 01161500 + else dec (image [9], 8) ; 01162000 + if m gtr n then 01164500 + error (next, 0, "seqerr ", octdex (m)) ; 01166000 + ll [at] := (at+1) & (m:=n)[sf] & (at-1)[ff] ; 01167500 + interupt (1, 2, at - 1) ; 01167600 + end ; 01168000 + end ; 01168100 + fileaccess := i ; 01168200 + modified := not false ; 01168210 + ll [d] . t := 1 ; 01168220 + first := 2 ; 01168230 + last := 1 & infinity [sf] & d [ff] ; 01168240 + ll [2] . f := 0 ; 01168250 +next: 01168500 + close (library) ; 01168600 + n := n + inc ; 01169000 + at := 0 ; 01169100 + if readonlyfile then 01169500 + errorx (7, "read on", "ly file") ; 01170000 + end ; 01171000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01171500 +define increment = 01172000 + begin 01172100 + if not num1 then 01172500 + errorx (7, parameter0, octdex (inc)) 01173000 + else inc := parameter1 ; 01173500 + end# ; 01174000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01174500 +procedure reseq ; 01175000 + begin 01175500 +real l ; 01175600 +label next ; 01176000 + opencheck ; 01176100 + if num2 then 01176500 + begin 01177000 + if not num1 then 01177500 + error (next, 0, parameter1, "invalid") ; 01178000 + if num4 then 01178500 + inc := parameter4 ; 01179000 + if num3 then 01179500 + m := parameter3 - inc 01180000 + else m := parameter1 - inc ; 01180500 + if m + inc | kount (parameter1,parameter2,-1) geq ll [at].s then 01180600 + error (next, 0, parameter0, " error.") ; 01180700 + at := loc (parameter1) ; 01181000 + if m + inc leq ll [ll [at].f].s then 01181010 + error (next, 0, parameter0, " error.") ; 01181020 + n := m ; 01181500 + while (l := ll [at]).s leq parameter2 do 01182000 + begin 01182500 + ll [at] . s := n := n + inc ; 01183000 + modify (at) ; 01183500 + at := l.t ; 01183600 + end ; 01184000 + end 01185500 + else 01186000 + begin 01186500 + if num1 then 01187000 + inc := parameter1 ; ; 01187500 + if inc | kount (1, finity, -1) geq infinity then 01187600 + error (next, 0, parameter0, " error.") ; 01187700 + n := 0 ; 01188000 + at := 0 ; 01188500 + while at := ll [at] . t neq 1 do 01189000 + ll [at] . s := n := n + inc ; 01189500 + modified := not false ; 01189600 + end ; 01190000 + n := n + inc ; 01190500 + if not datafile then 01191000 + inorder := readonlyfile ; 01191500 +next: 01192000 + end reseq ; 01192500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01193000 +define tab = 01193500 + begin 01193600 + if not num1 then 01194000 + begin 01194010 + if not empty1 then 01194100 + tabon := toggle (tabon, 1) 01194300 + else 01194450 + errorx (7, parameter0, onoff (tabon) & 01194500 + octdex (if cobolfile then tabamount + 7 else tabamount + 1) 01194600 + [36:36:12]) ; 01194700 + end else 01194800 + begin 01194900 + if relativenumber.[2:2] neq 0 then 01194910 + parameter1 := tabamount + 1 + 01194920 + (relativenumber & relativenumber[1:3:3]) 01194930 + else if cobolfile then 01194940 + parameter1 := parameter1 - 6 ; 01194950 + if tabamount := parameter1 gtr 55 then 01195000 + tabamount := 55 ; 01195500 + if tabamount := tabamount - 1 lss 0 then 01197000 + tabamount := 0 ; 01197500 + end ; 01197600 + end#, 01198000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01198500 + saveit = 01199000 + begin 01199100 + if not num1 then 01199500 + errorx (7, parameter0, octdex (savefactor)) 01200000 + else savefactor := parameter1 ; 01200500 + end # ; 01201000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01211500 +procedure compile ; 01212000 + begin 01212500 +label next ; 01213000 + opencheck ; 01213100 + if empty2 then 01213500 + error (next, 3, parameter1, parameter2 ) ; 01214000 + if datafile and empty3 then 01216000 + error (next, 3, prefix, suffix) ; 01216500 + if not empty3 then 01217000 + if xfile (parameter3, "disk ", 2) lss 2 then 01218000 + go to next ; 01218500 + if parameter0 := xfile ("line ", usercode, -1) = 7 then 01221500 + begin 01223000 + read (library) ; 01223500 + detach ; 01224000 + close (library, purge) ; 01224500 + reattach ; 01225000 + end else 01225500 + if parameter0 geq 0 then 01226000 + error (next, 4, "line ", usercode) ; 01226500 + if xfile (12, 0, -1) geq 0 then 01227000 + error (next, 4, parameter1, parameter2) ; 01228500 + closefile ; 01229000 + if empty3 then 01230000 + if compiler = algol then 01230500 + parameter3 := "algol " 01231000 + else if compiler = fortran then 01231500 + parameter3 := "fortran" 01232000 + else if compiler = xalgol then 01232500 + parameter3 := "xalgol " 01233000 + else if compiler = basic then 01233500 + parameter3 := "basic " 01234000 + else 01234500 + parameter3 := "cobol " ; 01235000 + write (zippy [*], zipper, parameter1.[6:6], 01238000 + parameter1, parameter2.[6:6], parameter2, parameter3.[6:6], 01238500 + parameter3, prefix.[6:6], prefix, suffix.[6:6], suffix, 01239000 + usercode . [6 : 6], usercode) ; 01239500 + zip with zippy [*] ; 01234000 +next: 01242000 + end compile ; 01242500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01243000 +procedure ditto ; 01243400 + begin 01244000 +boolean b ; 01244100 +real l ; 01244200 +procedure link (x, y) ; value x, y ; integer x, y ; 01244300 +begin 01244310 + ll [x].t := y ; 01244320 + modify (x) ; 01244330 + ll [y].f := x ; 01244340 + modify (y) ; 01244350 +end link ; 01244360 +label next ; 01244500 + if parameter1 = "overite" then 01244550 + begin 01244600 + dittoclobber := toggle (dittoclobber, 2) ; 01244700 + go to next ; 01244850 + end ; 01244900 + readonlycheck ; 01245000 + if not num1 then 01246000 + error (next, 0, parameter0, " error.") ; 01246500 + if parameter2 = "move " or parameter3 = "move " then 01246510 + begin 01246520 + if not num2 then 01246530 + parameter2 := parameter1 ; 01246540 + b := itsold (n) ; 01246550 + parameter4 := ll [parameter3 := at] ; 01246560 + m := ll [i := loc (parameter1)].f ; 01246570 + if parameter0 := kount (parameter1,parameter2,-1) - 1 lss 0 then 01246580 + go to next ; 01246590 + if itsold (parameter2) then 01246600 + l := ll [at].t 01246610 + else 01246620 + at := ll [l := at].f ; 01246630 + if (b and b := ll [m].s geq n or n geq ll [l].s) or 01246640 + n+inc|parameter0 geq (if b then parameter4 else ll [l]).s then 01246650 + error (next, 0, "no room", ": move ") ; 01246660 + if b then 01246670 + begin 01246680 + link (m, l) ; 01246690 + link (at, parameter3) ; 01246700 + link (parameter4.f, i) ; 01246710 + end else 01246720 + parameter3 := l ; 01246730 + do begin 01246740 + ll [i].s := n ; 01246750 + n := n + inc ; 01246760 + modify (i) ; 01246770 + end until i := ll [i].t = parameter3 ; 01246780 + inorder := false ; 01246790 + go to next ; 01246800 + end ; 01246810 + close (disc) ; 01247000 + prewhere := parameter3 := -1 ; 01247100 + if num2 then 01247500 + wait (kount (parameter1, parameter2, clock), false) 01248500 + else parameter2 := parameter1 ; 01250000 + fill library with prefix, suffix ; 01250500 + i := loc (parameter1) ; 01251600 + m := d ; 01252000 + b := not (dittoclobber eqv temptog) ; 01252100 + while (l := ll [i]).s leq parameter2 and i leq m do 01252500 + begin 01253500 + if parameter3 + 1 neq parameter3 := i then 01254000 + read seek (library [i - 2]) ; 01254500 + if itsold (n) and b then 01255000 + error (next, 0, "overite", " is off") ; 01255500 + i := l.t ; 01256000 + read (library, 10, image [*]) ; 01256500 + wdisc ; 01257000 + interupt (1, 2, i - 2) ; 01257500 + end ; 01258000 +next: 01259500 + close (library) ; 01260000 + end ditto ; 01261000 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01261500 +procedure remove ; 01262000 + begin 01262500 +label next ; 01263000 + if empty2 and parameter1 = "listing" then 01263100 + begin 01263200 + parameter1 := "line " ; 01263300 + parameter2 := usercode ; 01263400 + end ; 01263500 + if xfile (12, 0, 4) lss 4 then 01263600 + go to next ; 01263700 + if parameter1 = prefix then 01264000 + if parameter2 = suffix and readwritefile then 01264500 + begin 01265000 + read (disc [0]) ; 01265500 + detach ; 01266000 + close (disc, purge) ; 01266500 + reattach ; 01267500 + fileaccess := 0 ; 01268000 + inorder := true ; 01268500 + go to next ; 01269000 + end ; 01269500 + if input [6] neq 0 then 01273000 + error (next, 0, "file in", " use. ") ; 01273500 + read (library) ; 01274000 + detach ; 01274500 + close (library, purge) ; 01275000 + reattach ; 01275500 +next: 01276000 + end remove ; 01276500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01277000 +procedure listing ; 01277200 + begin 01277400 +boolean locked ; 01277500 +integer p5 ; 01277510 +label next ; 01277600 +file line 15 (2, 15) ; 01277800 +file feedback disk serial (2, 15, 30) ; 01278000 +real stream procedure readz (z, skp, a, n) ; 01278200 +value skp, a, n ; 01278210 +begin 01278220 +label exit ; 01278230 + si := z ; 01278240 + si := si + skp ; 01278250 + di := loc readz ; 01278260 + a (di := di + 8 ; di := di - n ; ds := n chr ; jump out to exit) ; 01278270 + ds := n oct ; 01278280 +exit: 01278290 +end readz ; 01278300 + if xfile ("line ", usercode, 1) lss 1 then 01278400 + go to next ; 01278600 + if not empty1 then 01279200 + if i := filetype (parameter1) = 0 or i = data then 01279400 + error (next, 5, "type: ", parameter1) ; 01281600 + wait (input [5], ylocked) ; 01281800 + ylocked := locked := true ; 01282000 + fill feedback with "line ", usercode ; 01282200 + if num2 and num3 and num4 then 01282400 + begin 01282600 + parameter1 := 1 ; 01282800 + writesegment ; 01283200 + parameter0 := if i=fortran then 10 else real(i geq algol)+12 ; 01283300 + p5 := if i geq algol then parameter0 - 1 else 0 ; 01283310 + end 01283600 + else if parameter2.[6:30] = "error" or parameter2 01283800 + = "syntax " then 01284000 + begin 01284100 + parameter1 := 2 ; 01284200 + p5 := if i=fortran then 9 else 12 ; 01284300 + end 01284310 + else if empty2 then 01284400 + begin 01284600 + fill line with "line ", usercode ; 01284800 + detach ; 01285000 + write (line) ; 01285200 + reattach ; 01285400 + parameter1 := 3 ; 01285600 + end 01285800 + else 01286000 + error (next, 0, parameter0, " error.") ; 01286200 + do begin 01286400 + read (feedback, 15, zippy [*]) [next] ; 01287000 + if parameter1 = 1 then 01287200 + begin 01287400 + if i = fortran then 01287600 + begin 01287800 + if n := readz (zippy [11], 4, 1, 4) neq "long" then 01288000 + if n := readz (zippy [11], 3, 0, 4) neq 0 then 01288200 + m := n ; 01288400 + end 01288800 + else if i geq algol then 01289000 + begin 01289200 + if n := readz (zippy [14], 4, 0, 4) neq 0 then 01289400 + m := n ; 01289600 + end 01289800 + else m := readz (zippy [12], n := 0, 0, 4) ; 01293000 + if m = parameter2 and n = 0 then 01293200 + begin 01293400 + n := readz (zippy [parameter0], real (i=cobol) + 4, 0, 4) ; 01293600 + if n gtr parameter4 then 01294600 + go to next ; 01294800 + if parameter3 leq n then 01295000 + begin 01295200 + parameter3 := n ; 01295400 + n := readz (zippy [p5], if i=cobol then 3 else 0, 0, 8) ; 01295600 + writeseq ; 01296600 + writereladdr ; 01297000 + end ; 01297200 + end ; 01297400 + end 01297600 + else if parameter1 = 2 then 01297800 + begin 01298000 + if i = cobol then 01298200 + begin 01298400 + m := readz (zippy [0], 0, 1, 1) ; 01298600 + if m = " " or m = "[" then 01298800 + m := readz (zippy [0], 5, 0, 6) 01299000 + else m := 0 ; 01299200 + end 01299400 + else m := readz (zippy [p5], 0, 0, 8) ; 01300000 + if m = 0 and n gtr 0 then 01300200 + begin 01301200 + writeseq ; 01301600 + writerow (zippy, true, data) ; 01301800 + end else n := m ; 01302000 + end 01302200 + else 01302400 + write (line [dbl], 15, zippy [*]) ; 01302600 + interrupt (1) ; 01302800 + end until boolean (breaki) ; 01303000 +next: 01303200 + n := resetn ; 01303400 + if locked then 01303600 + ylocked := false ; 01303600 + end listing ; 01303800 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01345000 +procedure inline ; 01345500 + begin 01345550 +label next ; 01345560 +define quick = false# ; 01345570 + if parameter1 = "echo " then 01345600 + begin 01345610 + inlineecho := toggle (inlineecho, 2) ; 01345620 + go to next ; 01345660 + end ; 01345670 + readonlycheck ; 01345700 + if num1 then 01346000 + begin 01346500 + n := parameter1 ; 01347700 + if not itsold (n) then 01347500 + error (next, 0, "missing", octdex (n)) ; 01348000 + if not moreinput then 01348500 + writeat ; 01349000 + i := parameter2.[6:6] ; 01349500 + end 01350000 + else 01350500 + begin 01351000 + at := ll [loc (n)].f ; 01351500 + n := ll [at].s ; 01352500 + i := parameter1.[6:6] ; 01353000 + end ; 01353500 + if not num1 or moreinput then 01353600 + rdisc (at, record) ; 01354000 + inlinetog := true ; 01354500 + if i = "i" then 01356000 + m := 1 01356500 + else if i = "d" then 01357000 + m := 2 01357500 + else if i = "r" then 01358000 + m := 3 01358500 + else m := 0 ; 01359000 +next: 01359500 + end inline; 01359600 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01360000 +procedure column ; 01360100 + begin 01360150 + integer stream procedure getchar (s) ; 01360200 + begin 01360250 + label nope, yes, xit ; 01360300 + di := loc getchar ; 01360350 + si := s ; 01360400 + 2(40(if sc = alpha then else if sc = " " then else 01360450 + if sc = """ then 01360500 + jump out 2 to yes 01360550 + else if sc = "." then 01360600 + jump out 2 to yes 01360650 + else if sc = "(" then 01360700 + jump out 2 to yes 01360750 + else if sc = "[" then 01360800 + jump out 2 to yes 01360850 + else if sc = ";" then 01360900 + jump out 2 to nope ; 01360950 + si := si + 1)) ; 01361000 +nope: 01361050 + ds := 8 lit "+0000001" ; 01361100 + go to xit ; 01361150 +yes: 01361200 + si := si + 1 ; 01361250 + di := di + 7 ; 01361300 + ds := chr ; 01361350 +xit: 01361400 + end getchar ; 01361450 + if i := getchar (image) geq 0 then 01361500 + character := i ; 01361550 + if num1 then 01361600 + begin 01361650 + colstop1 := min (parameter1, 80) ; 01361700 + if num2 then 01361900 + begin 01361950 + colstop2 := min (max (parameter2, colstop1), 80) ; 01362000 + if num3 then 01362050 + begin 01362100 + colstop3 := min (max (parameter3, colstop2), 80) ; 01362150 + if num4 then 01362200 + begin 01362250 + colstop4 := min (max (parameter4, colstop3), 80) ; 01362300 + colstops := 4 ; 01362350 + end else 01362400 + colstops := 3 ; 01362450 + end else 01362500 + colstops := 2 ; 01362550 + end else 01362600 + colstops := 1 ; 01362650 + maxcolstop := colstop [colstops] ; 01362675 + end else 01362700 + if empty1 then 01362750 + begin 01363100 + show (parameter0, onoff (columns) & (character)[42:42:6]) ; 01363200 + if colstops lss 1 then 01363210 + parameter1 := 0 & "#"[6:42:6] 01363220 + else parameter1 := octdex (colstop1) ; 01363230 + if colstops lss 2 then 01363240 + parameter2 := 0 & "#"[6:42:6] 01363250 + else parameter2 := octdex (colstop2) ; 01363260 + show (parameter1, parameter2) ; 01363270 + if colstops lss 3 then 01363280 + parameter3 := 0 & "#"[6:42:6] 01363290 + else parameter3 := octdex (colstop3) ; 01363300 + if colstops lss 4 then 01363310 + parameter4 := 0 & "#"[6:42:6] 01363320 + else parameter4 := octdex (colstop4) ; 01363330 + errorx (7, parameter3, parameter4) ; 01363410 + end else 01363420 + columns := toggle (columns, 1) ; 01363430 + end column ; 01363500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01365000 +procedure teach ; 01365500 + begin 01366000 +label next ; 01366500 + if not empty1 then 01367000 + begin 01367500 + m := -1 ; 01368000 + for i := 0 step 1 until rswdm do 01368500 + if parameter1 = rswd [i] then 01369000 + begin 01369500 + m := i ; 01370000 + i := rswdm ; 01370500 + end ; 01371000 + if m lss 0 then 01371500 + begin 01371600 + if i := xfile (parameter1, parameter2:=macrolibrary, -1) lss 2 01371700 + and macrolibrary neq "macro " then 01371800 + i := xfile (parameter1, parameter2:="macro ", -1) ; 01371900 + if i lss 2 then 01372000 + begin 01372020 + show (parameter1, " invali") ; 01372040 + error (next, 0, "d: * ", rwteach) ; 01372050 + end ; 01372100 + num2 := false ; 01372200 + num3 := boolean (2) ; 01372300 + listit (0) ; 01372400 + go to next ; 01372450 + end ; 01372500 + parameter1 := "teacher" ; 01372500 + parameter2 := octdec (version) ; 01373000 + if xfile (parameter1, parameter2, 2) lss 2 then 01373500 + go to next ; 01374000 + read (library [m], 1, image [*]) ; 01375000 + n := dec (image [0], 8) ; 01376000 + close (library) ; 01376500 + parameter3 := n div 10000 ; 01377000 + num3 := true ; 01377500 + parameter4 := n mod 10000 ; 01378000 + num4 := true ; 01378500 + n := resetn ; 01379000 + listit (17) ;%posting and quick 01379500 + end else 01380500 + begin 01380600 + write (pretank [*], teach1) ; 01381500 + writetwx ; 01382000 + for i := 0 step 7 until rswdm do 01382500 + begin 01383000 + write (image [*], teach2, for m := 0 step 1 until 6 do 01383500 + [(parameter0 := rswd [i + m]).[6:6], parameter0]) ; 01384000 + writerow (image, false, cobol) ; 01384500 + end ; 01386500 + write (image [*], teach3) ; 01387000 + writerow (image, false, cobol) ; 01387500 + end ; 01380500 +next: 01380600 + end teach ; 01390700 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01391500 +define percent = 01392000 + begin 01392500 + translating := boolean (i := real (toggle (translating, 1))) ; 01393000 + translatei := i ; 01393500 + end# ; 01394500 +% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01402000 +procedure stop ; 01402500 + begin 01403000 +define dirctry = controls# ; 01403100 +label next ; 01403500 + if boolean (abnormalend) then 01403600 + begin 01403610 + empty1 := abnormalend = 3 ; 01403620 + abnormalend := breaki := 0 ; 01403630 + if boolean (inreadyq) then 01403650 + begin 01403690 + for i := 1 step 1 while readyq [i] neq user do ; 01403700 + for i := i + 1 step 1 until readyqtop do 01403750 + readyq [i - 1] := readyq [i] ; 01403755 + readyqtop := readyqtop - 1 ; 01403800 + inreadyq := 0 ; 01403810 + end ; 01403825 + end else 01403850 + begin 01403875 + if fileopen and parameter1 neq "ds " then 01403900 + closefile ; 01404500 + write (pretank [*], eoj) ; 01407000 + writetwx ; 01407500 + if not empty1 then 01407600 + savestate ; 01407700 + if counti geq 0 then 01407710 + begin 01407720 + abnormalend := if empty1 then 2 else 4 ; 01407730 + station := 0 ; 01407740 + go to next ; 01407750 + end ; 01407760 + end ; 01407800 + forget (stationi) ; 01407900 + i := 2 | sloti ; 01408000 + read (r1 [45], 90, dirctry [*]) ; 01408100 + if empty1 then 01408500 + dirctry [i] := 0 01408600 + else 01408700 + dirctry [i].[1:1] := 0 ; 01408800 + dirctry [i + 1] := 0 ; 01409000 + write (r1 [45], 90, dirctry [*]) ; 01409500 + station := 0 ; 01410500 + if user neq bigbird then 01415100 + begin 01415110 + write (buffers [user, *], 45, buffers [bigbird, *]) ; 01415130 + if boolean (inreadyq) then 01415140 + for i := 0 step 1 until readyqtop do 01415150 + if readyq [i] = bigbird then 01415160 + readyq [i] := user ; 01415170 + read (r1 [if inreadyq=3 then 46 else sloti], 90, controls [*]) ; 01415180 + fileaccess := controls [51] ; 01415190 + if fileopen then 01415200 + begin 01415210 + n := bigbird | 32 ; 01415215 + m := controls [57].leftside ; 01415220 + for i := 0 step 1 until m do 01415230 + write (linklists [user32 + i, *], 256, 01415240 + linklists [n + i, *]) ; 01415250 + end ; 01415260 + if xdex := controls [62] geq 0 then 01415265 + begin 01415270 + write (xarray [user, *], xmax | 13, xarray [bigbird, *]) ; 01415275 + for xdex := xdex step -1 until 0 do 01415280 + if boolean (xnchrs).[1:1] then 01415285 + begin 01415290 + read (io [2|maxusers+xmax|bigbird+xdex], 30, image [*]) ; 01415295 + write (io [2|maxusers+xmax|user+xdex], 30, image [*]) ; 01415300 + end ; 01415305 + end ; 01415310 + end ; 01415315 + bigbird := bigbird - 1 ; 01415500 +next: 01416500 + end ; 01417000 +procedure program ; 01417100 +begin 01417110 +label next, exit ; 01417120 +next: 01417150 + case verb of 01417160 + begin 01417170 + execute ; 01417175 + ditto ; 01417180 + copy ; 01417190 + inline ; 01417200 + zipit ; 01417210 + change ; 01417220 + edit ; 01417230 + saveit ; 01417240 + reseq ; 01417250 + punch ; 01417260 + print ; 01417270 + delete ; 01417280 + closeit ; 01417300 + compile ; 01417310 + column ; 01417320 + scan ; 01417330 + listing ; 01417340 + increment ; 01417350 + tab ; 01417360 + percent ; 01417370 + quicklist ; 01417380 + listit (0) ; 01417390 + open ; 01417400 + mail ; 01417410 + teach ; 01417420 + remove ; 01417430 + replace ; 01417440 + stop ; 01417450 + go to exit ; 01417460 + end ; 01417470 + if bigbird geq 0 then 01417480 + go to next ; 01417490 +exit: 01417500 +end program ; 01418000 +boolean procedure rc (start) ; 01418100 +value start ; 01418200 +boolean start ; 01418300 +begin 01418500 +save file out rone disk serial [1:47] "r/c" "#1" (1, 90, save 99) ; 01418600 +save file out rtwo disk serial [15:96] "r/c" "#2" (1, 256, save 99) ; 01418700 +array dirctry, newdirctry [0:90], 01418800 + linklist [0:255] ; 01418900 +label endofprogram ; 01419000 + charge (0) ; 01419100 + freefile (0) ; 01419150 + if start then 01419200 + begin 01419300 + search (rone, image [*]) ; 01419500 + if image [6] gtr 0 then 01420000 + begin 01420100 + i := status (image [*]) ; 01420200 + write (twxoutput (image [0]), userun) ; 01420300 + go to endofprogram ; 01420500 + end ; 01420600 + if image [0] geq 0 then 01421000 + begin 01421500 + read (r1 [45], 90, dirctry [*]) ; 01422000 + dirctry [90] := 12 ; 01422500 + for i := 0 step 2 while usercode := dirctry [i] neq 12 do 01423000 + dirctry [i] := abs (usercode) ; 01423500 + write (r1 [45], 90, dirctry [*]) ; 01424000 + end else 01424500 + begin 01425000 + dirctry [0] := 12 ; 01425500 + write (rone [45], 90, dirctry [*]) ; 01426000 + end ; 01426500 + search (rtwo, image [*]) ; 01432500 + if image [0] lss 0 then 01433000 + write (rtwo[0], 1, image [*]) ; 01433500 + end else 01436500 + begin 01436600 + read (r1 [45], 90, dirctry [*]) ; 01437300 + user := -2 ; 01437500 + for n := 0 step 1 until 1 do 01437600 + for i := 0 step 2 while usercode := dirctry [i] neq 12 do 01438000 + if usercode neq 0 then 01439000 + begin 01439500 + read (r1 [i/2], 90, controls [*]) ; 01440000 + fileaccess := controls [51] ; 01440100 + if fileopen or boolean (n) then 01440500 + begin 01441000 + newdirctry [user := user + 2] := usercode ; 01441500 + write (rone, 90, controls [*]) ; 01442500 + if fileopen then 01442600 + begin 01442700 + read seek (r2 [16 | i]) ; 01443000 + newdirctry [user + 1] := dirctry [i + 1] ; 01443100 + m := controls [57].leftside ; 01444100 + for d := 0 step 1 until m do 01444500 + begin 01445000 + read (r2, 256, linklist [*]) ; 01445500 + write (rtwo, 256, linklist [*]) ; 01446000 + end ; 01446500 + if m neq 31 then 01446600 + write (rtwo [16 | user + 31], 1, controls [*]) ; 01446700 + dirctry [i] := 0 ; 01447000 + end ; 01447100 + end ; 01447500 + end ; 01448000 + newdirctry [user + 2] := 12 ; 01455000 + if user geq 0 then 01455500 + write (rone [45], 90, newdirctry [*]) ; 01456000 + close (r1, purge) ; 01456500 + read (r2 [0]) ; 01456600 + close (r2, purge) ; 01457000 +endofprogram: 01458100 + rc := true ; 01458200 + end ; 01458300 +end rc ; 01458500 + controls [90] := 12 ; 01458900 + if not rc (true) then 01459000 + begin 01459100 + bigbird := -1 ; 01459110 + t0 := 150 ; 01459120 + freehead := maxfreehead := (xmax + 2) | maxusers ; 01459130 + program ; 01459200 + bool := rc (false) ; 01459300 + if xfile ("teacher", octdec (version), -1) gtr 0 then 01459310 + read (library) ; 01459320 + end ; 01459400 +end. 01459500 +?end diff --git a/RC-Ron-Brody/README.txt b/RC-Ron-Brody/README.txt new file mode 100644 index 0000000..72775a5 --- /dev/null +++ b/RC-Ron-Brody/README.txt @@ -0,0 +1,33 @@ +R/C (Remote/Card) Interactive Source Editor for Burroughs B5500 + +R/C was written in the late 1960s by Ron Brody at Burroughs Defense, +Space, and Special Systems Group in Paoli, Pennsylvania, US. It some of +the functionality of a timesharing system, but was not one. Unlike +CANDE, R/C was designed to run under the B5500 Data Communications MCP +(DCMCP) operating system, rather than the Timesharing MPC (TSMCP). The +remote access facilities of DCMCP were oriented towards on-line +transaction processing (OLTP) rather than multi-user timesharing. + +R/C provided for the remote preparation and maintenance of card-image +files, submission of card image files as batch jobs to the B5500 host, +and some remote control of those jobs. In that sense, it was more like a +Remote Job Entry (RJE) system, but one in which the card decks were +maintained on the central host rather than at the remote site. Output +from programs was generally printed or punched at the host, although +printer and punch files could be file-equated to disk and listed by R/C +from disk to the remote terminal. + +The source files for R/C were transcribed from portions of +http://bitsavers.org/pdf/burroughs/B5000_5500_5700/listing/ +B5700_Text_Editors_Sep76.pdf by Rich Cornwell of Durham, North Carolina, +US. Proofing and correction of the source was done by Paul Kimpel. + +RC.alg_m is the R/C program, written in Burroughs Extended Algol. + +RC-Compile.card is a card deck that can be used to compile the R/C +source. + +RC-Manual.txt_m is the raw text of the R/C Reference Manual. This is in +the markup notation used by the XREF/JONES utility, available on the +Mark XIII SYSTEM tape. +