github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-13 07:09:23 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/RC-Ron-Brody/RCSY94.RON.alg_m
Paul Kimpel 0ef7c9578f Rename source and reference manual files (again) to match the names in the documentation: 
RC.alg_m -> RCSY94.RON.alg_m
RC-Reference.txt_m -> TEACHER.0000094.txt_m
2016-05-18 08:09:07 -07:00

4097 lines
364 KiB
Plaintext
Raw Blame History

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 = 2097150#, 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] 00046600
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, "{!BREAK{!~") ; 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# ; 00125500
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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
FREEHEAD := SPOT ; 00142200
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], 30, 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: 00226500
SI := SI + 1 ; 00227000
N := SI ; 00227500
DI := N ; 00228000
DS := 1 LIT "~" ; 00228500
ALLBLANK := TALLY ; 00229000
END ALLBLANK ; 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
REATTACH ; 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 := C 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 ; % AGAIN 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 00493300
LASTUSER := USER ; 00493400
NEXT: 00493410
IF MORE THEN 00493500
GO TO EXIT ; 00494000
END ; 00494400
IF NOT Q AND READYQTOP GTR 0 THEN 00494600
BEGIN 00494700
LASTUSER := REAL (WAITX (0, BOOLEAN (3))) ; 00494800
SECURITYCHECK ; 00494900
GO TO EXIT ; 00495000
END ; 00495100
AGAIN: 00495200
CHARGE (0) ; 00495300
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
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 00568000
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 00692000
BEGIN 00692500
N := (L := LL [AT]).S ; 00693000
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 4 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, 00881850
NEXT ; 00881900
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 ; 00902910
GO TO NEXT ; 00903000
END ; 00903100
END 00903700
ELSE IF CHANGETOG THEN 00903800
BEGIN 00903900
IF I := CHANGED (ZIPPY, IMAGE, STRINGI, STRINGJ, 00904000
STRING, STRINGILEFT, PARAMETER1, PARAMETER2, 00904100
PARAMETER3, PARAMETER4, STRINGI LSS STRINGJ, 00904200
STRINGID) = 1 THEN 00904300
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 01070500
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 ; 01114000
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 ; 01243500
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 ; 01364500
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 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
99999990
Reference in New Issue View Git Blame Copy Permalink