From 51249a5a384a918719bcbb0f619f78b52b30b2cb Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Wed, 4 May 2016 14:48:46 -0700 Subject: [PATCH] Convert R/C transcription source to PWB .alg_m format, up-case source text, apply additional sequence number corrections, and adjust text alignment (most lines were aligned one position too far to the left). This version will be the base for proofing corrections. --- RC-Ron-Brody/RC.alg_m | 8196 ++++++++++++++++++++--------------------- 1 file changed, 4098 insertions(+), 4098 deletions(-) diff --git a/RC-Ron-Brody/RC.alg_m b/RC-Ron-Brody/RC.alg_m index 9870a88..c542300 100644 --- a/RC-Ron-Brody/RC.alg_m +++ b/RC-Ron-Brody/RC.alg_m @@ -1,4098 +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]#, 00035000 - num2 = bool . [34 : 2]#, 00035500 - num3 = bool . [32 : 2]#, 00036000 - num4 = bool . [30 : 2]#, 00036500 - 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 ; 00126600 -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) ; 00179000 - 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 -% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00190500 -procedure writerow (row, q, f) ; 00191000 -value q, 00191500 - f ; 00192000 -boolean q ; 00192500 -integer f ; 00193000 -array row [0] ; 00193500 - begin 00193600 -stream procedure move (s, d, skps, n) ; 00193700 -value skps, n ; 00193800 -begin 00193900 - si := s ; 00194000 - di := d ; 00194100 - si := si + skps ; 00194200 - ds := n chr ; 00194300 -end move ; 00194400 -stream procedure blankoutspecialcharacters (s, d, n, k) ; 00195000 -value n, 00195500 - k ; 00195600 - begin 00196000 - 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) ; 00220000 -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 00238030 -next: 00238040 - 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) ; 00238500 -value n ; 00238600 - 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 ; 00319890 - 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 00320020 - 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 ; 00329000 - 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 ; 00333100 -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, 00381000 - p, 00381100 - q ; 00381200 - begin 00381500 -local t ; 00382000 - p (si := im ; 00382100 - if sc = "%" then 00382110 - begin 00382120 - si := si + 1 ; 00382130 - if sc = "*" then 00382140 - begin 00382150 - si := c ; 00382180 - si := si - 8 ; 00382190 - c := si ; 00382200 - tally := 1 ; 00382210 - fix := tally ; 00382220 - end ; 00382230 - end) ; 00382240 - si := z ; 00382500 - 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: 00436500 - c := sloti := i / 2 ; 00437000 - 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 00454400 - i := d 00454500 - else if at = 1 then 00454600 - error (next, 6, prefix, suffix) ; 00455000 - end ; 00455100 - error (mailcall, 7, "linklis", "t error") ; 00456500 -new: 00458500 - write (r2 [32 | c + 31], 1, image [*]) ; 00459000 - lock (r2) ; 00459500 - user32 := user | 32 ; 00460000 - 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 ; 00548000 -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 ; 00698000 - 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 00756950 - 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 ; 00759950 - 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 ; 00774000 - 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 ; 00786100 -define quick = false# ; 00786110 -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 ; 00859100 - tally := 63 ; 00859200 - stopchr := tally ; 00859300 - di := loc quotes ; 00859400 - ds := 2 lit """ ; 00859500 - ds := 6 lit "..()[]" ; 00859600 - 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 ; 00887300 - tally := 1 ; 00887310 - 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 ; 00892600 - 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 ; 00896000 - 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) ; 00956900 - 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 -% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01023000 -procedure mail ; 01023500 - begin 01024000 -label next ; 01024100 -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") ; 01042000 - parameter1 := "mail % " ; 01042500 - 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 01122000 - error (next, 5, " type: ", parameter3) ; 01126000 - 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 [*] ; 01240000 -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 01303500 - 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 ; 01347000 - 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) ; 01371830 - if i lss 2 then 01371900 - begin 01372000 - show (parameter1, " invali") ; 01372020 - error (next, 0, "d: * ", rwteach) ; 01372040 - end ; 01372050 - num2 := false ; 01372100 - num3 := boolean (2) ; 01372200 - listit (0) ; 01372300 - go to next ; 01372400 - end ; 01372450 - 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 ; 01390500 -next: 01390600 - 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 +?EXECUTE OBJECT/READER 00000010 +?COMMON=3 00000020 +?FILE NEWTAPE = SYMBOL/RCSY94 SERIAL 00000030 +?DATA CARD 00000040 + 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]#, 00035000 + NUM2 = BOOL . [34 : 2]#, 00035500 + NUM3 = BOOL . [32 : 2]#, 00036000 + NUM4 = BOOL . [30 : 2]#, 00036500 + 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 ; 00126600 + 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] ; 00142400 + END ; 00142600 + END ELSE 00142800 + 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) ; 00179000 + 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 + % * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00190500 + PROCEDURE WRITEROW (ROW, Q, F) ; 00191000 + VALUE Q, 00191500 + F ; 00192000 + BOOLEAN Q ; 00192500 + INTEGER F ; 00193000 + ARRAY ROW [0] ; 00193500 + BEGIN 00193600 + STREAM PROCEDURE MOVE (S, D, SKPS, N) ; 00193700 + VALUE SKPS, N ; 00193800 + BEGIN 00193900 + SI := S ; 00194000 + DI := D ; 00194100 + SI := SI + SKPS ; 00194200 + DS := N CHR ; 00194300 + END MOVE ; 00194400 + STREAM PROCEDURE BLANKOUTSPECIALCHARACTERS (S, D, N, K) ; 00195000 + VALUE N, 00195500 + K ; 00195600 + BEGIN 00196000 + 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) ; 00220000 + 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 00238030 + NEXT: 00238040 + 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) ; 00238500 + VALUE N ; 00238600 + 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 ; 00319545 + GO TO EXIT ; 00319550 + END ; 00319560 + IF XDEX LSS 0 THEN 00319570 + BEGIN 00319580 + NEXT: 00319590 + IF NOT NOSTAR THEN 00319600 + WRITESEQUENCE ; 00319610 + CHRS := 0 ; 00319620 + SAVESTATE ; 00319630 + END ELSE 00319640 + BEGIN 00319650 + XSUB := XDEX | 13 ; 00319660 + WHILE XN := XN + 1 GTR XLAST DO 00319670 + IF XREPEAT := XREPEAT - 1 GTR 0 THEN 00319680 + XN := XSTART 00319690 + ELSE 00319700 + BEGIN 00319710 + IF XSUFFIX = "#MACRO#" THEN 00319720 + BEGIN 00319730 + IF XFILE (XPREFIX, XSUFFIX, 7) LSS 7 THEN 00319740 + GO TO NEXT ; 00319750 + READ (LIBRARY) ; 00319760 + DETACH ; 00319770 + CLOSE (LIBRARY, PURGE) ; 00319780 + 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 ; 00319890 + 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 00320020 + 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 ; 00329000 + 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 ; 00333100 + 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, 00381000 + P, 00381100 + Q ; 00381200 + BEGIN 00381500 + LOCAL T ; 00382000 + P (SI := IM ; 00382100 + IF SC = "%" THEN 00382110 + BEGIN 00382120 + SI := SI + 1 ; 00382130 + IF SC = "*" THEN 00382140 + BEGIN 00382150 + SI := C ; 00382180 + SI := SI - 8 ; 00382190 + C := SI ; 00382200 + TALLY := 1 ; 00382210 + FIX := TALLY ; 00382220 + END ; 00382230 + END) ; 00382240 + SI := Z ; 00382500 + 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 THEN00390880 + 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: 00436500 + C := SLOTI := I / 2 ; 00437000 + 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 00454400 + I := D 00454500 + ELSE IF AT = 1 THEN 00454600 + ERROR (NEXT, 6, PREFIX, SUFFIX) ; 00455000 + END ; 00455100 + ERROR (MAILCALL, 7, "LINKLIS", "T ERROR") ; 00456500 + NEW: 00458500 + WRITE (R2 [32 | C + 31], 1, IMAGE [*]) ; 00459000 + LOCK (R2) ; 00459500 + USER32 := USER | 32 ; 00460000 + 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 ; 00548000 + 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 ; 00698000 + 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 00756950 + 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 ; 00759950 + 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] THEN00764610 + 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 ; 00774000 + 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 ; 00786100 + DEFINE QUICK = FALSE# ; 00786110 + 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 ; 00859100 + TALLY := 63 ; 00859200 + STOPCHR := TALLY ; 00859300 + DI := LOC QUOTES ; 00859400 + DS := 2 LIT """ ; 00859500 + DS := 6 LIT "..()[]" ; 00859600 + 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 ; 00887300 + TALLY := 1 ; 00887310 + 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 ; 00892600 + 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 ; 00896000 + 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) ; 00956900 + 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 + % * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01023000 + PROCEDURE MAIL ; 01023500 + BEGIN 01024000 + LABEL NEXT ; 01024100 + 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") ; 01042000 + PARAMETER1 := "MAIL % " ; 01042500 + 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 01122000 + ERROR (NEXT, 5, " TYPE: ", PARAMETER3) ; 01126000 + 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 THEN01180600 + 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 [*] ; 01240000 + 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 THEN01246580 + 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 THEN01246650 + 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 01303500 + 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 ; 01347000 + 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 201371700 + AND MACROLIBRARY NEQ "MACRO " THEN 01371800 + I := XFILE (PARAMETER1, PARAMETER2:="MACRO ", -1) ; 01371830 + IF I LSS 2 THEN 01371900 + BEGIN 01372000 + SHOW (PARAMETER1, " INVALI") ; 01372020 + ERROR (NEXT, 0, "D: * ", RWTEACH) ; 01372040 + END ; 01372050 + NUM2 := FALSE ; 01372100 + NUM3 := BOOLEAN (2) ; 01372200 + LISTIT (0) ; 01372300 + GO TO NEXT ; 01372400 + END ; 01372450 + 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 ; 01390500 + NEXT: 01390600 + 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 99999990