mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-02-28 00:55:39 +00:00
16146 lines
1.4 MiB
16146 lines
1.4 MiB
% I N T R I N S I C S M A R K XVI 0 00 10/01/74 00000000
|
|
COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00000010
|
|
* FILE ID: SYMBOL/INTRINS TAPE ID: SYMBOL1/FILE000 * 00000011
|
|
* THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00000012
|
|
* AND IS NOT TO BE REPRODUCED, USED OR DISCLOSED * 00000013
|
|
* EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00000014
|
|
* WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00000015
|
|
* BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00000016
|
|
* * 00000017
|
|
* COPYRIGHT (C) 1971, 1972, 1974 * 00000018
|
|
* BURROUGHS CORPORATION * 00000019
|
|
* AA320206 AA393180 AA332366 *; 00000021
|
|
BEGIN 00000100
|
|
DEFINE ETRLNG = 5#, 00000200
|
|
INTDESC(INTDESC1) = FLAG(INTDESC1 & 85[1:41:7]) #, 00000210
|
|
INTCALL(INTCALL1,INTCALL2) = P(INTCALL2 & 85[1:41:7], 00000215
|
|
INTCALL1,COC) #, 00000216
|
|
CALLINT(CALLINT1) = P(CALLINT1 & 85[1:41:7],XCH,COC) #, 00000218
|
|
COBOLDCI= @167 #, 00000219
|
|
FORTERRI= @134 #, 00000220
|
|
EXPI = @20 #, 00000221
|
|
LNI = @17 #, 00000222
|
|
DEXPI = @77 #, 00000223
|
|
DLOGI = @101 #, 00000224
|
|
CABSI = @53 #, 00000225
|
|
SINI = @14 #, 00000226
|
|
SQRTI = @13 #, 00000227
|
|
ATAN2I = @114 #, 00000228
|
|
DMODI = @65 #, 00000229
|
|
DSINI = @105 #, 00000230
|
|
DSQRTI = @123 #, 00000231
|
|
XTOII = @6 #, 00000232
|
|
CXTOII = @56 #, 00000233
|
|
COSI = @15 #, 00000234
|
|
TANI = @111 #, 00000235
|
|
ARCTANI = @16 #, 00000236
|
|
DATANI = @113 #, 00000237
|
|
ARSINI = @116 #, 00000238
|
|
GAMMAI = @126 #, 00000239
|
|
EDITIT(EDITIT1,EDITIT2,EDITIT3,EDITIT4,EDITIT5) = P(MKS, 00000240
|
|
EDITIT1,EDITIT2,EDITIT3,(-1),(EDITIT4),(EDITIT5),00000241
|
|
@153&85[1:41:7],XCH,COC) #, 00000242
|
|
% EDITIT(BUFFADDRESS,FIELDWIDTH(W).TYPE LOWPART HIGHPART) 00000243
|
|
% WILL EDIT THE VALUE (LOWPART,HIGHPART) INTO A.FIELD 00000244
|
|
% STARTING AT BUFFADDRESS EDITIT RETURNS THE ENDING 00000245
|
|
% ADDRESS. THE WIDTH OF THE EDITED FIELD IS CONSTRAINED 00000246
|
|
% TO W CHARACTERS (EDITED VALUE IS RIGHT JUSTIFIED WITH 00000247
|
|
% LEADING BLANKS IF W IS LARGER THAN NEEDED) -- BUT IF 00000248
|
|
% W=0, THEN EDITIT WILL ADJUST THE FIELD WIDTH TO 00000249
|
|
% ACCOMODATE FULL NUMERICAL SIGNIFICANCE. TYPE=2 => EDITIT00000250
|
|
% WILL CHOOSE BETWEEN REAL, INTEGER, AND DOUBLEPRECISION 00000251
|
|
% EDITING (DOUBLEPRECISION IS USED IF LOWPART!0). 00000252
|
|
% TYPE=1 => USE ONLY INTEGER, TYPE=3 => USE ONLY REAL, 00000253
|
|
% TYPE=4 => USE ONLY LOGICAL, TYPE=5 => USE ONLY DOUBLE- 00000254
|
|
% PRECISION. 00000255
|
|
CTC = 33:33:15#, 00000300
|
|
CTF = 18:33:15#, 00000400
|
|
FTC = 33:18:15#, 00000410
|
|
FTF = 18:18:15#, 00000420
|
|
CF = 33:15#, 00000500
|
|
FF = 18:15#; 00000600
|
|
REAL JUNK = 5; 00000700
|
|
NAME MEM=2, M=2, MEMORY=2 ; 00000710
|
|
REAL BLKCNTRL = 5; 00000750
|
|
DEFINE DUMPNOW(DUMPNOW1)=P(DUMPNOW1,0,48,COM,DEL,DEL)#, 00000775
|
|
TRACENOW(TRACENOW1,TRACENOW2)= 00000780
|
|
P(TRACENOW1,1,TRACENOW2 ,+ ,48,COM,DEL,DEL)#; 00000785
|
|
PROCEDURE OUTPUTINT(TEN, FILX, CHSKP, LNSKP, FI, FRMT, LISX);% %WF 00000800
|
|
VALUE CHSKP, LNSKP, FI, LISX;% %WF 00000900
|
|
NAME FILX;% %WF 00001000
|
|
ARRAY TEN[*], FRMT[*];% %WF 00001100
|
|
REAL LISX;% %WF 00001200
|
|
INTEGER CHSKP, LNSKP, FI;% %WF 00001300
|
|
FORWARD;% CODE=B@@@0BB0, INTRINSIC NUMBER=@ 1 %WF 00001400
|
|
PROCEDURE INTRINSIC(DUPE, D, NUMDIM, SIZE, TYPE);% %WF 00001500
|
|
VALUE DUPE, D, NUMDIM, SIZE, TYPE;% %WF 00001600
|
|
NAME D;% %WF 00001700
|
|
ARRAY DUPE[*];% %WF 00001800
|
|
INTEGER NUMDIM, SIZE, TYPE;% %WF 00001900
|
|
FORWARD;% CODE=32000Q00, INTRINSIC NUMBER=@ 2 %WF 00002000
|
|
PROCEDURE INPUTINT(TEN, FILX, DKADR, ACT,% %WF 00002100
|
|
FI, FRMT, LISX, EOFL, PARL);% %WF 00002200
|
|
VALUE ACT, FI;% %WF 00002300
|
|
NAME FILX, LISX;% %WF 00002400
|
|
ARRAY TEN[*], FRMT[*];% %WF 00002500
|
|
REAL EOFL, PARL;% %WF 00002600
|
|
INTEGER DKADR, ACT, FI;% %WF 00002700
|
|
FORWARD;% CODE=S60G0000, INTRINSIC NUMBER=@ 3 %WF 00002800
|
|
PROCEDURE DISKSORT(T1, T2, RELA, ENDQ, BINGO, IPFIDX,% %WF 00002900
|
|
OUTPRO, INPRO, OUTF, INF, OPTOG, IPTOG, DKO, DKI,% %WF 00003000
|
|
TP1, TP2, TP3, TP4, TP5, NT, HIVALU, EQUALS,% %WF 00003100
|
|
R, ALFA, CORESIZE, DISKSIZE);% %WF 00003200
|
|
VALUE OPTOG, IPTOG, NT, HIVALU, EQUALS, R, ALFA,% %WF 00003300
|
|
CORESIZE, DISKSIZE;% %WF 00003400
|
|
NAME TP1, TP2, TP3, TP4, TP5;% %WF 00003500
|
|
REAL T1, T2, RELA, ENDQ, BINGO, IPFIDX, OUTPRO, INPRO,% %WF 00003600
|
|
OUTF, INF, DKO, DKI, NT, HIVALU, EQUALS, CORESIZE;% %WF 00003700
|
|
BOOLEAN OPTOG, IPTOG, ALFA;% %WF 00003800
|
|
INTEGER R, DISKSIZE;% %WF 00003900
|
|
FORWARD;% CODE=39400000, INTRINSIC NUMBER=@ 4 %WF 00004000
|
|
REAL PROCEDURE DUMPINT(SN, CV, BV, TIPE,% $WF 00004100
|
|
TENS, ALFA, CHAR, FIEL, FORMT);% %WF 00004200
|
|
VALUE SN, CV, BV, TIPE, TENS, ALFA, CHAR, FORMT;% %WF 00004300
|
|
NAME FIEL;% %WF 00004400
|
|
REAL SN, CV, BV, TIPE, TENS, ALFA, CHAR, FORMT;% %WF 00004500
|
|
FORWARD;% CODE=42000000, INTRINSIC NUMBER=@ 5 %WF 00004600
|
|
PROCEDURE XTOTHEIINT(BASE, EXPON, M, LOG, EXP);% %WF 00004700
|
|
VALUE BASE, EXPON, M, LOG, EXP;% %WF 00004800
|
|
REAL BASE, EXPON, M, LOG, EXP;% %WF 00004900
|
|
FORWARD;% CODE=42254000, INTRINSIC NUMBER=@ 6 %WF 00005000
|
|
REAL PROCEDURE ABSINT(X);% %WF 00005100
|
|
VALUE X;% %WF 00005200
|
|
REAL X;% %WF 00005300
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@ 7 %WF 00005400
|
|
REAL PROCEDURE SIGNINT(X);% %WF 00005500
|
|
VALUE X;% %WF 00005600
|
|
REAL X;% %WF 00005700
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@10 %WF 00005800
|
|
INTEGER PROCEDURE ENTIERINT(X);% %WF 00005900
|
|
VALUE X;% %WF 00006000
|
|
REAL X;% %WF 00006100
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@11 %WF 00006200
|
|
REAL PROCEDURE TIMEINT(X);% %WF 00006300
|
|
VALUE X;% %WF 00006400
|
|
REAL X;% %WF 00006500
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@12 %WF 00006600
|
|
PROCEDURE SQRTINT(X);% %WF 00006700
|
|
VALUE X;% %WF 00006800
|
|
REAL X;% %WF 00006900
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@13 %WF 00007000
|
|
PROCEDURE SININT(X);% %WF 00007100
|
|
VALUE X;% %WF 00007200
|
|
REAL X;% %WF 00007300
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@14 %WF 00007400
|
|
PROCEDURE COSINT(X);% %WF 00007500
|
|
VALUE X;% %WF 00007600
|
|
REAL X;% %WF 00007700
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@15 %WF 00007800
|
|
REAL PROCEDURE ARCTANINT(X);% %WF 00007900
|
|
VALUE X;% %WF 00008000
|
|
REAL X;% %WF 00008100
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@16 %WF 00008200
|
|
PROCEDURE LNINT(X);% %WF 00008300
|
|
VALUE X;% %WF 00008400
|
|
REAL X;% %WF 00008500
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@17 %WF 00008600
|
|
REAL PROCEDURE EXPINT(X);% %WF 00008700
|
|
VALUE X;% %WF 00008800
|
|
REAL X;% %WF 00008900
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@20 %WF 00009000
|
|
REAL PROCEDURE GOTOSOLVERINT(L, X, F, B);% %WF 00009100
|
|
VALUE L, X, F, B;% %WF 00009200
|
|
ARRAY F[*];% %WF 00009300
|
|
REAL L, X, B;% %WF 00009400
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@21 %WF 00009500
|
|
PROCEDURE ALGOLWRITE(TEN, FILX, CHSKP, LNSKP, FI, AEXP,% %WF 00009600
|
|
ARRY, LINESKIP, CHANSKIP, SUPRS, NUMWDS, TANK);% %WF 00009700
|
|
VALUE CHSKP, LNSKP, FI, AEXP, LINESKIP,% %WF 00009800
|
|
CHANSKIP, SUPRS, NUMWDS, TANK;% %WF 00009900
|
|
NAME FILX, TANK;% %WF 00010000
|
|
ARRAY TEN[*], ARRY[*];% %WF 00010100
|
|
INTEGER CHSKP, LNSKP, FI, AEXP, LINESKIP,% %WF 00010200
|
|
CHANSKIP, SUPRS, NUMWDS;%:">(<U(() %WF 00010300
|
|
FORWARD;% CODE=26000000, INTRINSIC NUMBER=@22 %WF 00010400
|
|
PROCEDURE ALGOLREAD(TEN, FILX, DKADD, ACT, FI, AEXP,% %WF 00010500
|
|
ARRY, EOFL, PARL, DKADR, CODE, TANK);% %WF 00010600
|
|
VALUE ACT, FI, AEXP, DKADR, CODE, TANK;% %WF 00010700
|
|
NAME FILX, TANK;% %WF 00010800
|
|
ARRAY TEN[*], ARRY[*];% %WF 00010900
|
|
REAL DKADD, EOFL, PARL, DKADR, CODE;% %WF 00011000
|
|
INTEGER ACT, FI, AEXP;% @6>}<XE2 %WF 00011100
|
|
FORWARD;% CODE=34000000, INTRINSIC NUMBER=@23 %WF 00011200
|
|
PROCEDURE ALGOLSELECT(ACT1, ACT2, TANK, I);% %WF 00011300
|
|
VALUE ACT1, ACT2, TANK, I;% %WF 00011400
|
|
NAME TANK;% %WF 00011500
|
|
INTEGER ACT1, ACT2, I;% %WF 00011600
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@24 %WF 00011700
|
|
PROCEDURE COBOLFCR;% %WF 00011800
|
|
FORWARD;% CODE=43000000, INTRINSIC NUMBER=@25 %WF 00011900
|
|
PROCEDURE COBOLIO; % GO TO 02700000 00012000
|
|
FORWARD;% CODE=43230000, INTRINSIC NUMBER=@26 %WF 00012100
|
|
PROCEDURE POLYMERGE(T1, T2, T3, ENDQ, BINGO, IPFIDX,% %WF 00012200
|
|
OUTPRO, INPRO, OUTF, INF, OPTOG, IPTOG, DKO, DKI,% %WF 00012300
|
|
TP1, TP2, TP3, TP4, TP5, NT, HIVALU, EQUALS,% %WF 00012400
|
|
R, ALFA, CORESIZE, DISKSIZE);% %WF 00012500
|
|
VALUE OPTOG, IPTOG, NT, HIVALU, EQUALS, R, ALFA,% %WF 00012600
|
|
CORESIZE, DISKSIZE;% %WF 00012700
|
|
NAME TP1, TP2, TP3, TP4, TP5;% %WF 00012800
|
|
REAL T1, T2, T3, ENDQ, BINGO, IPFIDX, OUTPRO, INPRO,% %WF 00012900
|
|
OUTF, INF, DKO, DKI, NT, HIVALU, EQUALS, R, CORESIZE; %WF 00013000
|
|
BOOLEAN OPTOG, IPTOG, ALFA;% %WF 00013100
|
|
INTEGER DISKSIZE;% %WF 00013200
|
|
FORWARD;% CODE=40140000, INTRINSIC NUMBER=@27 %WF 00013300
|
|
PROCEDURE STATUSINT(T, C);% %WF 00013400
|
|
VALUE T, C;% %WF 00013500
|
|
REAL T;% %WF 00013600
|
|
INTEGER C;% %WF 00013700
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@30 %WF 00013800
|
|
REAL PROCEDURE MAXINT(X);% %WF 00013900
|
|
VALUE X;% %WF 00014000
|
|
REAL X;% %WF 00014100
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@31 %WF 00014200
|
|
REAL PROCEDURE MININT(X);% %WF 00014300
|
|
VALUE X;% %WF 00014400
|
|
REAL X;% %WF 00014500
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@32 %WF 00014600
|
|
PROCEDURE DELAYINT(ARRY, MASK, TIME);% %WF 00014700
|
|
VALUE ARRY, MASK, TIME;% %WF 00014800
|
|
ARRAY ARRY[*];% %WF 00014900
|
|
REAL MASK;% %WF 00015000
|
|
INTEGER TIME;% %WF 00015100
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@33 %WF 00015200
|
|
PROCEDURE SUPERMOVLRINT(SORCE, DEST, AEXP);% %WF 00015300
|
|
VALUE AEXP;% %WF 00015400
|
|
ARRAY SORCE[*], DEST[*];% %WF 00015500
|
|
INTEGER AEXP;% %WF 00015600
|
|
FORWARD;% CODE= INTRINSIC NUMBER=@34 %WF 00015700
|
|
PROCEDURE SISO; FORWARD; %INT#35,SEQ#08400000 00015800
|
|
INTEGER PROCEDURE DELTA(P1,P2);%INT#36,SEQ#00022300 00015900
|
|
VALUE P1,P2; INTEGER P1,P2; FORWARD; 00015950
|
|
PROCEDURE ICVD; FORWARD; %INT#37,SEQ#00022500 00016000
|
|
PROCEDURE DYNAMICDIALER(B, A, X, F); 00016100
|
|
VALUE B, A, X, F; 00016110
|
|
INTEGER B, A, X; BOOLEAN F; 00016120
|
|
FORWARD;% CODE=00022700, INTRINSIC NUMBER=@40 00016130
|
|
PROCEDURE SCAN(UPDPDD,PTR,UPDCDD,HISCOUNT,CASECODE,CHAR); 00016200
|
|
VALUE PTR, HISCOUNT, CASECODE, CHAR; 00016210
|
|
NAME UPDPDD, UPDCDD; 00016220
|
|
INTEGER PTR, HISCOUNT, CASECODE, CHAR; 00016230
|
|
FORWARD; 00016240
|
|
PROCEDURE REPL; FORWARD; %INT#42,SE0#08420000 00016300
|
|
PROCEDURE COMPARE;FORWARD; %INT#43,SEQ#08430000 00016400
|
|
PROCEDURE BASICPRINT(TYPE); 00016500
|
|
VALUE TYPE; 00016510
|
|
REAL TYPE; 00016520
|
|
FORWARD;% CODE=08500000, INTRINSIC NUMBER=@44 00016530
|
|
PROCEDURE SWAP; FORWARD; %INT#45,SEQ#00023700 00016600
|
|
PROCEDURE BASICINPUT(TYPES); 00016700
|
|
VALUE TYPES; 00016710
|
|
REAL TYPES; 00016720
|
|
FORWARD;% CODE=08700000, INTRINSIC NUMBER=@46 00016730
|
|
PROCEDURE READATA(TYPE); 00016800
|
|
VALUE TYPE; 00016810
|
|
REAL TYPE; 00016820
|
|
FORWARD;% CODE=08600000, INTRINSIC NUMBER=@47 00016830
|
|
PROCEDURE FTINT ; FORWARD; % 050 00016900
|
|
PROCEDURE FTOUT ; FORWARD; % 051 00017000
|
|
PROCEDURE DABS ; FORWARD; % 052 00017100
|
|
PROCEDURE CABS ; FORWARD; % 053 00017200
|
|
PROCEDURE AINT ; FORWARD; % 054 00017300
|
|
PROCEDURE MATH ; FORWARD; % 055 00017400
|
|
PROCEDURE XTOI ; FORWARD; % 056 00017500
|
|
PROCEDURE IDINT ; FORWARD; % 057 00017600
|
|
PROCEDURE FLOAT ; FORWARD; % 060 00017700
|
|
PROCEDURE SNGL ; FORWARD; % 061 00017800
|
|
PROCEDURE DBLE ; FORWARD; % 062 00017900
|
|
PROCEDURE AMOD ; FORWARD; % 063 00018000
|
|
PROCEDURE TIME ; FORWARD; % 064 00018100
|
|
PROCEDURE DMOD ; FORWARD; % 065 00018200
|
|
PROCEDURE DMAX1 ; FORWARD; % 066 00018300
|
|
PROCEDURE DMIN1 ; FORWARD; % 067 00018400
|
|
PROCEDURE SIGNV ; FORWARD; % 070 00018500
|
|
PROCEDURE DSIGN ; FORWARD; % 071 00018600
|
|
PROCEDURE DIIM ; FORWARD; % 072 00018700
|
|
PROCEDURE REALP ; FORWARD; % 073 00018800
|
|
PROCEDURE AIMAG ; FORWARD; % 074 00018900
|
|
PROCEDURE CMPLX ; FORWARD; % 075 00019000
|
|
PROCEDURE CONJG ; FORWARD; % 076 00019100
|
|
PROCEDURE DEXP ; FORWARD; % 077 00019200
|
|
PROCEDURE CEXP ; FORWARD; % 100 00019300
|
|
PROCEDURE DLOG ; FORWARD; % 101 00019400
|
|
PROCEDURE CLOG ; FORWARD; % 102 00019500
|
|
PROCEDURE ALOG10; FORWARD; % 103 00019600
|
|
PROCEDURE DLOG10; FORWARD; % 104 00019700
|
|
PROCEDURE DSIN ; FORWARD; % 105 00019800
|
|
PROCEDURE CSIN ; FORWARD; % 106 00019900
|
|
PROCEDURE DCOS ; FORWARD; % 107 00020000
|
|
PROCEDURE CCOS ; FORWARD; % 110 00020100
|
|
PROCEDURE TANF ; FORWARD; % 111 00020200
|
|
PROCEDURE COTAN ; FORWARD; % 112 00020300
|
|
PROCEDURE DATAN ; FORWARD; % 113 00020400
|
|
PROCEDURE ATAN2 ; FORWARD; % 114 00020500
|
|
PROCEDURE DATAN2; FORWARD; % 115 00020600
|
|
PROCEDURE ARSIN ; FORWARD; % 116 00020700
|
|
PROCEDURE ARCOS ; FORWARD; % 117 00020800
|
|
PROCEDURE SINH ; FORWARD; % 120 00020900
|
|
PROCEDURE COSH ; FORWARD; % 121 00021000
|
|
PROCEDURE TANH ; FORWARD; % 122 00021100
|
|
PROCEDURE DSQRT ; FORWARD; % 123 00021200
|
|
PROCEDURE CSQRT ; FORWARD; % 124 00021300
|
|
PROCEDURE ERF ; FORWARD; % 125 00021400
|
|
PROCEDURE GAMMA ; FORWARD; % 126 00021500
|
|
PROCEDURE ALGAMA; FORWARD; % 127 00021600
|
|
PROCEDURE ANDI ; FORWARD; % 130 00021700
|
|
PROCEDURE ORI ; FORWARD; % 131 00021800
|
|
PROCEDURE CMPL ; FORWARD; % 132 00021900
|
|
PROCEDURE EQUIVP; FORWARD; % 133 00022000
|
|
PROCEDURE FORTERR;FORWARD; % 134 00022010
|
|
PROCEDURE MAX; FORWARD; % 135 00022011
|
|
PROCEDURE MIN; FORWARD; % 136 00022012
|
|
PROCEDURE IMOD; FORWARD; % 137 00022013
|
|
PROCEDURE CONCAT; FORWARD; % 140 00022014
|
|
PROCEDURE CONCAT; 00022020
|
|
FORWARD;% CODE=08400000, INTRINSIC NUMBER=@140 00022025
|
|
PROCEDURE MATRIXDIDDLER(A, B, C, TYPE); 00022030
|
|
VALUE A, B, C, TYPE; 00022032
|
|
ARRAY A[*], B[*], C[*]; 00022034
|
|
INTEGER TYPE; 00022036
|
|
FORWARD;% CODE=08800000, INTRINSIC NUMBER=@~4~ 00022038
|
|
PROCEDURE INVERT(A, B); 00022040
|
|
VALUE A, B; 00022050
|
|
ARRAY A[*], B[*]; 00022060
|
|
FORWARD;% CODE=09100000, INTRINSIC NUMBER=@142 00022070
|
|
PROCEDURE TRANSPOSE(A, B); 00022080
|
|
VALUE A, B; 00022090
|
|
ARRAY A[*], B[*]; 00022100
|
|
FORWARD;% CODE=08900000, INTRINSIC NUMBER=@143 00022110
|
|
PROCEDURE MATRIXMULTIPLY(A, B, C); 00022120
|
|
VALUE A, B, C; 00022130
|
|
ARRAY A[*], B[*], C[*]; 00022140
|
|
FORWARD;% CODE=09000000, INTRINSIC NUMBER=@144 00022150
|
|
PROCEDURE RANDOM(NUMBER, BASE); 00022160
|
|
VALUE NUMBER; 00022162
|
|
REAL NUMBER; 00022164
|
|
INTEGER BASE; 00022166
|
|
FORWARD;% CODE=00022900, INTRINSIC NUMBER=@145 00022168
|
|
PROCEDURE FORTRANFREEREAD; 00022170
|
|
FORWARD;% CODE=09200000, INTRINSIC NUMBER=@146 00022175
|
|
PROCEDURE BASICLOSE(FILX); 00022180
|
|
VALUE FILX; NAME FILX; 00022185
|
|
BEGIN REAL SELECT=14, ALGOLWRITE=12; ARRAY AIT=6[*]; 00022190
|
|
REAL T,I; ARRAY FIB[*]; NAME M=2; 00022195
|
|
SUBROUTINE MAYBEPRINT; 00022200
|
|
BEGIN FIB:=FILX[NOT 2]; 00022205
|
|
IF FIB[5].[41:3]=0 THEN %NOT CLOSED-NOT INPUT 00022210
|
|
IF FIB[4].[8:4] NEQ 10 THEN %NOT DATA COM 00022212
|
|
IF FIB[20].[3:15]!0 THEN % DATA LEFT 00022215
|
|
P(MKS,1,0,0,(FIB[20].[18:10]+1),FILX,ALGOLWRITE); 00022220
|
|
END; 00022225
|
|
IF P(.FILX,LOD)=0 THEN %EOJ FILE CLOSE 00022230
|
|
BEGIN I:=AIT[0]+1; WHILE (T:=AIT[I:=I-1]).[8:10] NEQ 0 00022235
|
|
DO IF T.[1:1] THEN 00022240
|
|
BEGIN FILX:=M[M[T.[18:15]] INX 4]; MAYBEPRINT END; 00022245
|
|
END ELSE %FILE RESTORE 00022250
|
|
BEGIN MAYBEPRINT; 00022255
|
|
P(MKS,2,0,[FILX[NOT 2]],4,SELECT); 00022260
|
|
FIB[0]:=FIB[8]:=FIB[20]:=FIB[21]:=0; 00022265
|
|
END; 00022270
|
|
END BASIC FILE RESTORE; 00022275
|
|
PROCEDURE FILEATTRIBUTES(T,E,D,V,G,I,TN); VALUE T,I,V,D,G; REAL D,G,I,E;00022280
|
|
INTEGER V; ARRAY TN[*]; NAME T; FORWARD; % CODE @ 0043000, INT # @150 00022281
|
|
PROCEDURE COBOLDECIMALTOOCTALCONVERT(A); % INI #=@151, CODE=09300000 00022282
|
|
VALUE A; NAME A; FORWARD ; 00022283
|
|
PROCEDURE COBOLOCTOLTODECIMALCONVERT(A,L,H,R,N,S,T); % INT #=@152 00022284
|
|
VALUE L,H,R,N,S,T; REAL L,H,R,N,S,T; NAME A; FORWARD; % CODE=09400000 00022285
|
|
PROCEDURE FORTRANFREEWRITE(F,D,R,W,L,I,N,S); VALUE I,D,R,W,L; INTEGER R,00022286
|
|
W; REAL I,D,L; NAME F; ARRAY S[*],N[*]; FORWARD ;%COD @02976019.INT@153 00022287
|
|
PROCEDURE FINNAME; FORWARD; 00022288
|
|
PROCEDURE FOUTNAME; FORWARD; 00022289
|
|
PROCEDURE FTINTFIX(F1,D1,F2,F3,L1,E1,E2,P1); VALUE D1,F2,L1,E1,E2,P1 ; 00022292
|
|
REAL D1,F2,L1,E1,E2,P1; ARRAY F3[*]; NAME F1; FORWARD; % INTRINSIC @156 00022293
|
|
PROCEDURE FTOUTFIX(F,D,R,Q,L,E,EL,PL); VALUE D,R,L,E,EL,PL; REAL D,R,L,E00022294
|
|
,EL,PL; NAME F; ARRAY Q[*]; FORWARD ; % CODE AT SEQ # 02886040. INT@15700022295
|
|
PROCEDURE FBINBACKBLOCK(F1,D,F2,F3,L,E1,E2,P1); VALUE D,F2,L,E1,E2,P1 ;00022296
|
|
REAL D,F2,L,E1,E2,P1; ARRAY F3[*]; NAME F1; FORWARD; % INT # @160. 00022297
|
|
PROCEDURE COBOLVARSZ; FORWARD;% CODE=09500000 INT #=@161 00022298
|
|
PROCEDURE COBOLIONONDSK; FORWARD;% CODE=09600000 INT #=@162 00022299
|
|
PROCEDURE COBOLIODSK; FORWARD;% CODE=09700000 INT #=@163 00022300
|
|
PROCEDURE FORTRANMEMHANDLER(A,H);VALUE H;REAL H;ARRAY A[*];FORWARD;%164 00022301
|
|
PROCEDURE COBOLATT; FORWARD; % CODE = 02650000 INT # = @165 %CJC 103I00022302
|
|
PROCEDURE INTERRUPTER; FORWARD; % CODE=09800000; INT #=@166 00022303
|
|
PROCEDURE COBOLDC; FORWARD; % CODE = 02690000 INT #=@167 00022304
|
|
INTEGER PROCEDURE DELTA(P1,P2); VALUE P1,P2; REAL P1,P2; %@036 00022310
|
|
BEGIN 00022320
|
|
DEFINE 00022330
|
|
DOT=[18:13]#, AMPER=[18:35:13]#; 00022340
|
|
COMMENT @4000000=2*20, WHICH IS 1 LARGER THAN ANY 6500 COUNT.; 00022350
|
|
COMMENT DELTA=2*20 IF DESC(P1)!DESC(P2) OR CSIZE-S ARE !; 00022360
|
|
IF (P2-P1).[31:17]!0 THEN DELTA~@4000000 ELSE 00022370
|
|
DELTA~P2.DOT-P1.DOT; 00022380
|
|
END DELTA; 00022390
|
|
00022400
|
|
PROCEDURE ICVD; %37 00022500
|
|
BEGIN 00022510
|
|
DEFINE DOT=[18:13]#, AMPER=[18:35:13]#, CSIZE=[31:02]#,SIX=0#; 00022520
|
|
ARRAY STRING[*]; 00022530
|
|
NAME M = 2; 00022540
|
|
REAL PTR=-3; INTEGER N=-1; 00022550
|
|
IF PTR.CSIZE!SIX THEN POLISH(M&1[17:47:01],9999,CDC,DEL); 00022560
|
|
STRING ~ M[PTR]; 00022570
|
|
N~N; COMMENT MAKE SURE N IS INTEGERIZED; 00022575
|
|
IF N>8 THEN POLISH(M&1[14:47:01],N,CDC,DEL); 00022580
|
|
POLISH([STRING[(PTR.DOT+N-1).[35:10]]], DEL); 00022590
|
|
STREAM(RESULT~0:S~[STRING[PTR.[18:10]]], N, 00022600
|
|
SKS~PTR.[28:03]); 00022610
|
|
BEGIN 00022620
|
|
DI ~ LOC RESULT; 00022630
|
|
SI ~ S; SI ~ SI+SKS; 00022640
|
|
DS ~ N OCT; 00022650
|
|
END; 00022660
|
|
PTR ~ P; 00022670
|
|
END ICVD; 00022680
|
|
PROCEDURE DYNAMICDIALER(A,B,X,F) ; 00022700
|
|
VALUE B, A, X, F; 00022705
|
|
INTEGER B, A, X; BOOLEAN F; 00022710
|
|
BEGIN % A,B,X,Y,Z ARE AS IN Y&Z[A:B:X]. 00022715
|
|
% F=TRUE => X WAS LITERAL, AND TRB WILL BE DONE AFTER XITING.00022720
|
|
REAL Y=-7, Z=-6, C=+1 ; 00022725
|
|
DEFINE Q= @3403007777777777 #, % MASK FOR ZERO-ING OUT THE G,H,K&V- 00022730
|
|
% REGISTER PARTS OF THE RCW. 00022735
|
|
R= @0055005500610065 #, % NOP,DIA,DIB,TRB. 00022740
|
|
S= @0055703404210435 #; % NOP,LITC Y,STD,XIT. 00022745
|
|
IF (A~A)<1 OR (B~B)<1 OR (X~X)<1 OR X+A>48 OR X+B>48 00022750
|
|
THEN P((-63),26,COM) ; 00022755
|
|
IF F THEN P(Q,AND,0&(B MOD 6)[4:9:3],A MOD 6,DIB 7,TRB 3, 00022760
|
|
P&(B DIV 6)[12:45:3],A DIV 6,DIB 15,TRB 3,OR,0,0,XIT) ; 00022765
|
|
GO P(P(R)&(B DIV 6)[12:45:3],A DIV 6,DIB 24,TRB 3,P&(B MOD 6) 00022770
|
|
[15:9:3],A MOD 6,DIB 27,TRB 3,P&X[36:42:6],.A,~,S,.B,~,Y,Z,[A]);00022775
|
|
END DYNAMICDIALER; 00022830
|
|
00022840
|
|
00022850
|
|
PROCEDURE RANDOM(NUMBER, BASE); 00022900
|
|
VALUE NUMBER; 00022925
|
|
REAL NUMBER; 00022950
|
|
INTEGER BASE; 00022975
|
|
BEGIN INTEGER N; 00023000
|
|
REAL T; 00023025
|
|
IF (T := NUMBER MOD 1.0)>0 THEN 00023100
|
|
BEGIN BASE := T.[9:38]; P(RTN); END; 00023150
|
|
IF NUMBER!0 THEN 00023200
|
|
BEGIN T := POLISH(1, 1, COM); 00023250
|
|
N := 0 & T[10:36:6] & T[16:42:6] & T[22:30:6] 00023300
|
|
& ((T.[30:18])|P(DUP))[28:22:20]; 00023350
|
|
END ELSE IF (N := BASE)=0 THEN N := @2631353020000; 00023400
|
|
T := 3 & (N.[10:26]|6137 + 2197513)[10:12:36]; 00023450
|
|
POLISH((((BASE := T) OR 0.5) - 0.5) + P(DUP), RTN); 00023500
|
|
END RANDOM; 00023550
|
|
00023600
|
|
PROCEDURE SWAP; % 045 00023700
|
|
BEGIN 00023710
|
|
ARRAY A = -2 [*,*], B = -1 [*,*]; 00023720
|
|
STREAM(A, B, CA~0, CB~0, FA~A.[18:15], FB~B.[18:15]); 00023730
|
|
BEGIN 00023740
|
|
SI ~ A; CA ~ SI; 00023750
|
|
SI ~ B; CB ~ SI; 00023760
|
|
DI ~ LOC B; DI ~ DI+5; SKIP 3 DB; 00023770
|
|
SI ~ LOC CA; SI ~ SI+5; SKIP 3 SB; 00023780
|
|
3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); DS ~ 2 CHR; 00023790
|
|
DI ~ FB; SI ~ LOC B; DS ~ WDS; 00023800
|
|
DI ~ LOC A; DI ~ DI+5; SKIP 3 DB; 00023810
|
|
SI ~ LOC CB; SI ~ SI+5; SKIP 3 SB; 00023820
|
|
3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); DS ~ 2 CHR; 00023830
|
|
DI ~ FA; SI ~ LOC A; DS ~ WDS; 00023840
|
|
END; 00023850
|
|
END SWAP; 00023860
|
|
00023900
|
|
00024000
|
|
00024100
|
|
00024200
|
|
COMMENT ALGOL WRITE INTRINSIC;% 00100000
|
|
PROCEDURE ALGOLWRITE(TEN, FILX, CHSKP, LNSKP, FI, AEXP, %WF 00100100
|
|
ARRY, LINESKIP, CHANSKIP, SUPRS, NUMWDS, TANK); %WF 00100200
|
|
VALUE LINESKIP, CHANSKIP, SUPRS, NUMWDS, TANK, %WF 00100300
|
|
CHSKP, LNSKP, FI, ARRY; %WF 00100400
|
|
INTEGER CHSKP, LNSKP, FI, AEXP, %WF 00100500
|
|
LINESKIP, CHANSKIP, NUMWDS, SUPRS; %WF 00100600
|
|
NAME FILX, TANK; %WF 00100700
|
|
ARRAY ARRY[*], TEN[*]; %WF 00100800
|
|
BEGIN REAL SELECT=14,REED=13,ADDRESS;% 00100900
|
|
NAME MEM=2;% 00101000
|
|
LABEL AB,ACTION; 00101100
|
|
LABEL DS,WINDUP1; 00101200
|
|
ARRAY FPB=3[*],FIB[*],HEADER[*];% 00101300
|
|
INTEGER I,RSIZE;% 00101400
|
|
INTEGER SPOUT; 00101450
|
|
ARRAY TINK=TANK[*]; %WF 00101500
|
|
REAL CHNSKP=CHANSKIP; 00101550
|
|
REAL ALGOLWRITE=12; %WF 00101600
|
|
DEFINE FNUM = FIB[4].[13:11] #; 00101650
|
|
DEFINE IOD=(*TANK)#;% 00101700
|
|
$ SET OMIT = NOT(TIMESHARING) 00101750
|
|
SUBROUTINE WAIT; POLISH(TANK, @2000000000, 36, COM, DEL, DEL); 00101752
|
|
$ POP OMIT 00101753
|
|
$ SET OMIT = TIMESHARING 00101799
|
|
LABEL ERR,LP1,MT1,CLOSED,DK1,SP1,CP1,DC1,PP1;% 00101900
|
|
LABEL DCN1,DCN2,SPIN; 00101910
|
|
$ SET OMIT = NOT SHAREDISK 00101919
|
|
SWITCH SW1~ ERR,LP1,MT1,CLOSED,DK1,SP1,CP1,LP1,PP1,ERR,DC1, 00102000
|
|
ERR,LP1,DCN1; 00102010
|
|
LABEL LP2,MT2,DK2,SP2,CP2,DC2,PP2;% 00102100
|
|
SWITCH SW2~ ERR,LP2,MT2,ERR,DK2,SP2,CP2,LP2,PP2,ERR,DC2,ERR, 00102200
|
|
LP2,DCN2; 00102210
|
|
LABEL DS1,DR1,DU1;% 00102300
|
|
SWITCH DSW1~DS1,DR1,DU1,CLOSED; 00102400
|
|
LABEL UT,PBIT,OWT,D19,RELEASE,STA,EXIT,L1,WINDUP,DBIT;% 00102500
|
|
LABEL TYPEU,TYPEA,TYPEC;% 00102600
|
|
SWITCH TYPE~TYPEU,TYPEA,ERR,TYPEC;% 00102700
|
|
LABEL DS2,DR2,DU2;% 00102800
|
|
SWITCH DSW2~DS2,DR2,DU2;% 00102900
|
|
SUBROUTINE BLOCK;% 00103000
|
|
BEGIN GO TO TYPE[I~FIB[5].[46:2]];% 00103100
|
|
TYPEC: STREAM(D1~IOD,S~(NUMWDS~NUMWDS+1)|8,% 00103200
|
|
D2~(TANK[0]~NUMWDS INX IOD));% 00103300
|
|
BEGIN SI~LOC S; DI~DI-8; DS~4 DEC; DI~D1;% 00103400
|
|
SI~D2; SI~SI-8; DI~DI-4; DS~4 CHR;% 00103500
|
|
END;% 00103600
|
|
IF (FIB[17]~FIB[17]-NUMWDS)>RSIZE+1 THEN BEGIN% 00103700
|
|
OWT: FIB[7]~FIB[7]+1; P(XIT);% 00103800
|
|
TYPEA: IF (FIB[17]~FIB[17]-RSIZE)}RSIZE THEN% 00103900
|
|
BEGIN TANK[0]~RSIZE INX IOD; GO OWT END END;% 00104000
|
|
NUMWDS~FIB[18].[18:15]-FIB[17]+(I=3);% 00104100
|
|
TYPEU: END BLOCK;% 00104200
|
|
REAL SUBROUTINE DISKADDRESS;% 00104300
|
|
BEGIN% 00104400
|
|
ADDRESS~(CHANSKIP DIV HEADER[0].[30:12])|HEADER[0].[42:6];% 00104500
|
|
IF (SUPRS~ADDRESS DIV HEADER[1]+10)}30 THEN 00104600
|
|
BEGIN P(0); GO TO EXIT END; 00104700
|
|
IF HEADER[SUPRS]=0 THEN 00104800
|
|
IF HEADER[9]>(SUPRS-10) THEN% 00104900
|
|
P(FPB[FNUM+3],FPB[FNUM],FPB[FNUM+1],SUPRS,HEADER, 00105000
|
|
4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL) ELSE 00105050
|
|
BEGIN P(0); GO TO EXIT END;% 00105100
|
|
ADDRESS~HEADER[SUPRS]+SUPRS~ADDRESS MOD HEADER[1];% 00105200
|
|
STREAM(D~[ADDRESS]); BEGIN SI~D; DS~8 DEC END; P(1);% 00105300
|
|
EXIT: DISKADDRESS~P;% 00105400
|
|
END DISKADDRESS;% 00105500
|
|
IF TINK=0 THEN %WF 00105600
|
|
BEGIN FIB ~ FILX[NOT 2]; %WF 00105700
|
|
IF FIB[5].[11:2]<2 THEN P(MKS,"WRITNG",FILX,7,SELECT) ; 00105703
|
|
IF FIB[5].[43:1] THEN 00105710
|
|
P(MKS, CHSKP, 0, FILX, 1, SELECT); 00105720
|
|
IF LNSKP>1 AND ARRY<0 AND (I~FIB[4].[8:4])!1 00105750
|
|
$ SET OMIT = NOT(TIMESHARING) 00105752
|
|
AND I!7 AND I!12 AND I!10 THEN 00105753
|
|
$ SET OMIT = TIMESHARING 00105754
|
|
P(XIT);%CARRIAGE CONTROL ON NON-PRINTER FILE 00105760
|
|
00105800
|
|
00105900
|
|
RSIZE ~ P(MKS, LNSKP, CHSKP, SUPRS, %WF 00106000
|
|
(-1), FILX, ALGOLWRITE); %WF 00106100
|
|
IF ARRY{0 THEN SUPRS ~ 1 ELSE %WF 00106200
|
|
BEGIN % 11/24/72 - CORRECTED 10/3/73 00106300
|
|
IF ARRY.[8:10]=P(DUP,0) THEN % INDEXED WRITE 00106320
|
|
P(DEL,AEXP) % WRITE MIN(AEXP,RSIZE) WORDS 00106340
|
|
ELSE % WRITE MIN(ARRY SIZE,AEXP,RSIZE) WORDS 00106360
|
|
IF P GTR P(DUP,AEXP) % 00106380
|
|
THEN P(DEL,AEXP); %WF 00106400
|
|
IF P(DUP)}RSIZE THEN P(DEL) ELSE RSIZE ~ P; %WF 00106500
|
|
STREAM(P4 ~ [ARRY[0]], P3 ~ RSIZE, %WF 00106600
|
|
P2 ~ P(DUP).[36:6], P1 ~ *FILX); %WF 00106700
|
|
BEGIN SI ~ P4; DS ~ P3 WDS; %WF 00106800
|
|
P2(DS ~ 32 WDS; DS ~ 32 WDS); %WF 00106900
|
|
END; %WF 00107000
|
|
END; %WF 00107100
|
|
IF RSIZE>0 THEN P(MKS, LNSKP, %WF 00107200
|
|
CHSKP, SUPRS, RSIZE, FILX, ALGOLWRITE); %WF 00107300
|
|
FILX[NOT 4] ~ FILX[NOT 3] ~ 0; %WF 00107400
|
|
P(XIT); %WF 00107500
|
|
END; %WF 00107600
|
|
FIB~TANK[NOT 2];% 00107700
|
|
UT: I~FIB[4].[8:4]; RSIZE~FIB[18].[33:15];% 00107800
|
|
SPOUT:=(I=5); 00107820
|
|
$ SET OMIT = TIMESHARING 00107840
|
|
IF CHNSKP.[4:1] THEN 00107860
|
|
BEGIN CHNSKP.[4:1]~0; 00107870
|
|
$ SET OMIT = NOT SHAREDISK 00107879
|
|
END; 00107890
|
|
IF NUMWDS<0 THEN GO TO SW1[I]; GO TO SW2[I];% 00107900
|
|
LP1: MT1: SP1: CP1: PP1: 00108000
|
|
% 00108100
|
|
D19: IF IOD.[19:1] THEN% 00108200
|
|
PBIT: IF IOD.[2:1] THEN P(RSIZE,RTN) ELSE% 00108300
|
|
IF IOD.[25:1] THEN% 00108400
|
|
CLOSED: BEGIN 00108410
|
|
FIB[13].[27:1]~0; 00108420
|
|
IF (I~(FPB[FNUM+3] AND 31))!10 AND I!12 00108430
|
|
AND I!13 AND I!26 THEN FIB[5].[45:1]~0 ELSE 00108440
|
|
FIB[5].[45:1]~P(TANK[NOT 3],DUP)!0 AND P(XCH)!15; 00108450
|
|
P(TANK,0,11,COM,DEL,DEL) ; 00108510
|
|
IF NOT FIB[5].[45:1] THEN GO UT ; 00108515
|
|
P(TANK[NOT 3]); TANK[NOT 3]~TANK[NOT 4]~0 ; 00108520
|
|
P(MKS,9,BLKCNTRL,DEL) ;% TAKE PARITY ACTION LBL BRNCH. 00108525
|
|
P(1); GO TO DS; 00108530
|
|
END ELSE 00108535
|
|
IF IOD.[27:1] AND (I=2 OR I=7 OR I=8) THEN% 00108600
|
|
BEGIN IF NOT FIB[4].[2:1] THEN% 00108700
|
|
BEGIN HEADER~TANK[NOT 1];HEADER[4].[42:6]~1 END;00108800
|
|
IF I=7 THEN FIB[9].[1:1]~1; % MULTI-REEL PBT FILE 00108850
|
|
I~FIB[13].[28:10]+1;% 00108900
|
|
P(MKS,6,0,(NOT 2) INX TANK,4,SELECT);% 00109000
|
|
FIB[13].[28:10]~I; GO TO CLOSED;% 00109100
|
|
END ELSE% 00109200
|
|
BEGIN 00109300
|
|
ERR: P(3); 00109310
|
|
DS: P(TANK,XCH,11,COM); 00109320
|
|
END; 00109330
|
|
WAIT; GO TO PBIT;% 00109400
|
|
DK1: HEADER~*[FIB[14]]; GO TO DSW1[FIB[4].[27:3]];% 00109500
|
|
DK2: HEADER~*[FIB[14]]; GO TO DSW2[FIB[4].[27:3]];% 00109600
|
|
CP2: BLOCK; TANK[0]~FLAG(FIB[16])&CHANSKIP[32:47:1]; GO TO RELEASE;% 00109700
|
|
LP2: IF SUPRS THEN STREAM(RSIZE,D~IOD); BEGIN RSIZE(DS~8 LIT " ") END; 00109800
|
|
CHANSKIP~CHANSKIP+LINESKIP.[45:1]; 00109850
|
|
IF CHANSKIP!0 THEN% 00109900
|
|
BEGIN IF (I~FIB[17]-RSIZE)>0 THEN% 00110000
|
|
STREAM(I,D~RSIZE INX IOD); BEGIN I(DS~8 LIT " ") END;% 00110100
|
|
END ELSE BLOCK;% 00110200
|
|
TANK[0]~FLAG(FIB[16])&LINESKIP[27:47:1]&LINESKIP[28:46:1]% 00110300
|
|
&CHANSKIP[29:44:4]&NUMWDS[8:38:10];% 00110400
|
|
GO TO RELEASE;% 00110500
|
|
SP2: PP2:% 00110600
|
|
MT2: BLOCK;% 00110700
|
|
P(TANK[0]~FLAG(FIB[16])&NUMWDS[8:38:10],NUMWDS,XCH,INX,% 00110800
|
|
@3700000000000000,XCH,~);% 00110900
|
|
IF SPOUT THEN % SPO OUTPUT 00110910
|
|
IF FPB[FNUM+3].[42:6]=43 THEN P(XIT) ELSE %DUMMY 00110920
|
|
P(0,0,NOT,IOD,INX,15,COM,XIT) 00110940
|
|
ELSE 00110990
|
|
RELEASE: P(FLAG(FIB[19])&IOD[3:3:5],TANK,PRL,DEL);% 00111000
|
|
WINDUP: I~FIB[19].[33:15]-FIB[16].[33:15];% 00111100
|
|
FIB[16].[33:15]~SUPRS~MEM[P(DUP) INX NOT 1].[18:15];% 00111200
|
|
FIB[19].[33:15]~SUPRS+I;% 00111300
|
|
WINDUP1: 00111400
|
|
FIB[6]~FIB[6]+1; FIB[7]~FIB[7]+1; FIB[17]~FIB[18].[18:15];% 00111500
|
|
P(XIT);% 00111600
|
|
DU1:% 00111700
|
|
DS1: IF LINESKIP!0 THEN% 00111800
|
|
BEGIN IF IOD.[27:1] AND IOD.[19:1] THEN GO AB; 00111900
|
|
IF FIB[17]=FIB[18].[18:15] THEN 00111950
|
|
BEGIN CHANSKIP~FIB[7];% 00112000
|
|
L1: IF DISKADDRESS THEN% 00112100
|
|
IF IOD.[19:1] THEN DBIT: IF IOD.[2:1] THEN% 00112200
|
|
BEGIN 00112300
|
|
$ SET OMIT = NOT SHAREDISK 00112309
|
|
MEM[FIB[16]]~ADDRESS; 00112340
|
|
P(RSIZE,RTN); 00112350
|
|
END ELSE 00112360
|
|
IF IOD.[25:1] THEN GO TO CLOSED ELSE 00112400
|
|
$ SET OMIT = NOT SHAREDISK 00112409
|
|
BEGIN 00112420
|
|
$ SET OMIT = NOT SHAREDISK 00112429
|
|
GO TO AB; 00112440
|
|
END ELSE 00112450
|
|
BEGIN WAIT; GO TO DBIT; END ELSE 00112460
|
|
BEGIN 00112470
|
|
$ SET OMIT = NOT SHAREDISK 00112479
|
|
GO TO AB; 00112490
|
|
END; 00112500
|
|
END; P(RSIZE,RTN);% 00112600
|
|
END;% 00112700
|
|
P(MKS,CHANSKIP,4,TANK,1,SELECT); GO TO L1; 00112800
|
|
DS2: IF FIB[7]>HEADER[7] THEN HEADER[7]~FIB[7];% 00112900
|
|
BLOCK; TANK[0]~FLAG(FIB[16]); GO RELEASE;% 00113000
|
|
DR1: IF LINESKIP!0 THEN CHANSKIP~FIB[7] ELSE FIB[7]~CHANSKIP;% 00113100
|
|
IF HEADER[7]<CHANSKIP THEN HEADER[7]~CHANSKIP;% 00113200
|
|
$ SET OMIT = NOT SHAREDISK 00113249
|
|
IF FIB[5].[46:2]=0 THEN GO TO L1;% 00113300
|
|
IF DISKADDRESS THEN% 00113400
|
|
BEGIN FIB[16].[24:1]~1;% 00113500
|
|
$ SET OMIT = SHAREDISK 00113599
|
|
P(MKS,CHANSKIP+1,1,TANK,REED,RTN);% 00113600
|
|
$ POP OMIT 00113601
|
|
$ SET OMIT = NOT SHAREDISK 00113649
|
|
END;% 00113700
|
|
$ SET OMIT = NOT SHAREDISK 00113749
|
|
GO TO AB; 00113800
|
|
DR2: 00113900
|
|
$ SET OMIT = NOT SHAREDISK 00113909
|
|
TANK[0]~FLAG(FIB[16])&0[24:24:1]; 00113980
|
|
P(FLAG(FIB[19])&IOD[3:3:5]&1[27:47:1],TANK,PRL,DEL);% 00114000
|
|
$ SET OMIT = NOT SHAREDISK 00114049
|
|
GO TO WINDUP;% 00114100
|
|
DU2:: FIB[5].[43:2]~2;% 00114300
|
|
IF FIB[7]>HEADER[7] THEN HEADER[7]~FIB[7];% 00114400
|
|
BLOCK;% 00114500
|
|
CHANSKIP~FIB[7]+FIB[13].[10:9]|HEADER[0].[30:12];% 00114600
|
|
IF DISKADDRESS THEN% 00114700
|
|
BEGIN P(TANK[0]~FLAG(FIB[16])&0[24:24:1],(NOT 0),XCH,INX,% 00114800
|
|
ADDRESS,XCH,~);% 00114900
|
|
P(FLAG(FIB[19])&1[24:47:1],TANK,PRL,DEL);% 00115000
|
|
END ELSE% 00115100
|
|
BEGIN TANK[0]~FLAG(FIB[16])&0[24:24:1];% 00115200
|
|
P(FLAG(FIB[19])&1[24:44:4],TANK,PRL,DEL);% 00115300
|
|
END;% 00115400
|
|
GO TO WINDUP;% 00115500
|
|
$ SET OMIT = NOT(TIMESHARING) 00115501
|
|
DC1:: P(RSIZE, RTN); 00115510
|
|
$ SET OMIT = TIMESHARING 00115590
|
|
AB:: BEGIN IF(ADDRESS~TANK[NOT 4])=0 THEN GO ERR; 00115800
|
|
ACTION:: TANK[NOT 3]~TANK[NOT 4] ~0; 00115900
|
|
TANK[0] := IOD OR MEM; 00116000
|
|
P(ADDRESS,MKS,9,JUNK); GO TO ERR; 00116100
|
|
END; 00116200
|
|
IF TANK[NOT 4]=0 THEN BEGIN WAIT; GO TO DC1 END; 00116300
|
|
IF P(CHANSKIP.[CF]|60,CHANSKIP,TANK,18,11,COM,DEL,DEL,DEL) 00116400
|
|
THEN P(RSIZE,RTN); 00116500
|
|
GO TO AB; 00116600
|
|
$ SET OMIT = NOT(TIMESHARING) 00116601
|
|
DC2: IF CHANSKIP.[CF] NEQ 0 THEN CHANSKIP:=ABS(CHANSKIP&1[CTF]) 00116610
|
|
ELSE CHANSKIP ~ (8|(LINESKIP=4)+LINESKIP.[45:3]) 00116620
|
|
&LINESKIP[32:43:1]; 00116630
|
|
NUMWDS ~ IF SUPRS THEN 0 ELSE 8|NUMWDS; 00116635
|
|
POLISH(IOD, NUMWDS, CHANSKIP, 0, (-11), COM, DEL); 00116640
|
|
I:=POLISH+1; 00116644
|
|
ADDRESS:=TANK[NOT(4-(I=2))]; 00116646
|
|
TANK[NOT 4]:=TANK[NOT 3]:=0; 00116648
|
|
IF I THEN P(XIT); 00116650
|
|
IF ADDRESS NEQ 0 THEN 00116652
|
|
P(ADDRESS,MKS,9,BLKCNTRL); 00116654
|
|
ADDRESS:=1+((I=0)|2); 00116656
|
|
P(TANK,ADDRESS,11,COM); 00116658
|
|
DCN1:DCN2:SPIN: P(XIT); 00116660
|
|
$ SET OMIT = TIMESHARING 00116690
|
|
END ALGOLWRITE; 00118800
|
|
PROCEDURE OUTPUTINT(TEN,FILX,CHSKP,LNSKP,FI,FRMT,LISX);% 00200000
|
|
COMMENT ESPOL VERSION OF ALGOL WRITE INTRINSIC% 00200100
|
|
BY L.R. GUCK 12/1/64;% 00200200
|
|
VALUE CHSKP,LNSKP,FI,LISX;% 00200300
|
|
NAME FILX;% 00200400
|
|
ARRAY TEN[*],% 00200500
|
|
FRMT[*];% 00200600
|
|
REAL LISX;% 00200700
|
|
INTEGER CHSKP,LNSKP,FI;% 00200800
|
|
BEGIN% 00200900
|
|
REAL ALGOLWRITE=12;% 00201000
|
|
ARRAY REALROW=TEN-1[*];% 00201100
|
|
REAL SELECT=14;% 00201200
|
|
REAL JUNK2=9;% 00201300
|
|
INTEGER V2=1 ; 00201310
|
|
INTEGER TEMPD=7 ; 00201320
|
|
INTEGER JUNK1=17;% 00201400
|
|
INTEGER LSTRN=19;% 00201500
|
|
INTEGER AEXP =FRMT;% 00201600
|
|
ARRAY ARRY =LISX[*];% 00201700
|
|
INTEGER TLSTRN=+1 ;% 00201800
|
|
REAL UTYP = TLSTRN+1; 00201900
|
|
DEFINE UTIP =UTYP.[47:1] #, %%%% USED FOR NON-BOOLEAN USE OF UTYP00201905
|
|
FFTYP=UTYP.[46:1] #, %%%% FLAG TO SHOW USING FREE FIELD. 00201906
|
|
STORW=UTYP.[40:6] #, %%%% USED TO STORE ORIG VALUE OF W. 00201907
|
|
UES =UTYP.[39:1] #, %%%% FLAG TO INCLUDE EXPONENT SIGN. 00201908
|
|
UDC =UTYP.[38:1] #, %%%% FLAG TO INCLUDE DECIMAL POINI. 00201909
|
|
UED =UTYP.[36:2] #, %%%% NUMBER OF EXPONENT DIGITS. 00201910
|
|
UMD =UTYP.[35:1] #, %%%% FLAG TO INCLUDE MANTISSA. 00201911
|
|
STORD=UTYP.[29:6] #, %%%% USED TO STORE ORIG VALUE OF D 00201912
|
|
UBUFF=UTYP.[16:13]#, %%%% ADJUSIED BUFFER SIZE. . 00201913
|
|
UTOP =UTYP.[15:1] #, %%%% FLAG TO INCLUDE TRAILING BLANK. 00201914
|
|
USKIP=UTYP.[09:6] #, %%%% # XTRA LEADING BLANKS FOR I OR F00201915
|
|
FFCHR=UTYP.[03:6] #; %%%% FREE FIELD DELIMITER (, OR BLNK)00201917
|
|
INTEGER SUPRS = UTYP+1; 00201920
|
|
REAL BUFF=SUPRS+1;% 00202000
|
|
INTEGER BSIZE=BUFF+1;% 00202100
|
|
ARRAY FIB=BSIZE+1[*];% 00202200
|
|
REAL WH2=FIB+1;% 00202300
|
|
REAL WH1=WH2+1;% 00202400
|
|
REAL DH1=WH1+1;% 00202500
|
|
INTEGER DH2=DH1+1;% 00202600
|
|
REAL W=DH2+1;% 00202700
|
|
REAL W1=W+1;% 00202800
|
|
REAL W2=W1+1;% 00202900
|
|
REAL WT=W2+1;% 00203000
|
|
REAL D=WT+1;% 00203100
|
|
REAL D1=D+1;% 00203200
|
|
REAL D2=D1+1;% 00203300
|
|
REAL DA=D2+1;% 00203400
|
|
REAL SKIP=DA+1;% 00203500
|
|
REAL CHR=SKIP+1;% 00203600
|
|
INTEGER E=CHR+1;% 00203700
|
|
REAL ZEROS=E+1;% 00203800
|
|
REAL CODE=ZEROS+1;% 00203900
|
|
REAL FAW=CODE+1;% 00204000
|
|
REAL SGN=FAW+1;% 00204100
|
|
INTEGER SCFTR=SGN+1;% 00204200
|
|
REAL TPHRASE=SCFTR+1; 00204210
|
|
INTEGER LZ = TPHRASE + 1; 00204220
|
|
LABEL RTNPRNT,EFA,EFC,EERTN,RNA,RNB,% 00204300
|
|
START,ISFRM,AEXL,ISA,ISB,ASLST,BS,BR,BB,ERROR,% 00204400
|
|
FMOUT,S1,S,LFPAR,RTPAR,SLASH,SCALE,STRNG,% 00204500
|
|
PHRAS,INLOOP,ASTB,ASTA,AST,FLDW,JMP,% 00204600
|
|
LOGI,ALFA,DOTYPE,XTYPE,ITYPE,% 00204700
|
|
FTYPE,RFIN,FA,FB,FC,FD,UTYPE,UI,UF,ESUBTYPE,ETYPE1,COMMM, 00204800
|
|
FORMATERR,TTYPE,BACK, 00204810
|
|
ETYPE,REIN,EA,ERTN,REOT,EB,MAXN,TEN8,% 00204900
|
|
RTYPE,RC,TRYE,RRTN,MAXM,COMM;% 00205000
|
|
COMMENT LABELS ARE LISTED IN SAME ORDER THEY APPEAR;% 00205100
|
|
DEFINE LOG8 = @1157163034761674#,% 00205200
|
|
MAX =@0007777777777777#,% 00205300
|
|
SAVEBUFF=TPHRASE.[30:18]#, 00205305
|
|
MAXCHR =TPHRASE.[18:12]#, 00205310
|
|
P = POLISH#;% 00205400
|
|
SUBROUTINE CKPB;% 00205500
|
|
BEGIN% 00205600
|
|
IF FILX.[18:15] { 1 THEN% 00205700
|
|
BEGIN IF NOT FILX.[18:15] THEN% 00205800
|
|
BEGIN;STREAM(A~[REALROW[0]]:B~0);% 00205900
|
|
BEGIN SI~A; DI~A; SI~SI-16; 00206000
|
|
SKIP 2 SB;% 00206100
|
|
IF SB THEN TALLY ~ 1;% 00206200
|
|
A ~ TALLY;% 00206300
|
|
END;% 00206400
|
|
IF NOT P THEN% 00206500
|
|
BEGIN P(FILX,14,COM,DEL);% 00206600
|
|
FILX.[18:15] ~ 1;% 00206700
|
|
END;% 00206800
|
|
END;% 00206900
|
|
BSIZE ~ REALROW.[8:10];% 00207000
|
|
END ELSE% 00207100
|
|
BSIZE~POLISH(MKS,LNSKP,CHSKP,SUPRS,(-1),FILX,ALGOLWRITE); 00207200
|
|
BUFF~(*FILX)&BSIZE[8:38:10] ; 00207300
|
|
END;% 00207400
|
|
SUBROUTINE PRNT;% 00207500
|
|
BEGIN COMMENT RELEASE BUFFER;% 00207600
|
|
COMMENT S= RETURN LITERAL.% 00207700
|
|
S-1 = IF TRUE THEN RETURN AFTER RELEASE.% 00207800
|
|
IF FALSE THEN EXIT;% 00207900
|
|
P(XCH);% 00208000
|
|
IF FILX.[18:15] > 1 THEN% 00208100
|
|
IF BSIZE>0 THEN 00208200
|
|
POLISH(MKS,LNSKP,CHSKP,SUPRS,BSIZE,FILX,ALGOLWRITE); 00208300
|
|
COMMENT WRITE RELEASE;% 00208400
|
|
IF P THEN CKPB% 00208500
|
|
ELSE BEGIN LSTRN ~ TLSTRN;% 00208600
|
|
IF FILX.[18:15]>1 THEN 00208700
|
|
FILX[NOT 4]~FILX[NOT 3]~0 ELSE 00208800
|
|
IF FILX.[18:15] = 1 THEN% 00208900
|
|
P(FILX,14,COM);% 00209000
|
|
P(XIT);% 00209100
|
|
END;% 00209200
|
|
RTNPRNT:END;% 00209300
|
|
SUBROUTINE DEBLANK; IF CHR<132 THEN 00209310
|
|
STREAM(P3~P(BSIZE-CHR,DUP),P2~P DIV 64,P1~BUFF) ; 00209320
|
|
BEGIN P2(2(DS~32LIT" ")); P3(DS~LIT" ") END ; 00209330
|
|
SUBROUTINE PRNTA;% 00209400
|
|
BEGIN COMMENT BLANK TO END OF BUFFER OR TO 132 TH CHARACIER,% 00209500
|
|
WHICH EVER IS LESS;% 00209600
|
|
P(XCH); COMMENT S= XIT KEY IF TRUE THEN RETURN.% 00209700
|
|
IF FALSE THEN EXIT ;% 00209800
|
|
IF TPHRASE>0 THEN DEBLANK ELSE CHR~MAXCHR ; 00209900
|
|
%VOID 00210000
|
|
%VOID 00210100
|
|
%VOID 00210200
|
|
%VOID 00210300
|
|
%VOID 00210400
|
|
%VOID 00210500
|
|
%VOID 00210600
|
|
BSIZE~(IF CHR=0 THEN BSIZE ELSE CHR+7) DIV 8; 00210700
|
|
PRNT; COMMENT RELEASE BUFFER;% 00210800
|
|
CHR ~ 0;% 00210900
|
|
BSIZE ~ BSIZE | 8;% 00211000
|
|
TPHRASE~BUFF~P(.BUFF,LOD,0,INX) ; 00211100
|
|
END;% 00211200
|
|
SUBROUTINE FINDE;% 00211300
|
|
BEGIN COMMENT DETERMINE THE EXPONENT OF A REAL NUMBER;% 00211400
|
|
IF WH1 = (LZ~ZEROS~0) THEN GO TO EFC; 00211500
|
|
E ~ (( 0&WH1[42:3:6]&WH1[1:2:1] + 12) | LOG8) + .5 ;% 00211600
|
|
EFA: IF ABS(WH1) } ( IF E} 0 THEN TEN[E]% 00211700
|
|
ELSE 1/TEN[-E])% 00211800
|
|
THEN GO TO EERTN;% 00211900
|
|
E ~ E - 1;% 00212000
|
|
GO TO EFA;% 00212100
|
|
EFC: E ~ 0;% 00212200
|
|
EERTN:END;% 00212300
|
|
SUBROUTINE RNDOFF;% 00212400
|
|
COMMENT ADJUST NUMBER TO 12 SIGNIFICAT DIGITS PLUS% 00212500
|
|
TRAILING ZEROS. NOTE DA = ADJUSTED <DECIMAL PLACES>;% 00212600
|
|
RNA: BEGIN IF ABS(P((JUNK2 ~ TEN[DA]) | WH1,DUP)) { MAX% 00212700
|
|
THEN GO TO RNB; COMMENT DA = ADJUSTED DEC1MAL PLACES; 00212800
|
|
P(DEL);% 00212900
|
|
ZEROS ~ ZEROS +1; COMMENT TRAILING ZEROS +1;% 00213000
|
|
DA ~ DA-1; COMMENT SUBTRACI 1 FROM DECIMAL PLACES;% 00213100
|
|
GO TO RNA;% 00213200
|
|
RNB: DH2 ~ P; COMMENT ROUND OFF NUMBER;% 00213300
|
|
END;% 00213400
|
|
REAL SUBROUTINE LISTELEMENT; 00213500
|
|
BEGIN IF LSTRN<0 THEN GO TO ERROR; 00213600
|
|
P(WH1,.WH1,ISN); WH1~LISX; 00213700
|
|
LISTELEMENT~P; 00213800
|
|
END LISTELEMENT; 00213900
|
|
SUBROUTINE SETMAXCHR; IF MAXCHR<CHR THEN MAXCHR~CHR ; 00213910
|
|
LABEL L,X,A,Z,I,G,R,C,O,ZW2,ZD,SWT; 00214000
|
|
COMMENT START OF CODE;% 00214100
|
|
START:: P(LSTRN,0,0,0);% 00214200
|
|
P(0); 00214210
|
|
IF FILX.[18:15] > 1 THEN% 00214300
|
|
BEGIN P(FILX[NOT 2]);% 00214400
|
|
IF FIB[5].[11:2]<2 THEN P(MKS,"WRITNG",FILX,7,SELECT) ; 00214420
|
|
IF FIB[5].[43:1] THEN POLISH(MKS,CHSKP,0,FILX,1,SELECT);% 00214500
|
|
COMMENT CALL SELECT IF FILE NOT IN WRITE STATUS;% 00214600
|
|
END ELSE P(0);% 00214700
|
|
CKPB; COMMENT CHECK FOR PRESENCE BIT;% 00214800
|
|
COMMENT CHECK FOR TYPE OF WRITE;% 00214900
|
|
IF FRMT ! 0 THEN GO TO ISFRM;% 00215000
|
|
IF ARRY ! 0 THEN% 00215100
|
|
IF ARRY < 0 THEN GO TO ASLST% 00215200
|
|
ELSE GO TO AEXL;% 00215300
|
|
COMMENT CASE = FORMAT = LIST = EMPTY;% 00215400
|
|
SUPRS~1;% 00215500
|
|
GO TO BB;% 00215600
|
|
ISFRM: IF NOT P(FRMT,TOP,XCH,DEL) THEN GO TO FMOUT;% 00215700
|
|
IF FI!0 THEN %%% FREE FIELD: [FI]/[TEMPD=AEXP-1] 00215710
|
|
BEGIN TEMPD~AEXP-1; FRMT~0; GO TO FMOUT END ; 00215720
|
|
COMMENT CASE = AEXP,ARRAY ROW;% 00215800
|
|
AEXL: IF P(ARRY.[8:10],DUP) { AEXP THEN GO TO ISA;% 00215900
|
|
IF AEXP<0 THEN P(ARRY[AEXP]) ; 00216000
|
|
P(DEL,AEXP);% 00216100
|
|
COMMENT STACK ~ SMALLER OF ARRAY SIZE OR AEXP;% 00216200
|
|
ISA: IF P(DUP) { BSIZE THEN GO TO ISB;% 00216300
|
|
P(DEL,BSIZE);% 00216400
|
|
COMMENT STACK ~ SMALLEST OF BUFFER SIZE, ARRAY SIZE% 00216500
|
|
OR AEXP;% 00216600
|
|
ISB: BSIZE ~ P;% 00216700
|
|
COMMENT BSIZE~# OF WORDS TO TRANSFER;% 00216800
|
|
COMMENT TRANSFER ARRAY TO BUFFFR;% 00216900
|
|
STREAM(P4 ~ [ARRY[0]], P3 ~ BSIZE,% 00217000
|
|
P2 ~ BSIZE DIV 64, P1 ~ * FILX);% 00217100
|
|
BEGIN% 00217200
|
|
SI ~ P4;% 00217300
|
|
P2 (DS ~ 32 WDS;% 00217400
|
|
DS ~ 32 WDS);% 00217500
|
|
DS ~ P3 WDS;% 00217600
|
|
END;% 00217700
|
|
GO TO BB;% 00217800
|
|
COMMENT CASE = *,LIST;% 00217900
|
|
ASLST: P(0,.LSTRN,SND); COMMENT S=I=0;% 00218000
|
|
BS: P(DUP,LISX); COMMENT S=VALUE,S-1=I,S-2=I;% 00218100
|
|
IF LSTRN } 0 THEN GO TO BR;% 00218200
|
|
BSIZE ~ P(DEL,DEL); COMMENT BSIZE ~ I =% 00218300
|
|
# OF WORDS IN BUFFER;% 00218400
|
|
GO TO BB;% 00218500
|
|
BR: P(XCH); COMMENT S=I,S-1=VALUE,S-2=I;% 00218600
|
|
P([BUFF],STD); COMMENT VALUE TO BUFFER[I];% 00218700
|
|
IF P(1,+,DUP) < BSIZE% 00218800
|
|
THEN GO TO BS;% 00218900
|
|
BSIZE ~ P;% 00219000
|
|
BB: P(0); COMMENT FLAG TO EXIT ON CALLING PRNT;% 00219100
|
|
PRNT;% 00219200
|
|
ERROR: P(0);% 00219300
|
|
PRNTA; COMMENT CALL PRNTA AND EXIT;% 00219400
|
|
COMMENT CASE OF FORMAT,LIST OR FORMAT EMPTY;% 00219500
|
|
FMOUT: LSTRN ~ -( ARRY = 0);% 00219600
|
|
COMMENT LSTRN ~ -1 IF NO LIST;% 00219700
|
|
P(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);% 00219800
|
|
P(0) ; 00219810
|
|
DH1 ~ TEMPD ; 00219900
|
|
WH1 ~ LISX; COMMENT GET FIRST LISI ITEM;% 00220000
|
|
TPHRASE~BUFF~P(0,[BUFF]).[33:15] ; 00220100
|
|
COMMENT BUFF ~ ABSOLUTE CORE ADDRESS;% 00220200
|
|
BSIZE ~ BSIZE | 8;% 00220300
|
|
COMMENT BSIZE NOW # OF CHARACTERS IN BUFFER;% 00220400
|
|
IF FRMT=0 THEN %%% FREE FIELD WRITE, WHICH IS EQUIVALENT 00220405
|
|
BEGIN %%% TO <INFINITY>U OR <INFINITY>UX.X 00220410
|
|
CODE~11; JUNK1~BSIZE; IF(TEMPD~DH1)>63 THEN TEMPD~63;00220415
|
|
FFCHR~IF FI<0 THEN " " ELSE "," ; 00220416
|
|
IF (FI~ABS(FI)-1)!0 THEN %%% WE HAVE AT LEAST [FI]/ 00220418
|
|
BEGIN IF TEMPD=0 THEN %%% WE HAVE [FI]/[0]. 00220420
|
|
BEGIN IF (TEMPD~BSIZE/FI-2.4999999999){0 00220422
|
|
THEN TEMPD~1 ELSE IF TEMPD>21 THEN 00220424
|
|
JUNK1~((TEMPD~21)+2)|FI END 00220426
|
|
ELSE IF (V2~FI|(TEMPD+2))<BSIZE THEN JUNK1~V2 ; 00220428
|
|
V2~TEMPD END %%% ABOVE ELSE WAS [FI]/[TEMPD]. 00220430
|
|
ELSE IF (V2~TEMPD)=0 THEN TEMPD~63;%%%HAVE [0]/[0] OR00220432
|
|
UTYP~(UTYP&JUNK1[16:35:13]) OR 2 ; %%%[0]/[TEMPD] 00220455
|
|
FAW~1&TEMPD[6:42:6]&V2[32:42:6] ; 00220460
|
|
GO TO PHRAS ; 00220465
|
|
END ELSE 00220470
|
|
GO TO S;% 00220500
|
|
S1: FI ~ FI + 1;% 00220600
|
|
COMMENT SET INDEX TO NEXT EDITING PHRASE;% 00220700
|
|
S: CODE ~ (FAW ~ FRMT[FI]).[2:4];% 00220800
|
|
UTYP ~ 0&BSIZE[16:35:13] ; 00220810
|
|
IF FAW > 0 THEN GO TO PHRAS;% 00220900
|
|
COMMENT IF S=0 THEN GO TO PHRASE;% 00221000
|
|
GO TO P(CODE); COMMENT SWITCH ON CODE;% 00221100
|
|
GO TO RTPAR;% 00221200
|
|
GO TO STRNG;% 00221300
|
|
GO TO LFPAR;% 00221400
|
|
GO TO SLASH;% 00221500
|
|
GO TO SCALE;% 00221600
|
|
COMMENT LEFT PARENTHESIS;% 00221700
|
|
LFPAR: IF FAW.[12:1] THEN 00221800
|
|
BEGIN IF P(LISTELEMENT,DUP)<0 THEN 00221900
|
|
BEGIN P(DEL); FI~FAW.[28:10]+FI; END; 00222000
|
|
END ELSE P(FAW.[38:10]); 00222100
|
|
COMMENT MASK OUT REPFAT AND LEAVE IN STACK;% 00222200
|
|
GO TO S1;% 00222300
|
|
COMMENT RIGHT PARENTHESIS;% 00222400
|
|
RTPAR: P(1,SUB); COMMENT SUBTRACT ONE FROM LFPAR REPEAT;% 00222500
|
|
IF P(DUP) = 0 THEN BEGIN% 00222600
|
|
P(DEL); COMMENT DELETE 0 REPEAT;% 00222700
|
|
GO TO S1; COMMENT PICK UP NEXT PHRASE;00222800
|
|
END;% 00222900
|
|
FI ~ FI -(FAW AND 1023); COMMENT SET FI BACK TO LFPAR;00223000
|
|
GO TO S1;% 00223100
|
|
COMMENT SLASH;% 00223200
|
|
SLASH: POLISH((LSTRN}0) OR NOT FAW);% 00223300
|
|
PRNTA;COMMENT RELEASE BUFFER;% 00223400
|
|
COMMENT EXIT IF FORMAT & LIST EXAUSTED;% 00223500
|
|
GO TO S1; COMMENT S1 IF LIST OR FORMAT NOT EXAUSTED;% 00223600
|
|
COMMENT SCALE FACTOR;% 00223700
|
|
SCALE: SCFTR~IF FAW.[12:1] THEN LISTELEMENT 00223800
|
|
ELSE 0&FAW[38:38:10]&FAW[1:11:1]; 00223900
|
|
GO TO S1;% 00224000
|
|
COMMENT STRINGS;% 00224100
|
|
STRNG: IF P(CHR + (W~FAW.[6:6]),DUP) > BSIZE% 00224200
|
|
THEN GO TO ERROR; COMMENT BUFFER OVERFLOW;% 00224300
|
|
CHR ~ P ; COMMENT CHR ~ W+CHR;% 00224400
|
|
SETMAXCHR ; 00224410
|
|
STREAM(P4 ~ 0: P3 ~ FAW,P2 ~ W,P1 ~ BUFF);% 00224500
|
|
BEGIN% 00224600
|
|
SI ~ LOC P2;% 00224700
|
|
SI ~ SI-P2;% 00224800
|
|
DS ~ P2 CHR;% 00224900
|
|
P4 ~ DI;% 00225000
|
|
END;% 00225100
|
|
BUFF ~ P;% 00225200
|
|
GO TO S1;% 00225300
|
|
COMMENT BRLAK APART FORMAT WORD;% 00225400
|
|
PHRAS: IF FAW.[12:1] THEN P(LISTELEMENT) ELSE P(FAW.[38:10]); 00225500
|
|
IF CODE=13 THEN CODE~IF (CODE~LISTELEMENT)="D" THEN 0 ELSE00225600
|
|
IF CODE="I" THEN 1 ELSE 00225650
|
|
IF CODE="X" THEN 2 ELSE 00225700
|
|
IF CODE="A" THEN 4 ELSE 00225800
|
|
IF CODE="I" THEN 6 ELSE 00225900
|
|
IF CODE="F" THEN 8 ELSE 00226000
|
|
IF CODE="E" THEN 10 ELSE 00226100
|
|
IF CODE="U" THEN 11 ELSE 00226110
|
|
IF CODE="B" THEN 110 ELSE 00226120
|
|
IF CODE="O" THEN 12 ELSE 00226200
|
|
IF CODE="L" THEN 14 ELSE 00226300
|
|
IF CODE="R" THEN 15 ELSE 16; 00226400
|
|
IF CODE=110 THEN BEGIN CODE~11; FAW.[31:1]~1 END ; 00226410
|
|
W~IF FAW.[13:1] THEN LISTELEMENT-(CODE=1) ELSE FAW.[6:6] ;00226500
|
|
D~IF FAW.[14:1] THEN LISTELEMENT 00226600
|
|
ELSE IF CODE=11 THEN FAW.[32:6] 00226610
|
|
ELSE (D1~FAW.[20:4])+(D2~FAW.[16:4]); 00226700
|
|
IF P(DUP){0 THEN GO BACK; 00226800
|
|
IF W<0 THEN 00226810
|
|
IF CODE=1 AND W=(-1) THEN GO BACK 00226815
|
|
ELSE IF NOT(CODE=0 OR CODE=12) THEN GO FORMATERR; 00226820
|
|
IF D<0 THEN IF NOT(CODE!15 AND CODE!8 AND CODE!10) 00226830
|
|
THEN GO TO FORMATERR ; 00226840
|
|
IF W=0 THEN IF CODE!2 AND CODE!1 THEN 00226850
|
|
BACK: BEGIN P(DEL); GO S1 END ; 00226852
|
|
IF CODE=11 THEN BEGIN UTOP~DH1~FAW.[31:1]=0 ; 00226860
|
|
IF (WH2~UBUFF-DH1-FFTYP)<W THEN W~WH2 ; IF D>WH2 THEN 00226865
|
|
GO TO ERROR; UTYP~UTYP&W[40:42:6]&D[29:42:6] OR 1 ; 00226870
|
|
GO TO INLOOP END ; 00226875
|
|
IF FAW.[13:2]!0 OR FAW.[2:4]=13 THEN 00226900
|
|
BEGIN 00227000
|
|
GO P(IF CODE=15 THEN 8 ELSE IF CODE=1 THEN 2 ELSE 00227060
|
|
CODE) ; 00227065
|
|
GO C; GO X; GO A; GO I; GO R; GO G; GO O; GO L; 00227100
|
|
GO TO FORMATERR ; 00227200
|
|
L: W1~IF W{5 THEN W ELSE 5; GO TO Z; 00227300
|
|
X: W1~W DIV 64; W~SKIP~W.[42:6]; 00227400
|
|
GO TO ZW2; 00227500
|
|
A: W1~IF W{6 THEN W ELSE 6; 00227600
|
|
Z: SKIP~W-W1; GO TO ZW2; 00227700
|
|
I: W1~IF W{8 THEN W ELSE 8; 00227800
|
|
SKIP~IF W{16 THEN 0 ELSE W-16; CODE~6 ; 00227900
|
|
W2~W-SKIP-W1; GO TO ZD; 00228000
|
|
G: D~D+(UTIP OR FAW.[2:4]=13 OR FAW.[14:1]); 00228100
|
|
D2~D-D1~IF D{8 THEN D ELSE 8; 00228200
|
|
SKIP~IF (W-D){5 THEN 0 ELSE W-D-5; 00228300
|
|
W1~W2~0; CODE~10; GO TO SWT ; 00228400
|
|
R: D2~D-D1~IF D{8 THEN D ELSE 8; 00228500
|
|
SKIP~IF (W-D){17 THEN 0 ELSE W-D-17; 00228600
|
|
W1~IF (W-D){8 THEN W-D-1 ELSE 8; 00228700
|
|
W2~IF (W-D-SKIP){9 THEN 0 ELSE W-D-SKIP-9; 00228800
|
|
CODE~8; GO TO SWT ; 00228900
|
|
C: O: W~8; W1~SKIP~0; 00229000
|
|
ZW2: W2~0; 00229100
|
|
ZD: D~D1~D2~0; 00229200
|
|
SWT: WT~W1+W2; 00229300
|
|
IF UTYP THEN BEGIN IF NOT((DH1~TEMPD-W){0 OR CODE!10) THEN00229310
|
|
W~TEMPD ELSE DH1~0; IF (WH2~W+UTOP+FFTYP+ 00229320
|
|
USKIP)+CHR>UBUFF THEN BEGIN P(1); PRNTA END;00229330
|
|
CHR~CHR+WH2; SETMAXCHR; IF CODE=10 THEN BEGIN00229340
|
|
SKIP~SGN+DH1; GO ETYPE1 END ELSE GO JMP END ;00229350
|
|
END ELSE 00229400
|
|
BEGIN WT~(W1~FAW.[28:4])+(W2~FAW.[24:4]); 00229500
|
|
SKIP~FAW.[32:6]; 00229600
|
|
END; 00229700
|
|
INLOOP: IF CODE { 2 THEN GO TO FLDW;% 00229800
|
|
UTYP.[35:5]~27 ; %%% SETS UMD=UDC=UES=TRUE, SETS UED=2. 00229810
|
|
USKIP~0 ; 00229820
|
|
IF LSTRN}0 THEN IF UTYP THEN GO TO UTYPE 00229900
|
|
ELSE GO TO FLDW ; 00229910
|
|
P(0); COMMENT SET KEY = EXIT;% 00230000
|
|
PRNTA; COMMENT LIST EXAUSTED. RELEASE BUFFLR AND EXIT; 00230100
|
|
COMMENT FILL FIELD WITH *;% 00230200
|
|
ASTB: P(DEL); ASTA: P(DEL);% 00230300
|
|
AST: STREAM(P3~0: P2~W,PU~UTIP,PUU~UTOP,PS~USKIP, 00230400
|
|
PFF~FFTYP, 00230410
|
|
PCH~FFCHR, 00230415
|
|
P1~BUFF) ; 00230420
|
|
BEGIN 00230500
|
|
PS(DS~LIT" ") ; 00230510
|
|
P2(DS~LIT"*"; PU(DI~DI-1; DS~LIT"|")) ; 00230600
|
|
PFF(SI~LOC P1; SI~SI-1; DS~CHR) ; 00230605
|
|
PUU(DS~LIT" ") ; 00230610
|
|
P3 ~ DI;% 00230700
|
|
END;% 00230800
|
|
00230900
|
|
GO TO COMMM ; 00231000
|
|
FORMATERR: IF FILX.[18:15]>1 THEN 00231020
|
|
BEGIN %%% NOT ARRAYROWBUFF, SO TRY PAR LBL BRANCH. 00231025
|
|
P(FILX[NOT 3]) ; 00231027
|
|
FILX[NOT 3] ~ FILX[NOT 4] ~ 0 ; 00231030
|
|
P(MKS,9,JUNK) ; 00231040
|
|
END ; 00231045
|
|
TEN~0; TEN~P([TEN[1]],CFX,SFB) & 10[8:38:10] ; 00231050
|
|
STREAM(TEN); DS~17LIT"-FMT ERR NO LBL:~" ; 00231060
|
|
P([TEN[0]].[33:15],34,COM) ; 00231070
|
|
FLDW: IF CODE=1 THEN GO TTYPE; IF P(W+CHR,DUP)>BSIZE 00231100
|
|
THEN GO TO ERROR; COMMENT BUFFER OVERFLOW;% 00231200
|
|
CHR ~ P; COMMENT CHR ~ CHR + W;% 00231300
|
|
SETMAXCHR ; 00231350
|
|
COMMENT SELECT EDITING PHRASE;% 00231400
|
|
JMP: IF CODE = 15 THEN GO TO RTYPE;% 00231500
|
|
IF CODE THEN GO ERROR ; 00231510
|
|
GO TO P(CODE);% 00231600
|
|
GO TO DOTYPE; COMMENT CODE = 0;% 00231700
|
|
GO TO XTYPE; COMMENT CODE = 2;% 00231800
|
|
GO TO ALFA ; COMMENT CODE = 4;% 00231900
|
|
GO TO ITYPE; COMMENT CODE = 6;% 00232000
|
|
GO TO FTYPE; COMMENT CODE = 8;% 00232100
|
|
GO TO ETYPE; COMMENT CODE = 10;% 00232200
|
|
GO TO DOTYPE; COMMENT CODE = 12;% 00232300
|
|
GO TO LOGI ; COMMENT CODE = 14;% 00232400
|
|
COMMENT L PHRASE;% 00232500
|
|
LOGI: STREAM(P5 ~ 0:P4 ~ IF WH1 THEN "TRUE "% 00232600
|
|
ELSE "FALSE" ,% 00232700
|
|
P3 ~ W1, P2 ~ SKIP,P1 ~ BUFF);% 00232800
|
|
BEGIN% 00232900
|
|
P2(DS ~ LIT " ");% 00233000
|
|
SI ~ LOC P4;% 00233100
|
|
SI ~ SI+3;% 00233200
|
|
DS ~ P3 CHR;% 00233300
|
|
P5 ~ DI;% 00233400
|
|
END;% 00233500
|
|
00233600
|
|
GO TO COMMM ; 00233700
|
|
UTYPE: COMMENT THL U <EDITING PHRASE TYPE> (U, UW OR UW M) SELECTS THE00233703
|
|
<EDITING PHRASE TYPE> ::= I / F / (SPECIAL) E, 00233706
|
|
AND FOR THE CHOSEN PHRASE TYPE IT SELECTS A SUITABLE 00233709
|
|
<FIELD PART> ::= FP, 00233712
|
|
AND A SUITABLE 00233715
|
|
<DECIMAL PLACES> ::= D, 00233718
|
|
SUCH THAT THE FOLLOWING CONDITIONS ARE SATISFIED: 00233721
|
|
1. FP MUST SATISFY THE INEQUALITIES, M { FP { W. 00233727
|
|
IF M > W THEN INITIALLY FP { W AND LAIER FP IS 00233730
|
|
ADJUSTED SUCH THAT M-W LEADING BLANKS ARE SUPPLIED00233733
|
|
2. SUBJECT TO CONDITION #1, THE SELECTED PHRASE 00233739
|
|
SHALL OUTPUT, IN A HIGHLY READABLE FORMAT, THE 00233742
|
|
MAXIMUM AMOUNT OF MEANINGFUL NUMERIC SIGNIFICANCE 00233745
|
|
IN THE LEAST POSSIBLE FIELD WIDTH. A BLANK SPACE 00233746
|
|
IS POSTFIXED TO THE EDITED LIST ELEMENT. 00233747
|
|
NOTE: WH1 = VALUE OF LIST ELEMENT TO BE EDITED, AND 00233748
|
|
IN THE FOLLOWING COMMENTS, "FULL WORD" IS USED IN THE 00233751
|
|
CONTEXT OF CONDITION #2 UNRESTRICTED BY CONDITION #1. 00233754
|
|
END OF COMMENT ; 00233757
|
|
WH1~TEN[0]|ABS(WH2~WH1); %%% RETAIN ORIG WH1,NORM WH1 FOR FINDE00233760
|
|
IF (W~STORW){1 THEN GO UI; %%% RESTORE W, U1 IS SENT TO I-TYPE.00233765
|
|
FINDE ; %%% FINDE SETS E = ENTIER[LOG10(ABS(WH1))],@E{WH1<@E+1.00233775
|
|
TEMPD~STORD ; %%% DECREASES USF OF PARTIAL WORDS. 00233778
|
|
IF ((WH1~ABS(WH2))=0 %%% ZERO IS INTEGRAL, REGARDLESS OF EXPONT00233781
|
|
OR (WH1.[3:6]=0 AND E<10)) %%% WH1 IS INTEGRAL AND NOT BIG00233784
|
|
AND (V2~(SGN~WH2<0)+1+E){W %%% V2 = MINIMUM WIDTH REQUIRED00233787
|
|
THEN %%% FOR FULL WORD I-TYPE. 00233788
|
|
BEGIN W~V2 ; %%% WE NOW USE FULL WORD I-TYPE. 00233790
|
|
UI: IF W<TEMPD THEN USKIP~TEMPD-W ; %%% PHRASE GETS BLNKS00233791
|
|
WH1~WH2; GO TO I ; %%% RESTORE WH1 AND EXIT TO I-TYPE. 00233793
|
|
END ; 00233796
|
|
SKIP~(W1~IF DH2~E<0 THEN WH1|TEN[-E] ELSE WH1/TEN[E])}5 ; 00233800
|
|
JUNK1~IF DH1~(D~11-(W1>5.49755813885))<E THEN WH1/TEN[E-D] 00233802
|
|
ELSE WH1|TEN[D-E] ; 00233804
|
|
%%% JUNK1 = MANTISSA OF WH1 AS AN 11 OR 12 DIGIT INTEGER. 00233806
|
|
%%% D = # DIGITS-1 IN JUNK1. 00233809
|
|
%%% W1 = MANTISSA OF WH1 AS N.NN...N. 00233812
|
|
%%% DH1 = TRUE IF WH1 > MAX INTEGER, ELSE DH1 = FALSE. 00233813
|
|
%%% DH2 = TRUE IF WH1 < 1, ELSE DH2 = FALSE. 00233815
|
|
%%% SKIP = TRUE IF WH1 WOULD ROUND UP, ELSE SKIP = FALSE. 00233816
|
|
IF DH1 OR DH2 THEN IF (D1~JUNK1 MOD 10)<3%%% HERE WE HANDLE ANY00233818
|
|
THEN JUNK1~JUNK1-D1 ELSE IF D1>7 THEN %%% CONVERSION TRUNCA-00233821
|
|
JUNK1~JUNK1-D1+10 ; %%% TION PROBLEMS. 00233824
|
|
IF JUNK1=TEN[11] THEN IF D!11 THEN 00233825
|
|
BEGIN WH1~(IF E}(-1) THEN TEN[E+1] ELSE 1/TEN[-(E+1)]) 00233826
|
|
&SGN[1:47:1]; GO TO UTYPE ; 00233827
|
|
END ; 00233828
|
|
D1~1 ; 00233829
|
|
WHILE JUNK1 MOD TEN[D1]=0 DO D1~D1+1;%%%D1=1+#TRAILN 0 IN JUNK100233830
|
|
UES~DH2; IF NOT JUNK1~ABS(E)>9 THEN UED~1; UDC~DA~D1-D!1 ; 00233831
|
|
WT~(W2~2+SGN+DH2)+1+DA+JUNK1 ; %%% WT IS MAIN FIELD WIDTH FOR E00233832
|
|
IF DH1 %%% WH1 BEYOND MAXIMUM F-TYPE RANGE00233833
|
|
OR ((2+DA<(-E) %%% OR WH1 HAS LESS WIDTH IN THE 00233836
|
|
OR (D~D+1-D1)+DA<E) %%% E-TYPE THAN IN THE F-TYPE, 00233839
|
|
AND (ABS(E)}4 OR W<2+SGN %%% AND IT WOULDNT LOOK BETTER IN F00233840
|
|
+(D1~IF DH2 THEN 0 ELSE E)+D2~IF D{E THEN 1 ELSE D-E)) THEN 00233841
|
|
BEGIN %%% THEN WE SHALL TRY E-TYPE. 00233842
|
|
%%% IN THE ABOVE, D = # DECIMAL PLACES FOR FULL WORD ETYPE00233845
|
|
IF D+WT{W THEN %%% D+WT = MINIMUM FIELD WIDTH REQUIRED00233848
|
|
BEGIN W~D+WT;%%% FOR FULL WORD E-TYPE 00233851
|
|
GO TO G ; %%% EXIT TO FIRST PHASE OF E-TYPE PHRASE 00233854
|
|
END ; 00233857
|
|
IF NOT (DH1 OR %%% E-TYPE WIDIH WAS TOO SMALL TO HANDLE 00233860
|
|
V2!W) THEN GO UI ; %%% NN...N00...0.0, SO DROP .0, GO I00233863
|
|
ESUBTYPE: 00233864
|
|
IF (D~W-WT)}0 THEN GO TO G ; %%% WH1 FITS ROUNDED E-TYPE. 00233865
|
|
UDC~0 ; %%% NO ROOM FOR DFCIMAL POINT, SO WE RESET FLAG. 00233866
|
|
IF D+DA=D~0 THEN GO G ; %%% FORM IS <SIGN>N@<EXP>,GO TO E.00233867
|
|
UMD~0 ; %%% NO ROOM FOR MANTISSA, SO WE RESET FLAG. 00233868
|
|
W1~NOT(W2+JUNK1!W OR (JUNK1~W1)!1) ; 00233869
|
|
IF DH2 THEN BEGIN IF (DH2~(-E>10)+W2){W AND SKIP THEN 00233870
|
|
BEGIN %%% WH1<1, ROUND UP TO <SIGN>@<EXP+1>,GO TO ETYPE00233871
|
|
W~W-(DH2<W); IF (E~E+1)=(-9) THEN UED~1; GO TO G END 00233872
|
|
ELSE IF W1 THEN GO TO G %%% DEL 1 IN <SIGN>1@<EXP>,GO E00233873
|
|
END ELSE IF (E>8)+W2=W AND SKIP THEN BEGIN E~E+1; GO TO G00233874
|
|
END %%% WH1>1, ROUND UP TO <SIGN>@<EXP+1>, GO TO E-TYPE; 00233875
|
|
ELSE IF W1 THEN GO G ; %%% DEL 1 IN <SIGN>1@<EXP>, GO TO E00233876
|
|
D~W-1-(W+E+SKIP=1)|SGN; GO TO UF ; %%% GO TO F-TYPE FOR 00233877
|
|
END %%% **...*/(0).00...0 00233878
|
|
ELSE IF W}D1~(D~D2)+D2~2+SGN+D1 THEN %%% HANDLE VARIOUS F-TYPES00233879
|
|
%%% D = # DECIMAL PLACES FOR FULL WORD F-TYPE. 00233883
|
|
%%% D1 = MINIMUM WIDTH REQUIRED FOR FULL WORD F-TYPE. 00233886
|
|
%%% D2 = 1 + #DIGITS TO THE LEFT OF THE DEC1MAL PLACE. 00233889
|
|
BEGIN W ~ D1 ; %%% FULL WORD F-TYPE. 00233892
|
|
UF: IF W<TEMPD THEN USKIP~TEMPD-W ; %%% PHRASE GETS BLNKS00233893
|
|
WH1~WH2; GO TO R ; %%% RESTORE WH1 AND EXIT TO F-TYPE. 00233895
|
|
END; 00233896
|
|
IF DH2 THEN IF SGN THEN %%% DH2 SAYS WH1{0.NN...N, SO SINCE WE 00233899
|
|
D2~D2-(WH1<.5 OR W!2)%%% CANNOT FIT FULL WORD IN F-TYPE, WE 00233900
|
|
-(W+E < 1-SKIP) %%% THEN DELETE LEADING ZERO (IF DO NOT00233903
|
|
ELSE D2~D2-1 ; %%% HAVE TO ROUND INTO IT),AND IF SHALL00233906
|
|
%%% HAVE TO ROUND TO 0,DELETE -SIGN TOO00233909
|
|
IF (D~W-D2)}0 THEN GO TO UF ; %%% AFTER ABOVE SURGERY, IF CAN 00233912
|
|
%%% ROUND THEN SEND WH1 TO F-TYPE00233915
|
|
IF D2-1=W THEN GO TO UI ; %%% TRY WH1 ROUNDED TO AN INTEGER. 00233918
|
|
GO TO ESUBTYPE ; %%% AS A LAST DITCH EFFORT, TRY ROUNDED E-TYPE00233921
|
|
COMMENT A PHRASE ; 00233994
|
|
ALFA: STREAM(P5 ~ 0: P4 ~ WH1, P3 ~ W1, P2 ~ SKIP, 00233997
|
|
P1 ~ BUFF);% 00234000
|
|
BEGIN% 00234100
|
|
P2(DS ~ LIT " ");% 00234200
|
|
SI ~ LOC P3;% 00234300
|
|
SI ~ SI - P3;% 00234400
|
|
DS ~ P3 CHR;% 00234500
|
|
P5 ~ DI;% 00234600
|
|
END;% 00234700
|
|
00234800
|
|
GO TO COMMM ; 00234900
|
|
COMMENT D & O PHRASES;% 00235000
|
|
DOTYPE: STREAM(P4 ~ 0: P3 ~ IF CODE = 0 THEN 0% 00235100
|
|
ELSE WH1,% 00235200
|
|
P2 ~ SKIP, P1 ~ BUFF);% 00235300
|
|
BEGIN% 00235400
|
|
P2(DS ~ LIT " ");% 00235500
|
|
SI ~ LOC P3;% 00235600
|
|
DS ~ 8 CHR;% 00235700
|
|
P4 ~ DI;% 00235800
|
|
END;% 00235900
|
|
00236000
|
|
GO TO COMMM ; 00236100
|
|
COMMENT X PHRASE;% 00236200
|
|
XTYPE: IF P(CHR+(W1|64),DUP) > BSIZE% 00236300
|
|
THEN GO TO ERROR; COMMENT BUFFER OVERFLOW;% 00236400
|
|
CHR~P; SETMAXCHR ; 00236500
|
|
STREAM(P4 ~ 0: P3 ~ W1, P2 ~ SKIP, P1 ~ BUFF);% 00236600
|
|
BEGIN% 00236700
|
|
P2(DS ~ LIT " ");% 00236800
|
|
P3(32(DS ~ 2 LIT " "));% 00236900
|
|
P4 ~ DI;% 00237000
|
|
END;% 00237100
|
|
00237200
|
|
GO TO COMMM ; 00237300
|
|
COMMENT T PHRASE ; 00237305
|
|
TTYPE: IF TPHRASE>0 THEN BEGIN DEBLANK; TPHRASE~-TPHRASE END ; 00237308
|
|
IF (CHR~W+W1|64)}BSIZE THEN GO ERROR ; 00237310
|
|
STREAM(P3~SAVEBUFF:P2~W,P1~W1); 00237315
|
|
BEGIN SI~P3; SI~SI+P2; P1(2(SI~SI+32)); P3~SI END ; 00237320
|
|
GO COMMM ; 00237325
|
|
COMMENT I PHRASE;% 00237400
|
|
ITYPE: IF ABS(P(WH1,DUP)) > P(MAXN)% 00237500
|
|
THEN GO TO ASTA; COMMENT FILL FIELD WITH *;% 00237600
|
|
P(.WH1,ISN,DUP); COMMENT ROUND NUMBER;% 00237700
|
|
SGN ~ P < 0;% 00237800
|
|
WH2 ~(WH1 ~ ABS(P)) DIV P(TEN8);% 00237900
|
|
IF WH1 } TEN[WT-SGN]% 00238000
|
|
THEN GO TO AST; COMMENT NUMBER > FIELD WIDTH;% 00238100
|
|
STREAM(P8 ~ 0: P7 ~ WT-1, P6 ~ [WH2],P5 ~ SGN,% 00238200
|
|
P4 ~ W2,P3 ~ W1,P2 ~ SKIP+USKIP,PU~UTOP, 00238300
|
|
PFF~FFTYP, 00238305
|
|
PCH~FFCHR, 00238307
|
|
P1 ~ BUFF) ; 00238310
|
|
BEGIN% 00238400
|
|
P2(DS ~ LIT " ");% 00238500
|
|
P1 ~ DI; COMMENT SAVE STARTING ADDRESS;% 00238600
|
|
SI ~ P6;% 00238700
|
|
DS ~ P4 DEC; COMMENT CONVERT HIGH HALF;% 00238800
|
|
SI ~ P6;% 00238900
|
|
SI ~ SI+8;% 00239000
|
|
DS ~ P3 DEC; COMMENT CONVERT LOW HALF;% 00239100
|
|
PFF(SI~LOC P1; SI~SI-1; DS~CHR) ; 00239105
|
|
PU(DS ~ LIT" ") ; 00239110
|
|
P8 ~ DI;% 00239200
|
|
DI ~ P1;% 00239300
|
|
DS ~ P7 FILL; COMMENT LEADING ZEROS~BLANKS;% 00239400
|
|
P5(DI ~ DI-1; DS ~ LIT"-") ; 00239500
|
|
00239600
|
|
00239700
|
|
00239800
|
|
00239900
|
|
00240000
|
|
00240100
|
|
00240200
|
|
END;% 00240300
|
|
00240400
|
|
GO TO COMMM ; 00240500
|
|
COMMENT F PHRASE;% 00240600
|
|
FTYPE: IF ABS(WH1 ~ WH1 | 1.0) > P(MAXN)% 00240700
|
|
THEN GO TO AST; COMMENT INSURE NUMBER IS REAL AND NOI% 00240800
|
|
TO BIG;% 00240900
|
|
IF NOT UTYP THEN FINDE ;%FINDE SETS F=[LOG10(ABS(WH1))]. 00241000
|
|
RFIN: IF (E + (DA ~ D)) > 10 THEN GO TO FD;% 00241100
|
|
COMMENT DA ~ DECIMAL PLACES. IF D+E>10, MORE THEN% 00241200
|
|
11 DECIMAL PLACES SO MUST DO SPECIAL ROUND;% 00241300
|
|
DH2 ~ WH1 | (JUNK2 ~ TEN[D]);% 00241400
|
|
COMMENT SHIFT NUMBER LEFT D PLACES THEN ROUND IT% 00241500
|
|
OFF BY DOING INTEGER STORE IN DH2;% 00241600
|
|
FA: SGN ~ DH2 < 0;% 00241700
|
|
DH1 ~ (DH2 ~ ABS(DH2)) DIV P(TEN8);% 00241800
|
|
IF DH2 } JUNK2 THEN GO TO FB;% 00241900
|
|
COMMENT NUMBER IS LESS THEN ONE, WILL SIGN FIT;% 00242000
|
|
IF P(WT-SGN, DUP) < 0 THEN GO TO ASTA;% 00242100
|
|
COMMENT ASTA IF SIGN DONT FIT;% 00242200
|
|
LZ ~ P ! (JUNK1~0); 00242300
|
|
COMMENT JUNK1 = # OF INTEGER DIGITS TO PRINT.% 00242400
|
|
IF WT-SIGN = 0 THEN JUNK1=0= DONT PRINT LEADING 00242500
|
|
ZERO.% 00242600
|
|
IF WT-SIGN > 0 THEN JUNK1=1= DO PRINT LEADING% 00242700
|
|
ZERO;% 00242800
|
|
GO FC ; 00242895
|
|
MAXN::: @0007777777777777 ; 00242900
|
|
COMMENT NUMBER } 1. CHECK IF ON ROUND WE OVERFLOWED% 00243000
|
|
INTO NEXT POWER OF TEN;% 00243100
|
|
FB: IF ((JUNK1 ~ E + (IF DH2 } TEN[E+1+DA] THEN 2% 00243200
|
|
ELSE 1))% 00243300
|
|
+ SGN ) > WT THEN GO TO AST;% 00243400
|
|
COMMENT FOR NUMBERS } 1, E = ONE LESS THAN THE% 00243500
|
|
NUMBER OF DIGITS LEFT OF THE DECIMAL% 00243600
|
|
POINT. IN JUNK1 WE SAVE EITHER E+1 OR% 00243700
|
|
E+2,DEPENDING ON IF ROUND OVERFLOW% 00243800
|
|
OCCURED. ALSO WE COMPARE JUNK1 + SIGN% 00243900
|
|
WITH WT. THIS TELLS US IF THE NUMBER% 00244000
|
|
WILL FIT THE FIELD. WT = TOTAL NUMBER% 00244100
|
|
OF POSITIONS AVAILABLE FOR INTEGER DIGITS% 00244200
|
|
+ SIGN;% 00244300
|
|
FC: COMMENT NOW WE CONVERT. NOTE THAT NUMBER% 00244400
|
|
IS NOW AN INTEGER IN THE FORM N--N*N--N.% 00244500
|
|
, DENOTES TRUE DECIMAL POINT% 00244600
|
|
. DENOTES MACHINE POINT% 00244700
|
|
ZEROS CONTAINS # OF TRAILING ZEROS% 00244800
|
|
JUNK1 CONTAINS # DF DIGITS LEFT OF *% 00244900
|
|
DA CONTAINS # OF DIGITS BETWEEN * &.% 00245000
|
|
NOTE THAT WH2 + ZEROS ALWAYS = D.% 00245100
|
|
THE STREAM PROCEDURE WILL CONVERT THE% 00245200
|
|
NUMBER IN TWO PARTS (ALREADY SET UP IN% 00245300
|
|
DH1 AND DH2). IT WILL THEN MOVE JUNK1 #% 00245400
|
|
OF DIGITS LEFT AND INSERT THE DECIMAL% 00245500
|
|
POINT. ALSO THE SIGN AND TRAILING ZEROS% 00245600
|
|
ARE INSERTED;% 00245700
|
|
D1~DA+JUNK1-(D2~IF P(JUNK1 +DA,DUP) > 8 THEN P(8,SUB)% 00245800
|
|
ELSE P(DEL,0));% 00245900
|
|
STREAM(P9~0:P8~JUNK1+LZ,P7~ZEROS,P6~[DH1],P5~SGN, 00246000
|
|
P4~D1,P3~D2,P2~SKIP+WT-JUNK1-LZ+USKIP,PU~UTOP, 00246100
|
|
PFF~FFTYP, 00246105
|
|
PCH~FFCHR, 00246107
|
|
LZ, 00246108
|
|
P1 ~ BUFF) ; 00246110
|
|
BEGIN% 00246200
|
|
P2(DS~LIT " "); COMMENT INSERT LEADING BLANKS;% 00246300
|
|
P1~DI; COMMENT SAVE ADDRESS OF MSD;% 00246400
|
|
DI~DI+1; COMMENT LEAVE ROOM FOR INTEGER% 00246500
|
|
PART;% 00246600
|
|
LZ(DS~LIT"0"); 00246650
|
|
SI ~P6;% 00246700
|
|
DS~P3 DEC; COMMENT CONVERT HIGH PART;% 00246800
|
|
SI~P6;% 00246900
|
|
SI~SI+8;% 00247000
|
|
DS~P4 DEC; COMMENT CONVERT LOW HALF;% 00247100
|
|
P7(DS~LIT"0"); COMMENT INSERT TRAILING ZEROS;% 00247200
|
|
PFF(SI~LOC P1; SI~SI-1; DS~CHR) ; 00247205
|
|
PU(DS ~ LIT" ") ; 00247210
|
|
P9~DI; COMMENT ADDRESS OF NEXT FIELD;% 00247300
|
|
SI~P1;% 00247400
|
|
SI~SI+1;% 00247500
|
|
DI~P1; COMMENT MOVE INTEGER PART LEFT;% 00247600
|
|
DS~P8 CHR;% 00247700
|
|
DS~LIT".";% 00247800
|
|
P5(DI ~ P1; DI ~ DI-1; DS ~ LIT"-") ; 00247900
|
|
00248000
|
|
00248100
|
|
00248200
|
|
00248300
|
|
00248400
|
|
00248500
|
|
END;% 00248600
|
|
00248700
|
|
GO TO COMMM ; 00248800
|
|
FD: COMMENT MORE THEN 11 SIGNIFICANT DIGITS SO WE HAVE% 00248900
|
|
TO DO SPECIAL ROUND;% 00249000
|
|
DA ~ D -(ZEROS ~ E+D-11);% 00249100
|
|
COMMENT FIRST GUESS AT TRAILING ZEROS;% 00249200
|
|
RNDOFF;% 00249300
|
|
GO TO FA;% 00249400
|
|
COMMENT E PHRASES;% 00249500
|
|
ETYPE: IF D + 6 > W THEN GO TO AST; 00249600
|
|
SGN ~ (WH1 ~ WH1 | 1.0) < 0; 00249650
|
|
FINDE; COMMENT E ~ EXPONENI;% 00249700
|
|
ETYPE1: P(1) ; %%% RETURN LITERAL USED AT REDT. 00249800
|
|
REIN: IF (DA~D-1) > 10 THEN GO TO EB; COMMENT SPECIAL ROUND OFF 00249900
|
|
IF MORE THEN 11 SIGNIFICANT DIGITS;% 00250000
|
|
P(0); COMMENT SET LITERAL TO NOT ADJUST D2 AT ERTN;% 00250100
|
|
DH2 ~ (IF (E-D) } 0% 00250200
|
|
THEN WH1 / TEN[E-D+1]% 00250300
|
|
ELSE WH1 | TEN[D-1-E]);% 00250400
|
|
EA: COMMENT NUMBER NOW IN FORM OF N*N----N.% 00250500
|
|
WHERE * = TRUE DECIMAL POINT% 00250600
|
|
E = EXPONENT% 00250700
|
|
. = MACHINE POINT% 00250800
|
|
DA = # OF DIGITS BEIWEEN * S .% 00250900
|
|
DA + ZEROS = <DECIMAL PLACES>% 00251000
|
|
STORING IN DH2 ROUNDS NUMBER;% 00251100
|
|
IF ( DH2 ~ ABS(DH2)) } TEN[DA+1]% 00251200
|
|
THEN BEGIN% 00251300
|
|
DH2 ~ TEN[DA];% 00251400
|
|
E ~ E + 1;% 00251500
|
|
END;% 00251600
|
|
COMMENT IF ROUND OVERFLOWED THE LEADING DIGIT FROM 9 TO% 00251700
|
|
10 WE SET OUR NUMBER TO 1.0 AND INCREASE% 00251800
|
|
EXPONENT BY ONE;% 00251900
|
|
DH1 ~ DH2 DIV P(TEN8);COMMENT SINCE HARDWARE 0AN CONVERT% 00252000
|
|
ONLY 8 DIGITS WE SPLIT NUMBER IN IWO% 00252100
|
|
PARTS AT 8 TH DIGIT;% 00252200
|
|
IF FALSE THEN 00252210
|
|
TEN8::: @1045753604000000 ; 00252220
|
|
STREAM(P10~0:P9 ~ ABS(E),P8 ~ ( E<0),P7 ~ SGN,% 00252300
|
|
P6 ~ ZEROS,P5 ~ [DH1],P4 ~ D2,P3 ~ D1,% 00252400
|
|
P2 ~ SKIP, PU ~ UTOP ,PES ~ UES, 00252500
|
|
PFF ~ FFTYP, 00252505
|
|
PCH~FFCHR, 00252507
|
|
PED ~ UED,PDC ~ UDC,PMD ~ UMD, P1 ~ BUFF) ; 00252510
|
|
BEGIN% 00252600
|
|
P2(DS~LIT" "); COMMENT INSERT LEADING BLANKS;% 00252700
|
|
P1~DI; COMMENT SAVE ADDRESS OF INIEGER% 00252800
|
|
DIGIT;% 00252900
|
|
P7(DI ~ DI-1; DS~LIT"-"); 00253000
|
|
00253100
|
|
00253200
|
|
00253300
|
|
00253400
|
|
00253500
|
|
00253600
|
|
PDC(DI~DI+1 ; COMMENT SAVE ROOM FOR INTEGER 00253700
|
|
DIGIT;% 00253800
|
|
SI~P5;% 00253900
|
|
DS~P4 DEC) ; COMMENT CONVERT HIGH HALF ; 00254000
|
|
PMD(SI~P5 ; 00254100
|
|
SI~SI+8;% 00254200
|
|
DS~P3 DEC; COMMENT CONVERT LOW HALF;% 00254300
|
|
P6(DS~LIT"0")) ;COMMENT INSERT TRAILING ZEROS ; 00254400
|
|
DS~LIT "@";% 00254500
|
|
PES(DS~LIT"+"; P8(DI~DI-1; DS~LIT"-")) ; 00254600
|
|
00254700
|
|
00254800
|
|
00254900
|
|
00255000
|
|
SI~LOC P9; COMMENT CONVFRT EXPONENT;% 00255100
|
|
DS ~ PED DEC; 00255200
|
|
PFF(SI~LOC PED; SI~SI-1; DS~CHR) ; 00255205
|
|
PU(DS ~ LIT" ") ; 00255210
|
|
P10~DI; COMMENT ADDRESS OF NEXT FIELD;% 00255300
|
|
PDC(SI~P1 ; 00255400
|
|
SI~SI+1;% 00255500
|
|
DI~P1; COMMENT MOVE INTEGER DIGIT LEFT; 00255600
|
|
DS~CHR;% 00255700
|
|
DS~LIT".") ; 00255800
|
|
END;% 00255900
|
|
BUFF ~ P;% 00256000
|
|
ERTN: IF P THEN D2 ~ D-8;% 00256100
|
|
REOT: IF NOT P THEN GO TO RRTN; COMMENT OUT IF FROM RTYPE;% 00256200
|
|
GO TO COMM;% 00256300
|
|
EB: COMMENT MORL THEN 11 SIGNIFICANT DIGITS% 00256600
|
|
REQUESTED SO DO SPECIAL ROUND;% 00256700
|
|
DA ~ D-1-(ZEROS~ D-12);% 00256800
|
|
WH1 ~ (IF E>0 THEN WH1 / TEN[E]% 00256900
|
|
ELSE WH1 | TEN[-E]);% 00257000
|
|
COMMENT NUMBER NOW IN FORM N.NNN WITH EXPONENI IN E; 00257100
|
|
RNDOFF; COMMENT ROUND OFF NUMBER;% 00257200
|
|
D2 ~ DA - 7;% 00257300
|
|
P(1); COMMENT SET KEY TO ADJUST D2 AT ERTN;% 00257400
|
|
GO TO EA;% 00257500
|
|
COMMENT R PHRASE;% 00257600
|
|
RTYPE: WH1 ~ IF SCFTR } 0 THEN WH1 | TEN[SCFTR]% 00257700
|
|
ELSE WH1 / TEN[-SCFTR];% 00257800
|
|
FINDE;% 00257900
|
|
SGN ~ WH1 < 0;% 00258000
|
|
IF ABS(WH1) > P(MAXM) THEN GO TO TRYE;% 00258100
|
|
IF E } 0 THEN% 00258200
|
|
BEGIN COMMENT CHECK IF IT WILL GO AS F FIELD;% 00258300
|
|
IF (E+2+D+SGN) { W THEN% 00258400
|
|
BEGIN COMMENT YES- IT WILL;% 00258500
|
|
RC: SKIP ~ W-(D+1+WT);% 00258600
|
|
GO TO RFIN% 00258700
|
|
END ELSE GO TO TRYE; COMMENT TO BIG FOR F;% 00258800
|
|
END% 00258900
|
|
ELSE% 00259000
|
|
BEGIN COMMENT NUMBER IS LSS THEN 1. SEE IF IT WILL% 00259100
|
|
GO AS F FIELD WITHOUT LOSS IN REQUESTLD% 00259200
|
|
ACCURACY;% 00259300
|
|
IF ABS(E) { D THEN GO TO RC;% 00259400
|
|
COMMENT TO RC IF IT WILL GO AS F FIELD;% 00259500
|
|
END;% 00259600
|
|
COMMENT SEE IF NUMBER WILL FIT IN E FIELD;% 00259700
|
|
TRYE: IF W < (D+6+SGN) THEN% 00259800
|
|
BEGIN COMMENT FIELD TO SMALL FOR E. IF% 00259900
|
|
NUMBER < 1 PRINT AS F FIELD EVEN THOUGH% 00260000
|
|
ACCURACY IS LOST. FILL FIELD WITH * IF% 00260100
|
|
NUMBER } 1;% 00260200
|
|
IF E < 0 THEN GO TO RC% 00260300
|
|
ELSE GO TO AST;% 00260400
|
|
END;% 00260500
|
|
COMMENT NUMBER WILL FIT AS E FIELD,ADJUST PARAMETERS SO% 00260600
|
|
ETYPE CAN HANDLE;% 00260700
|
|
SKIP ~ W-(D+6);% 00260800
|
|
IF (D ~ D+1) > 8 THEN BEGIN D1~8; D2 ~ D-8 END% 00260900
|
|
ELSE BEGIN D1~D; D2 ~ 0 END;% 00261000
|
|
P(0); COMMENT FLAG USED AT REOT TO RETURN CONTROL TO% 00261100
|
|
RRTN;% 00261200
|
|
GO TO REIN;% 00261300
|
|
RRTN: IF (D ~ D-1) > 8 THEN BEGIN D1~8; D2 ~ D-8 END% 00261400
|
|
ELSE BEGIN D1~D; D2 ~ 0 END;% 00261500
|
|
GO TO COMM;% 00261600
|
|
MAXM::: @0007777777777777;% 00261700
|
|
COMMENT AFTER FORMATING A PHRASE WE COME HERE;% 00261800
|
|
COMMM: BUFF~P ; 00261810
|
|
COMM: IF CODE > 2 THEN WH1 ~ LISX;% 00261900
|
|
IF P((FFTYP=0),SUB,DUP) > 0 THEN GO TO INLOOP ; 00262000
|
|
P(DEL);% 00262100
|
|
GO TO S1;% 00262200
|
|
COMMENT THE <REPEAT PART> OF PHRASE IS IN TOP OF SIACK.% 00262300
|
|
IF REPEAT-1 > 0 THEN GO TO INLOOP TO USE SAME PHRASE 00262400
|
|
AGAIN ELSE DELETE THE "0" REPEAT AND GO TO S1 TO% 00262500
|
|
PICK UP NEXT PHRASE;% 00262600
|
|
END OUTPUTINT;% 00262700
|
|
COMMENT ALGOL SELECT INTRINSIC;% 00300000
|
|
PROCEDURE ALGOLSELECT(ACT1,ACT2,TANK,I); VALUE ACT1,ACT2,TANK,I;% 00300100
|
|
INTEGER ACT1,ACT2,I; NAME TANK;% 00300200
|
|
BEGIN ARRAY FIB[*]; NAME MEM=2; ARRAY FPB=3[*];% 00300300
|
|
ARRAY HEADER[*];% 00300400
|
|
LABEL REW,L6,MYUSERR ; 00300500
|
|
REAL RITE=12,REED=13,SELECT=14;% 00300600
|
|
INTEGER STATUS,NBUFFS,BSIZE,T1,INOUT,DIREC,UTYPE;% 00300700
|
|
LABEL OWT,EASY,EXIT,FILL;% 00300800
|
|
DEFINE IOD=(*TANK)#;% 00300900
|
|
LABEL WR,ERR,RF,RR;% 00301000
|
|
LABEL DC19; 00301010
|
|
SWITCH CURRENT~WR,ERR,RF,RR;% 00301100
|
|
LABEL CR,LP,MT,DK,SP,CP,PP,PR,DC;% 00301200
|
|
SWITCH USW~ CR,LP,MT,EASY,DK,SP,CP,LP,PP,PR,DC,CR,LP,DC19; 00301300
|
|
REAL SUBROUTINE COUNT;% 00301400
|
|
BEGIN FOR I~0 STEP 1 UNTIL NBUFFS-1 DO% 00301500
|
|
BEGIN IF NOT TANK[I].[19:1] THEN% 00301600
|
|
P([TANK[I]],@2000000000,2,COM,DEL,DEL);% 00301700
|
|
IF TANK[I].[27:1] THEN 00301800
|
|
BEGIN 00301805
|
|
I ~ I+1-(FIB[4].[2:1] AND FIB[5].[44:1]); 00301810
|
|
P(1); GO OWT; 00301820
|
|
END; 00301830
|
|
END; P(0);% 00301900
|
|
OWT: COUNT~P;% 00302000
|
|
END COUNT;% 00302100
|
|
SUBROUTINE SPACE; P(XCH,TANK,9,11,COM,DEL,DEL,DEL);% 00302200
|
|
SUBROUTINE MOVEUP;% 00302300
|
|
IF (I~MEM[FIB[16] INX 1])!BSIZE THEN% 00302400
|
|
BEGIN TANK[0]~IOD&(P(DUP).[33:15]-BSIZE+I)[33:33:15];% 00302500
|
|
T1~FIB[16].[33:15];% 00302600
|
|
STREAM(N~I+1,L~0,S~T1-I,D~T1-BSIZE);% 00302700
|
|
BEGIN SI~LOC N; SI~SI+6; DI~LOC L; DI~DI+7; DS~CHR;% 00302800
|
|
SI~S; DI~D; DS~N WDS; L(DS~32 WDS; DS~32 WDS);% 00302900
|
|
END END;% 00303000
|
|
SUBROUTINE REFILL;% 00303100
|
|
BEGIN FOR I~0 STEP 1 UNTIL NBUFFS-1 DO% 00303200
|
|
TANK[I]~TANK[I]&1[19:47:1]&DIREC[22:47:1] OR MEM;% 00303300
|
|
IF NBUFFS >1 THEN% 00303400
|
|
BEGIN;STREAM(T~IOD,N~NBUFFS-1,D~TANK);% 00303500
|
|
BEGIN SI~D; SI~SI+8; DS~N WDS; SI~LOC T; DS~WDS END;% 00303600
|
|
P(2&(NOT DIREC)[1:47:1],TANK,10,11,COM,DEL,DEL,DEL);% 00303700
|
|
END END REFILL;% 00303800
|
|
SUBROUTINE EMPTY;% 00303900
|
|
BEGIN FIB[17]~BSIZE-(IOD.[33:15]-(STATUS=3)-ACT2~FIB[16].[33:15]);00304000
|
|
FIB[16]~FIB[16]&0[22:22:1]&0[24:24:1];% 00304100
|
|
FIB[19]~FIB[19]&0[22:22:1]&0[24:24:2];% 00304200
|
|
FIB[13]~FIB[13]&0[25:25:1]&0[27:27:1];% 00304300
|
|
FIB[5].[43:2]~0;% 00304400
|
|
TANK[NOT 1]~P(DUP,LOD)&0[22:22:1]&0[24:24:1];% 00304500
|
|
BSIZE~IF STATUS=0 THEN MEM[ACT2-1] ELSE IOD.[8:10];% 00304600
|
|
FOR I~0 STEP 1 UNTIL NBUFFS-1 DO% 00304700
|
|
BEGIN TANK[I]~TANK[I]&1[19:47:1]&0[22:22:1]&0[24:24:1]% 00304800
|
|
&FIB[18][8:38:10] OR MEM;% 00304900
|
|
IF I>0 THEN% 00305000
|
|
TANK[I]~TANK[I]&((STATUS=3)+ACT2)[33:33:15];% 00305100
|
|
ACT2~MEM[ACT2-2].[18:15];% 00305200
|
|
END END EMPTY;% 00305300
|
|
IF I = 6 THEN GO TO L6; 00305400
|
|
IF I=7 THEN GO TO MYUSERR ; 00305410
|
|
TANK~((I-1) INX *P(.TANK))&0[8:8:25];% 00305500
|
|
FIB~TANK[NOT 2]; STATUS~FIB[5]; UTYPE~FIB[4].[8:4];% 00305600
|
|
IF I=4 THEN IF STATUS.[42:1]=0 THEN% 00305700
|
|
BEGIN;STREAM(S~[FPB[FIB[4].[13:11]+2]],D~[NBUFFS]);% 00305800
|
|
BEGIN SI~S; DS~3 OCT END;% 00305900
|
|
IF FIB[1]=0 THEN FIB[1]:=NBUFFS; 00305950
|
|
BSIZE~FIB[13].[28:10];% 00306000
|
|
IF (ACT1 OR 4)=6 THEN T1~@12 ELSE% 00306100
|
|
IF ACT1=4 THEN T1~@22 ELSE% 00306200
|
|
IF ACT1=8 THEN T1:=@52 ELSE 00306250
|
|
IF ACT1=0 THEN% 00306300
|
|
IF FIB[15].[24:6] LSS 16 AND NBUFFS GTR FIB[1] 00306350
|
|
THEN T1:=@12 ELSE T1:=IF NBUFFS EQL BSIZE 00306400
|
|
THEN 6 ELSE @12 ELSE 00306500
|
|
IF ACT1 = 1 THEN 00306600
|
|
BEGIN NBUFFS:=BSIZE; T1:=7; IF UTYPE = 4 THEN 00306610
|
|
BEGIN HEADER:=*[FIB[14]]; 00306620
|
|
IF(DIREC:=FIB[7]-1) GTR (INOUT:=HEADER[7]) THEN 00306630
|
|
DIREC:=INOUT;INOUT:=(DIREC DIV HEADER[0].[30:12])+1; 00306640
|
|
END END ELSE T1:=0; 00306650
|
|
P(TANK&T1[18:33:15],6,11,COM,DEL,DEL);% 00306700
|
|
FIB[13].[28:10]:=IF FIB[15].[24:6] LSS 16 AND NOT ACT1 00306800
|
|
THEN FIB[1] ELSE NBUFFS; IF ACT1 AND UTYPE =4 THEN 00306805
|
|
BEGIN FIB[6]:=INOUT; FIB[7]:=DIREC; END; GO TO EXIT; 00306810
|
|
END ELSE GO TO EXIT ELSE% 00306900
|
|
IF STATUS.[41:2]!0 THEN% 00307000
|
|
EASY: BEGIN FIB[13]~FIB[13]&(ACT2=3)[25:47:1]&(ACT2!0)[27:47:1];% 00307100
|
|
GO TO EXIT;% 00307200
|
|
END;% 00307300
|
|
GO TO USW[UTYPE];% 00307400
|
|
MT: NBUFFS~FIB[13].[10:9]; BSIZE~FIB[18].[18:15];% 00307500
|
|
INOUT~ACT2!0; DIREC~ACT2=3; STATUS~STATUS.[46:2];% 00307600
|
|
GO TO CURRENT[FIB[5].[43:2]];% 00307700
|
|
CR: LP: CP: PP: PR: GO TO ERR; 00307800
|
|
$ SET OMIT = NOT(TIMESHARING) 00307801
|
|
DC: 00307805
|
|
$ POP OMIT 00307808
|
|
DC19: POLISH(IOD, [TANK[1]], *P(DUP), TANK, ~, ~); 00307810
|
|
FIB[5] ~ (*P(DUP))&P(DUP, LNG)[43:43:1]; GO TO EASY; 00307820
|
|
$ SET OMIT = TIMESHARING 00307825
|
|
WR: IF NOT DIREC THEN 00307900
|
|
ERR:: P(TANK,8,11,COM);% 00308000
|
|
SP: P(MKS,1,0,(NOT 2) INX TANK,4,SELECT); GO TO EASY;% 00308100
|
|
RF: IF INOUT THEN% 00308200
|
|
BEGIN T1~COUNT; P((-I)); SPACE;% 00308300
|
|
IF (I~MEM[FIB[16] INX NOT 0])!BSIZE THEN% 00308400
|
|
BEGIN;STREAM(N~I+1,NDIV64~(I+1) DIV 64,% 00308500
|
|
S~FIB[16] INX (NOT 0) INX I,% 00308600
|
|
D~FIB[16] INX (NOT 0) INX BSIZE);% 00308700
|
|
BEGIN SI~S; N(DS~WDS; SI~SI-16; DI~DI-16);% 00308800
|
|
NDIV64(2(32(DS~WDS; SI~SI-16; DI~DI-16)));% 00308900
|
|
END;% 00309000
|
|
TANK[0]~(BSIZE-I) INX IOD;% 00309100
|
|
END;% 00309200
|
|
FIB[17]~I-(IF FIB[17]=0 THEN I ELSE FIB[17])% 00309300
|
|
+(STATUS!0)|IOD.[8:10]+(STATUS=3);% 00309400
|
|
FIB[16]~(BSIZE-1) INX FIB[16]&1[22:47:1];% 00309500
|
|
FIB[19]~FIB[19]&(FIB[16] INX (STATUS!3)% 00309600
|
|
-(STATUS=1)|FIB[18].[33:15])[33:33:15]% 00309700
|
|
&(IF STATUS=0 THEN FIB[19].[3:5]+2 ELSE% 00309800
|
|
IF STATUS=1 THEN 5 ELSE 7)[3:43:5]&1[22:47:1];% 00309900
|
|
FIB[5].[43:2]~3; FIB[13].[25:1]~1;% 00310000
|
|
TANK[NOT 1]~P(DUP,LOD)&1[22:47:1];% 00310100
|
|
MEM[FIB[16] INX 1]~I;% 00310200
|
|
MEM[FIB[16] INX NOT(I-1)]~I;% 00310300
|
|
FILL: REFILL;% 00310400
|
|
P(MKS,0,1,TANK,REED,MKS,0,0,TANK,REED);% 00310500
|
|
END ELSE% 00310600
|
|
BEGIN IF COUNT THEN IF I=1 THEN% 00310700
|
|
BEGIN P(MKS,1,0,(NOT 2) INX TANK,4,SELECT);% 00310800
|
|
FIB[13].[25:1]~1;% 00310900
|
|
P(TANK,0,11,COM,DEL,DEL);% 00311000
|
|
P(MKS,ACT1,0,TANK,1,SELECT);% 00311100
|
|
GO TO EXIT;% 00311200
|
|
END;% 00311300
|
|
P((-I)); SPACE; EMPTY;% 00311400
|
|
END;% 00311500
|
|
GO TO EXIT;% 00311600
|
|
RR: IF INOUT THEN% 00311700
|
|
BEGIN T1~COUNT; P(I); SPACE; MOVEUP;% 00311800
|
|
FIB[17]~I-(IF FIB[17]=0 THEN I ELSE FIB[17])+(STATUS=3)% 00311900
|
|
+(STATUS!0)|IOD.[8:10];% 00312000
|
|
FIB[16]~FIB[16]&P(DUP,1,INX,BSIZE,-)[33:33:15]&0[22:22:1];% 00312100
|
|
FIB[19]~FIB[19]&(FIB[16] INX (STATUS=3))[33:33:15]&0[22:22:1]% 00312200
|
|
&(P(DUP).[3:5]-STATUS&(NOT STATUS)[46:46:1])[3:43:5];% 00312300
|
|
TANK[NOT 1]~P(DUP,LOD)&0[22:22:1];% 00312400
|
|
FIB[5].[43:2]~2; FIB[13].[25:1]~0; GO FILL;% 00312500
|
|
END;% 00312600
|
|
IF COUNT THEN IF I=1 THEN% 00312700
|
|
BEGIN P(MKS,0,0,(NOT 2) INX TANK,4,SELECT); GO TO EASY END;% 00312800
|
|
P(I-1); SPACE; MOVEUP;% 00312900
|
|
FIB[16]~FIB[16]&P(DUP,1,INX,BSIZE,-)[33:33:15];% 00313000
|
|
FIB[19]~(STATUS=3) INX FIB[16]&FIB[18] [8:38:10];% 00313100
|
|
EMPTY;% 00313200
|
|
P(MKS,0,0,0,(-1),TANK, RITE,MKS,0,0,0,BSIZE,TANK, RITE);% 00313300
|
|
GO TO EXIT;% 00313400
|
|
% 00313500
|
|
DK:: IF FIB[4].[27:3]=1 THEN% 00313600
|
|
BEGIN FIB[5].[43:2]~ACT2;% 00313700
|
|
FIB[16].[24:1]~ACT2~ACT2!0;% 00313800
|
|
FIB[19]~FIB[19]&ACT2[24:47:1]&0[25:47:1]; 00313900
|
|
END ELSE% 00314000
|
|
IF FIB[4].[27:3]=0 THEN% 00314100
|
|
REW:% 00314200
|
|
BEGIN IF ACT2=1 THEN ACT2~FIB[5].[43:2]ELSE% 00314300
|
|
IF ACT2=4 THEN ACT2~0 ELSE% 00314400
|
|
IF ACT2=3 THEN ACT1~FIB[7]-1 ELSE% 00314500
|
|
IF FIB[5].[43:2]=3 THEN ACT1~FIB[7]+1 ELSE% 00314600
|
|
ACT1~FIB[7];% 00314700
|
|
P(MKS,0,0,(NOT 2)INX TANK,4,SELECT);% 00314800
|
|
FIB[13]~FIB[13]&(ACT2=3)[25:47:1]&(ACT2!0)[27:47:1];% 00314900
|
|
FIB[7]~ACT1;% 00315000
|
|
P(TANK,0,11,COM,DEL,DEL);% 00315100
|
|
END ELSE% 00315200
|
|
BEGIN IF ACT2=3 THEN GO TO ERR;% 00315300
|
|
IF ACT2=1 OR ACT2=4 THEN GO TO REW;% 00315400
|
|
IF ACT2=0 THEN BEGIN HEADER~*[FIB[14]];% 00315500
|
|
IF FIB[7]>HEADER[7] THEN% 00315600
|
|
HEADER[7]~FIB[7];% 00315700
|
|
P(MKS,0,1,TANK,REED,MKS,0,0,TANK,REED);00315800
|
|
END ELSE% 00315900
|
|
P(MKS,1,0,0,(-1),TANK,RITE,% 00316000
|
|
MKS,1,0,0,FIB[18].[33:15],TANK,RITE);% 00316100
|
|
GO TO EXIT; 00316200
|
|
END; GO EXIT; 00316300
|
|
L6: FIB ~ *TANK; TANK ~[TANK[3]]; % SORT REEL SWITCHING 00316400
|
|
IF ACT1 = 1 THEN 00316500
|
|
BEGIN % I/O COMPLETE BUT NOT PRESENT 00316600
|
|
IF NOT (*TANK).[27:1] THEN % PARITY 00316700
|
|
P(1,[TANK[NOT 2]],19,17,COM) % TERMNATE ON PARITY 00316800
|
|
ELSE 00316900
|
|
BEGIN % EOF OR EOR 00317000
|
|
P(TANK,11,11,COM,DEL,DEL); % READ ENDING LABEL 00317100
|
|
IF MEM[TANK[NOT 1] INX 4].[42:6] =0 THEN P(1,RTN); %EOF 00317200
|
|
T1~ FIB[13].[28:10] + 1; % REEL # + 1 00317300
|
|
P(MKS,4,0,[TANK[NOT 2]],4,SELECT); % CLOSE PURGE 00317400
|
|
FIB[13].[28:10] ~ T1; 00317500
|
|
P([TANK],0,11,COM); P(0,RTN); 00317600
|
|
END; 00317700
|
|
END; 00317800
|
|
IF ACT1 = 0 THEN % REEL SWITCH ON OUTPUT 00317900
|
|
BEGIN 00318000
|
|
HEADER ~ TANK[NOT 1]; HEADER[4].[42:6] ~ 1; % EOR FLAG 00318100
|
|
T1 ~ FIB[13].[28:10] + 1; 00318200
|
|
P(MKS,7,0,[TANK[NOT 2]],4,SELECT); 00318300
|
|
FIB[13].[28:10] ~ T1; 00318400
|
|
P( TANK,0,11,COM); P(XIT); 00318500
|
|
END; 00318600
|
|
IF ACT1 = 2 THEN % REWIND OUTPUT 00318700
|
|
BEGIN 00318800
|
|
T1 ~ IF FIB[13].[28:10] = 1 THEN 0 ELSE 7; 00318900
|
|
P(MKS,T1,0,[TANK[NOT 2]],4,SELECT); P(XIT); 00319000
|
|
END; P(XIT); 00319100
|
|
MYUSERR: %%% BRANCH TO HERE IF I=7; 00319110
|
|
P(TANK[NOT 3]); TANK[NOT 3]~TANK[NOT 4]~0; P(MKS,9,JUNK,DEL) ; 00319120
|
|
FIB~TANK[NOT 2]; HEADER~P([HEADER[1]],CFX,SFB) & 10[8:38:10] ; 00319130
|
|
STREAM(P1~ACT2,P2~[FPB[FIB[4].[13:11]]],P3~FIB[5].[11:2],HEADER) ; 00319140
|
|
BEGIN DS~5LIT"-FAE("; SI~P2; SI~SI+1; DS~7CHR; SI~SI+1; 00319150
|
|
DS~LIT"/"; TALLY~0; 7(IF SC=" " THEN JUMP OUT; SI~SI+1; 00319152
|
|
TALLY~TALLY+1); SI~P2; SI~SI+9; P2~TALLY; DS~P2 CHR ; 00319154
|
|
DS~7LIT".MYUSE="; SI~LOC P3; DS~DEC; DS~8LIT") TRIED " ; 00319160
|
|
SI~LOC P1; SI~SI+2; DS~6CHR; DS~2LIT":~" ; 00319170
|
|
END OF STREAM ; 00319180
|
|
P([HEADER[0]].[33:15],34,COM) ; 00319190
|
|
EXIT::% 00319200
|
|
END SELECT;% 00319300
|
|
PROCEDURE INTRINSIC(DUPE,D,NUMDIM,SIZE,TYPE);% 00400000
|
|
VALUE DUPE,D,NUMDIM,SIZE,TYPE;% 00400100
|
|
ARRAY DUPE[*];NAME D;% 00400200
|
|
INTEGER NUMDIM,SIZE,TYPE;% 00400300
|
|
BEGIN% 00400400
|
|
NAME DUM=TYPE,A;% 00400500
|
|
ARRAY DOPE=-8[*];% 00400600
|
|
ARRAY PRTPOINTER=10[*];% 00400700
|
|
REAL NUMBUFF=-7,IOT=-2,MODE=-6,FILENO=-9,BUFFSIZE=-5;% 00400800
|
|
REAL DISPOSITION=-10,ROWSIZE=-11,NUMROWS=-12,RECSIZE=D;% 00400900
|
|
NAME E;% 00401000
|
|
INTEGER I,J,K;% 00401100
|
|
REAL C;% 00401200
|
|
BOOLEAN B;% 00401300
|
|
ARRAY AIT=6[*];% 00401400
|
|
REAL RECURSE=5; INTEGER BLOCKCTR=16;% 00401500
|
|
NAME M=2; 00401600
|
|
ARRAY FIB[*]; 00401700
|
|
ARRAY FPB=3[*],SEGDICT=4[*]; 00401800
|
|
INTEGER TIPE=-2,CYCLE=-3,DATE=-4,REEL=-5,FID=-6,MFID=-7; 00401900
|
|
NAME FLE=-8; 00402000
|
|
LABEL EXIT,AOK,UPDATEFPB; 00402100
|
|
REAL PTR=-11,APTR=-10,LBO=-7,DIMO=-6,LBN=-5,DIMN=-4,MAXLB,MINUB, 00402200
|
|
UBO,UBN,N,TP,H; 00402300
|
|
ARRAY ARRY = MINUB[*]; 00402310
|
|
INTEGER DIM1 = UBO, DIM2 = UBN; 00402320
|
|
ARRAY OAT=11[*],NEW=-8[*],OLD=-9[*]; 00402400
|
|
NAME MAT=-2,NAT; 00402500
|
|
BOOLEAN OWNTOG,REDECLTOG,TASKARRAYTOG,AUXTOG; 00402600
|
|
LABEL FOUND,ARROUNDFOUND,TY12; 00402700
|
|
NAME PHILE=-10; 00402800
|
|
LABEL TY0,TY1,TY2,TY3,TY4,TY5,TY6,TY7,TY8,TY9,TY10;% 00402900
|
|
LABEL TY11,TY13,TY14,TY15,TY16,TY17,TY18,TY19; 00403000
|
|
SWITCH SW~TY0,TY1,TY2,TY3,TY4,TY5,TY6,TY7,TY8,TY9,TY10,TY11, 00403100
|
|
TY12,TY13,TY14,TY15,TY16,TY17,TY18,TY19; 00403200
|
|
TASKARRAYTOG~TYPE.[1:1];AUXTOG~TYPE.[41:1];TYPE~TYPE AND @77; 00403250
|
|
GO TO SW[TYPE];% 00403300
|
|
TY0::TY1:TY2:TY3:% 00403400
|
|
OWNTOG~TYPE.[46:1]; 00403500
|
|
I~AIT[J~0];TYPE~TYPE+4;% 00403600
|
|
E~P(NUMDIM-1+OWNTOG|(NUMDIM-1),NOT,[NUMDIM],INX); 00403700
|
|
A~P(SIZE-1+OWNTOG,NOT,[E],INX);IF P([E[0]],DUP,LOD,XCH,ISN){0 OR 00403800
|
|
E[0]>1023 THEN 00403900
|
|
P(E[0],TRUE,1,29,COM); 00404000
|
|
IF OWNTOG THEN BEGIN 00404100
|
|
H~OAT[0];NAT~P(0,NOT,[E],INX); 00404200
|
|
FOR K~1 STEP 1 UNTIL H DO 00404300
|
|
IF A[J].[CF]=OAT[K].[1:15] THEN GO TO FOUND; 00404400
|
|
FOR C~1 STEP 1 UNTIL SIZE DO 00404500
|
|
OAT[H~H+1]~0&A[C-1] [1:33:15]; 00404600
|
|
FOR C~1 STEP 1 UNTIL 2|NUMDIM DO 00404700
|
|
P(NAT[C-1],[OAT[H~H+1]],ISD); 00404800
|
|
OAT[0]~H;GO AOK; 00404900
|
|
FOUND:REDECLTOG~TRUE; 00405000
|
|
STREAM(R~0:NUMDIM,A~[OAT[TP~K+SIZE ]],B~[NAT] ); 00405100
|
|
BEGIN SI~A;TALLY~1; 00405200
|
|
NUMDIM(IF 16 SC!DC THEN TALLY~0); R~TALLY ; 00405300
|
|
END; 00405400
|
|
IF P(NOP) THEN GO TO EXIT; 00405500
|
|
ARROUNDFOUND: A[J]~[PRTPOINTER[17]]; 00405600
|
|
END; 00405700
|
|
AOK:DO 00405800
|
|
BEGIN% 00405900
|
|
B~NUMDIM!1;C~((IF AUXTOG THEN 3 ELSE (TYPE.[47:1] OR B)) 00406000
|
|
&A[J][CTF] & E[0][8:38:10]);% 00406100
|
|
IF NOT OWNTOG THEN 00406200
|
|
AIT[I~I+1]~C & TYPE[2:46:1]&BLOCKCTR[8:38:10]% 00406300
|
|
&NUMDIM[3:43:5]; P(FLAG(C),A[J],STD);% 00406400
|
|
IF TASKARRAYTOG THEN AIT[I].[1:2] ~ 3; 00406450
|
|
IF B THEN% 00406500
|
|
P(MKS,FLAG(C),[E[1+OWNTOG]],NUMDIM-1,E[0], 00406600
|
|
TYPE&AUXTOG[41:47:1],RECURSE) % 00406700
|
|
END% 00406800
|
|
UNTIL ((J~J+1)=SIZE) OR REDECLTOG; 00406900
|
|
IF REDECLTOG THEN 00407000
|
|
BEGIN %REMAP 00407100
|
|
P(MKS,TP+2,2,M[OAT[K].[1:15]],[PRTPOINTER[17]],LOD, 00407200
|
|
OAT[TP],OAT[TP+1],NAT[0],NAT[1],NUMDIM,[NAT],12 00407300
|
|
, RECURSE,[M[OAT[K].[1:15]]],LOD,NUMDIM,25,COM,DEL, 00407400
|
|
DEL);K~K+1; 00407500
|
|
IF J<SIZE THEN GO ARROUNDFOUND; 00407600
|
|
STREAM(NUMDIM,A~[NAT[0]],B~[OAT[TP]]); 00407700
|
|
BEGIN SI~A;NUMDIM(DS~2 WDS) END; 00407800
|
|
END; AIT[0]~I;GO TO EXIT; 00407900
|
|
; GO TO EXIT;% 00408000
|
|
TY4::TY5:TY6:TY7:% 00408100
|
|
OWNTOG~TYPE.[46:1]; 00408200
|
|
IF P(D,DUP,LOD,XCH,ISN,DUP ){0 OR P(XCH)>1023 THEN P(D[0],1,1,29,COM00408300
|
|
); DO 00408400
|
|
BEGIN% 00408500
|
|
B~NUMDIM!1; 00408510
|
|
DUPE[K]~FLAG(C~((IF AUXTOG THEN 3 ELSE 00408600
|
|
(TYPE.[47:1] OR B))% 00408700
|
|
&[DUPE[K]][CTF]&D[0][8:38:10]));% 00408800
|
|
IF B THEN% 00408900
|
|
P(MKS,FLAG(C),[D[1+OWNTOG]],NUMDIM-1,D[0], 00409000
|
|
TYPE&AUXTOG[41:47:1],RECURSE) % 00409100
|
|
END% 00409200
|
|
UNTIL(K~K+1)=SIZE% 00409300
|
|
; GO TO EXIT;% 00409400
|
|
TY12: 00409500
|
|
IF LBO<LBN THEN MAXLB~LBN 00409600
|
|
ELSE MAXLB~LBO; 00409700
|
|
UBO~LBO+DIMO-1; 00409800
|
|
UBN~LBN+DIMN-1; 00409900
|
|
IF UBO<UBN THEN MINUB~UBO 00410000
|
|
ELSE MINUB~UBN; 00410100
|
|
N~MINUB-MAXLB+1; 00410200
|
|
IF NUMDIM=1 THEN BEGIN 00410300
|
|
IF N{0 THEN GO TO EXIT; 00410400
|
|
STREAM(N,M~N.[38:4],A~[OLD[MAXLB-LBO]],B~[NEW[MAXLB-LBN]]); 00410500
|
|
BEGIN SI~A;M(DS~32 WDS;DS~32 WDS);DS~N WDS; END; 00410600
|
|
END 00410700
|
|
ELSE 00410800
|
|
FOR I~0 STEP 1 UNTIL N-1 DO 00410900
|
|
P(MKS,PTR+2,APTR+2,[OLD[MAXLB-LBO+I]],LOD, 00411000
|
|
[NEW[MAXLB-LBN+I]],LOD,OAT[PTR],OAT[PTR+1], 00411100
|
|
MAT[APTR],MAT[APTR+1],NUMDIM-1,[MAT],12,RECURSE); 00411200
|
|
GO TO EXIT; 00411300
|
|
TY8::% 00411400
|
|
P(IF NUMBUFF<1 THEN 1 ELSE NUMBUFF, .NUMBUFF, ISD); 00411500
|
|
P(NUMDIM,.NUMDIM,ISD); 00411600
|
|
P(RECSIZE,.RECSIZE,ISD); 00411700
|
|
P(BUFFSIZE,.BUFFSIZE,ISD); 00411800
|
|
P(ROWSIZE,.ROWSIZE,ISD); 00411900
|
|
IF P(NUMROWS,.NUMROWS,ISN)>20 THEN 00412000
|
|
P(NUMROWS,TRUE,2,29,COM); 00412100
|
|
P(MKS,*P(.DOPE),(NUMBUFF=1)+NUMBUFF+27, 00412200
|
|
1,1,1,RECURSE); 00412210
|
|
AIT[AIT[0]]~-AIT[AIT[0]];% 00412300
|
|
DOPE~*[DOPE];% 00412400
|
|
DOPE[2]~[DOPE[(NUMBUFF=1)+NUMBUFF+5]]&22[8:38:10]; 00412500
|
|
DOPE[4]~[DOPE[5]];% 00412600
|
|
DOPE[3]~0&10[8:38:10];% 00412700
|
|
I~0;C~ @20002020000000 &(IOT!10)[24:47:1]&MODE% 00412800
|
|
[27:47:1]&([DOPE[6]])[CTC];% 00412900
|
|
WHILE(I~I+1){NUMBUFF DO% 00413000
|
|
DOPE[I+4]~FLAG(C);% 00413100
|
|
DOPE~*[DOPE[2]];% 00413200
|
|
STREAM(T~[NUMDIM]); BEGIN SI~T; DS ~ 8 DEC END;% 00413300
|
|
FILENO~(FILENO-1)|ETRLNG;% 00413400
|
|
DOPE[4]~NUMDIM&FILENO[13:37:11]&1[12:47:1]&3[8:44:4]% 00413500
|
|
&(IOT=11)[6:47:1]&DISPOSITION[25:46:2];% 00413600
|
|
IF RECSIZE=0 THEN% 00413700
|
|
BEGIN RECSIZE~BUFFSIZE; I~0 END ELSE% 00413800
|
|
IF BUFFSIZE{RECSIZE THEN% 00413900
|
|
BEGIN I~BUFFSIZE; BUFFSIZE~RECSIZE; RECSIZE~I; I~1 END% 00414000
|
|
ELSE I~3;% 00414100
|
|
DUPE[5]~I & (IOT!10)[43:47:1] & 1[42:47:1] & (IF TYPE~( 00414200
|
|
TYPE~FPB[FILENO+3].[43:5])=1 OR TYPE=4 OR TYPE=6 00414205
|
|
OR (TYPE>14 AND TYPE<19) THEN 2 ELSE 3)[11:46:2] 00414210
|
|
& (IF TYPE THEN 0 ELSE 3)[9:46:2] & (IF TYPE THEN 00414215
|
|
4 ELSE 0)[13:45:3] ; 00414220
|
|
STREAM(FB~[FPB[FILENO]],R~[I]);% 00414300
|
|
BEGIN SI~FB; SI~SI+16; DS~3 OCT END;% 00414400
|
|
DOPE[13]~0&NUMBUFF[1:39:9]&MODE[24:47:1]% 00414500
|
|
&I[28:38:10]&NUMBUFF [10:39:9]% 00414600
|
|
&(IOT!10)[27:47:1];% 00414700
|
|
DOPE[18]~RECSIZE&BUFFSIZE[3:33:15]&BUFFSIZE[18:33:15];% 00414800
|
|
DOPE[8]~ROWSIZE&NUMROWS[15:38:10];% 00414900
|
|
$ SET OMIT = NOT SHAREDISK 00414949
|
|
GO TO EXIT;% 00415000
|
|
TY9::% 00415100
|
|
BEGIN IF NUMDIM ! 0 THEN 00415200
|
|
IF NUMDIM ! 15 THEN BEGIN 00415300
|
|
IF (J ~ (C ~ NUMDIM).[8:10]) ! BLOCKCTR THEN% 00415400
|
|
BEGIN BLOCKCTR ~ J+1;% 00415500
|
|
P(10,COM);% 00415600
|
|
END;% 00415700
|
|
P(SIZE,.NUMDIM,~);% 00415800
|
|
IF (J ~ C.[18:15]) = 0 THEN% 00415900
|
|
J ~ PRTPOINTER.[18:15]+2;% 00416000
|
|
DO UNTIL (*(PRTPOINTER&(J~HUNT(J+1) INX 0)[33:33:15])).% 00416100
|
|
[1:3]=4 AND M[J].[6:12] !0; 00416200
|
|
P((*[PRTPOINTER[C.[33:15]]])&J[18:33:15],BRT);% 00416300
|
|
END END;% 00416400
|
|
NUMDIM~0; 00416500
|
|
GO TO EXIT;% 00416600
|
|
TY10::% 00416700
|
|
AIT[AIT[0]~AIT[0]+1] ~-2&1[8:38:10]&[SIZE][18:33:15];% 00416800
|
|
GO TO EXIT;% 00416900
|
|
TY11:: FIB~FLE[NOT 2]; 00417000
|
|
IF FIB[5].[41:2] = 0 THEN GO TO EXIT; % FILE OPENED 00417100
|
|
IF FIB[5].[42:1] THEN GO TO UPDATEFPB; % CLOSED,RELEASED 00417110
|
|
IF FIB[4].[24:2] ! 1 THEN GO TO EXIT; % REWOUND 00417120
|
|
IF FIB[4].[8:4] ! 2 THEN GO TO EXIT; % MUST BE TAPE 00417125
|
|
MFID ~ TIPE ~ -0; % PREVENT CHANGE IN MFID OR TYPE 00417130
|
|
UPDATEFPB: 00417140
|
|
BEGIN 00417150
|
|
STREAM(A~0:MFID,FID,REEL~REEL~REEL,DATE~DATE~DATE, 00417200
|
|
CYCLE~CYCLE~CYCLE,TIPE~TIPE~TIPE, 00417300
|
|
F~ I~ [FPB[FIB[4].[13:11]]]); 00417400
|
|
BEGIN SI~LOC MFID; 00417500
|
|
2(IF SC="+" THEN BEGIN SI~SI+8; DI~DI+8 END ELSE 00417600
|
|
IF SC="0" THEN DS~WDS ELSE BEGIN TALLY~1; A~TALLY; 00417610
|
|
JUMP OUT TO ERR END); 00417620
|
|
IF SC="+" THEN BEGIN SI~SI+8; DI~DI+3 END ELSE DS~3 DEC; 00417700
|
|
IF SC="+" THEN BEGIN SI~SI+8; DI~DI+5 END ELSE DS~5 DEC; 00417800
|
|
IF SC="+" THEN BEGIN SI:=SI+8;DI:=DI+2 END ELSE 00417900
|
|
BEGIN DS~ DEC; DI~DI+1; END; 00417910
|
|
IF SC!"+" THEN BEGIN SI~SI+7; DI~DI+5; DS~CHR END; 00418000
|
|
ERR: END; 00418100
|
|
IF P THEN P((-75),34,COM); % DS - INVALD FILE NAME 00418110
|
|
IF REEL}0 THEN FIB[13].[28:10]~REEL END; 00418200
|
|
I~ P(.I,LOD) INX 0; % MARK MFID OF REMOTE FILE 00418210
|
|
IF M[I INX 3].[43:5]=19 THEN % WHICH HAS BEEN FILLED 00418220
|
|
M[I]~ P(DUP,LOD,SSN); % SO FILE OPEN WILL KNOW 00418230
|
|
GO TO EXIT; 00418300
|
|
TY13:: C~1; I~AIT[J~0]; 00418400
|
|
DO AIT[I~I+1]~(M[[TYPE]INX NOT C])&BLOCKCTR[8:38:10] 00418500
|
|
&1[1:46:2] UNTIL(C~C+1)> SIZE; 00418600
|
|
AIT[0]~I; GO EXIT; 00418700
|
|
TY14:: IF TIPE<3 THEN TIPE~0 ELSE IF TIPE>5 THEN TIPE~5; %AS00418800
|
|
IF TIPE!0 THEN DO % DECLARE SORT FILES %AS00418900
|
|
BEGIN P(MKS,0,0,3,CYCLE+I,[D[I]],2,1,10,0,3,11,8,RECURSE 00419000
|
|
,D[I],5,CDC,@1612-I,~); %AS00419100
|
|
END UNTIL (I~I+1)}TIPE; %AS00419200
|
|
P(TIPE,RTN); %AS00419300
|
|
COMMENT TY14 DECLARES SORT TAPE FILES FOR ALGOL; %AS00419400
|
|
GO EXIT; 00419500
|
|
TY15:: PHILE[NOT 3] ~ IOT; PHILE[NOT 4] ~ NUMDIM; GO TO EXIT; 00419600
|
|
TY16:: TY17: TY18: 00419700
|
|
E ~ M OR (*(P(.NUMDIM)+SIZE)).[18:15]; 00419705
|
|
IF SIZE = 0 THEN COMMENT FISH OUT OLD SIZES TO USE; 00419710
|
|
BEGIN;STREAM(A~0:S~*E); 00419715
|
|
BEGIN TALLY~1; SI~S; SI~SI-16; SKIP 2 SB; 00419720
|
|
IF SB THEN TALLY~2; A~TALLY; 00419725
|
|
END STREAM; 00419730
|
|
IF(SIZE:=P) THEN DIM2:=(*E).[8:10] ELSE 00419735
|
|
DIM2:=P(*E,P(DUP).[8:10],.DIM1,STD,0,CDC,LOD).[8:10]; 00419740
|
|
END ELSE BEGIN DIM2 ~ NUMDIM; 00419745
|
|
IF NOT SIZE THEN DIM1 ~ RECSIZE; 00419750
|
|
END; 00419755
|
|
IF TYPE = 18 COMMENT "IDN" FUNCTION; 00419760
|
|
THEN IF SIZE OR (DIM1 NEQ DIM2) THEN P((-54), 26, COM); 00419770
|
|
POLISH(SIZE,E,39,COM,DEL,DEL); % RETURN OLD ARRAY : 00419780
|
|
POLISH(MKS, E); IF NOT SIZE THEN P(DIM1); 00419790
|
|
POLISH(DIM2, SIZE, 1, 0, RECURSE); 00419800
|
|
ARRY ~ *E; DIM1 ~ DIM1-1; 00419810
|
|
IF TYPE = 17 THEN COMMENT "CON" FUNCTIDN; 00419820
|
|
BEGIN IF SIZE THEN P(*E, 2, CCX, E, ~) ELSE 00419830
|
|
FOR I~1 STEP 1 UNTIL DIM1 DO 00419840
|
|
POLISH([ARRY[I]], DUP, LOD, 2, CCX, XCH, ~); 00419850
|
|
END; 00419860
|
|
IF TYPE = 18 THEN COMMENT "IDN" FUNCTION AGAIN; 00419870
|
|
FOR I~1 STEP 1 UNTIL DIM1 DO 00419880
|
|
P(*[ARRY[I]], I, CDC, 1, XCH, ~); 00419890
|
|
GO TO EXIT; 00419900
|
|
TY19:: % IMPLEMENTED FOR COBOL 68 ARRAY DECLARATION 1 OR 2 DIM 00420000
|
|
ARRY ~ *[PRTPOINTER[17]]; 00420100
|
|
M[[ARRY[0]] INX NOT 1].[2:1] := 1; % MARK IT SAVE 00420105
|
|
FOR I ~ 1 STEP 1 UNTIL ARRY[0] DO 00420110
|
|
BEGIN 00420120
|
|
C ~ ARRY[I]; 00420130
|
|
P(MKS,[PRTPOINTER[C.[FF]]], 00420140
|
|
P(DUP,LOD,P(DUP).[FF],P(XCH).[CF]), 00420150
|
|
IF C.[17:1] THEN P(XCH,DEL) ELSE P, 00420160
|
|
C.[16:2],1,C.[CF],RECURSE); 00420170
|
|
END; 00420180
|
|
SEGDICT[0] ~ *P(DUP)-1; % DELETE TEMP AIT 00420185
|
|
P([PRTPOINTER[17]] INX M,3,COM,DEL); 00420190
|
|
EXIT:: 00429900
|
|
END INTRINSIC INTRINSIC; 00430000
|
|
PROCEDURE FILEATTRIBUTES(TANK,ERRL,DUM1,VAL,NAM,INFO,TEN) ; 00430050
|
|
VALUE TANK,DUM1,VAL,NAM,INFO,ERRL ; 00430100
|
|
INTEGER VAL ; 00430150
|
|
REAL ERRL,DUM1,NAM,INFO ; 00430200
|
|
NAME TANK ; 00430250
|
|
ARRAY TEN[*] ; 00430300
|
|
BEGIN 00430350
|
|
% THIS PROC HANDLES FILE ATTRIBUTES (FOR MORE INFO, REFER TO THE 00430400
|
|
% ALGOL COMPILER, PROCEDURE FILEATTRIBUTEHANDLER, FOR A DESCRIPIION 00430450
|
|
% OF THE VARIOUS KINDS OF FILE ATTRIBUTE CALLS). DUM1 IS A DUMMY 00430500
|
|
% PARAMETER RESERVED FOR POSSIBLE FUTURE USE. 00430525
|
|
% TO ADD A NEW ATTRIBUTE, FIRST MAKE THE APPROPIATE CHANGES IN 00430550
|
|
% THE COMPILER(S). THEN, DECLARE TWO NEW LABELS, XN & XVN -- "X" IS 00430600
|
|
% THE FILE ATTRIBUTE, E.G., ACCESS, AND "N" IS THE CORRESPONDING 00430650
|
|
% SWITCH LABEL NUMBER, E.G., THE 4 IN MFID4 -- AND ATTACH XN ONTO 00430675
|
|
% GETFILATT, AND ATTACH XVN ONTO THE SWITCH SETFILATT. THEN INSERT 00430700
|
|
% XN: AND ITS CODE BELOW THE LAST XN-TYPE CODE, AND INSERT XVN: AND 00430750
|
|
% ITS CODE BELOW THE LAST XVN-TYPE CODE. THE XN-TYPE CODE SETS THE 00430800
|
|
% FILE ATTRIBUTE (AFTER MUCH CHECKING TO ASSURE THAT THE FILE IS OF 00430850
|
|
% THE PROPER TYPE AND IN THE PROPER STATUS, AND THAT THE VALUE OF 00430900
|
|
% VAL IS WITHIN THE PROPER BOUNDS), AND THE XVN-TYPE CODE RETRIEVES 00430950
|
|
% AND STACKS THL FILE ATTRIBUTE. 00431000
|
|
00431050
|
|
ARRAY FIB=+1[*],FPB=3[*] ; 00431100
|
|
REAL FIB5=17,TYPE=9,FI=ERRL,SELECT=14,INTRINSIC=5, 00431110
|
|
OPEN=FIB+1, 00431111
|
|
NOTCLOSREL=OPEN+1, 00431112
|
|
NOTDISK=NOTCLOSREL+1, 00431113
|
|
RTNVAL=NOTDISK+1, 00431114
|
|
TEMP=RTNVAL+1, 00431115
|
|
PMET=TEMP+1, 00431116
|
|
FPB3=DUM1,VALSIGN=FIB, 00431135
|
|
MFIDX=OPEN,FIDX=NOTCLOSREL,REELX=NOTDISK,DATEX=FPB3, 00431140
|
|
CYCLEX=FIB5,TYPEX=TYPE ; 00431155
|
|
00431175
|
|
LABEL QUIT,EXIT,SETUSE,VALER,TOIT,BIG,CHK1,CHK2,CHK3L,CHK3T,MYUSERR,00431200
|
|
OPENERR,CLOSRELERR 00431225
|
|
,ACCESS0,ACCESSV0 00431250
|
|
,MYUSE1,MYUSEV1 00431260
|
|
,SAVE2,SAVEV2 00431270
|
|
,OTHERUSE3,OTHERUSEV3 00431280
|
|
,MFID4,MFIDV4 00431290
|
|
,FID5,FIDV5 00431300
|
|
,REEL6,REELV6 00431310
|
|
,DATE7,DATEV7 00431320
|
|
,CYCLE8,CYCLEV8 00431330
|
|
,TYPE9,TYPEV9 00431340
|
|
,AREAS10,AREASV10 00431350
|
|
,AREASIZE11,AREASIZEV11 00431360
|
|
,EUNUM12,EUNUMV12 % EU NUMBER FOR DISK 00431370
|
|
,DSKSPEED13,DSKSPEEDV13 % FAST/SLOW DISK (1-FAST) 00431380
|
|
,TIMELIMIT14,TIMELIMITV14 % WAIT TIME FOR LOCKED ADDRESS (RLL)00431390
|
|
,IOSTATUS15,IOSTATUSV15 % LAST IO RESULT STATUS (RLL) 00431400
|
|
,SENSITIVE14,SENSITIVEV14 % SENSITIVE 00431410
|
|
; %%%% ADD NEW ATTRIBUTE LABELS ON A NEW LINE ABOVE ****************00431490
|
|
%%%% AND BE SURE TO POST-FIX THE SWITCH NUMBER FOR DOCUMENTATION. 00431500
|
|
SWITCH SETFILATT := 00431550
|
|
ACCESS0 00431551
|
|
,MYUSE1 00431552
|
|
,SAVE2 00431553
|
|
,OTHERUSE3 00431554
|
|
,MFID4 00431555
|
|
,FID5 00431556
|
|
,REEL6 00431557
|
|
,DATE7 00431558
|
|
,CYCLE8 00431559
|
|
,TYPE9 00431560
|
|
,AREAS10 00431561
|
|
,AREASIZE11 00431562
|
|
,EUNUM12 00431563
|
|
,DSKSPEED13 00431564
|
|
,TIMELIMIT14 00431565
|
|
,IOSTATUS15 00431566
|
|
,SENSITIVE14 00431567
|
|
; %%%% ATTACH THE NEW XN-TYPE ATTRIBUTE LABEL ONTO SWITCH ABOVE ****00431850
|
|
SWITCH GETFILATT := 00431900
|
|
ACCESSV0 00431901
|
|
,MYUSEV1 00431902
|
|
,SAVEV2 00431903
|
|
,OTHERUSEV3 00431904
|
|
,MFIDV4 00431905
|
|
,FIDV5 00431906
|
|
,REELV6 00431907
|
|
,DATEV7 00431908
|
|
,CYCLEV8 00431909
|
|
,TYPEV9 00431910
|
|
,AREASV10 00431911
|
|
,AREASIZEV11 00431912
|
|
,EUNUMV12 00431913
|
|
,DSKSPEEDV13 00431914
|
|
,TIMELIMITV14 00431915
|
|
,IOSTATUSV15 00431916
|
|
,SENSITIVEV14 00431917
|
|
; %%%% ATTACH THE .EW XVN-TYPE ATTRIBUTE LABEL ONTO SWITCH ABOVE ***00432200
|
|
DEFINE CANTUSE = 0 #, 00432250
|
|
IO = 3 #, 00432259
|
|
SERIAL = 0 #, 00432262
|
|
RANDOM = 1 #, 00432265
|
|
UPDATE = 2 #, 00432268
|
|
PROTECT = 3 #, 00432269
|
|
DISK = (NOT NOTDISK) #, 00432271
|
|
HEADER[HEADER1] = P(HEADER1,14,.FIB,LOD,INX,LOD,INX,LOD) #, 00432274
|
|
FRM(ERM1) = BEGIN 00432276
|
|
INITERR; STREAM(FI); DS~13LIT ERM1; GO QUIT ; 00432277
|
|
END #, 00432278
|
|
CHKOPEN = BEGIN IF OPEN THEN GO OPENERR END #, 00432280
|
|
CHKCLOSREL = BEGIN IF NOTCLOSREL THEN GO CLOSRELERR END #, 00432285
|
|
CHKMYUSE = BEGIN IF FIB5.[11:2]=0 THEN GO MYUSERR END #, 00432290
|
|
P = POLISH #; 00432475
|
|
00432480
|
|
SUBROUTINE INITERR ; 00432500
|
|
BEGIN 00432550
|
|
PMET~P; FOR TEMP~P STEP -1 UNTIL 1 DO P(~); P(PMET) ; 00432560
|
|
P(TANK[NOT 4]); TANK[NOT 4]~0; P(MKS,9,INTRINSIC,DEL) ; 00432600
|
|
TEN~0; TEN~P([TEN[1]],CFX,SFB)&10[8:38:10] ; 00432700
|
|
STREAM(TEMP~NAM:A~[FPB[FPB3-3]],N~NAM.[6:6],TEN) ; 00432750
|
|
BEGIN DS~5LIT"-FAE,"; SI~A ; 00432800
|
|
2(SI~SI+1; A~SI; TALLY~0; 7(IF SC=" " THEN 00432850
|
|
JUMP OUT; SI~SI+1; TALLY~TALLY+1); SI~A; A~TALLY ; 00432900
|
|
DS~A CHR; DS~0DEC; DS~LIT"/"); DI~DI-1; DS~LIT" " ; 00432950
|
|
SI~LOC TEMP; SI~SI+2; DS~N CHR; DS~2LIT", "; TEMP~DI ;00432975
|
|
DI~DI+13; DS~2LIT":~" ; 00432980
|
|
END STREAM ; 00433100
|
|
FI~P ; 00433150
|
|
END OF INITERR ; 00433200
|
|
00433220
|
|
REAL SUBROUTINE OCTTODEC ; 00433230
|
|
BEGIN 00433240
|
|
STREAM(Q~0:VAL); BEGIN SI~LOC VAL; DI~LOC Q; DS~8DEC END ; 00433250
|
|
OCTTODEC~P ; 00433260
|
|
END OF OCTTODEC ; 00433270
|
|
00433275
|
|
REAL SUBROUTINE DECTOOCT ; 00433280
|
|
BEGIN PMET~P(XCH) ; 00433290
|
|
STREAM(Q~0:PMET); BEGIN SI~LOC PMET; DI~LOC Q; DS~8OCT END ; 00433295
|
|
DECTOOCT~P ; 00433300
|
|
END OF DECTOOCT ; 00433310
|
|
00433325
|
|
SUBROUTINE INITIALIZE ; 00433650
|
|
BEGIN % INITIALIZES A FEW USEFUL VARIABLES. 00433660
|
|
NOTDISK~NOT((NOTDISK~(TYPE~FPB[FPB3~FIB[4].[13:11]+3] AND 63) 00433670
|
|
AND 31)=10 OR NOTDISK=12 OR NOTDISK=13 OR 00433675
|
|
NOTDISK=26) ; 00433677
|
|
NOTCLOSREL~NOT(OPEN~(FIB5~FIB[5]).[41:2]) ; 00433680
|
|
OPEN~OPEN=0 ; 00433685
|
|
END OF INITIALIZE ; 00433690
|
|
00433725
|
|
SUBROUTINE SCATTERFPB ; 00433750
|
|
STREAM(F~[FPB[FPB3-3]],D~[DATEX],C~[CYCLEX],M~[MFIDX]) ; 00433760
|
|
BEGIN 00433775
|
|
SI~F; 2(DS~LIT"0"; SI~SI+1; DS~7CHR); DS~3OCT ; 00433780
|
|
DI~D; DS~5OCT; DI~C; DS~2OCT ; 00433785
|
|
END OF SCATTERFPB ; 00433790
|
|
00435445
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00435446
|
|
%%% 00435447
|
|
%%% ******* F I R S T E X E C U T A B L E C O D E ********00435448
|
|
%%% 00435449
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00435450
|
|
00435460
|
|
P(TANK[NOT 2],0,0,0,0,0,0); TANK[NOT 4]~ERRL; INITIALIZE ; 00435480
|
|
IF (FI~INFO AND 255)>3 AND FI<10 THEN SCATTERFPB ; 00435550
|
|
IF NAM}0 THEN IF ABS(VAL)>@7777777777777 THEN GO VALER ELSE VAL~VAL;00435600
|
|
IF INFO.[39:1] THEN IF INFO~INFO.[38:1] THEN RTNVAL~VAL 00435750
|
|
ELSE BEGIN TANK[NOT 4]~0; GO GETFILATT[FI] END 00435800
|
|
ELSE INFO~FALSE ; 00435825
|
|
GO SETFILATT[FI] ; 00435850
|
|
MYUSERR:: ERM("MYUSE=CANTUSE") ; 00435855
|
|
CLOSRELERR:: ERM("NOT CLOSRELES") ; 00435860
|
|
OPENERR:: INITERR; STREAM(FI); DS~13LIT"NOT RWND/CLSD" ; 00435870
|
|
QUIT:: P([TEN[0]].[33:15],34,COM) ; 00435900
|
|
00435980
|
|
ACCESS0: IF ((FI~TYPE AND 31)=12 AND VAL=SERIAL) 00436000
|
|
OR (FI=10 AND VAL=RANDOM) OR (FI=13 AND VAL=UPDATE) 00436025
|
|
$ SET OMIT = NOT SHAREDISK 00436049
|
|
THEN GO EXIT; 00436075
|
|
P(FPB[FPB3],[FPB[FPB3]],FIB[4],[FIB[4]],FIB[13],[FIB[13]],00436080
|
|
3) ; 00436085
|
|
FPB[FPB3].[43:5]~FI~IF VAL=0 THEN 12 ELSE IF VAL=1 THEN 1000436180
|
|
$ SET OMIT = NOT SHAREDISK 00436184
|
|
ELSE 13 ; 00436190
|
|
$ SET OMIT = SHAREDISK 00436194
|
|
IF FIB[4].[27:3]!3 THEN FIB[4].[27:3]~VAL ; 00436195
|
|
FIB[13].[39:5]~FI; P(UPDATE); GO CHK3T ; 00436200
|
|
$ POP OMIT 00436201
|
|
$ SET OMIT = NOT SHAREDISK 00436209
|
|
00436225
|
|
MYUSE1: IF FIB5.[11:2]=VAL THEN GO EXIT ; 00436250
|
|
IF P([FIB[14]],LOD).[FF]=2 THEN P(MKS,"CHNGNG",TANK,7, 00436260
|
|
SELECT); 00436270
|
|
FIB[5].[11:2]~FI~VAL; TEMP~FIB5.[9:2]; P(1); GO SETUSE;00436330
|
|
00436350
|
|
SAVE2: IF FIB[4].[30:18]=PMET~OCTTODEC THEN GO EXIT ; 00436400
|
|
P(FIB[4],[FIB[4]],1) ; 00436410
|
|
FIB[4].[30:18]~PMET; P(999); GO CHK2 ; 00436520
|
|
00436550
|
|
OTHERUSE3: IF FIB5.[9:2]=VAL THEN GO EXIT ; 00436600
|
|
FI~FIB5.[11:2]; FIB[5].[9:2]~TEMP~VAL; P(0) ; 00436660
|
|
SETUSE: PMET~P; P(FIB5,[FIB[5]],1) ; 00436670
|
|
IF DISK THEN IF HEADER[4] THEN CHKCLOSREL ELSE CHKOPEN ; 00436675
|
|
FIB[5].[13:3]~IF FI=0 THEN 7 ELSE IF TEMP=0 THEN 4 ELSE 00436680
|
|
IF TEMP=1 THEN IF FI=1 THEN 3 ELSE 2 ELSE IF00436685
|
|
FI=1 THEN 1 ELSE 0 ; 00436690
|
|
P(IO); IF NOT PMET THEN GO CHK2; GO CHK1 ; 00436710
|
|
00436725
|
|
MFID4: P(.MFIDX,0,MFIDX); GO TOIT ; 00436750
|
|
00436775
|
|
FID5: P(.FIDX,0,FIDX); GO TOIT ; 00436800
|
|
00436825
|
|
REEL6: P(.REELX,VAL>999,REELX); GO TOIT ; 00436850
|
|
00436875
|
|
DATE7: P(.DATEX,VAL DIV 1000>99 OR VAL MOD 1000>366,DATEX) ; 00436900
|
|
GO TOIT ; 00436905
|
|
00436925
|
|
CYCLE8: P(.CYCLEX,VAL>99,CYCLEX); GO TOIT ; 00436950
|
|
00436975
|
|
TYPE9: P(.TYPEX,VAL>63 OR(VAL AND 31)=3 OR(VAL AND 31)>26,TYPEX);00437010
|
|
TOIT: IF P=VAL THEN BEGIN P(DEL,DEL); GO EXIT END ; 00437030
|
|
INITIALIZE; P(0); CHKMYUSE; CHKOPEN ; 00437040
|
|
IF FIB[4].[24:2]!1 OR FIB[4].[8:4]!2 THEN CHKCLOSREL 00437070
|
|
ELSE IF FI=4 OR FI=9 THEN ERM("CLS*,NOT ALTR") ; 00437090
|
|
IF P(XCH) OR VAL.[1:5]!0 THEN GO VALER; SCATTERFPB ; 00437105
|
|
P(DEL,VAL,XCH,~,MKS,TANK,MFIDX,FIDX,REELX,DATEX,CYCLEX, 00437110
|
|
TYPEX,11,INTRINSIC) ; 00437125
|
|
GO EXIT ; 00437130
|
|
00437150
|
|
AREAS10: IF NOTDISK OR VAL=FIB[8].[20:5] THEN GO EXIT ; 00437200
|
|
P(FIB[8],[FIB[8]],1) ; 00437210
|
|
FIB[8].[20:5]~VAL; P(20); GO CHK3L ; 00437240
|
|
00437275
|
|
AREASIZE11: IF NOTDISK OR VAL=FIB[8].[25:23] THEN GO EXIT ; 00437300
|
|
P(FIB[8],[FIB[8]],1) ; 00437310
|
|
FIB[8].[25:23]~VAL; P(BIG) ; 00437340
|
|
CHK3L:: PMET~P; CHKCLOSREL; P(PMET); GO CHK2 ; 00437350
|
|
CHK3T:: PMET~P; CHKOPEN; P(PMET) ; 00437360
|
|
CHK2:: PMET~P; CHKMYUSE; P(PMET) ; 00437370
|
|
CHK1:: IF P}VAL AND NOT VAL.[1:1] THEN GO EXIT ; 00437380
|
|
VALER:: NOTDISK~ABS(VAL) ; 00437400
|
|
OPEN~0; WHILE TEN[OPEN~OPEN+1]{NOTDISK DO; INITERR ; 00437410
|
|
STREAM(N~OPEN,V~NOTDISK,T~TYPE,L~VALSIGN~VAL.[1:1],Q~NAM<000437440
|
|
,R~(OPEN+VALSIGN)>8,E~1+(TYPE>9),W~VAL,FI) ; 00437450
|
|
BEGIN 00437470
|
|
DI~DI-2; DS~2LIT":=" ; 00437480
|
|
Q(SI~LOC W; DS~8CHR; JUMP OUT TO J); L(DS~LIT"-") ; 00437490
|
|
R(DS~7LIT"*"; JUMP OUT TO J); SI~LOC V; DS~N DEC ; 00437500
|
|
J: SI~LOC T; DS~3LIT",T="; DS~E DEC; DS~2LIT":~" ; 00437510
|
|
END OF STREAM ; 00437520
|
|
GO QUIT ; 00437530
|
|
00437550
|
|
EUNUM12: IF NOTDISK OR OPEN OR FPB[FPB3].[18:5]=VAL+1 THEN GO EXIT;00437560
|
|
P(FPB[FPB3],[FPB[FPB3]],1); % STORE FOR RECOVERY 00437570
|
|
FPB[FPB3].[18:5]:=VAL+1; % EU NO.+1 00437580
|
|
IF VAL=(-1) THEN VAL:=1; P(19); GO TO CHK2; 00437590
|
|
00437600
|
|
DSKSPEED13: IF NOTDISK OR OPEN OR FPB[FPB3].[16:2]=VAL THEN GO EXIT; 00437610
|
|
P(FPB[FPB3],[FPB[FPB3]],1); % STORE VALUES FOR RECOVERY 00437620
|
|
FPB[FPB3].[16:2]:=VAL; % 1=FAST,2=SLOW 00437630
|
|
P(2); GO CHK2; 00437640
|
|
00437650
|
|
TIMELIMIT14: 00437700
|
|
$ SET OMIT = NOT SHAREDISK 00437710
|
|
00437760
|
|
IOSTATUS15: GO EXIT; 00437770
|
|
00437780
|
|
SENSITIVE14: IF NOTDISK OR FPB[FPB3].[15:1]=VAL THEN GO EXIT; 00437800
|
|
P(FPB[FPB3],[FPB[FPB3]],1); % STORE FOR RECOVERY 00437810
|
|
FPB[FPB3].[15:1]:=VAL; %SENSITIVE=1 00437820
|
|
P(1); GO CHK1; 00437830
|
|
BIG::: @37777777 ; 00440000
|
|
00449999
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00450000
|
|
%%%%% INSERT NEW XN-TYPE ATTRIBUTE CODE ON NEW LINES ABOVE HERE %%%%00450050
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00450100
|
|
00450150
|
|
00450200
|
|
ACCESSV0: P(IF (FI~TYPE AND 31)=10 THEN 1 ELSE IF FI=13 THEN 2 00450250
|
|
$ SET OMIT = NOT SHAREDISK 00450254
|
|
ELSE 0,RTN); 00450260
|
|
00450300
|
|
MYUSEV1: P(FIB5.[11:2],RTN) ; 00450400
|
|
00450450
|
|
SAVEV2: P(FIB[4].[30:18],DECTOOCT,RTN) ; 00450500
|
|
00450550
|
|
OTHERUSEV3: P(FIB5.[9:2],RTN) ; 00450600
|
|
00450625
|
|
MFIDV4: P(MFIDX,RTN) ; 00450650
|
|
00450675
|
|
FIDV5: P(FIDX,RTN) ; 00450700
|
|
00450725
|
|
REELV6: P(REELX,RTN) ; 00450750
|
|
00450775
|
|
DATEV7: P(DATEX,RTN) ; 00450800
|
|
00450825
|
|
CYCLEV8: P(CYCLEX,RTN) ; 00450850
|
|
00450875
|
|
TYPEV9: P(TYPEX,RTN) ; 00450900
|
|
00450925
|
|
AREASV10: IF FIB[8].[20:28] = 0 AND FIB[4].[8:4] = 4 AND OPEN 00450950
|
|
THEN P(HEADER[9].[43:5],RTN) 00450951
|
|
ELSE P(FIB[8].[20:5],RTN); 00450952
|
|
00450975
|
|
AREASIZEV11: 00451000
|
|
IF FIB[8].[20:28] = 0 AND FIB[4].[8:4] = 4 AND OPEN 00451001
|
|
THEN P(HEADER[8].[25:23],RTN) 00451002
|
|
ELSE P(FIB[8].[25:23],RTN); 00451003
|
|
EUNUMV12: P(FPB[FPB3].[18:5]-1,RTN); 00451025
|
|
DSKSPEEDV13: P((IF (TEMP:=FPB[FPB3].[16:2])=1 THEN 1 ELSE 00451050
|
|
IF TEMP=2 THEN 2 ELSE 0),RTN); 00451055
|
|
TIMELIMITV14: 00451075
|
|
$ SET OMIT = NOT SHAREDISK 00451099
|
|
P(0); P(RTN); 00451150
|
|
IOSTATUSV15: 00451175
|
|
$ SET OMIT = NOT SHAREDISK 00451199
|
|
P(0); P(RTN); 00451250
|
|
SENSITIVEV14: P(FPB[FPB3].[15:1],RTN); 00451300
|
|
00469999
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00470000
|
|
%%%% INSERT NEW XVN-TYPE ATTRIBUTE CODE ON NEW LINES ABOVE HERE %%%%00470050
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00470100
|
|
00470150
|
|
00470200
|
|
EXIT: TANK[NOT 4]~0; IF INFO THEN P(RTNVAL,RTN) ; 00470250
|
|
END OF FILEATTRIBUTES ; 00470350
|
|
PROCEDURE ALGOLREAD(TEN, FILX, DKADD, ACT, FI, AEXP, %WF 00500000
|
|
ARRY, EOFL, PARL, DKADR, CODE, TANK); %WF 00500100
|
|
VALUE FI, DKADR, TANK, CODE, ACT, AEXP; %WF 00500200
|
|
ARRAY ARRY[*], TEN[*]; %WF 00500300
|
|
INTEGER ACT, FI, AEXP; %WF 00500400
|
|
REAL DKADD, PARL, EOFL, CODE, DKADR; %WF 00500500
|
|
NAME FILX, TANK; %WF 00500600
|
|
BEGIN REAL RCW=+0,BLKCNTL=5,SELECT=14;% 00500700
|
|
NAME MEM=2;% 00500800
|
|
ARRAY FPB=3[*];% 00500900
|
|
REAL ALGOLREAD=13; %WF 00501000
|
|
ARRAY TINK=TANK[*]; %WF 00501100
|
|
INTEGER RSIZE=FI; %WF 00501200
|
|
DEFINE FNUM = FIB[4].[13:11] #; 00501250
|
|
DEFINE IOD=(*TANK)#;% 00501300
|
|
$ SET OMIT = NOT SHAREDISK 00501309
|
|
LABEL DC1,DC2; 00501400
|
|
LABEL DCN1,DCN2,SPIN; 00501410
|
|
LABEL CR1,MT1,CLOSED,DK1,SP1,PR1,ERR;% 00501500
|
|
SWITCH SW1~ CR1,ERR,MT1,CLOSED,DK1,SP1,ERR,ERR,ERR,PR1,DC1,CR1, 00501600
|
|
ERR,DCN1; 00501610
|
|
LABEL CR2,MT2,DK2,SP2,PR2;% 00501700
|
|
SWITCH SW2~ CR2,ERR,MT2,ERR,DK2,SP2,ERR,ERR,ERR,PR2,DC2,CR2, 00501800
|
|
ERR,DCN2; 00501810
|
|
LABEL SW,PBIT,DS,FIB7,DSPBIT,PAR,DSRTN,DS19,RA1,EOF,D28;% 00501900
|
|
LABEL EMPTY,FULL,SEMPTY,SFULL; 00501950
|
|
REAL UNITYPE,REV,ADDRESS,BLKODE;% 00502000
|
|
$ SET OMIT = NOT SHAREDISK 00502049
|
|
LABEL DKS,DKR,DKR1,DKU; 00502100
|
|
SWITCH ASW~DKS,DKR,DKU,CLOSED; 00502200
|
|
$ SET OMIT = NOT(TIMESHARING) 00502250
|
|
SUBROUTINE WAIT; POLISH(TANK, @2000000000, 36, COM, DEL, DEL); 00502252
|
|
$ POP OMIT 00502253
|
|
$ SET OMIT = TIMESHARING 00502299
|
|
LABEL RU,RA,RC;% 00502400
|
|
SWITCH RTYPE~RU,RA,ERR,RC;% 00502500
|
|
LABEL DKSR,DKRR,DKUR;% 00502600
|
|
SWITCH ASWR~DKSR,DKRR,DKUR;% 00502700
|
|
ARRAY FIB[*],HEADER[*];% 00502800
|
|
$ SET OMIT = NOT SHAREDISK 00502809
|
|
INTEGER I;% 00502900
|
|
REAL SUBROUTINE DISKADDRESS;% 00503000
|
|
BEGIN IF DKADR}0 THEN% 00503100
|
|
BEGIN ADDRESS~(DKADR DIV HEADER[0].[30:12])|HEADER[0].[42:6];% 00503200
|
|
IF (I~ADDRESS DIV HEADER[1]+10)}30 THEN P(0) ELSE 00503300
|
|
IF HEADER[I]=0 THEN P(0) ELSE 00503400
|
|
BEGIN ADDRESS~HEADER[I]+I~ADDRESS MOD HEADER[1];% 00503500
|
|
STREAM(D~[ADDRESS]); BEGIN SI~D; DS~8 DEC END;% 00503600
|
|
P(1);% 00503700
|
|
END END ELSE P(0);% 00503800
|
|
DISKADDRESS~P;% 00503900
|
|
END DISKADDRESS;% 00504000
|
|
$ SET OMIT = NOT SHAREDISK 00504009
|
|
IF TINK=0 THEN %WF 00504200
|
|
BEGIN FIB ~ FILX[NOT 2]; %WF 00504300
|
|
FILX[NOT 4] ~ EOFL; FILX[NOT 3] ~ PARL; %WF 00504400
|
|
IF NOT FIB[5].[12:1] THEN P(MKS,"READNG",FILX,7,SELECT) ; 00504450
|
|
IF FIB[5].[43:2]!((ACT<0)+2) THEN %WF 00504500
|
|
P(MKS, DKADD, (ACT<0)+2, FILX, 1, SELECT); %WF 00504600
|
|
RSIZE~P(MKS,(ABS(ACT)=3),DKADD,1,FILX,ALGOLREAD); 00504700
|
|
IF ARRY!0 THEN %WF 00504800
|
|
BEGIN IF ARRY.[8:10]>P(DUP, AEXP) %WF 00504900
|
|
THEN P(DEL, AEXP); %WF 00505000
|
|
IF P(DUP)}RSIZE THEN P(DEL) ELSE RSIZE ~ P; %WF 00505100
|
|
STREAM(P4 ~ *FILX, P3 ~ RSIZE, %WF 00505200
|
|
P2 ~ P(DUP).[36:6], P1 ~ [ARRY[0]]); %WF 00505300
|
|
BEGIN SI ~ P4; DS ~ P3 WDS; %WF 00505400
|
|
P2(DS ~ 32 WDS; DS ~ 32 WDS); %WF 00505500
|
|
END; %WF 00505600
|
|
END; %WF 00505700
|
|
IF ABS(ACT)}2 THEN% 00505800
|
|
P(MKS, DKADD, 0, FILX, ALGOLREAD); %WF 00505900
|
|
FILX[NOT 4] ~ FILX[NOT 3] ~ 0; %WF 00506000
|
|
P(XIT); %WF 00506100
|
|
END; %WF 00506200
|
|
FIB~TANK[NOT 2];% 00506300
|
|
SW: UNITYPE~FIB[4].[8:4]; REV~FIB[5].[44:1]; BLKODE~FIB[5].[46:2];% 00506400
|
|
$ SET OMIT = TIMESHARING 00506440
|
|
IF DKADR.[4:1] THEN 00506460
|
|
BEGIN 00506465
|
|
$ SET OMIT = NOT SHAREDISK 00506469
|
|
DKADR.[3:2]~0; 00506475
|
|
END; 00506480
|
|
IF CODE THEN GO TO SW1[UNITYPE]; GO TO SW2[UNITYPE];% 00506500
|
|
MT1:% 00506600
|
|
CR1:% 00506700
|
|
PR1: IF IOD.[19:1] THEN% 00506800
|
|
PBIT: BEGIN IF IOD.[2:1] THEN% 00506900
|
|
BEGIN IF FIB[17]=0 THEN FIB[17]~*((IF REV THEN 1 ELSE NOT 0)00507000
|
|
INX FLAG(FIB[16]));% 00507100
|
|
P((IF BLKODE THEN IOD.[8:10] ELSE FIB[17]),RTN);% 00507200
|
|
END;% 00507300
|
|
IF IOD.[25:1] THEN% 00507400
|
|
CLOSED: BEGIN 00507410
|
|
FIB[13].[27:1]~1; 00507420
|
|
IF (REV~(FPB[FNUM+3] AND 31))!10 AND REV!12 00507430
|
|
AND REV!13 AND REV!26 THEN FIB[5].[45:1]~0 ELSE 00507440
|
|
FIB[5].[45:1]~P(TANK[NOT 3],DUP)!0 AND P(XCH)!15; 00507450
|
|
P(TANK,0,11,COM,DEL,DEL) ; 00507510
|
|
IF NOT FIB[5].[45:1] THEN GO SW ; 00507515
|
|
P(TANK[NOT 3]); TANK[NOT 3]~TANK[NOT 4]~0 ; 00507520
|
|
P(MKS,9,BLKCNTRL,DEL) ;% TAKE PARITY ACTION LBL BRNCH. 00507525
|
|
CODE~1; GO TO DS; 00507530
|
|
END ; 00507535
|
|
IF IOD.[27:1] THEN% 00507600
|
|
BEGIN IF UNITYPE=2 THEN% 00507700
|
|
IF FIB[4].[2:1] THEN% 00507800
|
|
P(MKS,1,0,(NOT 2)INX TANK,4,SELECT) ELSE% 00507900
|
|
BEGIN P(TANK,11,11,COM,DEL,DEL);% 00508000
|
|
IF MEM[TANK[NOT 1] INX 4].[42:6]=1 THEN% 00508100
|
|
BEGIN UNITYPE~FIB[13].[28:10];% 00508200
|
|
P(MKS,6,0,(NOT 2)INX TANK,4,SELECT);% 00508300
|
|
FIB[13].[28:10]~UNITYPE+1;% 00508400
|
|
GO TO CLOSED;% 00508500
|
|
END END;% 00508600
|
|
EOF: IF CODE = 3 THEN P(1,SSN,RTN); CODE ~ 2; 00508700
|
|
END ELSE PAR: TANK[0]~IOD OR MEM;% 00508800
|
|
IF CODE =-3 THEN BEGIN P(0,[TANK[NOT 2]],19,17,COM); 00508900
|
|
P(0,RTN); END; 00509000
|
|
P(TANK[NOT(CODE+2)]); 00509400
|
|
TANK[NOT 4]~TANK[NOT 3]~0; 00509500
|
|
P(MKS,9,BLKCNTL); 00509600
|
|
DS: P(TANK,CODE,11,COM);% 00509700
|
|
END;% 00509800
|
|
P(TANK); WAIT; GO TO PBIT;% 00509900
|
|
ERR: CODE~3; GO DS;% 00510000
|
|
DK1: HEADER~*[FIB[14]]; GO TO ASW[FIB[4].[27:3]];% 00510100
|
|
DK2: HEADER~*[FIB[14]]; GO TO ASWR[FIB[4].[27:3]];% 00510200
|
|
CR2:% 00510300
|
|
MT2:% 00510400
|
|
PR2: GO TO RTYPE[BLKODE];% 00510500
|
|
RU: TANK[0]~FLAG(FIB[16]); P(FLAG(FIB[19]),TANK,PRL,DEL);% 00510600
|
|
BLKODE~FIB[19].[33:15]-FIB[16].[33:15];% 00510700
|
|
FIB[16].[33:15]~ CODE~(*((IF REV THEN 2 ELSE NOT 1) INX% 00510800
|
|
FLAG(FIB[16]))).[18:15];% 00510900
|
|
FIB[19].[33:15]~CODE+BLKODE;% 00511000
|
|
FIB[6]~(REV~1&REV[1:47:1])+FIB[6];% 00511100
|
|
FIB[7]~FIB[7]+REV; FIB[17]~0; P(XIT);% 00511200
|
|
RA: IF (FIB[17]~FIB[17]-CODE~FIB[18].[33:15])<CODE THEN GO TO RU;% 00511300
|
|
RA1: TANK[0]~(IF REV THEN NOT CODE INX 1 ELSE CODE) INX IOD;% 00511400
|
|
GO TO FIB7;% 00511500
|
|
RC: IF (FIB[17]~FIB[17]-CODE~IOD.[8:10]+1){1 THEN GO TO RU;% 00511600
|
|
IF REV THEN% 00511700
|
|
BEGIN;STREAM(S~IOD,D~[CODE]);% 00511800
|
|
BEGIN SI~S; SI~SI-8; DS~4 OCT END;% 00511900
|
|
TANK[0]~(NOT(CODE~CODE DIV 8 -1) INX IOD)&CODE[8:38:10];% 00512000
|
|
END ELSE% 00512100
|
|
BEGIN;STREAM(S~(TANK[0]~CODE INX IOD),D~[CODE]);% 00512200
|
|
BEGIN SI~S; SI~SI-4; DS~4 OCT END;% 00512300
|
|
TANK[0]~IOD&(CODE DIV 8 -1)[8:38:10];% 00512400
|
|
END;% 00512500
|
|
FIB7: FIB[7]~1&REV[1:47:1]+FIB[7];% 00512600
|
|
D28: TANK[0]~IOD&(NOT P(DUP))[2:28:1];% 00512700
|
|
SP2: P(XIT);% 00512800
|
|
DKU:% 00512900
|
|
DKS: IF DKADR=0 THEN % NORMAL SEQUENTIAL READ--NO ADDRESS SPECIFIED.% 00513000
|
|
DS19: IF IOD.[19:1] THEN% 00513100
|
|
DSPBIT: IF IOD.[2:1] THEN% 00513200
|
|
IF FIB[7]>HEADER[7] THEN% 00513300
|
|
BEGIN TANK[0]~IOD&0[2:2:1]&1[27:47:1];% 00513400
|
|
GO TO EOF;% 00513500
|
|
END ELSE% 00513600
|
|
DSRTN: BEGIN IF FIB[17]=0 THEN FIB[17]~FIB[18].[18:15];% 00513700
|
|
P(FIB[18].[33:15],RTN);% 00513800
|
|
END ELSE% 00513900
|
|
IF IOD.[25:1] THEN GO TO CLOSED ELSE% 00514000
|
|
IF IOD.[27:1] THEN GO TO EOF ELSE GO TO PAR ELSE% 00514100
|
|
BEGIN P(TANK); WAIT; GO TO DSPBIT END;% 00514200
|
|
% READ OR SEEK ON A SERIAL FILE WITH ADDRESS SPECIFIED.% 00514300
|
|
P(MKS,ABS(DKADR)-1,1,TANK,1,SELECT);% 00514400
|
|
IF DKADR<0 THEN GO TO DSRTN; GO TO DS19;% 00514500
|
|
DKSR: IF DKADR>0 THEN GO TO D28 ELSE IF DKADR=0 THEN% 00514600
|
|
BEGIN IF (FIB[17]~FIB[17]-CODE~FIB[18].[33:15])}CODE THEN GO RA1; 00514700
|
|
FIB[6]~(REV~1&REV[1:47:1])+FIB[6];% 00514800
|
|
FIB[17]~0;% 00514900
|
|
DKADR~FIB[7]% 00515000
|
|
+FIB[13].[10:9]|HEADER[0].[30:12]|REV;% 00515100
|
|
FIB[7]~FIB[7]+REV;% 00515200
|
|
IF DISKADDRESS THEN% 00515300
|
|
BEGIN P(TANK[0]~FLAG(FIB[16]),ADDRESS,XCH,~);% 00515400
|
|
P(FLAG(FIB[19]),TANK,PRL,DEL);% 00515500
|
|
END ELSE% 00515600
|
|
BEGIN TANK[0]~FLAG(FIB[16])&2[27:46:2]&0[2:47:1];% 00515700
|
|
P(FIB[13].[10:9],TANK,13,11,COM,DEL,DEL,DEL);% 00515800
|
|
END;% 00515900
|
|
BLKODE~FIB[19].[33:15]-FIB[16].[33:15];% 00516000
|
|
FIB[16].[33:15]~CODE~MEM[P(DUP) INX NOT 1].[18:15];% 00516100
|
|
FIB[19].[33:15]~CODE+BLKODE;% 00516200
|
|
END;% 00516300
|
|
DKRR: P(XIT);% 00516400
|
|
DKR: 00516410
|
|
$ SET OMIT = NOT SHAREDISK 00516419
|
|
DKR1: IF DKADR GEQ 0 THEN 00516500
|
|
BEGIN IF DKADR=0 THEN DKADR~FIB[7] ELSE FIB[7]~DKADR~DKADR-1;% 00516600
|
|
IF HEADER[7]}DKADR THEN% 00516700
|
|
IF DISKADDRESS THEN% 00516800
|
|
BEGIN CODE~FIB[16].[33:15]; UNITYPE~FIB[13].[10:9];% 00516900
|
|
FOR I~0 STEP 1 UNTIL UNITYPE DO% 00517000
|
|
$ SET OMIT = SHAREDISK 00517099
|
|
BEGIN IF NOT IOD.[19:1] THEN BEGIN P(TANK); WAIT END; 00517100
|
|
$ POP OMIT 00517101
|
|
$ SET OMIT = NOT SHAREDISK 00517109
|
|
IF IOD.[27:1] THEN GO TO EMPTY;% 00517200
|
|
$ SET OMIT = SHAREDISK 00517299
|
|
IF (MEM[CODE] EQV ADDRESS)=NOT 0 THEN GO FULL; 00517300
|
|
$ POP OMIT 00517301
|
|
$ SET OMIT = NOT SHAREDISK 00517309
|
|
TANK[0]~IOD&1[27:47:1];% 00517400
|
|
P(UNITYPE,TANK,13,11,COM,DEL,DEL,DEL);% 00517500
|
|
FIB[16].[33:15]~CODE~MEM[CODE-2].[18:15];% 00517600
|
|
FIB[19].[33:15]~CODE+1;% 00517700
|
|
END; GO TO ERR;% 00517800
|
|
EMPTY: 00517900
|
|
$ SET OMIT = NOT SHAREDISK 00517909
|
|
FIB[13].[10:9]~1; 00517980
|
|
P(TANK[0]~FLAG(FIB[16]),ADDRESS,XCH,~);% 00518000
|
|
P(FLAG(FIB[19]),TANK,PRL,DEL);% 00518100
|
|
FIB[13].[10:9]~UNITYPE; P(TANK); 00518200
|
|
$ SET OMIT = NOT SHAREDISK 00518299
|
|
WAIT; 00518350
|
|
FULL: IF NOT IOD.[2:1] OR FIB[5].[1:1] THEN 00518400
|
|
BEGIN 00518500
|
|
$ SET OMIT = NOT SHAREDISK 00518509
|
|
CODE~1; GO TO PAR; 00518550
|
|
END; 00518560
|
|
$ SET OMIT = NOT SHAREDISK 00518569
|
|
IF BLKODE=0 THEN SFULL:P(FIB[18].[33:15],RTN); 00518600
|
|
TANK[0]~IOD&((I~DKADR MOD HEADER[0].[30:12])% 00518700
|
|
|(I~FIB[18].[33:15])+FIB[19].[33:15])[33:33:15];% 00518800
|
|
P(I,RTN);% 00518900
|
|
END;% 00519000
|
|
IF NOT FIB[5].[1:1] THEN 00519100
|
|
BEGIN 00519110
|
|
$ SET OMIT = NOT SHAREDISK 00519119
|
|
GO TO EOF; 00519130
|
|
END; 00519140
|
|
$ SET OMIT = NOT SHAREDISK 00519149
|
|
CODE~1; GO TO PAR; 00519160
|
|
END;% 00519200
|
|
DKADR~ABS(DKADR)-1;% 00519300
|
|
IF HEADER[7]<DKADR THEN GO TO SFULL;% 00519400
|
|
IF NOT DISKADDRESS THEN GO TO SFULL;% 00519500
|
|
CODE~FIB[16].[33:15]; UNITYPE~FIB[13].[10:9]-1;% 00519600
|
|
FOR I~0 STEP 1 UNTIL UNITYPE DO% 00519700
|
|
$ SET OMIT = SHAREDISK 00519799
|
|
BEGIN IF NOT TANK[I].[19:1] THEN BEGIN P([TANK[I]]); WAIT END;% 00519800
|
|
$ POP OMIT 00519801
|
|
$ SET OMIT = NOT SHAREDISK 00519809
|
|
IF TANK[I].[27:1] THEN GO TO SEMPTY;% 00519900
|
|
$ SET OMIT = SHAREDISK 00519999
|
|
IF (MEM[CODE] EQV ADDRESS)=NOT 0 THEN GO TO SFULL; 00520000
|
|
$ POP OMIT 00520001
|
|
$ SET OMIT = NOT SHAREDISK 00520009
|
|
CODE~MEM[CODE-2].[18:15];% 00520100
|
|
END;% 00520200
|
|
$ SET OMIT = NOT SHAREDISK 00520209
|
|
$ SET OMIT = SHAREDISK 00520299
|
|
P(TANK[0]~FLAG(FIB[16]),ADDRESS,XCH,~);% 00520300
|
|
$ POP OMIT 00520301
|
|
P(FLAG(FIB[19]),TANK,PRL,DEL);% 00520400
|
|
FIB[16].[33:15]~CODE~MEM[CODE-2].[18:15];% 00520500
|
|
FIB[19].[33:15]~CODE+1;% 00520600
|
|
GO TO SFULL;% 00520700
|
|
SEMPTY: 00520710
|
|
$ SET OMIT = NOT SHAREDISK 00520719
|
|
$ SET OMIT = SHAREDISK 00520799
|
|
P(TANK[I]~FLAG(FIB[16])&CODE[33:33:15],ADDRESS,XCH,~); 00520800
|
|
$ POP OMIT 00520801
|
|
FIB[13].[10:9]~1;% 00520900
|
|
P(FLAG(FIB[19])&(CODE+1)[33:33:15],[TANK[I]],PRL,DEL);% 00521000
|
|
FIB[13].[10:9]~UNITYPE+1;% 00521100
|
|
GO TO SFULL;% 00521200
|
|
SP1:: STREAM(D~IOD); BEGIN DS~7 LIT "ACCEPT~" END;% 00521300
|
|
IF FPB[FNUM+3].[42:6]=43 THEN GO EOF; %DUMMY 00521310
|
|
P((NOT 1) INX IOD,16,COM,DEL); GO TO SFULL;% 00521400
|
|
% 00521500
|
|
DKUR: FIB[5].[43:2]~0;% 00521600
|
|
% 00521700
|
|
P(XIT); 00521800
|
|
$ SET OMIT = NOT(TIMESHARING) 00521810
|
|
DC1:: P(FIB[18].[33:15] & DKADR[1:47:1] & 00521813
|
|
(DKADR.[2:1] AND (DKADR.[FF]=0) AND (TANK[NOT 3]!0))[32:47:1], 00521814
|
|
IOD,1,(-13),COM); 00521815
|
|
I:=POLISH; 00521816
|
|
ADDRESS:=TANK[NOT(4-(I=2))]; 00521817
|
|
TANK[NOT 4]:=TANK[NOT 3]:=0; 00521818
|
|
IF I THEN P(FIB[18].[33:15],RTN); 00521819
|
|
IF ADDRESS NEQ 0 THEN 00521820
|
|
P(ADDRESS,MKS,9,BLKCNTRL); 00521821
|
|
ADDRESS:=(I=0)+1; 00521822
|
|
P(TANK,ADDRESS,11,COM); 00521823
|
|
DC2:: P(XIT); 00521824
|
|
DCN1: DCN2: SPIN: 00521825
|
|
$ SET OMIT = TIMESHARING 00521830
|
|
END ALGOLREAD; 00524700
|
|
PROCEDURE INPUTINT(TEN,FILX,DKADR,ACT,FI,FRMT,LISX,EOFL,PARL);% 00600000
|
|
COMMENT ESPOL VERSION OF ALGOL READ INTRINSIC% 00600100
|
|
BY L.R. GUCK 12/1/64% 00600200
|
|
VALUE FI,% 00600300
|
|
ACT;% 00600400
|
|
NAME FILX,% 00600500
|
|
LISX;% 00600600
|
|
ARRAY TEN[*],% 00600700
|
|
FRMT[*];% 00600800
|
|
INTEGER ACT,% 00600900
|
|
FI;% 00601000
|
|
REAL DKADR;% 00601100
|
|
REAL EOFL,% 00601200
|
|
PARL;% 00601300
|
|
BEGIN COMMENT LOCAL VARIABLES;% 00601400
|
|
REAL JUNK2=9,% 00601500
|
|
ALGOLREAD=13,% 00601600
|
|
SELECT=14,% 00601700
|
|
JUNK1 = 17,% 00601800
|
|
LSTRN=19;% 00601900
|
|
REAL BLKCNTL = 5;% 00602000
|
|
REAL SAVEBUFF=EOFL, CODE1=PARL ; 00602050
|
|
INTEGER AEXP=FRMT;% 00602100
|
|
ARRAY ARRY=LISX[*];% 00602200
|
|
ARRAY REALROW=TEN-1[*];% 00602300
|
|
REAL F = +0;% 00602400
|
|
REAL TLSTRN=F+1;% 00602500
|
|
REAL BUFF=TLSTRN+1;% 00602600
|
|
INTEGER BSIZE=BUFF+1;% 00602700
|
|
ARRAY FIB=BSIZE+1[*];% 00602800
|
|
REAL ADDRS=FIB+1;% 00602900
|
|
REAL SGN=ADDRS+1;% 00603000
|
|
REAL WT=SGN+1;% 00603100
|
|
REAL W1=WT+1;% 00603200
|
|
REAL CCR = W1, DIVR = W1;% 00603300
|
|
REAL W2=W1+1;% 00603400
|
|
REAL TYP = W2;% 00603500
|
|
REAL D=W2+1;% 00603600
|
|
REAL ESIG= D;% 00603700
|
|
REAL D1=D+1;% 00603800
|
|
REAL D2=D1+1;% 00603900
|
|
REAL W=D2+1;% 00604000
|
|
REAL SKIP=W+1;% 00604100
|
|
REAL CHR=SKIP+1;% 00604200
|
|
REAL FAW=CHR+1;% 00604300
|
|
REAL CODE=FAW+1;% 00604400
|
|
INTEGER CSIZE=CODE+1;% 00604500
|
|
INTEGER SCFTR = CSIZE+1;% 00604600
|
|
REAL FLG = SCFTR +1;% 00604700
|
|
REAL UDECLR=FLG+1; 00604710
|
|
LABEL GA,GAC,GRTY,GTB,GTC,GTD,NUMXIT,% 00604800
|
|
FREFLD,STRT,NMRCL,HERE,NOSIG,LPTWO,NOTNUM2,L1,L1P2,% 00604900
|
|
NFRAC1,ATS,HR1,NSG,L2P1,FINXP,NCA1,NMINUS,NOTAT,% 00605000
|
|
NCA2,NNMB,NOTNUM,RNOTNUM,INSERT,NAST,QRT,QRTN,% 00605100
|
|
EQUT,EAT1,EATUP,NQUOT,GETO,GTRT7,ASTRX,CHKOCT,% 00605200
|
|
GETCOMA,GETC1,MAXI, 00605300
|
|
START,CT,CTA,CTB,CTC,% 00605400
|
|
ASLST,BS,BR,AEXPL,ISA,ISB,ERROR,% 00605500
|
|
FMOUTA,FMOUT,S1,S,LFPAR,RTPAR,SCALE,STRNG,SLASH,% 00605600
|
|
PHRAS,INLOOP,FLDW,JMP,% 00605700
|
|
LOGI, FLAGBIT, 00605800
|
|
DTYPE,OTYPE,ALFA,XTYPE,% 00605900
|
|
RTYPE,RBLF,RFA,RIPART,RDONA,RDONE,RFC,REXP,% 00606000
|
|
RIPRTN,RFPRTN,RFPART,GETNUM,GRTN,% 00606100
|
|
ITYPE,FIN,FMOUTM1,S2, 00606200
|
|
FOUT,FTYPE,FA,ETYPE,% 00606300
|
|
COMA,COMM,COMB,COMC,RERRA;% 00606400
|
|
COMMENT LABELS ARE LISTED IN SAME ORDER THEY APPEAR;% 00606500
|
|
DEFINE P = POLISH#,% 00606600
|
|
TEN8 = @1045753604000000#;% 00606700
|
|
SUBROUTINE CKPB; COMMENT CHECK FOR PRESENCE BIT;% 00606800
|
|
BEGIN% 00606900
|
|
IF FILX.[18:15] { 1 THEN% 00607000
|
|
BEGIN IF NOT FILX.[18:15] THEN% 00607100
|
|
BEGIN;STREAM(A~[REALROW[0]]:B~0);% 00607200
|
|
BEGIN SI~A; DI~A; SI~SI-16; 00607300
|
|
SKIP 2 SB;% 00607400
|
|
IF SB THEN TALLY ~ 1;% 00607500
|
|
A ~ TALLY;% 00607600
|
|
END;% 00607700
|
|
IF NOT P THEN% 00607800
|
|
BEGIN P(FILX,14,COM,DEL);% 00607900
|
|
FILX.[18:15] ~ 1;% 00608000
|
|
END;% 00608100
|
|
END;% 00608200
|
|
BSIZE ~ REALROW.[8:10];% 00608300
|
|
END ELSE% 00608400
|
|
BSIZE~POLISH(MKS,DKADR,1,FILX,ALGOLREAD);% 00608500
|
|
BUFF~(*FILX)&BSIZE[8:38:10] ; 00608600
|
|
END;% 00608700
|
|
SUBROUTINE READS;% 00608800
|
|
COMMENT RELEASE BUFFER;% 00608900
|
|
BEGIN% 00609000
|
|
P(XCH); COMMENT FLAG TO TOP OF STACK;% 00609100
|
|
IF ACT=2 THEN COMMENT READ RELEASE;% 00609200
|
|
POLISH(MKS,DKADR,0,FILX,ALGOLREAD);% 00609300
|
|
IF P THEN% 00609400
|
|
BEGIN LSTRN ~ TLSTRN;% 00609500
|
|
IF FILX.[18:15]>1 THEN 00609600
|
|
FILX[NOT 4]~FILX[NOT 3]~0 ELSE 00609700
|
|
IF FILX.[18:15] = 1 THEN% 00609800
|
|
P(FILX,14,COM);% 00609900
|
|
P(XIT);% 00610000
|
|
END;% 00610100
|
|
CKPB;% 00610200
|
|
IF SGN.[45:1] THEN %%% UTYP=SGN.[45:1]; SEE U-PHRASE DECLR00610210
|
|
BEGIN CSIZE~8|BSIZE; BUFF~P(0,[BUFF],0,INX) END ; 00610220
|
|
END RLADS;% 00610300
|
|
COMMENT SUBROUTINE USED BY FREE FIELD;% 00610400
|
|
SUBROUTINE GNCR;% 00610500
|
|
BEGIN COMMENT THIS SUB-ROUTINE GETS CHARACTERS FOR% 00610600
|
|
FREE FIELD.INCLUDING READING OF RECORDS 00610700
|
|
WHEN REQUIRED;% 00610800
|
|
GA: IF WT > 0 THEN GO TO GAC;% 00610900
|
|
COMMENT BUFFER IS EMPTY-FILL IT;% 00611000
|
|
P(0);% 00611100
|
|
READS;% 00611200
|
|
WT ~ BSIZE | 8; COMMENT WT = # OF CHARACTERS IN BUFFER;% 00611400
|
|
BUFF ~ P(0,0,[BUFF],CCX);% 00611500
|
|
COMMENT GFT CHR FROM BUFFER;% 00611600
|
|
GAC: STREAM(% 00611700
|
|
P5 ~ 0,% 00611800
|
|
P4 ~ BUFF,% 00611900
|
|
P3 ~ IF WT < 63 THEN WT ELSE 63:% 00612000
|
|
P1 ~ TYP);% 00612100
|
|
BEGIN% 00612200
|
|
SI ~ P4;% 00612300
|
|
CI ~ CI + P1;% 00612400
|
|
GO TO FGNC; COMMENT DEBLANK-THEN GET NCR;% 00612500
|
|
GO TO GNCHC; COMMENT GET NCR;% 00612600
|
|
FGNC: P3(IF SC ! " " THEN JUMP OUT TO GNCHC;% 00612700
|
|
SI~SI+1;% 00612800
|
|
TALLY ~ TALLY +1);% 00612900
|
|
COMMENT RETURN A -1 IF ALL WERE BLANK;% 00613000
|
|
DI ~ LOC P5;% 00613100
|
|
DS ~ 8 LIT "+0000001";% 00613200
|
|
GO TO CRTN;% 00613300
|
|
GNCHC: TALLY ~ TALLY + 1;% 00613400
|
|
DI ~ LOC P4;% 00613500
|
|
DI ~ DI - 1;% 00613600
|
|
DS ~ CHR;% 00613700
|
|
CRTN: P3 ~ TALLY;% 00613800
|
|
P4 ~ SI;% 00613900
|
|
END;% 00614000
|
|
P(WT,XCH,SUB,.WT,STD); COMMENT WT ~ WT-TALLY;% 00614100
|
|
BUFF ~ P;% 00614200
|
|
IF P(DUP) < 0 THEN BEGIN P(DEL); GO TO GA END;% 00614300
|
|
P(XCH); COMMENT RETURN LITERAL TO TOP;% 00614400
|
|
END GNCR;% 00614500
|
|
REAL SUBROUTINE LISTELEMENT ; 00614505
|
|
BEGIN 00614510
|
|
IF LSTRN<0 THEN GO TO ERROR ; 00614515
|
|
P(ADDRS,.ADDRS,ISN) ; 00614520
|
|
ADDRS~LISX ; 00614525
|
|
LISTELEMENT~P ; 00614530
|
|
END OF LISTELEMENT ; 00614535
|
|
00614600
|
|
% * * * D E C L A R A T I O N S F O R U - P H R A S E * * * 00614605
|
|
% NOTE THAT CST REFERS TO THE CONSTRUCT BEGIN SCANNED. THE CST IS 00614610
|
|
% EITHER A NUMBER, AN UNQUOTED STRING, OR A QUOTED STRING 00614615
|
|
LABEL UERR , %%% BRNCHTO FOR DATA ERROR 00614620
|
|
UTYPE , %%% BRNCHTO FOR U-PHRASE EDITING. 00614625
|
|
UENDNUM , %%% BRNCHTO FOR END OF NUMBER SCAN. 00614630
|
|
UL1 , %%% BRNCHTO FOR EFFICIENCY IN UCH. 00614635
|
|
UL2 , %%% BRNCHTO FOR EFFICIENCY IN UCHECKT00614640
|
|
UL3 , %%% BRNCHTO FOR EFFICIENCY IN STRINGS00614645
|
|
UL4 , %%% BRNCHTO FOR STRING-HANDLING LOOP.00614650
|
|
UL5 , %%% BRNCHTO FOR UCHECKIT(@END-OF-CST)00614655
|
|
UL6 , %%% BRNCHTO FOR NO STRING STORE. 00614660
|
|
FMTERR ; %%% BRNCHTO FOR ILLEGAL FORMAI. 00614665
|
|
DEFINE UEXP = WT #, %%% IS VALUE OF EXPNT(OF CST AS NUM),00614670
|
|
%%% OR IT IS THE SHIP-IT-ANYHOW TOGGL00614675
|
|
%%% FOR THE 1-ST CHR OF QUOTED STRING00614680
|
|
%%% OR IS USED AS TEMPORY BY UGETSGN.00614685
|
|
UBUILD = W1 #, %%% IS > 0 IF HAVE NOT YET IDENIIFIED00614690
|
|
%%% CST & SO MUST BUILD UH INTO UBUFF00614695
|
|
%%% IS > 0 IF SHALL BRANCH TO ENDNUM 00614700
|
|
%%% IF HAVE HIT END OF FIELD WIDTH, 00614705
|
|
%%% IS ALSO USED AS TEMPORARY COUNTER00614710
|
|
%%% OF OCT D1GITS IN OCTAL NUM PART. 00614715
|
|
UVAL = W2 #, %%% IS VALUE OF CST IF CST IS A NUM. 00614720
|
|
%%% AND IS USED AS TEMPORARY STORAGE.00614725
|
|
UNUM = D1 #, %%% IS TRUE IFF CST IS NUMBER. 00614730
|
|
UADDRS =UDECLR #, %%% STORES LIST ADDRESS REFERRED TO 00614735
|
|
%%% BY THE ULIST DEFINE (BELOW). 00614740
|
|
UH = D2 #, %%% IS CURRENT CHARACTER OF CSY. 00614745
|
|
UBUFF = FLG #, %%% IS SIX OR LESS CHARACTERS OF CST,00614750
|
|
%%% ALSO IS USED AS TEMPORARY BY 00614755
|
|
%%% SUBROUTINE UCHECKIT. 00614760
|
|
UCHCNT = SKIP #, %%% IS CHARACTER COUNTER FOR CSI. 00614765
|
|
USCHCNT = FAW #, %%% IS STRING CHR. COUNTER FOR UBUFF.00614770
|
|
UDEC = D #, %%% IS VALUE OF DECIMAL PART OF CST 00614775
|
|
%%% (IF CST IS NUMBER), AND IS ALSO 00614780
|
|
%%% USED AS TEMPORARY STORAGE. 00614785
|
|
USGN = SGN.[47:1] #, %%% IS TRUE IFF CST(AS NUM) IS NEGTIV00614790
|
|
UEXPSGN = SGN.[46:1] #, %%% IS TRUE IFF UEXP IS NEGATIVE. 00614795
|
|
UTYP = SGN.[45:1] #, %%% IS TRUE IFF IN OR JUST USED UPHRS00614800
|
|
UNLOCATED = SGN.[44:1] #, %%% IS TRUE IFF HAVE NOT LOCATED CST.00614805
|
|
UQSTRNG = SGN.[43:1] #, %%% IS TRUE IFF CST IS QUOIED STRING.00614810
|
|
ULIST = SGN.[42:1] #, %%% IS TRUE IFF UCH HAS TRIED TO GET 00614815
|
|
%%% AND/OR HAS GOTTEN A NEW LISI ADRS00614820
|
|
UD = SGN.[36:6] #, %%% STORES ORIGINAL VALUE OF D 00614825
|
|
UW = SGN.[30:6] #, %%% STORES ORIGINAL VALUE OF W. 00614830
|
|
UFREEFIELD= SGN.[29:1] #, %%% IS TRUE IFF IN SPECL // FREEFIELD00614835
|
|
UGETRECORD = BEGIN P(CHR~0); READS END #, 00614840
|
|
UGOOFED(UGOOFED1) = BEGIN UEXP~UGOOFED1; GO TO UERR END #,00614845
|
|
UEOW = W{UCHCNT #, 00614850
|
|
UALLDONE = GO TO BR # ; 00614855
|
|
SUBROUTINE UGNCH; %%% UGNCH GETS THE NEXT CHARACTER FROM THE 00614860
|
|
BEGIN %%% BUFFER, GETS A NEW BUFFER WHEN NECCESSARY, 00614865
|
|
IF CHR}CSIZE %%% ADJUSTS BUFF, AND BUMPS CHR BY 1. 00614870
|
|
THEN BEGIN %%% WE NEED A NEW BUFFER, CALL READS TO GET ONE.00614875
|
|
UGETRECORD ; %%% GET A NEW RECORD. 00614880
|
|
IF UNLOCATED %%% IF HAVE NOT YET LOCATED CST, THEN 00614885
|
|
THEN UCHCNT~0 ; %%% ZERO CHAR. CNTER. FOR NEW BUFFER SCAN.00614890
|
|
END ; 00614895
|
|
CHR~CHR+1 ; %%% INCREMENT CHARACTER COUNTER. 00614900
|
|
STREAM(P1~0,P2~BUFF:P0~0) ; %%% NOW GET CHARACTER AND BUMP BUFF00614905
|
|
BEGIN DI~LOC P2; DI~DI-1; SI~P2; DS~CHR; P2~SI END ; 00614910
|
|
BUFF~P ; %%% BUFF IS SET TO NEW ABS ADDRS (BUFF+1). 00614915
|
|
UH~P ; %%% CHARACTER IS STORED IN UH. 00614920
|
|
END OF UGNCH ; 00614925
|
|
SUBROUTINE UBUFFIT ; %%% STUFFS UH INTO UBUFF FROM THE RIGHT 00614930
|
|
BEGIN %%% AND BUMPS THE STRING CHARACTER COUNTER. 00614935
|
|
UBUFF~UH & UBUFF[12:18:30] ; 00614940
|
|
USCHCNT~USCHCNT+1 ; 00614945
|
|
END OF UBUFFIT ; 00614950
|
|
SUBROUTINE UCH ; %%% UCH IS THE CONTROL FOR UGNCH. UCH WATCHES OUT 00614955
|
|
BEGIN %%% FOR END-OF-W AND, IF NOT IN "STRING", SCANS 00614960
|
|
%%% OVER IN-LINE COMMENTS (/...=) AND STORES NON- 00614965
|
|
%%% BLANK PORIION OF CST IN UBUFF FOR FUTURE USE 00614970
|
|
%%% IF CST TURNS OUT NOT TO BE A NUMBER. UCH ALSO 00614975
|
|
%%% HANDLES END-OF-RECORD SITUATIONS (/... OR ~). 00614980
|
|
IF UEOW THEN %%% IF HAVE HIT END-OF-W (W=FIELD WIDTH), THEN00614985
|
|
BEGIN 00614990
|
|
IF UBUILD!0 %%% IF WE ARE NOT IN THE STRING SECTION, WE 00614995
|
|
THEN BEGIN P(DEL); GO UENDNUM END %%% BRNCHTO END-OF-NUM.00615000
|
|
END 00615005
|
|
ELSE %%% ELSE WE ARE STILL INSIDE FIELD-WIDTH W... 00615010
|
|
BEGIN %%% STILL SOME FIELD WIDTH LEFT. 00615015
|
|
UGNCH; UCHCNT~UCHCNT+1 ; %%% GET CHRTER, BUMP CHR. CNTER.00615020
|
|
IF NOT UQSTRNG THEN %%% NOI IN A QUOTED STRING. 00615025
|
|
BEGIN 00615030
|
|
WHILE UH="/" DO %%% WE"VE HIT AN END-OF-RECORD MARK 00615035
|
|
BEGIN %%% ("/") OR AN INLINE CMMNT("/...=")00615040
|
|
DO UGNCH UNTIL CHR=1 OR UH="=" OR UH="~" ; 00615045
|
|
IF CHR!1 THEN 00615050
|
|
BEGIN 00615055
|
|
IF UH="=" THEN GO TO UL1 ; 00615060
|
|
IF UH="~" THEN 00615065
|
|
BEGIN CHR~CSIZE; UL1: UGNCH END ; 00615070
|
|
END ; 00615075
|
|
END ; 00615080
|
|
IF UH="~" THEN %%% WE SET UH=DELIMETER, AND IF THERES00615085
|
|
BEGIN %%% MORE LIST, WE GET A NEW RECORD. 00615090
|
|
UH~" "; IF LSTRN}0 THEN UADDRS~LISX ; 00615095
|
|
SGN~SGN OR 32 ; %%% SETS ULIST = TRUE. 00615100
|
|
IF LSTRN}0 THEN UGETRECORD ; 00615105
|
|
END ; 00615110
|
|
IF UBUILD!0 %%% WE HAVE NOT YET IDENTIFIED CST, 00615115
|
|
THEN UBUFFIT ; %%% SO MUST SAVE UH IN UBUFF. 00615120
|
|
END ; 00615125
|
|
END ; 00615130
|
|
END OF UCH ; 00615135
|
|
BOOLEAN SUBROUTINE UDELIMCHK ; %%% IS TRUE IFF HAVE ENCOUNTERED A 00615140
|
|
BEGIN %%% DELIMITER NOT IN A QUOTED SIRING.00615145
|
|
UDELIMCHK~UH="," OR UH=" " OR UH="*" OR UEOW ; 00615150
|
|
END OF UDELIMCHK ; 00615155
|
|
DEFINE UCHECKIT = %%% UCHECKIT IS USED WHENEVER IHE SCAN HAS 00615160
|
|
%%% TERMINATED. UCHECKIT CHECKS FOR THE PROPER00615165
|
|
%%% DELIMITER AND TAKES THE ASSOCIATED BRANCH.00615170
|
|
%%% UCHECKIT WILL POSITION UH APPROPIAIELY 00615175
|
|
%%% (PRIOR TO DELIMITER CHECKING) IF THE 00615180
|
|
%%% MINIMUM FIELD WIDTH (UD) HAS NOT BEEN 00615185
|
|
%%% EXHAUSTED. 00615190
|
|
IF UH="*" THEN UALLDONE ; %%% THE * TERMINATES THE READ STMT. 00615195
|
|
IF NOT((UBUFF~UH!",") AND UH!" ") THEN 00615200
|
|
BEGIN 00615205
|
|
UQSTRNG~UBUILD~0; W~123; D~UD ; 00615210
|
|
WHILE UCHCNT{D DO %%% SCAN OFF UNTIL AT LEAST 00615215
|
|
BEGIN %%% D CHARACIERS HAVE BEEN PASSED ; 00615220
|
|
UCH ; 00615225
|
|
IF ULIST THEN GO TO UL2 ; %%% HAVE ENCOUNTERED AN ~. 00615230
|
|
IF UH="*" THEN UALLDONE ; %%% THE * TRMNIS THE READ. 00615235
|
|
IF (UBUFF OR UVAL~UH!",") AND (UH=" " OR NOT UVAL) 00615240
|
|
THEN UBUFF~UBUFF AND UVAL ELSE UGOOFED(1) ; 00615245
|
|
END ; 00615250
|
|
UL2: W~UW ; %%% RESTORE W TO ITS ORIGINAL VALUE, 00615255
|
|
GO TO COMM ; %%% AND MAKE NORMAL EXIT. 00615260
|
|
END ; 00615265
|
|
UGOOFED(2) #; %%% WAS NOT "*", ",", OR " " SO WE ERROR EXIT. 00615270
|
|
%%% END OF UCHECKIT. 00615275
|
|
BOOLEAN SUBROUTINE UGETSGN ; %%% IS TRUE IF SIGN="-"; IF SIGN(+,-,&)00615280
|
|
BEGIN %%% EXISTS, UGETSGN FETCHES A NEW CHAR.00615285
|
|
IF P(UH="-",DUP) OR UH="+" OR UH="&" THEN UCH ; 00615290
|
|
UGETSGN~POLISH ; 00615295
|
|
END OF UGETSGN ; 00615300
|
|
BOOLEAN SUBROUTINE USDELIMCHK ; %%% IS IRUE IF CURRENT CHARACIER(UH)00615305
|
|
BEGIN %%% IS A DELIMITER(* OR , OR BLANK);00615310
|
|
IF NOT UQSTRNG THEN P(UDELIMCHK) ELSE %%% IF UH=RIGHT HAND 00615315
|
|
BEGIN %%% 0UOTE OF QUOTED SIRING, 00615320
|
|
IF UEOW THEN UGOOFED(3) ; %%% THEN ONE AND POSSIBLY TWO 00615325
|
|
IF NOT(UH!""" OR UEXP) THEN %%% CHAR ARE SCANNED UNTIL UH 00615330
|
|
BEGIN %%% IS EITHER A DELIMITER OR 00615335
|
|
UQSTRNG~0; UCH ; %%% THE FIRSI CHARACTER OF THE00615340
|
|
IF NOT P(UDELIMCHK,DUP)%%% NEXT CONCATENATED STRING. 00615345
|
|
THEN BEGIN 00615350
|
|
IF UH!""" THEN UGOOFED(4) ; 00615355
|
|
SGN~SGN OR 16 ; %%% SETS UQSTRNG = TRUE 00615360
|
|
UCH; 00615365
|
|
END ; %%% DO ERROR-EXIT IF WE ARE IN00615370
|
|
END %%% QUOIED STRING AND: EXCEED 00615375
|
|
ELSE P(UEXP~0) ; %%% W OR ENCOUNTER 00615380
|
|
END ; %%% A NON-QUOTE, NON-DELIMITER00615385
|
|
USDELIMCHK~POLISH ; 00615390
|
|
END OF USDELIMCHK ; 00615395
|
|
% * * * E N D O F U - P H R A S E D E C L A R A T I O N S * 00615400
|
|
00615405
|
|
LABEL C,X,A,I,R,E,O,L,Z,ZW2,ZD,SWT ; 00615410
|
|
GO TO START; COMMENT GO AROUND FREE FIELD CODE; 00615415
|
|
COMMENT FREE FIELD FORMAT ; 00615420
|
|
FREFLD:: P(0,0,0,0,0,0); COMMENT PUSH UP STACK;% 00615500
|
|
LSTRN ~ 0;% 00615600
|
|
WT ~ BSIZE | 8; COMMENT WT = # OF CHR IN BUFFER;% 00615700
|
|
BUFF ~ P(0,0,[BUFF],CCX);% 00615800
|
|
STRT: ADDRS ~ LISX; COMMENT ADDRESS OF LIST ITEM;% 00615900
|
|
IF LSTRN < 0 THEN BEGIN COMMENT CALL READ AND EXIT;% 00616000
|
|
P(1);% 00616100
|
|
READS;% 00616200
|
|
END;% 00616300
|
|
GNCR; COMMENT GET A CHARACTER TO TOP OF SIACK;% 00616400
|
|
NMRCL: ESIG ~ DIVR ~ 0; COMMENT SET EXPONENT AND FRACTION PART% 00616500
|
|
TO ZERO;% 00616600
|
|
IF (SGN ~ P(DUP) = "-") THEN GO TO HERE;% 00616700
|
|
IF P(DUP) = "+" THEN GO TO HERE;% 00616800
|
|
IF P(DUP) ! "&" THEN GO TO NOSIG;% 00616900
|
|
HERE: P(DEL);% 00617000
|
|
GNCR;% 00617100
|
|
NOSIG: IF P(DUP) > 9 THEN GO TO NOTNUM;% 00617200
|
|
GNCR;% 00617300
|
|
LPTWO: IF P(DUP) > 9 THEN GO TO NOTNUM2;% 00617400
|
|
P(XCH,10,MUL,+);% 00617500
|
|
GNCR; GO TO LPTWO;% 00617600
|
|
NOTNUM2: IF P(DUP) ! "." THEN GO TO NFRAC1;% 00617700
|
|
P(DEL);% 00617800
|
|
L1: GNCR;% 00617900
|
|
L1P2: IF P(DUP) > 9 THEN GO TO NFRAC1;% 00618000
|
|
P(XCH,10,MUL,+);% 00618100
|
|
DIVR ~ DIVR +1;% 00618200
|
|
GNCR; GO TO L1P2;% 00618300
|
|
NFRAC1: IF P(DUP) ! "@" THEN GO TO NOTAT;% 00618400
|
|
P(DEL);% 00618500
|
|
GNCR;% 00618600
|
|
ATS: IF (ESIG ~ P(DUP) = "-") THEN GO TO HR1;% 00618700
|
|
IF P(DUP) = "+" THEN GO TO HR1;% 00618800
|
|
IF P(DUP) ! "&" THEN GO TO NSG;% 00618900
|
|
HR1: P(DEL);% 00619000
|
|
GNCR; COMMENT 1ST DIGIT;% 00619100
|
|
NSG: GNCR; COMMENT 2ND DIGIT;% 00619200
|
|
L2P1: IF P(DUP) > 9 THEN GO TO FINXP;% 00619300
|
|
P(XCH,10,MUL,+);% 00619400
|
|
GNCR; GO TO L2P1;% 00619500
|
|
FINXP: IF P = "," THEN GO TO NCA1;% 00619600
|
|
GNCR; GO TO FINXP;% 00619700
|
|
NCA1: IF ESIG THEN P(CHS);% 00619800
|
|
NMINUS: ESIG ~ P;% 00619900
|
|
P(",");% 00620000
|
|
NOTAT: IF P = "," THEN GO TO NCA2;% 00620100
|
|
GNCR; GO TO NOTAT;% 00620200
|
|
NCA2: IF SGN THEN P(CHS);% 00620300
|
|
IF P(ESIG-DIVR,DUP) = 0 THEN% 00620400
|
|
BEGIN% 00620500
|
|
P(DEL);% 00620600
|
|
P([ADDRS],ISD);% 00620700
|
|
GO TO STRT% 00620800
|
|
END;% 00620900
|
|
IF P(DUP) } 0 THEN% 00621000
|
|
P(TEN[P],MUL)% 00621100
|
|
ELSE% 00621200
|
|
P(TEN[-P],/);% 00621300
|
|
NNMB: P([ADDRS],STD);% 00621400
|
|
GO TO STRT;% 00621500
|
|
NOTNUM: IF P(DUP) ! " " THEN GO TO RNOTNUM;% 00621600
|
|
P(DEL);% 00621700
|
|
P(0);% 00621800
|
|
GNCR; GO TO L1P2;% 00621900
|
|
RNOTNUM: IF P(DUP) ! "@" THEN GO TO INSERT;% 00622000
|
|
P(DEL);% 00622100
|
|
P(1);% 00622200
|
|
GNCR; GO TO ATS;% 00622300
|
|
INSERT: IF P(DUP) = "," THEN% 00622400
|
|
BEGIN% 00622500
|
|
P(DEL);% 00622600
|
|
GO TO STRT;% 00622700
|
|
END;% 00622800
|
|
NAST: IF P(DUP) ! """ THEN GO TO NQUOT;% 00622900
|
|
P(DEL);% 00623000
|
|
TYP ~ CCR ~ 1;% 00623100
|
|
GNCR;% 00623200
|
|
QRT: GNCR;% 00623300
|
|
QRTN: IF P(DUP) = """ THEN GO TO EQUT;% 00623400
|
|
P(XCH,64,MUL,+);% 00623500
|
|
IF (CCR ~ CCR+1) ! 6 THEN% 00623600
|
|
BEGIN% 00623700
|
|
GNCR; GO TO QRTN;% 00623800
|
|
END;% 00623900
|
|
P([ADDRS],STD);% 00624000
|
|
ADDRS ~ LISX;% 00624100
|
|
IF LSTRN < 0 THEN% 00624200
|
|
BEGIN% 00624300
|
|
DO GNCR UNTIL P= """;% 00624400
|
|
DO GNCR UNTIL P=",";% 00624500
|
|
P(1);% 00624600
|
|
READS;% 00624700
|
|
END;% 00624800
|
|
CCR ~ 0;% 00624900
|
|
GNCR;% 00625000
|
|
IF P(DUP) = """ THEN GO TO EQUT;% 00625100
|
|
CCR ~ 1;% 00625200
|
|
GO TO QRT;% 00625300
|
|
EQUT: P(DEL);% 00625400
|
|
TYP ~ 0;% 00625500
|
|
IF CCR = 0 THEN% 00625600
|
|
BEGIN% 00625700
|
|
GNCR;% 00625800
|
|
GO TO EATUP;% 00625900
|
|
END;% 00626000
|
|
P([ADDRS],STD);% 00626100
|
|
GNCR;% 00626200
|
|
EAT1: IF P(DUP) = "," THEN GO TO STRT;% 00626300
|
|
GNCR; GO TO EAT1;% 00626400
|
|
EATUP: IF P ! "," THEN BEGIN GNCR; GO TO EATUP END;% 00626500
|
|
GNCR;% 00626600
|
|
GO TO NMRCL;% 00626700
|
|
NQUOT: IF P(DUP) ! "%" THEN GO TO ASTRX;% 00626800
|
|
P(DEL,0);% 00626900
|
|
GNCR;% 00627000
|
|
GETO: IF P(DUP) > 7 THEN GO TO GTRT7;% 00627100
|
|
P(XCH,DIA 4,DIB 1,TRB 44);% 00627200
|
|
GNCR; GO TO GETO;% 00627300
|
|
GTRT7: IF P ! "," THEN BEGIN GNCR; GO TO GTRT7 END;% 00627400
|
|
P([ADDRS],STD);% 00627500
|
|
GO TO STRT;% 00627600
|
|
ASTRX: IF P(DUP) = "*" THEN% 00627700
|
|
BEGIN% 00627800
|
|
P(1);% 00627900
|
|
READS;% 00628000
|
|
END;% 00628100
|
|
CHKOCT: IF P(DUP) ! "/" THEN GO TO GETCOMA;% 00628200
|
|
P(DEL);% 00628300
|
|
WT ~ 0;% 00628400
|
|
GNCR;% 00628500
|
|
GO TO NMRCL;% 00628600
|
|
$ SET OMIT = NOT(TIMESHARING) 00628650
|
|
GETCOMA: ESIG ~ (FIB[4].[8:4]=10); % TRUE IF REMOTE INPUT 00628700
|
|
$ SET OMIT = TIMESHARING 00628701
|
|
GETC1: IF P = "," OR (ESIG AND WT=0) THEN GO STRT ELSE 00628750
|
|
GNCR; GO GETC1; 00628800
|
|
COMMENT START OF INPUTINT;% 00628900
|
|
START:: P(LSTRN,0,0);% 00629000
|
|
IF FILX.[18:15] > 1 THEN% 00629100
|
|
BEGIN P(FILX[NOT 2]);% 00629200
|
|
FILX[NOT 4]~EOFL; FILX[NOT 3]~PARL; 00629300
|
|
IF NOT FIB[5].[12:1] THEN P(MKS,"READNG",FILX,7,SELECT) ; 00629330
|
|
IF FIB[4].[27:3] ! 2 THEN 00629340
|
|
IF FIB[5].[43:2]!((ACT<0)+2) THEN% 00629400
|
|
POLISH(MKS,DKADR,(ACT<0) +2,FILX,1,SELECT);% 00629500
|
|
COMMENT CALL SELECT IF NOT READ STATUS OR% 00629600
|
|
WRONG DIRECTION ;% 00629700
|
|
END ELSE P(0);% 00629800
|
|
CKPB;% 00629900
|
|
COMMENT CHECK FOR TYPE OF READ STATMENT;% 00630000
|
|
CT: ACT~ABS(JUNK1~ACT);% 00630100
|
|
IF ARRY ! 0 THEN GO TO CTB; COMMENT<LIST PART>NOT EMPTY; 00630200
|
|
IF FRMT ! 0 THEN GO TO CTA; COMMENT <LIST PARI>=EMPIY,% 00630300
|
|
<FORMAT PART> IS NOT;% 00630400
|
|
COMMENT BOTH <LIST PART> & <FORMAT PART> WAS EMPTY;% 00630500
|
|
P(1); COMMENT SET FLAG = EXIT;% 00630600
|
|
READS; COMMENT RELEASE BUFFER;% 00630700
|
|
CTA: LSTRN ~ -1; COMMENT<LIST PART> = EMPTY;% 00630800
|
|
GO TO FMOUT; COMMENT READ IS <FORMAT>,<EMPTY>;% 00630900
|
|
CTB: IF NOT P(ARRY ,TOP,XCH,DEL) THEN GO TO CTC;% 00631000
|
|
COMMENT IF LIST IS NOT A DESCRIPTOR WE HAVE% 00631100
|
|
A SPACE STATEMENT AND ACT = # OF% 00631200
|
|
RECORDS TO SPACE;% 00631300
|
|
IF FIB[4].[8:4]=4 THEN% 00631400
|
|
BEGIN IF FIB[4].[27:3]!1 THEN% 00631500
|
|
P(MKS,FIB[7]+JUNK1,1,FILX,1,SELECT);% 00631600
|
|
END ELSE% 00631700
|
|
WHILE (ACT~ACT-1)}0 DO% 00631800
|
|
BEGIN CKPB; POLISH(MKS,DKADR,0,FILX,ALGOLREAD); END; 00631900
|
|
LSTRN ~ TLSTRN;% 00632000
|
|
POLISH(XIT);% 00632100
|
|
CTC: IF NOT P( FRMT,TOP) THEN GO TO FMOUTA; COMMENT WE HAVE% 00632200
|
|
<FORMAT>,<LIST>;% 00632300
|
|
IF P ! 0 THEN GO TO AEXPL; COMMENT WE HAVE AEXP,A[*];% 00632400
|
|
IF FI=1 THEN GO TO FREFLD ELSE %%% / TYPE FREE-FIELD READ 00632500
|
|
IF FI=2 THEN GO FMOUTM1 ELSE %%% // TYPE FREE-FIELD READ 00632510
|
|
IF ARRY } 0 THEN GO TO AEXPL;% 00632600
|
|
COMMENT WE HAVE *,LIST;% 00632700
|
|
ASLST: P(0,.LSTRN,SND); COMMENT LSTRN ~ 0 S ~ I ~ 0;% 00632800
|
|
BS: P(DUP,[LISX]); COMMENT S = ADDRESS OF LIST ITEM 00632900
|
|
S-1 = INDEX FOR BUFF; 00633000
|
|
IF LSTRN < 0 THEN GO TO BR; COMMENT LIST IS EXAUSTED;% 00633200
|
|
IF P(XCH,BUFF,XCH,STD,1,ADD,DUP) < BSIZE 00633300
|
|
THEN GO TO BS; COMMENT BUFFER ITEM TO LIST IF I+1% 00633400
|
|
IS { BUFFER SIZE THEN GET NEXT WORD;% 00633500
|
|
BR: P(1); COMMENT SET FLAG = EXIT;% 00633600
|
|
READS; COMMENT RELEASE BUFFER;% 00633700
|
|
COMMENT AEXP,A[*];% 00633800
|
|
AEXPL: IF P(ARRY.[8:10],DUP) { AEXP THEN GO TO ISA;% 00633900
|
|
IF AEXP < 0 THEN ARRY[-1]~0; 00634000
|
|
P(DEL,AEXP);% 00634100
|
|
COMMENT STACK IS SMALLEST OF ARRAY SIZE OR AEXP;% 00634200
|
|
ISA: IF P(DUP) { BSIZE THEN GO TO ISB;% 00634300
|
|
P(DEL,BSIZE);% 00634400
|
|
COMMENT STACK NOW HAS SMALLEST OF BUFFER SIZE AEXP 00634500
|
|
ARRAY SIZE;% 00634600
|
|
ISB: BSIZE ~ P;% 00634700
|
|
COMMENT BSIZE = # OF WORDS TO TRANSFER;% 00634800
|
|
STREAM(P4 ~ *FILX,P3 ~ BSIZE,P2 ~ BSIZE DIV 64,% 00634900
|
|
P1 ~ [ARRY[0]]);% 00635000
|
|
BEGIN% 00635100
|
|
SI~P4;% 00635200
|
|
P2(DS~32 WDS;% 00635300
|
|
DS~32 WDS);% 00635400
|
|
DS~ P3 WDS;% 00635500
|
|
END;% 00635600
|
|
ERROR: P(1); COMMENT ON ERROR, RELEASE BUFFER AND EXIT;% 00635700
|
|
READS;% 00635800
|
|
COMMENT WE HAVE FORMAT,LIST OR FORMAT,<EMPTY>;% 00635900
|
|
FMOUTA: P(DEL) ; 00636000
|
|
FMOUTM1: LSTRN~0 ; 00636100
|
|
FMOUT: P(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ; 00636200
|
|
COMMENT 19 GOOSE EGGS FOR YE OLDE STACK ; 00636300
|
|
ADDRS ~ LISX;% 00636400
|
|
SAVEBUFF~BUFF~P(0,[BUFF],0,INX) ; 00636500
|
|
CSIZE ~ BSIZE | 8;% 00636600
|
|
IF FRMT=0 THEN %%% SPLCIAL // TYPE OF FREE-FIELD READ. 00636610
|
|
BEGIN CODE~11; UFREEFIELD~1; FAW~1&1[27:47:1] ; 00636620
|
|
GO TO PHRAS END ELSE 00636630
|
|
GO TO S ;% 00636700
|
|
S2: P(DEL) ; 00636710
|
|
S1: FI~FI+1; COMMENT LOOK AT NEXI EDITING PHRASE;% 00636800
|
|
S: CODE ~ 0&(FAW ~ FRMT[FI])[44:2:4];% 00636900
|
|
IF FAW > 0 THEN GO TO PHRAS; COMMENT PHRAS IF S=0;% 00637000
|
|
GO TO P(CODE);% 00637100
|
|
GO TO RTPAR;% 00637200
|
|
GO TO STRNG;% 00637300
|
|
GO TO LFPAR;% 00637400
|
|
GO TO SLASH;% 00637500
|
|
GO TO SCALE;% 00637600
|
|
COMMENT LEFT PARENTHESIS;% 00637700
|
|
LFPAR: IF FAW.[12:1] THEN 00637800
|
|
BEGIN IF P(LISTELEMENT,DUP)<0 THEN 00637900
|
|
BEGIN P(DEL); FI~FAW.[28:10]+FI END; 00638000
|
|
END ELSE P(FAW.[38:10]); 00638100
|
|
GO TO S1;% 00638200
|
|
COMMENT RIGHT PARENTHESIS;% 00638300
|
|
RTPAR: IF P(1,SUB,DUP) =0% 00638400
|
|
THEN BEGIN COMMENT LFPAR REPEAT -1;% 00638500
|
|
P(DEL); COMMENT DELETE 0 REPEAT;% 00638600
|
|
GO TO S1; COMMENT PICK UP NEXT PHRASE;% 00638700
|
|
END;% 00638800
|
|
FI ~ FI - (FAW AND 1023); COMMENT SET FI BACK TO LFPAR;% 00638900
|
|
GO TO S1;% 00639000
|
|
COMMENT SCALE FACTOR;% 00639100
|
|
SCALE: SCFTR~IF FAW.[12:1] THEN LISTELEMENT 00639200
|
|
ELSE 0&FAW[38:38:10]&FAW[1:11:1]; 00639300
|
|
GO TO S1;% 00639400
|
|
COMMENT STRINGS;% 00639500
|
|
STRNG: IF (CHR ~ (W ~ FAW.[6:6]) + CHR)>CSIZE% 00639600
|
|
THEN GO TO ERROR; COMMENT BUFFER OVERFLOW;% 00639700
|
|
COMMENT CHR ~ CHR + W;% 00639800
|
|
STREAM(P2 ~ W,P1 ~ 0:P0 ~ BUFF);% 00639900
|
|
BEGIN% 00640000
|
|
SI~P0;% 00640100
|
|
DI~LOC P1;% 00640200
|
|
DI~DI-P2;% 00640300
|
|
DS~P2 CHR;% 00640400
|
|
P1~SI;% 00640500
|
|
END;% 00640600
|
|
BUFF ~ P;% 00640700
|
|
FRMT[FI] ~ P(XCH)&FAW[1:1:11]; COMMENT DIAL S,CODE & W TO 00640800
|
|
STRING OBTAINED FROM BUFFER AND PUI RESULI% 00640900
|
|
BACK INTO FORMAT ARRAY;% 00641000
|
|
GO TO S1;% 00641100
|
|
COMMENT SLASH;% 00641200
|
|
SLASH: POLISH((LSTRN<0) AND FAW);% 00641300
|
|
READS; COMMENT RELEASE BUFFER;% 00641400
|
|
CHR ~0;% 00641500
|
|
BUFF ~ P(0,[BUFF],0,INX);% 00641600
|
|
CSIZE ~ BSIZE | 8;% 00641700
|
|
GO TO S1;% 00641800
|
|
COMMENT BREAK APART FORMAT WORD;% 00641900
|
|
PHRAS: IF FAW.[12:1] THEN P(LISTELEMENT) ELSE P(FAW.[38:10]); 00642000
|
|
IF CODE=13 THEN CODE~IF (CODE~LISTELEMENT)="D" THEN 0 ELSE00642100
|
|
IF CODE="T" THEN 1 ELSE 00642150
|
|
IF CODE="X" THEN 2 ELSE 00642200
|
|
IF CODE="A" THEN 4 ELSE 00642300
|
|
IF CODE="I" THEN 6 ELSE 00642400
|
|
IF CODE="F" THEN 8 ELSE 00642500
|
|
IF CODE="E"THEN 10 ELSE 00642600
|
|
IF CODE="U" THEN 11 ELSE 00642610
|
|
IF CODE="O" THEN 12 ELSE 00642700
|
|
IF CODE="L" THEN 14 ELSE 00642800
|
|
IF CODE="R" THEN 15 ELSE 16; 00642900
|
|
CODE1~CODE=1 ; 00642905
|
|
IF (TYP~CODE=11) AND FAW.[31:1] THEN GO TO FMTERR ELSE 00642910
|
|
W~IF FAW.[13:1] THEN LISTELEMENT-CODE1 ELSE 00643000
|
|
IF TYP AND FAW.[27:1] THEN 64 00643010
|
|
ELSE FAW.[6:6] ; 00643020
|
|
D~IF FAW.[14:1] THEN LISTELEMENT 00643100
|
|
ELSE IF TYP THEN FAW.[32:6] 00643110
|
|
ELSE (D1~FAW.[20:4])+(D2~FAW.[16:4]); 00643200
|
|
IF P(DUP){0 THEN GO TO S2 ; 00643300
|
|
IF W<0 THEN IF CODE1 AND W=(-1) THEN GO S2 00643320
|
|
ELSE IF NOT(CODE=0 OR CODE=12) THEN GO TO FMTERR; 00643330
|
|
IF D<0 THEN IF NOT(CODE!15 AND CODE!8 AND CODE!10) 00643340
|
|
THEN GO TO FMTERR ; 00643350
|
|
IF W=0 THEN IF CODE!2 AND NOT CODE1 THEN GO S2 ; 00643360
|
|
IF TYP THEN BEGIN IF D>63 THEN D~63 ; 00643370
|
|
IF NOT(FAW.[27:1] OR W<64) THEN GO TO FMTERR 00643372
|
|
ELSE W~W.[42:6] ; GO TO INLOOP END ELSE 00643376
|
|
IF FAW.[13:2]!0 OR FAW.[2:4]=13 THEN 00643400
|
|
BEGIN GO TO P(IF CODE=15 THEN 8 ELSE IF CODE1 THEN 2 00643500
|
|
ELSE CODE) ; 00643590
|
|
GO C; GO X; GO A; GO I; GO R; GO E; GO O; GO L; 00643600
|
|
GO TO FMTERR ; 00643700
|
|
L: W1~IF W{5 THEN W ELSE 5; GO TO Z; 00643800
|
|
X: W1~W DIV 64; W~SKIP~W.[42:6]; 00643900
|
|
GO TO ZW2; 00644000
|
|
A: W1~IF W{6 THEN W ELSE 6; 00644100
|
|
Z: SKIP~W-W1; GO TO ZW2; 00644200
|
|
I: W1~IF W{8 THEN W ELSE 8; 00644300
|
|
SKIP~IF W{16 THEN 0 ELSE W-16; 00644400
|
|
W2~W-SKIP-W1; GO TO ZD; 00644500
|
|
E: D~(FAW.[2:4]=13 OR FAW.[14:1])+D; 00644600
|
|
D2~D-D1~IF D{8 THEN D ELSE 8; 00644700
|
|
SKIP~IF (W-D){5 THEN 0 ELSE W-D-5; 00644800
|
|
W1~W2~0; GO TO SWT; 00644900
|
|
R: D2~D-D1~IF D{8 THEN D ELSE 8; 00645000
|
|
SKIP~IF (W-D){17 THEN 0 ELSE W-D-17; 00645100
|
|
W1~IF (W-D){8 THEN W-D-1 ELSE 8; 00645200
|
|
W2~IF (W-D-SKIP){9 THEN 0 ELSE W-D-SKIP-9; 00645300
|
|
GO TO SWT; 00645400
|
|
C: O: W~8; W1~SKIP~0; 00645500
|
|
ZW2: W2~0; 00645600
|
|
ZD: D~D1~D2~0; 00645700
|
|
SWT: WT~W1+W2; 00645800
|
|
END ELSE 00645900
|
|
BEGIN WT~(W1~FAW.[28:4])+(W2~FAW.[24:4]); 00646000
|
|
SKIP~FAW.[32:6]; 00646100
|
|
END; 00646200
|
|
INLOOP: IF CODE { 2 THEN GO TO FLDW;% 00646300
|
|
IF LSTRN}0 THEN IF CODE=11 THEN GO TO UTYPE ELSE GO FLDW 00646400
|
|
ELSE UALLDONE ; 00646500
|
|
FLDW: IF CODE1 THEN BEGIN BUFF~SAVEBUFF; CHR~W; GO XTYPE END ; 00646600
|
|
IF (CHR~W+CHR)>CSIZE 00646700
|
|
THEN GO TO ERROR; COMMENT BUFFER EXAUSTED;% 00646800
|
|
COMMENT SELECT EDITING PHRASE;% 00646900
|
|
JMP: IF CODE = 15 THEN GO TO RTYPE;% 00647000
|
|
IF CODE THEN GO TO FMTERR ; 00647020
|
|
GO TO P(CODE);% 00647100
|
|
GO TO DTYPE; COMMENT CODE = 0 =D;% 00647200
|
|
GO TO XTYPE; COMMENT CODE = 2 =X;% 00647300
|
|
GO TO ALFA; COMMENT CODE = 4 =A;% 00647400
|
|
GO TO ITYPE; COMMENT CODE = 6 =I;% 00647500
|
|
GO TO FTYPE; COMMENT CODE = 8 =F;% 00647600
|
|
GO TO ETYPE; COMMENT CODE = 10=E;% 00647700
|
|
GO TO OTYPE; COMMENT CODE = 12=O;% 00647800
|
|
GO TO LOGI ; COMMENT CODE = 14=L;% 00647900
|
|
FMTERR: 00647903
|
|
UERR: IF FILX.[18:15]>1 THEN 00647906
|
|
BEGIN %%% NOT ARRAYROWBUFF, SO TRY PAR LBL BRANCH. 00647909
|
|
P(FILX[NOT 3]); FILX[NOT 3]~FILX[NOT 4]~0 ; 00647912
|
|
P(MKS,9,JUNK) ; 00647915
|
|
END ; 00647918
|
|
TEN~0; TEN~P([TEN[1]],CFX,SFB)&10[8:38:10] ; 00647921
|
|
W2~((W1~FIB[7]+1)>9)+(W1>99)+(W1>999)+1 ; 00647924
|
|
IF NOT UTYP THEN 00647927
|
|
BEGIN ; 00647930
|
|
STREAM(P2~W2,P1~W1,TEN) ; 00647933
|
|
BEGIN DS~14LIT"-FMT ERR, REC="; SI~LOC P1 ; 00647936
|
|
DS~P2 DEC; DS~10LIT", NO LBL:~" ; 00647939
|
|
END ; 00647942
|
|
END 00647945
|
|
ELSE 00647948
|
|
BEGIN ; 00647951
|
|
STREAM(P9~W2,P8~(CHR>9)+(CHR>99)+1,P7~UEXP,UH,CHR, 00647954
|
|
W1,P6~D~UD,P5~D!0,P4~(D>9)+1,P3~W~UW,P2~W!0, 00647957
|
|
P1~(W>9)+1,P0~CHR~UFREEFIELD,TEN) ; 00647960
|
|
BEGIN DS~2LIT"-U"; P2(SI~LOC P3; DS~P1 DEC) ; 00647963
|
|
P5(DS~LIT"."; SI~LOC P6; DS~P4 DEC);P0(DI~DI+5);00647966
|
|
DS~5LIT" ERR#"; SI~LOC P7; DS~DEC ; 00647969
|
|
DS~5LIT",CHR="; SI~SI+7; DS~CHR ; 00647972
|
|
DS~5LIT",COL="; DS~P8 DEC; DS~3LIT",R=" ; 00647975
|
|
DS~P9 DEC; DS~9LIT",NO LBL:~" ; 00647978
|
|
END ; 00647981
|
|
IF CHR THEN STREAM(TEN); DS~7LIT"-FREFLD" ; 00647984
|
|
END ; 00647987
|
|
P([TEN[0]].[33:15],34,COM) ; 00647990
|
|
COMMENT L PHRASE;% 00648000
|
|
LOGI: STREAM(P3 ~ W1, P2 ~ BUFF:P1 ~ SKIP);% 00648100
|
|
BEGIN% 00648200
|
|
SI~P2;% 00648300
|
|
SI~SI+P1; COMMENT SKIP ANY LEAOING BLANKS; 00648400
|
|
DI~LOC P1;% 00648500
|
|
DS~6 LIT "TRUE "; COMMENT PUT COMPARE IN P1;% 00648600
|
|
DI~DI-6;% 00648700
|
|
IF P3 SC ! DC% 00648800
|
|
THEN GO TO BL ; 00648900
|
|
LA: TALLY ~ 1 ; COMMENT IF SAME,P3~1;% 00649000
|
|
GO TO LC;% 00649100
|
|
BL: DI~LOC P1 ; 00649200
|
|
DS~ 6 LIT " TRUE "; COMMENT PUT COMPARE IN P1;% 00649300
|
|
DI~DI-6;% 00649400
|
|
SI~SI-P3;% 00649500
|
|
IF P3 SC=DC% 00649600
|
|
THEN TALLY~1; COMMENT IF SAME, P3-1;% 00649700
|
|
LC: P3 ~ TALLY;% 00649800
|
|
P2 ~ SI;% 00649900
|
|
END;% 00650000
|
|
GO TO COMA;% 00650100
|
|
COMMENT D PHRASE;% 00650200
|
|
DTYPE: STREAM(P2 ~ 0:P1 ~ BUFF);% 00650300
|
|
BEGIN% 00650400
|
|
SI~P1;% 00650500
|
|
SI~SI+8;% 00650600
|
|
P2~SI;% 00650700
|
|
END;% 00650800
|
|
BUFF ~ P;% 00650900
|
|
GO TO COMM;% 00651000
|
|
COMMENT O PHRASE;% 00651100
|
|
OTYPE: 00651200
|
|
STREAM(P2~0: P1~BUFF); % CHECK FOR FLAG BIT 00651210
|
|
BEGIN 00651220
|
|
SI ~ P1; 00651230
|
|
IF SB THEN TALLY ~ 1; 00651240
|
|
P2 ~ TALLY; 00651250
|
|
END; 00651300
|
|
IF P THEN 00651310
|
|
BEGIN % DATA HAS FLAG BIT 00651320
|
|
COMMENT IF F-FIELD = 0 OR R THEN LIST ITEM IS 00651330
|
|
SIMPLE VARIABLE IN STACK OR PRT; 00651340
|
|
IF (JUNK1 ~ [ADDRS].[18:15]) = 0 THEN GO FLAGBIT; 00651350
|
|
IF P(10,LOD).[18:15] = JUNK1 THEN GO FLAGBIT; 00651400
|
|
END; 00651410
|
|
COMMENT EITHER NO FLAG BIT OR DATA GOES TO ARRAY; 00651420
|
|
STREAM(P3~0: P2~BUFF, P1~[ADDRS]); 00651430
|
|
BEGIN 00651440
|
|
SI ~ P2; % DI SET FROM LAST PARAMEIER 00651450
|
|
DS ~ 8 CHR; 00651500
|
|
P3 ~ SI; 00651510
|
|
END; 00651520
|
|
BUFF ~ P; 00651530
|
|
GO TO COMM; 00651540
|
|
FLAGBIT: 00651550
|
|
COMMENT FLAGGED DATA GOING TO STACK OR PRT CAN CAUSE 00651600
|
|
BAD PROBLEMS. FORCE FLAG BIT INTERRUPT HERE; 00651610
|
|
JUNK1 ~ [JUNK1]; 00651620
|
|
P(JUNK1); 00651630
|
|
COMMENT CONTROL CANNOT REACH THIS POINT; 00651640
|
|
COMMENT U PHRASE;% 00651715
|
|
UTYPE: IF D}CSIZE THEN UALLDONE ; %%% EXIT IF MIN FLD-WDTH}BUFFSZ00651720
|
|
SGN~SGN&12[42:42:6]&D[36:42:6]&W[30:42:6] ; 00651725
|
|
W~IF W=0 THEN TEN[60] ELSE IF W>CSIZE THEN CSIZE ELSE W+1;00651730
|
|
UBUILD~UCHCNT~0 ; 00651735
|
|
DO UCH UNTIL UEOW OR UH!" " ; %%% SCAN UNTIL CST OR E-O-W.00651740
|
|
USCHCNT~UBUILD~1 ; 00651745
|
|
IF UDELIMCHK THEN GO TO UL5 ; UBUFF~UH ; 00651750
|
|
UNLOCATED~UNUM~UVAL~UDEC~UEXP~0; USGN~UGETSGN ; 00651755
|
|
IF UH="%" THEN %%% WE MAY HAVE AN OCTAL NUM; ERROR EXIT IF00651760
|
|
BEGIN %%% GTR 3777777777777777 OR HAS DIGIT GTR 700651765
|
|
UCH; SGN~SGN EQV (NOT UGETSGN) ; %%%USGN~USGN+UGETSGN00651770
|
|
UNUM~UH<8 ; 00651775
|
|
WHILE (UBUILD~UBUILD+1)<17 AND UH<8 DO 00651780
|
|
BEGIN UVAL~UH&UVAL[3:6:42]; UCH END ; 00651785
|
|
IF UBUILD=17 AND UH<8 AND (NOT UVAL.[3:1]) THEN 00651790
|
|
BEGIN %%% WE NOW BUILD 16-TH OCTAL DIGIT. 00651795
|
|
UVAL~UH&UVAL[1:4:44]; UCH ; 00651800
|
|
END ; 00651805
|
|
GO TO UENDNUM ; 00651810
|
|
END ; 00651815
|
|
UNUM~UH<10 ; 00651820
|
|
WHILE UH<10 DO BEGIN UVAL~10|UVAL+UH; UCH END ; 00651825
|
|
IF UH="." THEN 00651830
|
|
BEGIN 00651835
|
|
UCH; UNUM~UNUM OR UH<10 ; 00651840
|
|
WHILE UH<10 DO 00651845
|
|
BEGIN UBUILD~UBUILD+1; UDEC~10|UDEC+UH; UCH END;00651850
|
|
END ; 00651855
|
|
IF UH="@" OR UH="E" THEN 00651860
|
|
BEGIN UBUILD~-UBUILD; UCH; UEXPSGN~UGETSGN ; 00651865
|
|
IF NOT UNUM THEN UVAL~1 ; 00651870
|
|
IF UH<10 THEN 00651875
|
|
BEGIN UNUM~1; UBUILD~-UBUILD ; 00651880
|
|
DO BEGIN UEXP~10|UEXP+UH; UCH END UNTIL UH>9 ; 00651885
|
|
END ; 00651890
|
|
END ; 00651895
|
|
UENDNUM: IF UNUM THEN %%% THE CST HAS ENOUGH CHARACTERS IO UNAMBIG-00651900
|
|
BEGIN %%% UOUSLY APPEAR AS A NUMBER. 00651905
|
|
IF UBUILD{0 THEN UGOOFED(5) ; 00651910
|
|
UVAL~UVAL+UDEC/TEN[UBUILD-1] ; 00651915
|
|
IF UEXP!0 THEN UVAL~P(UVAL,TEN[UEXP],IF UEXPSGN THEN 00651920
|
|
P(/) ELSE P(|)) ; 00651925
|
|
P(IF SGN THEN -UVAL ELSE UVAL,[ADDRS],STD) ; 00651930
|
|
UL5: UCHECKIT ; 00651935
|
|
END ; 00651940
|
|
UBUILD~0 ; 00651945
|
|
IF UH!""" THEN 00651950
|
|
IF UDELIMCHK THEN UBUFF~UBUFF.[12:30] ELSE GO TO UL3 00651955
|
|
ELSE BEGIN UBUFF~USCHCNT~0; UQSTRNG~UEXP~1; UL3: UCH END ;00651960
|
|
IF NOT(UDEC~USDELIMCHK) AND USCHCNT<6 THEN 00651965
|
|
BEGIN UL4: UBUFFIT; GO TO UL3 END ; 00651970
|
|
IF (UVAL~0)=USCHCNT THEN GO TO UL6 ; 00651975
|
|
DO IF (UVAL~"|"&UVAL[24:30:18])=UBUFF THEN GO TO UL6 00651980
|
|
UNTIL UVAL.[24:1] ; 00651985
|
|
P(UBUFF,[ADDRS],STD) ; 00651990
|
|
UL6: IF UDEC THEN GO TO UL5; IF LSTRN}0 THEN ADDRS~LISX;00651995
|
|
IF LSTRN<0 THEN 00652000
|
|
BEGIN DO UCH UNTIL USDELIMCHK; GO TO UL5 END ; 00652005
|
|
USCHCNT~UBUFF~0; GO TO UL4 ; 00652010
|
|
COMMENT A PHRASE ; 00652015
|
|
ALFA: STREAM(P3~W1,P2~BUFF:P1~SKIP);% 00652100
|
|
BEGIN% 00652200
|
|
SI~P2;% 00652300
|
|
SI~SI+P1; COMMENT SKIP EVERYTHING BUT LAST 6;% 00652400
|
|
DI~LOC P2;% 00652500
|
|
DI~DI-P3;% 00652600
|
|
DS~P3 CHR;% 00652700
|
|
P2~SI;% 00652800
|
|
END;% 00652900
|
|
GO TO COMA;% 00653000
|
|
COMMENT X PHRASE AND T PHRASE ; 00653100
|
|
XTYPE: IF (CHR~CHR+W1|64)>CSIZE-CODE1 00653200
|
|
THEN GO TO ERROR; COMMENT BUFFER EXAUSTED;% 00653300
|
|
STREAM(P3~BUFF:P2~W1,P1~W);% 00653400
|
|
BEGIN% 00653500
|
|
SI~P3;% 00653600
|
|
SI~SI+P1;% 00653700
|
|
P2(SI~SI+32;% 00653800
|
|
SI~SI+32);% 00653900
|
|
P3~SI;% 00654000
|
|
END;% 00654100
|
|
BUFF ~ P;% 00654200
|
|
GO TO COMM;% 00654300
|
|
COMMENT I PHRASE;% 00654400
|
|
ITYPE: P(0); COMMENT RLIT = FROM I (SEE FOUT);% 00654500
|
|
FIN: COMMENT FIRST WE GET SIGN AND COUNT LEADING BLANKS;% 00654600
|
|
STREAM(% 00654700
|
|
P4~WT, COMMENT IN=FIELD WIDTH,OUT=LEADING% 00654800
|
|
BLANKS;% 00654900
|
|
P3~0 , COMMENT PLACE TO RETURN SIGN;% 00655000
|
|
P2~BUFF: COMMENT IN AND OUT=BUFFER ADDRESS;% 00655100
|
|
P1~SKIP);COMMENT # OF LEADING CHARACTERS TO% 00655200
|
|
IGNORE;% 00655300
|
|
BEGIN% 00655400
|
|
SI~P2;% 00655500
|
|
SI~SI+P1;% 00655600
|
|
P4(IF SC!" " THEN% 00655700
|
|
JUMP REAL TO NTBLK;% 00655800
|
|
SI~SI+1;% 00655900
|
|
TALLY~TALLY+1);% 00656000
|
|
COMMENT IF WE FALL THROUGH LOOP THEN% 00656100
|
|
WHOLE FIELD WAS BLANK;% 00656200
|
|
P4~TALLY;% 00656300
|
|
GO TO IEXIT;% 00656400
|
|
NTBLK: IF SC<"0" THEN% 00656500
|
|
BEGIN COMMENT SIGN IS PRESENT;% 00656600
|
|
IF SC="-" THEN; COMMENT TOGGLE~ TRUE;% 00656700
|
|
SI~SI+1; COMMENT SKIP SIGN;% 00656800
|
|
TALLY~TALLY+1;% 00656900
|
|
END;% 00657000
|
|
IMPLS: P4~TALLY; COMMENT LEADING BLANKS+"SIGN";% 00657100
|
|
TALLY~0; COMMENT INDICATE + SIGN;% 00657200
|
|
IF TOGGLE% 00657300
|
|
THEN TALLY~1; COMMENT TOGGLE = TRUE IF "-";% 00657400
|
|
P3~TALLY; COMMENT PASS BACK SIGN;% 00657500
|
|
IEXIT: P2~SI; COMMENT ADDRESS OF FIRST DIGIT;% 00657600
|
|
END;% 00657700
|
|
BUFF ~ P;% 00657800
|
|
SGN ~ P;% 00657900
|
|
COMMENT NOW TO CONVERT INTEGER;% 00658000
|
|
STREAM(% 00658100
|
|
P5 ~(P(SSN,WT,+,DUP)),% 00658200
|
|
P4 ~ (IF P { 8 THEN 0% 00658300
|
|
ELSE P(8, - ,8,XCH)),% 00658400
|
|
COMMENT IF WT-"LEADING BLANKS" > 8% 00658500
|
|
THEN P5~WT-LEADING BLANKS,P4~ 0% 00658600
|
|
ELSE P5~8,P4~WT-LEADING BLANKS-8;% 00658700
|
|
P3~0, COMMENT PLACE TO RETURN LOW HALF;% 00658800
|
|
P2~0,COMMENT PLACE TO RETURN HIGH HALF;% 00658900
|
|
P1~0: P0 ~ BUFF);% 00659000
|
|
BEGIN% 00659100
|
|
SI~P0;% 00659200
|
|
DI~LOC P2;% 00659300
|
|
DS~P4 OCT; COMMENT CONVERT HIGH HALF;% 00659400
|
|
DI~LOC P3;% 00659500
|
|
DS~P5 OCT; COMMENT CONVERT LOW HALF;% 00659600
|
|
P1~SI;% 00659700
|
|
END;% 00659800
|
|
BUFF ~ P; COMMENT SAVE NEXT FIELD ADDRESS; 00659900
|
|
P(TEN8,MUL,+); COMMENT HIGH HALF | 10*8% 00660000
|
|
- LOW HALF;% 00660100
|
|
IF SGN THEN P(CHS);% 00660200
|
|
IF P(XCH,DEL,XCH,DEL,XCH,DUP) THEN P(XCH,[ADDRS],~) 00660290
|
|
ELSE IF P(XCH,DUP){ P(MAXI) THEN P([ADDRS],ISD) 00660300
|
|
ELSE P([ADDRS],~); 00660310
|
|
% VOID 00660400
|
|
FOUT: IF P THEN GO TO FA;% 00660500
|
|
GO TO COMM;% 00660600
|
|
COMMENT F PHRASE;% 00660700
|
|
FTYPE: P(1);% 00660800
|
|
GO TO FIN; COMMENT USE ITYPE TO CONVERT INTEGER PART; 00660900
|
|
FA: STREAM(P5~ D2,% 00661000
|
|
P4~ D1,% 00661100
|
|
P3~ 0 , COMMENT PLACE TO RETURN LOW HALF;00661200
|
|
P2~ 0 , COMMENT PLACE TO RETURN HIGH HALF;% 00661300
|
|
P1 ~ 0:P0 ~ BUFF);% 00661400
|
|
BEGIN% 00661500
|
|
SI~P0 ;% 00661600
|
|
SI~SI+1; COMMENT SKIP DECIMAL POINT;% 00661700
|
|
DI~LOC P2;% 00661800
|
|
DS~P4 OCT; COMMENT CONVERT HIGH HALF;% 00661900
|
|
DI~LOC P3;% 00662000
|
|
DS~P5 OCT; COMMENT CONVERT LOW HALF;% 00662100
|
|
P1~SI;% 00662200
|
|
END;% 00662300
|
|
BUFF ~ P;% 00662400
|
|
P(TEN[D2] | P + P); COMMENT HIGH HALF | 10*D2 + LOW HALF; 00662500
|
|
P((ABS(ADDRS)| TEN[D]) + P); COMMENT INSERT INTEGER PART;00662600
|
|
P(TEN[D],/); COMMENT SCALE TO PROPER DECIMAL PLACE;00662700
|
|
IF SGN THEN P(CHS);% 00662800
|
|
P([ADDRS],STD);% 00662900
|
|
P(DEL,DEL) ;% 00663000
|
|
GO TO COMM;% 00663100
|
|
COMMENT E PHRASE;% 00663200
|
|
ETYPE: STREAM(P6~ 0, COMMENT PLACE TO RETURN EXPONENT;% 00663300
|
|
P5 ~ P(D-1, DUP), COMMENT D2 IN,MANTISSA SIGN OUT; 00663400
|
|
P4 ~ (IF P { 8 THEN P(0,.D2,SND,XCH)% 00663500
|
|
ELSE P(8,-,.D2,SND,8)),% 00663600
|
|
COMMENT IF (D-1) > 8 THEN P5= D-1-8,P4= 8% 00663700
|
|
ELSE P5= 0, P4=D-1,% 00663800
|
|
D1 ~ P4. ON RETURN P4=INTEGER% 00663900
|
|
DIGIT;% 00664000
|
|
P3 ~ P(0), COMMENT PLACE TO RETURN LOW HALF;% 00664100
|
|
P2 ~ 0, COMMENT PLACE TO RETURN HIGH HALF;% 00664200
|
|
P1 ~ BUFF:% 00664300
|
|
P0 ~ SKIP);% 00664400
|
|
BEGIN% 00664500
|
|
SI~P1;% 00664600
|
|
SI~SI+P0;% 00664700
|
|
P0~SI; COMMENT ADDRESS OF INTEGER;% 00664800
|
|
SI~SI+2; COMMENT SKIP INTEGER DIGIT & ".";% 00664900
|
|
DI~ LOC P2;% 00665000
|
|
DS~ P4 OCT; COMMENT CONVERT HIGH HALF;% 00665100
|
|
DI~ LOC P3;% 00665200
|
|
DS~ P5 OCT; COMMENT CONVERT LOW HALF;% 00665300
|
|
SI~SI+1; COMMENT SKIP "@";% 00665400
|
|
IF SC="-" THEN; COMMENT IF EXPONENT < 0% 00665500
|
|
THEN TOGGLE ~ TRUE;% 00665600
|
|
SI~SI+1; COMMENT SKIP EXPONENT SIGN;% 00665700
|
|
DI~ LOC P6;% 00665800
|
|
DS~ 2 OCT; COMMENT CONVERT EXPONENT;% 00665900
|
|
P1~ SI; COMMENT RETURN ADDRESS OF NEXT% 00666000
|
|
FIELD;% 00666100
|
|
IF TOGGLE THEN% 00666200
|
|
BEGIN DI~DI-8;% 00666300
|
|
DS~ LIT "+";% 00666400
|
|
END; COMMENT IF TOGGLE SET EXPONENT% 00666500
|
|
NEGATIVE;% 00666600
|
|
SI~P0;% 00666700
|
|
DI~LOC P4; COMMENT CONVERT INTEGER DIGII;% 00666800
|
|
DS ~ OCT;% 00666900
|
|
SI~SI-2; COMMENT LOOK AT SIGN;% 00667000
|
|
IF SC="-" THEN TALLY ~1;% 00667100
|
|
P5~TALLY;% 00667200
|
|
END;% 00667300
|
|
COMMENT ON RETURN STACK CONTAINS% 00667400
|
|
BUFF% 00667500
|
|
HIGH HALF% 00667600
|
|
LOW HALF% 00667700
|
|
INTEGER DIGIT% 00667800
|
|
MANTISSA SIGN% 00667900
|
|
EXPONENT;% 00668000
|
|
BUFF ~ P;% 00668100
|
|
P(TEN[D2] | P + P); COMMENT HIGH HALF|10*D2+LOW HALF;% 00668200
|
|
P(XCH,TEN[D-1]|P+P);COMMENT SCALE INTEGER DIGIT D PLACES% 00668300
|
|
AND ADD FRACTION PART;% 00668400
|
|
IF P(XCH) THEN P(CHS); COMMENT INSERT SIGN;% 00668500
|
|
P(XCH); COMMENT EXPONENT TO TOP;% 00668600
|
|
IF (JUNK1 ~ P-(D-1)) } 0% 00668700
|
|
THEN P(TEN[JUNK1],MUL)% 00668800
|
|
ELSE P(TEN[-JUNK1],/); COMMENT INSERT EXPONENT;% 00668900
|
|
GO TO COMB;% 00669000
|
|
COMA: BUFF ~ P;% 00669100
|
|
COMB: P([ADDRS],STD); COMMENT RESULT TO LIST;% 00669200
|
|
COMM: IF CODE { 2 THEN GO TO COMC; COMMENT PHRASE DIDNT USE% 00669300
|
|
ANYTHING FROM LIST;% 00669400
|
|
IF LSTRN}0 THEN ADDRS~IF NOT ULIST THEN LISX 00669500
|
|
ELSE P(.UADDRS,LOD) ; 00669505
|
|
ULIST~0 ; 00669510
|
|
COMC: IF P((UFREEFIELD=0),-,DUP)>0 THEN GO TO INLOOP ; 00669600
|
|
P(DEL);% 00669700
|
|
GO TO S1;% 00669800
|
|
COMMENT THE <REPEAT PART> OF PHRASE IS IN TOP OF STACK% 00669900
|
|
NOW(I HOPE). IF REPEAT-1 > 0 THEN GO TO INLOOP TO00670000
|
|
USE SAME PHRASE OVER. IF REPETE = 0 THEN DELETE% 00670100
|
|
THE 0 AND GO TO S1 TO PICK UP NEXT PHRASE;% 00670200
|
|
COMMENT R EDITING PHRASE;% 00670300
|
|
RTYPE:: STREAM(P6 ~(FLG~0), COMMENT RETURNS FLAG AS TO WHAT IS% 00670400
|
|
IN BUFFER;% 00670500
|
|
P5 ~ 0, COMMENT SIGN;% 00670600
|
|
P4 ~ W, COMMENT FIELD WIDTH;% 00670700
|
|
P3 ~ BUFF: COMMENT BUFFER CHARACTER ADDRESS;% 00670800
|
|
P1 ~ 0);% 00670900
|
|
BEGIN% 00671000
|
|
SI ~ P3;% 00671100
|
|
TALLY ~ P4;% 00671200
|
|
COMMENT SKIP LEADING BLANKS;% 00671300
|
|
P4(IF SC ! " " THEN JUMP OUT TO RSIGN;% 00671400
|
|
SI~SI+1;% 00671500
|
|
TALLY ~ TALLY +63);COMMENT TALLY-1;% 00671600
|
|
COMMENT FALL THRU LOOP MEANS FIELD WAS BLANK;% 00671700
|
|
TALLY~4; COMMENT SET FLAG TO 4;% 00671800
|
|
GO TO RXITA;% 00671900
|
|
NOI: TALLY ~ TALLY + 63;% 00672000
|
|
SI ~ SI+1;% 00672100
|
|
P4 ~ TALLY; COMMENT A "," WAS FOUND FIRST. SKIP% 00672200
|
|
THE "." AND SET FLAG TO 6;% 00672300
|
|
TALLY ~ 6;% 00672400
|
|
GO TO RXITA;% 00672500
|
|
COMMENT EXPONENT FOUND FIRST;% 00672600
|
|
EXPFRST: TALLY ~ TALLY +63;% 00672700
|
|
SI ~ SI+1;% 00672800
|
|
P4 ~ TALLY;% 00672900
|
|
TALLY ~ 8; COMMENT SET FLAG TO 8;% 00673000
|
|
GO TO RXITA;% 00673100
|
|
COMMENT LOOK AT FIRST NON-BLANK CHARACTER;% 00673200
|
|
RSIGN: IF SC="-" THEN GO TO RMINUS;% 00673300
|
|
IF SC="+" THEN GO TO RPLUS;% 00673400
|
|
IF SC="&" THEN GO TO RPLUS;% 00673500
|
|
RXITB: IF SC}"0" THEN GO TO RIMPLUS;% 00673600
|
|
IF SC="." THEN GO TO NOI;% 00673700
|
|
IF SC="E" THEN GO TO EXPFRST;% 00673800
|
|
IF SC="@" THEN GO TO EXPFRST;% 00673900
|
|
COMMENT IF NONE OF THE ABOVE THEN ERROR;% 00674000
|
|
RERR: TALLY ~ 2;% 00674100
|
|
GO TO RXITA;% 00674200
|
|
RMINUS: DI ~ LOC P4;% 00674300
|
|
DI ~ DI-1; COMMENT PASS BACK A "1" FOR A"-";% 00674400
|
|
DS ~ LIT "1";% 00674500
|
|
RPLUS: TALLY ~ TALLY+63;% 00674600
|
|
SI~SI+1;% 00674700
|
|
P4~TALLY;% 00674800
|
|
COMMENT SKIP BLANKS PAST SIGN (IF ANY) THEN LOOK AT% 00674900
|
|
NEXT NON-BLANK;% 00675000
|
|
P4(IF SC!" " THEN JUMP OUT TO RXITB;% 00675100
|
|
SI~SI+1;% 00675200
|
|
TALLY ~ TALLY + 63);% 00675300
|
|
GO TO RERR;% 00675400
|
|
RIMPLUS: P4 ~ TALLY;% 00675500
|
|
TALLY ~ 0;% 00675600
|
|
RXITA: P3 ~ SI;% 00675700
|
|
P6 ~ TALLY;% 00675800
|
|
END;% 00675900
|
|
BUFF ~ P; COMMENT ADDRESS OF NEXT CHARACTER;% 00676000
|
|
WT ~ P; COMMENT REMAINING FIELD;% 00676100
|
|
SGN ~ P; COMMENT SAVE SIGN;% 00676200
|
|
GO TO P; COMMENT SWITCH ON KEY;% 00676300
|
|
GO TO RIPART; COMMENT KEY = 0 = <SIGN><DIGIT> OR <DIGIT>;00676400
|
|
GO TO RERRA; COMMENT KEY = 2 = ERROR;% 00676500
|
|
GO TO RBLF; COMMENT KEY = 4 = BLANK FIELD;% 00676600
|
|
GO TO RFA; COMMENT KEY = 6 = <SIGN>"." OR ".";% 00676700
|
|
COMMENT FALL THRU FOR KEY = 8 =<SIGN> <EPONENT> OR% 00676800
|
|
~ <EXPONENT>;% 00676900
|
|
JUNK1 1; COMMENT MANTISSA ~ 1;% 00677000
|
|
W1 ~ 0; COMMENT 0 DECIMAL PLACES;% 00677100
|
|
GO TO REXP; COMMENT OUT TO DEVELOP EXPONENT;% 00677200
|
|
COMMENT BLANK FIELD;% 00677300
|
|
RBLF: P(0,SSN); COMMENT SET RESULT TO -0;% 00677400
|
|
GO TO COMB;% 00677500
|
|
COMMENT "." FOUND FIRST;% 00677600
|
|
RFA: JUNK1 ~ 0; COMMENT MANTISSA ~ 0;% 00677700
|
|
FLG ~ 1 ; COMMENT SET FLG TO REMEMBER NO INTEGER% 00677800
|
|
PART;% 00677900
|
|
GO TO RFPART;% 00678000
|
|
COMMENT DIGIT FOUND FIRST;% 00678100
|
|
RIPART: P(1); COMMENT CALL GETNUM TO BUILD OCTAL% 00678200
|
|
INTEGER PART;% 00678300
|
|
GO TO GETNUM;% 00678400
|
|
RIPRTN: IF NOT P THEN GO TO RFC; COMMENT BRANCH ON KEY GETNUM% 00678500
|
|
RETURNS. IF NO BRANCH THEN WE HAVE FIELD EXAUSIED.% 00678600
|
|
I.E. IMPLIED DECIMAL;% 00678700
|
|
W1 ~ D; COMMENT DECIMAL PLACES IN FRACIION;% 00678800
|
|
RDONA: W2 ~ 0; COMMENT NO EXPONENT;% 00678900
|
|
COMMENT BUILD RESULT;% 00679000
|
|
RDONE: P(JUNK1); COMMENT GET NUMBER;% 00679100
|
|
IF SGN THEN P(SSN); COMMENT INSERT SIGN;% 00679200
|
|
COMMENT SCALE NUMBER;% 00679300
|
|
IF P(W2 + SCFTR-W1,DUP) } 0% 00679400
|
|
THEN P(TEN[P],MUL)% 00679500
|
|
ELSE P(TEN[-P],/);% 00679600
|
|
GO TO COMB;% 00679700
|
|
MAXI::: @7777777777777; 00679750
|
|
COMMENT THE FIELD IS NOT EXAUSTED;% 00679800
|
|
RFC: WT ~ WT -1; COMMENT WT-1 TO ACCOUNT FOR CHARACTER% 00679900
|
|
ENDING INTEGER FIELD;% 00680000
|
|
IF W2 = "." THEN GO TO RFPART;% 00680100
|
|
COMMENT OUT FOR VISABLE DECIMAL POINT;% 00680200
|
|
IF WT } D THEN GO TO RERRA;% 00680300
|
|
COMMENT ERROR IF IMPLIED POINT TO RIGHT% 00680400
|
|
OF MANIISSA FIELD;% 00680500
|
|
W1 ~ D-WT-1; COMMENT CALCULAIE DECIMAL POSITION FROM% 00680600
|
|
DECIMAL PLACES AND POSITION OF RIGT MOST% 00680700
|
|
O DIGIT IN MANTISSA;% 00680800
|
|
COMMENT L-OK FOR AND CONVERT ANY EXPONENT FOUND;% 00680900
|
|
REXP: STREAM(% 00681000
|
|
P6 ~ 0, COMMENT PLACE TO RETURN EXPONENT;% 00681100
|
|
P5~WT+1, COMMENT REMAINING FIELD WIDTH;% 00681200
|
|
P4~ BUFF,% 00681300
|
|
P3~1: COMMENT FLAG;% 00681400
|
|
P1~0);% 00681500
|
|
BEGIN COMMENT LOOK FOR E OR @;% 00681600
|
|
SI ~ P4; SI ~ SI -1;% 00681700
|
|
TALLY ~ P5;% 00681800
|
|
P5( IF SC! " " THEN JUMP OUT TO RAA;% 00681900
|
|
SI ~ SI + 1;% 00682000
|
|
TALLY ~ TALLY + 63);COMMENT TALLY - 1 ;% 00682100
|
|
GO TO REXTA; COMMENT OUT IF NO EXPONENT;% 00682200
|
|
RAA: IF SC="E" THEN GO TO RAB;% 00682300
|
|
IF SC="@" THEN GO TO RAB;% 00682400
|
|
RAER:TALLY ~ 0; COMMENT IMPROPER EXPONENT,% 00682500
|
|
P3 ~ TALLY;% 00682600
|
|
GO TO REXTA;% 00682700
|
|
COMMENT LOOK FOR EXPONENT SIGN;% 00682800
|
|
RAB: TALLY ~ TALLY + 63;% 00682900
|
|
SI ~ SI + 1;% 00683000
|
|
IF SC="-" THEN% 00683100
|
|
BEGIN% 00683200
|
|
P5 ~ TALLY;% 00683300
|
|
TALLY ~ 1;% 00683400
|
|
P1 ~ TALLY; COMMENT REMEMBER "-" SIGN;% 00683500
|
|
TALLY ~ P5;% 00683600
|
|
GO TO REP;% 00683700
|
|
END;% 00683800
|
|
IF SC="+" THEN% 00683900
|
|
BEGIN% 00684000
|
|
REP: TALLY ~ TALLY + 63;% 00684100
|
|
P5~TALLY; 00684200
|
|
SI ~ SI + 1; COMMENT SKIP OVER SIGN;% 00684300
|
|
P5(JUMP OUT TO RADC); COMMENT OUT IF FIELD NOT% 00684400
|
|
EXAUSTED (P5!0);% 00684500
|
|
GO TO RAER; COMMENT OUT ON ERROR;% 00684600
|
|
REXTA: GO TO REXT;% 00684700
|
|
RAERA: GO TO RAER;% 00684800
|
|
END;% 00684900
|
|
IF SC="&" THEN GO TO REP;% 00685000
|
|
COMMENT LOOK FOR DIGITS IN EXPONENT;% 00685100
|
|
RADC: IF SC < "0" THEN GO TO RAER;% 00685200
|
|
COMMENT OUT IF NOT DIGIT-ERROR;% 00685300
|
|
TALLY ~ TALLY +63;% 00685400
|
|
P5 ~ TALLY;% 00685500
|
|
COMMENT LOOK FOR 2ND DIGIT;% 00685600
|
|
P5(SI~SI+1;% 00685700
|
|
IF SC}"0" THEN% 00685800
|
|
BEGIN% 00685900
|
|
SI~SI-1;% 00686000
|
|
DI ~ LOC P6;% 00686100
|
|
DS ~ 2 OCT;% 00686200
|
|
TALLY ~ TALLY + 63;% 00686300
|
|
P5 ~ TALLY;% 00686400
|
|
JUMP OUT TO RAIS;% 00686500
|
|
END;% 00686600
|
|
IF SC!" " THEN JUMP OUT TO RAER;% 00686700
|
|
SI ~ SI - 1; JUMP OUT TO RAC);% 00686800
|
|
RAC: DI ~ LOC P6;% 00686900
|
|
DS ~ OCT;% 00687000
|
|
COMMENT PUT IN EXPONENT SIGN SAVED IN P1;% 00687100
|
|
RAIS: P1(DI ~ LOC P6;% 00687200
|
|
DS ~ LIT "+");% 00687300
|
|
P5( IF SC ! " " THEN JUMP OUT TO RAERA;% 00687400
|
|
SI ~ SI + 1);% 00687500
|
|
REXT: P4 ~ SI;% 00687600
|
|
END;% 00687700
|
|
IF NOT P THEN GO TO RERRA; COMMENT OUT ON ERROR;% 00687800
|
|
BUFF ~ P;% 00687900
|
|
P(DEL);% 00688000
|
|
W2 ~P; COMMENT EXPONENT;% 00688100
|
|
GO TO RDONE;% 00688200
|
|
COMMENT WE COME HERE IF A "." IS FOUND IN FIELD;% 00688300
|
|
RFPART: P(JUNK1,[ADDRS],STD);% 00688400
|
|
COMMENT SAVE INTEGER PART IN ADDRS;% 00688500
|
|
IF (JUNK2 ~ WT) { 0 THEN% 00688600
|
|
BEGIN COMMENT "." WAS LAST IN FIELD;% 00688700
|
|
IF FLG THEN GO TO RERRA;% 00688800
|
|
COMMENT ERROR IF ONLY A "." WAS FOUND;% 00688900
|
|
W1 ~ 0; COMMENT INDICATE NO FRACTION PART;% 00689000
|
|
GO TO RDONA;% 00689100
|
|
END;% 00689200
|
|
P(0);% 00689300
|
|
GO TO GETNUM; COMMENT CALL GETNUM TO BUILD FRACTION;% 00689400
|
|
RFPRTN: IF (W1 ~ JUNK2 - WT) = 0 THEN% 00689500
|
|
BEGIN COMMENT FRACTION PART IS BLANK;% 00689600
|
|
IF FLG THEN GO TO RERRA;% 00689700
|
|
COMMENT ERROR IF ONLY "." IN FIELD;% 00689800
|
|
END;% 00689900
|
|
COMMENT DEVELOP NUMBER;% 00690000
|
|
JUNK1 ~ JUNK1 + ADDRS | TEN[W1];% 00690100
|
|
COMMENT INTEGER PART | 10@<DECIMAL PLACES> 00690200
|
|
+ FRACTION PART;% 00690300
|
|
IF P THEN GO TO RDONA;% 00690400
|
|
COMMENT BRANCH ON KEY GETNUM RETURNED.% 00690500
|
|
IF TRUE THEN FIELD EXAUSTED;% 00690600
|
|
WT ~ WT -1; COMMENT WT-1 TO ACCOUNT FOR CHARACTER% 00690700
|
|
ENDING FRACTION PART;% 00690800
|
|
GO TO REXP; COMMENT CHECK FOR EXPONENT;% 00690900
|
|
COMMENT SUB-PROGRAM USED BY R-TYPE;% 00691000
|
|
COMMENT GETNUM BUILDS AN OCTAL INTEGER FROM THE BCL% 00691100
|
|
FOUND IN THE BUFFER;% 00691200
|
|
GETNUM:: P(1); COMMENT FLAG USED AI GRTN;% 00691300
|
|
GRTY: STREAM(% 00691400
|
|
P6~0, COMMENT RETURN CHR ENDING INTEGER;% 00691500
|
|
P5~[D1], COMMENT POINTER TO BCL INTEGER;% 00691600
|
|
P4~(IF WT > 16 THEN 16 ELSE WT),% 00691700
|
|
COMMENT WT = FIELD WIDTH;% 00691800
|
|
P3~BUFF:% 00691900
|
|
P1~ 0);% 00692000
|
|
BEGIN% 00692100
|
|
SI ~ P3;% 00692200
|
|
DI ~ P5;% 00692300
|
|
P4(IF SC < "0" THEN JUMP OUT TO RENDM;% 00692400
|
|
DS ~ CHR;% 00692500
|
|
TALLY ~ TALLY +1);% 00692600
|
|
GO TO RCXIT;% 00692700
|
|
RENDM: DI ~ LOC P5;% 00692800
|
|
DI ~ DI-1;% 00692900
|
|
DS ~ CHR; COMMENT RETURN CHARACIER ENDING% 00693000
|
|
INIEGER FIELD;% 00693100
|
|
RCXIT: P3 ~ SI; COMMENT NEXT BUFF ADDRESS;% 00693200
|
|
P4 ~ TALLY; COMMENT RETURN NUMBER OF DIGITS% 00693300
|
|
IN INTEGER;% 00693400
|
|
END;% 00693500
|
|
BUFF ~ P; COMMENT BUFF ~ P3;% 00693600
|
|
W1 ~ P; COMMENT W1 ~ P4;% 00693700
|
|
P(DEL); COMMENT DELETE P5;% 00693800
|
|
W2 ~ P; COMMENT W2 ~ P6;% 00693900
|
|
GRTN: IF NOT P THEN GO TO GTD; COMMENT BRANCH ON FLAG PUT% 00694000
|
|
IN AT GRIY OR GIC;% 00694100
|
|
STREAM(% 00694200
|
|
P7 ~ P(W1,DUP),% 00694300
|
|
P6 ~ (IF P { 8 THEN 0 ELSE P(8,SUB,8,XCH)),% 00694400
|
|
COMMENT THE ABOVE IS "IF WT { 8 THEN P7~WT,P6~0 00694500
|
|
ELSE P7~8,P6~WT-8";% 00694600
|
|
P5 ~0, COMMENT OCTAL OF RIGHT 8 DIGITS;% 00694700
|
|
P4 ~ 0, COMMENT OCTAL OF WHATS LEFT;% 00694800
|
|
P3 ~ [D1]: COMMENT ADDRESS OF BCL INTEGER;% 00694900
|
|
P1 ~ 0);% 00695000
|
|
BEGIN% 00695100
|
|
SI~ P3;% 00695200
|
|
DI~ LOC P4;% 00695300
|
|
DS~ P6 OCT;% 00695400
|
|
DI~ LOC P5;% 00695500
|
|
DS ~ P7 OCT;% 00695600
|
|
END;% 00695700
|
|
P(DEL); COMMENT DELETE P3;% 00695800
|
|
P(TEN8,MUL,ADD,.JUNK1,STD);% 00695900
|
|
COMMENT JUNK1 ~ P4 | 10*8 + P5;% 00696000
|
|
P(DEL,DEL); COMMENT DELETE P6 & P7;% 00696100
|
|
GTB: IF (WT ~ WT-W1) { 0 THEN% 00696200
|
|
BEGIN COMMENT PASS BACK A KEY OF 1 TO% 00696300
|
|
FLAG FIELD EXAUSTED;% 00696400
|
|
P(1,XCH);% 00696500
|
|
GO TO NUMXIT% 00696600
|
|
END;% 00696700
|
|
COMMENT FIELD NOT EXAUSTED SO LOOK AT WHAT ENDED IT; 00696800
|
|
IF W2 > 9 THEN% 00696900
|
|
BEGIN COMMENT MANTISSA EXAUSTED BUT NOT FIELD% 00697000
|
|
SO RETURN A FLAG OF 0;% 00697100
|
|
P(0,XCH);% 00697200
|
|
GO TO NUMXIT;% 00697300
|
|
END;% 00697400
|
|
GTC: P(0); GO TO GRTY; COMMENT MANTISSA NOT EXAUSTED,% 00697500
|
|
SCALE NUMBER LEFT UNTIL IT IS;% 00697600
|
|
GTD: JUNK1 ~ JUNK1 | TEN[W1];% 00697700
|
|
GO TO GTB;% 00697800
|
|
NUMXIT: IF P THEN GO TO RIPRTN ELSE GO TO RFPRTN;% 00697900
|
|
COMMENT DATA ERROR READING R FORMAT;% 00698000
|
|
RERRA: IF FILX.[18:15]>1 THEN 00698100
|
|
BEGIN PARL~FILX[NOT 3]; FILX[NOT 3]~FILX[NOT 4]~0 END 00698150
|
|
ELSE BEGIN 00698200
|
|
IF FILX.[18:15]=1 THEN P(FILX,14,COM); PARL~0; FILX~*2 ;00698300
|
|
END ; 00698400
|
|
IF PARL = 0 THEN P(FILX.[33:15],7,11,COM) 00698500
|
|
ELSE P(PARL,MKS,9,BLKCNTL);% 00698600
|
|
COMMENT IF NO PARITY ACTION LABEL PRINT "RER"% 00698700
|
|
ERROR AND TERMINATE ELSE GO TO PARITY% 00698800
|
|
LABEL;% 00698900
|
|
END INPUTINT;% 00699000
|
|
PROCEDURE DISKSORT( 00700000
|
|
T1,T2,RELA, 00700100
|
|
ENDQ,BINGO,IPFIDX,OUTPRO,INPRO,OUTF,INF, 00700200
|
|
OPTOG,IPTOG,DKO,DKI,TP1,TP2,TP3,TP4,TP5,NT, 00700300
|
|
HIVALU,EQUALS,R,ALFA,CORESIZE,DISKSIZE); 00700400
|
|
COMMENT DISK-SORT BY L.R. GUCK DATE 9/19/1965 ; 00700500
|
|
VALUE OPTOG,IPTOG,NT,HIVALU,EQUALS,R,ALFA, 00700600
|
|
CORESIZE,DISKSIZE; 00700700
|
|
REAL ENDQ, 00700800
|
|
BINGO, 00700900
|
|
IPFIDX, 00701000
|
|
OUTPRO, 00701100
|
|
INPRO, 00701200
|
|
OUTF, % POINTER TO DESC WHICH DESCRIBES OUT AREA 00701300
|
|
T1, 00701400
|
|
T2, 00701500
|
|
RELA, 00701600
|
|
INF; % POINTER TO DESC WHICH DESCRIBES INPUT AREA 00701700
|
|
BOOLEAN OPTOG, % TRUE IF OUTPUT PROCEDURE 00701800
|
|
IPTOG; % TRUE IF INPUT PROCEDURE 00701900
|
|
REAL DKO, % DISK OUTPUT FILE 00702000
|
|
DKI; % DISK INPUT FILE 00702100
|
|
NAME TP1,TP2,TP3,TP4,TP5; % SCRATCH TAPES 00702200
|
|
REAL NT, % FOR FURTURE USE 00702300
|
|
HIVALU, 00702400
|
|
EQUALS; % KEY COMPARE ROUTINE 00702500
|
|
INTEGER R; % RECORD: <0 FOR ALGOL 00702600
|
|
BOOLEAN ALFA; % TRUE FOR ALPHA KEYS 00702700
|
|
REAL CORESIZE; % CORE STORAGE AVAILABLE 00702800
|
|
INTEGER DISKSIZE; % DISK STORAGE AVAILABLE 00702900
|
|
BEGIN 00703000
|
|
LABEL GRA,RTNRD,WRTBLOC,RTNDW,SA,RTNDR, 00703100
|
|
IPB,IPBA,IPC,IPD,IPE,IPG, 00703200
|
|
MIC,MID,MIE,RTA, 00703300
|
|
START,LY,LZ,LX,CALLSORT,ENDSORTPASS, 00703400
|
|
DKC,DKD,DKE,DKF, 00703500
|
|
TPA,TPB,TPC,WRAPUP,SORTDONE; 00703600
|
|
COMMENT GENERAL PARAMETERS; 00703700
|
|
REAL S, % MATRIX SIZE FOR SORT PASS 00703800
|
|
M, % MATRIX SIZE FOR MERGE PASS 00703900
|
|
MS, % CURRENT MATRIX SIZE 00704000
|
|
STPP, % INDEX OF LAST ADDRESS IN VECTOR (V) ARRAY 00704100
|
|
D, % SEGMENTS PER DISK INPUT BLOCK 00704200
|
|
OD, % SEGMENTS PER DISK OUTPUT BLOCK 00704300
|
|
BF, % RECORDS PER DISK INPUT BLOCK 00704400
|
|
TBO, % RECORDS PER DISK OUTPUT BLOCK & TAPE BLOCKING 00704500
|
|
I,X,Y; % TEMPORARY STORAGE 00704600
|
|
ARRAY DATA[*,*]; ARRAY DATX = DATA[*]; NAME DATN = DATA; 00704700
|
|
ARRAY V[*]; NAME VN = V; 00704800
|
|
DEFINE VX1=FLAG(V[X+1])#, VX=FLAG(V[X])#, VL=FLAG(V[VLOW])#; 00704900
|
|
DEFINE VA1 = FLAG(V[X+1 ]&P(0,RDS)[CTF])#, 00704910
|
|
VA = FLAG(V[X ]&P(0,RDS)[CTF])#, 00704920
|
|
XAL= *[INFIL],0,RDS,CFX#, 00704925
|
|
VAL = FLAG(V[VLOW]&P(0,RDS)[CTF])#; 00704930
|
|
REAL VLOW; % INDEX OF NEXT RECORD IN SEQUENCE 00705000
|
|
ARRAY MHK[*]; % HIGH KEY FOR MERGE PHASE 00705100
|
|
NAME MHN=MHK; 00705200
|
|
BOOLEAN MOREDATA, % GOES FALSE WHEN NO MORE INPUT DATA 00705300
|
|
FM, % TRUE ON LAST MERGE PASS 00705400
|
|
EOF, % TRUE WHEN INPUT FILE EXAUSTED 00705500
|
|
TM, % TRUE FOR SORT WITH BACK-UP TAPES 00705600
|
|
MF=T1, % TRUE IF MERGE ONLY 00705700
|
|
DF=IPTOG, % TRUE IF OUTPUT FILE IS A DISK 00705800
|
|
DISKFULL; % TRUE WHEN ASSIGNED DISK SPACE IS FULL 00705900
|
|
REAL TR; % # OF RECORDS OF DATA SAVED ON DISK 00706000
|
|
DEFINE IOC = @2000000000#, 00706100
|
|
POLYMERGE = PRTBASE[RELA] ~ P(DUP,LOD)&1[6:47:1]#; 00706200
|
|
COMMENT PARAMETERS RELATED TO PROGRAMMERS FILES; 00706300
|
|
NAME INFIL = INF; % POINTER TO TOP I/O DESC. 00706400
|
|
NAME WAIN = IPFIDX; % COBOL68 INFILE WORK AREA 00706420
|
|
NAME OUTFIL = OUTF; 00706500
|
|
NAME WAOUT = T2; % COBOL68 OUTFILE WORK AREA 00706520
|
|
ARRAY PRFIB[*]; % CONTAINS TAPE FILES FIB 00706600
|
|
REAL AC; % TRUE FOR COBOL INPUT FILE 00706700
|
|
REAL INCOUNT, % COUNTS # OF RECORDS FROM INPUT FILE 00706800
|
|
OUTCOUNT; % COUNTS # OF RECORDS WRITTEN ON OUTPUT FILE 00706900
|
|
COMMENT POINTERS FOR STANDARD PROCEDURES; 00707000
|
|
NAME MEM = 2; 00707100
|
|
ARRAY FPB = 3[*]; 00707110
|
|
REAL BLOCK = 5, 00707200
|
|
ALWR = 12, 00707300
|
|
ALRD = 13, 00707400
|
|
COFCR = 12, 00707500
|
|
PERFORMGEN = 13, % COBOL68 IN-OUT PROCEDURES 00707510
|
|
CORW = 14, 00707600
|
|
ALFCR = 14, 00707700
|
|
BLKCTR = 16; 00707800
|
|
ARRAY PRTBASE = 10[*]; 00707900
|
|
COMMENT PARAMETERS RELATED TO DISK OUTPUT FILE; 00708000
|
|
NAME DOTOP = DKO; % POINTER TO DISK OUTPUT I/O DESC. 00708100
|
|
ARRAY OUTFIB[*]; % POINTER TO FIB 00708200
|
|
ARRAY OUTHEAD[*]; % POINTER TO FILE HEADER BLOCK 00708300
|
|
REAL LOSA, % DISK ADDRESS OF CURRENT STRING TAG WORD 00708400
|
|
ONS, % RUNNING COUNT OF STRINGS IN OUTPUT AREA 00708500
|
|
ORC, % RUNNING COUNT OF RECORDS IN STRING 00708600
|
|
OCDA, % DISK ADDRESS OF NEXT AVAILABLE OUTPUT AREA 00708700
|
|
ORL, % RUNNING COUNT OF NUMBER OF SEGMENTS LEFY IN 00708800
|
|
% CURRENT ROW 00708900
|
|
ORI, % CURRENT ROW BEING USED 00709000
|
|
SRI, % ROW WHERE STRING STARTED 00709100
|
|
SRS, % NUMBER OF SEGMENTS OF STRING IN ROW SRI 00709200
|
|
OBC; % CURRENT # OF RECORDS IN OUTPUT BUFFER 00709300
|
|
DEFINE ORS= OUTHEAD[8]#; 00709400
|
|
DEFINE FNUM = OUTFIB[4].[13:11]#; 00709410
|
|
COMMENT PARAMETFRS FOR DISK INPUT FILE; 00709500
|
|
ARRAY ITNK = DKI[*]; % POINTER TO INPUT TANK 00709600
|
|
ARRAY INFIB[*], % POINTER TO FIB 00709700
|
|
INHEAD[*]; % POINTER TO FILE HEADER BLOCK 00709800
|
|
ARRAY BASE[*], % POINTER TO CONTROL INFO IN DATA 00709900
|
|
ITOP[*], % POINTER TO TOP I/O DESC 00710000
|
|
BUFF[*] ; % I/O DESCRIPTOR 00710100
|
|
REAL LISA; % HOLDS TAG ADDRESS FOR NEXT MERGE PASS 00710200
|
|
DEFINE IBC = BASE[0]#, % RECORDS LEFT IN BLOCK 00710300
|
|
IRL = BASE[1]#, % RECORDS LEFT IN STRING 00710400
|
|
ISL = BASE[2]#, % BLOCKS LEFT IN ROW 00710500
|
|
IDA = BASE[3]#, % DISK ADDRESS OF NEXT BLOCK 00710600
|
|
IRC = BASE[4]#, % CURRENT ROW OF THIS STRING 00710700
|
|
FCR = IF AC THEN COFCR ELSE ALFCR#; 00710800
|
|
COMMENT PARAMFTERS RELATED TO MERGE TAPES; 00710900
|
|
INTEGER CTRL; % CURRENT CONTROL TAPE 00711000
|
|
INTEGER COT; % CURRENT OUTPUT TAPE 00711100
|
|
NAME COIOD; % LOC OF I/O D OF CURRENT OUTPUT TAPE 00711200
|
|
NAME TP; % BASE POINTER OF MERGE TAPES 00711300
|
|
ARRAY TS[*]; % ARRAYS FOR CONTROLLING DISTRIBUTION 00711400
|
|
ARRAY TC[*]; % PATTERNS ON MERGE TAPES 00711500
|
|
ARRAY TN[*]; 00711600
|
|
NAME TSN=TS; NAME TCN=TC; NAME TNN=TN; 00711700
|
|
REAL TM1=CORESIZE; % TAPES - 1 00711800
|
|
NAME CIIOD; % LOC OF I/O D FOR CURRENT INPUT TAPE 00711900
|
|
%**********************************% 00712000
|
|
SUBROUTINE WAIT; COMMENT WAIT FOR I/O COMPLETE USING ADRRESS 00712100
|
|
ON TOP OF STACK; 00712200
|
|
$ SET OMIT = NOT(TIMESHARING) 00712250
|
|
BEGIN IF NOT (P(XCH,DUP,LOD)).[19:1] THEN P(IOC,36,COM,DEL); 00712252
|
|
$ POP OMIT 00712253
|
|
$ SET OMIT = TIMESHARING 00712299
|
|
IF NOT P(LOD,DUP).[2:1] THEN % CHECK FOR ERRORS 00712340
|
|
IF NOT (P(DUP,DUP).[27:1] AND P(XCH).[7:1]) THEN 00712350
|
|
P(1,XCH, MEM[P INX NOT 1] INX P(2,LNG,XCH), 72, 17, COM); 00712360
|
|
P(DEL); END WAIT; 00712400
|
|
%***************MM*****************% 00712500
|
|
SUBROUTINE RELEASETAPE; % CALLS MCP TO WRITE OUT BUFFERS 00712600
|
|
BEGIN 00712700
|
|
PRFIB[11] ~ TBO; 00712800
|
|
P(COIOD[0] ~ FLAG(PRFIB[16]),COIOD,PRL,DEL); 00712900
|
|
RTA: P(COIOD); WAIT; 00713000
|
|
IF (*COIOD).[27:1] THEN % REEL SWITCH 00713100
|
|
BEGIN 00713200
|
|
P(MKS,0,0,[COIOD[NOT 2]],6,FCR); 00713300
|
|
GO TO RTA; 00713400
|
|
END; 00713500
|
|
COIOD[0] ~ 1 INX FLAG(PRFIB[16] ~ NFLAG(*COIOD)); 00713600
|
|
END RELEASETAPE; 00713700
|
|
SUBROUTINE TAPEWRITE; % BLOCKS OUTPUT TAPES 00713800
|
|
BEGIN 00713900
|
|
PRFIB ~ *[COIOD[NOT 2]]; 00714000
|
|
PRFIB[9] ~ PRFIB[9] + 1; % RECORD COUNTER + 1 00714100
|
|
IF (PRFIB[11] ~ PRFIB[11] - 1) > 0 THEN % BLOCK COUNTER 00714200
|
|
COIOD[0] ~ R INX *COIOD 00714300
|
|
ELSE 00714400
|
|
BEGIN % TIME FOR RELEASE 00714500
|
|
P(0,PRFIB[16] INX MEM,STD); % ZERO CONTROL WORD IN BUFF[2] 00714600
|
|
RELEASETAPE; 00714700
|
|
END; 00714800
|
|
END TAPEWRITE; 00714900
|
|
SUBROUTINE WRITESTOPPER; 00715000
|
|
BEGIN % WRITES END OF STRING OR DUMMY STRINGS 00715100
|
|
PRFIB ~ *[COIOD[NOT 2]]; 00715200
|
|
X ~ PRFIB[9]&(TBO-PRFIB[11])[18:33:15]&("DS")[3:33:15]; 00715300
|
|
P(X,PRFIB[16] INX MEM,STD); 00715400
|
|
TN[COT] ~ TN[COT] + 1; % COUNT UP STRINGS FOR THIS IAPE 00715500
|
|
RELEASETAPE; 00715600
|
|
PRFIB [9] ~ 0 ; % ZERO OUT STRING CTR 00715610
|
|
END WRITESTOPPER; 00715700
|
|
%**********************************% 00715800
|
|
SUBROUTINE OPENOUT; % OPENS PROGRAMMERS OUTPUT TAPE 00715900
|
|
BEGIN 00716000
|
|
IF OPTOG THEN 00716100
|
|
BEGIN P(MKS,[OUTFIL],R,1,1,1,BLOCK); 00716200
|
|
IF AC THEN 00716300
|
|
BEGIN BINGO ~ OUTPRO; ENDQ ~ 0; 00716400
|
|
IF AC.[46:1] THEN % COBOL68 00716430
|
|
BEGIN P(MKS,BINGO,0,PERFORMGEN); 00716440
|
|
COIOD ~ [WAOUT]; 00716445
|
|
WAOUT ~ P(*[OUTFIL],0,CDC); 00716450
|
|
END ELSE 00716460
|
|
P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,CDC); 00716500
|
|
END END ELSE 00716600
|
|
BEGIN DF ~ FALSE; PRFIB ~ OUTFIL[NOT 2]; 00716700
|
|
PRFIB[13].[27:1] ~ 0; 00716800
|
|
IF AC THEN 00716900
|
|
BEGIN 00717000
|
|
P(MKS,[OUTFIL[NOT 2]],3,COFCR); 00717100
|
|
DF ~ PRFIB[4].[8:4] = 4; 00717200
|
|
IF AC.[46:1] THEN % COBOL68 00717240
|
|
BEGIN COIOD ~ [WAOUT]; 00717250
|
|
WAOUT ~ P(PRFIB[20].[FF],DUP,DIB 0,LOD,0, 00717260
|
|
CDC,DEL,DIB 0,LOD); 00717270
|
|
END; 00717280
|
|
END 00717300
|
|
ELSE BEGIN P([OUTFIL],0,11,COM,DEL,DEL); 00717400
|
|
P(MKS,1,0,0,(-R),[OUTFIL],ALWR,DEL); END; 00717500
|
|
END 00717600
|
|
END OPENOUT; 00717700
|
|
%**********************************% 00717800
|
|
SUBROUTINE SETUPTAPES; % INITIALIZES TAPES FOR DISTRIBUTION PASS 00717900
|
|
BEGIN 00718000
|
|
FOR I ~ 0 STEP 1 UNTIL NT DO TS[I] ~ TC[I] ~ TN[I] ~ 0; 00718100
|
|
CTRL ~ 0; TC[1] ~ COT ~ 1; TM1 ~ NT-1; 00718200
|
|
TP ~ ((NOT 5) INX [NT]); X ~ TBO|R+1; 00718300
|
|
FOR I ~ 1 STEP 1 UNTIL NT DO 00718400
|
|
BEGIN 00718500
|
|
COIOD ~ TP[I]; PRFIB ~ *[COIOD[NOT 2]]; 00718600
|
|
PRFIB[18] ~ X&X[3:33:15]&X[18:33:15]&(I!1)[1:47:1]; 00718700
|
|
PRFIB[13].[27:1] ~ 0; % SEI TO OUTPUT 00718800
|
|
PRFIB[4].[7:1] ~ ((AC AND 3) = 1); %COBOL61 TAPE SORT FLG 00718900
|
|
PRFIB[9] ~ 0; PRFIB[11] ~ TBO; 00719000
|
|
IF (Y~PRFIB[4].[12:12]) < 1023 THEN 00719100
|
|
PRFIB[4] ~ PRFIB[4]&((Y-1)|ETRLNG)[13:37:11]&1[12:47:1]; 00719200
|
|
IF I ! NT THEN P([COIOD],0,11,COM,DEL,DEL) % OPEN TAPES 00719300
|
|
ELSE PRFIB[18] ~ ABS(PRFIB[18]); 00719400
|
|
IF I ! NT THEN BEGIN P(COIOD); WAIT; END; 00719500
|
|
IF I = 1 THEN COIOD[0] ~ 1 INX *COIOD; 00719600
|
|
END; 00719700
|
|
COIOD ~ TP[COT] ; 00719800
|
|
END SETUPTAPES; 00719900
|
|
%**********************************% 00720000
|
|
SUBROUTINE GETROW; % GETS DISK SPACE FOR NEXT ROW IN OUTPUT AREA 00720100
|
|
BEGIN ORL ~ ORS; 00720200
|
|
IF (ORI ~ ORI + 1) } 30 THEN % DISK SCRATCH FILE IS FULL 00720300
|
|
BEGIN 00720400
|
|
GRA: IF NT < 3 THEN P(1,[DOTOP[NOT 2]],84,17,COM); 00720500
|
|
IF NOT TM THEN SETUPTAPES; 00720600
|
|
TM ~ DISKFULL ~ TRUE; 00720700
|
|
END 00720800
|
|
ELSE 00720900
|
|
IF (OCDA ~ OUTHEAD[ORI]) = 0 THEN % GET DISK SPACE 00721000
|
|
BEGIN 00721100
|
|
P(FPB[FNUM+3],FPB[FNUM],FPB[FNUM+1],ORI, 00721110
|
|
.OUTHEAD,LOD,4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL); 00721120
|
|
IF (OCDA ~ OUTHEAD[ORI]) = 0 THEN GO TO GRA; % NO DISK 00721200
|
|
END 00721300
|
|
END GETROW; 00721400
|
|
SUBROUTINE FORGETDISK; % RETURNS DISK NO LONGER NEEDED 00721500
|
|
BEGIN 00721600
|
|
PRFIB ~ P(XCH); I ~ 9; 00721700
|
|
WHILE (I~I+1) { 29 DO IF PRFIB[I] ! 0 00721800
|
|
THEN P(I ,.PRFIB,LOD,24,COM,DEL,DEL); 00721900
|
|
END FORGETDISK; 00722000
|
|
%XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX% 00722100
|
|
SUBROUTINE INROWCHK; 00722200
|
|
BEGIN 00722300
|
|
IF (ISL ~ ISL - 1) { 0 THEN 00722400
|
|
BEGIN 00722500
|
|
ISL ~ (ORS DIV OD ) | (OD DIV D); % BLOCKS IN ROW 00722600
|
|
IF INHEAD[(IRC ~ IRC + (IRC < 29))] ! 0 00722700
|
|
THEN IDA ~ INHEAD[IRC]; 00722800
|
|
END 00722900
|
|
ELSE IDA ~ IDA + D; 00723000
|
|
END; 00723100
|
|
%**********************************% 00723200
|
|
SUBROUTINE INREAD; COMMENT POINT INPUT BUFFER AT NEXT RECORD; 00723300
|
|
BEGIN 00723400
|
|
IF EOF THEN GO TO RTNRD; 00723500
|
|
INCOUNT ~ INCOUNT + 1; 00723600
|
|
IF IPTOG THEN 00723700
|
|
BEGIN IF AC THEN 00723800
|
|
BEGIN COMMENT CALL INPUT PROCEDURE; 00723900
|
|
IF AC.[46:1] THEN P(MKS,BINGO,0,PERFORMGEN) ELSE 00723980
|
|
P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,COC); 00724000
|
|
EOF ~ ENDQ; 00724100
|
|
END ELSE EOF ~ P(MKS,*[INFIL],0,INPRO); 00724200
|
|
END 00724300
|
|
ELSE 00724400
|
|
BEGIN 00724500
|
|
IF AC THEN EOF ~ P(MKS,R,[INFIL],0,CORW) % COBOL 00724600
|
|
ELSE 00724700
|
|
BEGIN COMMENT ALGOL READ; 00724800
|
|
P(MKS,0,0,[INFIL],ALRD); % READ FILE 00724900
|
|
EOF ~ P(MKS,0,3,[INFIL],ALRD) < 0; % WAIT FOR I/O 00725000
|
|
END; 00725100
|
|
END; 00725200
|
|
RTNRD: IF EOF THEN V[VLOW] ~ NFLAG(*[DATX[S]])& 00725300
|
|
S[18:33:15]&1[5:47:1]; 00725400
|
|
END INREAD; 00725500
|
|
%**********************************% 00725600
|
|
SUBROUTINE DISKWRITE; COMMENT BLOCKS OUTPUT BUFFER AND WRITES IT; 00725700
|
|
BEGIN 00725800
|
|
IF NOT P(XCH) THEN GO TO WRTBLOC; % WRITE BLOCK IF TOS = FALSE00725900
|
|
ORC ~ ORC+1; % RECORD COUNT +1; 00726000
|
|
IF (OBC ~ OBC-1) = 0 THEN % IF BUFFER EXAUSTED 00726100
|
|
BEGIN COMMENT BUFFER IS FULL SO WRITE IT OUT; 00726200
|
|
WRTBLOC: OBC ~ TBO; 00726300
|
|
STREAM(P1~OCDA, 00726400
|
|
P2~FLAG(OUTFIB[16])); % DISK ADDRESS TO BUFFER 00726500
|
|
BEGIN SI~LOC P1; DS ~ 8 DEC END; 00726600
|
|
P(1 INX FLAG(OUTFIB[16]),[DOTOP],DUP,OUTFIB[16],SFB,XCH, 00726700
|
|
STD,PRL,DEL); % CALL MCP TO REFILL BUFFER 00726800
|
|
IF (ORL~ORL-OD) } OD THEN 00726900
|
|
OCDA ~OCDA+OD 00727000
|
|
ELSE 00727100
|
|
GETROW; % GET SPACE AND ADDRESS OF NEXT ROW 00727200
|
|
P([DOTOP]); WAIT; % WAIT FOR I/O COMPLETE 00727300
|
|
COMMENT ON I/O COMPLETE SAVE ORGINIAL I/O DESC. IN FIB; 00727400
|
|
OUTFIB[16].[33:15] ~ (NOT 0) INX NFLAG(*[DOTOP]); 00727500
|
|
END 00727600
|
|
ELSE 00727700
|
|
DOTOP[0] ~ R INX *[DOTOP]; % POINT AT NEXT RECORD 00727800
|
|
RTNDW: 00727900
|
|
END DISKWRITE; 00728000
|
|
%**********************************% 00728100
|
|
SUBROUTINE DIST; % CALCULATES DISTRIBUTION PATTERNS FOR 00728200
|
|
BEGIN % MERGE TAPES 00728300
|
|
CTRL ~ (CTRL MOD TM1) + 1; 00728400
|
|
FOR I ~ 1 STEP 1 UNTIL TM1 DO 00728500
|
|
BEGIN TS[I] ~ TC[I]; 00728600
|
|
IF I ! CTRL THEN TC[I] ~ TC[I] + TC[CTRL]; 00728700
|
|
END; 00728800
|
|
END DIST; 00728900
|
|
SUBROUTINE SELECT; % SELECTS A MERGE TAPE TO WRITE A STRING ON00729000
|
|
BEGIN 00729100
|
|
X ~ COT; % SAVE INDEX OF PRIOR TAPE 00729200
|
|
SA: COT ~ COT + 1; 00729300
|
|
IF COT = NT THEN 00729400
|
|
BEGIN COT ~ 1; DIST; END; 00729500
|
|
IF COT = CTRL THEN GO TO SA; 00729600
|
|
PRFIB ~ COIOD[NOT 2]; 00729700
|
|
COIOD[0] ~ FLAG(PRFIB[16]); 00729800
|
|
IF COT ! X THEN P( ((NOT 2) INX TP[COT]) ,[COIOD[NOT 2]], 00729900
|
|
20,COM,DEL,DEL); 00730000
|
|
COIOD ~ TP[COT] ; 00730100
|
|
COIOD[0] ~ 1 INX *COIOD; 00730200
|
|
END SELECT; 00730300
|
|
%**********************************% 00730400
|
|
SUBROUTINE WRITETAG; % WRITE FRONT OF STRING TAG,00730500
|
|
BEGIN % DEVELOP ADDRESS OF NEXT 00730600
|
|
IF OBC ! TBO THEN % STRING 00730700
|
|
BEGIN P(0); DISKWRITE; END; % WRITE OUT BUFFER 00730800
|
|
BUFF ~ FLAG(OUTFIB[16]) 00730900
|
|
&30[8:38:10] % SET TOP I/O DESCRIPTOR TO 00731000
|
|
&1[27:42:6]; % 30 WORD, 1 SEGMENT WRITE. 00731100
|
|
STREAM(P1~LOSA,P2~ [BUFF[0]]); % DISK ADDRESS OF TAG TO 00731200
|
|
BEGIN SI ~LOC P1; DS ~ 8 DEC END; % BUFFER[0]. 00731300
|
|
IF NOT DISKFULL THEN 00731400
|
|
IF ORL < OD + 1 THEN GETROW; % GET SPACE FOR NEXT ROW 00731500
|
|
BUFF[1] ~ SRI; % ROW WHERE STRING STSRIED 00731600
|
|
BUFF[2] ~ ORC; % RECORDS/STRING. 00731700
|
|
BUFF[3] ~ SRS; % AMOUNT OF STRING IN 00731800
|
|
% ROW WHERE STRING STARTED. 00731900
|
|
BUFF[4] ~ LOSA ~ IF MOREDATA % ADDRESS OF NEXT TAG. 00732000
|
|
AND NOT DISKFULL THEN OCDA ELSE 0; % OR EOF FLAG 00732100
|
|
OCDA ~ OCDA + 1; % SKIP OVER TAG ADDRESS. 00732200
|
|
DOTOP[0] ~ P(.BUFF,LOD); % WRITE TAG ON DISK 00732300
|
|
P(1 INX FLAG(OUTFIB[16]),[DOTOP],PRL,DEL); 00732400
|
|
ONS ~ ONS+1; % STRING COUNTER + 1. 00732500
|
|
SRI ~ ORI; % SAVE WHERE NEXT ROW STARTS00732600
|
|
SRS ~ (ORL~ORL-1); % AMOUNT OF ROW LEFT 00732700
|
|
ORC ~ 0; % RECORDS/STRING ~ 0. 00732800
|
|
P([DOTOP]); WAIT; % WAIT FOR I/O COMPLETE 00732900
|
|
OUTFIB[16] ~ (NOT 0) INX NFLAG(*[DOTOP]); % SAVE IOD IN FIB 00733000
|
|
END WRITETAG; 00733100
|
|
%**********************************% 00733200
|
|
SUBROUTINE DISKREAD; % READS DISK ON DISK-TO- 00733300
|
|
BEGIN % DISK MERGE PASSES. 00733400
|
|
BASE ~ *[DATX[VLOW]]; % POINT AT CURRENT STRING 00733500
|
|
IF IRL { 0 THEN % IF IRL { 0,ALL RECORDS 00733600
|
|
BEGIN V[VLOW] ~ NFLAG(MHK)&MS % IN THIS STRING HAVE BEEN 00733700
|
|
[18:33:15]; 00733800
|
|
GO TO RTNDR; % READ SO POINT CORRESPON- 00733900
|
|
END; % ING V AT HK1. 00734000
|
|
IRL~IRL-1; % RECORDS LEFT - 1. 00734100
|
|
IF (IBC~IBC-1)!0 THEN BEGIN % IF BUFFER NOT EXAUSTED 00734200
|
|
V[VLOW] ~ R INX V[VLOW]; % THEN INDEX TO NEXT RECORD 00734300
|
|
GO TO RTNDR END; 00734400
|
|
IBC ~ BF; % BLOCK COUNTER ~ BLOCKING 00734500
|
|
Y ~ P(VLOW,DUP,ADD); % FACTOR. 00734600
|
|
STREAM(P1~IDA,P2~*[ITOP[Y]]); % CONVERI DISK ADDRESS 00734700
|
|
BEGIN SI ~ LOC P1;DS~8 DEC END; % INTO BUFFER. 00734800
|
|
P([ITOP[Y]],DUP,LOD,XCH,PRL,DEL); % READ NEXT BLOCK 00734900
|
|
INROWCHK; % GET ADDRESS OF NEXT BLOCK 00735000
|
|
P([ITOP[Y]]); WAIT; % WAIT FOR I/O COMPLEIE. 00735100
|
|
COMMENT POINT I/O D PAST DISK ADDRESS; 00735400
|
|
V[VLOW] ~ V[VLOW]&(1 INX (*[ITOP[Y]]))[33:33:15]; 00735500
|
|
RTNDR: END DISK READ; 00735600
|
|
%**********************************% 00735700
|
|
SUBROUTINE WRITEOUT; 00735800
|
|
BEGIN % SELECTS FILE TO BE WRITTEN DURING MERGE 00735900
|
|
IF NOT FM THEN 00736000
|
|
IF TM THEN TAPEWRITE ELSE BEGIN P(1); DISKWRITE END 00736100
|
|
ELSE 00736200
|
|
BEGIN COMMENT CALL OUTPUT PROCEDURE OR WRITE INTRINSIC; 00736300
|
|
OUTCOUNT ~ OUTCOUNT +1; 00736400
|
|
IF OPTOG THEN 00736500
|
|
BEGIN 00736600
|
|
IF AC THEN 00736700
|
|
BEGIN ENDQ ~ 0; IF AC.[46:1] THEN 00736800
|
|
P(MKS,BINGO,0,PERFORMGEN) % COBOL68 00736850
|
|
ELSE P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,COC) 00736900
|
|
END ELSE P(MKS,0,*[OUTFIL],0,OUTPRO); 00737000
|
|
END 00737100
|
|
ELSE 00737200
|
|
BEGIN COMMENT OUTPUT FILE RATHER THAN OUTPUT PROCEDURE; 00737300
|
|
IF AC THEN P(MKS,0,1,1,0,R,[OUTFIL],1,CORW) 00737400
|
|
ELSE BEGIN 00737500
|
|
P(MKS,1,0,0,R,[OUTFIL],ALWR); 00737600
|
|
P(MKS,1,0,0,(-R),[OUTFIL],ALWR,DEL); END; 00737700
|
|
IF DF THEN IF P THEN P(1,[OUTFIL[NOT 2]],83,17,COM); 00737800
|
|
END; 00737900
|
|
END; 00738000
|
|
END WRITEOUT; 00738100
|
|
%**********************************% 00738200
|
|
SUBROUTINE SUBMERGE; % SETS UP DISK INPUT TO START A MERGE PASS 00738300
|
|
BEGIN 00738400
|
|
FOR I ~ 0 STEP 1 UNTIL (MS-1) DO 00738500
|
|
BEGIN 00738600
|
|
IF EOF THEN BEGIN 00738700
|
|
V[I] ~ NFLAG(MHK)&MS[18:33:15]; 00738800
|
|
P(0,*[DATX[I]],1,CDC,STD); % IRL ~ 0 00738900
|
|
END 00739000
|
|
ELSE 00739100
|
|
BEGIN 00739200
|
|
BASE ~ *[DATX[I]]; % POINT AT CONTROL INFO 00739300
|
|
Y ~ P(I,DUP,ADD); % Y ~ 2|I 00739400
|
|
BUFF ~ *[ITOP[Y]]; 00739500
|
|
COMMENT SET I/O D = 30 WORD, 1 SEGMENT READ; 00739600
|
|
ITOP[Y] ~ (*[ITOP[Y]])&30[8:38:10]&1[27:42:6]; 00739700
|
|
COMMENT PUT ADDRESS OF STRING TAG WORD IN BUFFER(0); 00739800
|
|
STREAM(P1~( IDA~LISA),P2~*[ITOP[Y]]); 00739900
|
|
BEGIN SI ~ LOC P1; DS ~ 8 DEC END; 00740000
|
|
P(.BUFF,LOD, [ITOP[Y]],PRL,DEL); % READ IAG TO BUFFER 2 00740100
|
|
COMMENT READ 1ST DATA RECORD TO BUFFER #2, TAG GETS 00740200
|
|
ROTATED TO BUFFER #1; 00740300
|
|
P([ITOP[Y]]); WAIT; % WAIT FOR I/O COMPLLTE 00740400
|
|
STREAM(P1~( IDA~IDA +1),P2~*[ITOP[Y]]); % BLOCK #1 ADDRESS00740500
|
|
BEGIN SI ~ LOC P1; DS ~ 8 DEC END; 00740600
|
|
P(*[ITOP[Y]],[ITOP[Y]],PRL,DEL); % READ BLOCK #1 00740700
|
|
P([ITOP[Y]]); WAIT; % WAII FOR I/O ON READING TAG 00740800
|
|
BUFF ~ *[ITOP[Y]]; 00740900
|
|
IBC ~ BF; 00741000
|
|
IRC ~ BUFF[1]; 00741100
|
|
IRL ~ BUFF[2] - 1; 00741200
|
|
ISL ~ (BUFF[3] DIV OD) | (OD DIV D); 00741300
|
|
IF (LISA ~ BUFF[4]) { 0 THEN EOF ~ TRUE; 00741400
|
|
INROWCHK; % GET ADDRESS OF BLOCK #2 00741500
|
|
STREAM(P1~IDA ,P2~[BUFF[0]]); 00741600
|
|
BEGIN SI~LOC P1; DS ~ 8 DEC END; 00741700
|
|
P(.BUFF,LOD,[ITOP[Y]],PRL,DEL); % READ BLOCK #2 00741800
|
|
INROWCHK; % GET ADDRESS OF BLOCK #3 00741900
|
|
P([ITOP[Y]]); WAIT; % WAIT FOR I/O COMPLETE ON BLOCK #1 00742000
|
|
V[I] ~ NFLAG((1 INX *[ITOP[Y]])&I[18:33:15]); 00742100
|
|
END; 00742200
|
|
END; 00742300
|
|
END SUBMERGE; 00742400
|
|
%**********************************% 00742500
|
|
SUBROUTINE FIRSTSELECT; % INITIAL SELECTION OF LOW RECORD 00742600
|
|
BEGIN 00742700
|
|
X ~ 0; I~MS-1; 00742800
|
|
DO BEGIN 00742900
|
|
I~I+1; 00743000
|
|
V[I] ~ V[X+((IF ALFA THEN P(0,MKS,0,VX1,VX,EQUALS) 00743100
|
|
ELSE IF AC THEN P(0,MKS,VX1,VX,EQUALS) 00743200
|
|
ELSE P(MKS,VA1,0,VA,0,EQUALS)) AND TRUE)]; 00743300
|
|
END UNTIL (X~X+2) = STPP; VLOW ~ V[I].[18:15]; 00743400
|
|
END FIRSTSELECT; 00743500
|
|
SUBROUTINE LOWSELECT; 00743600
|
|
BEGIN 00743700
|
|
X ~ VLOW AND 1022; 00743800
|
|
DO BEGIN 00743900
|
|
I ~ MS + X.[38:9]; % I ] MS + (X/2) 00744000
|
|
V[I] ~ V[X+((IF ALFA THEN P(0,MKS,0,VX1,VX,EQUALS) 00744100
|
|
ELSE IF AC THEN P(0,MKS,VX1,VX,EQUALS) 00744200
|
|
ELSE P(MKS,VA1,0,VA,0,EQUALS)) AND TRUE)]; 00744300
|
|
X ~ I AND 1022; 00744400
|
|
END UNTIL I = STPP; VLOW ~ V[I].[18:15]; 00744500
|
|
END LOWSELECT; 00744600
|
|
%*********************************% 00744700
|
|
SUBROUTINE SORTIT; % DEVELOPS STRINGS FROM INPUT TAPE 00744800
|
|
BEGIN 00744900
|
|
COMMENT USE SPECIAL SORT COMMUNICATE TO GET STORAGE FOR 00745000
|
|
DATA AND VECTOR ARRAYS; 00745100
|
|
P(R,S+1,[DATN],21,COM,DEL,DEL,DEL); 00745200
|
|
P(MKS,[VN],(2|S)-1,1,1,1,BLOCK); 00745300
|
|
STPP ~ P(MS~S,DUP,ADD,2,SUB); 00745400
|
|
COMMENT CALL HIVALU TO SET UP HK1 ROW OF DATA; 00745500
|
|
STREAM(A~*[DATX[S]],B~R-1,C~P(DUP).[36:6]); 00745600
|
|
BEGIN DI~A;SI~LOC C;DS~WDS; 00745700
|
|
SI~A;C(DS~32 WDS;DS~32 WDS);DS~B WDS; 00745800
|
|
END; 00745900
|
|
P(MKS,*[DATX[S]]); IF NOT AC THEN P(0,RDS,CFX,0); P(HIVALU); 00746000
|
|
COMMENT INITIAL FILL OF DATA ARRAY FROM INPUT SOURCE; 00746100
|
|
IF TR } 0 THEN 00746200
|
|
BEGIN COMMENT NOT 1 ST CALL ON SORT SO FILL DATA FROM DISK; 00746300
|
|
OUTFIB[13].[27:1] ~ 1; % SET FILE TO READ 00746400
|
|
P([DOTOP],0,11,COM,DEL,DEL); % OPEN DISK FILE 00746500
|
|
P([DOTOP]); WAIT; % SLEEP UNTIL FILE IS OPENED 00746600
|
|
OCDA ~ OUTHEAD[10] + P(OD,DUP,ADD); 00746700
|
|
I ~ 0; ORL ~ ORS; OBC ~ TBO; 00746800
|
|
WHILE I < S DO 00746900
|
|
BEGIN 00747000
|
|
IF I < TR THEN 00747100
|
|
BEGIN;COMMENT MOVE RECORD TO DATA; 00747200
|
|
STREAM(P1~*[DOTOP],P2~R,P3~(P(DUP)).[36:6], 00747300
|
|
P4~*[DATX[I]]); 00747400
|
|
BEGIN SI~P1;P3(DS~32 WDS;DS~32 WDS); DS~P2 WDS END; 00747500
|
|
P(1); DISKWRITE; 00747600
|
|
V[I] ~ NFLAG((*[DATX[I]])&I[18:33:15]); 00747700
|
|
END 00747800
|
|
ELSE V[I] ~ NFLAG((*[DATX[S]])&S[18:33:15]&1[5:47:1]); 00747900
|
|
I ~ I+1; 00748000
|
|
END; 00748100
|
|
P(MKS,0,0,[DOTOP[NOT 2]],4,FCR); % REWIND 00748200
|
|
OUTFIB[13].[27:1] ~ 0; % SET TO OUTPUT 00748300
|
|
P([DOTOP],0,11,COM,DEL,DEL); % OPEN FILE OUTPUT 00748400
|
|
P([DOTOP[1]]); WAIT; 00748500
|
|
GO TO IPB; 00748600
|
|
END FILL OF DATA FROM DISK; 00748700
|
|
IF IPTOG OR AC THEN BEGIN INREAD; INCOUNT ~ 0 END; 00748800
|
|
FOR VLOW ~ 0 STEP 1 UNTIL S-1 DO 00748900
|
|
BEGIN COMMENT FILL DATA FROM INPUT FILE; 00749000
|
|
IF VLOW ! 0 THEN INREAD; % POINT AT NEXT RECORD 00749100
|
|
IF NOT EOF THEN 00749200
|
|
BEGIN; COMMENT MOVE RECORD FROM FROM BUFFER TO DATA[VLOW,0]; 00749300
|
|
STREAM(P1~*[CIIOD],P2~R,P3~P(DUP).[36:6], 00749400
|
|
P4~ *[DATX[VLOW]]); 00749500
|
|
BEGIN SI ~ P1; P3(DS~32WDS;DS~32WDS);DS~P2 WDS END; 00749600
|
|
V[VLOW] ~ NFLAG((*[DATX[VLOW]])&VLOW[18:33:15]); 00749700
|
|
END; 00749800
|
|
END INITIAL FILL LOOP; 00749900
|
|
IPB: ORI ~ 10; GETROW; 00750000
|
|
IF DISKFULL THEN P(1,[DOTOP[NOT 2]],81,17,COM); 00750100
|
|
OCDA ~ (LOSA ~ OUTHEAD[ORI]) + 1; 00750200
|
|
SRS~ORL~ORS-1; SRI~ORI; ONS~ORC~0;OBC~TBO; 00750300
|
|
IPBA: FIRSTSELECT; % INITIAL COMPARE 00750400
|
|
GO TO IPD; 00750500
|
|
IPC: LOWSELECT; % INTERM COMPARE 00750600
|
|
IPD: IF VLOW < MS THEN 00750700
|
|
BEGIN;COMMENT MOVE NEXT RECORD TO OUTPUT AREA; 00750800
|
|
STREAM(P1~VL,P2~R,P3~(P(DUP)).[36:6],P4~*[DOTOP]); 00750900
|
|
BEGIN SI~P1;P3(DS~32WDS;DS~32WDS);DS~P2 WDS END; 00751000
|
|
P(1); DISKWRITE; % WRITE ON DISK THE RECORD FROM DATA[VLOW,0] 00751100
|
|
INREAD; % POINT AT NEXT RECORD 00751200
|
|
IF NOT EOF THEN 00751300
|
|
BEGIN COMMENT CHECK IF NEXT RECORD IS SMALLER; 00751400
|
|
IF ( IF ALFA THEN P(0,MKS,0,*[INFIL],VL,EQUALS) 00751500
|
|
ELSE IF AC THEN P(0,MKS,*[CIIOD],VL,EQUALS) 00751600
|
|
ELSE P(MKS,XAL,0,VAL,0,EQUALS)) 00751700
|
|
THEN V[VLOW] ~ NFLAG((*[DATX[MS]])&MS[18:33:15]); 00751800
|
|
STREAM(P1~*[CIIOD],P2~R,P3~P(DUP).[36:6],P4~*[DATX[VLOW]]); 00751900
|
|
BEGIN SI~P1;P3(DS~32WDS;DS~32WDS);DS~P2 WDS END; 00752000
|
|
% MOVE NEXT RECORD TO DATA 00752100
|
|
END; 00752200
|
|
IF NOT DISKFULL THEN GO TO IPC; 00752300
|
|
END; 00752400
|
|
COMMENT END OF STRINGING PASS OR NO MORE DATA; 00752500
|
|
IF NOT DISKFULL THEN % CHECK FOR RECORD = HIGH KEY 00752600
|
|
FOR I ~ 0 STEP 1 UNTIL MS-1 DO 00752700
|
|
IF (VLOW ~ V[I].[18:15]) < MS THEN GO TO IPD; 00752800
|
|
MOREDATA ~ FALSE; 00752900
|
|
FOR I~ 0 STEP 1 UNTIL MS-1 DO 00753000
|
|
IF NOT V[I].[5:1] THEN 00753100
|
|
BEGIN V[I] ~ NFLAG((*[DATX[I]])&I[18:33:15]); 00753200
|
|
MOREDATA ~ TRUE END; 00753300
|
|
DISKFULL ~ TM AND ONS } M-1 OR DISKFULL; 00753400
|
|
IPE: WRITETAG; % WRITE STRING TAG WORD IN FRONT OF STRING 00753500
|
|
IF DISKFULL THEN GO TO IPG; 00753600
|
|
IF MOREDATA THEN 00753700
|
|
IF NOT TM OR ONS < M THEN GO TO IPBA 00753800
|
|
ELSE GO TO IPG; 00753900
|
|
FM ~ NOT TM AND ONS { M; 00754000
|
|
IPG::END SORTIT; 00754100
|
|
%*********************************% 00754200
|
|
SUBROUTINE MERGEIT; % MERGES M STRINGS TO 1 STRING 00754300
|
|
BEGIN 00754400
|
|
MIC: FIRSTSELECT; 00754500
|
|
GO TO MIE; 00754600
|
|
MID: LOWSELECT; 00754700
|
|
MIE: IF VLOW < MS THEN 00754800
|
|
BEGIN; % MOVE LOW RECORD TO OUTPUT FILE 00754900
|
|
STREAM(P1~VL,P2~R,P3~(P(DUP)).[36:6],P4~*[COIOD]); 00755000
|
|
BEGIN SI~P1;P3(DS~32WDS;DS~32WDS);DS~ P2 WDS END; 00755100
|
|
WRITEOUT; DISKREAD; 00755200
|
|
GO TO MID; 00755300
|
|
END; 00755400
|
|
FOR I ~ 0 STEP 1 UNTIL MS-1 DO % CHECK FOR RECORD = HIGH KEY 00755500
|
|
IF (VLOW ~ V[I].[18:15]) < MS THEN GO TO MIE; 00755600
|
|
IF NOT TM AND NOT EOF THEN 00755700
|
|
BEGIN COMMENT HAVE MERGED M STRINGS FROM INPUT;00755800
|
|
WRITETAG; % TO ONE STRING IN OUTPUT, SELECT 00755900
|
|
SUBMERGE; % M MORE STRINGS IO MERGE 00756000
|
|
GO TO MIC; 00756100
|
|
END; 00756200
|
|
END MERGEIT; 00756300
|
|
%**********************************% 00756400
|
|
START: % INITIALIZE SORT PASS 00756500
|
|
BLKCTR ~ BLKCTR + ((AC ~ R>0) OR MF); R ~ ABS(R); 00756600
|
|
IF AC THEN IF CORESIZE.[1:1] THEN % IDENTIFY COBOL68 00756610
|
|
BEGIN AC~3; CORESIZE~ABS(CORESIZE); 00756620
|
|
BLKCTR ~ BLKCTR - 1; 00756630
|
|
END; 00756650
|
|
IF NOT OPTOG THEN 00756700
|
|
BEGIN 00756710
|
|
PRFIB ~ OUTFIL[NOT 2]; 00756720
|
|
IF R > (PRFIB[18].[33:15]) THEN 00756730
|
|
P(1,[OUTFIL[NOT 2]],87,17,COM); 00756740
|
|
END; 00756750
|
|
P(MKS,[TSN],[TCN],[TNN], 8 ,1,3,1,BLOCK); 00756800
|
|
IF MF THEN GO TO P(POLYMERGE); 00756900
|
|
LISA ~ IF IPTOG THEN 0 ELSE % SIZE OF INPUT BUFFER 00757000
|
|
2|P(*[INFIL[NOT 2]],18,COC).[3:15]; 00757100
|
|
CORESIZE ~ (IF CORESIZE = 0 THEN 12000 ELSE CORESIZE) 00757200
|
|
- 2000 - LISA; 00757300
|
|
IF CORESIZE < 2500 THEN CORESIZE ~ 2500; 00757310
|
|
ONS ~ R ~ ABS(R); S ~ M ~ 512; 00757400
|
|
WHILE ONS < 30 DO ONS ~ ONS + R; 00757500
|
|
LY: IF ONS > 1023 THEN BEGIN ONS ~ ONS - R; GO TO LZ END; 00757600
|
|
IF ONS MOD 30 ! 0 THEN BEGIN ONS ~ ONS + R; GO TO LY END; 00757700
|
|
COMMENT ONS NOW MINIMUM BUFFER SIZE; 00757800
|
|
LZ: ORC ~ ONS; 00757900
|
|
WHILE (ORC + ONS) { 150 DO ORC ~ ORC + ONS ; %DSK INPT BUFF SZ 00758000
|
|
ORL ~ ORC; 00758100
|
|
WHILE (ORC + ORL) { 450 DO ORL ~ ORL + ORC ; %DSK OTPT BUFF SZ 00758200
|
|
OCDA ~ CORESIZE - 2|ORL; 00758300
|
|
LOSA ~ (OCDA-R) DIV (2|ORC); 00758400
|
|
IF LOSA { 2 THEN M ~ 2 ELSE WHILE M > LOSA DO M~M DIV 2; 00758500
|
|
LOSA ~ (OCDA-R) DIV (R+3); 00758600
|
|
IF LOSA { 2 THEN S ~ 2 ELSE WHILE S > LOSA DO S~S DIV 2; 00758700
|
|
SRS ~ ORL; SRI ~ ORC; 00758800
|
|
LX: ORI ~ 2|ORL + 2|M|ORC; 00758900
|
|
IF ORI < 1.1|CORESIZE AND ORC { 1023 THEN 00759000
|
|
BEGIN 00759100
|
|
SRS ~ ORL; SRI ~ ORC; 00759200
|
|
ORC ~ ORC + ONS; 00759300
|
|
ORL ~ ORC; WHILE ORL < 300 DO ORL ~ ORL + ORC; 00759400
|
|
GO TO LX ; 00759500
|
|
END; 00759600
|
|
D ~ SRI DIV 30; IF SRI MOD 30 ! 0 THEN D ~ D + 1; 00759700
|
|
BF ~ SRI DIV R; TBO ~ SRS DIV R; 00759800
|
|
COMMENT COMPUTE DISK ROW SIZE, # ROWS ALWAYS = 20; 00759900
|
|
DISKSIZE ~ ( IF DISKSIZE = 0 THEN 1000|600 ELSE DISKSIZE) 00760000
|
|
/ (BF|19|R); 00760100
|
|
IF DISKSIZE { (Y ~ TBO DIV BF) THEN 00760200
|
|
DISKSIZE ~ Y + Y ELSE 00760300
|
|
WHILE (DISKSIZE MOD Y)!0 DO DISKSIZE~DISKSIZE + 1; 00760400
|
|
OD ~ D | Y ; 00760500
|
|
COMMENT SET UP DISK OUTPUT FILE AS ALGOL FILE; 00760600
|
|
OUTFIB ~ *[DOTOP[NOT 2]]; % GET FIB DESCRIPIOR 00760700
|
|
OUTFIB[ 8] ~ (DISKSIZE DIV Y)&20[15:38:10]; % # ROWS, ROW SIZE.00760800
|
|
OUTFIB[13].[10:9] ~ OUTFIB[13].[1:9]; 00760900
|
|
OUTFIB[4].[7:1] ~ ((AC AND 3) = 1); %COBOL61 DISK SORT FLG 00761000
|
|
OUTFIB[18] ~ (X~TBO|R)&X[3:33:15]&X[18:33:15]; % DISK BLOCK 00761100
|
|
IF (Y~OUTFIB[4].[12:12]) < 1023 THEN % FILE # TO FILE INDEX 00761200
|
|
OUTFIB[4] ~ OUTFIB[4]&((Y-1)|ETRLNG)[13:37:11]&1[12:47:1]; 00761300
|
|
IF FPB[FNUM+3].[16:7] = 0 THEN % NOT LABEL EQUATED 00761310
|
|
FPB[FNUM+3].[16:2] := 1; % USE FAST DISK 00761320
|
|
COMMENT OPEN DISK OUTPUT FILE, WILL SET UP FIB[16] AND 00761400
|
|
WILL PDINT TOP I/O DESC. PAST DISK ADDRESS; 00761500
|
|
P([DOTOP],0,11,COM,DEL,DEL); 00761600
|
|
OUTHEAD ~ *[OUTFIB[14]]; 00761700
|
|
IF NT > 2 THEN 00761800
|
|
OUTHEAD[8]~OUTHEAD[8] OR MEM; 00761900
|
|
COMMENT GET DISK SPACE FOR 1 ROW; 00762000
|
|
P([DOTOP[1]]); WAIT; % WAIT FOR FILE TO BE OPENED 00762100
|
|
ORI ~ 9; GETROW; MOREDATA ~ TR ~ -1; 00762200
|
|
IF DISKFULL THEN 00762300
|
|
P(1,[DOTOP[NOT 2]],81,17,COM); % IOR 81 00762400
|
|
COMMENT IF INPUT FILE THEN OPEN IT, IF PROCEDURE THEN 00762500
|
|
INITILIZE LINKAGE TO CALL IT; 00762600
|
|
IF IPTOG THEN BEGIN IF AC THEN 00762700
|
|
BEGIN ENDQ ~ 0; BINGO ~ INPRO; END; 00762800
|
|
P(MKS,[INFIL],R,1,1,1,BLOCK); 00763000
|
|
IF(AC AND 3)=3 THEN % COBOL68 00763050
|
|
BEGIN CIIOD ~ [WAIN]; 00763100
|
|
WAIN ~ P([INFIL],DUP,LOD,0,CDC,DEL,LOD); 00763150
|
|
END END ELSE 00763200
|
|
BEGIN COMMENT CHECK FOR ALGOL OR COBOL; 00763300
|
|
IF AC THEN BEGIN P(MKS,(NOT 2) INX [INFIL],1,COFCR); 00763400
|
|
IF AC.[46:1] THEN % COBOL68 00763440
|
|
BEGIN CIIOD ~ [WAIN]; 00763450
|
|
WAIN ~ P(*[INFIL[NOT 2]],20,COC,0,XCH,FCX,00763460
|
|
DUP,DIB 0,LOD,0,CDC,DEL,DIB 0,LOD); 00763470
|
|
END END ELSE BEGIN % OPEN ALGOL INPUT FILE 00763500
|
|
PRFIB ~ *[INFIL[NOT 2]]; 00763600
|
|
PRFIB[13].[27:1] ~ 1; 00763700
|
|
P(MKS,0,3,[INFIL],ALRD,DEL); 00763800
|
|
END; 00764200
|
|
END; 00764300
|
|
IF(AC AND 3)!3 THEN CIIOD ~ [INFIL]; 00764350
|
|
CALLSORT: 00764400
|
|
SORTIT; % SORT INPUT FILE INTO STRINGS 00764500
|
|
%**********************************% 00764600
|
|
ENDSORTPASS: COMMENT TURN BACK WHATS NO LONGER NEEDED AND 00764700
|
|
INITILIZE MERGE PASS; 00764800
|
|
IF EOF THEN COMMENT CLOSE INPUT TAPE; 00764900
|
|
IF NOT MOREDATA THEN 00764950
|
|
BEGIN 00765000
|
|
IF IPTOG THEN P([INFIL],3,COM,DEL) 00765100
|
|
ELSE P(MKS,2,0,[INFIL[NOT 2]], 00765200
|
|
IF (INFIL=OUTFIL) AND AC THEN 18 ELSE 4,FCR); 00765210
|
|
IF INCOUNT = 0 THEN P(1,[DOTOP[NOT 2]],86,17,COM); 00765300
|
|
END; 00765400
|
|
IF MOREDATA THEN 00765500
|
|
BEGIN COMMENT SAVE CONTENTS OF DATA ON DISK; 00765600
|
|
TR ~ 0; OCDA ~ OUTHEAD[ORI ~ 10]; I ~ 0; 00765700
|
|
OBC ~ TBO; ORL ~ ORS; 00765800
|
|
WHILE I < S DO 00765900
|
|
BEGIN 00766000
|
|
IF NOT V[I].[5:1] THEN 00766100
|
|
BEGIN 00766200
|
|
TR ~ TR +1; 00766300
|
|
STREAM(P1~*[DATX[I]],P2~R,P3~(P(DUP)).[36:6], 00766400
|
|
P4~*[DOTOP]); 00766500
|
|
BEGIN SI~P1;P3(DS~32WDS;DS~32WDS);DS~P2 WDS END; 00766600
|
|
P(1); DISKWRITE; 00766700
|
|
END; 00766800
|
|
I ~ I + 1; 00766900
|
|
END; 00767000
|
|
P(0); DISKWRITE; % WRITE BLOCK 00767100
|
|
END; 00767200
|
|
AC ~ AC&EOF[2:47:1]&MOREDATA[1:47:1]; 00767300
|
|
COMMENT TURN BACK DATA & VECTOR ARRAYS; 00767400
|
|
P(.DATA,LOD,RFB,.DATA,STD,[DATN],22,COM,DEL); 00767500
|
|
P(.V,LOD,RFB,.V,STD,[VN],3,COM,DEL); 00767600
|
|
STPP ~ P(MS ~ M,DUP,ADD,2,SUB); 00767700
|
|
BLKCTR ~ BLKCTR + 1; 00767800
|
|
COMMENT DECLARE DISK OUTPUT FILE; 00767900
|
|
ITNK ~ 0; 00768000
|
|
P(MKS,20,DISKSIZE,3,OUTFIB[4].[13:11]DIV ETRLNG +2,[DKI], 00768100
|
|
(Y~2|M),1,BF|R,0,0,10,8,BLOCK); 00768200
|
|
INFIB ~ *[ITNK[2]]; 00768300
|
|
ITOP ~ [ITNK[5]]&Y[8:38:10] ; % POINT ITOP AT TOP I/O D 00768400
|
|
COMMENT OPEN FILE; 00768500
|
|
P([ITNK[5]],0,11,COM,DEL,DEL); 00768600
|
|
INHEAD ~ *[INFIB[14]]; 00768700
|
|
IF NT > 2 THEN 00768800
|
|
INHEAD[8] ~ INHEAD[8]&1[2:47:1]; % FLAG SORT DISK 00768900
|
|
P([ITOP[Y~Y-1]]); WAIT; % WAIT FOR FILE TO BE OPENED 00769000
|
|
IF INHEAD[10] !0 THEN 00769100
|
|
P(10,.INHEAD,LOD, 24,COM,DEL,DEL); % RETURN 1 ST ROW 00769200
|
|
COMMENT SET FILE TO READ & PERMUTE 2 BUFFERS; 00769300
|
|
INFIB[13] ~ INFIB[13]&2[10:39:9]&1[27:47:1]; 00769400
|
|
INFIB[16] ~ (*[INFIB[16]])&1[24:47:1]; 00769500
|
|
COMMENT GET DATA AND VECTDR ARRAYS; 00769600
|
|
P(MKS,[VN],(2|M)-1,1,1,1,BLOCK); 00769700
|
|
P(5,M+1,[DATN],21,COM,DEL,DEL,DEL); 00769800
|
|
COMMENT GENERATE HIGH KEY RECORD; 00769900
|
|
MHN ~ 0; P(MKS,[MHN],R,1,1,1,BLOCK); 00770000
|
|
P(MKS,MHK); IF NOT AC THEN P(0,CDC,MHK,XCH,RDS,CFX,0); 00770100
|
|
P(HIVALU); 00770120
|
|
FOR I ~ 0 STEP 1 UNTIL Y DO 00770200
|
|
ITOP[I] ~ (NOT 0) INX (*[ITOP[I]])&1[24:47:1]&D[27:42:6]; 00770300
|
|
DKC: IF NOT TM THEN 00770400
|
|
BEGIN % DISK ONLY SORT COMPLETED 00770500
|
|
IF FM THEN GO TO DKF; 00770600
|
|
P(10,.OUTHEAD,LOD,24,COM,DEL,DEL); % RETURN OVERLAY SPACE 00770700
|
|
P(.INHEAD,LOD,.OUTHEAD,LOD,.INHEAD,STD,.OUTHEAD,STD); 00770800
|
|
SRI ~ ORI; ORI ~ 10; % SRI= AMOUNT OF DISK USED TO NOW 00770900
|
|
WHILE ORI < SRI DO % GET ANOTHER AREA OF DISK = SRI 00771000
|
|
BEGIN 00771100
|
|
GETROW; 00771200
|
|
IF DISKFULL THEN 00771300
|
|
BEGIN P(.OUTHEAD,LOD); FORGETDISK; GO TO TPA; END; 00771400
|
|
END; 00771500
|
|
COIOD ~ DOTOP; 00771600
|
|
DKD: OCDA ~ (LOSA ~ OUTHEAD[(SRI ~ ORI ~ 11)]) + 1; 00771700
|
|
SRS ~ ORL ~ ORS - 1; 00771800
|
|
DKE: LISA ~ INHEAD[11]; % LOCATION OF FIRST TAG 00771900
|
|
MOREDATA ~ NOT(EOF ~ DISKFULL ~ ONS ~ 0); 00772000
|
|
SUBMERGE; MERGEIT; 00772100
|
|
IF FM THEN BEGIN P(*[INFIB[14]]); FORGETDISK; GO TO TPC END; 00772200
|
|
MOREDATA ~ FALSE; WRITETAG; 00772300
|
|
DKF: P(.INHEAD,LOD,.OUTHEAD,LOD,.INHEAD,STD,.OUTHEAD,STD); 00772400
|
|
IF ONS > M THEN GO TO DKD; 00772500
|
|
FM ~ TRUE; MS ~ 2; WHILE ONS > MS DO MS~MS|2; 00772600
|
|
STPP ~ 2|MS-2; 00772700
|
|
COMMENT REPLACE DISK OUTPUT BY PROGRAMMERS OUTPUT; 00772800
|
|
P(MKS,0,0,[DOTOP[NOT 2]],4,FCR); % RETURN BUFFERS 00772900
|
|
OPENOUT; IF(AC AND 3)!3 THEN COIOD ~ [OUTFIL]; 00773000
|
|
GO TO DKE; 00773100
|
|
END; 00773200
|
|
COMMENT DISK-TAPE MERGE; 00773300
|
|
P(.INHEAD,LOD,.OUTHEAD,LOD,.INHEAD,STD,.OUTHEAD,STD); 00773400
|
|
TPA: P(MKS,0,0,[DOTOP[NOT 2]],4,FCR); % RETURN BUFFERS 00773500
|
|
LISA ~ INHEAD[11]; MOREDATA ~ NOT(EOF~DISKFULL~ONS~0); 00773600
|
|
TPB: IF TN[COT] } TC[COT] THEN BEGIN SELECT; GO TO TPB END; 00773700
|
|
SUBMERGE; MERGEIT; WRITESTOPPER; 00773800
|
|
IF NOT EOF THEN GO TO TPB; 00773900
|
|
P(.INHEAD,LOD,.OUTHEAD,LOD,.INHEAD,STD,.OUTHEAD,STD); 00774000
|
|
TPC: P(.DATA,LOD,RFB,.DATA,STD,[DATN],22,COM,DEL); % RTN DATA 00774100
|
|
INHEAD ~ INFIB ~ BASE ~ ITOP ~ BUFF ~ 0; 00774300
|
|
IF FM OR AC.[1:2] =1 THEN GO TO WRAPUP; 00774500
|
|
P (10,COM); %RETURN MERGE MATRIX %TR-11700774550
|
|
MOREDATA ~ AC.[1:1]; EOF ~ AC.[2:1]; 00774600
|
|
GO TO CALLSORT; 00774700
|
|
WRAPUP: 00774800
|
|
P(*[OUTFIB[14]]); FORGETDISK; 00774900
|
|
OUTFIB ~ OUTHEAD ~ 0; 00775000
|
|
IF TM THEN %ITD SORT MERGE %TR-11700775100
|
|
BEGIN P (10,COM); %RETURN MERGE MATRIX %TR-11700775120
|
|
GO TO P(POLYMERGE);% GO TO ITD MERGL %TR-11700775130
|
|
END; %TR-11700775140
|
|
SORTDONE: 00775200
|
|
COMMENT JUST DID FINAL PASS; 00775300
|
|
COMMENT RETURN EVERYTHING; 00775400
|
|
P([DOTOP]&0[18:18:15],6,11,COM,DEL,DEL); 00775500
|
|
IF NOT OPTOG THEN BEGIN 00775600
|
|
P(MKS,2,0,[OUTFIL[NOT 2]],4,FCR) 00775700
|
|
; IF NOT AC THEN P(0,OUTFIL[NOT 2],8,CDC,STD); 00775800
|
|
END ELSE 00775900
|
|
BEGIN COMMENT CALL OUTPUT PROCEDURE PASSING END-OF-SORT FLAG; 00776000
|
|
IF AC THEN 00776100
|
|
BEGIN ENDQ ~ 1; IF AC.[46:1] THEN 00776200
|
|
P(MKS,BINGO,0,PERFORMGEN) % COBOL68 00776250
|
|
ELSE P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,COC) 00776300
|
|
END ELSE P(MKS,1,MEM,0,OUTPRO); 00776400
|
|
END; 00776500
|
|
P( 10,COM); % RETURN MERGE MATRIX %TR-11700776550
|
|
IF OUTCOUNT!INCOUNT THEN P(INCOUNT,OUTCOUNT,0, 00776600
|
|
[DOTOP[NOT 2]],82,17,COM); 00776700
|
|
P(10,COM); % FALL OUT OF BLOCK COM WILL REIURN EVERYTHING 00776800
|
|
END DISKSORT; 00776900
|
|
PROCEDURE POLYMERGE( 00800000
|
|
T1,T2,T3, 00800100
|
|
ENDQ,BINGO,IPFIDX,OUTPRO,INPRO,OUTF,INF, 00800200
|
|
OPTOG,IPTOG,DKO,DKI,TP1,TP2,TP3,TP4,TP5,NT, 00800300
|
|
HIVALU,EQUALS,R,ALFA,CORESIZE,DISKSIZE); 00800400
|
|
COMMENT DISK-SORT BY L.R. GUCK DATE 9/19/1965 ; 00800500
|
|
VALUE OPTOG,IPTOG,NT,HIVALU,EQUALS,R,ALFA, 00800600
|
|
CORESIZE,DISKSIZE; 00800700
|
|
REAL ENDQ,BINGO,IPFIDX,OUTPRO,INPRO,OUTF,T1,T2,T3,INF; 00800800
|
|
BOOLEAN OPTOG,IPTOG; 00800900
|
|
REAL DKO,DKI; 00801000
|
|
NAME TP1,TP2,TP3,TP4,TP5; % SCRATCH TAPES 00801100
|
|
REAL NT,HIVALU,EQUALS,R; 00801200
|
|
BOOLEAN ALFA; % TRUE FOR ALPHA KEYS 00801300
|
|
REAL CORESIZE; % CORE STORAGE AVAILABLE 00801400
|
|
INTEGER DISKSIZE; % DISK STORAGE AVAILABLE 00801500
|
|
BEGIN 00801600
|
|
LABEL MIC,MID,MIE,START,TPD,TPE,TPF,RTNTR,TRA,SORTDONE,RTA,TRX; 00801700
|
|
REAL S,M,MS,STPP,D,OD,BF,TBO,I,X,Y,DN; 00801800
|
|
ARRAY V[*]; NAME VN = V; 00801900
|
|
DEFINE VX1=FLAG(V[X+1])#, VX=FLAG(V[X])#, VL=FLAG(V[VLOW])#; 00802000
|
|
DEFINE VA1 = FLAG(V[X+1 ]&P(0,RDS)[CTF])#, 00802010
|
|
VA = FLAG(V[X ]&P(0,RDS)[CTF])#, 00802020
|
|
VAL = FLAG(V[VLOW]&P(0,RDS)[CTF])#; 00802030
|
|
REAL VLOW; % INDEX OF NEXT RECORD IN SEQUENCE 00802100
|
|
ARRAY MHK[*]; % HIGH KEY FOR MERGE PHASE 00802200
|
|
NAME MHN=MHK; 00802300
|
|
NAME DOTOP = DKO; 00802400
|
|
BOOLEAN MOREDATA,FM,EOF,TM,DF,TR; 00802500
|
|
BOOLEAN MF= T1; 00802600
|
|
DEFINE IOC = @2000000000#, 00802700
|
|
P = POLISH#; 00802800
|
|
COMMENT PARAMETERS RELATED TO PROGRAMMERS FILES; 00802900
|
|
NAME INFIL = INF; % POINTER TO TOP I/O DESC. 00803000
|
|
NAME OUTFIL = OUTF; 00803100
|
|
NAME WAOUT = T2; % COBOL68 OUTFILE WORK AREA 00803120
|
|
ARRAY PRFIB[*]; % CONTAINS TAPE FILES FIB 00803200
|
|
REAL AC; % TRUE FOR COBOL INPUT FILE 00803300
|
|
REAL INCOUNT,OUTCOUNT; 00803400
|
|
NAME MEM = 2; 00803500
|
|
REAL BLOCK = 5,ALWR=12,ALRD=13,COFCR=12,CORW=14,ALFCR=14, 00803600
|
|
PERFORMGEN = 13, % COBOL68 IN-OUT PROCEDURES 00803610
|
|
BLKCTR = 16; 00803700
|
|
ARRAY PRTBASE = 10[*]; 00803800
|
|
REAL OF,OH,LO,ONS,ORC,OCDA,ORL,ORI,SRI,SRS,OBC,IFB,IFH; 00803900
|
|
ARRAY BASE[*]; % POINTER TO CONTROL INFO IN DATA 00804000
|
|
REAL ITP,DONTDONOTHINIEOPEN,LISA; 00804100
|
|
DEFINE FCR = IF AC THEN COFCR ELSE ALFCR#; 00804200
|
|
COMMENT PARAMETERS RELATED TO MERGE TAPES; 00804300
|
|
INTEGER CTRL; % CURRENT CONTROL TAPE 00804400
|
|
INTEGER COT; % CURRENT OUTPUT TAPE 00804500
|
|
NAME COIOD; % LOC OF I/O D OF CURRENT OUTPUT TAPE 00804600
|
|
NAME TP; % BASE POINTER OF MERGE TAPES 00804700
|
|
ARRAY TS[*]; % ARRAYS FOR CONTROLLING DISTRIBUTION 00804800
|
|
ARRAY TC[*]; % PATTERNS ON MERGE TAPES 00804900
|
|
ARRAY TN[*]; 00805000
|
|
REAL TM1=CORESIZE; % TAPES - 1 00805100
|
|
NAME CIIOD; % LOC OF I/O D FOR CURRENT INPUT TAPE 00805200
|
|
%**********************************% 00805300
|
|
SUBROUTINE WAIT; COMMENT WAIT FOR I/O COMPLETE USING ADRRESS 00805400
|
|
ON TOP OF STACK; 00805500
|
|
$ SET OMIT = NOT(TIMESHARING) 00805550
|
|
BEGIN IF NOT (P(XCH,DUP,LOD)).[19:1] THEN P(IOC,36,COM,DEL); 00805552
|
|
$ POP OMIT 00805553
|
|
$ SET OMIT = TIMESHARING 00805599
|
|
P(DEL); END WAIT; 00805700
|
|
%***************MM*****************% 00805800
|
|
SUBROUTINE RELEASETAPE; % CALLS MCP TO WRITE OUT BUFFERS 00805900
|
|
BEGIN 00806000
|
|
PRFIB[11] ~ TBO; 00806100
|
|
P(COIOD[0] ~ FLAG(PRFIB[16]),COIOD,PRL,DEL); 00806200
|
|
RTA: P(COIOD); WAIT; 00806300
|
|
IF (*COIOD).[27:1] THEN % REEL SWITCH 00806400
|
|
BEGIN 00806500
|
|
P(MKS,0,0,[COIOD[NOT 2]],6,FCR); 00806600
|
|
GO TO RTA; 00806700
|
|
END; 00806800
|
|
IF NOT(*COIOD).[2:1] THEN P(1,[COIOD[NOT 2]],74,17,COM); 00806850
|
|
COIOD[0] ~ 1 INX FLAG(PRFIB[16] ~ NFLAG(*COIOD)); 00806900
|
|
END RELEASETAPE; 00807000
|
|
SUBROUTINE TAPEWRITE; % BLOCKS OUTPUT TAPES 00807100
|
|
BEGIN 00807200
|
|
PRFIB ~ *[COIOD[NOT 2]]; 00807300
|
|
PRFIB[9] ~ PRFIB[9] + 1; % RECORD COUNTER + 1 00807400
|
|
IF (PRFIB[11] ~ PRFIB[11] - 1) > 0 THEN % BLOCK COUNTER 00807500
|
|
COIOD[0] ~ R INX *COIOD 00807600
|
|
ELSE 00807700
|
|
BEGIN % TIME FOR RELEASE 00807800
|
|
P(0,PRFIB[16] INX MEM,STD); % ZERO CONTROL WORD IN BUFF[2] 00807900
|
|
RELEASETAPE; 00808000
|
|
END; 00808100
|
|
END TAPEWRITE; 00808200
|
|
SUBROUTINE WRITESTOPPER; 00808300
|
|
BEGIN % WRITES END OF STRING OR DUMMY STRINGS 00808400
|
|
PRFIB ~ *[COIOD[NOT 2]]; 00808500
|
|
X ~ PRFIB[9]&(TBO-PRFIB[11])[18:33:15]&("DS")[3:33:15]; 00808600
|
|
P(X,PRFIB[16] INX MEM,STD); 00808700
|
|
TN[COT] ~ TN[COT] + 1; % COUNT UP STRINGS ON OUTPUI TAPE 00808800
|
|
RELEASETAPE; 00808900
|
|
PRFIB [9] ~ 0 ; % ZERO OUT STRING CTR 00808910
|
|
END WRITESTOPPER; 00809000
|
|
%**********************************% 00809100
|
|
SUBROUTINE OPENOUT; % OPENS PROGRAMMERS OUTPUT TAPE 00809200
|
|
BEGIN 00809300
|
|
IF OPTOG THEN 00809400
|
|
BEGIN P(MKS,[OUTFIL],R,1,1,1,BLOCK); 00809500
|
|
IF AC THEN 00809600
|
|
BEGIN BINGO ~ OUTPRO; ENDQ ~ 0; 00809700
|
|
IF AC.[46:1] THEN % COBOL68 00809730
|
|
BEGIN P(MKS,BINGO,0,PERFORMGEN); 00809740
|
|
COIOD ~ [WAOUT]; 00809745
|
|
WAOUT ~ P(*[OUTFIL],0,CDC); 00809750
|
|
END ELSE 00809760
|
|
P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,COC); 00809800
|
|
END END ELSE 00809900
|
|
BEGIN TR ~ FALSE; PRFIB ~ OUTFIL[NOT 2]; 00810000
|
|
PRFIB[13].[27:1] ~0; 00810100
|
|
IF AC THEN 00810200
|
|
BEGIN 00810300
|
|
P(MKS,[OUTFIL[NOT 2]],3,COFCR); 00810400
|
|
IF AC.[46:1] THEN % COBOL68 00810440
|
|
BEGIN COIOD ~ [WAOUT]; 00810450
|
|
WAOUT ~ P(PRFIB[20].[FF],DUP,DIB 0,LOD,0, 00810460
|
|
CDC,DEL,DIB 0,LOD); 00810470
|
|
END; 00810480
|
|
TR ~ PRFIB[4].[8:4] = 4; 00810600
|
|
END 00810700
|
|
ELSE BEGIN P([OUTFIL],0,11,COM,DEL,DEL); 00810800
|
|
P(MKS,1,0,0,(-R),[OUTFIL],ALWR,DEL); END; 00810900
|
|
END 00811000
|
|
END OPENOUT; 00811100
|
|
%**********************************% 00811200
|
|
SUBROUTINE TAPEREAD; % READS TAPES ON POLYPHASE MERGE 00811300
|
|
BEGIN 00811400
|
|
CIIOD ~ TP[VLOW + 1 ]; PRFIB ~ CIIOD[NOT 2]; 00811500
|
|
PRFIB[9] ~ PRFIB[9] + 1; % RECORD COUNTER + 1 00811600
|
|
IF (PRFIB[11] ~ PRFIB[11] -1) > 0 THEN % BLOCK COUNTER - 1 00811700
|
|
V[VLOW] ~ R INX V[VLOW] 00811800
|
|
ELSE 00811900
|
|
BEGIN % TIME FOR RELEASE 00812000
|
|
IF (Y ~ P(FLAG(PRFIB[16]),LOD)) ! 0 THEN 00812100
|
|
BEGIN % CONTROL WORD ! 0 SO END OF STRING 00812200
|
|
TRA: DF ~ TRUE; 00812300
|
|
IF Y.[33:15] ! PRFIB[9].[33:15] THEN 00812400
|
|
P(0,[CIIOD[NOT 2]],85,17,COM,DEL,DEL,DEL); 00812500
|
|
END; 00812600
|
|
P(CIIOD[0] ~ FLAG(PRFIB[16]),CIIOD,PRL,DEL); 00812700
|
|
TRX: P(CIIOD); WAIT; 00812800
|
|
IF NOT (*CIIOD).[2:1] THEN % ERROR OR EOF OR EOR 00812900
|
|
BEGIN 00813000
|
|
EOF ~ P(MKS,1,0,[CIIOD[NOT 2]],6,FCR); 00813100
|
|
IF NOT EOF THEN GO TO TRX; 00813200
|
|
END; 00813300
|
|
IF EOF THEN GO TO RTNTR; 00813400
|
|
PRFIB[11] ~ IF P(Y~ P(*CIIOD,LOD)) = 0 THEN TBO 00813500
|
|
ELSE Y.[18:15]; 00813600
|
|
CIIOD[0] ~ 1 INX FLAG(PRFIB[16] ~ NFLAG(*CIIOD)); 00813700
|
|
IF DF THEN GO TO RTNTR; 00813800
|
|
IF PRFIB[11] ! 0 THEN V[VLOW] ~ V[VLOW]&(*CIIOD)[33:33:15] 00813900
|
|
ELSE GO TO TRA; 00814000
|
|
END; 00814100
|
|
RTNTR: IF EOF OR DF THEN BEGIN 00814200
|
|
V[VLOW] ~ NFLAG(MHK)&MS[18:33:15]; 00814300
|
|
IF FM AND NOT MF THEN % REL TAPE LST PASS 00814340
|
|
P(MKS,4,0,[CIIOD[NOT 2]],4,FCR); % FOR SRT 00814350
|
|
EOF~DF~FALSE; 00814400
|
|
END; 00814500
|
|
END TAPEREAD; 00814600
|
|
%**********************************% 00814700
|
|
SUBROUTINE INREAD; % READS PROGRAMMERS MERGE FILES 00814800
|
|
BEGIN 00814900
|
|
CIIOD ~ TP[VLOW+1]; PRFIB ~ CIIOD[NOT 2]; 00815000
|
|
BEGIN 00815100
|
|
IF AC THEN TC[VLOW] ~ P(MKS,R,CIIOD,0,CORW) 00815200
|
|
ELSE 00815300
|
|
BEGIN 00815400
|
|
P(MKS,0,0,CIIOD,ALRD); 00815500
|
|
TC[VLOW] ~ P(MKS,0,3,CIIOD,ALRD) < 0; 00815600
|
|
END; 00815700
|
|
IF TC[VLOW] THEN V[VLOW] ~ NFLAG(MHK)&MS[18:33:15] 00815800
|
|
ELSE IF (AC AND 3) ! 3 THEN % NOT COBDL68 00815900
|
|
V[VLOW] ~ (*P(DUP)) & (*[CIIOD])[CTC]; 00815910
|
|
END; 00816000
|
|
END INREAD; 00816100
|
|
%*********************************% 00816200
|
|
SUBROUTINE WRITEOUT; 00816300
|
|
BEGIN % SELECTS FILE TO BE WRITTEN DURING MERGE 00816400
|
|
IF NOT FM THEN TAPEWRITE 00816500
|
|
ELSE 00816600
|
|
BEGIN COMMENT CALL OUTPUT PROCEDURE OR WRITE INTRINSIC; 00816700
|
|
OUTCOUNT ~ OUTCOUNT +1; 00816800
|
|
IF OPTOG THEN 00816900
|
|
BEGIN 00817000
|
|
IF AC THEN BEGIN ENDQ ~ 0; 00817100
|
|
IF AC.[46:1] THEN P(MKS,BINGO,0,PERFORMGEN) 00817120
|
|
ELSE P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,COC) 00817150
|
|
END ELSE P(MKS,0,*[OUTFIL],0,OUTPRO); 00817200
|
|
END 00817300
|
|
ELSE 00817400
|
|
BEGIN COMMENT OUTPUT FILE RATHER THAN OUTPUT PROCEDURE; 00817500
|
|
IF AC THEN P(MKS,0,1,1,0,R,[OUTFIL],1,CORW) 00817600
|
|
ELSE BEGIN 00817700
|
|
P(MKS,1,0,0,R,[OUTFIL],ALWR); 00817800
|
|
P(MKS,1,0,0,(-R),[OUTFIL],ALWR,DEL); END; 00817900
|
|
IF TR THEN IF P THEN P(1,[OUTFIL[NOT 2]],83,17,COM); 00818000
|
|
END; 00818100
|
|
END; 00818200
|
|
END WRITEOUT; 00818300
|
|
SUBROUTINE FIRSTSELECT; % INITIAL SELECTION OF LOW RECORD 00818400
|
|
BEGIN 00818500
|
|
X ~ 0; I~MS-1; 00818600
|
|
DO BEGIN 00818700
|
|
I~I+1; 00818800
|
|
V[I] ~ V[X+((IF ALFA THEN P(0,MKS,0,VX1,VX,EQUALS) 00818900
|
|
ELSE IF AC THEN P(0,MKS,VX1,VX,EQUALS) 00819000
|
|
ELSE P(MKS,VA1,0,VA,0,EQUALS)) AND TRUE)]; 00819100
|
|
END UNTIL (X~X+2) = STPP; VLOW ~ V[I].[18:15]; 00819200
|
|
END FIRSTSELECT; 00819300
|
|
SUBROUTINE LOWSELECT; 00819400
|
|
BEGIN 00819500
|
|
X ~ VLOW AND 1022; 00819600
|
|
DO BEGIN 00819700
|
|
I ~ MS + X.[38:9]; % I ] MS + (X/2) 00819800
|
|
V[I] ~ V[X+((IF ALFA THEN P(0,MKS,0,VX1,VX,EQUALS) 00819900
|
|
ELSE IF AC THEN P(0,MKS,VX1,VX,EQUALS) 00820000
|
|
ELSE P(MKS,VA1,0,VA,0,EQUALS)) AND TRUE)]; 00820100
|
|
X ~ I AND 1022; 00820200
|
|
END UNTIL I = STPP; VLOW ~ V[I].[18:15]; 00820300
|
|
END LOWSELECT; 00820400
|
|
%*********************************% 00820500
|
|
SUBROUTINE MERGEIT; % MERGES M STRINGS TO 1 STRING 00820600
|
|
BEGIN 00820700
|
|
MIC: FIRSTSELECT; 00820800
|
|
GO TO MIE; 00820900
|
|
MID: LOWSELECT; 00821000
|
|
MIE: IF VLOW < MS THEN 00821100
|
|
BEGIN; % MOVE LOW RECORD TO OUTPUT FILE 00821200
|
|
STREAM(P1~VL,P2~R,P3~(P(DUP)).[36:6],P4~*[COIOD]); 00821300
|
|
BEGIN SI~P1;P3(DS~32WDS;DS~32WDS);DS~ P2 WDS END; 00821400
|
|
WRITEOUT; IF MF THEN INREAD ELSE TAPEREAD; 00821500
|
|
GO TO MID; 00821600
|
|
END; 00821700
|
|
FOR I ~ 0 STEP 1 UNTIL MS-1 DO % CHECK FOR RECORD = HIGH KEY 00821800
|
|
IF (VLOW ~ V[I].[18:15]) < MS THEN GO TO MIE; 00821900
|
|
END MERGEIT; 00822000
|
|
START: 00822100
|
|
CIIOD ~ 0; P(([CIIOD].[33:15]+2),STS); 00822200
|
|
MS ~ 2; TM1~NT-1; WHILE MS<(TM1+MF) DO MS~MS|2; 00822300
|
|
IF MF THEN 00822400
|
|
BEGIN % MERGE ONLY 00822500
|
|
TP ~ ((NOT 7) INX [NT]); FM ~ TRUE; 00822600
|
|
P(MKS,[VN],(2|MS)-1,1,1,1,BLOCK); P(MKS,[MHN],R,1,1,1,BLOCK);00822700
|
|
P(M|S,MHK); IF NOT AC THEN P(0,CDC,MHK,XCH,RDS,CFX,0); 00822800
|
|
P(HIVALU); 00822820
|
|
FOR VLOW ~ 0 STEP 1 UNTIL TM1 DO 00822900
|
|
BEGIN % OPEN TAPES 00823000
|
|
CIIOD ~ TP[VLOW+1]; PRFIB ~ CIIOD[NOT 2]; 00823100
|
|
PRFIB[13].[27:1] ~ 1; % SET TO OPEN INPUT 00823200
|
|
IF AC THEN P(MKS,[CIIOD[NOT 2]],1,COFCR) 00823300
|
|
ELSE TC[VLOW]~P(MKS,0,3,CIIOD,ALRD)<0; 00823400
|
|
IF PRFIB[5].[39:1] THEN TC[VLOW] ~ 1 ELSE %OPTIONAL 00823500
|
|
BEGIN 00823600
|
|
P(CIIOD); WAIT; IF AC THEN INREAD; 00823700
|
|
END; 00823800
|
|
END; 00823900
|
|
FOR I ~ 0 STEP 1 UNTIL MS-1 DO 00824000
|
|
BEGIN 00824100
|
|
IF I > TM1 OR TC[I] THEN V[I] ~ NFLAG(MHK)&MS[18:33:15] 00824200
|
|
ELSE V[I]~NFLAG(P(TP[I+1])&(IF(AC AND 3)=3 THEN 00824300
|
|
P(2,NOT,XCH,INX,LOD,20,COC,0,XCH,FCX,DIB 0,LOD,I) 00824310
|
|
ELSE P(LOD,I))[CTF]); 00824320
|
|
END; 00824400
|
|
OPENOUT; IF(AC AND 3)!3 THEN COIOD ~ OUTFIL; 00824500
|
|
STPP ~ 2 | MS - 2; 00824550
|
|
MERGEIT; 00824600
|
|
FOR I ~1 STEP 1 UNTIL TM1 + 1 DO %CLOSE LOCK ALL IAPES 00824610
|
|
BEGIN CIIOD ~TP [I] ; % PG 00824630
|
|
P (MKS,2,0,[CIIOD[NOT 2 ]],4,FCR); % PG 00824660
|
|
END; % % PG 00824670
|
|
GO TO SORTDONE; 00824700
|
|
END; 00824800
|
|
FOR I ~ COT STEP 1 UNTIL TM1 DO % WRITE OUT DUMMY STRINGS 00824900
|
|
IF TN[I] < TC[I] THEN % PERFECT DISTRIBUIION 00825000
|
|
BEGIN 00825100
|
|
IF COT ! I THEN 00825200
|
|
BEGIN 00825300
|
|
PRFIB ~ COIOD[NOT 2]; COIOD[0] ~ FLAG(PRFIB[16]); 00825400
|
|
P(((NOT 2) INX TP[I]),((NOT 2) INX TP[COT]), 00825500
|
|
20,COM,DEL,DEL); 00825600
|
|
COIOD ~ TP[I]; COIOD[0] ~ 1 INX *COIOD; 00825700
|
|
COT ~ I; 00825800
|
|
END; 00825900
|
|
WHILE TN[I] < TC[I] DO % PERFECT DISTRIBUTION PATTERN 00826000
|
|
BEGIN COIOD ~ TP[I] ; PRFIB ~ COIOD[NOT 2]; 00826100
|
|
PRFIB[11] ~ TBO; PRFIB[9] ~ 0; WRITESTOPPER; 00826200
|
|
END; 00826300
|
|
END; 00826400
|
|
FOR I ~ 1 STEP 1 UNTIL TM1 DO 00826500
|
|
BEGIN % SET UP TO DO POLYPHASE MERGE 00826600
|
|
CIIOD ~ TP[I] ; 00826700
|
|
P(MKS, 2 ,0,[CIIOD[NOT 2]],6,FCR); % REWIND OR RELEASE 00826800
|
|
END; 00826900
|
|
P(MKS,[VN],(2|MS)-1,1,1,1,BLOCK); STPP ~ 2|MS-2; MHN~0; 00827000
|
|
P(MKS,[MHN],R,1,1,1,BLOCK); % HI-KEY 00827100
|
|
P(MKS,MHK); IF NOT AC THEN P(0,CDC,MHK,XCH,RDS,CFX,0); 00827200
|
|
P(HIVALU); 00827220
|
|
FOR I ~ 1 STEP 1 UNTIL TM1 DO 00827300
|
|
BEGIN % OPEN INPUT TAPES 00827400
|
|
CIIOD ~ TP[I] ; PRFIB ~ CIIOD[NOT 2]; 00827500
|
|
PRFIB[13].[27:1] ~ 1; P(CIIOD,0,11,COM,DEL,DEL); 00827600
|
|
P(CIIOD); WAIT; PRFIB[11] ~ TBO; PRFIB[9] ~ 0; 00827700
|
|
CIIOD[0] ~ 1 INX *CIIOD; 00827800
|
|
END; 00827900
|
|
TPD: FM ~ TRUE; 00828000
|
|
FOR I ~ 1 STEP 1 UNTIL TM1 DO IF TN[I] > 1 THEN FM ~ FALSE; 00828100
|
|
IF FM THEN 00828200
|
|
BEGIN OPENOUT; IF(AC AND 3)!3 THEN COIOD ~ OUTFIL END 00828250
|
|
ELSE % OPEN SCRATCH OUTPUT TAPE 00828300
|
|
BEGIN COIOD ~ TP[NT]; PRFIB ~ *[COIOD[NOT 2]]; 00828400
|
|
PRFIB[13].[27:1] ~ 0; % SET TO OUTPUT 00828500
|
|
P(COIOD,0,11,COM,DEL,DEL); 00828600
|
|
PRFIB[11] ~ TBO; PRFIB[9] ~ 0; COT ~ NT; 00828700
|
|
P(COIOD); WAIT; COIOD[0] ~ 1 INX FLAG(PRFIB[16]); 00828800
|
|
END; 00828900
|
|
COMMENT SET UP VECTOR ROW 0; 00829000
|
|
TPE: FOR I ~ 0 STEP 1 UNTIL MS - 1 DO 00829100
|
|
BEGIN 00829200
|
|
IF I } TM1 THEN BEGIN EOF ~ TRUE; GO TO TPF END; 00829300
|
|
CIIOD ~ TP[I+1] ; PRFIB ~ CIIOD[NOT 2]; 00829400
|
|
IF (EOF ~ (*CIIOD).[27:1]) THEN GO TO TPF; 00829500
|
|
IF ( X ~ (*(FLAG(PRFIB[16])))) !0 THEN %TR-142 00829600
|
|
IF NOT ( EOF ~X.[33:15] = 0 ) THEN PRFIB[11] ~X.[18:15] %IR-14200829610
|
|
ELSE ELSE PRFIB[11] ~ TBO ; PRFIB[9] ~0; %IR-14200829620
|
|
TPF: IF TN[I+1] = 0 OR EOF 00829700
|
|
THEN BEGIN % PG 00829800
|
|
V[I] ~NFLAG(MHK)&MS[18:33:15]; % PG 00829825
|
|
IF FM AND I LSS TM1 THEN P(MKS,4,0,[CIIOD[NOT 2]],4,FCR);00829850
|
|
END % PG 00829875
|
|
ELSE V[I] ~ NFLAG(P(*TP[I+1])&I[18:33:15]); 00829900
|
|
EOF ~ FALSE; 00830000
|
|
END; 00830100
|
|
MERGEIT; 00830200
|
|
IF FM THEN GO TO SORTDONE ELSE WRITESTOPPER; 00830300
|
|
COMMENT HAVE MERGED A STRING OFF EACH TAPE; 00830400
|
|
COMMENT CHECK IF REWIND NEEDED; 00830500
|
|
FOR I ~ 1 STEP 1 UNTIL TM1 DO TN[I] ~ TN[I] - 1; 00830600
|
|
FOR I ~ 1 STEP 1 UNTIL TM1 DO IF TN[I] { 0 THEN 00830700
|
|
BEGIN % REWIND IS NEEDED 00830800
|
|
PRFIB ~ COIOD[NOT 2]; 00830900
|
|
P(MKS, 2 ,0,[COIOD[NOT 2]],6,FCR); % REWIND OR RELEASE 00831000
|
|
CIIOD~TP[I]; 00831100
|
|
P(MKS,4,0,[CIIOD[NOT 2]],4,FCR); % CLOSE PURGE 00831200
|
|
TN[I] ~ TN[NT]; TN[NT]~ 0; 00831300
|
|
PRFIB[13].[27:1] ~ 1; % SET FORMER OUTPUT TO INPUT 00831400
|
|
% %IR-14200831500
|
|
P(COIOD,0,11,COM,DEL,DEL); % OPEN FOR INPUT 00831600
|
|
P(COIOD); WAIT; COIOD[0] ~ 1 INX FLAG(PRFIB[16]); 00831700
|
|
P((TP[NT])); TP[NT] ~ TP[I]; TP[I] ~ P(XCH); 00831800
|
|
GO TO TPD; 00831900
|
|
END; 00832000
|
|
GO TO TPE; 00832100
|
|
SORTDONE: 00832200
|
|
COMMENT JUST DID FINAL PASS; 00832300
|
|
COMMENT RETURN EVERYTHING; 00832400
|
|
IF NOT MF THEN 00833000
|
|
P([DOTOP]&0[18:18:15],6,11,COM,DEL,DEL); 00833100
|
|
IF NOT OPTOG THEN BEGIN 00833200
|
|
P(MKS,2,0,[OUTFIL[NOT 2]],4,FCR) 00833300
|
|
; IF NOT AC THEN P(0,OUTFIL[NOT 2],8,CDC,STD); 00833400
|
|
END ELSE 00833500
|
|
BEGIN COMMENT CALL OUTPUT PROCEDURE PASSING END-OF-SORT FLAG; 00833600
|
|
IF AC THEN 00833700
|
|
BEGIN ENDQ ~ 1; IF AC.[46:1] THEN 00833800
|
|
P(MKS,BINGO,0,PERFORMGEN) % COBOL68 00833850
|
|
ELSE P(MKS,BINGO,[PRTBASE[P(DUP)]],LOD,IPFIDX,COC) 00833900
|
|
END ELSE P(MKS,1,MEM,0,OUTPRO); 00834000
|
|
END; 00834100
|
|
IF NOT MF THEN 00834200
|
|
IF OUTCOUNT!INCOUNT THEN P(INCOUNT,OUTCOUNT,0, 00834300
|
|
[DOTOP[NOT 2]],82,17,COM); 00834400
|
|
P(10,COM); % FALL OUT OF BLOCK COM WILL RETURN EVERYTHING 00834500
|
|
END POLYMERGE; 00834600
|
|
REAL PROCEDURE OUMPINT(SN,CV,BV, TIPE,TENS,ALFA,CHAR,FIEL,FORMT);% 00900000
|
|
VALUE SN,CV,BV, TIPE,TENS,ALFA,CHAR,FORMT;% 00900100
|
|
REAL SN,CV,BV, TIPE,TENS,ALFA,CHAR,FORMT;% 00900200
|
|
NAME FIEL;% 00900300
|
|
BEGIN% 00900400
|
|
REAL E=+1,% 00900500
|
|
VALUEE=+2,% 00900600
|
|
DH1=+3,% 00900700
|
|
DH2=+4,% 00900800
|
|
LNGTH=+5,% 00900900
|
|
CSIZE=+6,% 00901000
|
|
BCTR=+7% 00901100
|
|
, TEMP=+8,% 00901200
|
|
NL =+9% 00901300
|
|
, J =+10,% 00901400
|
|
TROW=+11,% 00901500
|
|
COUNT=+12,% 00901600
|
|
TARRY=+13,% 00901700
|
|
N=BV,% 00901800
|
|
SINN=9;% 00901900
|
|
LABEL% 00902000
|
|
PRINT,% 00902100
|
|
PR3,% 00902200
|
|
BRTN,% 00902300
|
|
TA,% 00902400
|
|
TCP,% 00902500
|
|
TC,% 00902600
|
|
IRTN,% 00902700
|
|
P2,% 00902800
|
|
P1,% 00902900
|
|
TB,% 00903000
|
|
TD,% 00903100
|
|
P3E,% 00903200
|
|
TF,% 00903300
|
|
TP2,% 00903400
|
|
TP3,% 00903500
|
|
TP22,% 00903600
|
|
TP1,% 00903700
|
|
TP8,% 00903800
|
|
TP5,% 00903900
|
|
TP11,% 00904000
|
|
TD1,% 00904100
|
|
TD2,% 00904200
|
|
TD3,% 00904300
|
|
TP10,% 00904400
|
|
TP9,% 00904500
|
|
TP6,% 00904600
|
|
TP7,% 00904700
|
|
TP71,% 00904800
|
|
P3,% 00904900
|
|
P3A,% 00905000
|
|
P3L,% 00905100
|
|
P3I,% 00905200
|
|
EA,% 00905300
|
|
EB,% 00905400
|
|
EC,% 00905500
|
|
ED,% 00905600
|
|
P5,% 00905700
|
|
EE,% 00905800
|
|
EFAA,% 00905900
|
|
EFA,% 00906000
|
|
ERTN,% 00906100
|
|
EFB,% 00906200
|
|
EFC;% 00906300
|
|
SWITCH OCSWITCH~TA,TB,TC,TCP,TD;% 00906400
|
|
SWITCH TIPESW~P3L,P3E,P3A,P3I;% 00906500
|
|
REAL RITEINT=12;% 00906600
|
|
REAL SELECT=14;% 00906700
|
|
NAME M=2;% 00906800
|
|
DEFINE I=ALFA#;% 00906900
|
|
SUBROUTINE RITE;% 00907000
|
|
BEGIN% 00907100
|
|
P(MKS,1,0,0,LNGTH,FIEL,RITEINT, 00907200
|
|
MKS,1,0,0,(-1),FIEL,RITEINT,DEL); 00907300
|
|
END;% 00907400
|
|
SUBROUTINE FINDE ;% 00907500
|
|
BEGIN IF P(VALUEE|@1141000000000000,DUP)!0 THEN% 00907600
|
|
BEGIN% 00907700
|
|
SINN~P(DUP,0,<); P(SSP,.VALUEE,SND);% 00907800
|
|
IF P(0,XCH,DIA 3,DIB 42,TRB 6,VALUEE,DIA 2% 00907900
|
|
, DIB 1,TRB 1,12,+,@1157163034761674,|,% 00908000
|
|
@1154000000000000,+,.E,ISN,DUP)<0 THEN GO TO EFB;% 00908100
|
|
P(TENS);% 00908200
|
|
EFAA:IF P { VALUEE THEN GO TO ERTN;GO TO EFC;% 00908300
|
|
END;% 00908400
|
|
P(DEL);% 00908500
|
|
E~SINN~0;GO TO ERTN;% 00908600
|
|
EFB: P(CHS,TENS,1,XCH,/); GO TO EFAA; 00908700
|
|
EFC: E~E-1;% 00908800
|
|
ERTN:% 00908900
|
|
END;% 00909000
|
|
SUBROUTINE OUTI;% 00909100
|
|
BEGIN FINDE;% 00909200
|
|
P(VALUEE,.DH1,ISD);% 00909300
|
|
STREAM(P8~0:P7~SINN,P6~[VALUEE],P5~SINN,P4~0,P3~% 00909400
|
|
E+1+SINN,P2~0,P1~BCTR);% 00909500
|
|
BEGIN% 00909600
|
|
P2(DS~LIT" ");% 00909700
|
|
P1~DI;SI~P6;DS~P4 DEC; SI~P6;SI~SI+8;% 00909800
|
|
DS~P3 DEC; P8~DI;SI~P1;DI~P1;% 00909900
|
|
P7(IF SC!"0" THEN JUMP REAL TO IA;% 00910000
|
|
DS~LIT " ";SI~SI+1);% 00910100
|
|
IA:SI~LOC P4;SI~SI-1;IF SC="1" THEN% 00910200
|
|
BEGIN% 00910300
|
|
DI~DI-1;% 00910400
|
|
DS~LIT"-";% 00910500
|
|
END;% 00910600
|
|
END;BCTR~P;% 00910700
|
|
END;% 00910800
|
|
SUBROUTINE BLNK;% 00910900
|
|
BEGIN;% 00911000
|
|
STREAM(P3~CSIZE,P2~CSIZE DIV 64,P1~(BCTR~*FIEL INX 0)00911100
|
|
);% 00911200
|
|
BEGIN% 00911300
|
|
P2(32(DS~2 LIT" "));% 00911400
|
|
P3(DS~LIT" ");% 00911500
|
|
END;% 00911600
|
|
END;% 00911700
|
|
IF FORMT=5 THEN DUMPINT~FIEL ELSE% 00911800
|
|
BEGIN P(0,0,0 );% 00911900
|
|
IF M[M[FIEL INX NOT 2] INX 5].[43:1] THEN% 00912000
|
|
P(MKS,0,0,FIEL,1,SELECT);% 00912100
|
|
IF P(MKS,1,0,0,(-1),FIEL,RITEINT,DUP)>16 THEN P(DEL,16) ; 00912200
|
|
IF P(DUP) <4 THEN P(XIT);% 00912300
|
|
P(DUP,8,|,0,0 );BLNK;% 00912400
|
|
BRTN: GO TO OCSWITCH[FORMT];% 00912500
|
|
TA: STREAM(BCTR:A~ALFA ); BEGIN DI~BCTR;% 00912600
|
|
SI~LOC A;SI~SI+1; DS~7 CHR END;% 00912700
|
|
RITE;P(XIT);% 00912800
|
|
TCP: IF (TEMP~TEMP+1){N THEN% 00912900
|
|
IF P(TEMP-1,NOT,[CV],INX,LOD)!P(TEMP+N-1,NOT,[CV],% 00913000
|
|
INX,LOD) THEN P(XIT) ELSE GO TO TCP;% 00913100
|
|
TC: STREAM(BCTR:A~ALFA ); BEGIN DI~BCTR;% 00913200
|
|
SI~LOC A;SI~SI+1; DS~6 CHR;DS~% 00913300
|
|
1 LIT"["; BCTR~DI;% 00913400
|
|
END; BCTR~P;% 00913500
|
|
VALUEE~P(N-1,NOT,[CV],INX,LOD);% 00913600
|
|
OUTI;% 00913700
|
|
IRTN: I~0;% 00913800
|
|
P2: IF (I~I+1)<N THEN% 00913900
|
|
BEGIN;STREAM(B~0 : BCTR);% 00914000
|
|
BEGIN DS~ 1 LIT",";B~DI END;BCTR~P;% 00914100
|
|
VALUEE~P(N-I-1,NOT,[CV],INX,LOD);% 00914200
|
|
OUTI;GO TO P2; END;% 00914300
|
|
P1: VALUEE~CV;% 00914400
|
|
STREAM(B~0: BCTR);% 00914500
|
|
BEGIN DS~2 LIT"]=";B~DI END; BCTR~P;% 00914600
|
|
GO TO P3;% 00914700
|
|
TB: VALUEE~BV;% 00914800
|
|
STREAM(BCTR:ALFA ); BEGIN DI~BCTR;% 00914900
|
|
SI~LOC ALFA;SI~SI+1; DS~6 CHR;DS~1 LIT"=";% 00915000
|
|
BCTR~DI% 00915100
|
|
END; BCTR~P; GO TO P3;% 00915200
|
|
TD: STREAM(BCTR:ALFA ); BEGIN DI~BCTR;% 00915300
|
|
SI~LOC ALFA;SI~SI+1; DS~6 CHR;DS~1 LIT"=";% 00915400
|
|
BCTR~DI% 00915500
|
|
END; BCTR~P;% 00915600
|
|
RITE; BLNK;% 00915700
|
|
TF: P((LNGTH|8) DIV(IF TIPE=0 THEN 6 ELSE IF TIPE=1% 00915800
|
|
THEN 19 ELSE IF TIPE= 2 THEN 9% 00915900
|
|
ELSE 14),0,0,0,0,0,DEL,DEL);% 00916000
|
|
P([TARRY]&(2|N+1)[8:38:10]);I~0;% 00916100
|
|
TP2: P(0);% 00916200
|
|
TP3: IF (I~I+1)<N THEN GO TO TP2;% 00916300
|
|
I~0;P(0,.CV,LOD);GO TO TP1;% 00916400
|
|
TP22:P(0,.TEMP,LOD,LOD);% 00916500
|
|
TP1:P(.TEMP,SND,DIA 8,DIB 38,TRB 10);IF (I~I+1)<N THEN% 00916600
|
|
GO TO TP22;% 00916700
|
|
TP8: I~0;P(.CV,LOD);% 00916800
|
|
TP5: IF(I~I+1)<N THEN% 00916900
|
|
BEGIN% 00917000
|
|
P(I,TARRY,CDC,LOD);GO TO TP5% 00917100
|
|
END;% 00917200
|
|
TROW~P; J~0;% 00917300
|
|
TP11:P(J);VALUEE~TROW;GO TO P3;% 00917400
|
|
TD1: IF(J~J+1)<P(N,DUP,+,TARRY) THEN GO TO TP7;% 00917500
|
|
RITE;BLNK;% 00917600
|
|
TD2: RITE;BLNK;% 00917700
|
|
TD3: P(0,.COUNT,SND);GO TO TP6;% 00917800
|
|
TP10: IF P(N-I,TARRY,2|N-I,TARRY,1,-,=) THEN GO TO TP9;% 00917900
|
|
P(N-I,[TARRY],DUP,COC,1,+,XCH,~);GO TO TP8;% 00918000
|
|
TP9: P(0,N-I,[TARRY],~,I); 00918100
|
|
TP6: IF(I~P(1,+))=N THEN P(XIT) ELSE GO TO TP10;% 00918200
|
|
TP7: IF(COUNT~COUNT+1)!NL THEN GO TO TP11;% 00918300
|
|
RITE;BLNK;% 00918400
|
|
TP71:COUNT~0;GO TO TP11;% 00918500
|
|
P3: GO TO TIPESW[TIPE];% 00918600
|
|
P3A: STREAM(BCTR:VALUEE); BEGIN DI~BCTR;% 00918700
|
|
SI~LOC VALUEE;SI~SI+1;DS~2 LIT" ";DS~7% 00918800
|
|
CHR;BCTR~DI;% 00918900
|
|
END;BCTR~P;GO TO P5;% 00919000
|
|
P3L: STREAM(V~VALUEE AND 1:BCTR); 00919100
|
|
BEGIN DS~6 LIT " FALSE"; 00919200
|
|
V(DI~DI-5; DS~5 LIT "TRUE "); 00919300
|
|
V~DI; 00919400
|
|
END; BCTR~P;GO TO P5;% 00919500
|
|
P3I: IF VALUEE { @7777777777777 THEN% 00919600
|
|
BEGIN P(VALUEE,.VALUEE,ISN,DUP,0,<,.SINN,~,% 00919700
|
|
SSP,.DH2,SND,@1045753604000000,DIV,% 00919800
|
|
.DH1,~);% 00919900
|
|
STREAM(P8~0:P7~11,P6~[DH1],P5~SINN,P4~4,P3~8,P2~2,% 00920000
|
|
P1~BCTR);% 00920100
|
|
BEGIN% 00920200
|
|
P2(DS~LIT" ");% 00920300
|
|
P1~DI;% 00920400
|
|
SI~P6;% 00920500
|
|
DS~P4 DEC; SI~P6;SI~SI+8;DS~P3 DEC;% 00920600
|
|
P8~DI;SI~P1;DI~P1;% 00920700
|
|
P7(IF SC!"0" THEN JUMP REAL TO IA;% 00920800
|
|
DS~LIT " "; SI~SI+1);% 00920900
|
|
IA:SI~LOC P4;SI~SI-1;IF SC="1" THEN% 00921000
|
|
BEGIN% 00921100
|
|
DI~DI-1;DS~LIT "-";% 00921200
|
|
END;% 00921300
|
|
END;BCTR~P; GO TO P5;% 00921400
|
|
END;% 00921500
|
|
P3E: FINDE; DH2~0;% 00921600
|
|
EB: IF P(VALUEE,E,11,-,DH2,+,DUP)<0 THEN% 00921700
|
|
BEGIN P(CHS,TENS,MUL); GO TO ED END;% 00921800
|
|
EC: P(TENS,/); 00921900
|
|
ED: IF P(DUP) { @7777777777777 THEN% 00922000
|
|
BEGIN% 00922100
|
|
P(.DH1,ISN);% 00922200
|
|
IF P(DUP) } P(12-DH2,TENS) THEN% 00922300
|
|
BEGIN% 00922400
|
|
P(DEL);% 00922500
|
|
P(11-DH2,TENS,.DH1,ISN); 00922600
|
|
E ~ E + 1;% 00922700
|
|
END;% 00922800
|
|
P(@1045753604000000,IDV,.VALUEE,~); 00922900
|
|
STREAM(P10~0:P9~ABS(E),P8~(E<0),P7~SINN,P6~DH2,% 00923000
|
|
P5~[VALUEE],P4~4-DH2,P3~8,P2~2,P1~BCTR);% 00923100
|
|
BEGIN% 00923200
|
|
P2(DS~LIT" ");P1~DI;SI~LOC P6;SI~SI-1;% 00923300
|
|
IF SC="1"% 00923400
|
|
THEN BEGIN% 00923500
|
|
DI~DI-1;DS~LIT"-"% 00923600
|
|
END;% 00923700
|
|
DI~DI+1;SI~P5;DS~P4 DEC;SI~P5;SI~SI+8;% 00923800
|
|
DS~P3 DEC;% 00923900
|
|
P6(DS~LIT"0");% 00924000
|
|
DS~LIT"@";% 00924100
|
|
SI~LOC P7;SI~SI-1;% 00924200
|
|
IF SC="1" THEN DS~LIT"-" ELSE DS~LIT"+";% 00924300
|
|
SI~LOC P9;DS~2 DEC; P10~DI;SI~P1;SI~SI+1; 00924400
|
|
DI~P1;DS~CHR;DS~LIT".";% 00924500
|
|
END;BCTR~P;% 00924600
|
|
P5: IF FORMT=4 THEN GO TO TD1;% 00924700
|
|
RITE; P(XIT); END;% 00924800
|
|
P(DEL);DH2~DH2+1;GO TO EB;% 00924900
|
|
END;% 00925000
|
|
END DUMPINT;% 00925100
|
|
PROCEDURE XTOTHEIINT(BASE,EXPON,M,LOG,EXP);% 01000000
|
|
VALUE BASE,EXPON,M,LOG,EXP;% 01001000
|
|
REAL BASE,EXPON,M,LOG,EXP;% 01002000
|
|
BEGIN LABEL ROWS,MORE,EXIT;% 01003000
|
|
REAL CTR=+1,F2=+2;% 01004000
|
|
IF EXPON = 0 THEN% 01005000
|
|
BEGIN BASE ~ 1; P(XIT) END;% 01006000
|
|
IF BASE = 0 THEN P(XIT);% 01007000
|
|
IF EXPON.[3:35] ! 0 THEN% 01008000
|
|
BEGIN BASE ~ P(MKS,BASE,LOG,MKS,CTR,EXPON,|,EXP);% 01009000
|
|
P(XIT);% 01010000
|
|
END;% 01011000
|
|
P(1,EXPON,BASE,DIA 38, DIB 39,EXPON);% 01012000
|
|
ROWS:: IF P(0,XCH,FCE 9) THEN% 01013000
|
|
BEGIN P(DEL);% 01014000
|
|
MORE:: IF (CTR ~ CTR-1) = 0 THEN GO TO EXIT;% 01015000
|
|
P(MUL);% 01016000
|
|
GO TO MORE;% 01017000
|
|
::% 01018000
|
|
END;% 01019000
|
|
P(DEL);% 01020000
|
|
IF EXPON THEN% 01021000
|
|
BEGIN CTR ~ CTR+1;% 01022000
|
|
P(DUP);% 01023000
|
|
END;% 01024000
|
|
P(DUP,MUL,0,EXPON,TRB 9,.EXPON,SND);% 01025000
|
|
GO TO ROWS;% 01026000
|
|
EXIT: IF F2 < 0 THEN P(1,XCH,/);% 01027000
|
|
BASE ~ P;% 01028000
|
|
END;% 01029000
|
|
PROCEDURE STATUSINT(T,C); VALUE T,C; REAL T; INTEGER C; 01100000
|
|
BEGIN P(T,C,28,COM,DEL,RTN) END; 01101000
|
|
REAL PROCEDURE ABSINT(X); VALUE X; REAL X;% 01200000
|
|
BEGIN P(ABS(X),RTN) END;% 01201000
|
|
REAL PROCEDURE SIGNINT(X); VALUE X; REAL X;% 01300000
|
|
BEGIN P(SIGN(X),RTN) END;% 01301000
|
|
INTEGER PROCEDURE ENTIERINT(X); VALUE X; REAL X;% 01400000
|
|
BEGIN ENTIERINT ~ X-.5 END;% 01401000
|
|
REAL PROCEDURE TIMEINT (X); VALUE X; REAL X;% 01500000
|
|
BEGIN P(X,1, COM,RTN) END;% 01501000
|
|
PROCEDURE DELAYINT(ARRY, MASK, TIME);% %WF 01600000
|
|
VALUE ARRY, MASK, TIME;% %WF 01601000
|
|
ARRAY ARRY[*]; REAL MASK; INTEGER TIME;% %WF 01602000
|
|
BEGIN POLISH(ARRY, MASK, TIME, 31, COM, DEL, DEL, RTN) END;% %WF 01603000
|
|
PROCEDURE SQRTINT(X); VALUE X; REAL X;% 01700000
|
|
BEGIN REAL Y=+1,Z=+2;% 01701000
|
|
LABEL P5,ONE;% 01702000
|
|
DEFINE INNER = XCH,MUL,DUP,Y,XCH,/#,% 01703000
|
|
ITER = P(+,P5,INNER)#;% 01704000
|
|
IF X<0 THEN P(1,26,COM); % ARGUMENT CHECK %IA01705000
|
|
IF P(ABS(X),DUP) ! 0 THEN% 01706000
|
|
BEGIN P(ONE,+,DUP,0,DEL,% 01707000
|
|
DIA 7, DIB 45, VFI 3 7, Y,% 01708000
|
|
DIA 2, TRB 1,.ONE,+,LOD,% 01709000
|
|
Y,DUP,DIB 3,TRB 6,XCH,INNER);% 01710000
|
|
ITER;ITER;ITER;% 01711000
|
|
P(Z,-,P5,|,+);% 01712000
|
|
END ;% 01713000
|
|
P(RTN);% 01714000
|
|
P5::: @1154000000000000;% 01715000
|
|
ONE::: @1770000000000001,% 01716000
|
|
@1235560000000000,% 01717000
|
|
@1233250000000000,% 01718000
|
|
@1222000000000000,% 01719000
|
|
@1221150000000000,% 01720000
|
|
@0155560000000000,% 01721000
|
|
@0153250000000000,% 01722000
|
|
@0152000000000000,% 01723000
|
|
@0151150000000000;% 01724000
|
|
END;% 01725000
|
|
DEFINE SINCOSBODY =% 01800000
|
|
P(1);% 01801000
|
|
IF X < 0 THEN% 01802000
|
|
BEGIN X ~ -X; P(CHS) END;% 01803000
|
|
IF X } P(PI) THEN% 01804000
|
|
BEGIN P(NOP);% 01805000
|
|
IF P(X/P(PI)-P(HALF), DUP)>P(MAXI) %WF 01806000
|
|
THEN P(LITERAL, 26, COM); %WF 01807000
|
|
IF I ~ POLISH THEN P(CHS); %WF 01808000
|
|
X ~ X MOD P(PI);% 01809000
|
|
END;% 01810000
|
|
IF X } P(PIHAF) THEN% 01811000
|
|
BEGIN P(CHS);% 01812000
|
|
X ~ X-P(PI);% 01813000
|
|
END;% 01814000
|
|
IF ABS(X) < .000001 THEN P(Z|X,RTN);% 01815000
|
|
P(X,DUP,% 01816000
|
|
|,DUP,K1,NOP,|,K2,-,T,|,K3,+,T,|,K4,-,T,|,K5,+,T,|,K6,-,T,01817000
|
|
|,1.0,+,X,|,Z,XCH,|,RTN);% 01818000
|
|
PI :::@ 1143110375524210;% 01819000
|
|
PIHAF:::@ 1141444176652104;% 01820000
|
|
HALF :::@ 1154000000000000;% 01821000
|
|
K1 :::@ 1271245234431113;% 01822000
|
|
K2 :::@ 1253270005320624;% 01823000
|
|
K3 :::@ 1235616716201177;% 01824000
|
|
K4 :::@ 1216400637634150;% 01825000
|
|
K5 :::@ 1174210421041102;% 01826000
|
|
K6 :::@ 1151252525252524;% 01827000
|
|
MAXI :::@ 0007777777777777;% %WF 01828000
|
|
#;% 01829000
|
|
PROCEDURE SININT(X); VALUE X; REAL X;% 01830000
|
|
BEGIN REAL T=+2,Z=+1;% 01831000
|
|
INTEGER I=T;% 01832000
|
|
LABEL PI,PIHAF,HALF;% 01833000
|
|
LABEL K1,K2,K3,K4,K5,K6;% 01834000
|
|
LABEL MAXI;% %WF 01835000
|
|
DEFINE LITERAL = 4#; %WF 01836000
|
|
;SINCOSBODY;% 01837000
|
|
END;% 01838000
|
|
PROCEDURE COSINT(X); VALUE X; REAL X;% 01839000
|
|
BEGIN REAL T=+2,Z=+1;% 01840000
|
|
INTEGER I=T;% 01841000
|
|
LABEL PI,PIHAF ,HALF;% 01842000
|
|
LABEL K1,K2,K3,K4,K5,K6;% 01843000
|
|
LABEL MAXI; %WF 01844000
|
|
DEFINE LITERAL = 5#; %WF 01845000
|
|
X ~ X+P(PIHAF ,NOP,NOP,NOP);% 01846000
|
|
SINCOSBODY;% 01847000
|
|
END;% 01848000
|
|
COMMENT ARCTAN INTRINSIC FOR ESPOL;% 01900000
|
|
REAL PROCEDURE ARCTANINT(X1);% 01901000
|
|
VALUE X1; REAL X1;% 01902000
|
|
BEGIN REAL T=+1,D,PI2,ARCY;% 01903000
|
|
LABEL L1,ONEL,PIHAF,A,B,ARCA,ARCB,TENM6;% 01904000
|
|
LABEL K1,K2,K3,K4,K5,K6,K7;% 01905000
|
|
DEFINE ONE = P(ONEL)#;% 01906000
|
|
REAL X=X1;% 01907000
|
|
P(DIA 1,DIB 1);% 01908000
|
|
IF (T ~ ABS(X)) > ONE THEN% 01909000
|
|
BEGIN PI2 ~ P(PIHAF,X,TRB 1);% 01910000
|
|
IF T } P(L1) THEN P(X~0)% 01911000
|
|
ELSE P(ABS(X~-(ONE/X)));% 01912000
|
|
T ~ P;% 01913000
|
|
END;% 01914000
|
|
IF T < P(TENM6) THEN P(X+PI2,RTN);% 01915000
|
|
IF T > P(K1) THEN% 01916000
|
|
BEGIN IF T < P(K2) THEN P(A,ARCA) ELSE P(B,ARCB);% 01917000
|
|
D ~ P(X,TRB 1,.ARCY,SND,TRB 1);% 01918000
|
|
X ~ (X-D)/(D|X+ONE);% 01919000
|
|
END;% 01920000
|
|
P(X,DUP,% 01921000
|
|
|,.T,SND,K3,|,K4,+,T,|,K5,-,T,|,K6,+,T,|,K7,-,T,|,ONE,+,% 01922000
|
|
X,|,+,+,RTN);% 01923000
|
|
ONEL :::@ 1141000000000000;% 01924000
|
|
L1 :::@ 0631000000000000;% 01925000
|
|
K1 :::@ 1151210574175662;% 01926000
|
|
K2 :::@ 1154047010241407;% 01927000
|
|
K3 :::@ 3165354424670553;% 01928000
|
|
K4 :::@ 1167063634367006;% 01929000
|
|
K5 :::@ 1151111104736450;% 01930000
|
|
K6 :::@ 1151463146300126;% 01931000
|
|
K7 :::@ 1152525252525235;% 01932000
|
|
PIHAF:::@ 1141444176652104;% 01933000
|
|
A :::@ 1152462675773223;% 01934000
|
|
B :::@ 1155637726073171;% 01935000
|
|
ARCA :::@ 1152406627566472;% 01936000
|
|
ARCB :::@ 1155015457355165;% 01937000
|
|
TENM6:::@ 1232061573640554;% 01938000
|
|
END;% 01939000
|
|
COMMENT LN INTRINSIC FOR ESPOL;% 02000000
|
|
PROCEDURE LNINT(X); VALUE X; REAL X;% 02001000
|
|
BEGIN LABEL L1,L2,L3,K15,K16,K17,K18,K19;% 02002000
|
|
LABEL KON,K1,K2,K3,K4,K5,K6,K7,K8,K10,K11,K12,K13,K14;% 02003000
|
|
LABEL MIN;% 02004000
|
|
DEFINE ONE = P(KON)#;% 02005000
|
|
IF X{0 THEN P(X,0,=,DUP,+,26,COM); % ARGUMENT CHECK %IA02006000
|
|
IF (X ~ ABS(X+P(MIN)))> P(K1) THEN% 02007000
|
|
IF X < P( K2) THEN% 02008000
|
|
BEGIN P(0,0);% 02009000
|
|
L3: P(X);% 02010000
|
|
GO TO L2;% 02011000
|
|
END;% 02012000
|
|
P(X.[3:6]&X[1:2:1]+12,DUP,K3,|,XCH,DUP,+);% 02013000
|
|
IF (X~X&76[2:41:7]) } P(K7) THEN BEGIN% 02014000
|
|
IF X }P(K10) THEN BEGIN P(K14,+,K13); GO TO L1 END;% 02015000
|
|
BEGIN P(K12,+,K11); GO TO L1 END; END;% 02016000
|
|
IF X } P(K4) THEN% 02017000
|
|
BEGIN P(ONE,+,K8); GO TO L1 END;% 02018000
|
|
IF X { P(K2) THEN GO TO L3;% 02019000
|
|
P(K6,+,K5);% 02020000
|
|
L1:: P(X,|);% 02021000
|
|
L2: P(ONE,-,DUP,K14,+,% 02022000
|
|
/,DUP,DUP,NOP,% 02023000
|
|
|,.X,SND,K15,|,K16,+,X,|,K17,+,X,|,K18,+,X,|,K19,+,% 02024000
|
|
X,|,K14,+,XCH,|,+,+,RTN);% 02025000
|
|
MIN:::@1770000000000001;% 02026000
|
|
KON:::@1141000000000000;% 02027000
|
|
K1 :::@1156165757475261;% 02028000
|
|
K2 :::@1141221327436077;% 02029000
|
|
K4 :::@1142073716664320;% 02030000
|
|
K3 :::@1165053107716726;% 02031000
|
|
K5 :::@1154664262770676;% 02032000
|
|
K6 :::@1154000000000000;% 02033000
|
|
K7 :::@1143373034355542;% 02034000
|
|
K8 :::@1152742653066132;% 02035000
|
|
K10:::@1145602266440557;% 02036000
|
|
K11:::@1151621741671113;% 02037000
|
|
K12:::@1141400000000000;% 02038000
|
|
K13:::@1151052252521677;% 02039000
|
|
K14:::@1142000000000000;% 02040000
|
|
K15:::@1151406657727033;% 02041000
|
|
K16:::@1151615542107107;% 02042000
|
|
K17:::@1152222224366610;% 02043000
|
|
K18:::@1153146314625377;% 02044000
|
|
K19:::@1155252525252530;% 02045000
|
|
END;% 02046000
|
|
COMMENT EXP INTRINSIC FOR ESPOL;% 02100000
|
|
REAL PROCEDURE EXPINT(X) ; VALUE X ; REAL X;% 02101000
|
|
BEGIN% 02102000
|
|
REAL Q = +4, Z =+1, EX = +2, B=+3, Y=+5, T = +2;% 02103000
|
|
LABEL K0,K1,K2,K3,K4,K5,K6,HALF;% 02104000
|
|
LABEL MAX; 02105000
|
|
IF X < P(K0) THEN P(RTN);% 02106000
|
|
IF X>P(MAX) THEN P(3, 26, COM); %WF 02107000
|
|
P( X,K1,|,.X,SND, HALF,-,.Z, ISN,CHS,X,+,.X,SND,% 02108000
|
|
DUP,NOP,|,DUP,K2,NOP,|,K3,+,T,|,K4,+,T,K5,+,T,NOP,|,% 02109000
|
|
K6,+,X,|,DUP,B,+,B,Q,-,NOP,/,DUP,0,DEL,P.[3:6]&Y[1:2:1],% 02110000
|
|
Z,3,DIV,+, .EX , SND, P & P[2:1:1]&EX[3:42:6],% 02111000
|
|
Z,3, MOD,DUP,+, .EX, SND,0,! ) ;% 02112000
|
|
IF P THEN% 02113000
|
|
BEGIN IF Z < 0 THEN P( EX,/,CHS,RTN);% 02114000
|
|
P ( EX, | ); END; P (RTN);% 02115000
|
|
K0::: @ 3121520000000000 ;% 02116000
|
|
K1::: @ 1141342521662454 ;% 02117000
|
|
K2::: @ 1135326737175655 ;% 02118000
|
|
K3::: @ 1102360633500106 ;% 02119000
|
|
K4::: @ 1075621717466364 ;% 02120000
|
|
K5::: @ 1111554324131444 ;% 02121000
|
|
K6::: @ 1072002411247315 ;% 02122000
|
|
HALF::: @ 1154000000000000 ;% 02123000
|
|
MAX::: @ 1122360000000000 ; 02124000
|
|
END EXP INT ;% 02125000
|
|
PROCEDURE GOTOSOLVERINT(L,X,F,B);% 02200000
|
|
VALUE L,X,F,B;REAL L,X,B;ARRAY F[*];% 02201000
|
|
BEGIN IF L ! 15 THEN 02202000
|
|
L ~ L&(F)[18:33:15]&B[8:38:10];% 02203000
|
|
END;% 02204000
|
|
REAL PROCEDURE MAXINT(X);% %WF 02300000
|
|
VALUE X; REAL X;% %WF 02301000
|
|
BEGIN REAL RCW=+0, SIZE=+1, JUNK=+2;% %WF 02302000
|
|
POLISH(RCW, FCX, [RCW] INX NOT 1 INX 0, XCH, SUB, 0, X);% %WF 02303000
|
|
WHILE SIZE>0 DO BEGIN P(DUP);% %WF 02304000
|
|
JUNK ~ *(P(.X)+SIZE);% %WF 02305000
|
|
IF POLISH<(JUNK ~ JUNK) THEN P(DEL, DUP);% %WF 02306000
|
|
SIZE ~ SIZE-1;% %WF 02307000
|
|
END;% %WF 02308000
|
|
POLISH(RTN);% %WF 02309000
|
|
END MAXINT;% %WF 02310000
|
|
REAL PROCEDURE MININT(X);% %WF 02400000
|
|
VALUE X; REAL X;% %WF 02401000
|
|
BEGIN REAL RCW=+0, SIZE=+1, JUNK=+2;% %WF 02402000
|
|
POLISH(RCW, FCX, [RCW] INX NOT 1 INX 0, XCH, SUB, 0, X);% %WF 02403000
|
|
WHILE SIZE>0 DO BEGIN P(DUP);% %WF 02404000
|
|
JUNK ~ *(P(.X)+SIZE);% %WF 02405000
|
|
IF POLISH>(JUNK ~ JUNK) THEN P(DEL, DUP);% %WF 02406000
|
|
SIZE ~ SIZE-1;% %WF 02407000
|
|
END;% %WF 02408000
|
|
POLISH(RTN);% %WF 02409000
|
|
END MININT;% %WF 02410000
|
|
PROCEDURE SUPERMOVERINT(SORCE, DEST, AEXP);% %WF 02500000
|
|
VALUE AEXP; INTEGER AEXP; ARRAY SORCE[*], DEST[*];% %WF 02501000
|
|
BEGIN INTEGER T=+1;% %WF 02502000
|
|
POLISH(SORCE.[8:10], DEST.[8:10]);% %WF 02503000
|
|
IF P(DUP)<T THEN P(XCH);% %WF 02504000
|
|
IF P(DEL, DUP)>AEXP THEN T ~ AEXP;% %WF 02505000
|
|
IF T>0 THEN %WF 02506000
|
|
STREAM(P4~P, P3~P(DUP).[36:6], P2~[SORCE[0]]:P1~[DEST[0]]);%WF 02507000
|
|
BEGIN SI~P2; P3(DS~32 WDS; DS~32 WDS); DS~P4 WDS; END; %WF 02508000
|
|
END SUPERMOVERINT;% %WF 02509000
|
|
PROCEDURE COBOLFCR; 02600000
|
|
BEGIN 02600100
|
|
REAL CODE =-1; % 0=INVALID,1=OPEN INPUT,2=OPEN REV IN02600110
|
|
% 3=OPEN OUT,4=CLOSE,5=OPEN I-O,6=SORI02600120
|
|
% 7=CLOSE CRUNCH,16=OPEN1,17=CLOSE1 02600200
|
|
NAME FLOC =-2; % POINTER TO FIB DESCRIPTOR 02600300
|
|
REAL MKSCW =-3; % = MKSCW :NO REEL,= 1 FOR REEL CLOSE 02600400
|
|
% = REEL # FOR REEL OPEN. 02600410
|
|
REAL CLOSELOCK =-4; % HOW TO CLOSE THE FILE 02600420
|
|
% 0 = REWIND (RETAIN) 02600430
|
|
% 1 = NO REWIND (RETAIN) 02600450
|
|
% 2 = LOCK (SAVE) 02600470
|
|
% 4 = PURGE LOCK (RELEASE + PURGE) 02600480
|
|
% 6 = RELEASE LOCK (RELEASE + LOCK) 02600500
|
|
% 7 = RELEASE (LOOK AT SAVE FACTOR) 02600510
|
|
% 64 = CRUNCH 02600515
|
|
% PRT DESCRIPTORS 02600600
|
|
REAL COBOLCONTROL =23, % COBOL 61: FOR CALLING USE ROUTINES 02600650
|
|
COBOLINDEX =22, % COBOL 61: FOR CALLING USE ROUTINES 02600700
|
|
COBOLIO =14, % COBOL READ WRITE 02600800
|
|
FCR =12, % COBOL FCR 02600900
|
|
PERFORMGEN =13; % COBOL 68: FOR PERFORMING USE ROUTNS 02600990
|
|
REAL INTINT =5; % ARRAY DEC INTRINSIC 02600994
|
|
NAME MEM =2; % DUMMY DATA DESCRIPTOR 02600995
|
|
ARRAY FPB =3[*], % FILE PARAMEIER BLOCK 02601000
|
|
PGUSE =24[*];% USE ROUTINES ARRAY - COB61:13 WDS 02601100
|
|
% COB68: 6 WDS 02601400
|
|
% LOCALS 02601500
|
|
REAL REEL; % MUST BE HERE FOR MKSCW OIDDLE 02601600
|
|
ARRAY FIB[*]; % FILE INFO BLOCK 02601700
|
|
REAL I; % INDEX + TEMPORARY 02601800
|
|
NAME IOD=I; % IO DESCRIPTORS FOR CLOSE 02601900
|
|
REAL IX; % INDEX TO FPB 02601950
|
|
ARRAY LBL[*]; %LABEL FOR BUILDLABEL+HEADER FOR CLOSE02602000
|
|
REAL NOTSERL; % SET TRUE FOR RANDOM & IO FILES 02602050
|
|
INTEGER PU1,PU2, % USED BY BUILDLABEL + USERS.DONT MOVE02602100
|
|
FU1,FU2; % USED BY BUILDLABEL + USERS DONT MOVE02602150
|
|
REAL RPU1 = PU1, % USED BY BUILDLABEL 02602199
|
|
RPU2 = PU2; % USED BY BUILDLABEL 02602200
|
|
REAL T, % TEMPORARY 02602250
|
|
TEST, % TRUE WHEN CALLING USERS,USERS68 SAYS02602300
|
|
% TEST FOR BEG OR END FILE USE ROUTINE02602350
|
|
SVFIB, % TRUE IF COBOL68 FIB IS TO BE SAVED 02602360
|
|
COB68; % TRUE IF THIS IS COBOL 68 02602400
|
|
DEFINE 02602410
|
|
AF = [12:12]#, % COB68: FILL USL ROUTINE 02602430
|
|
ALGOLIO(ALGOLIO1)=P([IOD],ALGOLIO1,11,COM,DEL,DEL)#, 02602440
|
|
ARR = [36:12]#, % COB68: REEL USE ROUTINE 02602450
|
|
BACKSPACE = P((-I),[FLOC[3]] INX 0,9,11,COM)#, 02602455
|
|
BCOUNT = FIB[6]#, % BLOCK COUNT 02602460
|
|
BF = [1:11]#, % COB68: FILE USE ROUTINE 02602470
|
|
BOUNDED = FIB[9].[2:1]#, % TRUE IF BOUNDED FROM ABOVE 02602480
|
|
BREAKFAIL = P(FIB[15].[25:5],(I=1)|4,12,COM)#,%BR OUT FAIL02602490
|
|
BUFFERSIZE = FIB[18].[3:15]#, % BUFFER SIZE REQUESTED 02602500
|
|
BUFREQ = FIB[13].[1:9]#, % NO. OF BUFFERS REQUESIED 02602510
|
|
BUFTOP = FIB[16]#,% COPY OF TOP IOD:POINTS TO BEG BUFFR02602520
|
|
BRR = [24:12]#, % COB68: REEL USE ROUTINE 02602530
|
|
CALLHASH(CALLHASH1)=P(MKS,FLOC,*FIB[8],CALLHASH1,COC)#, 02602550
|
|
CLOSE = 4#, 02602560
|
|
CLOSED =(FIB[5].[41:2]!0)#,%FILE CLOSED 02602570
|
|
CLOSEDHERE = FIB[8].[1:1]#, % COB68 CLOSE HERE WAS DONE 02602575
|
|
CLOSEDRET = @20#, % CLOSED REIAINED 02602580
|
|
COBOLCLOSE = P(CLOSELOCK&REEL [2:47:1],FLOC,CODE,13,COM, 02602585
|
|
DEL,DEL,DEL)#, 02602586
|
|
COBOLFILE = FIB[13]#, % ON SAYS FILE IS COBOL 02602590
|
|
COBOLFILBIT = FIB[13].[47:1]#, 02602600
|
|
COBOLOPENIN = P(REEL,FLOC,CODE,13,COM,.I,~,DEL,DEL)#, 02602610
|
|
COBOLOPENOUT = P(REEL,FLOC,CODE,13,COM,DEL,DEL,DEL)#, 02602620
|
|
COUNT = FIB[12]#, % NOTSERL : NO. OF CURRENT BLOCK 02602630
|
|
% SERIAL IN(OUT): RECORD COUNT WIIHIN BLOCK 02602640
|
|
CURRENTREEL = FIB[13].[28:10]#,% CURRENT REEL NUMBER 02602650
|
|
DIRECTION = (FIB[13].[25:1])#,% 1=REVERSE,0=FORWARD 02602660
|
|
DISCARDWA = P(MEM OR ((*RCPRT).[FF]),3,COM,DEL)#, 02602670
|
|
DISK = FIB[4].[8:4]=4#, 02602680
|
|
DISKR = 10#, % DISK RANDOM (FPB) 02602690
|
|
DISKS = 12#, % DISK SERIAL (FPB) 02602700
|
|
DISKP = 26#, % DISK PROTECT(FPB) 02602705
|
|
ENDFILE = FIB[5].[40:1]#, % RECOGNIZED END OF FILE 02602710
|
|
EOF = [27:1]#, % EOF BIT IN IOD 02602720
|
|
EORF = [42:6]#, % SENTINEL: 1=EOR 0=EOF 02602730
|
|
EORRERUN = FIB[4].[3:2]#,%EOR RERUN:1=OUTPUI IAPE,2=SCRCH02602740
|
|
FPBXDONE = FIB[4].[12:1]#, % [13:11] IS FPB INDEX 02602770
|
|
FCRCLOSE(FCRCLOSE1)=P(MKS,FCRCLOSE1,0,[FLOC],4,FCR)#, 02602780
|
|
FCROPENOUT = P(MKS,T,[FLOC],3,FCR)#, 02602790
|
|
FILIO = FIB[13].[22:1]#, % FILE OPEN IO 02602795
|
|
FPBTYPE = FPB[IX+3].[43:5]#,% FPB FILE TYPE 02602798
|
|
GETDISKROW = P(FPB[IX+3],FPB[IX],FPB[IX+1],10,LBL, 02602800
|
|
4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL)#, 02602805
|
|
HASH = (FIB[8]!0)#, % COB61: HASH ROUTINES PRESNI02602810
|
|
HEADERPTR = FIB[14]#, % DESC. FOR DISK FILE HEADER 02602820
|
|
HNMROWS = LBL[9]#, % HEADER: NUMBER OF ROWS 02602830
|
|
% (DO NOT CHANGE) 02602831
|
|
HNMSZRS = NOTSERL#, % HEADER: SIZE OF ROWS 02602840
|
|
INFILE = FIB[13].[27:1]#, % FILE OPEN INPUT 02602850
|
|
IODONE = FLOC[I+2].[19:1]#,% DONE BIT ON IN IOD 02602860
|
|
IOERR(IOERR1) = P(0,FLOC,IOERR1,17,COM)#, % CALL IOERR-DONI DS02602865
|
|
LABELED = NOT UNLABELED#, 02602870
|
|
LABEQ = FIB[5].[17:1]#, % LABEL EQUATED FROM DISK 02602880
|
|
LASTIO = FIB[13].[46:1]#, % 1=LAST WAS PHYSICAL READ 02602885
|
|
LBLPTR = FLOC[1]#, % LABEL DESCRIPTOR 02602890
|
|
LOCK = 2#, 02602900
|
|
LSUBL = FIB[1]#, % DISK: LOWER BOUND RECORD NO02602910
|
|
LSUBU = FIB[3]#, % DISK: UPPER BOUND RECORD NO02602920
|
|
MABUSE = FIB[4].[1:1]#, % USE ROUTINES PRESENT 02602930
|
|
MAXR = FIB[18][8:38:10]#, % MAX REC SZ FOR CONCATS 02602945
|
|
MAXREC = FIB[18].[CF]#, % MAXIMUM RECORD LENGTH 02602950
|
|
MINREC = FIB[18].[FF]#, % MINIMUM RECORD SIZE 02602952
|
|
MT = 2#, % MAGNETIC TAPE 02602955
|
|
NMSZROWS = FIB[8].[20:28]#, % DISK: NM=[20:5],SZ=[25:23] 02602960
|
|
NOAIT = FIB[20].[3:1]#, % AIT FOR WA WAS DESTROYED 02602965
|
|
NOREW = 1#, % NO REWIND 02602970
|
|
NOTCLOSED = FIB[5].[41:2]=0#,% FILE NOT CLOSED 02602980
|
|
NOTFIRSTREEL = FIB[5].[38:1]#, % =1 IFF CURRENTREEL!1ST REEL02602985
|
|
NOTINANDOPEN = FIB[5].[41:3]!1#,% FILE NOT(INPUT & OPEN) 02602990
|
|
NUMBUFF = FIB[13].[10:9]#, % NO.OF BUFFERS ASSIGNED 02603000
|
|
NUMREC = FIB[11]#, % NO.OF RECORDS PER BLOCK 02603010
|
|
OPENIN = 1#, 02603020
|
|
OPENIO = 5#, 02603025
|
|
OPENOUT = 3#, 02603030
|
|
OPTIONAL = FIB[5].[39:1]#, % REEL OPTIONAL AND ABSENT 02603040
|
|
OUTAP = T#, % EOR RERUN ON OUTPUT TAPE 02603050
|
|
PBIT = [2:1]#, % PRESENCE BII 02603051
|
|
PBT = 7#, 02603055
|
|
PERFORMUSE = P(MKS,[FIB],T,0,PERFORMGEN)#, 02603060
|
|
PRINTFILE = FIB[20] #, % CF=1 IS PRINTFILE 02603070
|
|
PURGEREEL = P([FLOC[3]]&@23[CTF],20,11,COM,DEL,DEL,DEL)#, 02603080
|
|
PURGE = 4#, 02603090
|
|
RANDOM = FIB[4].[29:1]#, % RANDOM ACCESS IS THE ORDER 02603100
|
|
RCOUNT = FIB[7]#, % NO.OF RECORDS INTO FILE 02603110
|
|
RCPRT = FIB[20].[FF]#, % PRT OF DESC POINIING IO REC02603115
|
|
RECSPERBLK = LBL[0].[30:12]#, % HEADER: RECORDS PER BLOCK 02603120
|
|
REDECWA = P(MKS,RCPRT,MAXREC,1,1,1,INTINT)#, % DECLARE 02603130
|
|
% SAVE ARRAY FOR WORK AREA02603140
|
|
RELEASE = 7#, 02603200
|
|
RESETPARITY = FLOC[3]~ (*P(DUP))&0[28:28:1]#, % RESEI PARIIY02603202
|
|
RESETREADBIT = 0[24:24:1]#, % USED TO TURN OFF READ BIT 02603205
|
|
REWIND = 0#, 02603210
|
|
SEGSPEROW = LBL[8]#, % HEADER:SEGMENTS PER ROW 02603220
|
|
SEGSPBLK = LBL[0].[42:6]#, % HEADER:SEGMENTS PER BLOCK 02603230
|
|
$ SET OMIT = NOT(TIMESHARING) 02603232
|
|
SLEEPCM = 36,COM#, % SLEEP COMUNICAIE 02603235
|
|
$ POP OMIT 02603236
|
|
$ SET OMIT = TIMESHARING 02603237
|
|
SORT = 6#, 02603240
|
|
SORTFILE = (FIB[4].[7:1] OR FIB[18].[1:1])#, 02603250
|
|
SZF = [8:10]#, 02603260
|
|
TECH = FIB[5].[46:2]#, 02603270
|
|
TECHB = 2#, % TECHNIQUE B 02603280
|
|
TECHC = 3#, % TECHNIQUE C 02603290
|
|
TERM(TERM1) = P(1,FLOC,TERM1,17,COM)#, % TERMINATE ON IO ERR02603300
|
|
TIP = FLOC[3]#, % TOP IOD 02603310
|
|
UNITYPE = (FIB[4].[8:4])#, %ASSND INTERNAL HARDWARE TYPE02603330
|
|
UNLABELED = FIB[4].[2:1]#, % UNLABELED FILE 02603340
|
|
WAITIO = P([FLOC[I+2]],@2000000000,SLEEPCM,DEL,DEL)#, 02603360
|
|
WORDSLEFT = FIB[17]#, % NO OF WORDS LEFT IN BLOCK 02603370
|
|
WRITEPARITY = FIB[5].[3:1]#, % INDICATES FORCED REELSWITCH02603375
|
|
WRITBACK = FIB[13].[23:1]#, % WRITE BLOCK BACK ON IO 02603380
|
|
WRITEAFTEREOF = FIB[13].[44:2]#; 02603385
|
|
LABEL LINVALID,LOPENIN,LOPREVIN,LOPENOUT,LCLOSE,LOPENIO,LSORT, 02603390
|
|
LOPEN1,LCLOSE1,STARTL,EXIT,TSTBRK,BSTP;% 02603395
|
|
SWITCH TYPE ~ LINVALID,LOPENIN,LOPREVIN,LOPENOUT,LCLOSE,LOPENIO, 02603400
|
|
LSORT;% 02603450
|
|
SUBROUTINE BUILDLABEL;% 02603500
|
|
BEGIN% 02603600
|
|
I~IX;% 02603700
|
|
FLOC[1]~FLAG(1&(IF FPB[I+3].[43:5]=1 THEN 19 ELSE FLOC[1].[8:1002603800
|
|
]+4)[8:38:10]&(FLOC INX 1)[18:33:15]);% 02603900
|
|
P(FLOC[1],0,COC,DEL);% 02604000
|
|
FLOC[1]~(2 INX FLOC[1])&(FLOC[1].[8:10]-4)[8:38:10];% 02604100
|
|
STREAM( A ~ FU2~P(0,1,COM),B~FIB[4],C~[PU1]);% 02604200
|
|
BEGIN SI~ LOC A;SI~SI+3;DS~2OCT;DS~3OCT;% 02604300
|
|
SI~LOC B; SI~SI+5; DS~3OCT; END;% 02604400
|
|
FU1~(PU2~PU2+FU1+3649)MOD 365+(PU2 DIV 365+PU1-10)|1000+1;% 02604500
|
|
% AT THIS POINT FU1 CONTAINS PURGE DATE(BINARY) AN FU2=DATE(DECIMAL)% 02604600
|
|
STREAM(K~0:A~CURRENTREEL,B~FPB[I+2]); BEGIN% 02604700
|
|
DI~LOC K;SI~LOC A;DS~3DEC;SI~LOC B;SI~SI+3;DS~5CHR END;% 02604800
|
|
IF (RPU1~P).[1:17]=0 THEN 02604900
|
|
IF (RPU1~FPB[I+2]).[1:17]=0 THEN RPU1.[17:1]~1; 02605000
|
|
IF RPU1.[18:30]=0 THEN RPU1.[18:30]~FU2; 02605100
|
|
IF (RPU2:=FPB[I+3]).[1:5]=0 THEN RPU2.[5:1]:=1; 02605200
|
|
STREAM(K~0:PU1);BEGIN DI~LOC K;SI~LOC PU1;DS~3OCT END;% 02605300
|
|
REEL~P; CURRENTREEL~REEL; 02605400
|
|
STREAM(A~[FPB[I]],B~PU1,C~PU2,D~FU1,% 02605500
|
|
Q~IF (T~FPB[I+3].[43:5])=10 OR T=12 OR T=26 THEN 02605600
|
|
P([HEADERPTR],LOD,7,COC,1,+) ELSE 0, 02605700
|
|
G~FLOC[1].[8:10]-8,% 02605900
|
|
F~IF REEL!1 THEN FIB[4].[4:1] ELSE 0,E~FLOC[1]); 02606000
|
|
BEGIN DS~8LIT" LABEL ";% 02606100
|
|
SI~A; DS~2 WDS; SI~LOC B; DS~WDS; SI~LOC C;% 02606200
|
|
DI:=DI+1;DS:= CHR; SI:=LOC D; DS:=5 DEC;% 02606300
|
|
DS~LIT"0"; %SENTINAL% 02606400
|
|
DS~5LIT"0";% BLOCK-COUNT% 02606500
|
|
SI~LOC Q;DS~7DEC; %REC-COUNT% 02606600
|
|
SI~LOC F;SI~SI+7;DS~CHR; % MEM-DUNP KEY% 02606700
|
|
DS~5LIT"0"; % PHYSICAL TAPE NO.% 02606800
|
|
DS~6LIT"0";% 02606900
|
|
G(DS~8LIT" ");% 02607000
|
|
END END;% 02607100
|
|
SUBROUTINE GOUSE;% 02607200
|
|
BEGIN% 02607300
|
|
COBOLINDEX ~ T.[26:10];% 02607400
|
|
P( MKS, T.[38:10], [COBOLCONTROL]);% 02607500
|
|
END;% 02607600
|
|
SUBROUTINE CALLGOUSE; 02607700
|
|
BEGIN 02607800
|
|
IF I OR TEST THEN 02607900
|
|
BEGIN IF(T~PGUSE[I].[ 1:23])! 0 THEN GOUSE; 02608000
|
|
IF(T~PGUSE[I].[24:24])! 0 THEN GOUSE; 02608100
|
|
END; 02608200
|
|
END CALLGOUSE; 02608300
|
|
SUBROUTINE CALLGOUSER; 02608310
|
|
BEGIN 02608320
|
|
IF I OR TEST THEN 02608330
|
|
BEGIN IF (T~FIB[I].[ 1:23])! 0 THEN GOUSE; 02608340
|
|
IF (T~FIB[I].[24:24])! 0 THEN GOUSE; 02608350
|
|
END; 02608360
|
|
END CALLGOUSER; 02608370
|
|
SUBROUTINE USERS; 02608400
|
|
BEGIN 02608500
|
|
I ~ PU1; CALLGOUSE; 02608600
|
|
IF (I~PU2)>0 THEN CALLGOUSE; 02608700
|
|
I ~ FU1; CALLGOUSER; 02608800
|
|
IF (I~FU2)>0 THEN CALLGOUSER; 02608900
|
|
END USERS; 02609000
|
|
SUBROUTINE GOUSE68; 02609005
|
|
BEGIN PERFORMUSE; END; 02609006
|
|
SUBROUTINE USERS68; 02609010
|
|
BEGIN 02609020
|
|
IF TEST THEN 02609030
|
|
BEGIN % CHECK FOR FILE USE ROUTINES 02609040
|
|
IF (T~FIB[FU1].BF)!0 THEN GOUSE68; 02609050
|
|
IF (T~FIB[FU1].AF)!0 THEN GOUSE68; 02609060
|
|
IF (T~PGUSE[PU1].BF)!0 THEN GOUSE68; 02609070
|
|
IF (T~PGUSE[PU1].AF)!0 THEN GOUSE68; 02609080
|
|
END; 02609090
|
|
IF PU2>0 THEN 02609100
|
|
BEGIN % NOT DISK: CHECK FOR REEL USE ROUTINES 02609110
|
|
IF (T~FIB[FU1].BRR)!0 THEN GOUSE68; 02609120
|
|
IF (T~FIB[FU1].ARR)!0 THEN GOUSE68; 02609130
|
|
IF (T~PGUSE[PU1].BRR)!0 THEN GOUSE68; 02609140
|
|
IF (T~PGUSE[PU1].ARR)!0 THEN GOUSE68; 02609150
|
|
END; 02609160
|
|
END USERS68; 02609170
|
|
% * * * * * * * * * * * * * * S T A R T H E R E * * * * * * * 02610150
|
|
REEL ~ IF P(MKSCW,TOP,XCH,DEL) THEN MKSCW ELSE 0;% 02610200
|
|
COB68 ~ (FIB~*FLOC).SZF=22;% 02610300
|
|
IF CODE=18 THEN BEGIN CODE:=4; SVFIB:=1; END; 02610310
|
|
IF NOT FPBXDONE THEN FIB[4].[12:12] ~ % 02610400
|
|
((FIB[4].[12:12]-1)|ETRLNG)&1 [36:47:1];% 02610500
|
|
IF NOT COB68 THEN 02610550
|
|
IF REEL>9 THEN% 02610600
|
|
BEGIN % CONVERT REEL NO TO OCTAL02610700
|
|
STREAM(K~0:L~REEL);% 02610800
|
|
BEGIN SI~LOC L; SI~SI+5;% 02610900
|
|
DI~LOC K; DS~3 OCT;% 02611000
|
|
END;% 02611100
|
|
REEL ~ P;% 02611200
|
|
END;% 02611300
|
|
IX ~ FIB[4].[13:11];% INDEX TO FPB 02611370
|
|
IF CODE!CLOSE THEN% 02611390
|
|
IF (T~FPBTYPE)=DISKR OR T=DISKP OR CODE=OPENIO THEN 02611400
|
|
BEGIN IF (T=DISKR OR T=DISKP) AND NOT COB68 THEN 02611410
|
|
BUFREQ~1; NOTSERL~TRUE; 02611430
|
|
END ELSE 02611440
|
|
IF T<3 OR T=11 OR (T GEQ 7 AND T<10) THEN 02611450
|
|
IF FIB[8].[20:5]>0 THEN % HAS BEEN LABEQ FRM DISK 02611480
|
|
BEGIN NMSZROWS~0; LABEQ ~ TRUE; END;% 02611490
|
|
IF CODE=SORT THEN GO TO LSORT;% 02611495
|
|
IF CODE!CLOSE THEN% 02611500
|
|
BEGIN 02611510
|
|
FIB[13].[19:5] ~0;% 02611610
|
|
IF T=DISKR OR T=DISKS OR T=DISKP THEN% TECH B & C NOT02611620
|
|
IF TECH>1 THEN TERM(30); % VALID ON DISK %CJC 103I02611630
|
|
IF COB68 THEN IF TECH!TECHC THEN MINREC~MAXREC; 02611675
|
|
END;% 02611680
|
|
NUMBUFF ~ BUFREQ;% 02611700
|
|
STARTL:% 02611800
|
|
IF CODE>5 THEN IF CODE=16 THEN GO TO LOPEN1 ELSE% 02611900
|
|
IF CODE=17 THEN GO TO LCLOSE1 ELSE TERM(25);% 02612000
|
|
GO TO TYPE[CODE];% 02612100
|
|
LOPENIO:% 02612200
|
|
CODE ~ OPENIN;% 02612300
|
|
FILIO ~ 1;% 02612400
|
|
GO TO LOPENIN;% 02612500
|
|
LOPREVIN:% 02612600
|
|
IF ((T~TECH)=TECHC) OR (T=TECHB AND NUMREC!1) THEN TERM(5); 02612700
|
|
LOPENIN:% 02612800
|
|
IF NOTCLOSED THEN TERM(2|CODE-1);% 02612900
|
|
IF REEL=0 THEN REEL ~ CURRENTREEL ELSE CURRENTREEL ~ REEL; 02613600
|
|
IF (T~FPBTYPE)=DISKR OR T=DISKS OR T=DISKP THEN 02614200
|
|
BEGIN% 02614300
|
|
NMSZROWS ~ 0; % SINCE ITS INPUT 02614400
|
|
IF LSUBU!0 THEN % UPPER BOUND 02614500
|
|
BEGIN LSUBU ~ *P(DUP)-1; BOUNDED ~ TRUE; END; 02614600
|
|
IF LSUBL!0 THEN LSUBL ~ *P(DUP)-1;% 02614700
|
|
WRITEAFTEREOF ~ 0;% 02614750
|
|
BCOUNT ~ IF (RCOUNT~LSUBL)=0 THEN 0 ELSE % STARTING 02614800
|
|
(RCOUNT-1) DIV NUMREC + 1; % BLOCK 02614900
|
|
END;% 02615000
|
|
COBOLOPENIN; % STORE BOOLEAN RESULT IN I: TRUE FOR 02615100
|
|
% LABELED AND NOT SORT FILE ON OPEN IN 02615105
|
|
IF COB68 THEN% 02615110
|
|
BEGIN% 02615115
|
|
IF NOAIT THEN% 02615120
|
|
BEGIN% 02615125
|
|
REDECWA;% 02615130
|
|
NOAIT ~ 0;% 02615133
|
|
END;% 02615135
|
|
END;% 02615140
|
|
IF DISK THEN% 02615170
|
|
BEGIN% 02615200
|
|
IF NOT COB68 THEN 02615250
|
|
IF RANDOM THEN TIP ~ 1 INX TIP;% DISK ADDR IN WRD 1 02615300
|
|
BUILDLABEL;% 02615400
|
|
IF MABUSE OR NOT COB68 THEN% 02615500
|
|
BEGIN % BEGINNING INPUT/IO FILE 02615600
|
|
FU1~ 0; TEST ~ 1; PU2 ~ FU2 ~ -1; 02615700
|
|
IF COB68 THEN BEGIN PU1 ~ 4|FILIO;% 02615800
|
|
USERS68; END% 02615900
|
|
ELSE BEGIN PU1 ~ 10|FILIO; USERS; END;% 02616000
|
|
END;% 02616100
|
|
IF COB68 THEN 02616140
|
|
BEGIN 02616160
|
|
BCOUNT ~ (IF RANDOM THEN NOT 0 02616180
|
|
ELSE RCOUNT DIV NUMREC); 02616200
|
|
COUNT~BCOUNT + (NUMBUFF-1)&FIB[5][1:44:1]; 02616220
|
|
END ELSE 02616240
|
|
BEGIN IF NOTSERL THEN %TR 1476 02616260
|
|
TIP ~ (BUFFERSIZE + 1) INX TIP & MAXR; %TR 1476 02616300
|
|
COUNT ~ IF NOTSERL THEN -1 ELSE 0; %TR 1476 02616400
|
|
RESETPARITY; %IR 1476 02616450
|
|
END ; %TR 1476 02616470
|
|
GO TO EXIT;% 02616500
|
|
END DISK;% 02616600
|
|
IF HASH THEN IF NOT WRITEPARITY THEN CALLHASH(2); 02616700
|
|
IF NOT OPTIONAL THEN 02616750
|
|
IF (MABUSE OR NOT COB68) AND I THEN % LABELED AND NOT SORT 02616800
|
|
IF NOT WRITEPARITY THEN 02616850
|
|
BEGIN % BEGINNING INPUT FILE/REEL 02616900
|
|
PU1 ~ FU1 ~ 0; TEST ~ CURRENTREEL=1;% 02617000
|
|
PU2 ~ FU2 ~ 1;% 02617100
|
|
IF COB68 THEN USERS68 ELSE USERS;% 02617200
|
|
END;% 02617300
|
|
GO TO TSTBRK;% 02617400
|
|
LOPENOUT:% 02617500
|
|
IF NOTCLOSED THEN TERM(6);% 02617600
|
|
IF CLOSEDHERE THEN BEGIN CLOSEDHERE~0; GO LOPEN1; END;% 02617700
|
|
IF REEL!0 THEN CURRENTREEL~REEL;% FIXES OPEN OUT REEL DATA-NAME02618500
|
|
IF (T~FPBTYPE)=5 OR T=8 OR T=9 % UNLABELED SPEC UNIT, PT, OR MT02618550
|
|
THEN UNLABELED ~ 1;% 02618600
|
|
IF T=DISKR OR T=DISKS OR T=DISKP THEN 02618650
|
|
BEGIN% 02618700
|
|
IF LSUBU!0 THEN BEGIN LSUBU ~ *P(DUP)-1;% 02618750
|
|
BOUNDED ~ TRUE; END;% 02618800
|
|
IF LSUBL!0 THEN LSUBL ~ *P(DUP)-1;% 02618900
|
|
BCOUNT ~ (RCOUNT~LSUBL) DIV NUMREC;% 02619000
|
|
IF COB68 AND NMSZROWS = 0 THEN % DISK DEFAULT IS 02619004
|
|
IF NOT DISK THEN % (LBL EQU ONLY) 02619005
|
|
NMSZROWS ~ 100&20[20:43:5]; % 20 ROWS 100 RECS02619006
|
|
END% 02619010
|
|
ELSE IF LABELED THEN% 02619020
|
|
BEGIN% 02619100
|
|
BUILDLABEL;% 02619200
|
|
IF NOT SORTFILE THEN% 02619300
|
|
BEGIN IF HASH THEN CALLHASH(2);% 02619400
|
|
IF MABUSE OR NOT COB68 THEN%BEG OUT FILE/RL02619410
|
|
BEGIN TEST ~ REEL=1; FU1 ~ 0; PU2 ~ 5;02619420
|
|
IF COB68 THEN% 02619430
|
|
BEGIN PU1~2; USERS68; END% 02619500
|
|
ELSE BEGIN PU1~4;FU2~1;USERS;END;02619600
|
|
END;% 02619700
|
|
END;% 02619800
|
|
END;% 02619900
|
|
COBOLOPENOUT;% 02620000
|
|
IF COB68 THEN % MOVE WA TO BUF.SAVE WA ADDR, POINT PRT TO BUFF02620010
|
|
BEGIN% 02620015
|
|
IF NOAIT THEN% 02620020
|
|
BEGIN% 02620030
|
|
REDECWA;% 02620040
|
|
NOAIT ~ 0;% 02620050
|
|
END;% 02620060
|
|
IF NOT (DISK) THEN 02620065
|
|
BEGIN WORDSLEFT ~ BUFFERSIZE; 02620070
|
|
PRINTFILE ~ P(DUP,LOD,(FIB[4].[8:4]), 02620075
|
|
P(DUP)=1,P(XCH,DUP)=7,P(XCH)=12,OR,OR,CCX);02620080
|
|
END UNDISK; % 1=LP, 7=PBT, 12=PBD 02620085
|
|
END COB68ING; 02620090
|
|
IF DISK THEN% 02620100
|
|
BEGIN% 02620200
|
|
IF RANDOM THEN 02620250
|
|
IF COB68 THEN BCOUNT ~ NOT 0 02620300
|
|
ELSE TIP ~ 1 INX TIP; 02620350
|
|
BUILDLABEL;% 02620400
|
|
LBL ~ *[HEADERPTR];% 02620500
|
|
LBL[7] ~ -1;% 02620600
|
|
IF MABUSE OR NOT COB68 THEN% 02620800
|
|
BEGIN % BEGINNING OUTPUT FILE 02620810
|
|
FU1 ~ 0; TEST ~ 1; PU2 ~ FU2 ~ -1; 02620900
|
|
IF COB68 THEN BEGIN PU1 ~ 2; USERS68; END 02621000
|
|
ELSE BEGIN PU1 ~ 4; USERS; END; 02621100
|
|
END;% 02621200
|
|
IF NOT COB68 THEN 02621220
|
|
BEGIN 02621230
|
|
RESETPARITY;% 02621250
|
|
IF NOTSERL THEN% 02621300
|
|
BEGIN% 02621310
|
|
IF UNITYPE =4 AND NOT UNLABELED AND NOT SORTFILE THEN %IR-9002621320
|
|
TIP ~ (BUFFERSIZE + 1) INX TIP & MAXR; %TR 1476 02621325
|
|
BUFTOP ~ (*P(DUP)) & 1[24:47:1]; %TR 1476 02621330
|
|
END END; 02621335
|
|
END DISK;% 02621340
|
|
IF NOT COB68 THEN COUNT ~ IF NOTSERL THEN -1 ELSE NUMREC; 02621350
|
|
TSTBRK:% 02621360
|
|
IF (T~EORRERUN)!0 AND CURRENTREEL!1 THEN IF BREAKFAIL AND OUTAP02621364
|
|
THEN BEGIN PURGEREEL; GO TO STARTL; END % TRY BREAK AGAIN 02621365
|
|
ELSE P(DEL);% 02621370
|
|
GO TO EXIT;% 02621371
|
|
LCLOSE:% 02621375
|
|
IF OPTIONAL THEN % EOF ON ABSENT OPTIONAL FILE 02621380
|
|
BEGIN FIB[5] ~ (*P(DUP))&4 [39:42:6]; % MARK CLOSED RLSD 02621400
|
|
P(XIT);% 02621500
|
|
END;% 02621600
|
|
IF NOT SORTFILE AND CLOSED THEN BEGIN IOERR(12-FIB[5].[43:1]); 02621700
|
|
GO TO EXIT; END; 02621750
|
|
IF INFILE THEN% 02621800
|
|
IF (COB68 AND MABUSE AND DISK) THEN % END INPUT/IO FILE 02621810
|
|
BEGIN FU1~2; PU2~-1; TEST~1; PU1~1+4|FILIO;% 02621820
|
|
USERS68;% 02621830
|
|
END ELSE% 02621840
|
|
ELSE IF (LABELED AND NOT SORTFILE) THEN% 02621900
|
|
IF DISK THEN% 02622000
|
|
BEGIN % MOVE RECORD COUNT FROM HEADER TO LABEL 02622010
|
|
STREAM(A~P([HEADERPTR],LOD,7,COC,1,+), 02622020
|
|
B~ 5 INX LBLPTR);% 02622030
|
|
BEGIN SI~LOC A; DI~DI+5; DS~7 DEC; END;% 02622040
|
|
IF MABUSE OR NOT COB68 THEN% END OUTPUT FILE 02622050
|
|
BEGIN FU1~2; TEST~1; PU2~FU2~-1; 02622070
|
|
IF COB68 THEN BEGIN PU1~3; USERS68; END02622100
|
|
ELSE BEGIN PU1~6; USERS; END;% 02622200
|
|
END;% 02622300
|
|
END % NOT DISK 02622400
|
|
ELSE BEGIN % MOVE BLK & RECORD COUNTS FROM FIB TO LBL02622500
|
|
IF HASH THEN CALLHASH(1);% 02622600
|
|
STREAM(A~BCOUNT,B~RCOUNT,C~5 INX LBLPTR);% 02622700
|
|
BEGIN SI~LOC A; DS~5 DEC; DS~7 DEC; END;% 02622800
|
|
LBL ~ LBLPTR;% 02622900
|
|
LBL[4].EORF~ REEL!0;% 02623000
|
|
LBL ~ 0; %FILE CLOSE FORGETS LABELS-SO CLEAR PTR02623100
|
|
IF REEL THEN CLOSELOCK ~ LOCK;% 02623200
|
|
IF MABUSE OR NOT COB68 THEN% END OUTPUT FILE/RL 02623300
|
|
BEGIN FU1~2; TEST ~ REEL=0; PU2 ~ 7; 02623400
|
|
IF COB68 THEN BEGIN PU1~3; USERS68; END 02623500
|
|
ELSE BEGIN PU1~6; FU2~3; USERS; END; 02623600
|
|
END;% 02623610
|
|
END; % OF NONDISK 02623620
|
|
IF DISK AND LABELED AND NOT SORTFILE THEN% 02623700
|
|
BEGIN% 02623800
|
|
LSUBL ~ *P(DUP)+1;% 02623900
|
|
IF BOUNDED THEN % IF UPPER BOUND 02624000
|
|
BEGIN LSUBU ~ *P(DUP)+1; BOUNDED~FALSE; END 02624100
|
|
ELSE IF COB68 THEN LSUBU ~ 0; 02624200
|
|
LBL ~ *[HEADERPTR];% 02624300
|
|
HNMSZRS ~-(((SEGSPEROW|RECSPERBLK) DIV SEGSPBLK)02624400
|
|
& HNMROWS [20:43:5]);% NM,SZ ROWS FR HEADER02624500
|
|
NMSZROWS ~ 0; % ZERO FIB NM,SZ ROWS 02624600
|
|
IF NOT COB68 THEN IF RANDOM THEN WORDSLEFT~0; 02624610
|
|
END;% 02624700
|
|
IF UNITYPE=MT AND NOT REEL THEN% 02624800
|
|
BEGIN% 02624900
|
|
IF CLOSELOCK=REWIND AND NOTFIRSTREEL THEN% 02624910
|
|
CLOSELOCK ~ LOCK;% 02624920
|
|
NOTFIRSTREEL ~ FALSE;% 02625000
|
|
END;% 02625100
|
|
T ~ CURRENTREEL;% 02625105
|
|
IF REEL AND UNITYPE=PBT THEN FIB[9].[1:1] ~ 1; 02625110
|
|
COBOLCLOSE;% 02625200
|
|
IF HNMSZRS.[1:1] THEN 02625210
|
|
BEGIN% 02625220
|
|
NMSZROWS ~ ABS(HNMSZRS);% 02625225
|
|
HNMSZRS ~ 0;% 02625230
|
|
WRITBACK ~ FALSE; % RANDOM OUTPUT AND I-O 02625240
|
|
END;% 02625250
|
|
IF REEL THEN% 02625255
|
|
BEGIN % REEL SWITCH 02625260
|
|
REEL ~ T+1;% 02625265
|
|
CODE ~ 3-(2|INFILE)+DIRECTION;% 02625268
|
|
IF CODE=OPENOUT THEN CURRENTREEL ~ REEL;% 02625270
|
|
NOTFIRSTREEL ~ TRUE; 02625280
|
|
GO TO STARTL;% 02625300
|
|
END% 02625400
|
|
ELSE CURRENTREEL ~ 0; 02625500
|
|
IF NOT SVFIB THEN 02625510
|
|
IF COB68 AND CLOSELOCK>1 THEN IF (T~FIB[20])<0 THEN 02625600
|
|
% THROW AWAY FILE TANK, RE-INITIALIZE TYPE-2 SEGMENT DESC 02625650
|
|
P(FLOC,DUP,FCX,3,COM,FLAG(0 & T [23:8:10] & T 02625700
|
|
[8:8:10] & 9 [3:44:4]),SSN,XCH,~); 02625800
|
|
P(XIT); 02625950
|
|
LINVALID:% 02626000
|
|
TERM(25);% 02626050
|
|
LCLOSE1:% 02626100
|
|
IF NOTINANDOPEN THEN TERM(12-FIB[5].[43:1]);% 02626150
|
|
IF ENDFILE THEN BEGIN I ~ 1; GO TO BSTP; END;% 02626200
|
|
FOR I ~ 1 STEP 1 UNTIL NUMBUFF DO% 02626250
|
|
BEGIN % WAIT UNTIL ALL I0-S ARE DONE% 02626300
|
|
IF NOT IODONE THEN WAITIO;% 02626350
|
|
IF FLOC[I+2].EOF THEN GO BSTP;% 02626400
|
|
END;% 02626450
|
|
I ~ NUMBUFF;% 02626500
|
|
BSTP:% 02626550
|
|
BACKSPACE; % BACKSPACL I BLOCKS 02626600
|
|
TIP.EOF ~ ENDFILE;% 02626650
|
|
CLOSEDHERE ~ COB68;% 02626660
|
|
FIB[5].[40:6] ~ CLOSEDRET;% 02626700
|
|
GO TO EXIT;% 02626750
|
|
LOPEN1:% 02626800
|
|
IF FIB[5].[40:6]!CLOSEDRET THEN TERM(6);% 02626850
|
|
FIB[5].[40:6] ~ 0;% 02626900
|
|
BUFTOP ~(*P(DUP))& RESETREADBIT;% 02626950
|
|
INFILE ~ 0; % MAKE IT OUTPUT 02627000
|
|
LBLPTR ~(*P(DUP))& RESETREADBIT;% 02627050
|
|
IF TIP.EOF THEN% 02627100
|
|
BEGIN % HAD READ EOF BEFORE BACKSPACE 02627150
|
|
WORDSLEFT ~ BUFFERSIZE;% 02627200
|
|
TIP.EOF ~ 0; % RESET EOF 02627250
|
|
COUNT ~ NUMREC; % # RECS LEFT IN BUFF = WHOLE BUFF 02627300
|
|
BUFTOP.[CF] ~ TIP.[CF];% 02627340
|
|
END% 02627350
|
|
ELSE BEGIN % NO EOF - OPEN IN PLACE 02627400
|
|
RCOUNT ~ *P(DUP)-1;% BACK UP BECAUSE WE 02627450
|
|
BCOUNT ~ *P(DUP)-1;% WERE READING 02627500
|
|
WORDSLEFT ~ BUFFERSIZE-(TIP.[CF]-BUFTOP.[CF]);% 02627510
|
|
COUNT ~ WORDSLEFT DIV MAXREC; % # RECS LEFI IN BUFF02627600
|
|
END;% 02627650
|
|
FOR T ~ 1 STEP 1 UNTIL NUMBUFF DO% 02627700
|
|
FLOC[T+2] ~ FLAG(BUFTOP&FLOC[T+2][CTC]); % CHANGE TO WRITE02627750
|
|
GO TO EXIT;% 02627800
|
|
LSORT:% 02627850
|
|
IOD ~ [TIP];% 02627860
|
|
IF CLOSELOCK=NOREW THEN % FCR CALLED WITH THESE PARAMS 02627870
|
|
BEGIN %IF IO COMPLETE BUT NOI PRESENT02627880
|
|
IF NOT (*IOD).EOF % NOT EOF:MUST HAVE BEEN PARITY02627890
|
|
THEN TERM(19) % TERMINATE ON PARITY 02627900
|
|
ELSE % MUST HAVE BEEN EOF OR EOR 02627910
|
|
BEGIN ALGOLIO(11);% READLABEL 02627920
|
|
LBL ~ LBLPTR;% 02627930
|
|
IF LBL[4].EORF=0 THEN P(1,RTN);%RETURN EOF02627940
|
|
REEL ~ CURRENTREEL+1;%REEL SWITCH ON INPUT02627950
|
|
T ~ COBOLFILBIT; % REMEMBER IF COBOL FILE 02627960
|
|
FCRCLOSE(PURGE); 02627970
|
|
FIB[13]~(*P(DUP))&REEL[28:38:10]% NXT REEL02628000
|
|
&0 [47:47:1]; % MAKE IT LOOK ALGOL02628050
|
|
ALGOLIO(0);% OPEN INPUT NEXT REEL 02628100
|
|
FIB[13] ~(*P(DUP))OR T;% RESTORE COBOL BIT02628150
|
|
P(0,RTN); % RETURN EOR 02628200
|
|
END;% 02628250
|
|
END NOREW;% 02628300
|
|
IF CLOSELOCK=REWIND THEN% 02628310
|
|
BEGIN % REEL SWITCH ON OUTPUT 02628320
|
|
LBL ~ LBLPTR;% 02628330
|
|
LBL[4].EORF ~ 1; % EOR 02628340
|
|
LBL ~ 0;%FILE CLOSE FOGETS LABEL SO PTR MUST BE CLRD 02628350
|
|
T ~ CURRENTREEL+1;% 02628360
|
|
FCRCLOSE(RELEASE); % CLOSE RELEASE CURRENT REEL 02628370
|
|
CURRENTREEL ~ REEL ~ T;%WIIH NO REEL SWITCH-DONE HERE02628380
|
|
IF COBOLFILE THEN FCROPENOUT ELSE ALGOLIO(0);%NXT RL 02628390
|
|
P(XIT); % OPEN OUT (ALGOL OR COBOL)NXI REEL02628400
|
|
END;% 02628450
|
|
IF CLOSELOCK=LOCK THEN 02628500
|
|
BEGIN% 02628510
|
|
T ~ IF CURRENTREEL=1 THEN REWIND ELSE RELEASE; 02628520
|
|
FCRCLOSE(T); % CLOSE REWIND FIRST REEL. 02628550
|
|
P(XIT); % CLOSE RELEASE ALL OTHERS 02628600
|
|
END;% 02628700
|
|
EXIT::% 02628800
|
|
END COBOLFCR;% 02628900
|
|
PROCEDURE COBOLATT; BEGIN % INT # = @ 165 %CJC 103I02650000
|
|
COMMENT INTRINSIC FOR COBOL ATTRIBUTES %CJC 103I02650100
|
|
CALLING SEQUENCE IS %CJC 103I02650110
|
|
MKS %CJC 103I02650120
|
|
LITC OPERATION %CJC 103I02650130
|
|
LITC FILEFIB %CJC 103I02650140
|
|
DESC 10 %CJC 103I02650145
|
|
LITC ATTRIBUTENUM %CJC 103I02650150
|
|
LITC WORD-OFSET %CJC 103I02650160
|
|
DESC DATAWORD %CJC 103I02650170
|
|
%CJC 103I02650180
|
|
OBERATIONS ARE: %CJC 103I02650190
|
|
1 = MOVE %CJC 103I02650200
|
|
0 = SET (OR CHANGE ATTRIBUTE VALUE) %CJC 103I02650210
|
|
%CJC 103I02650220
|
|
ATTRIBUTENUM HAS THE FOLLOWING VALUES: %CJC 103I02650230
|
|
0 = EOF %CJC 103I02650240
|
|
1 = DO NOT USE %CJC 103I02650250
|
|
2 = DO NOT USE %CJC 103I02650260
|
|
3 = SAVEFACTOR %CJC 103I02650270
|
|
4 = AREAS %CJC 103I02650280
|
|
5 = AREASIZE %CJC 103I02650290
|
|
6 = MFID %CJC 103I02650300
|
|
7 = FI0 %CJC 103I02650310
|
|
8 = REEL %CJC 103I02650320
|
|
9 = DATE %CJC 103I02650330
|
|
10 = BUFFERS %CJC 103I02650340
|
|
11 = TYPE %CJC 103I02650350
|
|
12 = BLOCKSIZE %CJC 103I02650360
|
|
13 = MAXRECSIZE %CJC 103I02650370
|
|
14 = FILE INFORMATION BLOCK %CJC 103I02650371
|
|
15 = FILE PARAMETER BLOCK %CJC 103I02650372
|
|
16 = LABEL (8 WORDS ONLY) %CJC 103I02650373
|
|
17 = EU NUMBER (0 THRU 19) 02650374
|
|
18 = DISK SPEED (1=FAST,2=SLOW) 02650375
|
|
19 = TIMELIMIT (PROTECT FILES) 02650376
|
|
20 = IOSTATUS (PROTECT FILES) 02650377
|
|
21 = SENSITIVE 02650378
|
|
END-OF-COMMENTS; %CJC 103I02650380
|
|
%CJC 103I02650390
|
|
NAME ITEM = -1; % COMP AREA FOR VALUE %CJC 103I02650400
|
|
REAL ATTNUM = -2; % ATTRIBUTE NUMBER %CJC 103I02650500
|
|
NAME FLOC = -3; % POINTER TO FIB %CJC 103I02650600
|
|
REAL OPCODE = -4; % OPERATION 0=SET 1=MOVE %CJC 103I02650700
|
|
%CJC 103I02650800
|
|
ARRAY FPB = 3[*]; % FILE PARAMETER BLOCK %CJC 103I02650900
|
|
%CJC 103I02651000
|
|
ARRAY FIB[*]; %CJC 103I02651100
|
|
ARRAY LBL[*]; %CJC 103I02651110
|
|
LABEL EOF,IOERR, SAVEFACTOR,AREAS, %CJC 103I02651300
|
|
AREASIZE,MFID,FID,REEL,DATE,BUFFERS, %CJC 103I02651400
|
|
TYPE,BLOCKSIZE,MAXRECSIZE,ATTEXIT, %CJC 103I02651410
|
|
FIBWORDS,FPBWORDS,LABELWORDS, 02651500
|
|
EUNUM,DSKSPEED, 02651510
|
|
TIMELIMIT,IOSTATUS, 02651520
|
|
SENSITIVE, 02651530
|
|
DUMMY; 02651590
|
|
02651595
|
|
SWITCH ROUTINE ~ EOF,IOERR,IOERR ,SAVEFACTOR,AREAS, %CJC 103I02651600
|
|
AREASIZE,MFID,FID,REEL,DATE,BUFFERS, %CJC 103I02651610
|
|
TYPE,BLOCKSIZE,MAXRECSIZE, %CJC 103I02651700
|
|
FIBWORDS,FPBWORDS,LABELWORDS, 02651710
|
|
EUNUM,DSKSPEED, 02651720
|
|
TIMELIMIT,IOSTATUS, 02651730
|
|
SENSITIVE, 02651740
|
|
IOERR; 02651799
|
|
%CJC 103I02651800
|
|
REAL XI,TEMP,UNITYPE; %CJC 103I02651900
|
|
DEFINE GETFROMITEM = P(*[ITEM])#, %CJC 103I02652000
|
|
STOREINTOITEM(STOREINTOITEM1) = %CJC 103I02652100
|
|
P(STOREINTOITEM1,[ITEM],~)#, %CJC 103I02652150
|
|
IOERROR(IOERROR1) = %CJC 103I02652200
|
|
P(1,FLOC,IOERROR1,17,COM)#; %CJC 103I02652250
|
|
%CJC 103I02652251
|
|
COMMENT I/O ERRORS ARE AS FOLLOWS: %CJC 103I02652252
|
|
40 = FILE WAS OPEN WHEN SETTING THE ATTRIBUTE %CJC 103I02652253
|
|
41 = SETTING A READ ONLY ATTRIBUTE %CJC 103I02652254
|
|
42 = SETTING AN ATTRIBUTE TO AN ILLEGAL VALUE %CJC 103I02652255
|
|
43 = CHANGING # OF BUFFERS OF A NON-SERIAL FILE %CJC 103I02652256
|
|
44 = INCREASING # OF BUFFERS %CJC 103I02652257
|
|
45 = CHANGING BLOCKSIZE TO A VALUE WHICH IS NOT %CJC 103I02652258
|
|
A MULTIPLE OF RECDRD SIZE %CJC 103I02652259
|
|
46 = CHANGE TO BLOCKSIZE WHEN FILE IS OTHER THAN %CJC 103I02652260
|
|
TAPE, PAPER TAPE OR SERIAL DISK %CJC 103I02652261
|
|
47 = ACCESSING "LABEL" WHEN FILE IS NOT OPEN %CJC 103I02652262
|
|
48 = THIS FILE MAY NOT HAVE "TYPE" CHANGED %CJC 103I02652263
|
|
49 = ILLEGAL ATTNUM VALUE %CJC 103I02652264
|
|
END OF I/O ERRORS; %CJC 103I02652290
|
|
%CJC 103I02652300
|
|
% S T A R T H E R E %CJC 103I02652400
|
|
FIB ~ *FLOC; %CJC 103I02652500
|
|
IF FIB[5].[41:2] = 0 THEN LBL ~ FLOC[1]; %CJC 103I02652550
|
|
IF NOT FIB[4].[12:1] THEN FIB[4].[12:12] ~ %CJC 103I02652600
|
|
((FIB[4].[12:12] -1) | ETRLNG) & 1[36:47:1];%CJC 103I02652700
|
|
XI ~ FIB[4].[13:11]; %CJC 103I02652800
|
|
IF OPCODE = 0 AND FIB[5].[41:2] = 0 THEN %CJC 103I02652900
|
|
IOERROR(40); % SET AN ATTRIBUTE ON A FILE %CJC 103I02653000
|
|
% WHICH IS OPEN. %CJC 103I02653100
|
|
GO TO ROUTINE[ATTNUM]; %CJC 103I02653200
|
|
IOERR:: IOERROR(49); % ILLEGAL ATTNUM %CJC 103I02653250
|
|
%CJC 103I02653300
|
|
EOF:: %CJC 103I02653400
|
|
IF OPCODE = 0 THEN IOERROR(41); %CJC 103I02653500
|
|
% EOF IS READ ONLY %CJC 103I02653600
|
|
STOREINTOITEM(FIB[5].[40:1]); %CJC 103I02653700
|
|
GO TO ATTEXIT; %CJC 103I02653800
|
|
%CJC 103I02655500
|
|
AREAS:: %CJC 103I02655600
|
|
IF OPCODE = 0 THEN %CJC 103I02655700
|
|
IF (TEMP ~ GETFROMITEM) < 1 OR TEMP > 20 THEN %CJC 103I02655800
|
|
IOERROR(42) ELSE % OK VALUES 1-20 %CJC 103I02655900
|
|
FIB[8].[20:5] ~ TEMP ELSE %CJC 103I02656000
|
|
STOREINTOITEM(FIB[8].[20:5]); %CJC 103I02656100
|
|
GO TO ATTEXIT; %CJC 103I02656200
|
|
%CJC 103I02656300
|
|
AREASIZE:: %CJC 103I02656400
|
|
IF OPCODE = 0 THEN %CJC 103I02656500
|
|
IF (TEMP ~ GETFROMITEM) < 1 THEN %CJC 103I02656600
|
|
IOERROR(42) ELSE % MUST HAVE 1 OR MORE %CJC 103I02656700
|
|
FIB[8].[25:23] ~ TEMP ELSE %CJC 103I02656800
|
|
STOREINTOITEM(FIB[8].[25:23]); %CJC 103I02656900
|
|
GO TO ATTEXIT; %CJC 103I02657000
|
|
%CJC 103I02657100
|
|
MFID:: %CJC 103I02657200
|
|
FID:: %CJC 103I02657300
|
|
IF OPCODE = 0 AND FIB [5].[42:1] = 0 THEN 02657310
|
|
IF ((UNITYPE~FPB[XI+3].[43:5])= 10 OR UNITYPE = 12 02657320
|
|
OR UNITYPE = 13) THEN % DISK FILE IS NOT CLOSED WITH RELEASE 02657330
|
|
IOERROR(40); % CANT CHANGE MFID/FID 02657340
|
|
ATTNUM ~ ATTNUM - 6; %CJC 103I02657400
|
|
IF FIB[4].[2:1] = 0 THEN % IF LABELED %CJC 103I02657405
|
|
IF OPCODE = 1 AND FIB[5].[41:3] = 1 THEN %CJC 103I02657410
|
|
BEGIN % IF "MOVE" AND FILE OPEN INPUT PICKUP %CJC 103I02657420
|
|
% MFID AND ID FROM LABEL IN CASE OF "IL". %CJC 103I02657430
|
|
STOREINTOITEM(LBL[ATTNUM + 1].[6:42]); %CJC 103I02657440
|
|
GO TO ATTEXIT; %CJC 103I02657450
|
|
END; %CJC 103I02657460
|
|
IF OPCODE = 0 THEN %CJC 103I02657500
|
|
FPB[XI + ATTNUM].[6:42] ~ GETFROMITEM ELSE %CJC 103I02657600
|
|
STOREINTOITEM(FPB[XI + ATTNUM].[6:42]); %CJC 103I02657700
|
|
GO TO ATTEXIT; %CJC 103I02657800
|
|
% NOTE THAT MFID MUST BE ATTRIBUTE 6 AND FID MUST %CJC 103I02657900
|
|
% BE ATTRIBUTE 7 TO MAKE THE ABOVE WORK. %CJC 103I02658000
|
|
%CJC 103I02658100
|
|
BUFFERS:: %CJC 103I02658200
|
|
IF OPCODE = 0 THEN %CJC 103I02658300
|
|
IF FIB[4].[27:3] ! 0 THEN IOERROR(43) ELSE %CJC 103I02658400
|
|
% CHANGING # OF BUFFERS ON NON-SERIAL %CJC 103I02658500
|
|
IF (TEMP ~ GETFROMITEM) > FIB[13].[1:9] THEN %CJC 103I02658600
|
|
IOERROR(44) ELSE % INCREASING # OF BUFFERS %CJC 103I02658700
|
|
IF TEMP < 1 THEN IOERROR(42) ELSE %CJC 103I02658800
|
|
FIB[13].[1:9] ~ TEMP ELSE %CJC 103I02658900
|
|
STOREINTOITEM(FIB[13].[1:9]); %CJC 103I02659000
|
|
GO TO ATTEXIT; %CJC 103I02659100
|
|
%CJC 103I02659200
|
|
BLOCKSIZE:: %CJC 103I02659300
|
|
IF OPCODE = 1 THEN %CJC 103I02659400
|
|
BEGIN STOREINTOITEM(FIB[18].[3:15]); %CJC 103I02659500
|
|
GO TO ATTEXIT; %CJC 103I02659600
|
|
END; %CJC 103I02659700
|
|
% THE FOLLOWING WILL "SET" BLOCKSIZE: %CJC 103I02659800
|
|
IF (TEMP ~ GETFROMITEM) MOD FIB[18].[33:15] ! 0 %CJC 103I02659900
|
|
THEN IOERROR(45); %CJC 103I02660000
|
|
% I/O ERROR 45 IF NOT MULTIPLE OF RECORD LENGTH %CJC 103I02660100
|
|
IF NOT ((UNITYPE ~ FPB[XI + 3].[43:5]) = 2 %CJC 103I02660200
|
|
OR UNITYPE = 7 OR UNITYPE = 8 %CJC 103I02660300
|
|
OR UNITYPE = 9 OR UNITYPE = 12) THEN %CJC 103I02660400
|
|
IOERROR(46); %CJC 103I02660500
|
|
% I/O ERROR 46 UNLESS FILETYPE IS MAGTAPE, PAPERTAPE %CJC 103I02660600
|
|
% OR SERIAL DISK. %CJC 103I02660700
|
|
% AT THIS POINT THE CHANGE TO BLOCKSIZE IS VALID %CJC 103I02660800
|
|
% A CHANGE TO TECHNIQUE (FIB[5].[46:2]) AND RECORDS %CJC 103I02660900
|
|
% PER BLOCK (FIB[11]) IS TAKEN INTO CONSIDERATION. %CJC 103I02661000
|
|
FIB[18].[3:15] ~ TEMP; %CJC 103I02661050
|
|
FIB[11] ~ TEMP DIV FIB[18].[33:15]; %CJC 103I02661100
|
|
FIB[5].[46:2] ~ (IF FIB[11] = 1 THEN 0 ELSE 1); %CJC 103I02661200
|
|
GO TO ATTEXIT; %CJC 103I02661300
|
|
%CJC 103I02661400
|
|
MAXRECSIZE:: %CJC 103I02661500
|
|
IF OPCODE = 0 THEN IOERROR(41); %CJC 103I02661600
|
|
% MAXRECSIZE IS READ ONLY %CJC 103I02661700
|
|
STOREINTOITEM(FIB[18].[33:15]); %CJC 103I02661800
|
|
GO TO ATTEXIT; %CJC 103I02661850
|
|
%CJC 103I02661900
|
|
TYPE:: %CJC 103I02661990
|
|
IF OPCODE = 1 THEN %CJC 103I02662000
|
|
BEGIN STOREINTOITEM(FPB[XI + 3].[43:5]); %CJC 103I02662010
|
|
GO TO ATTEXIT; %CJC 103I02662020
|
|
END; 02662030
|
|
IF (TEMP ~ FPB[XI+3].[43:5]) > 9 AND TEMP < 15 02662040
|
|
OR TEMP = 19 OR TEMP = 26 02662050
|
|
THEN IOERROR(48); 02662060
|
|
% I/O FRROR 48 = FILE TYPE NOT ALTERABLE 02662080
|
|
FPB[XI + 3].[43:5] ~ TEMP ~ GETFROMITEM; %CJC 103I02662100
|
|
IF TEMP = 0 % CARD %CJC 103I02662200
|
|
OR TEMP > 19 AND TEMP < 26 THEN %PUNCH BACKUP %CJC 103I02662300
|
|
IF FIB[18].[3:15] < 11 THEN GO TO ATTEXIT %CJC 103I02662400
|
|
ELSE IOERROR(42); % AND BLOCK < 11 WORDS %CJC 103I02662500
|
|
IF TEMP = 1 OR TEMP = 4 OR TEMP = 6 %CJC 103I02662600
|
|
OR TEMP > 14 AND TEMP < 19 THEN % PRINTERS %CJC 103I02662700
|
|
IF FIB[18].[3:15] < 18 THEN GO TO ATTEXIT %CJC 103I02662800
|
|
ELSE IOERROR(42); % BLOCK < 18 WORDS %CJC 103I02662900
|
|
IF TEMP = 2 % MAG TAPE %CJC 103I02663000
|
|
OR TEMP = 7 % PAPER TAPE %CJC 103I02663100
|
|
OR TEMP = 8 % PT UNLABELED %CJC 103I02663200
|
|
OR TEMP = 9 THEN % MT UNLABELED %CJC 103I02663300
|
|
GO TO ATTEXIT; %CJC 103I02663500
|
|
IOERROR(42); %CJC 103I02663600
|
|
SAVEFACTOR: REEL:: DATE : %%CJC1103I02663800
|
|
IF OPCODE = 0 THEN % "SET" ATTRIBUTE %CJC 103I02663900
|
|
BEGIN STREAM(K~[TEMP], L~[ITEM]); %CJC 103I02664000
|
|
BEGIN SI ~ L; DI ~ K; DS ~ 8 DEC; %CJC 103I02664100
|
|
END; %CJC 103I02664200
|
|
IF ATTNUM = 9 THEN % "DATE" %CJC 103I02664300
|
|
FPB[XI + 2].[18:30] ~ TEMP ELSE %CJC 103I02664400
|
|
IF ATTNUM = 8 THEN % "REEL" %CJC 103I02664500
|
|
FPB[XI + 2].[1:17] ~ TEMP ELSE %CJC 103I02664600
|
|
FIB[4].[30:18] ~ TEMP; %CJC 103I02664800
|
|
GO TO ATTEXIT; %CJC 103I02664900
|
|
END; %CJC 103I02665000
|
|
IF FIB[4].[2:1] = 1 THEN IOERROR(47); %CJC 103I02665050
|
|
STREAM(K ~ IF FIB[5].[41:2] ! 0 THEN %CJC 103I02665100
|
|
IF ATTNUM = 9 THEN FPB[XI+2].[18:30] ELSE %CJC 103I02665200
|
|
IF ATTNUM = 8 THEN FPB[XI+2].[1:17] ELSE %CJC 103I02665300
|
|
FIB[4].[30:18] ELSE %CJC 103I02665350
|
|
IF ATTNUM = 9 THEN LBL[3].[18:30] ELSE %CJC 103I02665360
|
|
IF ATTNUM = 8 THEN LBL[3].[1:17] ELSE %CJC 103I02665370
|
|
FIB[4].[30:18], L ~ [ITEM]); %CJC 103I02665400
|
|
BEGIN SI~LOC K; DI~L; DS~8 OCT; %CJC 103I02665500
|
|
END; %CJC 103I02665600
|
|
GO TO ATTEXIT; %CJC 103I02665700
|
|
FIBWORDS:: %CJC 103I02665900
|
|
IF OPCODE = 0 THEN IOERROR(41); %CJC 103I02666000
|
|
% FIB IS READ ONLY %CJC 103I02666100
|
|
STREAM(A~[FIB[0]], B~[ITEM]); %CJC 103I02666200
|
|
BEGIN SI ~ A; DI ~ B; DS ~ 20 WDS; %CJC 103I02666300
|
|
END; %CJC 103I02666400
|
|
GO TO ATTEXIT; %CJC 103I02666500
|
|
:: %CJC 103I02666600
|
|
FPBWORDS %CJC 103I02666700
|
|
IF OPCODE = 0 THEN IOERROR(41); %CJC 103I02666800
|
|
% FPB IS READ ONLY %CJC 103I02666900
|
|
STREAM(A~[FPB[XI]], B~[ITEM]); %CJC 103I02667000
|
|
BEGIN SI ~ A; DI ~ B; DS ~ 5 WDS; %CJC 103I02667100
|
|
END; %CJC 103I02667200
|
|
GO TO ATTEXIT; %CJC 103I02667300
|
|
%CJC 103I02667400
|
|
LABELWORDS:: %CJC 103I02667500
|
|
IF OPCODE = 0 THEN IOERROR(41); %CJC 103I02667600
|
|
% LABEL IS READ ONLY %CJC 103I02667700
|
|
IF FIB[5].[41:2] ! 0 THEN IOERROR(47); %CJC 103I02667710
|
|
% I/O ERROR 47 = ACCESS TO LABEL WHEN FILE NOT OPEN %CJC 103I02667720
|
|
IF FIB[4].[2:1] = 1 THEN IOERROR(47); %CJC 103I02667730
|
|
STREAM(A~[LBL[0]], B~[ITEM]); %CJC 103I02667800
|
|
BEGIN SI ~ A; DI ~ B; DS ~ 8 WDS; %CJC 103I02667900
|
|
END; %CJC 103I02668000
|
|
GO TO ATTEXIT; %CJC 103I02668100
|
|
EUNUM:: IF FIB[5].[41:2] = 0 AND OPCODE=0 THEN GO TO ATTEXIT; 02668200
|
|
IF OPCODE = 0 THEN 02668300
|
|
FPB[XI+3].[18:5]:=GETFROMITEM+1 ELSE 02668400
|
|
STOREINTOITEM(FPB[XI+3].[18:5]-1); 02668500
|
|
GO TO ATTEXIT; 02668600
|
|
DSKSPEED:: IF FIB[5].[41:2] = 0 AND OPCODE=0 THEN GO TO ATTEXIT; 02668700
|
|
IF OPCODE = 0 THEN 02668800
|
|
FPB[XI+3].[16:2]:=GETFROMITEM ELSE 02668900
|
|
BEGIN 02669000
|
|
TEMP := IF (TEMP:=FPB[XI+3].[16:2])=1 THEN 02669100
|
|
1 ELSE IF TEMP=2 THEN 2 ELSE 0; 02669200
|
|
STOREINTOITEM(TEMP); 02669400
|
|
END; 02669500
|
|
GO TO ATTEXIT; 02669600
|
|
:: 02680000
|
|
TIMELIMIT 02680100
|
|
IF OPCODE = 0 THEN 02680200
|
|
$ SET OMIT = NOT SHAREDISK 02680299
|
|
ELSE 02680500
|
|
BEGIN 02680600
|
|
$ SET OMIT = NOT SHAREDISK 02680699
|
|
STOREINTOITEM(TEMP); 02680900
|
|
END; 02681000
|
|
GO TO ATTEXIT; 02681100
|
|
02681200
|
|
IOSTATUS:: 02681300
|
|
IF OPCODE = 0 THEN IOERROR(41); 02681400
|
|
% IOSTATUS IS READ ONLY 02681500
|
|
$ SET OMIT = NOT SHAREDISK 02681599
|
|
STOREINTOITEM(TEMP); 02681800
|
|
GO TO ATTEXIT; 02681900
|
|
SENSITIVE: 02683000
|
|
IF OPCODE=0 THEN 02683100
|
|
FPB[XI+3].[15:1]:=GETFROMITEM ELSE 02683200
|
|
BEGIN 02683300
|
|
TEMP:=FPB[XI+3].[15:1]; 02683400
|
|
STOREINTOITEM(TEMP); 02683500
|
|
END; 02683600
|
|
GO ATTEXIT; 02683700
|
|
ATTEXIT:: 02685000
|
|
P(XIT); 02686000
|
|
END OF COBOLATT; 02687000
|
|
PROCEDURE COBOLDC; % INTRINSIC NUMBER 167 02690000
|
|
BEGIN 02690020
|
|
REAL CODE = -1; % 0=READ,1=WRITE,2=SEEK,6=WRTBLK, 02690040
|
|
NAME DLOC = -2; % POINTS TO BUFFER I/O DESC 02690060
|
|
REAL NUMWDS = -3, % # WDS TO BE WRITTEN 02690080
|
|
KEY = -4, % RANDOM RECORD ADDRESS OR CARRAGE RTN02690100
|
|
EXPSTATAR = -4, % AREA TO EXPAND STATUS INTO 02690120
|
|
CHNNL = -4, % LP CHANNEL SKIP 02690140
|
|
LINES = -5, % # LINES TO BE SPACED 02690160
|
|
TIMEOUT = -5, % UNTIL PORIION OF DATA COM 02690180
|
|
SKIPAFT = -6 % 1=SPACE AFTER PRINT 02690200
|
|
;INTEGER 02690220
|
|
STATN = -6, % DATA COMM STATION (BUFFER) 02690240
|
|
TUNR = -7; % DATA COMM TERMINAL UNIT 02690260
|
|
%LOCALS 02690280
|
|
REAL COBOLCONTROL=23; % FOR LINKAGE BY USE ROUTINES 02690300
|
|
REAL COBOLINDEX =22; % FOR LINKAGE BY USE ROUTINES 02690320
|
|
REAL DEST ; % DESTINATION IN RANDOM MOVE 02690340
|
|
ARRAY FIB [*]; % FIB ARRAY 02690360
|
|
REAL FILECTRL =12 ; % USED TO CALL COBOLFCR 02690380
|
|
NAME FLOC; % POINTER TO FIB 02690400
|
|
ARRAY FPB = 3[*]; % FILE PARAMETER BLOCK 02690420
|
|
ARRAY H[*]; % DISK FILE HEADER 02690440
|
|
NAME MEM = 2; % DUMMY DATA DESC 02690460
|
|
ARRAY PGUSE=24[*]; % PROGRAM USE ROUTINES 02690480
|
|
REAL RTOG; % 1=I/O DONE THIS ROUND 02690500
|
|
REAL T; % TEMPORARY 02690520
|
|
REAL TECHCOFLO; % USED FOR TECH-C OVER FLOWS 02690540
|
|
REAL UNITYPE; % STORE UNIT TYPE FOR MANY TESTS 02690560
|
|
REAL X1; % *DO*NOT*SEPARATE X1 & X2 THEY ARE 02690580
|
|
REAL X2; % USED IN CONJUNCTION FOR TECHC OFLOWS02690600
|
|
INTEGER BS = X1; % USED IN COMPUTING DISK ADDR 02690620
|
|
INTEGER RT = X2; % USED IN COMPUTING DISK ADDR 02690640
|
|
DEFINE 02690660
|
|
ARROW = P(0,NOT,NUMWDS,TIP,INX,~)#, 02690680
|
|
% THIS INSERTS THE GROUP MARK 02690700
|
|
BADKEY = FIB[13].[19:1]#, % BAD KEY RANDOM DISK 02690720
|
|
BCOUNT = FIB[6]#, % BLOCK COUNT 02690740
|
|
BINARY = FIB[13].[24:1]#, % 1=BINARY,0=ALPHA 02690760
|
|
BOUNDED = FIB[9].[2:1]#, % TRUE IF BOUNED FROM ABOVE 02690780
|
|
BREAK = FIB[9] ! 0 # , % BREAKOUT RESTART POINT 02690800
|
|
BREAKOUT = IF(RCOUNT MOD FIB[9])=0 THEN 02690820
|
|
P(0,0,12,COM,DEL,DEL)#,% CALL BREAKOUT 02690840
|
|
BUFFNUM = FIB[13].[1:9] #, % # OF BUFFS REQUSTED 02690860
|
|
BUFFSIZE = FIB[18].[3:15]#, % BUFFER SIZE (REQUESTED) 02690880
|
|
BUFFSZ = FIB[18][8:8:10]#, % SIZE FOR CONCATINATES 02690900
|
|
BUFSTATUS = FIB[14] #, % STATUS AFTER SEEKDC 02690920
|
|
BUFTOP = FIB [16]#, % USED ON I-O AND RANDOM 02690940
|
|
BUILDSTATNWD =P((STATN~SKIPAFT)& % BUILD STATION WORD FOR DC 02690960
|
|
P(DUP)[14:44:4]&(TUNR~TUNR)[9:44:4])#, 02690980
|
|
CHECK(CHECK1) = IF P(DUP)!(CHECK1) THEN P(CHECK1,0,FLOC,#, 02691000
|
|
ONERR(ONERR1) = ONERR1,17,COM,DEL,DEL,DEL,DEL); P(DEL)#, 02691020
|
|
% THE ABOVE ARE USED ON BLOCK+REC CHKS02691040
|
|
CLEARSTATUS =P(0,TIP,~)#, % CLEAR BUFF[0] FOR WRITE 02691060
|
|
CLOSFANDOPEN =P(MKS,1,0,FLOC,4,FILECTRL, %CLOSE NO RWD 02691080
|
|
MKS,FLOC,1,FILECTRL)#, % OPEN INPUT 02691100
|
|
COUNT = FIB[12] #, % USED FOR BLOCKING TECH-A,B02691120
|
|
DCBUFRLS = P(NUMBUF,DLOC,16, % DATA COMM BUFFER RELEASE 02691140
|
|
11,COM,DEL,DEL,DEL)#, 02691160
|
|
DELAY = TIP.[20:1] #, % THIS ALLOWS ONE CYCLE DELY02691180
|
|
DONE = TIP.[19:1] #, % 1= IO COMPLETED 02691200
|
|
DISK = (UNITYPE=4) #, % DISK IS UNIT TYPE OF 4 02691220
|
|
FNAM = FIB[4].[13:11]#, % FILE NAME INDEX IN FPB 02691240
|
|
ENDFILE = FIB[5].[40:1] #, % ALREADY PASSED EOF 02691260
|
|
ENDPROCESS = FIB[5].[39:2]#, % SEE OPTIONAL AND ENDFILE 02691280
|
|
ENDREEL = X2 #, % USED ONLY ON READ 02691300
|
|
EOF =((*DLOC).[27:1])#, % FIRST EOF OR EOT 02691320
|
|
FOREVER =(NOT 0).[9:39] #, % UNTIL END TIME 02691340
|
|
EXPAND = *P(.EXPSTATAR) #, % EXPAND CELL CHECK 02691360
|
|
EXPANDSTATUS = P(TIP,0,0,EXPAND, % EXPAND SIATUS WORD 02691380
|
|
27,COM,DEL,DEL,DEL,DEL)#, 02691400
|
|
GETSEG = P(FPB[(BS~FNAM)+3],FPB[BS],FPB[BS+1], 02691420
|
|
T,H,4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL)#, 02691440
|
|
HASH =IF NOT DISK THEN IF FIB[8]>0 THEN 02691460
|
|
P(MKS,FLOC,*FIB[8],3,COC)#, 02691480
|
|
% ABOVE CALLS ROUTINES FOR HASH ACCUMULATON02691500
|
|
HASHTOT =IF FIB[8] >0 THEN IF P(MKS,FLO0,*FIB[8],0,COC) 02691520
|
|
THEN IOERR(18)#,% CHECKS HASH TOTALS 02691540
|
|
HOWOPEN = FIB[5].[41:3]#, % 1=OPEN INPUT,0= OPEN OUTPT02691560
|
|
% 1 > CLOSED 02691580
|
|
INVALIDUSER = FIB[5]<0#, % INVALID USER NOT PARITY 02691600
|
|
IOERR(IOERR1) = P(0,FLOC,IOERR1,17,COM,DEL,DEL,DEL)#, 02691620
|
|
% ABOVE CALLS IOERROR ROUTINE 02691640
|
|
IOMASK = DEST #, % HAS IOMASK TO SAVE C-REL 02691660
|
|
LABEQ = FIB[5].[17:1] #, % LABEL EQUATED FROM DISK 02691680
|
|
LASTDONE = FIB[13].[21:1] #, % NOT OF LAST OPERAIION DONE02691700
|
|
LASTIO = FIB[13].[46:1]#, %LAST WAS PHYSICAL READ 02691720
|
|
LBLPTR = FLOC[1] #, % LABEL POINTER 02691740
|
|
LINEPRINT = UNITYPE=1 OR UNITYPE=7 OR UNITYPE=12 #, 02691760
|
|
% 1= LP , 7 = PBT , 12 = PBD 02691780
|
|
LSUBL = FIB [1] #, % LOWER BOUND FOR RANDOM 02691800
|
|
LSUBU = FIB [3] #, % UPPER BOUND FOR DISK REC 02691820
|
|
MAXR = FIB[18][8:38:10]#,% MAX REC SZ FOR CONCATS 02691840
|
|
MAXREC = FIB[18].[33:15]#, % MAX REC SZ 02691860
|
|
NONSTD = FIB [5].[16: 1]#, % NON-STANDARD LABELS 02691880
|
|
NUMBUF = FIB[13].[10: 9]#, % NUMBER OF BUFFERS ASSIGNED02691900
|
|
NUMBSPC = H[9].[43:5]#, % ROWS SPECIFIED %CJC 020 02691920
|
|
NUMREC = FIB[11] #, % RECORDS PER BLOCK 02691940
|
|
NXTREEL = P(MKS,2,1,FLOC,4, % THIS DOES REEL SWITCHING 02691960
|
|
FILECTRL)#, % 02691980
|
|
OPENIO = FIB[13].[22:1]#, % 1= OPEN INPUT-OUPUT (DISK)02692000
|
|
OPTIONAL = FIB[ 5].[39:1]#, % OPTIONAL FILE NOT PRESENT 02692020
|
|
PARITY = TIP.[28:1]#, % PARITY BIT ON DESC 02692040
|
|
PRESENT =((*DLOC).[2:1])#, % CHECKS PRESENTSBIT 02692060
|
|
PROPER =21+CODE+CODE+REVERSE#,% GENERATES PROPER IOERR 02692080
|
|
PUNCH = UNITYPE=6#, % UNIT IS CARD PUNCH %TR 830 I02692100
|
|
PURGE = TIMEOUT.[FF]!0#, % TRUE IF LINE TO BE PURGED 02692120
|
|
RANDOM = TECHCOFLO#, % 1 = RANDOM DISK 02692140
|
|
RCOUNT = FIB[7] #, % RECORD COUNT 02692160
|
|
READER =(UNITYPE MOD 11=0)#,% 0=READER 11=PSUDOREADER 02692180
|
|
READLBL =P(DLOC INX 0,11,11 % THIS READS THE LABEL. 02692200
|
|
,COM,DEL,DEL)#, % 02692220
|
|
RECPERBLK = H[0].[30:12] #, % RECORDS PER BLOCK 02692240
|
|
REMOTEIO =P(BUFFSIZE,DLOC, % READ & WRITE BATCH SYSTEM 02692260
|
|
FOREVER,(IF CODE THEN LINES ELSE 1), %FOR 02692280
|
|
KEY=0,CFX,TIP,CODE,36,COM, %REMOTE OR 02692300
|
|
DEL,DEL,DEL,DEL,DEL,1,SUB,RTN)#,%TYPE 19 FILES 02692320
|
|
REMOTEREAD =P(BUFFSIZE,TIP,0, % READ FOR ISS 02692340
|
|
(-13),COM,0,RTN)#, % 02692360
|
|
REMOTEWRIT =P(TIP,NUMWDS |8, % WRITE FOR TSS 02692380
|
|
LINES,KEY,CFX,0,(-11),COM,DEL,RTN)#, 02692400
|
|
RESETPARITY = DLOC[0]~TIP&0[28:28:1]#,%RESET PARIIY BII DISK02692420
|
|
RESETREADBIT = 0[24:24:1]#, % USED TO TURN OFF READ BIT 02692440
|
|
REVERSE = FIB[5].[44:1] #, % 1=REVERSE 02692460
|
|
ROTATEBUF =P(NUMBUF,DLOC,13,11 % ROTATES BUFFERS WIIH 02692480
|
|
,COM,DEL,DEL,DEL)#,% NO I/O 02692500
|
|
ROWLGTH = H[1]#, % ROW LGTH FROM HEADER 02692520
|
|
SANDBKEY = FIB[13].[19:2] #, % SEEK AND BADKEY 02692540
|
|
SEEKDC =P(0&NUMWDS[14:44:4] % DATA COM SEEK AND XIT 02692560
|
|
&CHNNL [9:44:4],DLOC,5,11,COM,XIT)#, 02692580
|
|
SEEKEY = FIB[13].[20:1]#, % SEEK WAS DONE 02692600
|
|
SERIAL = FIB[4].[27:3]=0 #, % FILE ACCESS = SERIAL 02692620
|
|
SEGPERBLK = H[0].[42:6] #, % SEGMENTS PER BLOCK 02692640
|
|
SETPRESENTSBIT =P(TIP OR MEM ,DLOC,~)#,% SET PRESENCE BIT 02692660
|
|
$ SET OMIT = NOT(TIMESHARING) 02692680
|
|
SLEEP = 36 #, 02692700
|
|
$ POP OMIT 02692720
|
|
$ SET OMIT = TIMESHARING 02692740
|
|
TAPEE = TIP.[7:1] #, % 1= TAPES 0=ALL ELSE 02692800
|
|
TECH = FIB[5].[46:2] #, %TECHNIQUE 02692820
|
|
TECHA =(FIB[5].[46:2]=1) #,% TECHNIQUL-A 02692840
|
|
TECHC =(FIB[5].[46:2]=3) #,% TECHNIQUL-C 02692860
|
|
TERM(TERM1) = P(1,FLOC,TERM1,17,COM)#,%TERMINATE I/O ERROR 02692880
|
|
TIP = (*DLOC) #, % LOAD I/O DESC 02692900
|
|
TOTREC = H[7] #, % TOTAL RECORDS ON FILE 02692920
|
|
UNLABELED = (FIB[4].[2:1])#, % UNLABELED FILE 02692940
|
|
UT = (FIB[4].[8:4])#, % HARDWARE TYPE 02692960
|
|
WAITDC = P(DLOC,IOMASK, % THIS SLEEPS ON I/O COMPLE02692980
|
|
SLEEP,COM,=)#, % AND LEAVES A FALSE ON STK02693000
|
|
WAITIO = P(DLOC,IOMASK, % THIS SLEEPS ON I/O 02693020
|
|
SLEEP,COM,DEL,DEL)#,% WAITING FOR A COMPLETE 02693040
|
|
WORDSLEFT = FIB[17]#, % WORDS LEFT IN BUFFER 02693060
|
|
WRITEAFTEREOF = FIB[13].[44:2]#, % 02693080
|
|
WRITBACK = FIB[13].[23:1]#; % FLAG TO SAY WRITE BACK 02693100
|
|
LABEL LPRETURN,IOUT,START,IODONE,RANDOMLBL,SEEKRTN,SETUP; 02693120
|
|
LABEL IMPROPER,DCPRL,FIXSTATNWD,DIDDLE,DIDDLEWRT,SERIALIO,EOFSEICK; 02693140
|
|
LABEL DATACOM,RANDOMIO; %CUBE XIX I 02693160
|
|
START : 02693180
|
|
FIB ~ *(FLOC ~ (NOT 2) INX DLOC); 02693200
|
|
IOMASK ~ @2000000000; 02693220
|
|
IF CODE THEN % DC WRITE 02693240
|
|
BEGIN RTOG ~ (-4); % SET ALGOLIO FOR COBOLDCWR 02693260
|
|
CLEARSTATUS; 02693280
|
|
GO TO FIXSTATNWD; 02693300
|
|
END; 02693320
|
|
IF BUFSTATUS=0 THEN 02693340
|
|
BEGIN RTOG ~ 1; % SET ALGOLIO FOR READC 02693360
|
|
FIXSTATNWD: BUILDSTATNWD; 02693380
|
|
GO TO DCPRL; 02693400
|
|
END; 02693420
|
|
IF DELAY THEN % THIS IS USED TO INHIBIT BUFFER 02693440
|
|
DCBUFRLS; % ROTATION ON 1ST READ 02693460
|
|
IF TIMEOUT < 0 THEN % UNTIL END READ 02693480
|
|
BEGIN WAITDC; % THIS LEAVES 0 ON STACK 02693500
|
|
DLOC[0]~ TIP&1[20:47:1]; % SET DELAY 02693520
|
|
END ELSE BEGIN 02693540
|
|
P(BUFSTATUS); % SET ALGOLIO FOR READSOUGHT 02693560
|
|
DCPRL: P(IF TIMEOUT < 0 THEN FOREVER ELSE TIMEOUT.[CF] 02693580
|
|
|60&(PURGE)[1:47:1],XCH,DLOC,15-RTOG,11,COM, 02693600
|
|
DEL,DEL,DEL,1,!); %THIS LEAVES 1 OR 0 ON STACK02693620
|
|
END; %DEPENDING ON HOW IO WAS. 02693640
|
|
IF EXPAND ! 0 THEN EXPANDSTATUS; 02693660
|
|
P(PRESENT,NOT,OR); %THIS ORS RESULTS OF ABOVE WITH 02693680
|
|
SETPRESENTSBIT; % PRESENTS BIT AND IS RETURNED TO 02693700
|
|
% PROGRAM. 02693720
|
|
P(RTN); 02693740
|
|
END COBOLDC; 02693760
|
|
PROCEDURE COBOLIO; 02700000
|
|
BEGIN 02700100
|
|
REAL CODE = -1; % 0=READ,1=WRITE,2=SELK,6=WRTBLK, 02700200
|
|
NAME DLOC = -2; % POINTS TO BUFFER I/O DESC 02700300
|
|
REAL NUMWDS = -3, % # WDS TO BE WRITTEN 02700400
|
|
KEY = -4, % RANDOM RECORD ADDRESS OR CARRAGE RTN02700500
|
|
EXPSTATAR = -4, % AREA TO EXPAND STATUS INTO 02700600
|
|
CHNNL = -4, % LP CHANNEL SKIP 02700700
|
|
LINES = -5, % # LINES TO BE SPACED 02700800
|
|
TIMEOUT = -5, % UNTIL PORTION OF DATA COM 02700900
|
|
SKIPAFT = -6 % 1=SPACE AFTER PRINT 02701000
|
|
;INTEGER 02701100
|
|
STATN = -6, % DATA COMM STATION (BUFFER) 02701200
|
|
TUNR = -7; % DATA COMM TERMINAL UNIT 02701300
|
|
ARRAY MKSCW=-4[*]; 02701310
|
|
%LOCALS 02701400
|
|
REAL COBOLCONTROL=23; % FOR LINKAGE BY USE ROUTINES 02701500
|
|
REAL COBOLINDEX =22; % FOR LINKAGE BY USE ROUTINES 02701600
|
|
REAL DEST ; % DESTINATION IN RANDOM MOVE 02701700
|
|
ARRAY FIB [*]; % FIB ARRAY 02701800
|
|
REAL FILECTRL =12 ; % USED TO CALL COBOLFCR 02701900
|
|
NAME FLOC; % POINTER TO FIB 02702000
|
|
ARRAY FPB = 3[*]; % FILE PARAMETER BLOCK 02702100
|
|
ARRAY H[*]; % DISK FILE HEADER 02702200
|
|
REAL IOMASK; % TO SAVE C-REL CALL 02702250
|
|
NAME MEM = 2; % DUMMY DAIA DESC 02702300
|
|
ARRAY PGUSE=24[*]; % PROGRAM USE ROUTINES 02702400
|
|
REAL RTOG; % 1=I/O DONE THIS ROUND 02702500
|
|
REAL T; % TEMPORARY 02702600
|
|
REAL TECHCOFLO; % USED FOR TECH-C OVER FLOWS 02702700
|
|
REAL UNITYPE; % STORE UNIT TYPE FOR MANY TESTS 02702800
|
|
REAL X1; % *DO*NOT*SEPARATE X1 & X2 THEY ARE 02702900
|
|
REAL X2; % USED IN CONJUNCTION FOR TECHC OFLOWS02703000
|
|
INTEGER BS = X1; % USED IN COMPUTING D1SK ADDR 02703100
|
|
INTEGER RT = X2; % USED IN COMPUTING DISK ADDR 02703200
|
|
$ SET OMIT = NOT SHAREDISK 02703204
|
|
DEFINE 02703300
|
|
ARROW = P(0,NOT,NUMWDS,TIP,INX,~)#, 02703400
|
|
% THIS INSERTS THE GROUP MARK 02703500
|
|
BADKEY = FIB[13].[19:1]#, % BAD KEY RANDOM DISK 02703600
|
|
BCOUNT = FIB[6]#, % BLOCK COUNT 02703700
|
|
BINARY = FIB[13].[24:1]#, % 1=BINARY,0=ALPHA 02703800
|
|
BOUNDED = FIB[9].[2:1]#, % TRUE IF BOUNED FROM ABOVE 02703900
|
|
BREAK = FIB[9] ! 0 # , % BREAKOUT RESTART POINT 02704000
|
|
BREAKOUT = IF(RCOUNT MOD FIB[9])=0 THEN 02704100
|
|
P(0,0,12,COM,DEL,DEL)#,% CALL BREAKOUT 02704200
|
|
BUFFNUM = FIB[13].[1:9] #, % # OF BUFFS REQUSTED 02704300
|
|
BUFFSIZE = FIB[18].[3:15]#, % BUFFER SIZE (REQUESTED) 02704400
|
|
BUFFSZ = FIB[18][8:8:10]#, % SIZE FOR 0ONCATINATES 02704500
|
|
BUFSTATUS = FIB[14] #, % STATUS AFTER SEEKDC 02704600
|
|
BUFTOP = FIB [16]#, % USED ON I-O AND RANDOM 02704700
|
|
BUILDSTATNWD =P((STATN~SKIPAFT)& % BUILD STATION WORD FOR DC 02704800
|
|
P(DUP)[14:44:4]&(TUNR~TUNR)[9:44:4])#, 02704900
|
|
CHECK(CHECK1) = IF P(DUP)!(CHECK1) THEN P(CHECK1,0,FLOC,#, 02705000
|
|
ONERR(ONERR1) = ONERR1,17,COM,DEL,DEL,DEL,DEL); P(DEL)#, 02705100
|
|
% THE ABOVE ARE USED ON BLOCK+REC CHKS02705200
|
|
CLEARSTATUS =P(0,TIP,~)#, % CLEAR BUFF[0] FOR WRITE 02705300
|
|
CLOSEANDOPEN =P(MKS,1,0,FLOC,4,FILECTRL, %CLOSE NO RWD 02705350
|
|
MKS,FLOC,1,FILECTRL)#, % OPEN INPUT 02705351
|
|
COUNT = FIB[12] #, % USED FOR BLOCKING TECH-A,B02705400
|
|
DCBUFRLS = P(NUMBUF,DLOC,16, % DATA COMM BUFFER RELEASE 02705500
|
|
11,COM,DEL,DEL,DEL)#, 02705600
|
|
DELAY = TIP.[20:1] #, % THIS ALLOWS ONE CYCLE DELY02705700
|
|
DONE = TIP.[19:1] #, % 1= IO COMPLETED 02705800
|
|
DISK = (UNITYPE=4) #, % DISK IS UNIT TYPE OF 4 02705900
|
|
FNAM = FIB[4].[13:11]#, % FILE NAME INDEX IN FPB 02706000
|
|
ENDFILE = FIB[5].[40:1] #, % ALREADY PASSED EOF 02706100
|
|
ENDPROCESS = FIB[5].[39:2]#, % SEE OPTIONAL AND ENDFILE 02706200
|
|
ENDREEL = X2 #, % USED ONLY ON READ 02706300
|
|
EOF =((*DLOC).[27:1])#, % FIRST EOF OR EOT 02706400
|
|
FOREVER =(NOT 0).[9:39] #, % UNTIL END TIME 02706500
|
|
EXPAND = *P(.EXPSTATAR) #, % EXPAND CELL CHECK 02706600
|
|
EXPANDSTATUS = P(TIP.0,0,EXPAND, % EXPAND STATUS WORD 02706700
|
|
27,COM,DEL,DEL,DEL,DEL)#, 02706800
|
|
GETSEG = P(FPB[(BS:=FNAM)+3],FPB[BS],FPB[BS+1], 02706900
|
|
T,H,4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL)#, 02707000
|
|
HASH =IF NOT DISK THEN IF FIB[8]>0 THEN 02707100
|
|
P(MKS,FLOC,*FIB[8],3,COC)#, 02707200
|
|
% ABOVE CALLS ROUTINES FOR HASH ACCUMULATON02707300
|
|
HASHTOT =IF FIB[8] >0 THEN IF P(MKS,FLOC,*FIB[8],0,COC) 02707400
|
|
THEN IOERR(18)#,% CHECKS HASH TOTALS 02707500
|
|
HOWOPEN = FIB[5].[41:3]#, % 1=OPEN INPUT,0= OPEN OUTPI02707600
|
|
% 1 > CLOSED 02707700
|
|
INVALIDUSER = FIB[5]<0#, % INVALID USER NOI PARITY 02707800
|
|
IOERR(IOERR1) = P(0,FLOC,IOERR1,17,COM,DEL,DEL,DEL)#, 02707900
|
|
% ABOVE CALLS IOERROR ROUTINE 02708000
|
|
LABEQ = FIB[5].[17:1] #, % LABEL EQUATED FROM DISK 02708200
|
|
LASTDONE = FIB[13].[21:1] #, % NOT OF LAST OPERATION DONE02708300
|
|
LASTIO = FIB[13].[46:1]#, %LAST WAS PHYSICAL READ 02708350
|
|
LBLPTR = FLOC[1] #, % LABEL POINTER 02708400
|
|
LINEPRINT = UNITYPE=1 OR UNITYPE=7 OR UNITYPE=12 #, 02708500
|
|
% 1= LP , 7 = PBT , 12 = PBD 02708600
|
|
LSUBL = FIB [1] #, % LOWER BOUND FOR RANDOM 02708700
|
|
LSUBU = FIB [3] #, % UPPER BOUND FOR DISK REC 02708800
|
|
MAXR = FIB[18][8:38:10]#,% MAX RFC SZ FOR CONCAIS 02708900
|
|
MAXREC = FIB[18].[33:15]#, % MAX REC SZ 02709000
|
|
NONSTD = FIB [5].[16: 1]#, % NON-STANDARD LABELS 02709100
|
|
NUMBUF = FIB[13].[10: 9]#, % NUMBER OF BUFFERS ASSIGNED02709200
|
|
NUMBSPC = H[9].[43:5]#, % ROWS SPECIFIED %CJC 020 02709300
|
|
NUMREC = FIB[11] #, % RECORDS PER BLOCK 02709400
|
|
NXTREEL = P(MKS,2,1,FLOC,4, % THIS DOES REEL SWITCHING 02709500
|
|
FILECTRL)#, % 02709600
|
|
OPENIO = FIB[13].[22:1]#, % 1= OPEN INPUT-OUPUT (DISK)02709700
|
|
OPTIONAL = FIB[ 5].[39:1]#, % OPTIONAL FILE NOT PRESENT 02709800
|
|
PARITY = TIP.[28:1]#, % PARITY BIT ON DESC 02709900
|
|
PRESENT =((*DLOC).[2:1])#, % CHECKS PRESENTSBIT 02710000
|
|
PROPER =21+CODE+CODE+REVERSE#,% GENERAIES PROPER IOERR 02710100
|
|
PUNCH = UNITYPE=6#, % UNIT IS CARD PUNCH %IR 830 I02710150
|
|
PURGE = TIMEOUT.[FF]!0#, % TRUE IF LINE TO BE PURGED 02710200
|
|
RANDOM = TECHCOFLO#, % 1 = RANDOM DISK 02710300
|
|
RCOUNT = FIB[7] #, % RECORD COUNT 02710400
|
|
READER =(UNITYPE MOD 11=0)#,% 0=READER 11=PSUDOREADER 02710500
|
|
READLBL =P(DLOC INX 0,11,11 % IHIS READS THE LABEL. 02710600
|
|
,COM,DEL,DEL)#, % 02710700
|
|
RECPERBLK = H[0].[30:12] #, % RECORDS PER BLOCK 02710800
|
|
REMOTEIO =P(BUFFSIZE,DLOC, % READ & WRITE BATCH SYSTEM 02710900
|
|
FOREVER,(IF CODE THEN LINES ELSE 1), %FOR 02710950
|
|
KEY=0,CFX,TIP,CODE,36,COM, %REMOTE OR 02711000
|
|
:DEL,DEL,DEL,DEL,DEL,1,SUB,RTN)#,%TYPE 19 FILES 02711100
|
|
REMOTEREAD =P(BUFFSIZE,TIP,1, % READ FROM TSS 02711200
|
|
(-13),COM,1,SUB,RTN)#, % 02711300
|
|
REMOTEWRIT =P(TIP,NUMWDS |8, % WRITE FOR TSS 02711400
|
|
LINES,KEY,CFX,0,(-11),COM,DEL,RTN)#, 02711500
|
|
RESETPARITY = DLOC[0]~TIP&0[28:28:1]#,%RESET PARITY BII DISK02711550
|
|
RESETREADBIT = 0[24:24:1]#, % USED TO TURN OFF READ BIT 02711600
|
|
REVERSE = FIB[5].[44:1] #, % 1=REVERSE 02711700
|
|
ROTATEBUF =P(NUMBUF,DLOC,13,11 % ROTATES BUFFERS WITH 02711800
|
|
,COM,DEL,DEL,DEL)#,% NO I/O 02711900
|
|
ROWLGTH = H[1]#, % ROW LGTH FROM HEADER 02712000
|
|
SANDBKEY = FIB[13].[19:2] #, % SEEK AND BADKEY 02712100
|
|
SEEKDC =P(0&NUMWDS[14:44:4] % DATA COM SEEK AND XIT 02712200
|
|
&CHNNL [9:44:4],DLOC,5,11,COM,XIT)#, 02712300
|
|
SEEKEY = FIB[13].[20:1]#, % SEEK WAS DONE 02712400
|
|
SERIAL = FIB[4].[27:3]=0 #, % FILE ACCESS = SERIAL 02712500
|
|
SEGPERBLK = H[0].[42:6] #, % SEGMENTS PER BLOCK 02712600
|
|
SETPRESENTSBIT =P(TIP OR MEM ,DLOC,~)#,% SET PRESENCE BIT 02712700
|
|
$ SET OMIT = NOT(TIMESHARING) 02712800
|
|
SLEEP = 36 #, 02712900
|
|
$ POP OMIT 02712950
|
|
$ SET OMIT = TIMESHARING 02713000
|
|
TAPEE = TIP.[7:1] #, % 1= TAPES 0=ALL ELSE 02713200
|
|
TECH = FIB[5].[46:2] #, %TECHNIQUE 02713250
|
|
TECHA =(FIB[5].[46:2]=1) #,% TECHNIQUL-A 02713300
|
|
TECHC =(FIB[5].[46:2]=3) #,% TECHNIQUE-C 02713400
|
|
TERM(TERM1) = P(1,FLOC,TERM1,17,COM)#,%TERMINATE I/O ERROR 02713500
|
|
TIP = (*DLOC) #, % LOAD I/O DESC 02713600
|
|
TOTREC = H[7] #, % TOTAL RECORDS ON FILE 02713700
|
|
UNLABELED = (FIB[4].[2:1])#, % UNLABELED FILE 02713800
|
|
UT = (FIB[4].[8:4])#, % HARDWARE TYPE 02713900
|
|
WAITDC = P(DLOC,IOMASK, % THIS SLEEPS ON I/O COMPLE02714000
|
|
SLEEP,COM,=)#, % AND LEAVES A FALSE ON STK02714100
|
|
WAITIO = P(DLOC,IOMASK, % THIS SLEEPS ON I/O 02714200
|
|
SLEEP,COM,DEL,DEL)#,% WAITING FOR A COMPLETE 02714300
|
|
WORDSLEFT = FIB[17]#, % WORDS LEFT IN BUFFER 02714400
|
|
WRITEPARITY = FIB[5].[3:1]#, % INDICATES FORCED REELSWITCH02714410
|
|
WRITEAFTEREOF = FIB[13].[44:2]#, % 02714450
|
|
WRITBACK = FIB[13].[23:1]#; % FLAG TO SAY WRITE BACK 02714500
|
|
LABEL LPRETURN,IOUT,START,IODONE,RANDOMLBL,SEEKRTN,SETUP; 02714600
|
|
LABEL IMPROPER,DCPRL,FIXSTATNWD,DIDDLE,DIDDLEWRT,SERIALIO,EOFSETCK; 02714700
|
|
LABEL DATACOM,RANDOMIO,REREAD; 02714800
|
|
SUBROUTINE GOUSE; % THIS CALLS USE ROUTINES 02714900
|
|
BEGIN COBOLINDEX ~ T.[26:10]; 02715000
|
|
P(MKS,T.[38:10],[COBOLCONTROL]); %THIS EXECUTES IHE 02715100
|
|
END GOUSE; % CODE SEGMENT 02715200
|
|
SUBROUTINE MAYBEPARITY; 02715300
|
|
BEGIN 02715400
|
|
SETPRESENTSBIT; 02715450
|
|
IF (T ~RT ~PGUSE[(DISK AND OPENIO)|3+9].[1:23])!0 02715500
|
|
THEN GOUSE ; 02715600
|
|
IF (T~FIB [15].[1:23]) !0 THEN GOUSE; 02715700
|
|
$ SET OMIT = NOT SHAREDISK 02715709
|
|
IF RTOG THEN 02715800
|
|
IF (T OR RT) = 0 THEN IOERR(19); 02715900
|
|
END MAYBEPARITY; 02716000
|
|
SUBROUTINE MOVREC; %THIS MOVES RECORDS TO&FROM WORK AREA 02716100
|
|
BEGIN IF CODE ! 4 THEN 02716200
|
|
P(BUFTOP INX(BS~(NUMWDS | (RCOUNT MOD NUMREC))+1)) 02716300
|
|
ELSE 02716400
|
|
P(XCH); %PICK UP VALUE LEFT FROM SERIALIO 02716500
|
|
P(BUFTOP INX (BUFFSIZE + 2)); %FIND END OF BUFFER 02716600
|
|
DEST := IF CODE THEN P (XCH) ELSE P; 02716700
|
|
STREAM (FROM:=P:NUMWDS,E:=NUMWDS.[36:6], XX:=DEST); 02716800
|
|
BEGIN 02716900
|
|
SI~FROM; E(DS~32WDS;DS~32WDS); DS~NUMWDS WDS; 02717000
|
|
END; 02717100
|
|
IF CODE THEN DEST := P 02717200
|
|
ELSE BEGIN 02717300
|
|
P(DEL); 02717400
|
|
IF CODE=0 AND PARITY THEN 02717500
|
|
BEGIN 02717510
|
|
$ SET OMIT = NOT SHAREDISK 02717519
|
|
MAYBEPARITY; 02717530
|
|
END; 02717540
|
|
END; 02717600
|
|
DLOC[0] ~ TIP& DEST[33:33:15] 02717700
|
|
END MOVREC; 02717800
|
|
SUBROUTINE DIDDLEREC; % THIS ROUTINE GETS THE NEXI RECORD 02717900
|
|
BEGIN % FOR ALL SERIAL FILES (READ & WRITE)02718000
|
|
WORDSLEFT ~ T ; 02718100
|
|
DLOC[0] ~ NUMWDS INX TIP; 02718200
|
|
RCOUNT ~ *P(DUP) + 1; 02718300
|
|
IF BREAK THEN BREAKOUT; 02718400
|
|
IF PARITY THEN MAYBEPARITY; 02718500
|
|
END DIDDLE; 02718600
|
|
$ SET OMIT = NOT SHARFDISK 02718604
|
|
SUBROUTINE PREL; % THIS DOES ACTUAL I/O 02718700
|
|
BEGIN 02718800
|
|
IF NOT (RT LSS 0) THEN 02718900
|
|
BEGIN 02719000
|
|
P( TIP,DLOC); 02719100
|
|
IF WRITBACK THEN % DO SPECIAL WRITE-IO 02719200
|
|
BEGIN WRITBACK ~ FALSE; % TURN OFF REAO BIT 02719300
|
|
DLOC[0]~ TIP&RESETREADBIT;% TO MAKE WRITE 02719400
|
|
END; 02719500
|
|
P(PRL,DEL); % DO I-O 02719600
|
|
END; 02719700
|
|
BCOUNT ~ *P(DUP) + (RTOG~1); %COUNT BLOCK&SET IOTOG02719900
|
|
IF CODE = 2 THEN GO TO SEEKRTN; 02719950
|
|
RCOUNT ~ *P(DUP) + 1; % COUNT RECS 02720000
|
|
IF NOT DONE THEN 02720100
|
|
$ SET OMIT = NOT SHAREDISK 02720109
|
|
WAITIO; 02720150
|
|
IF BREAK THEN BREAKOUT; 02720200
|
|
END PREL; % ON NEW DESC 02720300
|
|
SUBROUTINE REFLECTCHECKER ; % WRITE PARITY ROUTINE 02720400
|
|
BEGIN 02720500
|
|
IF NOT EOF THEN %TAPE WRITE PARITY OR BLANK TAPE 02720550
|
|
BEGIN 02720570
|
|
IF OPENIO AND DISK THEN IF(T~PGUSE[12].[1:23])!002720600
|
|
THEN GOUSE ELSE ELSE 02720605
|
|
IF (T~PGUSE[9].[24:24])!0 THEN GOUSE; 02720610
|
|
IF (T~FIB[15].[1:23]) ! 0 THEN GOUSE; 02720620
|
|
TERM(20); 02720650
|
|
END; 02720670
|
|
SETPRESENTSBIT; % MAKE DESC PRESENT 02720700
|
|
IF NOT DISK THEN NXTREEL;% REEL SWITCH 02720800
|
|
END RELECTCHECKER; 02720900
|
|
SUBROUTINE SKIPPER; % THIS DOES SKIPPING ON LINE PRINTER 02721000
|
|
BEGIN NUMBUF ~ 1; % INHIBIT BUFFER ROTATION 02721100
|
|
IF CHNNL ! 0 THEN LINES := 1; 02721200
|
|
DLOC[0] ~ TIP & 1 [18:47:1] 02721300
|
|
&(16+CHNNL) [27:42:6]; 02721400
|
|
FOR T~2 STEP 2 UNTIL LINES DO 02721500
|
|
BEGIN 02721600
|
|
PREL; 02721700
|
|
IF NOT PRESENT THEN IF EOF THEN SETPRESENTSBIT 02721800
|
|
ELSE REFLECTCHECKER; 02721810
|
|
END; 02721900
|
|
IF LINES THEN 02722000
|
|
BEGIN 02722100
|
|
DLOC[0]~ TIP & (2-(2|(CHNNL!0)))[27:46:2]; 02722200
|
|
PREL; 02722300
|
|
IF NOT PRESENT THEN IF EOF THEN SETPRESENTSBIT 02722400
|
|
ELSE REFLECTCHECKER; 02722410
|
|
END; 02722500
|
|
NUMBUF ~ BUFFNUM; % RESTORE BUFFER FOR ROTATION 02722600
|
|
END SKIPPER; 02722700
|
|
SUBROUTINE REVREAD; % THIS DOES A READ REVERSE 02722800
|
|
BEGIN DLOC[0] ~ FLAG (FIB [16]); 02722900
|
|
PREL; 02723000
|
|
FIB[16].[33:15]~ TIP; 02723100
|
|
WORDSLEFT ~ MEM [1 INX TIP]; 02723200
|
|
END; 02723300
|
|
SUBROUTINE READREV; % THIS HANDLES A READ REVERSE 02723400
|
|
BEGIN IF NOT TECHA THEN 02723500
|
|
BEGIN 02723600
|
|
REVREAD; 02723700
|
|
DLOC [0] ~ NOT(WORDSLEFT-2) INX TIP; 02723800
|
|
END 02723900
|
|
ELSE 02724000
|
|
IF (WORDSLEFT := T) LEQ 0 THEN 02724100
|
|
BEGIN 02724200
|
|
REVREAD; 02724300
|
|
DLOC[0] ~ (NOT(MAXREC - 2 )INX TIP)&MAXR; 02724400
|
|
END 02724500
|
|
ELSE BEGIN 02724600
|
|
DLOC[0]~ NOT(NUMWDS-1)INX (TIP 02724700
|
|
&(NOT TIP) [2:28:1]); 02724800
|
|
RCOUNT ~ *P(DUP) + 1; 02724900
|
|
END ; 02725000
|
|
IF NOT PRESENT THEN 02725100
|
|
BEGIN 02725200
|
|
SETPRESENTSBIT; 02725300
|
|
IF EOF THEN 02725400
|
|
BEGIN 02725500
|
|
ENDFILE ~ TRUE; 02725600
|
|
HASHTOT; 02725700
|
|
P (1,RTN); 02725800
|
|
END; 02725900
|
|
IF (T ~PGUSE[9]&FIB[15] [25:1:23])!0 THEN GOUSE;02726000
|
|
IF RTOG THEN IOERR (29); 02726100
|
|
END; 02726200
|
|
END READREV; 02726300
|
|
SUBROUTINE ERROR; 02726400
|
|
BEGIN IF EOF THEN 02726500
|
|
BEGIN 02726600
|
|
BCOUNT ~ *P(DUP) - 1; 02726700
|
|
RCOUNT ~ *P(DUP) - 1; 02726800
|
|
ENDFILE ~ TRUE; 02726900
|
|
SETPRESENTSBIT; 02727000
|
|
IF READER THEN P(1,RTN); 02727100
|
|
IF NOT UNLABELED THEN 02727200
|
|
BEGIN 02727300
|
|
ENDREEL := FALSE; 02727400
|
|
IF NOT DISK THEN 02727500
|
|
BEGIN 02727600
|
|
READLBL; 02727700
|
|
STREAM(SENT~0,BC~0,RC~0,WP~0:L~LBLPTR);02727800
|
|
BEGIN % THIS RETRIVES END02727900
|
|
DI ~ LOC SENT;% OF REEL SENTINAL,02728000
|
|
DI ~ DI +7; % BLOCK & REC COUNT02728100
|
|
SI ~ L ; SI ~SI+39; 02728200
|
|
DS ~ CHR;DS~5 OCT;DS~7 OCT; 02728300
|
|
DI ~ DI+7; DS ~ CHR; 02728310
|
|
END; 02728400
|
|
IF P=1 THEN WRITEPARITY ~ TRUE; 02728410
|
|
CHECK(RCOUNT) ONERR(16); 02728500
|
|
CHECK(BCOUNT) ONERR(17); 02728600
|
|
ENDREEL ~ P ; % THIS STORES SENTINAL 02728700
|
|
IF NOT WRITEPARITY THEN 02728710
|
|
BEGIN 02728720
|
|
HASHTOT; 02728800
|
|
IF (T~PGUSE[3].[ 1:23])! 0 THEN GOUSE;02728900
|
|
IF (T~PGUSE[3].[24:24])! 0 THEN GOUSE;02729000
|
|
END; 02729010
|
|
END 02729100
|
|
ELSE STREAM (RECTOT~ TOTREC + 1, 02729200
|
|
LABL ~ LBLPTR); 02729300
|
|
BEGIN 02729400
|
|
SI ~ LOC RECTOT ; 02729500
|
|
DI ~ DI + 45; 02729600
|
|
DS ~ 7 DEC; 02729700
|
|
END; 02729800
|
|
IF NOT ENDREEL THEN 02729900
|
|
IF PGUSE[BS~(DISK AND OPENIO)|9+2]!0 02730000
|
|
THEN BEGIN 02730100
|
|
IF (T~PGUSE[BS].[ 1:23])!0 THEN GOUSE;02730200
|
|
IF (T~PGUSE[BS].[24:24])!0 THEN GOUSE;02730300
|
|
END; 02730400
|
|
IF NOT DISK THEN % END OF REEL USE ROUTINES02730500
|
|
IF NOT WRITEPARITY THEN 02730510
|
|
BEGIN 02730600
|
|
IF (T~FIB [3].[ 1:23])!0 THEN GOUSE; 02730700
|
|
IF (T~FIB [3].[24:24])!0 THEN GOUSE; 02730800
|
|
END ; 02730900
|
|
IF NOT ENDREEL THEN 02731000
|
|
BEGIN 02731100
|
|
IF (T~ FIB [2].[ 1:23])!0 THEN GOUSE; 02731200
|
|
IF (T~ FIB [2].[24:24])!0 THEN GOUSE; 02731300
|
|
P(1,RTN); 02731400
|
|
END; 02731500
|
|
END; 02731600
|
|
IF NONSTD THEN 02731700
|
|
BEGIN 02731800
|
|
ENDFILE := FALSE; 02731900
|
|
CLOSEANDOPEN; 02731950
|
|
P(1,RTN); 02732000
|
|
END; 02732100
|
|
NXTREEL; 02732200
|
|
P(DEL,DEL); %DELETE BRANCH RETURNS 02732300
|
|
WRITEPARITY ~ FALSE; 02732310
|
|
GO TO START; 02732400
|
|
END; 02732500
|
|
MAYBEPARITY; 02732600
|
|
END ERROR; 02732700
|
|
SUBROUTINE DISKADDRESS; %THIS COMPUTES THE DISK ADDRESS READ & WRIT02732705
|
|
BEGIN 02732710
|
|
IF CODE THEN RT ~ SEGPERBLK | BCOUNT; 02732715
|
|
IF P(RT DIV ROWLGTH,DUP) GEQ NUMBSPC THEN 02732716
|
|
BEGIN 02732717
|
|
$ SET OMIT = NOT SHAREDISK 02732718
|
|
P(1,RTN); 02732721
|
|
END; 02732722
|
|
IF (T~ P + 10) LSS 10 THEN T~10; 02732723
|
|
IF (BS ~ H[T]) = 0 THEN 02732725
|
|
BEGIN 02732730
|
|
GETSEG; 02732740
|
|
IF INVALIDUSER THEN 02732742
|
|
BEGIN 02732744
|
|
MAYBEPARITY; 02732746
|
|
END; 02732748
|
|
IF HOWOPEN!0 THEN IF NOT OPENIO THEN IOERR(22); 02732750
|
|
BS ~ H[T]; 02732760
|
|
END; 02732765
|
|
STREAM( A ~ BS ~ BS + RT MOD ROWLGTH, 02732770
|
|
B~T~BUFTOP.[CF]-(IF CODE THEN 0 ELSE WRITBACK)); 02732775
|
|
BEGIN SI~LOC A; DS~8 DEC; END; 02732780
|
|
$ SET OMIT = NOT SHAREDISK 02732784
|
|
END DISKADDRESS; 02732795
|
|
SUBROUTINE WRIT; % THIS WRITES A RECORD 02732800
|
|
BEGIN IF TECHC THEN 02732900
|
|
BEGIN 02733000
|
|
; STREAM (A ~ TIP, B ~ [X1] ); 02733100
|
|
BEGIN 02733200
|
|
SI ~ A; DI ~ DI +4; DS ~ 4 CHR; 02733300
|
|
DI ~ DI +4; DS ~ 4 CHR; 02733400
|
|
END; 02733500
|
|
TECHCOFLO ~1&TIP[18:33:15]&NUMWDS[3:33:15]; 02733600
|
|
NUMWDS ~ -WORDSLEFT +(WORDSLEFT ~ BUFFSIZE); 02733700
|
|
DLOC[0]~ FLAG(FIB[16] & NUMWDS[8:38:10]);%TR840 02733750
|
|
END 02733800
|
|
ELSE BEGIN 02733900
|
|
COUNT ~ NUMREC; 02734000
|
|
NUMWDS~ (WORDSLEFT ~ BUFFSIZE) - T ; 02734100
|
|
IF PUNCH THEN FIB[16].[32:1] ~ CHNNL; %TR 830 I02734150
|
|
IF DISK THEN 02734200
|
|
BEGIN 02734300
|
|
LASTIO ~ 0; 02734350
|
|
%THIS COMPUTES THE AMT OF DISK USED IN ROWS02734400
|
|
IF (RCOUNT+1) DIV RECPERBLK|SEGPERBLK DIV 02734500
|
|
ROWLGTH GEQ NUMBSPC THEN 02734600
|
|
IF (RCOUNT + OPENIO) DIV 02734700
|
|
RECPERBLK | SEGPERBLK DIV ROWLGTH 02734800
|
|
GEQ NUMBSPC THEN 02734810
|
|
BEGIN 02734820
|
|
IF OPENIO THEN RCOUNT ~ *P(DUP) + (SERIAL);02734830
|
|
COUNT ~ 0; 02734835
|
|
P(1,RTN) 02734840
|
|
END ELSE 02734900
|
|
IF SERIAL THEN COUNT~0 ELSE BADKEY~TRUE; 02735000
|
|
DLOC[0] ~ FLAG(BUFTOP & RESETREADBIT); 02735100
|
|
P(CODE); 02735200
|
|
CODE ~ 1; 02735300
|
|
DISKADDRESS; 02735400
|
|
CODE ~ P; 02735450
|
|
$ SET OMIT = NOT SHAREDISK 02735599
|
|
END 02736100
|
|
ELSE IF LINEPRINT THEN 02736200
|
|
BEGIN 02736300
|
|
IF NOT SKIPAFT THEN 02736400
|
|
BEGIN 02736500
|
|
SKIPPER; 02736600
|
|
LINES ~ CHNNL~ 0; 02736700
|
|
GO TO SETUP; 02736800
|
|
END; 02736900
|
|
IF (CHNNL !0) OR (LINES { 2) THEN 02737000
|
|
SETUP: DLOC[0]~ FLAG(FIB[16]&LINES [27:47:1] 02737100
|
|
&LINES [28:46:1] 02737200
|
|
&CHNNL [29:44:4]) 02737300
|
|
ELSE BEGIN 02737400
|
|
DLOC[0] ~ FLAG(FIB[16]&@20 [27:42:6]);02737500
|
|
PREL; 02737600
|
|
IF NOT PRESENT THEN REFLECTCHECKER; 02737650
|
|
LINES ~ LINES - 2; 02737700
|
|
SKIPPER; 02737800
|
|
GO TO LPRETURN; 02737900
|
|
END; 02738000
|
|
END LINEPRINTER 02738100
|
|
ELSE DLOC[0] ~ FLAG(FIB[16]&NUMWDS[8:38:10]); 02738200
|
|
END; 02738300
|
|
IF TAPEE THEN IF NOT BINARY THEN ARROW; 02738400
|
|
IF DISK AND BS < 100 THEN TERM(69); 02738500
|
|
PREL; 02738600
|
|
LPRETURN: FIB[16].[33:15] ~ TIP; 02738700
|
|
DLOC[0] ~ (DISK) INX TIP & MAXR; 02738800
|
|
IF TECHCOFLO THEN 02738900
|
|
BEGIN 02739000
|
|
;STREAM (I ~ [X1],A~NUMWDS~TECHCOFLO.[3:15], 02739100
|
|
B ~ TECHCOFLO.[18:15], K ~NUMWDS.[36:6],02739200
|
|
X ~ TIP OR MEM ); 02739300
|
|
BEGIN 02739400
|
|
SI ~ B; 02739500
|
|
K(DS ~ 32 WDS;DS~ 32 WDS); 02739600
|
|
DS ~ A WDS; 02739700
|
|
SI ~ I; DI ~ X; SI ~SI+4; 02739800
|
|
DS~4 CHR; SI~SI+4; DS ~ 4 CHR; 02739900
|
|
END; 02740000
|
|
TECHCOFLO ~ 0; 02740100
|
|
DLOC[0] ~ NUMWDS INX TIP; 02740200
|
|
WORDSLEFT ~ WORDSLEFT - NUMWDS; 02740300
|
|
END; 02740400
|
|
IF NOT PRESENT THEN %CJC 021 02740500
|
|
BEGIN 02740510
|
|
$ SET OMIT = NOT SHAREDISK 02740519
|
|
REFLECTCHECKER; 02740530
|
|
END ELSE 02740540
|
|
RESETPARITY; 02740550
|
|
END WRIT; 02740600
|
|
SUBROUTINE WRITEADJUST; % THIS ADJUSTS BLOCK+REC PTRS 02740700
|
|
BEGIN 02740800
|
|
T := 0; 02740900
|
|
P(NUMWDS); %SAVE OFF NUMWDS 02741000
|
|
BCOUNT := *P(DUP) - 1; %BACK UP BECAUSE WE 02741100
|
|
RCOUNT := *P(DUP) - 1; %WERE READING 02741200
|
|
WRIT; 02741300
|
|
BCOUNT := *P(DUP) + 1; %UP GRADE SO IT CAN STILL 02741400
|
|
RCOUNT := *P(DUP) + 1; %THINK THAT WERE READING 02741500
|
|
NUMWDS:= P; 02741600
|
|
WORDSLEFT := *P(DUP)-NUMWDS;%DONT LOSE LAST REC 02741700
|
|
END OF WRITEADJUST; 02741800
|
|
SUBROUTINE REED; % THIS READS A RECORD 02741900
|
|
BEGIN IF DISK THEN 02742000
|
|
BEGIN LASTIO ~ 1; 02742100
|
|
IF RCOUNT > TOTREC OR BADKEY THEN 02742200
|
|
BEGIN 02742300
|
|
DLOC[0]~ TIP &1[27:47:1]; 02742400
|
|
WRITEAFTEREOF ~ 3; 02742420
|
|
IF OPENIO AND SERIAL THEN 02742450
|
|
RCOUNT ~ *P(DUP) +1; 02742460
|
|
ERROR; 02742500
|
|
END; 02742600
|
|
DLOC[0]~ FLAG(FIB[16]); 02742700
|
|
RT ~(BCOUNT+(T~(NUMBUF-1)))|SEGPERBLK; 02742800
|
|
%RT = SEGMENTS READ ,T=BUFFERS 02742900
|
|
IF (T~(T|RECPERBLK)+RCOUNT) GTR TOTREC OR 02743000
|
|
(T >LSUBU AND BOUNDED) THEN 02743100
|
|
BEGIN 02743200
|
|
IF WRITBACK THEN 02743300
|
|
BEGIN 02743400
|
|
WRITEADJUST; 02743500
|
|
GO TO IOUT; 02743600
|
|
END; 02743700
|
|
DLOC[0]~TIP&1[27:47:1]&0[2:47:1]; 02743800
|
|
ROTATEBUF; %THIS FLAGS ERROR DESC 02743900
|
|
RT ~ -1; % THIS INHIBITS PRL 02744000
|
|
END 02744100
|
|
ELSE BEGIN ; 02744200
|
|
P(CODE); CODE ~ 0; 02744300
|
|
DISKADDRESS; 02744400
|
|
CODE ~ P; 02744500
|
|
$ SET OMIT = NOT SHAREDISK 02744599
|
|
END END 02744800
|
|
ELSE BEGIN 02744900
|
|
IF NUMWDS<1 AND RCOUNT >0 THEN TERM(26); 02745000
|
|
DLOC [0] ~ FLAG (FIB[16]); 02745100
|
|
END; 02745200
|
|
IF CODE=2 THEN NUMBUF ~2; 02745300
|
|
PREL; 02745400
|
|
IODONE: WORDSLEFT ~ IF DISK THEN % DISK HAS NO SHORT BLOCKS 02745500
|
|
IF (BS~TOTREC-RCOUNT+2)}RECPERBLK THEN 02745600
|
|
BUFFSIZE ELSE (BS|MAXREC) ELSE 02745700
|
|
MEM [(NOT 0 ) INX TIP]; 02745800
|
|
IF NOT PRESENT THEN 02745900
|
|
BEGIN 02745905
|
|
$ SET OMIT = NOT SHAREDISK 02745909
|
|
ERROR; 02745975
|
|
END ELSE 02745980
|
|
BEGIN RESETPARITY; 02745985
|
|
$ SET OMIT = NOT SHAREDISK 02745989
|
|
END; 02745995
|
|
IF RANDOM THEN GO TO RANDOMLBL; 02746000
|
|
FIB[16].[33:15] ~ TIP; 02746100
|
|
DLOC[0]~ (DISK) INX TIP & MAXR; 02746200
|
|
$ SET OMIT = NOT SHAREDISK 02746249
|
|
IOUT: END REED ; 02746300
|
|
SUBROUTINE SEEK; % THIS CHECKS FOR PRESENTS OF BLOCKS IF NOT IT READS 02746400
|
|
BEGIN 02746500
|
|
IF ((KEY ~ KEY-1)<LSUBL ) OR (KEY >LSUBU AND BOUNDED)02746600
|
|
THEN BADKEY ~ TRUE 02746700
|
|
ELSE BEGIN 02746800
|
|
BCOUNT ~ (RCOUNT~KEY) DIV NUMREC; 02746900
|
|
IF BCOUNT ! COUNT THEN 02747100
|
|
BEGIN 02747200
|
|
REREAD: 02747250
|
|
IF NUMBUF=2 THEN 02747300
|
|
BEGIN 02747400
|
|
ROTATEBUF; 02747500
|
|
IF NOT DONE THEN 02747600
|
|
$ SET OMIT = NOT SHAREDISK 02747609
|
|
WAITIO; 02747650
|
|
NUMBUF ~1; 02747700
|
|
DLOC[0] ~ DLOC[1]; %CJC 018 02747800
|
|
END; 02747900
|
|
IF CODE=2 THEN DLOC[1]~ TIP; 02748000
|
|
IF RCOUNT { TOTREC THEN REED 02748100
|
|
ELSE IF BCOUNT =(TOTREC DIV NUMREC) THEN 02748200
|
|
BEGIN %ABOVE CHECKS FOR LAST BLOCK02748300
|
|
RCOUNT ~ TOTREC; 02748400
|
|
REED; 02748500
|
|
END; 02748600
|
|
SEEKRTN: RCOUNT ~ KEY; 02748700
|
|
IF RTOG THEN 02748750
|
|
COUNT ~ BCOUNT ~ *P(DUP) - 1; 02748800
|
|
$ SET OMIT = SHAREDISK 02748899
|
|
END; 02748900
|
|
$ POP OMIT 02748901
|
|
$ SET OMIT = NOT SHAREDISK 02748909
|
|
BADKEY ~ FALSE; 02749000
|
|
END; 02749100
|
|
SEEKEY ~ (CODE=2); 02749200
|
|
IF CODE = 2 THEN P(XIT); 02749300
|
|
END SEEK; 02749400
|
|
%%%%%%%%%%%%%START HERE%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 02749500
|
|
START : 02749600
|
|
FIB ~ * (FLOC ~ (NOT 2) INX DLOC); %SET UP IDS 02749700
|
|
IF FPB[FNAM+3].[42:6]=43 THEN % DUMMY 02749710
|
|
IF CODE=0 THEN GO EOFSETCK ELSE 02749720
|
|
IF P(MKSCW,TOP,XCH,DEL) THEN P(XIT) 02749730
|
|
ELSE P(0,RTN); 02749740
|
|
IOMASK := @2000000000; 02749800
|
|
IF (UNITYPE~UT)=4 THEN % DISK 02749900
|
|
BEGIN 02750000
|
|
H ~ * [FIB[14]]; % LOAD HEADER 02750100
|
|
IF RCOUNT > LSUBU AND BOUNDED THEN 02750200
|
|
IF CODE THEN 02750300
|
|
IF (RCOUNT-(OPENIO AND (SERIAL))) > LSUBU THEN 02750305
|
|
P(1,RTN) ELSE ELSE BADKEY ~ TRUE; 02750310
|
|
$ SET OMIT = NOT SHAREDISK 02750314
|
|
IF CODE.[1:1] THEN 02750325
|
|
BEGIN CODE~ABS(CODE); 02750330
|
|
$ SET OMIT = NOT SHAREDISK 02750334
|
|
END; 02750400
|
|
END; 02750450
|
|
IF NOT(ENDPROCESS=0 OR CODE) THEN GO TO EOFSETCK; 02750500
|
|
IF CODE>1 THEN % OTHER THAN READ OR WRIT 02750600
|
|
BEGIN 02750700
|
|
IF CODE=2 THEN % SEEK 02750800
|
|
BEGIN 02750900
|
|
IF HOWOPEN>1 THEN GO TO IMPROPER; 02751000
|
|
IF DISK THEN SEEK; 02751100
|
|
$ SET OMIT = TIMESHARING 02751200
|
|
TERM(28); %IMPROPER SEEK 02751400
|
|
END; 02751500
|
|
IF CODE=6 THEN % WRITE BLOCK 02751600
|
|
IF DISK THEN %CUBE XIX I 02751610
|
|
$ SET OMIT = NOT SHAREDISK 02751614
|
|
IF OPENIO AND %CUBE XIX I 02751620
|
|
FIB[4].[27:3] = 1 THEN %CUBE XIX I 02751630
|
|
GO TO RANDOMIO %CUBE XIX I 02751640
|
|
ELSE TERM(35) %CUBE XIX I 02751650
|
|
ELSE % THEN IT IS TAPE %CUBE XIX I 02751660
|
|
IF FIB[5].[41:4] ! 0 THEN %CUBE XIX I 02751670
|
|
% TERM(34) WHEN WRITE BLOCK ON INPUT OR ON %CUBE XIX I 02751680
|
|
% REVERSED OR ON UNOPENED FILE. %CUBE XIX I 02751690
|
|
TERM(34) ELSE %CUBE XIX I 02751700
|
|
BEGIN T := WORDSLEFT; %WRITE BLOCK 02751800
|
|
IF T=BUFFSIZE THEN %TR 857 02751830
|
|
P(XIT);%NULL BLOCK%TR 857 02751850
|
|
WRIT; 02751900
|
|
RCOUNT ~ *P(DUP) - 1; 02752000
|
|
P(XIT); 02752100
|
|
END WRITE BLOCK; 02752200
|
|
TERM(25); % UN RECOGNISED CODE 02752300
|
|
END; 02752400
|
|
IF (1-CODE) !HOWOPEN THEN % CHECK USE VS HOW OPEN 02752500
|
|
IMPROPER: IF HOWOPEN>1 THEN TERM (31+CODE) ELSE %CLOSED 02752600
|
|
IF NOT OPENIO THEN TERM(PROPER); %USAGE 02752700
|
|
IF UNITYPE =10 OR UNITYPE =13 THEN GO TO DATACOM; 02752800
|
|
IF SERIAL THEN 02752900
|
|
BEGIN 02753000
|
|
T ~ WORDSLEFT -(NUMWDS~NUMWDS); %COUNT WORDLEFT02753100
|
|
IF OPENIO THEN GO TO SERIALIO; 02753200
|
|
IF CODE THEN % CODE=1 ON WRITE 02753300
|
|
BEGIN 02753400
|
|
IF NUMWDS<1 THEN TERM(36); 02753450
|
|
HASH; 02753500
|
|
IF TECHC THEN 02753600
|
|
BEGIN 02753700
|
|
IF NUMWDS > MAXREC THEN 02753800
|
|
T ~ WORDSLEFT-(NUMWDS~MAXREC);02753900
|
|
IF T> MAXREC THEN DIDDLEREC ELSE WRIT;02754000
|
|
END 02754100
|
|
ELSE IF(COUNT ~ *P(DUP) - 1)>0 THEN 02754200
|
|
DIDDLEREC ELSE WRIT; 02754300
|
|
IF NOT DISK THEN 02754400
|
|
P(XIT); 02754500
|
|
IF (T~RCOUNT-1) > TOTREC THEN TOTREC ~ T; 02754600
|
|
P(0,RTN); 02754700
|
|
END; 02754800
|
|
%CODE=0 ON READ 02754900
|
|
IF REVERSE THEN READREV ELSE 02755000
|
|
IF TECH = 0 THEN REED ELSE %TR 899 02755050
|
|
IF T < 1 OR BADKEY THEN REED ELSE 02755100
|
|
IF NUMWDS<1 THEN GO TO EOFSETCK ELSE 02755200
|
|
DIDDLEREC; 02755300
|
|
HASH; 02755400
|
|
P (0,RTN) 02755500
|
|
END; 02755600
|
|
%RANDOM AND RANDOM I-O HERE ON 02755700
|
|
RANDOMIO: FIB[13].[44:1] ~ 0; %CUBE XIX I 02755710
|
|
IF SEEKEY THEN KEY ~RCOUNT ELSE SEEK; 02755800
|
|
IF BADKEY OR (KEY > TOTREC AND CODE=0) THEN 02755900
|
|
BEGIN 02756000
|
|
SANDBKEY ~ 0; %RESET SEEKEY&BADKEY 02756100
|
|
IF WRITBACK THEN %RESTORE THE ADDRESS 02756110
|
|
RCOUNT ~ ((BCOUNT ~ COUNT) | NUMREC); 02756120
|
|
$ SET OMIT = NOT SHAREDISK 02756129
|
|
P(1,RTN); 02756200
|
|
END; 02756300
|
|
IF SEEKEY THEN 02756400
|
|
BEGIN IF NUMBUF = 2 THEN 02756500
|
|
BEGIN ROTATEBUF; 02756600
|
|
IF NOT DONE THEN 02756700
|
|
$ SET OMIT = NOT SHAREDISK 02756709
|
|
WAITIO; 02756795
|
|
NUMBUF ~1; 02756800
|
|
END; 02756900
|
|
SEEKEY~FALSE; 02756910
|
|
$ SET OMIT = NOT SHAREDISK 02756919
|
|
RTOG~RANDOM~TRUE; 02757000
|
|
GO TO IODONE; 02757200
|
|
END; 02757300
|
|
RANDOMLBL: IF INVALIDUSER THEN 02757400
|
|
BEGIN 02757410
|
|
MAYBEPARITY; 02757430
|
|
END; 02757440
|
|
T ~RANDOM ~ FALSE; 02757500
|
|
IF CODE = 6 THEN IF WRITBACK THEN %CUBE XIX I 02757510
|
|
BEGIN P(BCOUNT); %CUBE XIX I 02757520
|
|
WRIT; %CUBE XIX I 02757530
|
|
P([BCOUNT],~); %CUBE XIX I 02757540
|
|
RCOUNT ~ KEY; %CUBE XIX I 02757550
|
|
P(XIT); %CUBE XIX I 02757560
|
|
END ELSE P(XIT); %CUBE XIX I 02757570
|
|
IF WRITBACK AND CODE THEN 02757600
|
|
IF COUNT ! BCOUNT THEN 02757700
|
|
BEGIN 02757800
|
|
P(NUMWDS,BCOUNT); %LEAVE BLOCK COUNT ON SIK02757900
|
|
RCOUNT~ (BCOUNT~COUNT) | NUMREC; 02758000
|
|
WRIT; 02758100
|
|
P([BCOUNT],~);%PICK UP BLOCK COUNT 02758200
|
|
NUMWDS ~ P; 02758300
|
|
RCOUNT ~ KEY; 02758400
|
|
END; 02758500
|
|
MOVREC; 02758600
|
|
IF CODE THEN % IF RANDOM WRITE THEN WRITE 02758700
|
|
BEGIN 02758800
|
|
IF LASTIO THEN FIB[13].[44:1] ~ 1; 02758850
|
|
IF NOT (COUNT = BCOUNT AND WRITBACK) THEN 02758900
|
|
BEGIN 02758960
|
|
DISKADDRESS;%COMPUTE NEW ADDRESS 02759000
|
|
COUNT ~ BCOUNT; 02759010
|
|
END; 02759050
|
|
IF KEY > TOTREC THEN TOTREC ~ KEY; 02759100
|
|
$ SET OMIT = NOT SHAREDISK 02759104
|
|
WRITBACK ~ TRUE; 02759165
|
|
END; 02759200
|
|
P(0,RTN); 02759300
|
|
%END OF MAIN LOGIC NEXT IS SPECIAL ROUTINES 02759400
|
|
SERIALIO: %THIS HANDLES SERIAL I-O 02759500
|
|
IF BADKEY THEN REED; %CJC 022 02759550
|
|
IF NOT (LASTDONE AND CODE) THEN 02759600
|
|
IF (COUNT ~ *P(DUP) -1) > 0 THEN 02759620
|
|
BEGIN WORDSLEFT ~ T; 02759640
|
|
GO TO DIDDLE; 02759660
|
|
END ELSE 02759680
|
|
BEGIN IF BOUNDED THEN 02759700
|
|
IF RCOUNT = LSUBL THEN 02759720
|
|
BEGIN COUNT ~ NUMREC - (BS ~ RCOUNT MOD NUMREC); 02759740
|
|
BCOUNT ~ *P(DUP) - (BS ! 0); 02759760
|
|
END ELSE 02759780
|
|
COUNT ~ NUMREC ELSE 02759800
|
|
COUNT ~ NUMREC; 02759900
|
|
IF CODE THEN % TWO WRITES IN A ROW 02759920
|
|
BEGIN P(TIP INX 0); % LEAVES POINTER FOR MOVEREC 02759940
|
|
IF RCOUNT GEQ TOTREC THEN 02759960
|
|
BEGIN IF TECH = 0 AND WRITEAFTEREOF = 2 THEN 02759980
|
|
BEGIN WRITEAFTEREOF ~ 1; 02760000
|
|
RCOUNT ~ *P(DUP) +2; 02760020
|
|
BCOUNT ~ *P(DUP) +2; 02760040
|
|
END; 02760100
|
|
IF RCOUNT = 0 THEN 02760200
|
|
BEGIN P(DEL); 02760300
|
|
RCOUNT ~ *P(DUP) +1; 02760400
|
|
BCOUNT ~ *P(DUP) +1; 02760500
|
|
WORDSLEFT ~ BUFFSIZE - NUMWDS; 02760600
|
|
GO TO DIDDLEWRT; 02760700
|
|
END ELSE 02760800
|
|
WRITEADJUST; 02760900
|
|
END ELSE REED; 02761000
|
|
CODE ~ 4; MOVREC; CODE ~ 1; 02761100
|
|
END ELSE REED; 02761200
|
|
DIDDLEWRT: IF CODE THEN WRITBACK ~ TRUE; 02761300
|
|
IF WRITEAFTEREOF = 3 THEN WRITEAFTEREOF ~ 2; 02761400
|
|
RCOUNT ~ *P(DUP) -1; 02761500
|
|
DIDDLE: MOVREC; 02761600
|
|
RCOUNT ~ *P(DUP) +1; 02761700
|
|
END ELSE GO TO DIDDLEWRT; 02761800
|
|
LASTDONE ~ NOT CODE; 02761900
|
|
IF (T ~ RCOUNT -1) > TOTREC THEN 02762000
|
|
IF CODE THEN TOTREC ~ T % UPDATE EOF POINTER 02762100
|
|
ELSE GO TO EOFSETCK; % PASSED EOF ON READ 02762200
|
|
P(0,RTN); 02762300
|
|
%END SERIAL I-O 02762400
|
|
DATACOM: % ALL DATA COMM GOES THRU HERE 02762500
|
|
$ SET OMIT = NOT(TIMESHARING) 02762600
|
|
IF NOT CODE THEN REMOTEREAD; REMOTEWRIT; 02762700
|
|
$ POP OMIT 02762750
|
|
$ SET OMIT = TIMESHARING 02762800
|
|
EOFSETCK: IF ENDFILE THEN TERM (15); 02765800
|
|
ENDFILE ~ TRUE ; 02765900
|
|
P(1,RTN); 02766000
|
|
% END OF EOF SET CHECK 02766100
|
|
END OF COBOL I O INTRINSICS; 02766200
|
|
PROCEDURE FBINBACKBLOCK(FILX,DKADDR,FI,FMT,LISX,EDITCODE,EOFL,PARL) ; 02767050
|
|
VALUE DKADDR,FI,LISX,EDITCODE,EOFL,PARL ; % INT # @160. 02767100
|
|
REAL DKADDR,FI,LISX,EDITCODE,EOFL,PARL; ARRAY FMT[*]; NAME FILX ; 02767150
|
|
BEGIN 02767200
|
|
02767250
|
|
INTEGER BSIZE, LSTRN=19 ; 02767300
|
|
02767350
|
|
REAL LISTYPE=20, ARRAYSTUFF=18, ALGOLWRITE=12, ALGOLREAD=13, T6, T7,02767400
|
|
SELECT=14, FORTERR=24, ARY, TYPE, DBLPREC=20, INDX=EOFL, B6700,02767450
|
|
OUT, FLG, IOINT, T1, T2, T3, T4, T5, TWDT, WH1=18, WH2=17, 02767500
|
|
SIZE=PARL, INTINT=5, PRNTR, CKPBI, FMTWRD=CKPBI, FLB=FILX ; 02767550
|
|
02767600
|
|
NAME LISTADDR, ADDR ; 02767650
|
|
02767700
|
|
ARRAY AR1=LISTADDR[*], FIB[*], IOBUFF[*], TPAR=23[*], FPB=3[*] ; 02767750
|
|
02767800
|
|
LABEL ALIST, BLKDTA, SEVENS, ENDALL, AWAY, SPCL1, SPCL2, DSZ, 02767850
|
|
CMPXL, DUBEL, LOGCL, STRNL, INTREL, BDERR, ENDIT, ERROR, 02767900
|
|
BO, BI, BO1, BI1, BDERR1, BDERR2, BI2, MAX, LOOP, STRNL1, 02767950
|
|
PRINTER, OUTL, BKSPC, BO2, BO3, BO4, BI0, BI3, BI4, BI5, ENDG,02767975
|
|
B6 ; 02767980
|
|
02768000
|
|
SWITCH TYPL~INTREL, STRNL, INTREL, LOGCL, DUBEL, CMPXL ; 02768050
|
|
02768100
|
|
DEFINE DONE = LSTRN=(-1) #, 02768150
|
|
NOTDONE = LSTRN!(-1) #, 02768200
|
|
KIND = FIB[4].[8:4] #, 02768250
|
|
TAPEF = 2 #, 02768300
|
|
REMOTEF = 13 #, 02768325
|
|
DATACOMF = 10 #, 02768330
|
|
INTEGR = 1 #, 02768350
|
|
STRING = 2 #, 02768400
|
|
REEL = 3 #, 02768450
|
|
LOGICAL = 4 #, 02768500
|
|
DBLPRECSN = 5 #, 02768550
|
|
COMPLEX = 6 #, 02768600
|
|
TYPEF = [44:4] #, 02768650
|
|
INDXF = [18:15] #, 02768700
|
|
SIZEF = [33:15] # ; 02768750
|
|
02768800
|
|
SUBROUTINE BLANKIT ; 02768805
|
|
BEGIN 02768810
|
|
STREAM(C~P(XCH),A~BSIZE-1,B~P(DUP).[36:6]:D~IOBUFF) ; 02768815
|
|
BEGIN 02768820
|
|
SI~LOC A; 8(SI~SI-1; DS~CHR); SI~D; DS~A WDS ; 02768825
|
|
B(DS~32WDS; DS~32WDS) ; 02768830
|
|
END ; 02768835
|
|
P(DEL,DEL,DEL) ; 02768840
|
|
END OF BLANKIT ; 02768845
|
|
02768846
|
|
SUBROUTINE CKPB ; 02768850
|
|
BEGIN 02768900
|
|
P(MKS,FLG); IF OUT THEN P(DKADDR,0,(-1)) ELSE P(CKPBI) ; 02768950
|
|
IF (BSIZE~P(FILX,IOINT))<0 THEN GO ENDIT ; 02769000
|
|
END OF CKPB ; 02769050
|
|
02769100
|
|
SUBROUTINE IO ; 02769700
|
|
BEGIN P(0) ; 02769750
|
|
ENDALL: P(MKS,FLG,DKADDR); IF OUT THEN P(0,BSIZE); P(FILX,IOINT) ; 02769800
|
|
IF P THEN 02769850
|
|
ENDIT: BEGIN FILX[NOT 3]~FILX[NOT 4]~0; P(XIT) END ; 02769900
|
|
CKPB ; 02769950
|
|
END OF IO ; 02770000
|
|
02770050
|
|
REAL SUBROUTINE NXTITM ; 02770100
|
|
BEGIN 02770150
|
|
P(IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX AND 255,CDC) 02770200
|
|
ELSE [AR1[INDX]]) ; 02770250
|
|
INDX~INDX+1; NXTITM~P ; 02770300
|
|
END OF NXTITM ; 02770350
|
|
02770400
|
|
SUBROUTINE GETNEXTLISTITEM ; 02770450
|
|
BEGIN 02770500
|
|
IF ARY THEN 02770550
|
|
BEGIN 02770600
|
|
ALIST: P(NXTITM) ; 02770650
|
|
IF DBLPREC THEN IF OUT THEN WH2~*NXTITM ELSE INDX~INDX+1 ;02770700
|
|
ARY~SIZE>INDX ; 02770750
|
|
END 02770800
|
|
ELSE IF TYPE=COMPLEX THEN 02770850
|
|
BEGIN TYPE~-COMPLEX; P([LISTADDR[1]]) END 02770900
|
|
ELSE BEGIN 02770950
|
|
P(ARRAYSTUFF~LISTYPE~0); LISTADDR~[LISX] ; 02771000
|
|
DBLPREC~(TYPE~LISTYPE.TYPEF)=DBLPRECSN ; 02771050
|
|
IF ARY~ARRAYSTUFF!0 THEN 02771100
|
|
BEGIN 02771150
|
|
IF TYPE=COMPLEX THEN TYPE~-COMPLEX ; 02771200
|
|
SIZE~(INDX~ARRAYSTUFF.INDXF)+ARRAYSTUFF.SIZEF ; 02771250
|
|
P(LISTADDR~MEM[LISTADDR.[18:15]]) ; 02771300
|
|
TWDT~NOT P(LOD,TOP); P(DEL) ; 02771350
|
|
IF EDITCODE=2 THEN GO ENDG ELSE GO ALIST ; 02771400
|
|
END ; 02771500
|
|
P(DEL,[LISTADDR[0]]) ; 02771550
|
|
IF DBLPREC THEN IF OUT THEN WH2~LISTADDR[1] ; 02771600
|
|
END ; 02771650
|
|
IF OUT THEN WH1~*P ELSE ADDR~P ; 02771700
|
|
ENDG: END OF GETNEXTLISTITEM ; 02771750
|
|
02771800
|
|
SUBROUTINE GETANDCHECK ; 02772050
|
|
BEGIN 02772100
|
|
GETNEXTLISTITEM; T1~T1-1 ; 02772150
|
|
IF DONE THEN 02772200
|
|
BDERR1: BEGIN P(1) ; 02772250
|
|
BDERR: T1~P; P(MKS,T1,TYPE,T2,FLG,BSIZE,(-2),FORTERR) ; 02772425
|
|
END ; 02772950
|
|
FLG~FLG+1 ; 02772975
|
|
END OF GETANDCHECK ; 02773000
|
|
02773050
|
|
%*************************::CODE STARTS HERE ::************************%02773100
|
|
02773150
|
|
LSTRN~CKPBI~1 ; 02773200
|
|
IF EDITCODE=6 THEN 02773250
|
|
BEGIN % BLOCKDATA. 02773300
|
|
BLKDTA: GETNEXTLISTITEM; P((FMTWRD~FMT[FI~P+FI])=0) ; 02773400
|
|
T2~FMTWRD.[18:15]; BSIZE~(FMTWRD!0)+BSIZE ; 02773425
|
|
IF DONE THEN BEGIN IF NOT P THEN GO BDERR1; P(XIT) END ; 02773450
|
|
FLG~FLG+1 ; 02773475
|
|
IF P THEN BEGIN P(2); GO BDERR END; T1~FMTWRD.[33:15]-1 ; 02773500
|
|
T3~FMT[FI~FI+1]; T4~FMT[FI+1] ; 02773550
|
|
GO TYPL[T2-1] ; 02773600
|
|
CMPXL: IF ABS(TYPE)!COMPLEX THEN GO BDERR2; ADDR[0]~T3 ; 02773650
|
|
GETNEXTLISTITEM; ADDR[0]~T4; IF T1{0 THEN GO SPCL1 ; 02773700
|
|
GETANDCHECK ; 02773725
|
|
GO CMPXL ; 02773750
|
|
DUBEL: IF NOT DBLPREC THEN GO BDERR2; ADDR[0]~T3; ADDR[1]~T4 ; 02773800
|
|
IF T1 LEQ 0 THEN 02773850
|
|
SPCL1: BEGIN P(2); GO BLKDTA END ; 02773900
|
|
GETANDCHECK ; 02773950
|
|
GO DUBEL ; 02774000
|
|
LOGCL: IF TYPE!LOGICAL THEN 02774050
|
|
BDERR2: BEGIN P(3); GO BDERR END ; 02774100
|
|
ADDR[0]~T3; IF T1 LEQ 0 THEN GO SPCL2; GETANDCHECK ; 02774150
|
|
GO LOGCL ; 02774200
|
|
STRNL: T4~FI; T3~T1+1; FMTWRD~FMTWRD.[3:15] ; 02774220
|
|
STRNL1: IF ABS(TYPL)=COMPLEX OR DBLPREC THEN GO BDERR2 ; 02774225
|
|
ADDR[0]~FMT[FI] ; 02774230
|
|
IF T1>0 THEN FI~FI+1 02774250
|
|
ELSE BEGIN 02774275
|
|
IF (FMTWRD~FMTWRD-1){0 THEN GO SPCL2; FI~T4; T1~T3 ; 02774300
|
|
END ; 02774325
|
|
GETANDCHECK ; 02774350
|
|
GO STRNL1 ; 02774375
|
|
INTREL: IF ABS(TYPE)=COMPLEX THEN GO BDERR2; P(T3,[ADDR[0]]) ; 02774400
|
|
IF TYPE=INTEGR OR TYPE=LOGICAL THEN 02774410
|
|
BEGIN 02774420
|
|
IF T3>P(MAX) THEN BEGIN P(4); GO BDERR END ; 02774430
|
|
P(ISD) ; 02774440
|
|
END 02774450
|
|
ELSE P(~) ; 02774460
|
|
IF DBLPREC THEN ADDR[1]~0 ; 02774470
|
|
IF T1 LEQ 0 THEN 02774480
|
|
SPCL2: BEGIN P(1); GO BLKDTA END ; 02774500
|
|
GETANDCHECK ; 02774550
|
|
GO INTREL ; 02774600
|
|
END OF BLOCKDATA ; 02774650
|
|
FIB~FILX[NOT 2]; FILX[NOT 3]~PARL; FILX[NOT 4]~EOFL ; 02774700
|
|
P(FIB[5]) ; 02774750
|
|
IF FI<0 THEN GO OUTL; P(P.[43:2]!T1~(EDITCODE=5)+2,*P(.ALGOLREAD));02774800
|
|
FLG~DKADDR; GO DSZ ; 02774850
|
|
MAX::: @7777777777777 ; 02774900
|
|
OUTL: 02774950
|
|
OUT~1; P(P.[43:1],*P( ALGOLWRITE)) ; 02775000
|
|
IF FLG~DKADDR<0 THEN 02775050
|
|
DSZ: DKADDR~0 ; 02775100
|
|
IOINT~P; IF P THEN P(MKS,0,T1,FILX,1,SELECT) ; 02775250
|
|
IF EDITCODE=5 THEN 02775300
|
|
BEGIN % BACKSPACE. 02775350
|
|
IF FIB[5].[41:2]!0 THEN GO ENDIT; CKPBI~3; CKPB; IO ; 02775400
|
|
IF NOT (FIB[FLG~0]!1 AND KIND=TAPEF) THEN GO ENDIT ; 02775450
|
|
BKSPC: IF (*(*[FILX])).[3:15]!P(SEVENS) THEN BEGIN IO; GO BKSPC END ; 02775500
|
|
IF (*(*[FILX])).[18:15]!P(SEVENS) THEN GO AWAY; GO ENDIT ; 02775550
|
|
END ; 02775650
|
|
T2~(FIB[5] AND 96)!0; CKPB; T4~(T1~KIND)=TAPEF; CKPBI~3 ; 02775675
|
|
IF PRNTR~(T1=1 OR T1=7 OR T1=12) AND FPB[FIB[4].[13:11]+3].[43:5]<2002775700
|
|
THEN BEGIN 02775725
|
|
IF BSIZE>17 THEN BSIZE~17 ; 02775727
|
|
IF T2 THEN BEGIN IOBUFF~TPAR; P(" "); BLANKIT END ; 02775730
|
|
END 02775735
|
|
ELSE IF T2 AND T4 THEN FIB[8].[3:15]~0 ; 02775737
|
|
IF FIB[0]=0 THEN FIB[0]~2; T5~T1=REMOTEF OR T1=DATACOMF ; 02775740
|
|
IF FIB[0]!2 AND T4 THEN 02775750
|
|
BEGIN T1~4 ; 02775800
|
|
ERROR: P(MKS,FIB[6],FILX.[33:15],T1,FORTERR) ; 02775850
|
|
END ; 02775900
|
|
IF T4 AND NOT FIB[13].[24:1] THEN P(MKS,(-1),FORTERR) ; 02775925
|
|
T3~P(SEVENS) ; 02775950
|
|
IF EDITCODE=0 THEN 02776000
|
|
BEGIN %FNO FORMAT, NO LIST.J 02776050
|
|
IOBUFF~*FILX ; 02776100
|
|
IF OUT THEN 02776150
|
|
BEGIN 02776200
|
|
IF PRNTR THEN 02776205
|
|
BEGIN 02776210
|
|
PRINTER: IF NOT T2 THEN FIB[17]~*P(DUP)+BSIZE ; 02776220
|
|
P(MKS,1,0,T2,BSIZE,FILX,ALGOLWRITE); CKPB ; 02776225
|
|
FIB[17]~*P(DUP)-BSIZE ; 02776230
|
|
STREAM(TPAR,BSIZE,S~*FILX) ; 02776235
|
|
BEGIN 02776240
|
|
SI~TPAR; DS~BSIZE WDS; DI~TPAR; 18(DS~8LIT" ") ;02776245
|
|
END ; 02776250
|
|
GO ENDIT ; 02776255
|
|
END ; 02776280
|
|
IF T5 THEN P(" ") ELSE P("0"); BLANKIT ; 02776320
|
|
IF T4 THEN IOBUFF[0]~(NOT 0)&(BSIZE-1)[33:33:15] ; 02776550
|
|
END 02776600
|
|
ELSE IF T4 THEN GO BI0 ; 02776650
|
|
AWAY: P(1); GO ENDALL ; 02776700
|
|
END ; 02776750
|
|
IF T4 THEN IF (*FILX).[8:10]<3 THEN P(MKS,(-4),FORTERR) ; 02776775
|
|
GETNEXTLISTITEM; IF NOT OUT THEN GO BI0 ; 02776800
|
|
BO: T1~T4; IOBUFF~IF PRNTR THEN TPAR ELSE *FILX ; 02776850
|
|
IF T5 THEN BEGIN P(" "); BLANKIT END ; 02776875
|
|
BO1:IF ARY THEN 02776880
|
|
BO2: BEGIN WH1~1 ; 02776885
|
|
IF P((BSIZE-T1) AND NOT DBLPREC,DUP)>SIZE-INDX THEN 02776890
|
|
P(DEL,SIZE-INDX) ; 02776895
|
|
IF TWDT THEN 02776900
|
|
BEGIN 02776905
|
|
IF P(DUP)>(WH2~256-INDX.[40:8]) THEN 02776910
|
|
BEGIN P(DEL,WH2); WH1~0 END ; 02776915
|
|
P(*[AR1[INDX.[33:7]]],INDX.[40:8],CDC) ; 02776920
|
|
END 02776925
|
|
ELSE P([AR1[INDX]]) ; 02776930
|
|
WH2~P(XCH) ; 02776935
|
|
STREAM(S~P:WH2,N~P(DUP).[38:4],D~[IOBUFF[T1]]) ; 02776940
|
|
BEGIN SI~S; DS~WH2 WDS; N(DS~32WDS; DS~32WDS) END ; 02776945
|
|
P(DEL); T1~T1+WH2 ; 02776950
|
|
IF ARY~(INDX~INDX+WH2)<SIZE THEN IF WH1 THEN GO BO4 ELSE GO BO202776955
|
|
ELSE GO BO3 ; 02776957
|
|
END ; 02776960
|
|
IOBUFF[T1]~WH1; IF DBLPREC THEN IOBUFF[T1~T1+1]~WH2; T1~T1+1 ; 02776965
|
|
BO3:GETNEXTLISTITEM ; 02776970
|
|
IF NOT (DONE OR T1+DBLPREC}BSIZE) THEN GO BO1 ; 02777000
|
|
BO4:IF PRNTR THEN GO PRINTER; IF NOT T4 THEN GO AWAY ; 02777050
|
|
P((T1-1)&T3[3:33:15]) ; 02777100
|
|
IF DONE THEN BEGIN P(SEVENS,CFX,[IOBUFF[0]],~); GO AWAY END ; 02777150
|
|
P([IOBUFF[T3~0]],~) ; 02777200
|
|
IO; GO BO ; 02777250
|
|
SEVENS:::@77777 02777260
|
|
BI0:IF T4 THEN 02777265
|
|
BEGIN T7~BSIZE ; 02777267
|
|
IF T2 THEN FIB[8].[3:1]~B6700~(*(*[FILX])).[1:15]=P(B6) 02777270
|
|
ELSE IF B6700~FIB[8].[3:1] THEN T6~FIB[8].[4:14] ; 02777290
|
|
IF EDITCODE=0 THEN 02777292
|
|
BEGIN BSIZE~(IOBUFF[T6] AND T3)+1; GO BI5 END ; 02777293
|
|
END ; 02777295
|
|
BI: IOBUFF~*FILX ; 02777300
|
|
IF T4 THEN BEGIN BSIZE~(IOBUFF[T6] AND T3)+1; P(T6+1) END ELSE P(0);02777302
|
|
T1~P ; 02777303
|
|
BI1:IF ARY THEN 02777305
|
|
BI2: BEGIN WH1~1 ; 02777310
|
|
IF P((BSIZE+T6-T1) AND NOT DBLPREC,DUP)>SIZE-INDX THEN 02777315
|
|
P(DEL,SIZE-INDX) ; 02777320
|
|
IF TWDT THEN 02777325
|
|
BEGIN 02777330
|
|
IF P(DUP)>(WH2~256-INDX.[40:8]) THEN 02777335
|
|
BEGIN P(DEL,WH2); WH1~0 END ; 02777340
|
|
P(*[AR1[INDX.[33:7]]],INDX.[40:8],CDC) ; 02777345
|
|
END 02777350
|
|
ELSE P([AR1[INDX]]) ; 02777355
|
|
IF (WH2~P(XCH))+(TYPE~P(IOBUFF INX T1))>HUNT(TYPE) THEN P(FLB);02777360
|
|
STREAM(S~P:WH2,N~P(DUP).[38:4],TYPE) ; 02777365
|
|
BEGIN SI~TYPE; DI~S; DS~WH2 WDS; N(DS~32WDS; DS~32WDS)END;02777370
|
|
P(DEL); T1~T1+WH2 ; 02777375
|
|
IF ARY~(INDX~INDX+WH2)<SIZE THEN IF WH1 THEN GO BI4 ELSE GO BI202777380
|
|
ELSE GO BI3 ; 02777385
|
|
END ; 02777390
|
|
ADDR[0]~IOBUFF[T1]; IF DBLPREC THEN ADDR[1]~IOBUFF[T1~T1+1] ; 02777395
|
|
T1~T1+1 ; 02777400
|
|
BI3:GETNEXTLISTITEM ; 02777425
|
|
IF NOT (DONE OR T1+DBLPREC}BSIZE) THEN GO BI1 ; 02777450
|
|
BI4:IF NOT T4 THEN GO AWAY ; 02777500
|
|
IF DONE THEN 02777550
|
|
BEGIN 02777600
|
|
BI5: IF B6700 THEN 02777650
|
|
BEGIN 02777655
|
|
IF BSIZE+T6<T7 THEN T6~T6+BSIZE 02777660
|
|
ELSE BEGIN 02777665
|
|
WHILE NOT (*(T6 INX *FILX)).[32:1] 02777670
|
|
DO BEGIN IO; T6~0 END ; 02777672
|
|
IF (T6~((*(*[FILX])) AND T3)+1)}T7 THEN 02777675
|
|
BEGIN IO; T6~0 END ; 02777680
|
|
END ; 02777685
|
|
FIB[8].[4:14]~T6; GO ENDIT ; 02777690
|
|
END ; 02777695
|
|
WHILE (*(*[FILX])).[18:15]!T3 DO IO; GO AWAY ; 02777700
|
|
B6::: @10000 ; 02777725
|
|
END ; 02777750
|
|
IF B6700 THEN 02777755
|
|
BEGIN 02777760
|
|
IF IOBUFF[T6].[32:1] THEN BEGIN T1~5; GO ERROR END ; 02777765
|
|
IF BSIZE+T6}T7 THEN BEGIN IO; BSIZE~0 END ; 02777770
|
|
T6~BSIZE; GO BI ; 02777775
|
|
END ; 02777780
|
|
IF IOBUFF[0].[18:15]=T3 THEN BEGIN T1~5; GO ERROR END ; 02777800
|
|
IO; GO BI ; 02777850
|
|
END OF FBINBACKBLOCK ; 02777950
|
|
PROCEDURE FTINTFIX(FILX,DKADDR,FI,FMT,LISX,EDITCODE,EOFL,PARL); %INT@15602780000
|
|
VALUE DKADDR,FI,LISX,EDITCODE,EOFL,PARL; ARRAY FMT[*]; NAME FILX ; 02780050
|
|
REAL DKADDR,FI,LISX,EDITCODE,EOFL,PARL ; 02780100
|
|
BEGIN 02780150
|
|
02780200
|
|
INTEGER LSTRN=19, IT3 ; 02780250
|
|
02780300
|
|
REAL LISTYPE=20, HOLTOG=21, ARRAYSTUFF=18, ALGOLREAD=13, SELECT=14, 02780350
|
|
FORTERR=24, CHR, MAXCHR, FMTW, BUFF, TYPE, INDX, SIZE, TWDT, 02780400
|
|
INTINT=5, SGN, NEEDNEWLISTADDRESS, SCALE, R, W, D, T3=IT3, T2, 02780450
|
|
XTRA, DBLPREC, ARY, T1, EXP=PARL, DECPT=EOFL, E=18, WH1=17, 02780500
|
|
SAVD, 02780540
|
|
WH2=9, C=20, CODE, T4, COMMAS, DLRSGN, VL, DC10 ; 02780550
|
|
02780600
|
|
NAME LISTADDR, ADDR ; 02780650
|
|
02780700
|
|
ARRAY TEN=22[*], AR1=LISTADDR[*], TPAR=23[*], FIB[*] ; 02780750
|
|
02780800
|
|
LABEL ALIST, GETNEXTPHRASE, REPEAT, TT, XX, SS, PP, AA, OO, HH, 02780850
|
|
CC, GG, LL, FF, EE, II, DD, ERR3, TEST1, AWAY, JJ, 02780900
|
|
ERROR, BACK, GOTNUMBER, MAX, ENDALL, EDIT, BLANKS, ADJT, CHKC,02780950
|
|
FERROR, EX, ASK, ERR1, EX1, O1, O2, E1, E2, STNRD, OUTSUB, 02781000
|
|
CD, NLEL, FO94, FO95, VERROR, HV, CD1 ; 02781005
|
|
02781050
|
|
SWITCH PHRASE~SS,HH,PP,XX,TT,AA,OO,LL,JJ,II,GG,FF,EE,DD,CC ; 02781100
|
|
02781150
|
|
DEFINE DONE = LSTRN=(-1) #, 02781200
|
|
REEL = 3 #, 02781250
|
|
LOGICAL = 4 #, 02781300
|
|
INTEGR = 1 #, 02781350
|
|
DBLPRECSN = 5 #, 02781400
|
|
COMPLEX = 6 #, 02781450
|
|
MAXCODE = 15 #, 02781455
|
|
VERR(VERR1) = BEGIN P(VERR1); GO VERROR END #, 02781460
|
|
ERR(ERR1) = BEGIN P(ERR1); GO ERROR END #, 02781500
|
|
H(H1,H2,H3,H4) = IF SC}"}" THEN H1: DS~CHR 02781550
|
|
ELSE BEGIN 02781600
|
|
IF SC="#" THEN H2:DS~LIT"=" ELSE02781650
|
|
IF SC="&" THEN H3:DS~LIT"+" ELSE02781700
|
|
IF SC="%" THEN DS~LIT"(" ELSE 02781750
|
|
IF SC="[" THEN DS~LIT")" ELSE 02781800
|
|
IF SC="@" THEN H4:DS~LIT""" ELSE02781850
|
|
IF SC!":" THEN IF SC!"<" THEN 02781900
|
|
IF SC!">" THEN GO H1 ELSE GO H2 02781950
|
|
ELSE GO H3 ELSE GO H4 ; 02782000
|
|
SI~SI+1 ; 02782050
|
|
END #, 02782100
|
|
TWOD = LISTYPE.[38:1] #, 02782150
|
|
INDXF = [18:15] #, 02782200
|
|
TYPEF = [44:4] #, 02782250
|
|
SIZEF = [33:15] # ; 02782300
|
|
02782350
|
|
REAL SUBROUTINE NEXTCHR ; 02782400
|
|
BEGIN 02782450
|
|
STREAM(C~0,BUFF:T~T1~T1-1) ; 02782500
|
|
BEGIN DI~LOC BUFF; DI~DI-1; SI~BUFF; DS~CHR; BUFF~SI END ;02782550
|
|
BUFF~P; NEXTCHR~C~P ; 02782600
|
|
END OF NEXTCHR ; 02782650
|
|
02782700
|
|
SUBROUTINE RNDADJ ; 02782705
|
|
BEGIN 02782710
|
|
E~(T4~P(XCH)+T2)+E; T2~T2-T4; T3~T3-T4; VL~1 ; 02782715
|
|
P(XCH,TEN[T4],/,.T4,ISN,XCH) ; 02782720
|
|
END OF RNDADJ ; 02782725
|
|
02782730
|
|
SUBROUTINE CONVERT ; 02782750
|
|
BEGIN 02782800
|
|
STREAM(V~0,Q~0,R~0,C~0,DECPT,N~0,W~IF T1}8 THEN 8 ELSE T1:BUFF,02782850
|
|
T~0,J~CODE!9,Z~T1<9) ; 02782900
|
|
BEGIN 02782950
|
|
SI~BUFF; DI~LOC T ; 02783000
|
|
W(L3: IF SC}"0" THEN BEGIN TALLY~TALLY+1; DS~CHR END 02783050
|
|
ELSE IF SC="." THEN 02783100
|
|
BEGIN 02783150
|
|
CI~CI+DECPT; GO L1; GO L2; L1: Q~TALLY; TALLY~1;02783200
|
|
R~TALLY; DECPT~TALLY; TALLY~Q; SI~SI+1 ; 02783250
|
|
CI~CI+Z; GO L3 ; 02783275
|
|
END 02783300
|
|
ELSE IF SC=" " THEN 02783350
|
|
BEGIN 02783400
|
|
CI~CI+J; GO L2; TALLY~TALLY+1; DS~CHR ; 02783450
|
|
END 02783500
|
|
ELSE IF SC="O" THEN 02783550
|
|
BEGIN 02783600
|
|
CI~CI+J; GO L2; DI~DI+1; SI~SI+1 ; 02783650
|
|
TALLY~TALLY+1 ; 02783700
|
|
END 02783750
|
|
ELSE BEGIN 02783800
|
|
L2: DI~LOC DECPT; DI~DI-1; DS~CHR ; 02783850
|
|
JUMP OUT TO CV ; 02783900
|
|
END) ; 02783950
|
|
CV: W~SI; SI~LOC T; DI~LOC V; N~TALLY; DS~N OCT ; 02784000
|
|
END ; 02784050
|
|
BUFF~P; T3~P; DC10~(DECPT~P) AND CODE>10 ; 02784100
|
|
T1~T1-((C~P(XCH))!0)-P(XCH)-T3; T4~P; P(XCH) ; 02784125
|
|
IF COMMAS THEN IF C="," AND NOT DC10 THEN C~0 ; 02784150
|
|
END OF CONVERT ; 02784200
|
|
02784250
|
|
REAL SUBROUTINE DEBLANKDEZEROGETSGN ; 02784300
|
|
BEGIN 02784350
|
|
STREAM(C~0,BUFF,VL~1,SGN~0,T2~C,T1:T~T1.[36:6],HADSGN~SGN) ; 02784400
|
|
BEGIN SI~BUFF; DI~T2 ; 02784450
|
|
T1(IF SC!" " THEN 02784500
|
|
IF SC>"0" THEN GO ENDS 02784550
|
|
ELSE IF SC="-" THEN 02784600
|
|
BEGIN 02784650
|
|
BUFF~TALLY; TALLY~1; SGN~TALLY; TALLY~BUFF;02784700
|
|
L1: CI~CI+HADSGN; GO L2; HADSGN~DI; VL~DI ; 02784750
|
|
END 02784850
|
|
ELSE IF SC!"0" THEN 02784900
|
|
BEGIN 02784950
|
|
IF SC!"+" THEN IF SC!"&" THEN 02785000
|
|
BEGIN 02785050
|
|
L2: TALLY~TALLY+1; DI~LOC BUFF; DI~DI-1 ; 02785100
|
|
DS~CHR; ENDS: T2~TALLY ; 02785150
|
|
JUMP OUT TO ENDS1 ; 02785200
|
|
END ; 02785250
|
|
GO L1 ; 02785300
|
|
END ELSE VL~DI ; 02785350
|
|
SI~SI+1; TALLY~TALLY+1) ; 02785400
|
|
DI~T1; T2~TALLY ; 02785450
|
|
T(2(32(IF SC!" " THEN 02785500
|
|
IF SC>"0" THEN BEGIN T1~DI; JUMP OUT 3 TO ENDS1 END 02785550
|
|
ELSE IF SC="-" THEN 02785600
|
|
BEGIN TALLY~1; SGN~TALLY ; ; 02785650
|
|
L3: CI~CI+HADSGN; GO L4; TALLY~0; HADSGN~TALLY;02785700
|
|
VL~TALLY ; 02785725
|
|
END 02785750
|
|
ELSE IF SC!"0" THEN 02785800
|
|
BEGIN 02785850
|
|
IF SC!"+" THEN IF SC!"&" THEN 02785900
|
|
BEGIN 02785950
|
|
L4: DI~DI-8; T1~DI; DI~LOC BUFF; DI~DI-1 ;02786000
|
|
DS~CHR; JUMP OUT 3 TO ENDS1 ; 02786050
|
|
END ; 02786100
|
|
GO L3 ; 02786150
|
|
END ELSE BEGIN TALLY~0; VL~TALLY END ; 02786200
|
|
SI~SI+1; DI~DI-8))) ; 02786250
|
|
ENDS1: BUFF~SI ; 02786300
|
|
END ; 02786350
|
|
T1~P(SUB,SSP); SGN~P; VL~P; BUFF~P ; 02786400
|
|
DEBLANKDEZEROGETSGN~(C~P)>9 ; 02786425
|
|
END OF DEBLANKDEZEROGETSGN ; 02786450
|
|
02786500
|
|
SUBROUTINE CKPB ; 02786550
|
|
BEGIN 02786600
|
|
MAXCHR~P(MKS,DKADDR,1,FILX,ALGOLREAD)|8 ; 02786650
|
|
BUFF~(P(*FILX)).[33:15] ; 02786700
|
|
END OF CKPB ; 02786750
|
|
02786800
|
|
SUBROUTINE INPUT ; 02786850
|
|
BEGIN P(0) ; 02786900
|
|
ENDALL: P(MKS,DKADDR,CHR~0,FILX,ALGOLREAD) ; 02786950
|
|
IF P THEN BEGIN FILX[NOT 3]~FILX[NOT 4]~0; P(XIT) END ; 02787000
|
|
CKPB ; 02787300
|
|
END OF INPUT ; 02787350
|
|
02787400
|
|
SUBROUTINE GETNEXTLISTADDRESS ; 02787450
|
|
BEGIN 02787500
|
|
IF NEEDNEWLISTADDRESS THEN 02787550
|
|
BEGIN 02787600
|
|
IF ARY THEN 02787650
|
|
BEGIN 02787700
|
|
ALIST: IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX AND 255,CDC) 02787750
|
|
ELSE P([AR1[INDX]]) ; 02787800
|
|
ARY~(INDX~INDX+1+DBLPREC) LSS SIZE ; 02787850
|
|
END 02787900
|
|
ELSE IF TYPE=COMPLEX THEN 02787950
|
|
BEGIN TYPE~-COMPLEX; P([LISTADDR[1]]) END 02788000
|
|
ELSE BEGIN 02788050
|
|
P(ARRAYSTUFF~0); LISTADDR~[LISX] ; 02788100
|
|
DBLPREC~(TYPE~LISTYPE.TYPEF)=DBLPRECSN ; 02788150
|
|
IF ARY~ARRAYSTUFF!0 THEN 02788200
|
|
BEGIN 02788250
|
|
IF TYPE=COMPLEX THEN TYPE~-COMPLEX ; 02788300
|
|
SIZE~(INDX~ARRAYSTUFF.INDXF)+ 02788350
|
|
ARRAYSTUFF.SIZEF ; 02788400
|
|
P(LISTADDR~MEM[LISTADDR.[18:15]]) ; 02788450
|
|
TWDT~NOT P(LOD,TOP); P(DEL) ; 02788500
|
|
GO ALIST ; 02788550
|
|
END ; 02788650
|
|
P(DEL,[LISTADDR[0]]) ; 02788700
|
|
END ; 02788750
|
|
NEEDNEWLISTADDRESS~0; ADDR~P ; 02788800
|
|
END ; 02788850
|
|
IF DONE OR EDITCODE=1 THEN 02788900
|
|
AWAY: BEGIN P(1); GO ENDALL END ; 02788950
|
|
END OF GETNEXTLISTADDRESS ; 02788955
|
|
02788960
|
|
SUBROUTINE NLE ; 02788965
|
|
BEGIN P(XCH); GETNEXTLISTADDRESS; NEEDNEWLISTADDRESS~1 ; 02788970
|
|
IF WH2~DBLPREC THEN WH2~ADDR[1] ; 02788975
|
|
IF (WH1~ADDR[0])+4>P(FO94) THEN 02788980
|
|
BEGIN IF T1 THEN VERR(P+10); P(DEL,FO94) END 02788985
|
|
ELSE IF P(DEL,(-P(FO94)),DUP)<WH1 THEN P(DEL,WH1) ; 02788990
|
|
P(XCH) ; 02788995
|
|
END OF NLE ; 02789000
|
|
02789005
|
|
SUBROUTINE HANDLEVARIABLES ; 02789010
|
|
BEGIN T1~1 ; 02789015
|
|
IF R=P(FO95) THEN 02789020
|
|
BEGIN P(0); NLE; T1~P(.R,ISN)>0; DLRSGN.[18:15]~R ; 02789025
|
|
IF CODE=29 THEN 02789030
|
|
BEGIN P(FI+W) ; 02789035
|
|
IF R}0 THEN P([FMT[P]],DUP,LOD,P&R[6:36:12],XCH) 02789040
|
|
ELSE P(.FI) ; 02789045
|
|
P(STN) ; 02789050
|
|
OUTSUB: P(DEL,DEL); GO GETNEXTPHRASE ; 02789055
|
|
END ; 02789060
|
|
END ; 02789065
|
|
IF T4~CODE=30 THEN 02789070
|
|
BEGIN P(2); NLE; P(.T2,ISN) ; 02789075
|
|
STREAM(P1~P:P2~P(CD),P3~P(CD1)) ; 02789080
|
|
BEGIN SI~LOC P1; SI~SI+7; DI~LOC P2; DI~DI+1 ; 02789085
|
|
32(IF SC=DC THEN JUMP OUT; TALLY~TALLY+1; SI~SI-1) ; 02789090
|
|
P1~TALLY ; 02789095
|
|
END ; 02789100
|
|
IF (T2 AND 63)!T2 THEN P(DEL,32) ; 02789105
|
|
IF (CODE~P+3)>MAXCODE AND T1 THEN VERR(2) ; 02789110
|
|
T1~CODE>4 AND T1 ; 02789115
|
|
END ; 02789120
|
|
T2~T1 ; 02789125
|
|
IF P(CODE}11 AND CODE{14,FO95)=W THEN 02789130
|
|
BEGIN P(.W,4) ; 02789135
|
|
NLEL: NLE; P(XCH,ISD); T1~P(DUP) AND T2~T2 AND W>0 ; 02789140
|
|
END ; 02789145
|
|
IF D=P(FO95) THEN BEGIN P(.D,6); GO NLEL END ; 02789150
|
|
IF CODE{4 THEN 02789155
|
|
BEGIN IF T4 THEN W~R; 02789160
|
|
FMTW~FMTW&(P(DUP).[41:1]+(W<0))[41:47:1]; GO HV ; 02789165
|
|
END ; 02789170
|
|
IF NOT T2 THEN GO OUTSUB; IF CODE=5 THEN HV: R~1 ; 02789175
|
|
IF P(DUP) AND D<0 THEN VERR(16) ; 02789180
|
|
IF T4 THEN IF W=P(FO94) THEN 02789185
|
|
BEGIN IF CODE!9 THEN VERR(6); W~0 END 02789187
|
|
ELSE IF P(DUP) AND D=P(FO94) THEN 02789190
|
|
BEGIN P(7) ; 02789195
|
|
VERROR: T4~P; P(MKS,CODE,R,W,D,T4,WH1,WH2,FMTW, 02789200
|
|
(-5),FORTERR) ; 02789205
|
|
FO94::: 4094 ; 02789210
|
|
FO95::: 4095 ; 02789215
|
|
CD::: @0047676321464341 ; % 0PXTAOLJ 02789220
|
|
CD1::: @3127262524230000 ; % IGFEDC00 02789225
|
|
END ; 02789230
|
|
IF NOT P THEN SAVD:=D:=0 ELSE SAVD:=D; 02789235
|
|
END OF HANDLEVARIABLES ; 02789240
|
|
02789250
|
|
SUBROUTINE ADJUSTBUFF ; 02789300
|
|
BUFF~(P(*FILX) INX T2.[33:12])&T2[30:45:3] ; 02789350
|
|
02789400
|
|
SUBROUTINE SKIP ; 02789450
|
|
IF (T1~P(XCH)) GEQ W THEN T1~W 02789500
|
|
ELSE BEGIN T2~CHR-T1; ADJUSTBUFF END ; 02789550
|
|
02789600
|
|
%************************:: CODE STARTS HERE ::************************%02789650
|
|
02789700
|
|
FIB~FILX[NOT 2]; FILX[NOT 3]~PARL; FILX[NOT 4]~EOFL ; 02789750
|
|
IF FIB[5].[43:2]!2 THEN P(MKS,0,2,FILX,1,SELECT); CKPB ; 02789800
|
|
IF NOT(NOT(NEEDNEWLISTADDRESS~EDITCODE=3) OR FMT[FI])THEN GO FERROR;02789850
|
|
IF FIB[0]=0 THEN FIB[0]~1 ; 02789900
|
|
IF (LSTRN~1)!FIB[0] AND FIB[4].[8:4]=2 THEN 02789950
|
|
BEGIN T3~4 ; 02790000
|
|
FERROR: P(MKS,FIB[7],FILX.[33:15],T3,FORTERR) ; 02790050
|
|
END ; 02790100
|
|
P(0) ; 02790150
|
|
GETNEXTPHRASE: 02790200
|
|
R~P(FMT[FI~FI+1],DUP).[6:12]; IF (CODE~P(DUP).[1:5])=2 THEN GO HH ;02790250
|
|
W:=P(DUP).[18:12]; SAVD:=D:=(FMTW:=P(DUP)).[30:12]; 02790255
|
|
IF (XTRA~P(DUP) AND 63).[44:2]=0 THEN P(0,0) 02790260
|
|
ELSE P(P((T4~P(DUP) AND 15)=12,DUP) OR T4=8,P(XCH) OR T4=4) ; 02790265
|
|
DLRSGN~P; COMMAS~P ; 02790270
|
|
IF P.[42:1] THEN IF (FMTW AND 3)=0 THEN HANDLEVARIABLES ; 02790275
|
|
IF CODE=0 THEN 02790300
|
|
BEGIN 02790350
|
|
IF D!0 THEN BEGIN GETNEXTLISTADDRESS; INPUT END ; 02790400
|
|
IF P(DUP).[18:15]!FI THEN P(R&FI[18:33:15]) ; 02790450
|
|
IF P((NOT 0),XCH,INX,DUP).[33:15]=0 THEN P(DEL) ELSE FI~FI-W ; 02790500
|
|
GO GETNEXTPHRASE ; 02790550
|
|
END ; 02790600
|
|
IF CODE=5 THEN CHR~0 ; 02790650
|
|
REPEAT: 02790750
|
|
IF CODE>5 THEN BEGIN GETNEXTLISTADDRESS; NEEDNEWLISTADDRESS~1 END ; 02790800
|
|
IF CODE!3 AND CODE!9 THEN 02790850
|
|
IF (CHR~CHR+W)>MAXCHR THEN GO AWAY ; 02790900
|
|
T1~W; SGN~1; E~EXP~DECPT~T2~WH1~WH2~0 ; 02790950
|
|
GO PHRASE[CODE-1] ; 02791000
|
|
TT: CHR~W-1 ; 02791050
|
|
XX: T2~CHR; ADJUSTBUFF; GO TEST1 ; 02791100
|
|
SS: INPUT; GO TEST1 ; 02791150
|
|
LL: IF NOT (NEXTCHR!" " OR T1=0) THEN GO LL ; 02791200
|
|
IF NOT ((ADDR[0]~C!"F" AND C!" ") AND C!"T") THEN GO XX ; 02791250
|
|
P("G"); IF CODE!11 THEN P(12,+); ERR(1) ; 02791300
|
|
PP: SCALE~W&FMTW[1:41:1]; GO TEST1 ; 02791350
|
|
OO: P(16); SKIP; P(DEBLANKDEZEROGETSGN); IF T1=0 THEN SGN~SGN OR VL ;02791400
|
|
O1: IF (T2~C<8 OR C=" ") AND T1>0 THEN 02791450
|
|
BEGIN 02791500
|
|
P(NEXTCHR&P(XCH)[1:4:44]) ; 02791550
|
|
IF T2~T1=15 AND C>3 THEN BEGIN P(DEL); GO O2 END ELSE GO O1 ; 02791600
|
|
END ; 02791650
|
|
IF SGN THEN P(CHS); ADDR[0]~P; IF T2 THEN GO TEST1 ; 02791700
|
|
O2: P("O"); ERR(1+T2+T2) ; 02791750
|
|
GG: IF TYPE=LOGICAL THEN GO LL; IF TYPE=INTEGR THEN D:=0; 02791800
|
|
P("G"); GO EDIT ; 02791825
|
|
EE: P("E"); GO EDIT ; 02791850
|
|
FF: P("F"); GO EDIT ; 02791900
|
|
DD: P("D"); GO EDIT ; 02791950
|
|
II: P("I"); GO EDIT ; 02792000
|
|
JJ: P("J") ; 02792050
|
|
EDIT: 02792100
|
|
IF DEBLANKDEZEROGETSGN THEN 02792150
|
|
BEGIN 02792200
|
|
IF DLRSGN THEN 02792250
|
|
IF C="$" THEN IF NOT DEBLANKDEZEROGETSGN THEN GO E2 ; 02792300
|
|
IF CODE=9 THEN GO GOTNUMBER ; 02792350
|
|
IF DECPT~C="." THEN 02792355
|
|
BEGIN IF CODE=10 THEN ERR(2); P((-T1)) ; 02792360
|
|
STREAM(BUFF,C~0,T2~0,T1:T~T1.[36:6]) ; 02792365
|
|
BEGIN SI~BUFF ; 02792370
|
|
T1(IF SC!"0" THEN IF SC!" " THEN IF SC!"O" THEN 02792375
|
|
BEGIN 02792380
|
|
IF SC<"0" THEN 02792385
|
|
BEGIN 02792390
|
|
DI~LOC T2; DI~DI-1; DS~CHR; TALLY~TALLY+1 ;02792395
|
|
END ; 02792400
|
|
JUMP OUT TO L ; 02792405
|
|
END ; 02792410
|
|
TALLY~TALLY+1; SI~SI+1) ; 02792415
|
|
DI~T1 ; 02792420
|
|
T(2(32(IF SC!"0" THEN IF SC!" " THEN IF SC!"O" THEN 02792425
|
|
BEGIN T1~DI ; 02792430
|
|
IF SC<"0" THEN 02792435
|
|
BEGIN DI~DI-8 ; 02792440
|
|
T1~DI; DI~LOC T2; DI~DI-1; DS~CHR ; 02792445
|
|
END ; 02792450
|
|
JUMP OUT 3 TO L ; 02792455
|
|
END ; 02792460
|
|
DI~DI-8; SI~SI+1))) ; 02792465
|
|
T1~DI ; 02792470
|
|
L: BUFF~SI; T2~TALLY ; 02792475
|
|
END ; 02792480
|
|
T1~P(SUB,SSP); C~P; BUFF~P; E~P+T1 ; 02792485
|
|
IF C<10 THEN IF T1=0 THEN GO GOTNUMBER ELSE GO E2 ; 02792490
|
|
END ; 02792495
|
|
IF C="*" THEN GO ASK; WH1~1-DECPT; GO EX1 ; 02792500
|
|
END 02792505
|
|
ELSE IF T1=0 THEN BEGIN SGN~VL OR SGN; GO GOTNUMBER END ; 02792510
|
|
E2: IF CODE{10 THEN DECPT~1; VL~0 ; 02792550
|
|
BACK: 02792600
|
|
CONVERT ; 02792650
|
|
IF T3=0 THEN IF COMMAS THEN GO CHKC ELSE P(DEL) 02792700
|
|
ELSE BEGIN 02792750
|
|
IF VL THEN 02792900
|
|
BEGIN 02792905
|
|
IF DC10 THEN P(T4) 02792910
|
|
ELSE 02792915
|
|
ADJT: P(T3) ; 02792920
|
|
E~E+P; P(DEL) ; 02792925
|
|
END 02792930
|
|
ELSE BEGIN 02792950
|
|
IF DC10 THEN E~E+T4-T3 ; 02793000
|
|
IF (T2~T2+T3)>T3 THEN 02793050
|
|
BEGIN 02793075
|
|
IF T2<12 THEN GO STNRD ; 02793100
|
|
IF DBLPREC THEN 02793125
|
|
BEGIN 02793130
|
|
IF P(DUP)=0 THEN IF T2>23 OR T1=0 OR C!0 THEN 02793135
|
|
BEGIN VL~1; T2~T2-T3; GO ADJT END ; 02793140
|
|
IF T2>23 THEN 02793160
|
|
BEGIN 02793165
|
|
P((TEN[T2-T3-12]|P(MAX)<WH1)-24); RNDADJ ;02793170
|
|
END ; 02793175
|
|
WH2~P(0,XCH,WH2,WH1,0,TEN[T3],DLM,DLA,XCH) ; 02793180
|
|
END 02793185
|
|
ELSE BEGIN 02793190
|
|
P((TEN[T3-T2+12]|WH1>P(MAX))-12); RNDADJ ; 02793195
|
|
STNRD: P(TEN[T3]|WH1,+) ; 02793200
|
|
END ; 02793205
|
|
END ; 02793245
|
|
WH1~P ; 02793250
|
|
END ; 02793300
|
|
CHKC: IF NOT (C!0 OR T1{0) THEN GO BACK ; 02793350
|
|
END ; 02793400
|
|
IF C>9 AND CODE!9 THEN ELSE GO GOTNUMBER ; 02793450
|
|
EX1:IF NOT (C!"E" AND C!"D") THEN GO EX ; 02793500
|
|
IF C="+" OR C="-" THEN BEGIN P(T2,T1+1); SKIP; T2~P END 02793510
|
|
ELSE IF C!"@" OR HOLTOG THEN GO ERR1 ; 02793515
|
|
EX: IF CODE=10 THEN ERR(2); P(SGN); SGN~EXP~1 ; 02793550
|
|
IF DEBLANKDEZEROGETSGN THEN 02793600
|
|
BEGIN P(DEL) ; 02793650
|
|
ERR1: IF C="*" THEN GO GOTNUMBER; ERR(1+(CODE=10 AND C=".")) ; 02793700
|
|
END ; 02793750
|
|
P(DECPT); DECPT~1; CONVERT; IF SGN THEN P(SSN); E~(T4~P)+E ; 02793800
|
|
DECPT~P; SGN~P; IF C>9 THEN GO ERR1 ; 02793850
|
|
E1: IF T1>0 THEN IF NEXTCHR>9 AND C!" " THEN GO ERR1 ELSE GO E1 ; 02793900
|
|
GOTNUMBER: 02793950
|
|
IF CODE>10 THEN 02794000
|
|
BEGIN IF NOT DECPT THEN E~E-D; IF NOT EXP THEN E~E-SCALE END 02794050
|
|
ELSE IF CODE=9 THEN 02794100
|
|
IF (CHR~CHR+W-T1-(C>9)+(C=C~"*"))>MAXCHR THEN GO AWAY ; 02794150
|
|
IF ABS(E)>44 THEN 02794200
|
|
BEGIN IF E+T2>68 THEN GO ERR3; IF E<(-68) THEN E~-68 END ; 02794250
|
|
IF DBLPREC THEN 02794300
|
|
BEGIN 02794350
|
|
P(WH2,WH1) ; 02794400
|
|
IF E!0 THEN P(TEN[ABS(E)+69],TEN[ABS(E)],IF E>0 THEN P(DLM) 02794450
|
|
ELSE P(DLD)) ; 02794500
|
|
END 02794550
|
|
ELSE BEGIN 02794600
|
|
P(WH1); IF E!0 THEN P(TEN[ABS(E)],IF E>0 THEN P(|) ELSE P(/));02794650
|
|
END ; 02794700
|
|
IF SGN THEN P(SSN) ; 02794750
|
|
IF TYPE=INTEGR OR TYPE=LOGICAL THEN 02794800
|
|
BEGIN 02794850
|
|
IF P(DUP)>P(MAX) THEN BEGIN P(DEL); ERR3: ERR(3) END ; 02794900
|
|
P([ADDR[0]],ISD); GO ASK ; 02794950
|
|
END ; 02795000
|
|
P([ADDR[0]],~); IF DBLPREC THEN P([ADDR[1]],~) ; 02795350
|
|
ASK:P(DEL); IF C!"*" THEN GO TEST1; GO XX ; 02795400
|
|
MAX::: @0007777777777777 ; 02795410
|
|
HH: P(DEL); IF (CHR~CHR+R)>MAXCHR THEN GO AWAY ; 02795450
|
|
STREAM(BUFF:R,S~R.[36:6],HOLTOG,Q~[FMT[FI]]) ; 02795460
|
|
BEGIN 02795500
|
|
DI~DI+3; SI~BUFF; CI~CI+HOLTOG; GO L1; R(H(A,B,C,D)) ; 02795550
|
|
GO L2; L1: GO L3; L2: S(2(32(H(W,X,Y,Z)))); GO L4; L3: 02795600
|
|
DS~R CHR; S(DS~32 CHR; DS~32 CHR); L4: BUFF~SI ; 02795650
|
|
END ; 02795700
|
|
FI~FI+(R+2).[36:9]; BUFF~P; GO GETNEXTPHRASE ; 02795750
|
|
CC: 02795800
|
|
AA: P(6); SKIP; ADDR[0]~IF P(CODE=6,DUP) THEN P(BLANKS) ELSE 0 ; 02795850
|
|
STREAM(T~IF P THEN 2 ELSE 8-T1:BUFF,T1,HOLTOG,ADDR) ; 02795900
|
|
BEGIN 02795950
|
|
DI~DI+T; SI~BUFF; CI~CI+HOLTOG; GO L1; T1(H(A,B,C,D)) ; 02796000
|
|
GO L2; L1: DS~T1 CHR; L2: T~SI ; 02796050
|
|
END ; 02796100
|
|
BUFF~P ; 02796150
|
|
TEST1: 02796200
|
|
IF (R~R-1)>0 THEN GO REPEAT ; 02796250
|
|
IF (XTRA AND 3)=0 THEN GO GETNEXTPHRASE ; 02796300
|
|
P(XTRA); XTRA~W~0 ; 02796350
|
|
IF P(DUP) THEN BEGIN W~P.[42:5]; CODE~4; GO REPEAT END ; 02796400
|
|
CODE~1; R~P.[42:4]; GO SS ; 02796450
|
|
BLANKS:::" " ; 02796500
|
|
ERROR: 02796700
|
|
P(FILX[NOT 3]); FILX[NOT 3]~FILX[NOT 4]~0; P(MKS,9,INTINT) ; 02796750
|
|
T3~P(DEL); T2~P ; 02796800
|
|
P(MKS,T2,T3,W,SAVD,CODE,TYPE,CHR-T1,FIB[7],BUFF,FMT[FI],DLRSGN,(-3), 02796850
|
|
FORTERR) ; 02796900
|
|
END OF FTINTFIX ; 02797450
|
|
PROCEDURE FTINT ; % 050 02800000
|
|
BEGIN 02800100
|
|
COMMENT FILX FILE TOP IO DESCRIPTOR 02800200
|
|
FMTA FORMAT OR NAMELIST OR 0 02800300
|
|
LISX ACCIDENTAL ENTRY DESC. OR 0 02800400
|
|
EDITCODE 0 NO FORMAT, NO LIST 02800500
|
|
1 FORMAT, NO LIST 02800600
|
|
2 NO FORMAT, LIST 02800700
|
|
3 FORMAT, LIST 02800800
|
|
4 NAMELIST 02800900
|
|
5 BACKSPACE 02801000
|
|
6 BLOCKDATA; 02801100
|
|
REAL PARL = -1, 02801200
|
|
EOFL = -2, 02801300
|
|
FORTERR = 24, 02801301
|
|
EDITCODE = -3, 02801400
|
|
LISX = -4, 02801500
|
|
FI = -6, 02801600
|
|
DKADR = -7, 02801700
|
|
READINT = 13, 02801900
|
|
SELECT = 14; 02802000
|
|
ARRAY FMTA = -5[*]; 02802100
|
|
NAME FILX = -8, 02802160
|
|
MEM = 2; 02802190
|
|
INTEGER LSTRN = 19; 02802300
|
|
REAL LISTYPE = 20, 02802400
|
|
ARRAYSTUFF = 18, 02802500
|
|
HOLTOG = 21; 02802600
|
|
ARRAY TEN = 22[*], 02802900
|
|
FIB[*]; 02803000
|
|
NAME LISTADR; 02803100
|
|
REAL BUFF , % FIRST BUFFER POSITION 02803200
|
|
BSIZE , % ARGUMENTS 02803300
|
|
NBC, 02803400
|
|
NFCI, 02803600
|
|
DH1, 02803700
|
|
WH1 , % 02803800
|
|
WH2; 02803900
|
|
NAME W1; 02804100
|
|
ARRAY IOBUFF = BUFF[*]; 02804200
|
|
INTEGER RPT, 02804300
|
|
W , % FIELD 02804400
|
|
BDTYP = W, 02804500
|
|
WT , % WIDTH 02804600
|
|
T1 , % 02804700
|
|
D , % DEC- 02804800
|
|
DT , % IMAL P- 02804900
|
|
D1 , % LA- 02805000
|
|
D2 , % CE- 02805100
|
|
CNT, 02805200
|
|
EXP , % EXPONENT 02805300
|
|
EXPSGN, 02805400
|
|
CODE , % EDITING FUNCTION 02805500
|
|
SKP , % REDUNDANT POSITIONS 02805600
|
|
NCR , % CURRENT BUFFER POSITION 02805700
|
|
LCR , % BUFFER SIZE IN CHARACTERS 02805800
|
|
CHR , % CURRENT CHAR FROM FORMAT 02805900
|
|
PRCW , % PAREN CONTROL WORD 02805910
|
|
PCT, % PAREN COUNTER 02805920
|
|
PS ; % SCALE FACTOR 02806000
|
|
BOOLEAN DONETOG , % RETURN AFTER WRITE 02806100
|
|
SGN , % SIGN 02806200
|
|
FRTOG, % TRUE IF NUM HAS FRACTION PART 02806210
|
|
LGTG, 02806300
|
|
DTAERR, 02806400
|
|
FMERRTOG , % FORMAT ERROR 02806500
|
|
GTOG, 02806700
|
|
CTOG; 02806800
|
|
DEFINE LOGV = 4#, 02806900
|
|
INTEGV =1#, 02807000
|
|
STRGV =2#, 02807100
|
|
DBLV = 5#, 02807300
|
|
CMPLXV = 6#, 02807400
|
|
NUM = 2#, 02807600
|
|
GTYPE = 1#, 02807800
|
|
FTYPE = 2#, 02807900
|
|
ETYPE = 3#, 02808000
|
|
DTYPE = 4#, 02808100
|
|
ITYPE = 5#, 02808200
|
|
LTYPE = 6#, 02808300
|
|
ATYPE = 7#, 02808400
|
|
OTYPE = 8#, 02808500
|
|
KIND = (FIB[4].[8:4])#, 02808600
|
|
TAPEF =2#, 02808800
|
|
MAX = @7777777777777#, 02809000
|
|
ELMTYP = LISTYPE . [44:4]#, 02809100
|
|
DLN = (LISTYPE.[44:4] = DBLV)#, 02809200
|
|
CMPLX = (LISTYPE.[44:4] = CMPLXV)#, 02809300
|
|
TWOD = LISTYPE.[38:1]#, 02809400
|
|
LPPS = 15:30:18#, 02809500
|
|
LPPR = [15:18]#, 02809600
|
|
RPTF = [33:15]#, 02809700
|
|
NORF = (P(XCH,DUP) < 0)#, 02809800
|
|
PCF = [9:6]#, 02809810
|
|
ENDLIST = (LSTRN = (-1))#, 02809900
|
|
SIZEF = [33:15]#, 02810000
|
|
BASEF = [18:15]#; 02810100
|
|
LABEL TYPERR, FMCYC, FMERR, MON, FNOL, FMTLST, FRMTCD, NFPH, 02810300
|
|
STRT,REPEAT,LPAR,RTPAR,SLASH,STRING,TFMT,FMTERR, 02810400
|
|
CL1,CL2,CL3,CL4,SCAL,HOL,SKIP,CL3A,STRA,TFMA,TIX, 02810500
|
|
G,F,E,DC,I,L,A,O,COMM, 02810600
|
|
LL,LL1; 02810900
|
|
COMMENT * * * * * START OF SUBROUTINE DECLARATIONS * * * * * * * * ; 02811000
|
|
SUBROUTINE CKPB; 02811100
|
|
BEGIN COMMENT INITIALIZE FILE AND ACQUIRE RECORD SIZE; 02811200
|
|
LCR ~ 8|(BSIZE ~ P(MKS,DKADR,1,FILX,READINT)); 02811300
|
|
BUFF ~ (*FILX).[33:15]; NCR ~ 0; 02811400
|
|
END CKPB; 02811500
|
|
SUBROUTINE READS; 02811600
|
|
BEGIN 02811700
|
|
P(MKS,DKADR,0,FILX,READINT); 02811800
|
|
IF DONETOG THEN P(XIT); 02811900
|
|
$ SET OMIT = NOT(TIMESHARING) 02811909
|
|
IF KIND!10 THEN %%% THEN NOT FROM DATA COM. 02811910
|
|
IF NOT ((*FILX).[19:1]) THEN P(FILX,@2000000000,36,COM,DEL,DEL); 02811920
|
|
$ SET OMIT = TIMESHARING 02811950
|
|
CKPB; 02812200
|
|
END READS; 02812300
|
|
LABEL NFCL; 02812400
|
|
REAL SUBROUTINE NFC; 02812500
|
|
BEGIN 02812600
|
|
NFCL: 02812700
|
|
WHILE NFCI.[45:3] < 2 DO NFCI ~ NFCI + 1; 02812800
|
|
STREAM(P1 ~ 0:P2 ~FMTA[NFCI.[30:15]],P3 ~ NFCI.[45:3]); 02812900
|
|
BEGIN DI ~ LOC P1; DS ~ 7 LIT "0"; 02813000
|
|
SI ~ LOC P2; SI ~SI + P3;DS ~ CHR; 02813100
|
|
SI ~ SI - 1; DI ~ DI - 1; 02813200
|
|
IF SC < "A" THEN 02813300
|
|
BEGIN 02813400
|
|
IF SC = "@" THEN DS ~ LIT """ ELSE 02813500
|
|
IF SC = "[" THEN DS ~ LIT ")" ELSE 02813600
|
|
IF SC = "%" THEN DS ~LIT "("; 02813700
|
|
END; 02813800
|
|
END; 02813900
|
|
NFCI ~ NFCI + 1; IF (CHR ~ P) = " " THEN IF NOT LGTG THEN GO NFCL; 02814000
|
|
NFC ~ CHR; 02814100
|
|
END NFC; 02814200
|
|
SUBROUTINE PUT; 02814300
|
|
BEGIN ; 02814400
|
|
WHILE NFCI.[45:3] <2 DO NFCI ~ NFCI + 1; 02814500
|
|
STREAM(P2~[FMTA[NFCI.[30:15]]],P3~NFCI.[45:3],P4~NBC); 02814600
|
|
BEGIN 02814700
|
|
SI ~ LOC P4; SI~SI+1; 02814800
|
|
DI ~ P2; DI~DI+P3; DS~CHR; 02814900
|
|
END; 02815000
|
|
NFCI ~ NFCI +1; 02815100
|
|
END PUT; 02815200
|
|
SUBROUTINE GET; 02815300
|
|
BEGIN; 02815400
|
|
STREAM(P1 ~[NBC]:P2 ~ BUFF); 02815500
|
|
BEGIN 02815600
|
|
SI ~ P2; DI ~ P1; 02815700
|
|
DI ~ DI+1; DS ~ CHR; 02815800
|
|
P1 ~ SI; 02815900
|
|
END; 02816000
|
|
BUFF ~ P; 02816100
|
|
IF HOLTOG THEN 02816200
|
|
BEGIN 02816300
|
|
IF (NBC ~ NBC.[6:6]) = "#" THEN NBC ~ "=" ELSE 02816400
|
|
IF NBC = "&" THEN NBC ~ "+" ELSE 02816500
|
|
IF NBC = "%" THEN NBC ~ "(" ELSE 02816600
|
|
IF NBC = "[" THEN NBC ~ ")" ELSE 02816700
|
|
IF NBC = "@" THEN NBC ~ """; 02816800
|
|
NBC ~ 0&NBC[6:42:6]; 02816900
|
|
END; 02817000
|
|
END GET; 02817100
|
|
% PARAMETERS FOR LIST CONTROL 02817200
|
|
BOOLEAN ATOG,TWDT; 02817300
|
|
ARRAY AR1 = LISTADR[*]; 02817400
|
|
INTEGER INDX, SIZE; 02817600
|
|
LABEL RTNLST,SRT; 02817700
|
|
DEFINE NXTELM = IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX.[40:8],CDC) 02817800
|
|
ELSE [AR1[INDX]]#; 02817900
|
|
SUBROUTINE GETLIST; 02818000
|
|
BEGIN 02818100
|
|
SRT: IF ATOG THEN 02818200
|
|
BEGIN 02818300
|
|
W1 ~ NXTELM; 02818400
|
|
INDX ~ INDX + DLN; 02818500
|
|
IF (INDX ~INDX + 1) } SIZE THEN 02818600
|
|
BEGIN 02818700
|
|
ARRAYSTUFF ~ 0; 02818800
|
|
ATOG ~ FALSE; 02818900
|
|
END; 02819000
|
|
GO TO RTNLST; 02819100
|
|
END; 02819200
|
|
IF CTOG THEN 02819300
|
|
BEGIN % IMAGINARY PART OF COMPLEX 02819400
|
|
W1 ~ [LISTADR[1]]; 02819500
|
|
CTOG ~ FALSE; 02819600
|
|
GO TO RTNLST; 02819700
|
|
END; 02819800
|
|
P(0); 02819900
|
|
LISTADR ~ [LISX]; 02820000
|
|
IF ARRAYSTUFF ! 0 THEN 02820100
|
|
BEGIN 02820200
|
|
ATOG ~ TRUE; 02820300
|
|
TWDT~NOT P(*(LISTADR~MEM[LISTADR.[18:15]]),TOP); P(DEL) ; 02820400
|
|
SIZE~(INDX~ARRAYSTUFF.BASEF)+ARRAYSTUFF.SIZEF ; 02820700
|
|
GO TO SRT; 02820800
|
|
END; 02820900
|
|
W1 ~ [LISTADR[0]]; 02821000
|
|
P(DEL); 02821100
|
|
CTOG ~ CMPLX; 02821200
|
|
RTNLST: 02821300
|
|
END GETLIST; 02821400
|
|
SUBROUTINE FORMATCONTROL; 02821500
|
|
BEGIN 02821600
|
|
STRT: 02821700
|
|
W~D~CODE~SKP~RPT~0; 02821800
|
|
SGN~DONETOG~FMERRTOG~FALSE; 02821900
|
|
CL1: COMMENT CHECK FOR SINGLE CHARACTER EDITING TYPES; 02822000
|
|
IF NFC{9 THEN GO TO REPEAT; % MUST BE REPEAT FIELD 02822100
|
|
IF CHR="(" THEN GO LPAR; 02822200
|
|
IF CHR=")" THEN GO RTPAR; 02822300
|
|
IF CHR="/" THEN GO SLASH; 02822400
|
|
IF CHR=""" THEN GO STRING; 02822500
|
|
IF CHR="T" THEN GO TO TFMT; 02822600
|
|
SGN~(CHR="-") & (CHR="+")[2:47:1]; 02822690
|
|
IF SGN THEN 02822700
|
|
BEGIN 02822800
|
|
IF NFC{9 THEN GO TO REPEAT 02822900
|
|
ELSE GO TO FMTERR; 02823000
|
|
END; 02823100
|
|
IF CHR="," THEN GO TO STRT; 02823200
|
|
RPT~1; 02823300
|
|
CL2: COMMENT TYPES WHICH MAY HAVE REPEAT FIELDS; 02823400
|
|
IF SGN THEN RPT~-RPT; 02823500
|
|
IF CHR="P" THEN GO TO SCAL; 02823600
|
|
IF RPT<0 OR SGN.[2:1] THEN GO TO FMTERR; 02823700
|
|
IF CHR="(" THEN GO TO LPAR; 02823800
|
|
IF CHR="H" THEN GO TO HOL; 02823900
|
|
IF RPT=0 THEN RPT~1; 02824000
|
|
IF CHR = "X" THEN GO TO SKIP; 02824100
|
|
CL3: COMMENT TYPES WHICH HAVE W FIELDS; 02824200
|
|
IF CHR="I" THEN CODE ~ ITYPE ELSE 02824300
|
|
IF CHR="A" THEN CODE ~ ATYPE ELSE 02824400
|
|
IF CHR="L" THEN CODE ~ LTYPE ELSE 02824500
|
|
IF CHR="O" THEN CODE ~ OTYPE; 02824600
|
|
IF CODE } ITYPE THEN GO TO CL3A; 02824700
|
|
CL4: COMMENT TYPES WITH W AND D FIELDS; 02824800
|
|
IF CHR="D" THEN CODE ~ DTYPE ELSE 02824900
|
|
IF CHR="E" THEN CODE ~ ETYPE ELSE 02825000
|
|
IF CHR="F" THEN CODE ~ FTYPE ELSE 02825100
|
|
IF CHR="G" THEN CODE ~ GTYPE ELSE 02825200
|
|
GO TO FMTERR; 02825300
|
|
CL3A: COMMENT DEVELOP VALUE OF W FIELD; 02825400
|
|
IF NFC>9 THEN GO TO FMTERR; 02825500
|
|
W~CHR; 02825600
|
|
WHILE NFC{9 DO W~10|W+CHR; % CONVERT TO OCTAL 02825700
|
|
NFCI~NFCI-1; 02825800
|
|
IF W>63 THEN GO TO FMTERR; 02825900
|
|
IF CODE}ITYPE THEN GO TIX; 02826000
|
|
COMMENT DEVELOP D FIELD; 02826100
|
|
IF NFC!"." THEN GO TO FMTERR; 02826200
|
|
IF NFC>9 THEN GO TO FMTERR; 02826300
|
|
D~CHR; 02826400
|
|
WHILE NFC{9 DO D~10|D+CHR; % CONVERT TO OCTAL 02826500
|
|
NFCI~NFCI-1; 02826600
|
|
GO TO TIX; 02826700
|
|
LPAR: COMMENT GENER1TE PAREN CONTROL WORD; 02826800
|
|
IF PCT!0 AND RPT=0 THEN RPT~1 ; 02826810
|
|
T1 ~ RPT&NFCI[LPPS]&(RPT{0)[1:47:1]; 02826900
|
|
IF PCT { 1 THEN PRCW ~ T1 & PCT[9:42:6]; 02826910
|
|
P(T1,XCH); PCT ~ PCT + 1; 02826920
|
|
GO TO STRT; 02827000
|
|
RTPAR: COMMENT POINT AT LEFT PAR IF REPEAT NOT EXAUSTED; 02827100
|
|
IF NORF THEN 02827200
|
|
BEGIN % NO REPEAT FIELD 02827300
|
|
DONETOG ~ ENDLIST ; 02827400
|
|
READS; 02827500
|
|
IF (PCT ~ PCT - 1) { 0 THEN IF PRCW.PCF !0 02827510
|
|
THEN BEGIN P(XCH,PRCW); PCT ~ 2 END ELSE PCT ~ 1; 02827520
|
|
END ELSE 02827600
|
|
BEGIN 02827700
|
|
IF (RPT~P(DUP).RPTF) { 1 02827800
|
|
THEN BEGIN P(DEL);PCT ~ PCT - 1; GO TO STRT END 02827900
|
|
ELSE P(RPT - 1,CCX); 02828000
|
|
END; 02828100
|
|
NFCI~P(DUP).LPPR; % RESET TO LEFT PAREN 02828200
|
|
P(XCH); 02828300
|
|
GO TO STRT; 02828400
|
|
REPEAT: COMMENT CONVERT REPEAT FIELD TO OCTAL IN RPT; 02828500
|
|
RPT~CHR; 02828600
|
|
WHILE NFC{9 DO RPT~ 10|RPT+CHR; 02828700
|
|
GO TO CL2; 02828800
|
|
SLASH: % READ NEXT RECORD 02828900
|
|
READS; 02829000
|
|
GO TO STRT; 02829100
|
|
STRING: % MOVE STRING FROM BUFFER TO FORMAT 02829200
|
|
LGTG ~ TRUE; 02829300
|
|
GET; PUT; NCR ~ NCR + 1; 02829400
|
|
STRA: IF NFC = """ THEN BEGIN LGTG ~ FALSE; GO TO STRT END; 02829500
|
|
IF (NCR ~ NCR + 1) > LCR THEN GO TO FMTERR; 02829600
|
|
GET; NFCI ~ NFCI-1; 02829700
|
|
PUT; 02829800
|
|
GO TO STRA; 02829900
|
|
TFMT: COMMENT SET BUFFER TO CHARACTER POSITION INDICATED BY FIELD 02830000
|
|
FOLLOWING "T"; 02830100
|
|
IF (RPT~NFC)>9 THEN GO TO FMTERR; 02830200
|
|
WHILE NFC{9 DO RPT~10|RPT+CHR; 02830300
|
|
IF RPT>LCR THEN GO TO FMTERR; 02830400
|
|
NCR~RPT-1; 02830500
|
|
TFMA: BUFF ~ ((*FILX) INX NCR.[33:12])&NCR[30:45:3]; 02830600
|
|
GO TO STRT; 02830700
|
|
SCAL: COMMENT SCALE FACTOR OF P PHRASE; 02830800
|
|
PS~RPT; 02830900
|
|
GO TO STRT; 02831000
|
|
HOL: COMMENT HOLLERITH STRING; 02831100
|
|
WHILE RPT > 0 DO 02831200
|
|
BEGIN 02831300
|
|
IF (NCR ~ NCR + 1) > LCR THEN GO TO FMTERR; 02831400
|
|
GET; PUT; 02831500
|
|
RPT~RPT-1; 02831600
|
|
END; 02831700
|
|
GO TO STRT; 02831800
|
|
SKIP: COMMENT X PHRASE; 02831900
|
|
IF (NCR ~ NCR+RPT) > LCR THEN GO TO FMTERR; 02832000
|
|
GO TO TFMA; 02832100
|
|
FMTERR: FMERRTOG~TRUE; 02832200
|
|
TIX: 02832300
|
|
END FORMATCONTROL; 02832400
|
|
SUBROUTINE SKPC; % SKIPS CURRENT CHARACTERS. PUTS NEXT CHARACTERS 02832500
|
|
BEGIN; % IN NBC 02832600
|
|
STREAM(P1~BUFF,P2~0:P3~0); 02832700
|
|
BEGIN 02832800
|
|
SI ~ P1; SI ~ SI +1; P1 ~ SI; 02832900
|
|
DI ~ LOC P2; DI ~ DI+7; DS ~ CHR; 02833000
|
|
END; 02833100
|
|
NBC ~ P; BUFF ~ P; 02833200
|
|
WT ~ WT -1; 02833300
|
|
END SKPC; 02833400
|
|
SUBROUTINE SCALE; 02833500
|
|
BEGIN 02833600
|
|
IF (D1 ~ D1 + CNT) > 11 02833700
|
|
THEN DOUBLE(WH1,WH2,TEN[CNT],TEN[69+CNT],|, 02833800
|
|
DH1,0,+,~,WH1,WH2) 02833900
|
|
ELSE WH1~ WH1|TEN[CNT]+DH1; 02834000
|
|
DH1 ~ 0; 02834100
|
|
END SCALE; 02834200
|
|
SUBROUTINE GETNUM; 02834300
|
|
BEGIN; 02834400
|
|
STREAM(P1~BUFF,P2~IF WT { 8 THEN WT ELSE 8,P3~0,P4~0:P5~0); 02834500
|
|
BEGIN 02834600
|
|
SI~P1; DI~LOC P5 ; 02834700
|
|
P2(IF SC<"0" THEN 02834800
|
|
IF SC!" " THEN 02834900
|
|
IF SC="O" THEN BEGIN DS~LIT"0"; SI~SI+1;GO L END02835000
|
|
ELSE JUMP OUT ; 02835100
|
|
DS~CHR ; 02835200
|
|
L: TALLY~TALLY+1) ; 02835300
|
|
P2~TALLY; P1~SI ; 02835400
|
|
SI~LOC P5; DI~LOC P3; DS~P2 OCT ; 02835500
|
|
SI~P1 ; 02835600
|
|
DI ~ LOC P4; DI ~ DI + 7; DS ~ CHR; 02835700
|
|
END; 02835800
|
|
NBC ~ P; DH1 ~ P; CNT ~ P; BUFF ~ P; 02835900
|
|
END GETNUM; 02836000
|
|
SUBROUTINE GETSIGN; 02836100
|
|
BEGIN; 02836200
|
|
STREAM(P1~BUFF,P2~(IF WT > 63 THEN 63 ELSE WT),P3~0,P4~(-1): 02836300
|
|
P5~0); 02836310
|
|
BEGIN 02836400
|
|
SI~P1; DI~P2 ; 02836500
|
|
P2(DI~DI-8; IF SC!" " THEN JUMP OUT TO L1; 02836600
|
|
SI ~ SI + 1; TALLY ~ TALLY + 1); 02836700
|
|
P1 ~ SI; 02836800
|
|
GO TO RTNSGN; 02836900
|
|
L1: IF SC } "0" THEN 02837000
|
|
BEGIN 02837100
|
|
L3: P2 ~ TALLY; 02837200
|
|
L2: P5(P1~DI; TALLY~P2; P1(IF SC!" " THEN 02837300
|
|
JUMP OUT; TALLY~TALLY+1; SI~SI+1); P2~TALLY); P1~SI ; 02837310
|
|
DI ~ LOC P4; DS ~ 7 LIT "0"; DS ~ CHR; 02837400
|
|
GO TO RTNSGN; 02837500
|
|
END; 02837600
|
|
IF SC ="." THEN GO TO L3; 02837700
|
|
TALLY ~ TALLY+1; 02837800
|
|
P2 ~ TALLY; 02837900
|
|
TALLY~1; P5~TALLY ; 02838000
|
|
IF SC="-" THEN TALLY~1 ELSE IF SC="+" THEN TALLY~0 ELSE 02838010
|
|
IF SC="&" THEN TALLY~0 ELSE 02838020
|
|
BEGIN TALLY~0; P1~TALLY; GO TO RTNSGN END; 02838025
|
|
P3 ~ TALLY; 02838100
|
|
SI ~ SI + 1; 02838200
|
|
GO TO L2; 02838300
|
|
RTNSGN: 02838400
|
|
END; 02838500
|
|
NBC~P; SGN~P; CNT~P; DTAERR~((BUFF~P)=0) ; 02838600
|
|
END GETSIGN; 02838700
|
|
LABEL NCRTN,BLSGN; 02838800
|
|
SUBROUTINE NUMCONVERT; 02838900
|
|
BEGIN 02839000
|
|
DH1 ~ D1 ~ D2 ~ EXP ~ EXPSGN ~ FRTOG ~0; 02839100
|
|
WH1 ~ WH2 ~ -0; 02839200
|
|
WT ~ W; 02839300
|
|
BLSGN: 02839310
|
|
GETSIGN; 02839400
|
|
IF DTAERR THEN GO TO NCRTN ; 02839405
|
|
WT ~ WT - CNT; IF NBC <0 % BLANK FIELD 02839500
|
|
THEN IF WT { 0 THEN GO TO NCRTN ELSE GO TO BLSGN; 02839510
|
|
IF NBC { 9 THEN 02839600
|
|
BEGIN 02839700
|
|
GETNUM; WH1 ~ DH1; 02839800
|
|
IF (WT ~ WT - (D1 ~ CNT)) { 0 THEN GO TO NCRTN; 02839900
|
|
WHILE NBC{9 OR NBC=" " OR NBC="O" DO 02840000
|
|
BEGIN 02840100
|
|
GETNUM; SCALE; 02840200
|
|
IF (WT ~ WT-CNT) { 0 THEN GO TO NCRTN; 02840300
|
|
END; 02840400
|
|
END; 02840500
|
|
IF NBC = "." THEN 02840600
|
|
BEGIN 02840700
|
|
FRTOG ~ TRUE; 02840800
|
|
SKPC; 02840900
|
|
IF WT{0 THEN GO TO NCRTN ; 02840910
|
|
WHILE NBC{9 OR NBC=" " OR NBC="O" DO 02841000
|
|
BEGIN 02841100
|
|
GETNUM; SCALE; 02841200
|
|
D2 ~ D2 + CNT; 02841300
|
|
IF ( WT ~ WT - CNT) { 0 THEN GO TO NCRTN; 02841400
|
|
END; 02841500
|
|
END; 02841600
|
|
IF NBC = "D" OR NBC = "E" THEN SKPC; 02841700
|
|
IF WT{0 THEN BEGIN DTAERR~TRUE; GO TO NCRTN END ; 02841710
|
|
IF (NBC="+") OR (NBC="&") OR (NBC=" ") OR (EXPSGN~(NBC="-")) 02841800
|
|
THEN SKPC; 02841900
|
|
IF WT{0 THEN BEGIN DTAERR~TRUE; GO TO NCRTN END ; 02841910
|
|
IF NBC > "9" THEN DTAERR ~ TRUE 02842000
|
|
ELSE 02842100
|
|
BEGIN 02842200
|
|
GETNUM; 02842300
|
|
EXP ~ IF EXPSGN THEN (-DH1) ELSE DH1; 02842400
|
|
IF (WT~WT-CNT) { 0 THEN GO TO NCRTN; 02842500
|
|
WHILE WT > 0 DO SKPC; 02842600
|
|
END; 02842700
|
|
NCRTN: 02842800
|
|
IF WH1 = 0 THEN IF SGN THEN WH1 ~ -0; 02842900
|
|
END NUMCONVERT; 02843000
|
|
SUBROUTINE CONVERT; 02843100
|
|
BEGIN 02843200
|
|
WH1 ~ WH2 ~ 0; WT ~W; 02843300
|
|
GO TO P(CODE,DUP,ADD); 02843400
|
|
GO TO FMERR; 02843500
|
|
GO TO G; GO TO F; GO TO E; GO TO DC; GO TO I; 02843600
|
|
GO TO L; GO TO A; GO TO O; 02843700
|
|
O: % OCTAL CONVERSION 02843800
|
|
IF W>16 THEN SKP~W-WT~16 ELSE SKP~0 ; 02843900
|
|
STREAM(P1~BUFF,P2~0:P3~[WH1],P4~SKP,P5~WT,P6~16-WT,P7~0, 02843950
|
|
P8~(WT=16)) ; 02844000
|
|
BEGIN 02844050
|
|
SI~P1; P1~TALLY; TALLY~1 ; 02844100
|
|
P4(IF SC=" " THEN SI~SI+1 ELSE IF SC="0" THEN SI~SI+1 02844150
|
|
ELSE BEGIN P7(JUMP OUT 2 TO MAST); IF SC="-" THEN 02844200
|
|
P2~TALLY ELSE IF SC!"+" THEN IF SC!"&" THEN JUMP OUT 02844250
|
|
TO MAST; P7~TALLY; SI~SI+1 END) ; 02844300
|
|
P8(IF SC>"3" THEN JUMP OUT TO MAST) ; 02844350
|
|
DI~P3; P6(SKIP 3 DB) ; 02844400
|
|
GO TO FAST; MAST: GO TO LAST; FAST: 02844410
|
|
P5(IF SC>"0" THEN IF SC<"8" THEN BEGIN SKIP 3 SB; P7~ 02844450
|
|
TALLY; 3(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB) END02844500
|
|
ELSE JUMP OUT TO LAST ELSE BEGIN IF SC!" " THEN 02844550
|
|
IF SC!"0" THEN BEGIN P7(JUMP OUT 2 TO LAST); 02844600
|
|
IF SC="-" THEN P2~TALLY ELSE IF SC!"+" THEN 02844650
|
|
IF SC!"&" THEN JUMP OUT TO LAST; P7~TALLY END ; 02844700
|
|
SI~SI+1; SKIP 3 DB END) ; 02844750
|
|
P1~SI ; 02844800
|
|
LAST: 02844850
|
|
END ; 02844900
|
|
SGN~P; IF (DTAERR~((BUFF~P)=0)) THEN GO TO COMM ; 02844950
|
|
W1[0]~IF SGN THEN -WH1 ELSE WH1 ; 02844975
|
|
GO TO COMM; 02845000
|
|
A: % ALPHA CONVERSION 02845100
|
|
IF W > 6 THEN SKP ~ W - (WT ~ 6); 02845200
|
|
WH1 ~ " "; 02845300
|
|
STREAM(P1~ BUFF:P2~[WH1],P3~SKP,P4~WT,P5~HOLTOG); 02845400
|
|
BEGIN 02845500
|
|
SI ~ P1; SI ~ SI + P3; 02845600
|
|
DI ~ P2; DI ~ DI + 2; 02845700
|
|
P5(P4( 02845800
|
|
IF SC } "A" THEN DS ~ CHR ELSE 02845900
|
|
IF SC = "#" THEN BEGIN SI ~ SI +1; DS ~ LIT "=" END ELSE 02846000
|
|
IF SC = "&" THEN BEGIN SI ~ SI +1; DS ~ LIT "+" END ELSE 02846100
|
|
IF SC = "%" THEN BEGIN SI ~ SI +1; DS ~ LIT "(" END ELSE 02846200
|
|
IF SC = "[" THEN BEGIN SI ~ SI +1; DS ~ LIT ")" END ELSE 02846300
|
|
IF SC = "@" THEN BEGIN SI ~ SI +1; DS ~ LIT """ END ELSE 02846400
|
|
DS ~ CHR;); 02846500
|
|
JUMP OUT TO X;); 02846600
|
|
DS ~ P4 CHR; 02846700
|
|
X: 02846800
|
|
P1 ~ SI; 02846900
|
|
END; 02847000
|
|
BUFF ~ P; 02847100
|
|
W1[0] ~ WH1; 02847200
|
|
GO TO COMM; 02847300
|
|
L: % LOGICAL CONVERSION 02847400
|
|
STREAM(P1~BUFF,P2~0:P3~0,P4~W); 02847500
|
|
BEGIN 02847600
|
|
SI ~ P1; P3~SI; 02847700
|
|
P4(IF SC!" " THEN JUMP OUT 1 TO LL ELSE SI ~ SI + 1); 02847800
|
|
TALLY ~ 0; GO TO LL1; 02847900
|
|
LL: IF SC = "T" THEN TALLY ~ 1; 02848000
|
|
LL1: P2 ~ TALLY; SI ~ P3; SI ~ SI +P4; P1 ~ SI; 02848100
|
|
END; 02848200
|
|
W1[0] ~ P; 02848300
|
|
BUFF ~ P; 02848400
|
|
DTAERR ~ ELMTYP ! LOGV; 02848600
|
|
GO TO COMM; 02848700
|
|
I: % INTEGER CONVLRSION 02848800
|
|
NUMCONVERT; 02848900
|
|
IF (DTAERR ~ DTAERR OR D2!0 OR EXP ! 0 02849000
|
|
OR ELMTYP = DBLV OR WH1 > MAX) 02849100
|
|
THEN GO TO COMM; 02849200
|
|
W1[0] ~ IF SGN THEN -WH1 ELSE WH1; 02849300
|
|
GO TO COMM; 02849400
|
|
% SINGLE PRECISION 02849500
|
|
E: % E FORMAT 02849600
|
|
F: % F FORMAT 02849700
|
|
G: % G FORMAT 02849800
|
|
NUMCONVERT; 02849900
|
|
IF (W1[0] ~ WH1) = 0 THEN GO TO COMM; 02850000
|
|
IF (DTAERR ~ DTAERR OR ELMTYP = LOGV 02850100
|
|
OR ELMTYP = INTEGV OR ELMTYP= DBLV) 02850200
|
|
THEN GO TO COMM; 02850300
|
|
T1 ~ (IF EXP ! 0 THEN EXP ELSE -PS) 02850400
|
|
-(IF FRTOG THEN D2 ELSE D); 02850500
|
|
IF T1<(-68) THEN T1~-68 ELSE IF DTAERR~T1>68 THEN GO TO COMM ; 02850510
|
|
IF D1 GTR 11 THEN IF T1 GTR 0 THEN 02850530
|
|
DOUBLE(WH1,WH2,TEN[ T1],TEN[69+T1],TIMES,:=,WH1,WH2) 02850535
|
|
ELSE 02850540
|
|
BEGIN 02850545
|
|
DOUBLE(WH1,WH2,TEN[-T1],TEN[69-T1],/,:=,WH1,WH2); 02850550
|
|
IF WH2 > @0007777777777700 THEN 02850553
|
|
IF WH1.[3:6] LSS 14 THEN WH1 := WH1 + 1 & WH1[2:2:7]; 02850555
|
|
END 02850560
|
|
ELSE 02850565
|
|
WH1 ~ IF T1} 0 THEN WH1|TEN[T1] 02850600
|
|
ELSE WH1/TEN[-T1]; 02850700
|
|
W1[0] ~ IF SGN THEN -WH1 ELSE WH1; 02850800
|
|
GO TO COMM; 02850900
|
|
DC: % DOUBLE PRECISION CONVERSION 02851000
|
|
NUMCONVERT; 02851100
|
|
IF WH1 = 0 THEN BEGIN W1[0] ~ W1[1] ~WH1; GO TO COMM END; 02851200
|
|
IF (DTAERR ~ DTAERR OR ELMTYP ! DBLV ) 02851300
|
|
THEN GO TO COMM; 02851400
|
|
T1 ~ (IF EXP ! 0 THEN EXP ELSE -PS) 02851500
|
|
-(IF FRTOG THEN D2 ELSE D); 02851600
|
|
IF T1<(-68) THEN T1~-68 ELSE IF DTAERR~T1>68 THEN GO TO COMM ; 02851610
|
|
IF SGN THEN WH1 ~ - WH1; 02851700
|
|
IF T1 > 0 THEN 02851800
|
|
DOUBLE(WH1,WH2,TEN[ T1],TEN[69+T1],|,~,W1[0],W1[1]) 02851900
|
|
ELSE 02852000
|
|
DOUBLE(WH1,WH2,TEN[-T1],TEN[69-T1],/,~,W1[0],W1[1]); 02852100
|
|
COMM: 02852200
|
|
END CONVERT; 02852300
|
|
COMMENT * * * * * * * * * * END OF DECLARATIONS * * * * * * * * * * * ; 02862200
|
|
IF EDITCODE!1 AND EDITCODE!3 THEN 02862210
|
|
BEGIN P(MKS) ; 02862220
|
|
IF EDITCODE!6 THEN P(FILX,DKADR); P(FI,FMTA,*P(.LISX)) ; 02862230
|
|
IF EDITCODE=4 THEN P(EOFL,INTCALL(PARL,@154)) 02862250
|
|
ELSE P(EDITCODE,EOFL,INTCALL(PARL,@160)) ; 02862260
|
|
P(XIT) ; 02862270
|
|
END ; 02862300
|
|
FILX[NOT 4] ~ EOFL; FILX[NOT 3] ~ PARL; 02862310
|
|
FIB ~ FILX[NOT 2]; % OPEN FILE IF NOT OPEN 02862400
|
|
IF FIB[5].[43:2] ! (T1 ~ 2 + (EDITCODE=5)) THEN 02862500
|
|
P(MKS,0,T1,FILX,1,SELECT); 02862600
|
|
CKPB; ARRAYSTUFF~0; 02862705
|
|
IF FIB[0] = 0 THEN 02862706
|
|
FIB[0] ~ 1 + (EDITCODE =0 OR EDITCODE =2) 02862708
|
|
ELSE 02862710
|
|
IF FIB[0] !1 + (EDITCODE =0 OR EDITCODE = 2) 02862712
|
|
THEN P(MKS,FIB[6],FILX.[33:15],4,FORTERR); 02862714
|
|
IF EDITCODE=1 THEN GO FNOL; GO FMTLST ; 02862800
|
|
FNOL: 02863900
|
|
LSTRN~-1; 02864000
|
|
GO TO FRMTCD; 02864100
|
|
FMTLST: 02882900
|
|
LSTRN ~ 1; 02883000
|
|
CTOG ~ DONETOG ~ FALSE; 02883100
|
|
GETLIST; 02883200
|
|
GO TO FRMTCD; 02883300
|
|
MON: 02883400
|
|
FRMTCD: 02883500
|
|
PS ~ 0; 02883600
|
|
NFCI ~ (FI|8) + 2; % FIRST FORMAT CHARACTER 02883700
|
|
IF NFC ! "(" THEN GO TO FMERR; 02883800
|
|
NFCI ~ (FI|8) + 2; % FIRST FORMAT CHARACTER 02883900
|
|
NFPH: FORMATCONTROL; % ANAYLSIS OF FORMAT STATEMENT 02884000
|
|
IF FMERRTOG THEN GO TO FMERR; 02884100
|
|
FMCYC: IF (DONETOG ~ ENDLIST) THEN READS; 02884200
|
|
IF W + NCR > LCR THEN GO TO FMERR; 02884300
|
|
NCR ~ W + NCR; 02884500
|
|
CONVERT; 02884600
|
|
IF DTAERR THEN GO TO TYPERR; 02884700
|
|
GETLIST; 02884800
|
|
IF (RPT~RPT-1) > 0 THEN GO TO FMCYC; 02884900
|
|
GO TO NFPH; 02885000
|
|
FMERR: 02885100
|
|
P(MKS,FIB[6],FILX.[33:15],0,FORTERR); 02885110
|
|
TYPERR: 02885400
|
|
P(MKS,FIB[6],FILX.[33:15],2,FORTERR); 02885500
|
|
END FTINT; 02885800
|
|
PROCEDURE FTOUTFIX(FILX,DKADDR,FI,FMT,LISX,EDITCODE,EOFL,PARL); %INT@15702886000
|
|
VALUE DKADDR,FI,LISX,EDITCODE,EOFL,PARL ; 02886040
|
|
ARRAY FMT[*]; NAME FILX; REAL DKADDR,FI,LISX,EDITCODE,PARL,EOFL ; 02886080
|
|
BEGIN 02886120
|
|
02886160
|
|
INTEGER LSTRN=19, E=17 ; 02886200
|
|
02886240
|
|
REAL LISTYPE=20, ARRAYSTUFF=18, ALGOLWRITE=12, SELECT=14, 02886280
|
|
FORTERR=24, CHR, MAXCHR, BSIZE, PRNTR, TYPE, INDX, SIZE, TWDT, 02886320
|
|
SGN, BUFF, T1, T2, T3, WH1, WH2, WH3, ARY, W, D, R, SAVW=EOFL, 02886360
|
|
E1=9, XTRA, C, FMTW, SAVBUFF, DBLPREC, CODE, T4, T5, SKP=PARL, 02886400
|
|
NEEDNEWLISTELEMENT, FLG, SCALE, T8, T6=18, SAVD, DECPT=20, ND, 02886440
|
|
COMMAS, DLRSGN, T21 ; 02886480
|
|
02886520
|
|
NAME LISTADDR ; 02886560
|
|
02886600
|
|
ARRAY TEN=22[*], AR1=LISTADDR[*], TPAR=23[*], FPB=3[*], FIB[*] ; 02886640
|
|
02886680
|
|
LABEL ALIST, GETNEXTPHRASE, REPEAT, TT, XX, SS, PP, AA, A1, OO, HH, 02886720
|
|
CC, ERROR, GG, LL, FF, EE, II, DD, TEST, TEST1, AWAY, OVRFLW, 02886760
|
|
BUMPWH3, MAXI, LOG8, THREH, THREL, HLF, CONVERT, D1, OVRFLW1, 02886800
|
|
FIVPT, JJ, RAPUP, X1, OVRFLW2, ONE, OUTSUB, CD, NLEL, FO94, 02886840
|
|
FO95, VERROR, HV, CD1, CMSK, REPEAT1, IEDIT, TEN11, ONDG, CKH,02886845
|
|
STNRD, SE, TWHLF, DREST, DREST1, HLF1, FIVPT1, SQN, OVRFLW3, 02886850
|
|
TEST2, REPEAT2, STNRD1, XPIV, GOTE, NK ; 02886855
|
|
02886880
|
|
SWITCH PHRASE~SS,HH,PP,XX,TT,AA,OO,LL,JJ,II,GG,FF,EE,DD,CC ; 02886920
|
|
02886960
|
|
DEFINE DONE = LSTRN=(-1) #, 02887000
|
|
REEL = 3 #, 02887040
|
|
LOGICAL = 4 #, 02887080
|
|
INTEGR = 1 #, 02887120
|
|
DBLPRECSN = 5 #, 02887160
|
|
COMPLEX = 6 #, 02887200
|
|
MAXCODE = 15 #, 02887210
|
|
VERR(VERR1) = BEGIN P(VERR1); GO VERROR END #, 02887215
|
|
MAYBE(MAYBE1,MAYBE2,MAYBE3) = CI~CI+MAYBE1; GO TO MAYBE2 ; 02887240
|
|
DS~LIT MAYBE3; MAYBE2: #, 02887280
|
|
TWOD = LISTYPE.[38:1] #, 02887320
|
|
INDXF = [18:15] #, 02887360
|
|
TYPEF = [44:4] #, 02887400
|
|
SIZEF = [33:15] # ; 02887440
|
|
02887480
|
|
SUBROUTINE BLANKIT ; 02887482
|
|
BEGIN 02887484
|
|
STREAM(A~BSIZE-1,B~P(DUP).[36:6],T21,BUFF) ; 02887486
|
|
BEGIN 02887488
|
|
SI~T21; DS~WDS; SI~BUFF; DS~A WDS; B(DS~32WDS; DS~32WDS) ;02887490
|
|
END ; 02887492
|
|
END OF BLANKIT ; 02887496
|
|
SUBROUTINE OUTPUT ; 02887520
|
|
BEGIN 02887560
|
|
IF PRNTR THEN 02887600
|
|
BEGIN 02887640
|
|
STREAM(Q~0:SAVBUFF) ; 02887680
|
|
BEGIN DI~LOC Q; SI~SAVBUFF; DI~DI+7; DS~CHR END ; 02887720
|
|
T1~IF (T1~P)="+" THEN 0 ELSE IF T1>9 THEN 16 02887760
|
|
ELSE IF T1=0 THEN 32 ELSE T1;02887800
|
|
IF NOT C THEN FIB[17]~*P(DUP)+BSIZE ; 02887840
|
|
P(MKS,T1.[42:2],T1 AND 15,C,BSIZE,FILX,ALGOLWRITE) ; 02887880
|
|
FIB[6]~*P(DUP)-((C~0)=T1) ; 02887920
|
|
P(MKS,FLG,DKADDR,0,(-1),FILX,ALGOLWRITE,DEL) ; 02888160
|
|
STREAM(Q~BUFF~SAVBUFF,BSIZE,BSZ~P(DUP)-1,T21,S~*FILX) ; 02888200
|
|
BEGIN 02888240
|
|
SI~Q; SI~SI+1; DS~BSIZE WDS; DI~Q; SI~T21; DS~9CHR ; 02888280
|
|
SI~Q; SI~SI+1; DS~BSZ WDS ; 02888320
|
|
END ; 02888360
|
|
FIB[17]~*P(DUP)-BSIZE ; 02888400
|
|
END 02888440
|
|
ELSE BEGIN 02888480
|
|
P(MKS,FLG,DKADDR,0,BSIZE,FILX,ALGOLWRITE) ; 02888520
|
|
IF LSTRN!(-1) THEN 02888560
|
|
BEGIN 02888600
|
|
P(MKS,FLG,DKADDR,0,(-1),FILX,ALGOLWRITE,DEL) ; 02888640
|
|
BUFF~SAVBUFF~(*FILX).[33:15]; BLANKIT ; 02888680
|
|
END ; 02888720
|
|
END ; 02888760
|
|
CHR~0 ; 02888800
|
|
END OF OUTPUT ; 02888840
|
|
02888880
|
|
SUBROUTINE SKIP ; 02888920
|
|
IF (T1~P(XCH)) GEQ W THEN T1~W 02888960
|
|
ELSE BEGIN 02889000
|
|
STREAM(T21:Q~W-T1,T~P(DUP).[36:6],BUFF) ; 02889040
|
|
BEGIN 02889080
|
|
SI~T21; DS~Q CHR; T(SI~T21; DS~32CHR; DS~32CHR) ; 02889120
|
|
T21~DI ; 02889140
|
|
END ; 02889160
|
|
BUFF~P ; 02889200
|
|
END OF SKIP ; 02889240
|
|
02889280
|
|
REAL SUBROUTINE NXTELM ; 02889320
|
|
BEGIN 02889360
|
|
P(IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX AND 255,COC) 02889400
|
|
ELSE AR1[INDX]) ; 02889440
|
|
INDX~INDX+1; NXTELM~P ; 02889480
|
|
END OF NXTELM ; 02889520
|
|
02889560
|
|
SUBROUTINE GETNEXTLISTELEMENT ; 02889600
|
|
BEGIN 02889640
|
|
IF NEEDNEWLISTELEMENT THEN 02889680
|
|
BEGIN 02889720
|
|
IF ARY THEN 02889760
|
|
BEGIN 02889800
|
|
ALIST: P(NXTELM); IF DBLPREC THEN WH2~NXTELM; ARY~INDX<SIZE;02889840
|
|
END 02889880
|
|
ELSE IF TYPE=COMPLEX THEN 02889920
|
|
BEGIN TYPE~REEL; P(LISTADDR[1]) END 02889960
|
|
ELSE BEGIN 02890000
|
|
P(ARRAYSTUFF~0); LISTADDR~[LISX] ; 02890040
|
|
DBLPREC~(TYPE~LISTYPE.TYPEF)=DBLPRECSN ; 02890080
|
|
IF ARY~ARRAYSTUFF!0 THEN 02890120
|
|
BEGIN 02890160
|
|
IF TYPE=COMPLEX THEN TYPE~REEL ; 02890200
|
|
SIZE~(INDX~ARRAYSTUFF.INDXF)+ 02890240
|
|
ARRAYSTUFF.SIZEF ; 02890280
|
|
P(LISTADDR~MEM[LISTADDR.[18:15]]) ; 02890320
|
|
TWDT~NOT P(LOD,TOP); P(DEL) ; 02890360
|
|
GO ALIST ; 02890400
|
|
END ; 02890480
|
|
P(DEL,LISTADDR[0]) ; 02890520
|
|
IF DBLPREC THEN WH2~LISTADDR[1] ; 02890560
|
|
END ; 02890600
|
|
T5~WH1~P ; 02890640
|
|
END ; 02890680
|
|
IF (NEEDNEWLISTELEMENT~1)=EDITCODE OR DONE THEN 02890720
|
|
AWAY: BEGIN OUTPUT; P(XIT) END ; 02890725
|
|
END OF GETNEXTLISTELEMENT ; 02890730
|
|
02890735
|
|
SUBROUTINE NLE ; 02890740
|
|
BEGIN P(XCH); WH2~0; GETNEXTLISTELEMENT ; 02890745
|
|
IF WH1+4>P(FO94) THEN 02890750
|
|
BEGIN IF T1 THEN VERR(P+10); P(DEL,FO94) END 02890755
|
|
ELSE IF P(DEL,(-P(FO94)),DUP)<WH1 THEN P(DEL,WH1) ; 02890760
|
|
P(XCH) ; 02890765
|
|
END OF NLE ; 02890770
|
|
02890775
|
|
SUBROUTINE HANDLEVARIABLES ; 02890780
|
|
BEGIN T1~1 ; 02890785
|
|
IF R=P(FO95) THEN 02890790
|
|
BEGIN P(0); NLE; T1~P(.R,ISN)>0 ; 02890795
|
|
IF CODE=29 THEN 02890800
|
|
BEGIN P(FI+SAVW) ; 02890805
|
|
IF R}0 THEN P([FMT[P]],DUP,LOD,P&R[6:36:12],XCH) 02890810
|
|
ELSE P(.FI) ; 02890815
|
|
P(STN) ; 02890820
|
|
OUTSUB: P(DEL,DEL); GO GETNEXTPHRASE ; 02890825
|
|
END ; 02890830
|
|
END ; 02890835
|
|
IF T4~CODE=30 THEN 02890840
|
|
BEGIN P(2); NLE; P(.ND,ISN) ; 02890845
|
|
STREAM(P1~P:P2~P(CD),P3~P(CD1)) ; 02890850
|
|
BEGIN SI~LOC P1; SI~SI+7; DI~LOC P2; DI~DI+1 ; 02890855
|
|
32(IF SC=DC THEN JUMP OUT; TALLY~TALLY+1; SI~SI-1) ; 02890860
|
|
P1~TALLY ; 02890865
|
|
END ; 02890870
|
|
IF (ND AND 63)!ND THEN P(DEL,32) ; 02890875
|
|
IF (CODE~P+3)>MAXCODE AND T1 THEN VERR(2) ; 02890880
|
|
T1~CODE>4 AND T1 ; 02890885
|
|
END ; 02890890
|
|
T2~T1 ; 02890895
|
|
IF P(CODE}11 AND CODE{14,FO95)=SAVW THEN 02890900
|
|
BEGIN P(.SAVW,4) ; 02890905
|
|
NLEL: NLE; P(XCH,ISD); T1~P(DUP) AND T2~T2 AND SAVW>0 ; 02890910
|
|
END ; 02890915
|
|
IF SAVD=P(FO95) THEN BEGIN P(.SAVD,6); GO NLEL END ; 02890920
|
|
IF CODE{4 THEN 02890925
|
|
BEGIN IF T4 THEN SAVW~R; 02890930
|
|
FMTW~FMTW&(P(DUP).[41:1]+(SAVW<0))[41:47:1]; GO HV ; 02890935
|
|
END ; 02890940
|
|
IF NOT T2 THEN GO OUTSUB; IF CODE=5 THEN HV: R~1 ; 02890945
|
|
IF P(DUP) AND SAVD<0 THEN VERR(16) ; 02890950
|
|
IF T4 THEN IF SAVW=P(FO94) THEN BEGIN IF CODE!9 THEN VERR(6)END02890955
|
|
ELSE IF P(DUP) AND SAVD=P(FO94) THEN 02890960
|
|
BEGIN P(7) ; 02890965
|
|
VERROR: T4~P; P(MKS,CODE,R,SAVW,SAVD,T4,WH1,WH2,FMTW, 02890970
|
|
(-5),FORTERR) ; 02890975
|
|
FO94::: 4094 ; 02890980
|
|
FO95::: 4095 ; 02890985
|
|
CD::: @0047676321464341 ; % 0PXTAOLJ 02890990
|
|
CD1::: @3127262524230000 ; % IGFEDC00 02890995
|
|
END ; 02891000
|
|
IF NOT P THEN SAVD~0 ; 02891005
|
|
END OF HANDLEVARIABLES ; 02891010
|
|
02891015
|
|
REAL SUBROUTINE SETUP ; 02891020
|
|
BEGIN 02891025
|
|
P(XCH,DUP) ; 02891030
|
|
IF DBLPREC THEN 02891035
|
|
BEGIN 02891040
|
|
IF P>ND THEN BEGIN T6~P-ND; P(ND) END ; 02891080
|
|
IF (T5~(T4~P)-T3~ND-16)<0 THEN 02891120
|
|
BEGIN P(WH3/TEN[-T5],.WH3,ISD); T3~T4 END 02891160
|
|
ELSE IF T5 LSS 8 THEN 02891200
|
|
BEGIN 02891240
|
|
IF P(WH2/TEN[8-T2~T5],.WH2,ISN)=TEN[T2] THEN 02891280
|
|
BUMPWH3: WH3~WH3+1 ; 02891320
|
|
END 02891360
|
|
ELSE IF P(WH1/TEN[16-T5],.WH1,ISN)=TEN[T1~T5-T2~8] 02891400
|
|
THEN IF (WH2~WH2+1)=T8 THEN GO BUMPWH3 ; 02891440
|
|
END 02891480
|
|
ELSE BEGIN 02891520
|
|
IF (T3~P)>11 THEN T6~T3-T3~(P(WH1,TEN[ABS(E)],IF E>0 02891560
|
|
THEN P(/) ELSE P(|)){P(FIVPT))+11 ; 02891600
|
|
IF CODE=12 THEN P(SCALE,+) ; 02891640
|
|
P(P-E1-T6,WH3,XCH,TEN[ABS(P(DUP))],IF P(XCH)<0 THEN P(/) 02891680
|
|
ELSE P(|),.WH3,ISD) ; 02891720
|
|
END ; 02891760
|
|
E1~P(TEN[T3]=WH3,DUP)+E1; SETUP~P ; 02891800
|
|
END OF SETUP ; 02891840
|
|
02891880
|
|
%************************:: CODE STARTS HERE ::************************%02891920
|
|
02891960
|
|
FIB~FILX[NOT 2]; P(TEN[8],.T8,ISD) ; 02892000
|
|
IF FLG~DKADDR<0 THEN DKADDR~0 ; 02892040
|
|
IF P(FIB[5],DUP).[43:1] THEN P(MKS,0,0,FILX,1,SELECT) ; 02892080
|
|
C~(P AND 96)!0 ; 02892120
|
|
MAXCHR~(BSIZE~P(MKS,FLG,DKADDR,0,(-1),FILX,ALGOLWRITE))|8+ 02892160
|
|
PRNTR~((T1~FIB[4].[8:4])=1 OR T1=12 OR T1=7) AND 02892200
|
|
FPB[FIB[4].[13:11]+3].[43:5]<20 ; 02892205
|
|
IF NOT(NOT(NEEDNEWLISTELEMENT~EDITCODE=3) OR FMT[FI]) THEN GO ERROR;02892240
|
|
IF NOT TPAR.[14:1] THEN 02892250
|
|
BEGIN 02892255
|
|
E~P(1,[E],CFX,SFB)&29[8:38:10] ; 02892260
|
|
STREAM(A~P(21,[E])); BEGIN DS~8LIT" "; SI~A; DS~7WDS END ; 02892265
|
|
P(TPAR,1,25,COM,DEL,DEL); E~0 ; 02892270
|
|
END ; 02892275
|
|
T21~P([TPAR[21]]) INX 0 ; 02892276
|
|
IF PRNTR THEN 02892280
|
|
BEGIN 02892320
|
|
IF BSIZE>16 THEN BEGIN BSIZE~17; MAXCHR~133 END ; 02892360
|
|
IF C THEN BEGIN BUFF~TPAR INX 1; TPAR[0]~" "; BLANKIT END ; 02892440
|
|
P(P(CMSK) OR TPAR) ; 02892445
|
|
END 02892480
|
|
ELSE P(P(*FILX).[33:15]) ; 02892520
|
|
BUFF~SAVBUFF~P ; 02892560
|
|
IF NOT PRNTR THEN BLANKIT ; 02892565
|
|
IF FIB[0]=0 THEN FIB[0]~1 ; 02892600
|
|
IF (LSTRN~1)!FIB[0] AND T1=2 THEN 02892640
|
|
BEGIN T3~4 ; 02892680
|
|
ERROR: P(MKS,FIB[7],FILX.[33:15],T3,FORTERR) ; 02892720
|
|
END ; 02892760
|
|
P(0) ; 02892800
|
|
GETNEXTPHRASE: 02892840
|
|
R~P(FMT[FI~FI+1],DUP).[6:12]; IF (CODE~P(DUP).[1:5])=2 THEN GO HH ;02892880
|
|
SAVW~P(DUP).[18:12]; SAVD~(FMTW~P(DUP)).[30:12] ; 02892885
|
|
IF (XTRA~P(DUP) AND 63).[44:2]=0 THEN P(0,0) 02892890
|
|
ELSE P(P((D~P(DUP) AND 15)=12,DUP) OR D=8,P(XCH) OR D=4) ; 02892895
|
|
DLRSGN~P; COMMAS~P ; 02892900
|
|
IF P.[42:1] THEN IF (FMTW AND 3)=0 THEN HANDLEVARIABLES ; 02892905
|
|
IF CODE=0 THEN 02892920
|
|
BEGIN 02892960
|
|
IF SAVD!0 THEN 02893000
|
|
BEGIN GETNEXTLISTELEMENT; OUTPUT; NEEDNEWLISTELEMENT~0END;02893005
|
|
IF P(DUP).[18:15]!FI THEN P(R&FI[18:33:15]) ; 02893040
|
|
IF P((NOT 0),XCH,INX,DUP).[33:15]=0 THEN P(DEL)ELSE FI~FI-SAVW;02893080
|
|
GO GETNEXTPHRASE ; 02893120
|
|
FIVPT::: 5.49755813885 ; 02893160
|
|
END ; 02893200
|
|
IF CODE=5 THEN CHR~R~0 ; 02893240
|
|
REPEAT: 02893320
|
|
IF CODE>5 THEN 02893360
|
|
REPEAT1: GETNEXTLISTELEMENT ; 02893365
|
|
REPEAT2: 02893370
|
|
IF (CHR~(W~SAVW)+CHR)>MAXCHR THEN IF CODE!3 AND CODE!9 THEN GO AWAY;02893375
|
|
IF CODE}9 THEN IF CODE{14 THEN 02893380
|
|
BEGIN 02893385
|
|
SGN~WH1.[1:1]; DECPT~CODE>10 ; 02893390
|
|
IF CODE<13 THEN 02893395
|
|
IF ABS(WH1)<P(TEN11) AND NOT CODE THEN 02893400
|
|
IF W<64 AND NOT(COMMAS OR DLRSGN OR DBLPREC) THEN 02893405
|
|
BEGIN 02893410
|
|
IF NOT DECPT THEN 02893415
|
|
BEGIN 02893420
|
|
IF P(E1~W,ABS(WH1),.WH2,ISN)>9 02893425
|
|
THEN GO IEDIT ; 02893430
|
|
IF P(SGN+1,-,DUP)}0 THEN GO ONDG ; 02893435
|
|
GO OVRFLW1 ; 02893440
|
|
END ; 02893445
|
|
IF (T1~11-D~SAVD)<0 THEN GO STNRD1 ; 02893450
|
|
IF (E1~W-D-1)<0 THEN GO OVRFLW ; 02893455
|
|
P(T6~0); IF WH1=0 THEN BEGIN WH2~0; GO CKH END;02893460
|
|
P(TEN[D],DUP,ABS(WH1)) ; 02893465
|
|
IF SCALE!0 THEN 02893470
|
|
BEGIN 02893475
|
|
IF P(TEN[ABS(SCALE)],IF SCALE>0 THEN P(|) 02893480
|
|
ELSE P(/),DUP)}P(TEN11) THEN GO STNRD ; 02893485
|
|
P(.WH1,STN) ; 02893490
|
|
END ; 02893495
|
|
IF P(DUP,HLF1,-,.WH2,ISN,-,|,.T5,ISN)=P THEN 02893500
|
|
BEGIN T5~0; WH2~WH2+1 END ; 02893505
|
|
IF T5!0 THEN 02893510
|
|
BEGIN P(DEL,10) ; 02893515
|
|
IF D>8 THEN 02893520
|
|
BEGIN P(DEL,5) ; 02893525
|
|
T2~T5 DIV T8; D~D-8 ; 02893530
|
|
END ; 02893535
|
|
END ; 02893540
|
|
IF WH2<10 THEN 02893545
|
|
BEGIN 02893550
|
|
CKH: IF P(E1-SGN-1,DUP)<0 THEN 02893555
|
|
BEGIN 02893560
|
|
IF WH2!0 THEN GO OVRFLW2 ; 02893565
|
|
P(DEL) ; 02893570
|
|
IF E1=0 THEN 02893575
|
|
BEGIN 02893580
|
|
IF SGN THEN GO OVRFLW1 02893585
|
|
ELSE GO DREST1 ; 02893590
|
|
CMSK::: @700000 ; 02893595
|
|
HLF1::: 0.5 ; 02893600
|
|
TEN11::: 99999999999.0 ; 02893605
|
|
END ; 02893610
|
|
P(SGN~0); WH2~"-" ; 02893615
|
|
END ; 02893620
|
|
ONDG: STREAM(S~P:T21,WH2,SGN,BUFF) ; 02893625
|
|
BEGIN 02893630
|
|
SI~I21; DS~S CHR; MAYBE(SGN,L1,"-") ; 02893635
|
|
SI~LOC SGN; SI~SI-1; DS~CHR; S~DI ; 02893640
|
|
END ; 02893645
|
|
IF NOT DECPT THEN GO TEST ; 02893650
|
|
BUFF~P; P(WH2!0) ; 02893655
|
|
DREST: IF (E~P)>T1 THEN 02893660
|
|
T6~E-T1-(ABS(WH1){TEN[E-1]|P(FIVPT1)) ; 02893665
|
|
DREST1: STREAM(Q~P:D,T2,T5,T6,BUFF) ; 02893670
|
|
BEGIN 02893675
|
|
DS~LIT"."; CI~CI+Q; SI~LOC I5;SI~SI+2;02893680
|
|
DS~D CHR; GO L2; SI~LOC T2; DS~D DEC ;02893685
|
|
DS~8DEC; GO L2; SI~LOC T5; DS~D DEC ; 02893690
|
|
L2: Q~DI ; 02893695
|
|
T6(DI~DI-T6;T6(DS~LIT"0"); JUMP OUT); 02893700
|
|
END ; 02893705
|
|
GO TEST ; 02893710
|
|
END ; 02893715
|
|
IEDIT: IF P(E1-SGN,DUP)<9 THEN 02893720
|
|
BEGIN 02893725
|
|
STREAM(E1~P,WH2,SGN:BUFF) ; 02893730
|
|
BEGIN SI~LOC WH2; CI~CI+SGN; GO L1 ; 02893735
|
|
DS~LIT"0"; DS~E1 DEC; E1~DI; DI~BUFF ;02893740
|
|
IF TOGGLE THEN TALLY~1; DS~8 FILL ; 02893745
|
|
DI~DI-1; DS~LIT"-"; GO L2; L1: 02893750
|
|
DS~E1 DEC; IF TOGGLE THEN TALLY~1 ; 02893755
|
|
E1~DI; DI~BUFF; DS~8FILL; L2: WH2~DI ;02893760
|
|
SGN~TALLY ; 02893765
|
|
END ; 02893770
|
|
IF P THEN GO SQN ELSE GO OVRFLW3 ; 02893775
|
|
END ; 02893780
|
|
IF WH2<T8 THEN 02893785
|
|
BEGIN 02893790
|
|
P(DEL) ; 02893795
|
|
STREAM(WH2,S~E1-8:T21,SGN,BUFF) ; 02893800
|
|
BEGIN 02893805
|
|
SI~T21; DS~S CHR; S~DI; SI~LOC WH2 ; 02893810
|
|
DS~8DEC; WH2~DI; DI~S; DS~8FILL; S~DI;02893815
|
|
CI~CI+SGN; GO L1; DI~DI-1; DS~LIT"-" ;02893820
|
|
L1: 02893825
|
|
END ; 02893830
|
|
GO SQN ; 02893835
|
|
END ; 02893840
|
|
E1~P ; 02893845
|
|
STREAM(WH1~WH2 DIV T8,WH2,T21:S~IF E1>16 THEN P(02893850
|
|
E1-16,8) ELSE P(0,E1-8),E1~P,SGN,BUFF) ; 02893855
|
|
BEGIN 02893860
|
|
SI~T21; DS~S CHR; DS~SGN CHR; S~DI ; 02893865
|
|
SI~LOC WH1; DS~E1 DEC; IF TOGGLE THEN 02893870
|
|
TALLY~1; DS~8DEC; WH1~DI; T21~TALLY; DI~S ;02893875
|
|
DS~8FILL; WH2~DI; CI~CI+SGN; GO L1 ; 02893880
|
|
DI~DI-1; DS~LIT"-"; L1: 02893885
|
|
END ; 02893890
|
|
IF NOT P THEN GO OVRFLW3 ; 02893895
|
|
SQN: IF NOT DECPT THEN 02893900
|
|
BEGIN P(DEL,XCH,DEL); GO TEST END ; 02893905
|
|
E1~P; BUFF~P ; 02893910
|
|
IF W<13 THEN GO DREST1 ; 02893915
|
|
P(0&P((1+BUFF) INX (NOT E1))[43:46:2] 02893920
|
|
+BUFF.[30:3]-E1.[30:3]) ; 02893925
|
|
GO DREST ; 02893930
|
|
FIVPT1:::5.49755813885 ; 02893935
|
|
STNRD: P(DEL,DEL,DEL,DEL) ; 02893940
|
|
END ; 02893945
|
|
D~SAVD ; 02893950
|
|
STNRD1: P(XPIV,WH1=0) ; 02893955
|
|
IF NOT DBLPREC THEN 02893960
|
|
BEGIN 02893965
|
|
IF P THEN GO GOTE ; 02893970
|
|
P(TEN[ABS(E~(P&(WH1~ABS(WH1) MOD P(MAXI))[9:3:6]& 02893975
|
|
WH1[1:2:1]+P(TWHLF))|P(LOG8))],WH1) ; 02893980
|
|
IF E<0 THEN P(|,ONE,XCH) ; 02893985
|
|
IF P(>) THEN 02893990
|
|
BEGIN P(E-1) ; 02893995
|
|
GOTE: E~P ; 02894000
|
|
END ; 02894005
|
|
IF CODE=13 THEN 02894010
|
|
IF NOT (WH1!0 AND (DLRSGN OR D>16 OR D+SCALE>11)) 02894015
|
|
THEN GO SE ; 02894020
|
|
ND~12; WH3~WH1 ; 02894025
|
|
END 02894030
|
|
ELSE IF P AND WH2=0 THEN BEGIN WH3~E~P; ND~24 END ELSE 02894035
|
|
BEGIN 02894040
|
|
P(WH1~ABS(WH1)) ; 02894045
|
|
IF (P AND P(NK))=0 THEN WH2~P(0,ONE,WH2,WH1,DLM,.WH1,~) ; 02894050
|
|
IF (E~(P&(WH3~WH1)[9:3:6]&WH1[1:2:1]+P(TWHLF))|P(LOG8))<0 02894055
|
|
THEN P(0,ONE,TEN[69-E],TEN[-E],DLD) 02894080
|
|
ELSE P(TEN[E+69],TEN[E]) ; 02894120
|
|
T1~P; IF (P>WH2 AND T1=WH1) OR T1>WH1 THEN E~E-1 ; 02894160
|
|
P(WH2,WH1,TEN[69+ABS(E)],TEN[ABS(E)],IF 0>E THEN 02894200
|
|
P(DLM) ELSE P(DLD)) ; 02894240
|
|
T1~P; T3~P; P(24) ; 02894280
|
|
IF T1}P(THREH) THEN P(T1>P(THREH) OR T3>P(THREL),-) ; 02894320
|
|
ND~P ; 02894360
|
|
IF ND}70+E THEN P(WH2,WH1,TEN[ND+69],TEN[ND],DLM, 02894400
|
|
TEN[68-E],TEN[-E-1],DLM) 02894410
|
|
ELSE P(WH2,WH1,TEN[(T1~ABS(ND-E-1))+69],TEN[T1],IF ND{E 02894425
|
|
THEN P(DLD) ELSE P(DLM)) ; 02894440
|
|
WH1~P ; 02894480
|
|
P(T3~P,WH1,T6~TEN[85],T4~TEN[16],DLD,HLF,-,.WH3,ISD,DEL, 02894520
|
|
T3,WH1,0,WH3,T6,T4,DLM,DLS) ; 02894560
|
|
WH1~P ; 02894600
|
|
P(T3~P,WH1,0,T8,DLD,HLF,-,.WH2,ISD,DEL,T3,WH1, 02894640
|
|
0,WH2,0,T8,DLM,DLS,.WH1,ISD,DEL) ; 02894680
|
|
END ; 02894720
|
|
IF T4~(T1~T2~T3~T6~0)=WH3 THEN P((-ND)) 02894760
|
|
ELSE BEGIN P(E+1); IF CODE=12 THEN P(SCALE,+) END ; 02894800
|
|
E1~P ; 02894840
|
|
END ; 02894880
|
|
GO PHRASE[CODE-1] ; 02894960
|
|
HLF::: 0.5 ; 02894965
|
|
MAXI::: @0777777777777777 ; 02894967
|
|
ONE::: 1.0 ; 02895000
|
|
XPIV::: @1130000000000000 ; 02895040
|
|
TWHLF::: 12.5 ; 02895045
|
|
NK::: @0007000000000000 ; 02895050
|
|
THREH::: @1153013331500045 ; 02895055
|
|
THREL::: @0003112121167260 ; 02895060
|
|
LOG8::: 0.90308998709 ; 02895065
|
|
SE: IF P(W-D-5-SGN,DUP)<0 THEN GO OVRFLW1 ; 02895070
|
|
IF P(DUP)>63 THEN BEGIN P(W,XCH,SUB,63,+); SKIP; P(63) END ; 02895075
|
|
IF WH1=0 THEN 02895080
|
|
BEGIN 02895085
|
|
STREAM(SKP~P:T21,SGN,D~D+3,D1~P(DUP).[36:6],BUFF) ; 02895090
|
|
BEGIN 02895095
|
|
SI~T21; DS~SKP CHR; MAYBE(SGN,L1,"-"); DS~2LIT" 0" ; 02895100
|
|
SI~T21; DS~D CHR; D1(SI~T21; DS~32CHR; DS~32CHR); SKP~DI ;02895105
|
|
END ; 02895110
|
|
GO TEST ; 02895115
|
|
END ; 02895120
|
|
ND~E ; 02895125
|
|
IF SCALE!0 THEN 02895130
|
|
IF SCALE<0 THEN 02895135
|
|
BEGIN IF P(1-SCALE,DUP)>D THEN GO OVRFLW2 END 02895140
|
|
ELSE BEGIN 02895145
|
|
IF P(SCALE,-,DUP)<0 THEN GO OVRFLW1 ; 02895150
|
|
P(SKP~P); D~D+SCALE; E~E-SCALE; P(1) ; 02895155
|
|
END 02895160
|
|
ELSE BEGIN IF D=0 THEN GO OVRFLW1; P(1) END ; 02895165
|
|
T3~P ; 02895170
|
|
IF P(WH1,TEN[ABS(P((E1~D-T3)-ND,DUP))],IF P(XCH)>0 THEN 02895175
|
|
P(|) ELSE P(/),.T4,ISN)=TEN[E1+1] THEN 02895180
|
|
BEGIN P(TEN[E1],.T4,ISD); E~E+1 END ; 02895185
|
|
P(5); IF D>8 THEN BEGIN E1~T4 DIV T8; D~D-8; P(DEL,0) END ; 02895190
|
|
STREAM(SKP~P,Q~P:D,E1,T4,E~ABS(E+T3),ES~E<(-T3),SGN,T21,BUFF) ; 02895195
|
|
BEGIN 02895200
|
|
SI~T21; DS~SKP CHR; MAYBE(SGN,L1,"-"); DS~LIT"."; CI~CI+Q; 02895205
|
|
SI~LOC E1; DS~D DEC; DS~8DEC; GO L2; SI~LOC T4; DS~D DEC ; 02895210
|
|
L2: DS~2LIT"E "; CI~CI+ES; GO L3; DI~DI-1; DS~LIT"-" ; 02895215
|
|
L3: DS~2DEC; SKP~DI ; 02895220
|
|
END ; 02895225
|
|
P(DEL) ; 02895230
|
|
IF SCALE>0 THEN STREAM(SCALE,SKP~SKP+SGN,BUFF) ; 02895235
|
|
BEGIN 02895240
|
|
DI~DI+SKP; SKP~DI; SI~SKP; SI~SI+1; DS~SCALL CHR ; 02895245
|
|
DS~LIT"." ; 02895250
|
|
END ; 02895255
|
|
GO TEST ; 02895260
|
|
TT: P(CHR~W-1); IF PRNTR THEN P(DEL,W+6) ; 02895265
|
|
P((P(DUP).[33:12] INX SAVBUFF)&P(XCH)[30:45:3]); GO TEST ; 02895280
|
|
XX: P(0) ; 02895320
|
|
X1: SKIP; GO TEST1 ; 02895360
|
|
SS: OUTPUT; IF (R~R-1)>0 THEN GO SS ELSE GO TEST2 ; 02895400
|
|
CC: 02895440
|
|
AA: P(WH1,6) ; 02895480
|
|
A1: SKIP ; 02895520
|
|
STREAM(Q~P:T~IF CODE=6 THEN 2 ELSE 8-T1,T1,BUFF) ; 02895560
|
|
BEGIN SI~LOC Q; SI~SI+T; DS~T1 CHR; Q~DI END ; 02895600
|
|
GO TEST ; 02895640
|
|
LL: P("F"); IF T5 THEN P(29,+); P(1); GO A1 ; 02895680
|
|
PP: SCALE~W&FMTW[1:41:1]; CHR~CHR-W; GO TEST1 ; 02895720
|
|
OO: P(16); SKIP ; 02895760
|
|
STREAM(Q~3|(16-T1):T1,WH1,BUFF) ; 02895800
|
|
BEGIN 02895840
|
|
SI~LOC WH1; SKIP Q SB ; 02895880
|
|
I1(DS~3RESET; 3(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB)) ; 02895920
|
|
Q~DI ; 02895960
|
|
END ; 02896000
|
|
GO TEST ; 02896040
|
|
HH: P(DEL); IF (CHR~CHR+R)>MAXCHR THEN GO AWAY ; 02896080
|
|
STREAM(Q~[FMT[FI]]:R,S~R.[36:6],BUFF) ; 02896100
|
|
BEGIN SI~Q; SI~SI+3; DS~R CHR; S(DS~32CHR; DS~32CHR); Q~DI END ;02896120
|
|
BUFF~P; FI~(R+2).[36:9]+FI; GO GETNEXTPHRASE ; 02896160
|
|
GG: IF TYPE=INTEGR THEN BEGIN DECPT~D~0; GO II END ; 02896200
|
|
IF TYPE=LOGICAL THEN GO LL ; 02896240
|
|
IF E1}0 AND E1{D THEN 02896280
|
|
BEGIN 02896320
|
|
W~W-4; D~D-E1 ; 02896360
|
|
II: 02896400
|
|
JJ: 02896440
|
|
FF: IF P(0,E1+D,DUP)<0 THEN P(DEL,WH3~0) ; 02896480
|
|
IF T4 AND DECPT THEN T6~P ELSE T3~SETUP+T3 ; 02896520
|
|
P(CODE=9) ; 02896600
|
|
E~(T4~IF (ND~0)<E1 THEN E1 ELSE P(DUP))+(T5~IF COMMAS THEN 02896640
|
|
(T4-1) DIV 3 ELSE 0)+DLRSGN+SGN ; 02896680
|
|
IF P THEN 02896720
|
|
BEGIN IF (CHR~CHR+E-W)>MAXCHR THEN GO AWAY; P(WH3=0) END 02896725
|
|
ELSE IF P(W-D-DECPT-E,DUP)<0 THEN GO OVRFLW2 ; 02896760
|
|
SKP~P+T5 ; 02896800
|
|
IF E1 LSS 1 THEN 02896840
|
|
BEGIN IF (ND~(T4~SKP!0)-E1)>D THEN ND~D+T4;SKP~SKP-T4 END;02896880
|
|
GO CONVERT ; 02896920
|
|
END ; 02896960
|
|
EE: P("E"); GO D1 ; 02897000
|
|
DD: P("D") ; 02897040
|
|
D1: IF T4 THEN BEGIN P(DEL); GO SE END; IF P(SCALE,DUP)<0 THEN P(DEL,0);02897080
|
|
IF (SKP~-P(D+P,DUP)+W-5-SGN-DLRSGN)<0 THEN GO OVRFLW2 ; 02897100
|
|
IF D~SCALE{0 THEN IF -SCALE}SAVD THEN GO OVRFLW2 ELSE P(SCALE,+) ; 02897120
|
|
IF SETUP THEN P(TEN[T3-1],.WH3,ISD) ; 02897360
|
|
IF (T4~ND~0)!SCALE THEN 02897400
|
|
BEGIN 02897440
|
|
IF ABS(E1~E1-SCALE)>99 THEN GO OVRFLW1 ; 02897480
|
|
IF D THEN ND~-SCALE ELSE T4~SCALE ; 02897520
|
|
END ; 02897560
|
|
CONVERT: 02897600
|
|
IF NOT DBLPREC AND T3>8 THEN 02897640
|
|
BEGIN WH3~(WH2~WH3) DIV T8; T3~T3-T2~8 END ; 02897680
|
|
STREAM(ND,SKP:T6,SGN,E~DECPT,S~SKP.[36:6],T~T6.[36:6],DLRSGN,T4, 02897720
|
|
T21,WH3,T3,WH2,T2,WH1,T1,BUFF) ; 02897760
|
|
BEGIN SI~T21; DS~SKP CHR ; 02897800
|
|
S(SI~T21; DS~32CHR; DS~32CHR); SKP~DI; MAYBE(DLRSGN,L3,"$") ; 02897840
|
|
MAYBE(SGN,L1,"-"); SGN~DI; DI~DI+E; ND(DS~LIT"0") ; 02897880
|
|
SI~LOC WH3; DS~T3 DEC; SI~LOC WH2; DS~T2 DEC; SI~LOC WH1 ; 02897920
|
|
DS~T1 DEC;T6(DS~LIT"0");T(32(DS~2LIT"0"));ND~DI;CI~CI+E; 02897960
|
|
GO L2; SI~SGN; DI~SGN; SI~SI+1; DS~I4 CHR; DS~LIT"."; L2: 02898000
|
|
END ; 02898040
|
|
T6~P ; 02898080
|
|
IF (T4~P(XCH))!0 THEN 02898120
|
|
STREAM(BUFF~P:T4,SGN~IF E1 LSS 0 THEN "-" ELSE " ",S~ABS(E1)) ;02898160
|
|
BEGIN 02898200
|
|
DI~BUFF; SI~LOC T4; SI~SI+7; DS~CHR; SI~SI+7; DS~CHR ; 02898240
|
|
DS~2 DEC; BUFF~DI ; 02898280
|
|
END 02898320
|
|
ELSE IF T5>0 THEN 02898360
|
|
STREAM(T~T5-1,Q~E-T5|4,T5,T6) ; 02898400
|
|
BEGIN 02898440
|
|
SI~T6; DI~DI-T5; DS~Q CHR; DS~LIT"," ; 02898480
|
|
T(DS~3CHR; DS~LIT",") ; 02898520
|
|
END ; 02898560
|
|
IF W!SAVW THEN BEGIN BUFF~P; P(W+W-SAVW); GO X1 END ; 02898600
|
|
GO TEST ; 02898640
|
|
OVRFLW3: 02898660
|
|
P(DEL) ; 02898665
|
|
OVRFLW2: 02898680
|
|
P(DEL) ; 02898720
|
|
OVRFLW1: 02898760
|
|
P(DEL) ; 02898800
|
|
OVRFLW: 02898840
|
|
STREAM(W~SAVW:W1~SAVW.[36:6],BUFF) ; 02898880
|
|
BEGIN W(DS~LIT"*"); W1(32(DS~2LIT"*")); W~DI END ; 02898920
|
|
TEST: 02898960
|
|
BUFF~P ; 02899000
|
|
TEST1: 02899040
|
|
IF (R~R-1)>0 THEN GO REPEAT1 ; 02899080
|
|
TEST2: 02899085
|
|
IF (XTRA AND 3)=0 THEN GO GETNEXTPHRASE ; 02899120
|
|
P(XTRA); XTRA~SAVW~0 ; 02899160
|
|
IF P(DUP) THEN BEGIN SAVW~P.[42:5]; CODE~4; GO REPEAT2 END ; 02899200
|
|
CODE~1; R~P.[42:4]; GO SS ; 02899240
|
|
END OF FTOUTFIX ; 02899280
|
|
% FORTRAN OUTPUT INTRINSIC 02900000
|
|
PROCEDURE FTOUT; % 051 02900100
|
|
BEGIN 02900200
|
|
COMMENT FILX FILE TOP IO DESCRIPTOR 02900300
|
|
FMTA FORMAT OR NAMELIST OR 0 02900400
|
|
LISX ACCIDENTAL ENTRY DESC. OR 0 02900500
|
|
EDITCODE 0 NO FORMAT, NO LIST 02900600
|
|
1 FORMAT, NO LIST 02900700
|
|
2 NO FORMAT, LIST 02900800
|
|
3 FORMAT, LIST 02900900
|
|
4 NAMELIST 02901000
|
|
; 02901100
|
|
REAL EDITCODE = -1, 02901200
|
|
FORTERR = 24, 02901210
|
|
LISX = -2, 02901300
|
|
FI = -4, 02901400
|
|
DKADR = -5; 02901500
|
|
ARRAY FMTA = -3[*], FPB = 3[*] ; 02901600
|
|
NAME FILX = -6, 02901700
|
|
MEM = 2; 02901800
|
|
REAL ALGOLWRITE = 12, 02901900
|
|
SELECT = 14; 02902000
|
|
INTEGER LSTRN = 19; 02902300
|
|
REAL LISTYPE = 20, 02902400
|
|
ARRAYSTUFF = 18; 02902500
|
|
ARRAY TEN = 22[*], 02902900
|
|
TPAR = 23[*], 02903000
|
|
FIB[*]; 02903100
|
|
NAME LISTADR; 02903200
|
|
REAL BUFF , % FIRST BUFFER POSITION 02903300
|
|
BSIZE , % ARGUMENTS 02903400
|
|
FLG , % TRUE FOR SERIAL I/O 02903410
|
|
WH1, 02903500
|
|
WH2 , % 02903600
|
|
W1 , % 02903700
|
|
W2 , % 02903800
|
|
NFCI ; % NEXT FORMAT CHAR LOCATION 02903900
|
|
ARRAY IOBUFF = BUFF[*]; 02904000
|
|
INTEGER DH1 , % CONV- 02904100
|
|
DH2 , % ERTED NU- 02904200
|
|
DH3 , % MBER 02904300
|
|
RPT , % REPEAT INDICATOR 02904400
|
|
W , % FIELD 02904500
|
|
WT , % WIDTH 02904600
|
|
T1 , % 02904700
|
|
D , % DEC- 02904800
|
|
DT , % IMAL P- 02904900
|
|
D1 , % LA- 02905000
|
|
D2 , % CE- 02905100
|
|
D3 , % S 02905200
|
|
ZEROS , % TRAILING ZEROES 02905300
|
|
EXP , % EXPONENT 02905400
|
|
SHFT , % INTEGER PART OF SHIFT 02905500
|
|
CODE , % EDITING FUNCTION 02905600
|
|
SKP , % REDUNDANT POSITIONS 02905700
|
|
NCR , % 0URRENT BUFFER POSITION 02905800
|
|
LCR , % BUFFER SIZL IN CHARACIERS 02905900
|
|
QUOTE , % STRING DELIMITER (" OR @) 02905910
|
|
CHR , % CURRENT CHAR FROM FORMAT 02906000
|
|
PRCW , % PAREN CONTROL WORD 02906010
|
|
PCT, % PAREN COUNTER 02906020
|
|
PS ; % SCALE FACTOR 02906100
|
|
BOOLEAN DONETOG , % RETURN AFTER WRITE 02906200
|
|
SGN , % SIGN 02906300
|
|
PRNTR , % TRUE IF PRINTER OUT PUT 02906400
|
|
FMERRTOG , % FORMAT ERROR 02906500
|
|
LGTG , 02906600
|
|
DTOG , % DOUBLE PRECISION TOG 02906700
|
|
CTOG , % COMPLEX NUMBER TOG 02906800
|
|
GTOGA , % G EDITING TOG W-D - SGN > 4 02906810
|
|
GTOG ; % G EDITING TOG 02906900
|
|
DEFINE DBLV = 5#, 02907300
|
|
CMPLXV = 6#, 02907400
|
|
GTYPE = 1#, 02907500
|
|
FTYPE = 2#, 02907600
|
|
ETYPE = 3#, 02907700
|
|
DTYPE = 4#, 02907800
|
|
ITYPE = 5#, 02907900
|
|
LTYPE = 6#, 02908000
|
|
ATYPE = 7#, 02908100
|
|
OTYPE = 8#, 02908200
|
|
KIND = (FIB[4].[8:4])#, 02908300
|
|
TAPEF =2#, 02908500
|
|
MAX = @7777777777777#, 02908700
|
|
DLN = (LISTYPE.[44:4] =DBLV)#, 02908900
|
|
CMPLX = (LISTYPE.[44:4] = CMPLXV)#, 02909000
|
|
TWOD = LISTYPE.[38:1]#, 02909100
|
|
LPPS = 15:30:18#, 02909200
|
|
LPPR = [15:18]#, 02909300
|
|
RPTF = [33:15]#, 02909400
|
|
NORF = (P(XCH,DUP) < 0)#, 02909500
|
|
PCF = [9:6]#, 02909510
|
|
ENDLIST = (LSTRN = (-1))#, 02909600
|
|
SIZEF = [33:15]#, 02909700
|
|
BASEF = [18:15]#; 02909800
|
|
LABEL TYPERR,NMLST, 02910000
|
|
STRT,REPEAT,LPAR,RTPAR,SLASH,STRING,TFMT,FMTERR, 02910100
|
|
CL1,CL2,CL3,CL4,SCAL,HOL,SKIP,CL3A,STRA,TFMA,TIX, 02910200
|
|
ERTN,G,F,E,DC,I,L,A,AA,O,FA,GA,AST,COMM, 02910300
|
|
NOFL,FNOL,BINARY,FMTLST, 02910400
|
|
FRMTCD,NFPH,FMCYC,FMERR,ZAP,ZIPIT; 02910500
|
|
COMMENT * * * * * START OF SUBROUTINE DECLARATIONS * * * * * * * * ; 02910600
|
|
SUBROUTINE CKPB; 02910700
|
|
BEGIN COMMENT INITIALIZE FILE AND ACQUIRE RECORD SIZE; 02910800
|
|
LCR ~ 8|(BSIZE ~ P(MKS,FLG,DKADR,0,(-1),FILX,ALGOLWRITE)); 02910900
|
|
IF PRNTR~PRNTR&(((T1~FIB[4].[8:4])=1 OR T1=7 OR T1=12) AND FPB[FIB[4] 02911000
|
|
.[13:11]+3].[43:5]<20)[47:47:1] THEN 02911005
|
|
IF BSIZE } 17 THEN BEGIN LCR ~ 132; BSIZE ~ 17 END; 02911010
|
|
BUFF~(IF T1~PRNTR AND (EDITCODE=1 OR EDITCODE>2) THEN TPAR ELSE *FILX) 02911100
|
|
.[33:15] ; 02911200
|
|
IF ((NOT T1) OR PRNTR.[46:1]) AND EDITCODE!2 THEN 02911400
|
|
STREAM(P2 ~ (BSIZE-1).[36:6], 02911500
|
|
P3~BSIZE+T1-1,P4~BUFF) ; 02911600
|
|
BEGIN DI ~ P4; DS ~ 8 LIT " "; 02911700
|
|
SI ~ P4; 02911800
|
|
P2(DS ~ 32 WDS; DS ~ 32 WDS); 02911900
|
|
DS ~ P3 WDS; 02912000
|
|
END; 02912100
|
|
NCR ~ 0; 02912300
|
|
END CKPB; 02912400
|
|
SUBROUTINE PRNT; 02912500
|
|
BEGIN COMMENT GENERATE A CALL FOR CAR. CONT. AND FOR OUTPUT; 02912600
|
|
IF PRNTR AND (EDITCODE = 1 OR EDITCODE } 3) THEN 02912700
|
|
BEGIN; 02912800
|
|
NCR ~ 0; 02912900
|
|
STREAM(P1~0:P2~TPAR); 02913000
|
|
BEGIN SI ~P2; DI ~ LOC P1; DI ~DI + 7; DS ~CHR; 02913100
|
|
DI ~ P2; DS ~ LIT " ";END; 02913200
|
|
NCR ~ P; 02913300
|
|
IF NCR = " " THEN D2 ~ 16 ELSE 02913400
|
|
IF NCR = "0" THEN D2 ~ 32 ELSE 02913500
|
|
IF NCR = "+" THEN D2 ~ 0 ELSE 02913600
|
|
IF (D2 ~ NCR) > 9 THEN D2 ~ 16; 02913700
|
|
IF NOT PRNTR.[46:1] THEN FIB[17]~FIB[17]+BSIZE ; 02913900
|
|
P(MKS,D2.[42:2],D2.[44:4],PRNTR.[46:1],BSIZE,FILX,ALGOLWRITE) ;02914000
|
|
FIB[6]~FIB[6]-(D2=0) ; 02914010
|
|
IF NOT (*FILX).[19:1] THEN P(FILX,@2000000000,2,COM,DEL,DEL); 02914100
|
|
PRNTR~1; CKPB ; 02914200
|
|
STREAM(P1~TPAR,P2~*FILX,P3~BSIZE.[36:6],P4~BSIZE); 02914300
|
|
BEGIN 02914400
|
|
SI ~ P1; DI ~ P2; DS ~ P4 WDS; 02914500
|
|
P3(DS ~32 WDS; DS ~ 32 WDS); 02914600
|
|
DI~P1; P4(DS~8LIT" ") ; 02914610
|
|
END; 02914700
|
|
FIB[17]~FIB[17]-BSIZE; IF DONETOG THEN P(XIT) ; 02914800
|
|
END ELSE BEGIN P(MKS,FLG,DKADR,0,BSIZE,FILX,ALGOLWRITE); 02914900
|
|
IF DONETOG THEN P(XIT); 02915000
|
|
CKPB END ; 02915100
|
|
END PRNT; 02915200
|
|
LABEL NFCL; 02915300
|
|
REAL SUBROUTINE NFC; 02915400
|
|
BEGIN 02915500
|
|
NFCL: 02915600
|
|
WHILE NFCI.[45:3] < 2 DO NFCI ~ NFCI + 1; 02915700
|
|
STREAM(P1 ~ 0:P2 ~FMTA[NFCI.[30:15]],P3 ~ NFCI.[45:3]); 02915800
|
|
BEGIN DI ~ LOC P1; DS ~ 7 LIT "0"; 02915900
|
|
SI ~ LOC P2; SI ~SI + P3;DS ~ CHR; 02916000
|
|
SI ~ SI - 1; DI ~ DI - 1; 02916100
|
|
END; 02916800
|
|
NFCI ~ NFCI + 1; IF (CHR ~ P) = " " THEN IF NOT LGTG THEN GO NFCL; 02916900
|
|
NFC ~ CHR; 02917000
|
|
END NFC; 02917100
|
|
SUBROUTINE IST; 02917200
|
|
BEGIN ; 02917300
|
|
STREAM(P1 ~ 0:P2 ~ BUFF,P3 ~ CHR); 02917400
|
|
BEGIN SI ~ LOC P3; SI ~ SI + 7; 02917500
|
|
DI ~ P2; DS ~ CHR; P1 ~ DI; 02917600
|
|
END; 02917700
|
|
BUFF ~ P; 02917800
|
|
END IST; 02917900
|
|
% PARAMETERS FOR LIST CONTROL 02918000
|
|
BOOLEAN ATOG,TWDT; 02918100
|
|
ARRAY AR1 = LISTADR[*]; 02918200
|
|
REAL INDX,SIZE,NLI,NLE; 02918400
|
|
LABEL RTNLST,SRT; 02918500
|
|
DEFINE NXTELM = IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX.[40:8],COC) 02918600
|
|
ELSE AR1[INDX]#; 02918700
|
|
SUBROUTINE GETLIST; 02920200
|
|
BEGIN 02920300
|
|
SRT: IF ATOG THEN 02920400
|
|
BEGIN 02920500
|
|
IF DLN THEN 02920600
|
|
BEGIN 02920700
|
|
WH1 ~ NXTELM; 02920800
|
|
INDX ~ INDX + 1; 02920900
|
|
WH2 ~ NXTELM; 02921000
|
|
END ELSE 02921100
|
|
BEGIN 02921200
|
|
WH1 ~ NXTELM; 02921300
|
|
WH2 ~ 0; 02921400
|
|
END; 02921500
|
|
IF (INDX ~INDX + 1) } SIZE THEN 02921600
|
|
BEGIN 02921700
|
|
ARRAYSTUFF ~ 0; 02921800
|
|
ATOG ~ FALSE; 02921900
|
|
END; 02922000
|
|
GO TO RTNLST; 02922100
|
|
END; 02922200
|
|
IF CTOG THEN 02922300
|
|
BEGIN % IMAGINARY PART OF COMPLEX 02922400
|
|
WH1 ~ LISTADR[1]; 02922500
|
|
WH2 ~ 0; 02922600
|
|
CTOG ~ FALSE; 02922700
|
|
GO TO RTNLST; 02922800
|
|
END; 02922900
|
|
P(0); LISTADR ~ [LISX]; 02923600
|
|
IF ARRAYSTUFF ! 0 THEN 02923800
|
|
BEGIN 02923900
|
|
ATOG ~ TRUE; 02924000
|
|
SIZE~(INDX~ARRAYSTUFF.BASEF)+ARRAYSTUFF.SIZEF ; 02924400
|
|
TWDT~NOT P(*(LISTADR~MEM[LISTADR.[18:15]]),TOP); P(DEL) ; 02924500
|
|
GO TO SRT; 02924600
|
|
END; 02924700
|
|
P(DEL); 02924800
|
|
WH1 ~ LISTADR[0]; 02924900
|
|
WH2 ~ IF DLN THEN LISTADR[1] ELSE 0; 02925000
|
|
CTOG ~ CMPLX; 02925100
|
|
RTNLST: 02925200
|
|
END GETLIST; 02925300
|
|
SUBROUTINE FORMATCONTROL; 02927400
|
|
BEGIN 02927500
|
|
STRT: 02927600
|
|
W~D~CODE~SKP~RPT~0; 02927700
|
|
SGN~DONETOG~FMERRTOG~FALSE; 02927800
|
|
CL1: COMMENT CHECK FOR SINGLE CHARACTER EDITING TYPES; 02927900
|
|
IF NFC{9 THEN GO TO REPEAT; % MUST BE REPEAT FIELD 02928000
|
|
IF CHR = "(" OR CHR = "%" THEN GO TO LPAR; 02928100
|
|
IF CHR = ")" OR CHR = "[" THEN GO TO RTPAR; 02928200
|
|
IF CHR="/" THEN GO SLASH; 02928300
|
|
IF CHR = """ OR CHR = "@" THEN GO TO STRING; 02928400
|
|
IF CHR="T" THEN GO TO TFMT; 02928500
|
|
SGN~(CHR="-") & (CHR="+")[2:47:1]; 02928590
|
|
IF SGN THEN 02928600
|
|
BEGIN 02928700
|
|
IF NFC{9 THEN GO TO REPEAT 02928800
|
|
ELSE GO TO FMTERR; 02928900
|
|
END; 02929000
|
|
IF CHR="," THEN GO TO STRT; 02929100
|
|
RPT~1; 02929200
|
|
CL2: COMMENT TYPES WHICH MAY HAVE REPEAT FIELDS; 02929300
|
|
IF SGN THEN RPT~-RPT; 02929400
|
|
IF CHR="P" THEN GO TO SCAL; 02929500
|
|
IF RPT<0 OR SGN.[2:1] THEN GO TO FMTERR; 02929600
|
|
IF CHR = "(" OR CHR = "%" THEN GO TO LPAR; 02929700
|
|
IF CHR="H" THEN GO TO HOL; 02929800
|
|
IF RPT=0 THEN RPT~1; 02929900
|
|
IF CHR = "X" THEN GO TO SKIP; 02930000
|
|
CL3: COMMENT TYPES WHICH HAVE W FIELDS; 02930100
|
|
IF CHR="I" THEN CODE ~ ITYPE ELSE 02930200
|
|
IF CHR="A" THEN CODE ~ ATYPE ELSE 02930300
|
|
IF CHR="L" THEN CODE ~ LTYPE ELSE 02930400
|
|
IF CHR="O" THEN CODE ~ OTYPE; 02930500
|
|
IF CODE } ITYPE THEN GO TO CL3A; 02930600
|
|
CL4: COMMENT TYPES WITH W AND D FIELDS; 02930700
|
|
IF CHR="D" THEN CODE ~ DTYPE ELSE 02930800
|
|
IF CHR="E" THEN CODE ~ ETYPE ELSE 02930900
|
|
IF CHR="F" THEN CODE ~ FTYPE ELSE 02931000
|
|
IF CHR="G" THEN CODE ~ GTYPE ELSE 02931100
|
|
GO TO FMTERR; 02931200
|
|
CL3A: COMMENT DEVELOP VALUE OF W FIELD; 02931300
|
|
IF NFC>9 THEN GO TO FMTERR; 02931400
|
|
W~CHR; 02931500
|
|
WHILE NFC{9 DO W~10|W+CHR; % CONVERT TO OCTAL 02931600
|
|
NFCI~NFCI-1; 02931700
|
|
IF W>63 THEN GO TO FMTERR; 02931800
|
|
IF CODE}ITYPE THEN GO TIX; 02931900
|
|
COMMENT DEVELOP D FIELD; 02932000
|
|
IF NFC!"." THEN GO TO FMTERR; 02932100
|
|
IF NFC >9 THEN GO TO FMTERR; 02932200
|
|
D~CHR; 02932300
|
|
WHILE NFC{9 DO D~10|D+CHR; % 0ONVERT TO OCTAL 02932400
|
|
NFCI~NFCI-1; 02932500
|
|
GO TO TIX; 02932600
|
|
LPAR: COMMENT GENER1TE PAREN CONTROL WORD. 02932700
|
|
IF PCT!0 AND RPT=0 THEN RPT~1 ; 02932710
|
|
T1 ~ RPT&NFCI[LPPS]&(RPT{0)[1:47:1]; 02932800
|
|
IF PCT { 1 THEN PRCW ~ T1 & PCT[9:42:6]; 02932810
|
|
P (T1, XCH); PCT~PCT+1; 02932820
|
|
GO TO STRT; 02932900
|
|
RTPAR: COMMENT POINT AT LEFT PAR IF REPEAT NOT EXAUSTED; 02933000
|
|
IF NORF THEN 02933100
|
|
BEGIN % NO REPEAT FIELD 02933200
|
|
DONETOG ~ ENDLIST; 02933300
|
|
PRNT;% WRITE OUT RECORD 02933400
|
|
IF (PCT ~ PCT - 1) { 0 THEN IF PRCW.PCF !0 02933410
|
|
THEN BEGIN P(XCH,PRCW); PCT ~ 2 END ELSE PCT ~ 1; 02933420
|
|
END ELSE 02933500
|
|
BEGIN 02933600
|
|
IF (RPT~P(DUP).RPTF) { 1 02933700
|
|
THEN BEGIN P(DEL);PCT ~ PCT - 1; GO TO STRT END 02933800
|
|
ELSE P(RPT - 1,CCX); 02933900
|
|
END; 02934000
|
|
NFCI~P(DUP).LPPR; % RESET TO LEFT PAREN 02934100
|
|
P(XCH); 02934200
|
|
GO TO STRT; 02934300
|
|
REPEAT: COMMENT CONVERT REPEAT FIELD TO OCTAL IN RPT; 02934400
|
|
RPT~CHR; 02934500
|
|
WHILE NFC{9 DO RPT~ 10|RPT+CHR; 02934600
|
|
GO TO CL2; 02934700
|
|
SLASH: COMMENT WRITE OUT BUFFER; 02934800
|
|
PRNT; 02934900
|
|
GO TO STRT; 02935000
|
|
STRING: COMMENT MOVE STRING FROM FORMAT ARRAY TO BUFFER; 02935100
|
|
QUOTE ~ CHR; % SAVE STRING DELIMITER 02935110
|
|
LGTG ~ TRUE; CHR ~ NFC; 02935200
|
|
STRA: IF (NCR ~ NCR + 1) > LCR THEN GO TO FMTERR; 02935300
|
|
IST; 02935400
|
|
IF NFC ! QUOTE THEN GO TO STRA; % " OR @ 02935500
|
|
LGTG ~ FALSE ; GO TO STRT; 02935600
|
|
TFMT: COMMENT SET BUFFER TO CHARACTER POSITION INDICATED BY FIELD 02935700
|
|
FOLLOWING "T"; 02935800
|
|
IF (RPT~NFC)>9 THEN GO TO FMTERR; 02935900
|
|
WHILE NFC{9 DO RPT~10|RPT+CHR; 02936000
|
|
IF RPT>LCR THEN GO TO FMTERR; 02936100
|
|
NCR~RPT-1; 02936200
|
|
TFMA: BUFF ~((IF PRNTR THEN TPAR ELSE (*FILX)) INX 02936300
|
|
NCR.[33:12])&NCR[30:45:3]; 02936400
|
|
GO TO STRT; 02936500
|
|
SCAL: COMMENT SCALE FACTOR OF P PHRASE; 02936600
|
|
PS~RPT; 02936700
|
|
GO TO STRT; 02936800
|
|
HOL: COMMENT HOLLERITH STRING; 02936900
|
|
LGTG ~ TRUE; 02937000
|
|
WHILE RPT > 0 DO 02937100
|
|
BEGIN 02937200
|
|
IF (NCR ~ NCR + 1) > LCR THEN GO TO FMTERR; 02937300
|
|
CHR ~ NFC; IST; 02937400
|
|
RPT~RPT-1; 02937500
|
|
END; 02937600
|
|
LGTG ~ FALSE; GO TO STRT; 02937700
|
|
SKIP: COMMENT X PHRASE; 02937800
|
|
IF (NCR ~ NCR+RPT) > LCR THEN GO TO FMTERR; 02937900
|
|
GO TO TFMA; 02938000
|
|
FMTERR: FMERRTOG~TRUE; 02938100
|
|
TIX: 02938200
|
|
END FORMATCONTROL; 02938300
|
|
SUBROUTINE FUNNYZERO; 02938400
|
|
BEGIN 02938500
|
|
SKP ~ W - (D+6+SGN); 02938600
|
|
STREAM(P1~ BUFF:P2~SKP,P3~SGN,P4~(D+4)); 02938700
|
|
BEGIN 02938800
|
|
DI ~P1; DI ~ DI + P2; 02938900
|
|
P3(DS ~ LIT "-"; JUMP OUT TO L); 02939000
|
|
L: DS ~ 2 LIT "0."; 02939100
|
|
P4(DS ~ LIT " "); 02939200
|
|
P1 ~ DI; 02939300
|
|
END; 02939400
|
|
BUFF ~ P; 02939500
|
|
END FUNNYZERO; 02939600
|
|
SUBROUTINE FINDE; 02939700
|
|
BEGIN IF DTOG THEN 02939800
|
|
DOUBLE(TEN[0],0,WH1,WH2,|,~,WH1,WH2) 02939900
|
|
ELSE WH1 ~ TEN[0] | WH1; 02940000
|
|
EXP~(0&WH1[42:3:6]&WH1[1:2:1]+12.5)|.90308998709 ; 02940100
|
|
W2 ~ 0; 02940150
|
|
IF DTOG THEN 02940200
|
|
IF EXP } 0 THEN DOUBLE(TEN[EXP],TEN[69+EXP],~,W1,W2) 02940300
|
|
ELSE DOUBLE(1,0,TEN[-EXP],TEN[69-EXP],/,~,W1,W2) 02940400
|
|
ELSE W1 ~ IF EXP } 0 THEN TEN[EXP] ELSE 1/TEN[-EXP]; 02940500
|
|
IF WH1 > W1 THEN GO TO ERTN; 02940600
|
|
IF WH1 = W1 THEN 02940700
|
|
IF WH2 } W2 THEN GO TO ERTN; 02940800
|
|
EXP ~ EXP-1; 02940900
|
|
ERTN: 02941000
|
|
END FINDE; 02941100
|
|
SUBROUTINE NUMCONVERT; 02941200
|
|
BEGIN 02941300
|
|
IF D1 > 0 THEN 02941400
|
|
BEGIN 02941500
|
|
DOUBLE(WH1,WH2,TEN[16],TEN[85],/,~,W1,W2); 02941600
|
|
DH1 ~ W1 DIV 1.0; 02941700
|
|
END; 02941800
|
|
IF D2 > 0 THEN 02941900
|
|
BEGIN IF DTOG THEN 02942000
|
|
BEGIN 02942100
|
|
DOUBLE(WH1,WH2,DH1,0,TEN[16],TEN[85],|,-, 02942200
|
|
TEN[ 8],TEN[77],/,~,W1,W2); 02942300
|
|
DH2 ~ W1 DIV 1; 02942400
|
|
END 02942500
|
|
ELSE DH2 ~ WH1 DIV TEN[8]; 02942600
|
|
END; 02942700
|
|
IF DTOG THEN 02942800
|
|
BEGIN 02942900
|
|
DOUBLE(WH1,WH2,DH1,0,TEN[16],TEN[85],|, 02943000
|
|
DH2,0,TEN[ 8],TEN[77],|,+,-,~,W1,W2); 02943100
|
|
DH3 ~ W1 DIV 1; 02943200
|
|
END 02943300
|
|
ELSE DH3 ~ WH1 DIV 1; 02943400
|
|
EXP ~ EXP+1; 02943500
|
|
END NUMCONVERT; 02943600
|
|
SUBROUTINE SETD; 02943700
|
|
BEGIN 02943800
|
|
IF DLN AND DT > 23 THEN 02943900
|
|
BEGIN 02944000
|
|
ZEROS~DT-23; DT ~ 23; D1 ~ 7; D2 ~ D3 ~ 8; 02944100
|
|
END ELSE IF DT>12 AND NOT DLN THEN 02944200
|
|
BEGIN 02944300
|
|
ZEROS~DT-12; DT ~ 12; D1~0; D2 ~ 4; D3 ~ 8; 02944400
|
|
END ELSE IF DT>16 THEN 02944500
|
|
BEGIN 02944600
|
|
D1~DT-16; D2~D3~8; 02944700
|
|
END ELSE IF DT > 8 THEN 02944800
|
|
BEGIN 02944900
|
|
D1~0;D2~DT-8; D3~8; 02945000
|
|
END ELSE 02945100
|
|
BEGIN 02945200
|
|
D1~D2~0;D3~DT; 02945300
|
|
END; 02945400
|
|
END SETD; 02945500
|
|
SUBROUTINE RNDOFF; 02945600
|
|
BEGIN IF DTOG THEN 02945700
|
|
IF T1 } 0 THEN 02945800
|
|
DOUBLE(WH1,WH2,,5,TEN[T1],TEN[T1+69],|,+,~,WH1,WH2) ELSE 02945900
|
|
DOUBLE(WH1,WH2,,5,TEN[-T1],TEN[69-T1],/,+,~,WH1,WH2) 02946000
|
|
ELSE WH1 ~ WH1 + (IF T1}0 THEN 5|TEN[T1] ELSE 5/TEN[-T1]);02946100
|
|
END RNDOFF; 02946200
|
|
SUBROUTINE SCALE; 02946300
|
|
BEGIN IF DTOG THEN 02946400
|
|
BEGIN IF T1 } 0 02946500
|
|
THEN DOUBLE(WH1,WH2,TEN[T1],TEN[T1+69],|,~,WH1,WH2) 02946600
|
|
ELSE DOUBLE(WH1,WH2,TEN[-T1],TEN[69-T1],/,~,WH1,WH2); 02946700
|
|
IF WH1 } TEN[DT] THEN 02946800
|
|
BEGIN 02946900
|
|
EXP ~ EXP + 1; 02947000
|
|
DOUBLE(WH1,WH2,TEN[1],0,/,~,WH1,WH2); 02947100
|
|
END 02947200
|
|
END ELSE WH1 ~ IF T1 } 0 THEN WH1|TEN[T1] ELSE WH1/TEN[-T1]; 02947300
|
|
END SCALE; 02947400
|
|
%************** S T A R T O F EDIT-CONTROL*****************%02947500
|
|
SUBROUTINE CONVERT; 02947600
|
|
BEGIN 02947700
|
|
DTOG ~ GTOG ~ FALSE; 02947800
|
|
SGN ~WH1.[1:1]; IF CODE < LTYPE THEN WH1 ~ ABS(WH1); WT ~ W; DT ~ D; 02947900
|
|
DH1 ~ DH2 ~ DH3 ~ ZEROS ~EXP ~ SKP ~ SHFT ~ D1 ~ D2 ~ D3 ~ 0; 02948000
|
|
GO TO P(CODE,DUP,ADD); 02948100
|
|
GO TO FMERR; 02948200
|
|
GO TO G; 02948300
|
|
GO TO F; 02948400
|
|
GO TO E; 02948500
|
|
GO TO DC; 02948600
|
|
GO TO I; 02948700
|
|
GO TO L; 02948800
|
|
GO TO A; 02948900
|
|
GO TO O; 02949000
|
|
O: COMMENT OCTAL CONVERSION * * * * * * * * * ; 02949100
|
|
IF W > 16 THEN SKP ~ W - (WT ~ 16); 02949200
|
|
STREAM(P1 ~ BUFF:P2 ~ WH1,P3 ~ SKP,P4 ~ WT,P5 ~ 16-WT); 02949300
|
|
BEGIN SI ~ LOC P2; DI ~ P1; 02949400
|
|
DI ~ DI + P3; P5(SKIP 3 SB); 02949500
|
|
P4(DS ~ 3 RESET; 3(IF SB THEN DS ~ SET 02949600
|
|
ELSE DS ~ RESET; SKIP SB)); 02949700
|
|
P1 ~ DI; 02949800
|
|
END; 02949900
|
|
BUFF ~ P; 02950000
|
|
GO TO COMM; 02950100
|
|
A: COMMENT ALPHA CONVERSION * * * * * * * * * ; 02950200
|
|
IF W > 6 THEN SKP ~ W - (WT ~ 6); 02950300
|
|
AA: STREAM(P1 ~ BUFF:P2 ~ WH1,P3 ~ SKP, P4 ~ WT); 02950400
|
|
BEGIN DI ~ P1; DI ~ DI + P3; 02950500
|
|
SI ~ LOC P2; SI ~ SI + 2; 02950600
|
|
DS ~ P4 CHR; P1 ~ DI; 02950700
|
|
END; 02950800
|
|
BUFF ~ P; 02950900
|
|
GO TO COMM; 02951000
|
|
L: COMMENT LOGICIAL CONVERSION; 02951100
|
|
IF W >1 THEN SKP~W-(WT~1); 02951200
|
|
WH1~ 0&(IF WH1 THEN "T" ELSE "F")[12:42:6]; 02951300
|
|
GO TO AA; 02951400
|
|
I: COMMENT INTEGER CONVERSION; 02951500
|
|
IF WH1=0 AND WH2=0 THEN DT ~ D3 ~ 1 ELSE 02951600
|
|
BEGIN IF DTOG THEN 02951700
|
|
DOUBLE(WH1,WH2,,.5,+,~,WH1,WH2) % ROUND OFF 02951800
|
|
ELSE WH1 ~ T1 ~ WH1; 02951900
|
|
IF WH1=0 AND WH2=0 THEN EXP~-1 ELSE FINDE ; 02952000
|
|
IF EXP < 0 THEN DT ~ D3 ~ 1 ELSE 02952100
|
|
BEGIN 02952200
|
|
IF (DLN AND EXP}24) OR (NOT DLN AND EXP}12) THEN GO AST; 02952300
|
|
DT ~ EXP+1; SETD; NUMCONVERT; 02952400
|
|
END; 02952500
|
|
END; 02952600
|
|
IF DT + SGN > W THEN GO TO AST; 02952700
|
|
IF W > DT + SGN THEN SKP ~ W - DT - SGN; 02952800
|
|
STREAM(P1~0:P2 ~ D1,P3 ~ DH1,P4 ~ D2,P5 ~ DH2, 02952900
|
|
P6 ~ D3,P7 ~ DH3,P8 ~ SGN,P9 ~ SKP,P10 ~ BUFF); 02953000
|
|
BEGIN DI ~ P10; P9(DI ~ DI + 1); 02953100
|
|
P8(DS ~ LIT "-"); 02953200
|
|
SI ~LOC P3; DS ~ P2 DEC; 02953210
|
|
SI ~ LOC P5; DS ~ P4 DEC; 02953300
|
|
SI ~ LOC P7; DS ~ P6 DEC; 02953400
|
|
P1 ~ DI; 02953500
|
|
END; 02953600
|
|
BUFF ~ P; 02953700
|
|
GO TO COMM; 02953800
|
|
DC: COMMENT DOUBLE PRECISION CONVERT,SAME AS E CONVERT; 02953900
|
|
E: COMMENT E CONVERSION; 02954000
|
|
DTOG ~ TRUE; 02954100
|
|
SETD; 02954200
|
|
IF WH1=0 AND WH2 = 0 THEN 02954300
|
|
BEGIN 02954400
|
|
IF W < (D+6+ SGN) THEN GO TO AST; 02954500
|
|
FUNNYZERO; GO TO COMM; 02954600
|
|
END ELSE 02954700
|
|
BEGIN 02954800
|
|
FINDE; 02954900
|
|
IF PS { 0 THEN 02955000
|
|
BEGIN 02955100
|
|
IF (SKP ~ W - D - 5 - SGN) < 0 THEN GO TO AST; SETD; 02955200
|
|
IF (DT ~ DT + PS) < 0 THEN DT ~ 0; 02955300
|
|
T1 ~ EXP - DT; RNDOFF; 02955400
|
|
END ELSE 02955500
|
|
BEGIN 02955600
|
|
DT ~ DT + (SHFT ~ PS); SETD; 02955700
|
|
T1 ~ EXP - DT; RNDOFF; 02955800
|
|
IF W<(T1~DT+5+ SGN + ZEROS) THEN GO TO AST; 02955900
|
|
SKP~W-T1; 02956000
|
|
END; 02956100
|
|
T1~DT-1-EXP; SCALE; 02956200
|
|
NUMCONVERT; 02956300
|
|
EXP~EXP-PS; 02956400
|
|
END; 02956500
|
|
STREAM(P1 ~ 0:P2 ~ SKP,P3 ~ SGN,P4 ~ D1,P5 ~ DH1, 02956600
|
|
P6 ~ D2,P7 ~ DH2,P8 ~ D3,P9 ~ DH3,P10 ~ (DLN), 02956700
|
|
P11 ~ (EXP < 0),P12 ~ ABS(EXP),P13 ~ SHFT,P14 ~ ZEROS,P15 ~BUFF);02956800
|
|
BEGIN DI ~ P15; DI ~ DI + P2; P3(DS ~ LIT "-"); 02956900
|
|
P2 ~ DI; DS ~ LIT "."; 02957000
|
|
SI ~ LOC P5; DS ~ P4 DEC; 02957100
|
|
SI ~ LOC P7; DS ~ P6 DEC; 02957200
|
|
SI ~ LOC P9; DS ~ P8 DEC; 02957300
|
|
P14(DS ~ LIT " "); DS ~ LIT "E"; 02957400
|
|
P10(DI ~ DI - 1; DS ~ LIT "D"); 02957500
|
|
DS ~ LIT " " ; 02957600
|
|
P11(DI ~ DI - 1; DS ~ LIT "-"); 02957700
|
|
SI ~ LOC P12; DS ~ 2 DEC; 02957800
|
|
P1 ~ DI; 02957900
|
|
P13(DI ~ P2; SI ~ P2; SI ~ SI + 1; 02958000
|
|
DS ~ P13 CHR; DS ~ LIT "."; JUMP OUT TO X); X: 02958100
|
|
END; 02958200
|
|
BUFF ~ P; 02958300
|
|
GO TO COMM; 02958400
|
|
F: COMMENT F CONVERSION; 02958500
|
|
IF DTOG THEN 02958600
|
|
IF PS>0 02958700
|
|
THEN DOUBLE(WH1,WH2,TEN[PS],TEN[69+PS],|,~,WH1,WH2) 02958800
|
|
ELSE DOUBLE(WH1,WH2,TEN[-PS],TEN[69-PS],/,~,WH1,WH2) 02958900
|
|
ELSE WH1 ~ IF PS > 0 THEN WH1|TEN[PS] ELSE WH1/TEN[-PS]; 02959000
|
|
FA: IF WH1=0 AND WH2=0 THEN EXP~0 ELSE 02959100
|
|
BEGIN 02959200
|
|
T1 ~ -(DT+1); RNDOFF; 02959300
|
|
FINDE; 02959400
|
|
IF EXP<0 THEN EXP~0; 02959500
|
|
IF (T1~DT+EXP+1)> 12 THEN DT~DT-(ZEROS~T1-12); 02959600
|
|
T1 ~ DT; SCALE; 02959700
|
|
IF ABS(WH1) > MAX THEN 02959800
|
|
BEGIN 02959900
|
|
DT ~ DT - 1; ZEROS ~ ZEROS + 1; 02960000
|
|
T1 ~ -1; SCALE; 02960100
|
|
END; 02960200
|
|
END; 02960300
|
|
DT~DT + EXP +1; SETD; 02960400
|
|
IF W<(T1~D+2+ SGN + EXP) THEN GO TO AST; 02960500
|
|
SKP~W-T1; 02960600
|
|
NUMCONVERT; 02960700
|
|
STREAM(P1 ~ 0:P2 ~ SKP,P3 ~ SGN,P4 ~ D1,P5 ~ DH1, 02960800
|
|
P6 ~ D2,P7 ~ DH2,P8 ~ D3,P9 ~ DH3,P10 ~ ZEROS, 02960900
|
|
P11 ~ EXP,P12 ~ BUFF); 02961000
|
|
BEGIN DI ~ P12; DI ~ DI + P2; P3(DS ~ LIT "-"); 02961100
|
|
P2 ~ DI; DS ~ LIT "."; 02961200
|
|
SI ~ LOC P5; DS ~ P4 DEC; 02961300
|
|
SI ~ LOC P7; DS ~ P6 DEC; 02961400
|
|
SI ~ LOC P9; DS ~ P8 DEC; 02961500
|
|
P10(DS ~ LIT "0"); 02961600
|
|
P1 ~ DI; 02961700
|
|
P11(DI ~ P2; SI ~ P2; SI ~ SI + 1; DS ~ P11 CHR; 02961800
|
|
DS ~ LIT "."; JUMP OUT TO X); X: 02961900
|
|
END; 02962000
|
|
BUFF ~ P; 02962100
|
|
IF GTOG THEN GO TO GA; 02962200
|
|
GO TO COMM; 02962300
|
|
G: COMMENT G CONVERSION; 02962400
|
|
GTOG ~ TRUE; 02962500
|
|
IF WH1=0 AND WH2=0 THEN EXP~0 ELSE FINDE; 02962600
|
|
IF (GTOGA~W-D-SGN>4) THEN 02962610
|
|
IF EXP< (-1) THEN GO TO E; 02962700
|
|
IF (T1~D-EXP-1)<0 AND GTOGA THEN GO TO E; 02962800
|
|
WT ~ D; W ~ W-4; 02962900
|
|
D ~ DT ~ T1; 02963000
|
|
GO TO FA; 02963100
|
|
GA: 02963200
|
|
STREAM(P1 ~ 0:P2 ~ BUFF); 02963300
|
|
BEGIN DI ~ P2; DI ~ DI + 4; P1 ~ DI; END; 02963400
|
|
BUFF ~ P; 02963500
|
|
W ~ W + 4; D ~ WT; 02963600
|
|
GO TO COMM; 02963700
|
|
AST: 02963800
|
|
STREAM(P1 ~ 0:P2 ~ BUFF,P3 ~ W); 02963900
|
|
BEGIN DI ~ P2; P3(DS ~ LIT "*"); P1 ~ DI; END; 02964000
|
|
BUFF ~ P; 02964100
|
|
IF GTOG THEN GO TO GA; 02964150
|
|
COMM: 02964200
|
|
END CONVERT; 02964300
|
|
COMMENT * * * * * * * * * * END OF DECLARATIONS * * * * * * * * * * * ; 02964400
|
|
IF EDITCODE=0 OR EDITCODE=2 OR EDITCODE=4 THEN 02964405
|
|
BEGIN 02964410
|
|
P(MKS,FILX,DKADR) ; 02964415
|
|
IF EDITCODE=4 THEN P(FI,FMTA,INTCALL(*P(.LISX),@155)) 02964420
|
|
ELSE P((-1),FMTA,*P(.LISX),EDITCODE,0,INTCALL(0,@160)) ; 02964425
|
|
P(XIT) ; 02964430
|
|
END ; 02964435
|
|
IF EDITCODE=6 THEN GO ZAP; 02964450
|
|
FIB ~ FILX[NOT 2]; % OPEN FILE IF NOT OPEN 02964500
|
|
IF DKADR < 0 THEN BEGIN FLG ~ 1; DKADR ~0 END; 02964510
|
|
IF FIB[5].[43:1] THEN P(MKS,0,0,FILX,1,SELECT); 02964600
|
|
PRNTR~2|(FIB[5].[41:2]!0) ; %%% IFF FILE IS CLOSED, SETS PRNTR.[46:1]=1.02964610
|
|
CKPB; ARRAYSTUFF ~ 0; 02964700
|
|
IF FIB[0] = 0 THEN 02964710
|
|
FIB[0] ~ 1 + (EDITCODE =0 OR EDITCODE =2) 02964720
|
|
ELSE 02964730
|
|
IF FIB [0] !1 + (EDITCODE =0 OR EDITCODE = 2) 02964740
|
|
THEN P(MKS,FIB[6],FILX.[33:15],4,FORTERR); 02964750
|
|
IF PRNTR THEN STREAM(TPAR); DS~8LIT" " ; 02964765
|
|
GO TO P(EDITCODE,DUP,ADD); 02964800
|
|
GO TO NOFL; % NO FORMAT, NO LIST 02964900
|
|
GO TO FNOL; % FORMAT, NO LIST 02965000
|
|
GO TO BINARY; % NO FORMAT, LIST 02965100
|
|
GO TO FMTLST; % FORMAT, LIST 02965200
|
|
NOFL: 02965400
|
|
P(XIT) ; 02965500
|
|
FNOL: 02965700
|
|
LSTRN~-1; 02965800
|
|
GO TO FRMTCD; 02965900
|
|
NMLST: 02966000
|
|
P(XIT); 02966100
|
|
BINARY: 02971000
|
|
P(XIT) ; 02971100
|
|
FMTLST: 02973100
|
|
LSTRN ~ 1; 02973200
|
|
CTOG ~ DONETOG ~ FALSE; 02973300
|
|
GETLIST; 02973400
|
|
FRMTCD: 02973500
|
|
PS ~ 0; 02973600
|
|
NFCI ~ (FI|8) + 2; % FIRST FORMAT CHARACTER 02973700
|
|
IF NOT(NFC="(" OR CHR="%") THEN GO TO FMERR ; 02973800
|
|
NFCI ~ (FI|8) + 2; 02973900
|
|
NFPH: FORMATCONTROL; % ANAYLSIS OF FORMAT STATEMENT 02974000
|
|
IF FMERRTOG THEN GO TO FMERR; 02974100
|
|
FMCYC: IF(DONETOG ~ ENDLIST) THEN 02974200
|
|
IF EDITCODE=6 THEN GO ZIPIT ELSE PRNT; 02974250
|
|
IF W + NCR > LCR THEN GO TO FMERR; 02974300
|
|
NCR ~ W + NCR; 02974500
|
|
CONVERT; 02974600
|
|
GETLIST; 02974700
|
|
IF (RPT~RPT-1) > 0 THEN GO TO FMCYC; 02974800
|
|
IF EDITCODE=6 THEN GO ZIPIT ELSE 02974850
|
|
GO TO NFPH; 02974900
|
|
ZAP:RPT~27;CODE~ATYPE;W~WT~6;D~0;BUFF~TPAR.[33:15];GETLIST; 02974950
|
|
LCR~168; GO FMCYC; 02974953
|
|
ZIPIT: STREAM(P1~BUFF); BEGIN DI~P1; DS~ 5 LIT ";END."; END; 02974954
|
|
P(.TPAR,LOD,4,COM,DEL); 02974956
|
|
BUFF ~ TPAR.[33:15]; 02974958
|
|
STREAM(P1~BUFF);BEGIN DI~P1; 17(DS ~ 8 LIT " ");END; 02974960
|
|
P(XIT); 02974962
|
|
FMERR: 02975000
|
|
P(MKS,FIB[6],FILX.[33:15],0,FORTERR); 02975100
|
|
TYPERR: 02975200
|
|
P(MKS,FIB[6],FILX.[33:15],2,FORTERR); 02975210
|
|
END FTOUT; 02975300
|
|
PROCEDURE FORTRANFREEWRITE(FILX,DKADDR,R,W,LISX,NI,NAMS,SUBS) ;%INT @15302976020
|
|
VALUE DKADDR,R,LISX,W,NI; INTEGER R,W; REAL DKADDR,LISX,NI ; 02976035
|
|
ARRAY SUBS[*], NAMS[*]; NAME FILX ; 02976050
|
|
BEGIN 02976065
|
|
02976080
|
|
INTEGER LSTRN=19, E, CHR, MAXCHR, PRNTR, TYPE, INDX, SIZE, 02976095
|
|
WDTH, MAXWDTH, SGN, CC ; 02976110
|
|
02976125
|
|
REAL LISTYPE=20, ARRAYSTUFF=18, ALGOLWRITE=12, SELECT=14, T1, NID, 02976140
|
|
T2, FORTERR=24, BUFF, BSIZE, FLG, WH1=R, D, WH2, ARY, T3, WH1S,02976155
|
|
RNDUP=9, MNTSSA=17, FNR, FNL, ENR, MS3, DECPT, LSS1, SVMAXWDTH,02976170
|
|
GTRMI, WH3, HALF, TRZ, NN1, TWDT, VH=-1, VL=-2, TIPE=-4 ; 02976185
|
|
02976200
|
|
NAME LISTADDR ; 02976215
|
|
02976230
|
|
ARRAY TEN=22[*], AR1=LISTADDR[*], TPAR=23[*], FPB=3[*], FIB[*] ; 02976245
|
|
02976260
|
|
LABEL BACK, START, ITYPE, ALIST, TRU, FALS, TWOPT5, MAXI, SETUP, 02976275
|
|
LOG8, FTYPE, ETYPE, FUNNYE, CHOOSEI, OVRFLW, FIVEPT, GET3, 02976290
|
|
HUNT, ZERO, HLF, NOFIT, GOTOQ, ZEROES, FITYPE, ETYPE2, Q, 02976305
|
|
ETYPE1, DFTYPE, DTYPE, BUMPWH3, THREL, THREH, MAXWDTHOF1, Q1, 02976320
|
|
MAXI1 ; 02976321
|
|
02976335
|
|
DEFINE DONE = (LSTRN=(-1)) #, 02976350
|
|
REEL = 3 #, 02976365
|
|
LOGICAL = 4 #, 02976380
|
|
INTEGR = 1 #, 02976395
|
|
DBLPREC = 5 #, 02976410
|
|
COMPLEXR = 6 #, 02976425
|
|
COMPLEXI = 7 #, 02976440
|
|
MAYBE(MAYBE1,MAYBE2,MAYBE3) = CI~CI+MAYBE1; GO TO MAYBE2 ; 02976455
|
|
DS~LIT MAYBE3; MAYBE2: #, 02976470
|
|
TWOD = LISTYPE.[38:1] #, 02976485
|
|
INDXF = [18:15] #, 02976500
|
|
TYPEF = [44:4] #, 02976515
|
|
SIZEF = [33:15] # ; 02976530
|
|
02976545
|
|
SUBROUTINE GETWDTH ; 02976560
|
|
WDTH~((FNR~E+RNDUP)<FNL~0)+1+GTRMI~1+(ABS(FNR)>9) ; 02976575
|
|
02976590
|
|
REAL SUBROUTINE FTEST ; 02976605
|
|
FTEST~P(XCH)+(FNR~T2-FNL~FNL-LSS1)<(-E) OR FNR<0 ; 02976620
|
|
02976635
|
|
REAL SUBROUTINE NXTELM ; 02976650
|
|
BEGIN 02976665
|
|
P(IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX.[40:8],COC) 02976680
|
|
ELSE AR1[INDX]) ; 02976695
|
|
INDX~INDX+1; NXTELM~P ; 02976710
|
|
END OF NXTLLM ; 02976725
|
|
02976740
|
|
SUBROUTINE COUNTZ ; 02976755
|
|
BEGIN 02976770
|
|
T3~0 ; 02976785
|
|
HUNT: IF LISTYPE MOD TEN[T3~T3+3]=0 THEN GO HUNT ; 02976800
|
|
IF LISTYPE MOD TEN[T1~T3-1]!0 02976815
|
|
THEN T1~T1-1-(LISTYPE MOD TEN[T1-1]!0) ; 02976830
|
|
END OF COUNTZ ; 02976845
|
|
02976860
|
|
REAL SUBROUTINE USEXPNOTATION ; 02976875
|
|
BEGIN 02976890
|
|
FNL~IF LSS1 THEN P((-E),1) ELSE P(0,E+1) ; 02976905
|
|
IF (FNR~P+ENR-FNL-T1){0 THEN FNR~1 ; 02976920
|
|
USEXPNOTATION~(FNR+FNL>1+(ENR~ENR-T1)+((DECPT~1)+T3~(-1>E)+ 02976935
|
|
(ABS(E+1)>9))+(TRZ OR LSS1) AND (ABS(E)}4 OR 02976950
|
|
FNL+FNR>MS3+2)) OR (ENR+T3{MS3 AND ABS(E)}5) ; 02976965
|
|
END OF USEXPNOTATION ; 02976980
|
|
02976995
|
|
SUBROUTINE ROUNDANDSPLIT ; 02977010
|
|
BEGIN 02977025
|
|
T1~T2~LISTYPE~0; T3~RNDUP+7 ; 02977040
|
|
IF (MNTSSA~GTRMI-7-RNDUP) LSS 0 THEN 02977055
|
|
BEGIN 02977070
|
|
P(WH3/TEN[-MNTSSA]-1,.WH3,ISD); T3~GTRMI ; 02977085
|
|
BUMPWH3: IF (WH3~WH3+1)=TEN[T3] THEN E~(LISTYPE~1)+E ; 02977100
|
|
END 02977115
|
|
ELSE IF MNTSSA LSS 8 THEN 02977130
|
|
BEGIN 02977145
|
|
IF P(WH2/TEN[8-T2~MNTSSA],.WH2,ISN)=TEN[MNTSSA] 02977160
|
|
THEN GO BUMPWH3 ; 02977175
|
|
END 02977190
|
|
ELSE IF P(WH1/TEN[16-MNTSSA],.WH1,ISN)=TEN[T1~MNTSSA-T2~8] 02977205
|
|
THEN IF (WH2~WH2+1)=TEN[8] THEN GO BUMPWH3 ; 02977220
|
|
END OF ROUNDANDSPLIT ; 02977235
|
|
02977250
|
|
SUBROUTINE OUTPUT ; 02977265
|
|
BEGIN 02977280
|
|
IF PRNTR THEN 02977295
|
|
BEGIN 02977310
|
|
FIB[17]~FIB[17]+BSIZE ; 02977325
|
|
P(MKS,2,0,CC,BSIZE,FILX,ALGOLWRITE) ; 02977340
|
|
IF NOT(*FILX).[1:19] 02977355
|
|
$ SET OMIT = TIMESHARING 02977370
|
|
$ SET OMIT = NOT(TIMESHARING ) 02977400
|
|
THEN IF FIB[4].[8:4]!10 02977415
|
|
THEN P(FILX,@2000000000,36,COM,DEL,DEL) ; 02977430
|
|
$ POP OMIT 02977431
|
|
END 02977445
|
|
ELSE IF NOT CC THEN P(MKS,FLG,DKADDR,0,BSIZE,FILX,ALGOLWRITE) ;02977460
|
|
P(MKS,FLG,DKADDR,CHR~0,(-1),FILX,ALGOLWRITE,DEL) ; 02977475
|
|
IF PRNTR THEN FIB[17]~FIB[17]-BSIZE ; 02977490
|
|
STREAM(BS~BSIZE-1,B~P(DUP).[36:6],BUF~BUFF~(*FILX).[33:15]) ; 02977505
|
|
BEGIN 02977520
|
|
DS~8LIT" "; SI~BUF; DS~BS WDS; B(DS~32WDS; DS~32WDS) ; 02977535
|
|
END ; 02977550
|
|
END OF OUTPUT ; 02977565
|
|
02977580
|
|
SUBROUTINE CHECKBUMPANDSKIP ; 02977595
|
|
BEGIN 02977610
|
|
IF P(W+MAXWDTH-WDTH,DUP){0 THEN P(DEL,0) ; 02977625
|
|
IF P(P(DUP)+WDTH+2+SVMAXWDTH-MAXWDTH,DUP)+CHR>MAXCHR 02977640
|
|
THEN OUTPUT ; 02977655
|
|
CHR~P+CHR ; 02977670
|
|
STREAM(SKP~LSS1~P:L~LSS1.[36:6],BUFF) ; 02977685
|
|
BEGIN DI~DI+SKP; L(DI~DI+32; DI~DI+32); SKP~DI END ; 02977690
|
|
BUFF~P ; 02977695
|
|
IF NID!NI THEN 02977700
|
|
BEGIN 02977715
|
|
STREAM(N~(LSS1~NAMS[NID]).[9:3]:LSS1,T~(NN1}0),BUFF) ; 02977730
|
|
BEGIN 02977745
|
|
SI~LOC LSS1; SI~SI+2; DS~N CHR; MAYBE(T,L,"("); N~DI;02977760
|
|
END ; 02977775
|
|
BUFF~P ; 02977790
|
|
FOR MS3~0 STEP 1 UNTIL NN1 DO 02977805
|
|
BEGIN 02977820
|
|
STREAM(N~SUBS[MS3].[15:3]:Q~SUBS[MS3].[33:15],BUFF) ;02977835
|
|
BEGIN SI~LOC Q; DS~N DEC; DS~LIT","; N~DI END ; 02977850
|
|
BUFF~P ; 02977865
|
|
END ; 02977880
|
|
STREAM(T~(NN1}0):R~TYPE=COMPLEXR,I~TYPE=COMPLEXI,BUFF) ; 02977895
|
|
BEGIN 02977910
|
|
CI~CI+T; GO TO L; DI~DI-1; DS~LIT")"; L: 02977925
|
|
CI~CI+R; GO TO L1; DS~2LIT"-R"; L1: 02977940
|
|
CI~CI+I; GO TO L2; DS~2LIT"-I"; L2: DS~LIT"="; T~DI ;02977955
|
|
END ; 02977970
|
|
BUFF~P ; 02977985
|
|
END ; 02978000
|
|
END OF CHECKPUMPANDSKIP ; 02978030
|
|
02978045
|
|
SUBROUTINE BASICONVERT ; 02978060
|
|
BEGIN 02978075
|
|
IF TYPE!DBLPREC THEN 02978090
|
|
BEGIN T3~0 ; 02978105
|
|
IF E>8 THEN BEGIN WH2~WH1 DIV TEN[8]; T2~E-T1~8 END 02978120
|
|
ELSE BEGIN T2~0; T1~E END ; 02978135
|
|
END ; 02978150
|
|
WDTH~WDTH+T1+T2+T3+SGN+DECPT ; 02978165
|
|
CHECKBUMPANDSKIP ; 02978180
|
|
STREAM(WH3:WH2,WH1,T3,T2,T1,FNL,DECPT,ENR,SGN,TRZ,BUFF) ; 02978195
|
|
BEGIN 02978210
|
|
MAYBE(SGN,L1,"-"); SGN~DI ; 02978215
|
|
DI~DI+DECPT; ENR(DS~LIT"0"); SI~LOC WH3; DS~T3 DEC ; 02978225
|
|
SI~LOC WH2; DS~T2 DEC; SI~LOC WH1; DS~T1 DEC ; 02978240
|
|
TRZ(DS~LIT"0"); WH3~DI; CI~CI+DECPT; GO TO L ; 02978255
|
|
SI~SGN; SI~SI+1; DI~SGN; DS~FNL CHR; DS~LIT"."; L: 02978270
|
|
END ; 02978285
|
|
P(XCH) ; 02978300
|
|
END OF BASICONVERT ; 02978315
|
|
02978330
|
|
SUBROUTINE FINDE ; 02978345
|
|
E~(0&T1[42:3:6]&T1[1:2:1]+12+P(HLF))|P(LOG8) ; 02978360
|
|
02978375
|
|
SUBROUTINE GETW ; 02978390
|
|
IF (T1~P(XCH))}W~MAXCHR/R-P(TWOPT5) THEN W~T1 02978405
|
|
ELSE IF (T1~IF NAMS=0 THEN 30 ELSE P(NAMS[NI],DUP)|6+(P(XCH)>0)02978420
|
|
+37)<W THEN MAXCHR~((W~T1)+2)|R ; 02978435
|
|
02978450
|
|
%************************:: CODE STARTS HERE ::************************%02978465
|
|
02978480
|
|
HALF~P(HLF) ; 02978485
|
|
IF NI<0 THEN 02978487
|
|
BEGIN % SPLCIAL SINGLE EDIT. 02978489
|
|
BUFF~R; NID~NI; WH1~VH; WH2~VL ; 02978491
|
|
IF (TYPE~IF TIPE=2 THEN IF VL=0 THEN IF ABS(VH){P(MAXI1) THEN 02978493
|
|
IF P(VH,.TYPE,ISN)=VH THEN 1 ELSE 3 ELSE 3 ELSE 5 ELSE TIPE)<0 02978495
|
|
OR TYPE>5 THEN DO UNTIL FALSE ; 02978497
|
|
W~(W~ABS(W))-SVMAXWDTH~MAXWDTH~IF W!0 THEN W ELSE 62 ; 02978499
|
|
MAXCHR~64; GO Q1 ; 02978501
|
|
END ; 02978503
|
|
FIB~FILX[NOT 2]; IF DKADDR<0 THEN BEGIN FLG~1; DKADDR~0 END ; 02978510
|
|
D~IF R.[1:1] THEN "," ELSE " "; R~ABS(R) ; 02978525
|
|
IF FIB[5].[43:1] THEN P(MKS,0,0,FILX,1,SELECT) ; 02978540
|
|
CC~(FIB[5] AND 96)!0 ; 02978555
|
|
P(MKS,FLG,DKADDR,0,(-1),FILX,ALGOLWRITE) ; 02978560
|
|
IF P(*[FIB[14]],TOP) THEN P(DEL) 02978565
|
|
ELSE P((T1~(*(4 INX P(XCH))).[36:6])!0 AND T1!8 AND T1!9,SUB) ; 02978570
|
|
MAXCHR~P(BSIZE~P)|8 ; 02978575
|
|
IF PRNTR~((T1~FIB[4].[8:4])=1 OR T1=7 OR T1=12) AND FPB[FIB[4] 02978585
|
|
.[13:11]+3].[43:5]<20 THEN 02978590
|
|
BEGIN IF BSIZE>16 THEN BEGIN MAXCHR~132; BSIZE~17 END; END 02978600
|
|
ELSE CC~1 ; 02978615
|
|
OUTPUT ; 02978630
|
|
IF (CC~0)=FIB[0] THEN FIB[0]~1 ; 02978645
|
|
IF (LSTRN~1)!FIB[0] AND T1=2 02978660
|
|
THEN P(MKS,FIB[7],FILX.[33:15],4,FORTERR) ; 02978661
|
|
MAXWDTH~MAXCHR-2 ; 02978675
|
|
IF (W~ABS(W))!0 THEN 02978690
|
|
BEGIN 02978705
|
|
IF W>MAXWDTH THEN W~MAXWDTH ELSE MAXWDTH~W ; 02978720
|
|
IF R!0 THEN BEGIN P(MAXWDTH); GETW END ; 02978735
|
|
END 02978750
|
|
ELSE IF R!0 THEN BEGIN P(1); GETW; MAXWDTH~W END ; 02978765
|
|
W~W-SVMAXWDTH~MAXWDTH ; 02978780
|
|
GO START ; 02978795
|
|
HLF::: 0.5 ; 02978810
|
|
LOG8::: 0.90308998709 ; 02978825
|
|
TWOPT5:::2.4999999999 ; 02978840
|
|
MAXI1::: @0007777777777777 ; 02978842
|
|
BACK:: 02978855
|
|
BUFF~P; IF NI<0 THEN P(BUFF,RTN); TYPE~ABS(TYPE) ; 02978870
|
|
STREAM(D:BUFF); BEGIN SI~LOC D; SI~SI+7; DS~CHR; DI~DI+1; D~DI END ;02978885
|
|
BUFF~P ; 02978900
|
|
START: 02978915
|
|
IF ARY THEN 02978930
|
|
BEGIN 02978945
|
|
ALIST: WH1~NXTELM ; 02978960
|
|
IF NID!NI THEN 02978975
|
|
BEGIN 02978990
|
|
P(INDX-ARRAYSTUFF.INDXF) ; 02979005
|
|
IF TYPE}DBLPREC THEN P((P+1) DIV 2); T2~P ; 02979020
|
|
IF TYPE}COMPLEXR THEN TYPE~COMPLEXR+(TYPE=COMPLEXR) ; 02979035
|
|
FOR T1~NN1 STEP -1 UNTIL 0 DO 02979050
|
|
BEGIN 02979065
|
|
SUBS[T1].[33:15]~1+(T2-1) DIV (MS3~SUBS[T1].[18:15]);02979080
|
|
IF (T2~T2 MOD MS3)=0 THEN T2~MS3 ; 02979095
|
|
END ; 02979110
|
|
END ; 02979125
|
|
IF TYPE=DBLPREC THEN WH2~NXTELM; ARY~INDX<SIZE ; 02979140
|
|
END 02979155
|
|
ELSE IF TYPE=COMPLEXR THEN BEGIN WH1~LISTADDR[1]; TYPE~COMPLEXI END 02979170
|
|
ELSE BEGIN 02979185
|
|
P(ARRAYSTUFF~0); LISTADDR~[LISX]; TYPE~LISTYPE.TYPEF ; 02979200
|
|
IF (NID~ARRAYSTUFF.[3:15]+NI)!NI 02979215
|
|
THEN NN1~NAMS[NID].[1:8]-1 ; 02979230
|
|
IF ARY~ARRAYSTUFF.[18:30]!0 THEN 02979245
|
|
BEGIN 02979260
|
|
IF NID!NI THEN 02979275
|
|
BEGIN 02979290
|
|
SUBS[0].[18:15]~T1~1 ; 02979305
|
|
FOR T2~1 STEP 1 UNTIL NN1 DO SUBS[T2].[18:15]~T102979320
|
|
~T1|SUBS[T2-1].[33:15];02979335
|
|
END ; 02979350
|
|
IF TYPE=COMPLEXR THEN TYPE~COMPLEXI ; 02979365
|
|
SIZE~(INDX~ARRAYSTUFF.INDXF)+ARRAYSTUFF.SIZEF ; 02979380
|
|
P(LISTADDR~MEM[LISTADDR.[18:15]]) ; 02979395
|
|
TWDT~NOT P(LOD,TOP); P(DEL) ; 02979410
|
|
GO ALIST ; 02979425
|
|
END ; 02979440
|
|
WH1~LISTADDR[0]; P(DEL) ; 02979455
|
|
IF TYPE=DBLPREC THEN WH2~LISTADDR[1] ; 02979470
|
|
END ; 02979485
|
|
IF DONE THEN 02979500
|
|
BEGIN 02979515
|
|
STREAM(TPAR); 18(DS~8LIT" ") ; 02979530
|
|
IF NOT PRNTR THEN P(MKS,FLG,DKADDR,0,BSIZE,FILX,ALGOLWRITE) ; 02979545
|
|
P(XIT) ; 02979560
|
|
END ; 02979575
|
|
MAXWDTH~SVMAXWDTH ; 02979590
|
|
IF NID!NI THEN 02979605
|
|
BEGIN 02979620
|
|
T3~(NN1}0)+(NAMS[NID].[9:3])+2+NN1+P(ABS(TYPE)}COMPLEXR,DUP,+);02979635
|
|
FOR T1~NN1 STEP -1 UNTIL 0 DO 02979650
|
|
BEGIN T2~0; MS3~SUBS[T1].[33:15] ; 02979665
|
|
WHILE TEN[T2]{MS3 DO T2~T2+1 ; 02979680
|
|
T3~T3+T2; SUBS[T1].[15:3]~T2 ; 02979695
|
|
END ; 02979710
|
|
IF (MAXWDTH~MAXWDTH-T3){0 THEN GO OVRFLW ; 02979725
|
|
END ; 02979740
|
|
Q1: IF TYPE=LOGICAL THEN 02979755
|
|
BEGIN 02979770
|
|
IF (WDTH~7-WH1~WH1 AND 1)>MAXWDTH THEN WDTH~MAXWDTH ; 02979785
|
|
CHECKBUMPANDSKIP ; 02979800
|
|
STREAM(S~IF WH1 THEN P(TRU) ELSE P(FALS):Z~T1~WDTH>1, 02979815
|
|
Q~T2~WDTH>2,WDTH~WDTH-T1-T2,F~3+WH1,BUFF) ; 02979830
|
|
BEGIN 02979845
|
|
SI~LOC S; SI~SI+F; MAYBE(Z,L1,".") ; 02979860
|
|
DS~WDTH CHR; MAYBE(Q,L2,"."); S~DI ; 02979875
|
|
END ; 02979890
|
|
GO BACK ; 02979905
|
|
END OF LOGICAL ; 02979920
|
|
SGN~WH1.[1:1] ; 02979935
|
|
Q: IF T3~NOT (GTRMI~ABS(WH1)>P(MAXI)) AND TYPE=INTEGR 02979950
|
|
THEN P(WH1,.WH1,ISD) ; 02979965
|
|
T2~(MS3~MAXWDTH-3-SGN)+2; WH1~ABS(WH1) ; 02979980
|
|
IF TYPE=DBLPREC THEN 02979995
|
|
BEGIN 02980010
|
|
WH1~T1~P(WH2,WH1,0,TEN[0],DLM); WH2~P ; 02980025
|
|
IF WH1=0 THEN BEGIN TYPE~-DBLPREC; GO ZERO END; FINDE ; 02980040
|
|
IF MAXWDTH<7 02980055
|
|
THEN P(WH2,WH1,HALF,(NOT P(MAXI)) AND WH1,DLA,.WH1S,~,DEL) ; 02980070
|
|
IF LSS1~E LSS 0 THEN P(0,TEN[0],TEN[69-E],TEN[-E],DLD) 02980085
|
|
ELSE P(TEN[69+E],TEN[E]) ; 02980100
|
|
T1~P; T3~P ; 02980115
|
|
IF T1 GEQ WH1 THEN IF T1>WH1 OR T3>WH2 THEN E~E-1 ; 02980130
|
|
ENR~24 ; 02980145
|
|
P(WH2,WH1,TEN[69+ABS(E)],TEN[ABS(E)],IF LSS1~E LSS 0 THEN 02980160
|
|
P(DLM) ELSE P(DLD)) ; 02980175
|
|
T1~P; T3~P ; 02980190
|
|
IF T1}P(THREH) THEN IF T1>P(THREH) OR T3>P(THREL) THEN ENR~23 ;02980205
|
|
P(WH2,WH1,TEN[(T1~ABS(ENR-E-1))+69],TEN[T1],IF ENR{E THEN 02980220
|
|
P(DLD) ELSE P(DLM)) ; 02980235
|
|
WH1~P; RNDUP~ENR=24 ; 02980250
|
|
P(T3~P,WH1,TEN[85],TEN[16],DLD,HALF,-,.WH3,ISD,DEL,T3,WH1,0,WH302980265
|
|
,TEN[85],TEN[16],DLM,DLS) ; 02980280
|
|
WH1~P ; 02980295
|
|
P(T3~P,WH1,0,TEN[8],DLD,HALF,-,.WH2,ISD,DEL,T3,WH1,0,WH2,0,TEN[02980310
|
|
8],DLM,DLS,.WH1,ISD,DEL) ; 02980325
|
|
IF P(0,0)=LISTYPE~WH1 THEN 02980340
|
|
BEGIN P(DEL,8) ; 02980355
|
|
IF (LISTYPE~WH2)=0 THEN BEGIN P(DEL,16); LISTYPE~WH3 END ;02980370
|
|
END ; 02980385
|
|
COUNTZ; T1~P+T1 ; 02980400
|
|
IF USEXPNOTATION THEN 02980415
|
|
BEGIN 02980430
|
|
DTYPE: IF ENR+T3>MS3 THEN 02980445
|
|
IF E=T2 THEN BEGIN DECPT~FNR~0; GO DFTYPE END 02980460
|
|
ELSE IF (ENR~MS3-T3){0 THEN 02980475
|
|
GOTOQ: BEGIN WH1~WH1S; TYPE~-DBLPREC; GO Q END ; 02980490
|
|
GTRMI~ENR; ROUNDANDSPLIT ; 02980505
|
|
IF NOT (9!E OR T3!1) THEN GO GOTOQ ; 02980520
|
|
IF LISTYPE THEN P(TEN[(T3~T3+(IF LSS1 THEN -10=E ELSE -(9=02980535
|
|
E)))-1],.WH3,ISD) ; 02980550
|
|
RNDUP~1; GO ETYPE1 ; 02980565
|
|
MAXI::: @0007777777777777 ; 02980580
|
|
THREH::: @1143013331500045 ; 02980595
|
|
THREL::: @0003112121167260 ; 02980610
|
|
TRU::: "TRUE" ; 02980625
|
|
FALS::: "FALSE" ; 02980640
|
|
END ; 02980655
|
|
IF FNL+FNR{T2 THEN 02980670
|
|
BEGIN 02980685
|
|
DFTYPE: ENR~TRZ~0; T1~FNL ; 02980700
|
|
IF LSS1 THEN ENR~FNL-E-1 02980715
|
|
ELSE IF 23+RNDUP{FNL THEN 02980730
|
|
BEGIN TRZ~FNL+FNR-T1~23+RNDUP; FNR~0 END ; 02980745
|
|
GTRMI~T1+FNR-ENR; ROUNDANDSPLIT ; 02980760
|
|
IF LISTYPE THEN 02980775
|
|
BEGIN 02980790
|
|
IF DECPT THEN DECPT~FNR+TRZ}1 02980805
|
|
ELSE BEGIN 02980820
|
|
T1~T2~0; DECPT~WH3~T3~RNDUP~1; GETWDTH ; 02980835
|
|
IF (TRZ~-WDTH+WDTH~MS3+1){0 THEN GO GOTOQ ; 02980850
|
|
GO ETYPE2 ; 02980865
|
|
END ; 02980880
|
|
FNL~FNL+(E}0) ; 02980895
|
|
IF LSS1 THEN IF NOT (TRZ~(ENR~ENR-1)}0) THEN ENR~0 ; 02980910
|
|
IF T3<DECPT THEN GO GOTOQ ; 02980925
|
|
P(TEN[(T3~T3+1-DECPT)-1],.WH3,ISD) ; 02980940
|
|
END ; 02980955
|
|
FITYPE: WDTH~ENR+TRZ; BASICONVERT; GO BACK ; 02980970
|
|
END ; 02980985
|
|
P(WH3/TEN[RNDUP+6]>5); IF NOT FTEST THEN GO DFTYPE ; 02981000
|
|
GO DTYPE ; 02981015
|
|
END OF DBLPREC ; 02981030
|
|
IF MAXWDTH=1 THEN GO TO MAXWDTHOF1 ; 02981045
|
|
T1~TEN[0]|WH1 ; 02981060
|
|
IF E~WH1!0 THEN 02981075
|
|
BEGIN FINDE; E~E-((IF E>0 THEN TEN[E] ELSE 1/TEN[-E])>T1) END ;02981090
|
|
IF T3 AND E{T2 THEN 02981105
|
|
BEGIN E~E+1 ; 02981120
|
|
ITYPE: DECPT~0; GO SETUP ; 02981135
|
|
END ; 02981150
|
|
IF WH1=0 THEN 02981165
|
|
ZERO: BEGIN FNR~0; FNL~1; GO FTYPE END ; 02981180
|
|
RNDUP~(MNTSSA~P(WH1~T1,TEN[ABS(E)],IF LSS1~0>E THEN 02981195
|
|
P(|) ELSE P(/))) GEQ 5 ; 02981210
|
|
LISTYPE~P(WH1,TEN[ABS((ENR~12-(MNTSSA>P(FIVEPT)))-E-1)], 02981225
|
|
IF GTRMI THEN P(/) ELSE P(|)) ; 02981240
|
|
COUNTZ ; 02981255
|
|
IF GTRMI OR USEXPNOTATION THEN 02981270
|
|
BEGIN 02981285
|
|
IF ENR+T3 LEQ MS3 THEN 02981300
|
|
ETYPE: BEGIN 02981315
|
|
P(WH1) ; 02981330
|
|
IF NOT RNDUP~TYPE!INTEGR OR DECPT=0 THEN 02981345
|
|
BEGIN 02981360
|
|
ENR~P(E}10 AND (E~E-ENR){10,DUP)+1+ENR ; 02981375
|
|
DECPT~0; P(TEN[E~-P+E],/) ; 02981390
|
|
END 02981405
|
|
ELSE P(TEN[ABS(E+1-ENR)],IF E<ENR THEN P(|) ELSE P(/)) ; 02981420
|
|
P(.WH1,ISD) ; 02981435
|
|
IF WH1=TEN[ENR] THEN 02981450
|
|
BEGIN 02981465
|
|
IF (ENR~ENR+P(E+RNDUP,IF LSS1 THEN P=(-10) ELSE-(P=9)02981480
|
|
))<0 THEN ENR~DECPT~0 ; 02981495
|
|
E~E+1; P(TEN[ABS(ENR-1)],.WH1,ISD) ; 02981510
|
|
END ; 02981525
|
|
ETYPE1: IF P(RNDUP AND DECPT=0,DUP) THEN RNDUP~0 ; 02981540
|
|
GETWDTH ; 02981555
|
|
IF P THEN IF E=(-10) AND MNTSSA<1+HALF THEN ENR~0 02981570
|
|
ELSE DECPT~FNL~E=9 ; 02981585
|
|
IF MAXWDTH<SGN+DECPT+(E~ENR)+WDTH THEN 02981600
|
|
NOFIT: BEGIN IF NOT LSS1 THEN GO OVRFLW; GO ZEROES END ; 02981615
|
|
ENR~TRZ~0 ; 02981630
|
|
ETYPE2: BASICONVERT; BUFF~P ; 02981645
|
|
STREAM(GTRMI:FNR~ABS(FNR),S~FNR<0,C~IF ABS(TYPE)=DBLPREC 02981660
|
|
THEN "D" ELSE "E",BUFF) ; 02981675
|
|
BEGIN 02981690
|
|
SI~LOC C; SI~SI+7; DS~CHR; MAYBE(S,L,"-") ; 02981705
|
|
SI~LOC FNR; DS~GTRMI DEC; GTRMI~DI ; 02981720
|
|
END ; 02981735
|
|
GO BACK ; 02981750
|
|
FIVEPT::: 5.49755813885 ; 02981765
|
|
GET3: P(USEXPNOTATION,DEL) ; 02981780
|
|
END ; 02981795
|
|
FUNNYE: IF NOT(E!T2 OR GTRMI) THEN GO CHOOSEI ; 02981810
|
|
IF (ENR~MS3-T3)}1 THEN GO ETYPE; DECPT~0 ; 02981825
|
|
IF NOT ((ENR~MS3}T3) OR RNDUP OR MNTSSA<1+HALF) THEN GO NOFIT ;02981840
|
|
GO ETYPE ; 02981855
|
|
ZEROES: WH1~FNL~0; IF SGN AND MAXWDTH=2 THEN GO MAXWDTHOF1; FNR~T2 ; 02981870
|
|
FTYPE: P(WH1|TEN[FNR],.WH1,ISD); DECPT~1 ; 02981885
|
|
IF -2<E AND WH1=TEN[E~FNL+FNR] THEN 02981900
|
|
BEGIN FNL~FNL+1; P(TEN[(E~E+1-DECPT~FNR>0)-1],.WH1,ISD) END;02981915
|
|
SETUP: ENR~TRZ~0; GO FITYPE ; 02981930
|
|
END ; 02981945
|
|
IF FNR+FNL LEQ T2 THEN GO FTYPE ; 02981960
|
|
IF LSS1 AND SGN THEN IF MAXWDTH=2 THEN GO MAXWDTHOF1 ; 02981975
|
|
P(RNDUP); IF NOT FTEST THEN GO FTYPE ; 02981990
|
|
GO FUNNYE ; 02982005
|
|
MAXWDTHOF1: 02982020
|
|
E~0 ; 02982035
|
|
CHOOSEI: 02982050
|
|
IF NOT GTRMI THEN P(WH1,.WH1,ISD) ; 02982065
|
|
IF TEN[E~E+1]=WH1 THEN GO GET3 ; 02982080
|
|
IF P(MAXWDTH=1,DUP) THEN SGN~SGN AND WH1!0 ; 02982095
|
|
IF NOT (P AND (SGN OR WH1>9)) THEN GO ITYPE ; 02982110
|
|
OVRFLW: 02982125
|
|
WDTH~MAXWDTH; P(NID); NID~NI; CHECKBUMPANDSKIP; NID~P ; 02982140
|
|
STREAM(SVMAXWDTH:S~SVMAXWDTH.[36:6],BUFF) ; 02982155
|
|
BEGIN SVMAXWDTH(DS~LIT"|"); S(32(DS~2LIT"|"));SVMAXWDTH~DI END;02982160
|
|
GO BACK ; 02982170
|
|
END OF FORTRANFREEWRITE ; 02982185
|
|
PROCEDURE FINNAME; %154 02982500
|
|
BEGIN 02982520
|
|
COMMENT FILX FILE TOP IO DESCRIPTOR 02982540
|
|
FMTA FORMAT OR NAMELIST OR 0 02982560
|
|
LISX ACCIDENTAL ENTRY DESC. OR 0 02982580
|
|
; 02982600
|
|
REAL PARL = -1, 02982740
|
|
EOFL = -2, 02982760
|
|
FORTERR = 24, 02982780
|
|
LISX = -3, 02982820
|
|
FI = -5, 02982840
|
|
DKADR = -6, 02982860
|
|
READINT = 13, 02982880
|
|
SELECT = 14; 02982900
|
|
ARRAY FMTA = -4[*]; 02982920
|
|
NAME FILX = -7, 02982940
|
|
MEM = 2; 02982960
|
|
INTEGER JUNK1 = 17; 02982980
|
|
REAL LISTYPE = 20; 02983000
|
|
ARRAY PRTBASE = 10[*], 02983020
|
|
TEN = 22[*], 02983040
|
|
FIB[*]; 02983060
|
|
NAME LISTADR; 02983080
|
|
REAL BUFF , % FIRST BUFFER POSITION 02983100
|
|
BSIZE , % ARGUMENTS 02983120
|
|
NBC, 02983140
|
|
NLI,NLE,SBS, 02983160
|
|
NFCI, 02983180
|
|
DH1, 02983200
|
|
WH1 , % 02983220
|
|
WH2; 02983240
|
|
REAL NAMEV; 02983260
|
|
NAME W1; 02983280
|
|
INTEGER RPT, 02983300
|
|
W , % FIELD 02983320
|
|
WT , % WIDTH 02983340
|
|
T1 , % 02983360
|
|
D1 , % LA- 02983380
|
|
D2 , % CE- 02983400
|
|
CNT, 02983420
|
|
EXP , % EXPONENT 02983440
|
|
EXPSGN, 02983460
|
|
NCR , % CURRENT BUFFER POSITION 02983480
|
|
LCR , % BUFFER SIZE IN CHARACTERS 02983500
|
|
CHR ; 02983520
|
|
BOOLEAN DONETOG , % RETURN AFTER WRITE 02983540
|
|
SGN , % SIGN 02983560
|
|
LGTG, 02983580
|
|
DTAERR, 02983600
|
|
NLT, 02983620
|
|
NFL, 02983625
|
|
CTOG; 02983640
|
|
DEFINE LOGV = 4#, 02983660
|
|
INTEGV =1#, 02983680
|
|
DBLV = 5#, 02983700
|
|
CMPLXV = 6#, 02983720
|
|
SPC = 3#, 02983740
|
|
NUM = 2#, 02983760
|
|
ID = 1#, 02983780
|
|
KIND = (FIB[4].[8:4])#, 02983800
|
|
MAX = @7777777777777#, 02983820
|
|
ELMTYP = LISTYPE . [44:4]#, 02983840
|
|
DLN = (LISTYPE.[44:4] = DBLV)#, 02983860
|
|
CMPLX = (LISTYPE.[44:4] = CMPLXV)#, 02983880
|
|
TWOD = LISTYPE.[38:1]#, 02983900
|
|
SIZEF = [33:15]#, 02983920
|
|
BASEF = [18:15]#; 02983940
|
|
LABEL NMLST,NLERR,NLP,NLPA,NRP,NLISRT,NLL,NLPB,NRPL; 02983960
|
|
COMMENT * * * * * START OF SUBROUTINE DECLARATIONS * * * * * * * * ; 02983980
|
|
SUBROUTINE CKPB; 02984000
|
|
BEGIN COMMENT INITIALIZE FILE AND ACQUIRE RECORD SIZE; 02984020
|
|
LCR ~ 8|(BSIZE ~ P(MKS,DKADR,1,FILX,READINT)); 02984040
|
|
BUFF ~ (*FILX).[33:15]; NCR ~ 0; 02984060
|
|
END CKPB; 02984080
|
|
SUBROUTINE READS; 02984100
|
|
BEGIN 02984120
|
|
P(MKS,DKADR,0,FILX,READINT); 02984140
|
|
IF DONETOG THEN P(XIT); 02984160
|
|
IF ((*FILX).[27:1]) THEN P(XIT); 02984280
|
|
CKPB; 02984300
|
|
END READS; 02984320
|
|
% PARAMETERS FOR LIST CONTROL 02984340
|
|
BOOLEAN ATOG,TWDT; 02984360
|
|
ARRAY AR1 = LISTADR[*]; 02984380
|
|
INTEGER INDX, SIZE; 02984400
|
|
DEFINE NXTELM = IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX.[40:8],CDC) 02984420
|
|
ELSE [AR1[INDX]]#; 02984440
|
|
SUBROUTINE SKPC; % SKIPS CURRENT CHARACTERS. PUTS NEXT CHARACTERS 02984460
|
|
BEGIN; % IN NBC 02984480
|
|
STREAM(P1~BUFF,P2~0:P3~0); 02984500
|
|
BEGIN 02984520
|
|
SI ~ P1; SI ~ SI +1; P1 ~ SI; 02984540
|
|
DI ~ LOC P2; DI ~ DI+7; DS ~ CHR; 02984560
|
|
END; 02984580
|
|
NBC ~ P; BUFF ~ P; 02984600
|
|
WT ~ WT -1; 02984620
|
|
END SKPC; 02984640
|
|
SUBROUTINE SCALE; 02984660
|
|
BEGIN 02984680
|
|
IF (D1 ~ D1 + CNT) > 11 02984700
|
|
THEN DOUBLE(WH1,WH2,TEN[CNT],TEN[69+CNT],|, 02984720
|
|
DH1,0,+,~,WH1,WH2) 02984740
|
|
ELSE WH1~ WH1|TEN[CNT]+DH1; 02984760
|
|
DH1 ~ 0; 02984780
|
|
END SCALE; 02984800
|
|
SUBROUTINE GETNUM; 02984820
|
|
BEGIN; 02984840
|
|
STREAM(P1~BUFF,P2~IF WT { 8 THEN WT ELSE 8,P3~0,P4~0:P5~0); 02984860
|
|
BEGIN 02984880
|
|
SI ~ P1; 02984900
|
|
P2(IF SC = " " THEN TALLY ~ TALLY +1 02984920
|
|
ELSE 02984940
|
|
BEGIN IF SC } "0" THEN TALLY ~ TALLY + 1 02984960
|
|
ELSE JUMP OUT; 02984980
|
|
END; 02985000
|
|
SI ~ SI + 1); 02985020
|
|
P2 ~ TALLY; 02985040
|
|
SI ~ P1; DI ~ LOC P3; DS ~ P2 OCT; 02985060
|
|
P1 ~ SI; 02985080
|
|
DI ~ LOC P4; DI ~ DI + 7; DS ~ CHR; 02985100
|
|
END; 02985120
|
|
NBC ~ P; DH1 ~ P; CNT ~ P; BUFF ~ P; 02985140
|
|
END GETNUM; 02985160
|
|
SUBROUTINE GETSIGN; 02985180
|
|
BEGIN; 02985200
|
|
STREAM(P1~BUFF,P2~(IF WT > 63 THEN 63 ELSE WT),P3~0,P4~(-1): 02985220
|
|
P5~0); 02985240
|
|
BEGIN 02985260
|
|
SI~P1; DI~P2 ; 02985280
|
|
P2(DI~DI-8; IF SC!" " THEN JUMP OUT TO L1; 02985300
|
|
SI ~ SI + 1; TALLY ~ TALLY + 1); 02985320
|
|
P1 ~ SI; 02985340
|
|
GO TO RTNSGN; 02985360
|
|
L1: IF SC } "0" THEN 02985380
|
|
BEGIN 02985400
|
|
L3: P2 ~ TALLY; 02985420
|
|
L2: P5(P1~DI; TALLY~P2; P1(IF SC!" " THEN 02985440
|
|
JUMP OUT; TALLY~TALLY+1; SI~SI+1); P2~TALLY); P1~SI ; 02985460
|
|
DI ~ LOC P4; DS ~ 7 LIT "0"; DS ~ CHR; 02985480
|
|
GO TO RTNSGN; 02985500
|
|
END; 02985520
|
|
IF SC ="." THEN GO TO L3; 02985540
|
|
TALLY ~ TALLY+1; 02985560
|
|
P2 ~ TALLY; 02985580
|
|
TALLY~1; P5~TALLY ; 02985600
|
|
IF SC="-" THEN TALLY~1 ELSE IF SC="+" THEN TALLY~0 ELSE 02985620
|
|
IF SC="&" THEN TALLY~0 ELSE 02985640
|
|
BEGIN TALLY~0; P1~TALLY; GO TO RTNSGN END; 02985660
|
|
P3 ~ TALLY; 02985680
|
|
SI ~ SI + 1; 02985700
|
|
GO TO L2; 02985720
|
|
RTNSGN: 02985740
|
|
END; 02985760
|
|
NBC~P; SGN~P; CNT~P; DTAERR~((BUFF~P)=0) ; 02985780
|
|
END GETSIGN; 02985800
|
|
LABEL NCRTN,BLSGN; 02985820
|
|
SUBROUTINE NUMCONVERT; 02985840
|
|
BEGIN 02985860
|
|
DH1 := D1 := D2 := EXP := EXPSGN := 0; 02985880
|
|
WH1 ~ WH2 ~ -0; 02985900
|
|
WT ~ W; 02985920
|
|
BLSGN: 02985940
|
|
GETSIGN; 02985960
|
|
IF DTAERR THEN GO TO NCRTN ; 02985980
|
|
WT ~ WT - CNT; IF NBC <0 % BLANK FIELD 02986000
|
|
THEN IF WT { 0 THEN GO TO NCRTN ELSE GO TO BLSGN; 02986020
|
|
IF NBC { 9 THEN 02986040
|
|
BEGIN 02986060
|
|
GETNUM; WH1 ~ DH1; 02986080
|
|
IF (WT ~ WT - (D1 ~ CNT)) { 0 THEN GO TO NCRTN; 02986100
|
|
WHILE NBC { "9" OR NBC = " " DO 02986120
|
|
BEGIN 02986140
|
|
GETNUM; SCALE; 02986160
|
|
IF (WT ~ WT-CNT) { 0 THEN GO TO NCRTN; 02986180
|
|
END; 02986200
|
|
END; 02986220
|
|
IF NBC = "." THEN 02986240
|
|
BEGIN 02986260
|
|
SKPC; 02986280
|
|
IF WT{0 THEN GO TO NCRTN ; 02986300
|
|
WHILE (NBC { "9") OR (NBC = " ") DO 02986320
|
|
BEGIN 02986340
|
|
GETNUM; SCALE; 02986360
|
|
D2 ~ D2 + CNT; 02986380
|
|
IF ( WT ~ WT - CNT) { 0 THEN GO TO NCRTN; 02986400
|
|
END; 02986420
|
|
END; 02986440
|
|
IF NBC = "D" OR NBC = "E" THEN SKPC; 02986460
|
|
IF WT{0 THEN BEGIN DTAERR~TRUE; GO TO NCRTN END ; 02986480
|
|
IF (NBC="+") OR (NBC="&") OR (NBC=" ") OR (EXPSGN~(NBC="-")) 02986500
|
|
THEN SKPC; 02986520
|
|
IF WT{0 THEN BEGIN DTAERR~TRUE; GO TO NCRTN END ; 02986540
|
|
IF NBC > "9" THEN DTAERR ~ TRUE 02986560
|
|
ELSE 02986580
|
|
BEGIN 02986600
|
|
GETNUM; 02986620
|
|
EXP ~ IF EXPSGN THEN (-DH1) ELSE DH1; 02986640
|
|
IF (WT~WT-CNT) { 0 THEN GO TO NCRTN; 02986660
|
|
IF NOT NLT THEN WHILE WT > 0 DO SKPC; 02986680
|
|
END; 02986700
|
|
NCRTN: 02986720
|
|
IF WH1 = 0 THEN IF SGN THEN WH1 ~ -0; 02986740
|
|
END NUMCONVERT; 02986760
|
|
LABEL NMBLNK; 02986780
|
|
REAL SUBROUTINE NMSCN; 02986800
|
|
BEGIN; 02986820
|
|
NMBLNK: 02986840
|
|
IF NCR } LCR THEN READS; 02986860
|
|
STREAM(P1~BUFF,P2~(IF(T1~LCR-NCR)>63 THEN 63 ELSE T1), 02986880
|
|
P3 ~0:P4~0); 02986900
|
|
BEGIN 02986920
|
|
SI ~P1; 02986940
|
|
P2(IF SC !" " THEN JUMP OUT TO L1; 02986960
|
|
SI ~ SI + 1; TALLY ~ TALLY + 1;); 02986980
|
|
P2 ~ TALLY; TALLY ~ 1; 02987000
|
|
GO TO L2; 02987020
|
|
L1: P2 ~ TALLY; TALLY ~ 0; 02987040
|
|
L2: P1 ~ TALLY; P3 ~ SI; 02987060
|
|
END; 02987080
|
|
BUFF ~ P; NCR ~ NCR+P; IF P THEN GO TO NMBLNK; 02987100
|
|
STREAM(P1~BUFF,P2~0,P3~0,P4~" ",P5~0:NFL) ; 02987120
|
|
BEGIN 02987140
|
|
SI ~ P1; 02987160
|
|
NFL(IF SC}"0" THEN JUMP OUT TO NU) ; 02987180
|
|
IF SC = ALPHA THEN 02987200
|
|
BEGIN 02987220
|
|
DI ~ LOC P4; DI ~ DI + 2; 02987240
|
|
6(IF SC < "A" THEN JUMP OUT; 02987260
|
|
DS ~ CHR; TALLY ~ TALLY + 1); 02987280
|
|
P1 ~ SI; P3 ~ TALLY; 02987300
|
|
TALLY ~ 1; GO TO EXIT; 02987320
|
|
END; 02987340
|
|
NFL(IF SC!"-" THEN IF SC!"+" THEN IF SC!"&" THEN JUMP OUT;02987360
|
|
JUMP OUT TO NU) ; 02987380
|
|
02987400
|
|
02987420
|
|
02987440
|
|
TALLY ~ 1; P3 ~ TALLY; 02987460
|
|
DI ~ LOC P2; DI ~ DI + 7; 02987480
|
|
IF SC ="#" THEN BEGIN DS~LIT"="; SI~SI+1 END ELSE 02987500
|
|
02987520
|
|
IF SC ="[" THEN BEGIN DS~LIT ")"; SI ~ SI+1 END ELSE 02987540
|
|
IF SC ="%" THEN BEGIN DS~LIT "("; SI ~ SI+1 END ELSE 02987560
|
|
DS ~CHR; 02987580
|
|
P1 ~ SI; 02987600
|
|
TALLY ~ 3; GO TO EXIT; 02987620
|
|
02987640
|
|
NU: 02987660
|
|
P1 ~ SI; TALLY ~ 2; 02987680
|
|
EXIT: 02987700
|
|
P5 ~ TALLY; 02987720
|
|
END; 02987740
|
|
T1 ~ P; NAMEV ~ P; NCR ~ NCR + P; NBC ~ P; BUFF ~ P; 02987760
|
|
IF T1 = ID THEN NBC ~ NAMEV; 02987780
|
|
NMSCN ~ T1; 02987800
|
|
END NMSCN; 02987820
|
|
SUBROUTINE NLCONV; 02987840
|
|
BEGIN 02987860
|
|
IF NBC = "." THEN 02987880
|
|
BEGIN; 02987900
|
|
STREAM(P1~BUFF:P2~0); 02987920
|
|
BEGIN DI ~ P1; DI ~ DI - 1; P1 ~ DI; END; 02987940
|
|
BUFF ~ P; NCR ~ NCR - 1; 02987960
|
|
END; 02987980
|
|
W ~ LCR-NCR; 02988000
|
|
NUMCONVERT; 02988020
|
|
IF (NCR ~ NCR + (W-WT)) } LCR THEN READS; 02988040
|
|
T1 ~ EXP - D2; 02988060
|
|
IF WH1 > MAX 02988080
|
|
THEN 02988100
|
|
IF T1 } 0 THEN DOUBLE(WH1,WH2,TEN[T1],TEN[69+T1],|, 02988120
|
|
~,WH1,WH2) 02988140
|
|
ELSE DOUBLE(WH1,WH2,TEN[-T1],TEN[69-T1],/, 02988160
|
|
~,WH1,WH2) 02988180
|
|
ELSE 02988200
|
|
IF T1 } 0 THEN WH1 ~ WH1 | TEN[T1] 02988220
|
|
ELSE WH1 ~ WH1 / TEN[-T1]; 02988240
|
|
IF SGN THEN WH1 ~ - WH1; 02988260
|
|
END NLCONV; 02988280
|
|
LABEL NLR,SUBD; 02988300
|
|
SUBROUTINE SUBEVUL; 02988320
|
|
BEGIN 02988340
|
|
IF NMSCN !NUM THEN GO TO NLERR; 02988360
|
|
CHR ~ FMTA[NLI~NLI+1].[1:6]; % # DIM 02988380
|
|
NFCI ~ 1; NLCONV; 02988400
|
|
IF (D2!0) OR (EXP ! 0) THEN GO TO NLERR; 02988420
|
|
SBS ~ WH1-1; 02988440
|
|
NLR: IF NMSCN ! SPC THEN GO TO NLERR; 02988460
|
|
IF NBC = ")" THEN GO TO SUBD; 02988480
|
|
IF NFCI = CHR THEN GO TO NLERR; 02988500
|
|
NLCONV; 02988520
|
|
IF (D2!0) OR (EXP!0) THEN GO TO NLERR; 02988540
|
|
WH1 ~ WH1 - 1; D2 ~ 0; 02988560
|
|
WHILE D2<NFCI DO WH1 ~ WH1|FMTA[NLI+(D2~D2+1)]; 02988580
|
|
SBS ~ SBS + WH1; 02988600
|
|
NFCI ~ NFCI + 1; 02988620
|
|
GO TO NLR; 02988640
|
|
SUBD: 02988660
|
|
INDX ~ INDX + SBS; 02988680
|
|
T1 ~ NMSCN; 02988700
|
|
END SUBEVUL; 02988720
|
|
COMMENT * * * * * * * * * * END OF DECLARATIONS * * * * * * * * * * * ; 02988740
|
|
NFL~1 ; 02988745
|
|
FILX[NOT 4] ~ EOFL; FILX[NOT 3] ~ PARL; 02988760
|
|
FIB ~ FILX[NOT 2]; % OPEN FILE IF NOT OPEN 02988780
|
|
IF FIB[5].[43:2] ! (T1 ~ 2 ) THEN 02988800
|
|
P(MKS,0,T1,FILX,1,SELECT); 02988820
|
|
% SET/CHECK FOR MIXED FORMATTED - UNFORMATTED I/O 02988860
|
|
CKPB; 02988880
|
|
IF FIB[0] = 0 THEN FIB[0] := 1 ELSE 02988900
|
|
IF FIB[0] NEQ 1 THEN P(MKS,FIB[6],FILX.[33:15],4,FORTERR); 02988920
|
|
NMLST: 02989000
|
|
NLE ~ FMTA[FI].[2:10]; 02989020
|
|
NLT ~ TRUE; 02989040
|
|
SKPC; NCR ~ NCR + 1; 02989060
|
|
WHILE NMSCN ! SPC OR NBC ! "$" DO BEGIN READS; SKPC; END; 02989080
|
|
NCR ~ NCR + 1; 02989100
|
|
IF NMSCN ! ID THEN GO TO NLERR; 02989120
|
|
IF FMTA[FI].[12:36] ! NBC THEN 02989140
|
|
BEGIN READS; GO TO NMLST; END; 02989160
|
|
NLP: IF NMSCN ! ID THEN GO TO NLERR; 02989180
|
|
NLPA: 02989200
|
|
NLI ~ FI+1; T1 ~ NLE; 02989220
|
|
WHILE T1 >0 DO 02989240
|
|
BEGIN 02989260
|
|
IF NBC = FMTA[NLI].[12:36] THEN GO TO NLPB; 02989280
|
|
T1 ~ T1 - 1; 02989300
|
|
NLI ~ NLI + 2 + FMTA[NLI+1].[1:6]; 02989320
|
|
END; 02989340
|
|
% NOT FOUND 02989360
|
|
WHILE (T1~ NMSCN) ! SPC OR(NBC ! "," AND NBC ! "$") DO 02989380
|
|
IF T1 = NUM THEN NLCONV; 02989400
|
|
IF NBC = "$" THEN BEGIN DONETOG ~ TRUE; READS END; 02989420
|
|
GO TO NLP; 02989440
|
|
NLPB: 02989460
|
|
ATOG ~ CTOG ~ FALSE; 02989480
|
|
LISTYPE ~ FMTA[NLI].[2:10]; 02989500
|
|
IF (T1~FMTA[NLI+1].[18:30]) !0 THEN 02989520
|
|
BEGIN 02989540
|
|
SIZE~(INDX~T1.BASEF)+T1.SIZEF ; 02989560
|
|
ATOG ~ TRUE; 02989620
|
|
END; 02989640
|
|
IF (T1 ~ FMTA[NLI+1].[7:11]) < 1024 THEN 02989660
|
|
LISTADR ~ [PRTBASE[T1]] 02989680
|
|
ELSE LISTADR ~ IF T1.[39:1] THEN [MEM[LISX-T1.[41:7]]] 02989700
|
|
ELSE [MEM[LISX+T1.[40:8]]]; 02989720
|
|
IF ATOG THEN TWDT~NOT P(*(LISTADR~MEM[(*[LISTADR]).[18:15]]), 02989740
|
|
TOP,XCH,DEL) 02989745
|
|
ELSE W1~LISTADR ; 02989750
|
|
IF LGTG=0 THEN T1~NMSCN ELSE BEGIN NBC~LGTG; LGTG~0 END; 02989760
|
|
IF NBC ="(" THEN 02989780
|
|
BEGIN 02989800
|
|
IF NOT ATOG THEN GO TO NLERR; 02989820
|
|
SUBEVUL; 02989840
|
|
END; 02989860
|
|
IF NBC ! "=" THEN GO TO NLERR; 02989880
|
|
T1 ~ NMSCN; 02989900
|
|
NRP: IF T1 =NUM THEN 02989920
|
|
BEGIN 02989940
|
|
NLCONV; 02989960
|
|
IF NMSCN !SPC THEN GO TO NLERR; 02989980
|
|
IF NBC ! "*" THEN GO TO NLISRT; 02990000
|
|
RPT ~ WH1; 02990020
|
|
IF (D2!0) OR (EXP!0)THEN GO TO NLERR; 02990040
|
|
IF NMSCN = NUM THEN GO TO NRP; 02990060
|
|
END; 02990080
|
|
NRPL: 02990100
|
|
IF NBC = "." THEN 02990120
|
|
BEGIN 02990140
|
|
IF ELMTYP ! LOGV THEN 02990160
|
|
BEGIN 02990180
|
|
NLCONV; T1 ~ NMSCN; GO TO NLISRT; 02990200
|
|
END; 02990220
|
|
T1 ~ NMSCN; 02990240
|
|
NLL: WH1 ~ (NBC.[12:6]= "T"); 02990260
|
|
WHILE (T1~NMSCN) ! SPC OR (NBC!"$" AND NBC ! ",") 02990280
|
|
DO IF T1= NUM THEN GO TO NLERR; 02990300
|
|
GO TO NLISRT; 02990320
|
|
END; 02990340
|
|
IF NBC ="(" THEN 02990360
|
|
BEGIN 02990380
|
|
IF NMSCN ! NUM THEN GO TO NLERR; 02990400
|
|
NLCONV; JUNK1 ~WH1; 02990420
|
|
CTOG ~ TRUE; 02990440
|
|
IF NMSCN ! SPC OR NBC ! "," THEN GO TO NLERR; 02990460
|
|
IF NMSCN !NUM THEN GO TO NLERR; 02990480
|
|
NLCONV; 02990500
|
|
WH2 ~ WH1; WH1 ~ JUNK1; 02990520
|
|
IF NMSCN ! SPC OR NBC ! ")" THEN GO TO NLERR; 02990540
|
|
GO TO NLISRT; 02990560
|
|
END; 02990580
|
|
IF ELMTYP !LOGV THEN GO TO NLERR; 02990600
|
|
GO TO NLL; 02990620
|
|
NLISRT: 02990640
|
|
IF ATOG THEN 02990660
|
|
BEGIN 02990680
|
|
IF INDX } SIZE THEN GO TO NLERR; 02990700
|
|
W1 ~ NXTELM; 02990720
|
|
INDX ~ INDX+ (DLN OR CMPLX); 02990740
|
|
INDX ~ INDX + 1; 02990760
|
|
END; 02990780
|
|
IF ELMTYP = INTEGV THEN W1[0]~WH1 DIV 1 ELSE 02990800
|
|
W1[0] ~ WH1; 02990820
|
|
IF (DLN OR CMPLX) THEN W1[1] ~WH2; 02990840
|
|
IF NOT (CTOG EQV CMPLX) THEN GO TO NLERR; 02990860
|
|
IF ATOG THEN IF (RPT ~ RPT-1) > 0 THEN GO TO NLISRT; 02990880
|
|
NFL~0; WHILE NBC!"," AND NBC!"$" DO P(NMSCN,DEL); NFL~1 ; 02990900
|
|
IF NBC = "$" THEN BEGIN DONETOG ~ TRUE; READS; END; 02990920
|
|
IF NOT ATOG THEN GO TO NLP; 02990940
|
|
IF ELMTYP ! LOGV THEN IF (NMSCN =ID ) 02990960
|
|
THEN GO TO NLPA ELSE IF NBC!"," THEN GO TO NRP 02990980
|
|
ELSE BEGIN WH1~WH2~0; GO TO NLISRT END; 02991000
|
|
IF (T1 ~ NMSCN) = NUM THEN GO TO NRP; 02991020
|
|
IF NBC = "." THEN GO TO NRPL; 02991040
|
|
WH1 ~ NBC; T1 ~ NMSCN; 02991060
|
|
IF NBC ! "," THEN 02991080
|
|
BEGIN 02991100
|
|
LGTG ~ NBC; NBC ~ WH1; GO TO NLPA; 02991120
|
|
END; 02991140
|
|
WH1 ~ (WH1.[12:6] = "T"); 02991160
|
|
GO TO NLISRT; 02991180
|
|
NLERR: 02991200
|
|
P(MKS,FIB[6],FILX.[33:15],1,FORTERR); 02991220
|
|
END FINNAME; 02991240
|
|
PROCEDURE FOUTNAME; %155 02991260
|
|
BEGIN 02991280
|
|
COMMENT FILX FILE TOP IO DESCRIPTOR 02991300
|
|
FMTA FORMAT OR NAMELIST OR 0 02991320
|
|
LISX ACCIDENTAL ENTRY DESC. OR 0 02991340
|
|
; 02991460
|
|
REAL FORTERR = 24, 02991500
|
|
LISX = -1, 02991520
|
|
FI = -3, 02991540
|
|
DKADR = -4; 02991560
|
|
ARRAY FMTA = -2[*], FPB = 3[*] ; 02991580
|
|
NAME FILX = -5, 02991600
|
|
MEM = 2; 02991620
|
|
REAL ALGOLWRITE = 12, 02991640
|
|
SELECT = 14; 02991660
|
|
INTEGER LSTRN = 19; 02991680
|
|
REAL LISTYPE = 20, 02991700
|
|
ARRAYSTUFF = 18, 02991720
|
|
NAMEV = 21; 02991740
|
|
ARRAY PRTBASE = 10[*], 02991760
|
|
TEN = 22[*], 02991780
|
|
TPAR = 23[*], 02991800
|
|
FIB[*]; 02991820
|
|
NAME LISTADR; 02991840
|
|
REAL BUFF , % FIRST BUFFER POSITION 02991860
|
|
BSIZE , % ARGUMENIS 02991880
|
|
FLG , % TRUE FOR SERIAL I/O 02991900
|
|
WH1, 02991920
|
|
WH2 , % 02991940
|
|
W1 , % 02991960
|
|
W2 , % 02991980
|
|
NFCI ; % NEXT FORMAT CHAR LOCATION 02992000
|
|
INTEGER DH1 , % CONV- 02992020
|
|
DH2 , % ERTED NU- 02992040
|
|
DH3 , % MBER 02992060
|
|
W , % FIELD 02992080
|
|
WT , % WIDTH 02992100
|
|
T1 , % 02992120
|
|
D , % DEC- 02992140
|
|
DT , % IMAL P- 02992160
|
|
D1 , % LA- 02992180
|
|
D2 , % CE- 02992200
|
|
D3 , % S 02992220
|
|
ZEROS , % TRAILING ZEROES 02992240
|
|
EXP , % EXPONENT 02992260
|
|
SHFT , % INTEGER PART OF SHIFT 02992280
|
|
CODE , % EDITING FUNCTION 02992300
|
|
SKP , % REDUNDANT POSITIONS 02992320
|
|
NCR , % CURRENT BUFFER POSITION 02992340
|
|
LCR , % BUFFER SIZE IN CHARACTERS 02992360
|
|
CHR ; % CURRENT CHAR FROM FORMAT 02992380
|
|
BOOLEAN DONETOG , % RETURN AFTER WRITE 02992400
|
|
SGN , % SIGN 02992420
|
|
PRNTR , % TRUE IF PRINTER OUT PUT 02992440
|
|
DTOG , % DOUBLE PRECISION TOG 02992460
|
|
CTOG ; % COMPLEX NUMBER TOG 02992480
|
|
DEFINE LOGV = 4#, 02992500
|
|
INTEGV =1#, 02992520
|
|
DBLV = 5#, 02992540
|
|
CMPLXV = 6#, 02992560
|
|
ETYPE = 3#, 02992580
|
|
DTYPE = 4#, 02992600
|
|
ITYPE = 5#, 02992620
|
|
LTYPE = 6#, 02992640
|
|
ELMTYP = LISTYPE . [44:4]#, 02992660
|
|
DLN = (LISTYPE.[44:4] =DBLV)#, 02992680
|
|
CMPLX = (LISTYPE.[44:4] = CMPLXV)#, 02992700
|
|
TWOD = LISTYPE.[38:1]#, 02992720
|
|
ENDLIST = (LSTRN = (-1))#, 02992740
|
|
SIZEF = [33:15]#; 02992760
|
|
LABEL ERTN,E,DC,I,L,AST,COMM,NM1,NM2,FMERR; 02992780
|
|
COMMENT * * * * * START OF SUBROUTINE DECLARATIONS * * * * * * * * ; 02992800
|
|
SUBROUTINE CKPB; 02992820
|
|
BEGIN COMMENT INITIALIZE FILE AND ACQUIRE RECORD SIZE; 02992840
|
|
LCR ~ 8|(BSIZE ~ P(MKS,FLG,DKADR,0,(-1),FILX,ALGOLWRITE)); 02992860
|
|
IF PRNTR~PRNTR&(((T1~FIB[4].[8:4])=1 OR T1=7 OR T1=12) AND FPB[FIB[4] 02992880
|
|
.[13:11]+3].[43:5]<20)[47:47:1] THEN 02992885
|
|
IF BSIZE GEQ 17 THEN BEGIN LCR := 132; BSIZE := 17 END; 02992900
|
|
IF PRNTR AND BSIZE=17 THEN LCR~120 ; 02992920
|
|
BUFF :=(IF T1 := PRNTR THEN TPAR ELSE *FILX).[33:15]; 02992960
|
|
IF ((NOT T1) OR PRNTR.[46:1]) THEN 02993020
|
|
STREAM(P2 ~ (BSIZE-1).[36:6], 02993040
|
|
P3~T1.[47:1]+BSIZE-1,P4~BUFF) ; 02993060
|
|
BEGIN DI ~ P4; DS ~ 8 LIT " "; 02993080
|
|
SI ~ P4; 02993100
|
|
P2(DS ~ 32 WDS; DS ~ 32 WDS); 02993120
|
|
DS ~ P3 WDS; 02993140
|
|
END; 02993160
|
|
NCR ~ 0; 02993200
|
|
END CKPB; 02993220
|
|
SUBROUTINE PRNT; 02993240
|
|
BEGIN COMMENT GLNERATE A CALL FOR CAR. CONT. AND FOR OUTPUT; 02993260
|
|
IF PRNTR THEN 02993280
|
|
BEGIN; 02993300
|
|
NCR ~ 0; 02993320
|
|
STREAM(P1~0:P2~TPAR); 02993340
|
|
BEGIN SI ~P2; DI ~ LOC P1; DI ~DI + 7; DS ~CHR; 02993360
|
|
DI ~ P2; DS ~ LIT " ";END; 02993380
|
|
NCR ~ P; 02993400
|
|
IF NCR = " " THEN D2 ~ 16 ELSE 02993420
|
|
IF NCR = "0" THEN D2 ~ 32 ELSE 02993440
|
|
IF NCR = "+" THEN D2 ~ 0 ELSE 02993460
|
|
IF (D2 ~ NCR) > 9 THEN D2 ~ 16; 02993480
|
|
IF NOT PRNTR.[46:1] THEN FIB[17]~FIB[17]+BSIZE ; 02993520
|
|
P(MKS,D2.[42:2],D2.[44:4],PRNTR.[46:1],BSIZE,FILX,ALGOLWRITE) ;02993540
|
|
FIB[6]~FIB[6]-(D2=0) ; 02993560
|
|
IF NOT (*FILX).[19:1] THEN P(FILX,@2000000000,2,COM,DEL,DEL); 02993580
|
|
PRNTR~1; CKPB ; 02993600
|
|
STREAM(P1~TPAR,P2~*FILX,P3~BSIZE.[36:6],P4~BSIZE); 02993620
|
|
BEGIN 02993640
|
|
SI ~ P1; DI ~ P2; DS ~ P4 WDS; 02993660
|
|
P3(DS ~32 WDS; DS ~ 32 WDS); 02993680
|
|
DI~P1; P4(DS~8LIT" ") ; 02993700
|
|
END; 02993720
|
|
FIB[17]~FIB[17]-BSIZE; IF DONETOG THEN P(XIT) ; 02993740
|
|
END ELSE BEGIN P(MKS,FLG,DKADR,0,BSIZE,FILX,ALGOLWRITE); 02993760
|
|
IF DONETOG THEN P(XIT); 02993780
|
|
CKPB END ; 02993800
|
|
END PRNT; 02993820
|
|
% PARAMETERS FOR LIST CONTROL 02993840
|
|
BOOLEAN ATOG,TWDT; 02993860
|
|
ARRAY AR1 = LISTADR[*]; 02993880
|
|
REAL INDX,SIZE,NLI,NLE; 02993900
|
|
LABEL RTNLST,SRT; 02993920
|
|
DEFINE NXTELM = IF TWDT THEN P(*[AR1[INDX.[33:7]]],INDX.[40:8],COC) 02993940
|
|
ELSE AR1[INDX]#; 02993960
|
|
SUBROUTINE GETNMLST; 02993980
|
|
BEGIN 02994000
|
|
IF (NLE ~ NLE - 1) <0 THEN LSTRN ~ - 1 ELSE 02994020
|
|
BEGIN 02994040
|
|
NAMEV ~ FMTA[NLI~ NLI+1].[12:36]; 02994060
|
|
LISTYPE ~ FMTA [NLI].[2:10]; 02994080
|
|
ARRAYSTUFF ~ FMTA[NLI~NLI+1].[18:30]; 02994100
|
|
IF (T1 ~ FMTA[NLI].[7:11] ) < 1024 02994120
|
|
THEN LISTADR~ [PRTBASE[T1]] ELSE 02994140
|
|
IF T1.[39:1] THEN LISTADR ~ [MEM[LISX-(T1.[41:7])]] 02994160
|
|
ELSE LISTADR ~ [MEM[LISX+(T1.[40:8])]]; 02994180
|
|
NLI ~ NLI + FMTA[NLI].[1:6]; 02994200
|
|
END; 02994220
|
|
END GETNMLST; 02994240
|
|
SUBROUTINE GETLIST; 02994260
|
|
BEGIN 02994280
|
|
SRT: IF ATOG THEN 02994300
|
|
BEGIN 02994320
|
|
IF DLN THEN 02994340
|
|
BEGIN 02994360
|
|
WH1 ~ NXTELM; 02994380
|
|
INDX ~ INDX + 1; 02994400
|
|
WH2 ~ NXTELM; 02994420
|
|
END ELSE 02994440
|
|
BEGIN 02994460
|
|
WH1 ~ NXTELM; 02994480
|
|
WH2 ~ 0; 02994500
|
|
END; 02994520
|
|
IF (INDX ~INDX + 1) } SIZE THEN 02994540
|
|
BEGIN 02994560
|
|
ARRAYSTUFF ~ 0; 02994580
|
|
ATOG ~ FALSE; 02994600
|
|
END; 02994620
|
|
GO TO RTNLST; 02994640
|
|
END; 02994660
|
|
IF CTOG THEN 02994680
|
|
BEGIN % IMAGINARY PART OF COMPLEX 02994700
|
|
WH1 ~ LISTADR[1]; 02994720
|
|
WH2 ~ 0; 02994740
|
|
CTOG ~ FALSE; 02994760
|
|
GO TO RTNLST; 02994780
|
|
END; 02994800
|
|
GETNMLST; 02994820
|
|
IF ENDLIST THEN GO TO RTNLST; 02994840
|
|
IF ARRAYSTUFF ! 0 THEN 02994860
|
|
BEGIN 02994880
|
|
ATOG ~ TRUE; 02994900
|
|
SIZE~(INDX~ARRAYSTUFF.[18:15])+ARRAYSTUFF.SIZEF ; 02994910
|
|
TWDT~NOT P(*(LISTADR~MEM[(*[LISTADR]).[18:15]]),TOP); P(DEL) ;02994920
|
|
GO TO SRT; 02994970
|
|
END; 02994980
|
|
IF NOT P(*LISTADR,TOP,XCH,DEL) THEN LISTADR~P(*LISTADR) ; 02994985
|
|
WH1 ~ LISTADR[0]; 02995000
|
|
WH2 ~ IF DLN THEN LISTADR[1] ELSE 0; 02995020
|
|
CTOG ~ CMPLX; 02995040
|
|
RTNLST: 02995060
|
|
END GETLIST; 02995080
|
|
SUBROUTINE NMSZ; 02995100
|
|
BEGIN; 02995120
|
|
STREAM(P1~[NAMEV]:P2~0); 02995140
|
|
BEGIN 02995160
|
|
SI ~P1; SI ~ SI + 2; 02995180
|
|
6(IF SC = " " THEN JUMP OUT; 02995200
|
|
SI ~SI + 1; TALLY ~ TALLY + 1); 02995220
|
|
P1 ~TALLY; 02995240
|
|
END; 02995260
|
|
NFCI ~ P; 02995280
|
|
END NMSZ; 02995300
|
|
SUBROUTINE PUT; 02995320
|
|
BEGIN; 02995340
|
|
STREAM(P1~[NAMEV]:P2~NFCI,P3~BUFF); 02995360
|
|
BEGIN 02995380
|
|
SI ~ P1; SI ~SI + 2; DS ~P2 CHR; 02995400
|
|
P1 ~ DI; 02995420
|
|
END; 02995440
|
|
BUFF ~ P; 02995460
|
|
END PUT; 02995480
|
|
SUBROUTINE FUNNYZERO; 02995500
|
|
BEGIN 02995520
|
|
SKP ~ W - (D+6+SGN); 02995540
|
|
STREAM(P1~ BUFF:P2~SKP,P3~SGN,P4~(D+4)); 02995560
|
|
BEGIN 02995580
|
|
DI ~P1; DI ~ DI + P2; 02995600
|
|
P3(DS ~ LIT "-"; JUMP OUT TO L); 02995620
|
|
L: DS ~ 2 LIT "0."; 02995640
|
|
P4(DS ~ LIT " "); 02995660
|
|
P1 ~ DI; 02995680
|
|
END; 02995700
|
|
BUFF ~ P; 02995720
|
|
END FUNNYZERO; 02995740
|
|
SUBROUTINE FINDE; 02995760
|
|
BEGIN IF DTOG THEN 02995780
|
|
DOUBLE(TEN[0],0,WH1,WH2,|,~,WH1,WH2) 02995800
|
|
ELSE WH1 ~ TEN[0] | WH1; 02995820
|
|
EXP ~ ((0&WH1[42:3:6]&WH1[1:2:1]+12)|.9039) +.5; 02995840
|
|
W2 ~ 0; 02995860
|
|
IF DTOG THEN 02995880
|
|
IF EXP } 0 THEN DOUBLE(TEN[EXP],TEN[69+EXP],~,W1,W2) 02995900
|
|
ELSE DOUBLE(1,0,TEN[-EXP],TEN[69-EXP],/,~,W1,W2) 02995920
|
|
ELSE W1 ~ IF EXP } 0 THEN TEN[EXP] ELSE 1/TEN[-EXP]; 02995940
|
|
IF WH1 > W1 THEN GO TO ERTN; 02995960
|
|
IF WH1 = W1 THEN 02995980
|
|
IF WH2 } W2 THEN GO TO ERTN; 02996000
|
|
EXP ~ EXP-1; 02996020
|
|
ERTN: 02996040
|
|
END FINDE; 02996060
|
|
SUBROUTINE NUMCONVERT; 02996080
|
|
BEGIN 02996100
|
|
IF D1 > 0 THEN 02996120
|
|
BEGIN 02996140
|
|
DOUBLE(WH1,WH2,TEN[16],TEN[85],/,~,W1,W2); 02996160
|
|
DH1 ~ W1 DIV 1.0; 02996180
|
|
END; 02996200
|
|
IF D2 > 0 THEN 02996220
|
|
BEGIN IF DTOG THEN 02996240
|
|
BEGIN 02996260
|
|
DOUBLE(WH1,WH2,DH1,0,TEN[16],TEN[85],|,-, 02996280
|
|
TEN[ 8],TEN[77],/,~,W1,W2); 02996300
|
|
DH2 ~ W1 DIV 1; 02996320
|
|
END 02996340
|
|
ELSE DH2 ~ WH1 DIV TEN[8]; 02996360
|
|
END; 02996380
|
|
IF DTOG THEN 02996400
|
|
BEGIN 02996420
|
|
DOUBLE(WH1,WH2,DH1,0,TEN[16],TEN[85],|, 02996440
|
|
DH2,0,TEN[ 8],TEN[77],|,+,-,~,W1,W2); 02996460
|
|
DH3 ~ W1 DIV 1; 02996480
|
|
END 02996500
|
|
ELSE DH3 ~ WH1 DIV 1; 02996520
|
|
EXP ~ EXP+1; 02996540
|
|
END NUMCONVERT; 02996560
|
|
SUBROUTINE SETD; 02996580
|
|
BEGIN 02996600
|
|
IF DLN AND DT > 23 THEN 02996620
|
|
BEGIN 02996640
|
|
ZEROS~DT-23; DT ~ 23; D1 ~ 7; D2 ~ D3 ~ 8; 02996660
|
|
END ELSE IF DT>12 AND NOT DLN THEN 02996680
|
|
BEGIN 02996700
|
|
ZEROS~DT-12; DT ~ 12; D1~0; D2 ~ 4; D3 ~ 8; 02996720
|
|
END ELSE IF DT>16 THEN 02996740
|
|
BEGIN 02996760
|
|
D1~DT-16; D2~D3~8; 02996780
|
|
END ELSE IF DT > 8 THEN 02996800
|
|
BEGIN 02996820
|
|
D1~0;D2~DT-8; D3~8; 02996840
|
|
END ELSE 02996860
|
|
BEGIN 02996880
|
|
D1~D2~0;D3~DT; 02996900
|
|
END; 02996920
|
|
END SETO; 02996940
|
|
SUBROUTINE RNDOFF; 02996960
|
|
BEGIN IF DTOG THEN 02996980
|
|
IF T1 } 0 THEN 02997000
|
|
DOUBLE(WH1,WH2,,5,TEN[T1],TEN[T1+69],|,+,~,WH1,WH2) ELSE 02997020
|
|
DOUBLE(WH1,WH2,,5,TEN[-T1],TEN[69-T1],/,+,~,WH1,WH2) 02997040
|
|
ELSE WH1 ~ WH1 + (IF T1}0 THEN 5|TEN[T1] ELSE 5/TEN[-T1]);02997060
|
|
END RNDOFF; 02997080
|
|
SUBROUTINE SCALE; 02997100
|
|
BEGIN IF DTOG THEN 02997120
|
|
BEGIN IF T1 } 0 02997140
|
|
THEN DOUBLE(WH1,WH2,TEN[T1],TEN[T1+69],|,~,WH1,WH2) 02997160
|
|
ELSE DOUBLE(WH1,WH2,TEN[-T1],TEN[69-T1],/,~,WH1,WH2); 02997180
|
|
IF WH1 } TEN[DT] THEN 02997200
|
|
BEGIN 02997220
|
|
EXP ~ EXP + 1; 02997240
|
|
DOUBLE(WH1,WH2,TEN[1],0,/,~,WH1,WH2); 02997260
|
|
END 02997280
|
|
END ELSE WH1 ~ IF T1 } 0 THEN WH1|TEN[T1] ELSE WH1/TEN[-T1]; 02997300
|
|
END SCALE; 02997320
|
|
%************** S T A R T O F EDIT-CONTROL*****************%02997340
|
|
SUBROUTINE CONVERT; 02997360
|
|
BEGIN 02997380
|
|
DTOG := FALSE; 02997400
|
|
SGN ~WH1.[1:1]; IF CODE < LTYPE THEN WH1 ~ ABS(WH1); WT ~ W; DT ~ D; 02997420
|
|
DH1 ~ DH2 ~ DH3 ~ ZEROS ~EXP ~ SKP ~ SHFT ~ D1 ~ D2 ~ D3 ~ 0; 02997440
|
|
GO TO P(CODE,DUP,ADD); 02997460
|
|
GO TO FMERR; 02997480
|
|
GO TO FMERR; 02997500
|
|
GO TO FMERR; 02997520
|
|
GO TO E; 02997540
|
|
GO TO DC; 02997560
|
|
GO TO I; 02997580
|
|
GO TO L; 02997600
|
|
L: COMMENT LOGICIAL CONVERSION; 02997620
|
|
IF W >1 THEN SKP~W-(WT~1); 02997640
|
|
WH1~ 0&(IF WH1 THEN "T" ELSE "F")[12:42:6]; 02997660
|
|
STREAM(P1 := BUFF:P2 := WH1,P3 := SKP, P4 := WT); 02997680
|
|
BEGIN DI := P1; DI := DI + P3; 02997700
|
|
SI := LOC P2; SI := SI + 2; 02997720
|
|
DS := P4 CHR; P1 := DI; 02997740
|
|
END; 02997760
|
|
BUFF := P; 02997780
|
|
GO TO COMM; 02997800
|
|
I: COMMENT INTEGER CONVERSION; 02997820
|
|
IF WH1=0 AND WH2=0 THEN DT ~ D3 ~ 1 ELSE 02997840
|
|
BEGIN IF DTOG THEN 02997860
|
|
DOUBLE(WH1,WH2,,.5,+,~,WH1,WH2) % ROUND OFF 02997880
|
|
ELSE WH1 ~ T1 ~ WH1; 02997900
|
|
FINDE; 02997920
|
|
IF EXP < 0 THEN DT ~ 03 ~ 1 ELSE 02997940
|
|
BEGIN 02997960
|
|
IF (DLN AND EXP}24) OR (NOT DLN AND EXP}12) THEN GO AST; 02997980
|
|
DT ~ EXP+1; SETD; NUMCONVERT; 02998000
|
|
END; 02998020
|
|
END; 02998040
|
|
IF DT + SGN > W THEN GO TO AST; 02998060
|
|
IF W > DT + SGN THEN SKP ~ W - DT - SGN; 02998080
|
|
STREAM(P1~0:P2 ~ D1,P3 ~ DH1,P4 ~ D2,P5 ~ DH2, 02998100
|
|
P6 ~ D3,P7 ~ DH3,P8 ~ SGN,P9 ~ SKP,P10 ~ BUFF); 02998120
|
|
BEGIN DI ~ P10; P9(DI ~ DI + 1); 02998140
|
|
P8(DS ~ LIT "-"); 02998160
|
|
SI ~LOC P3; DS ~ P2 DEC; 02998180
|
|
SI ~ LOC P5; DS ~ P4 DEC; 02998200
|
|
SI ~ LOC P7; DS ~ P6 DEC; 02998220
|
|
P1 ~ DI; 02998240
|
|
END; 02998260
|
|
BUFF ~ P; 02998280
|
|
GO TO COMM; 02998300
|
|
DC: COMMENT DOUBLE PRECISION CONVERT,SAME AS E CONVERT; 02998320
|
|
E: COMMENT E CONVERSION; 02998340
|
|
DTOG ~ TRUE; 02998360
|
|
SETD; 02998380
|
|
IF WH1=0 AND WH2 = 0 THEN 02998400
|
|
BEGIN 02998420
|
|
IF W < (D+6+ SGN) THEN GO TO AST; 02998460
|
|
FUNNYZERO; GO TO COMM; 02998480
|
|
END ELSE 02998500
|
|
BEGIN 02998520
|
|
FINDE; 02998540
|
|
IF (SKP ~ W - D - 5 - SGN) < 0 THEN GO TO AST; SETD; 02998560
|
|
IF DT LSS 0 THEN DT := 0; 02998580
|
|
T1 ~ EXP - DT; RNDOFF; 02998600
|
|
SETD; 02998620
|
|
T1~DT-1-EXP; SCALE; 02998640
|
|
NUMCONVERT; 02998660
|
|
END; 02998680
|
|
STREAM(P1 ~ 0:P2 ~ SKP,P3 ~ SGN,P4 ~ D1,P5 ~ DH1, 02998700
|
|
P6 ~ D2,P7 ~ DH2,P8 ~ D3,P9 ~ DH3,P10 ~ (DLN), 02998720
|
|
P11 ~ (EXP < 0),P12 ~ ABS(EXP),P13 ~ SHFT,P14 ~ ZEROS,P15 ~BUFF);02998740
|
|
BEGIN DI ~ P15; DI ~ DI + P2; P3(DS ~ LIT "-"); 02998760
|
|
P2 ~ DI; DS ~ LIT "."; 02998780
|
|
SI ~ LOC P5; DS ~ P4 DEC; 02998800
|
|
SI ~ LOC P7; DS ~ P6 DEC; 02998820
|
|
SI ~ LOC P9; DS ~ P8 DEC; 02998840
|
|
P14(DS ~ LIT " "); DS ~ LIT "E"; 02998860
|
|
P10(DI ~ DI - 1; DS ~ LIT "D"); 02998880
|
|
DS ~ LIT " " ; 02998900
|
|
P11(DI ~ DI - 1; DS ~ LIT "-"); 02998920
|
|
SI ~ LOC P12; DS ~ 2 DEC; 02998940
|
|
P1 ~ DI; 02998960
|
|
P13(DI ~ P2; SI ~ P2; SI ~ SI + 1; 02998980
|
|
DS ~ P13 CHR; DS ~ LIT "."; JUMP OUT TO X); X: 02999000
|
|
END; 02999020
|
|
BUFF ~ P; 02999040
|
|
GO TO COMM; 02999060
|
|
AST: 02999080
|
|
STREAM(P1 ~ 0:P2 ~ BUFF,P3 ~ W); 02999100
|
|
BEGIN DI ~ P2; P3(DS ~ LIT "*"); P1 ~ DI; END; 02999120
|
|
BUFF ~ P; 02999140
|
|
COMM: 02999160
|
|
END CONVERT; 02999180
|
|
COMMENT * * * * * * * * * * END OF DECLARATIONS * * * * * * * * * * * ; 02999200
|
|
FIB ~ FILX[NOT 2]; % OPEN FILE IF NOT OPEN 02999220
|
|
IF DKADR < 0 THEN BEGIN FLG ~ 1; DKADR ~0 END; 02999240
|
|
IF FIB[5].[43:1] THEN P(MKS,0,0,FILX,1,SELECT); 02999260
|
|
PRNTR~2|(FIB[5].[41:2]!0) ; %%% IFF FILE IS CLOSED, SETS PRNTR.[46:1]=1.02999280
|
|
IF PRNTR THEN STREAM(TPAR); DS~8LIT" " ; 02999290
|
|
CKPB; ARRAYSTUFF ~ 0; 02999300
|
|
IF FIB[0] = 0 THEN FIB[0] := 1 ELSE 02999320
|
|
IF FIB[0] NEQ 1 THEN P(MKS,FIB[6],FILX.[33:15],4,FORTERR); 02999340
|
|
LSTRN ~0; CHR ~ " "; NLI ~ FI; 02999420
|
|
NAMEV ~ CHR&"$"[18:42:6]; 02999430
|
|
NCR ~NCR + (NFCI ~ 2); PUT; 02999440
|
|
NAMEV ~ FMTA[NLI].[12:36]; 02999450
|
|
NLE ~ FMTA[NLI].[2:10]; 02999460
|
|
NMSZ; PUT; NCR ~ NCR + NFCI; 02999470
|
|
NAMEV ~ CHR; NCR ~ NCR + (NFCI ~ 1); PUT; 02999480
|
|
02999490
|
|
NM1: GETLIST; IF ENDLIST THEN 02999500
|
|
BEGIN; 02999510
|
|
STREAM(P1~BUFF); 02999520
|
|
BEGIN 02999530
|
|
DI ~ P1; DI ~ DI - 3; DS ~ LIT "$"; 02999540
|
|
END; 02999550
|
|
DONETOG ~ TRUE; PRNT; 02999560
|
|
END; 02999570
|
|
IF PRNTR THEN PRNT; 02999580
|
|
CODE~NAMEV; NAMEV~CHR; NCR~NCR+(NFCI~2); PUT; NAMEV~CODE; 02999590
|
|
NMSZ; 02999600
|
|
IF ELMTYP = INTEGV THEN 02999610
|
|
BEGIN W ~12; D ~0; CODE ~ ITYPE END ELSE 02999620
|
|
IF ELMTYP = LOGV THEN 02999630
|
|
BEGIN W ~1; CODE ~ LTYPE END ELSE 02999640
|
|
IF ELMTYP = DBLV THEN 02999650
|
|
BEGIN W ~29; D ~23; CODE ~ DTYPE END ELSE 02999660
|
|
BEGIN W ~18; D ~ 12; CODE ~ ETYPE END; 02999670
|
|
IF (6 + W + NFCI + ( IF CMPLX THEN (W+3) ELSE 0) + NCR) 02999680
|
|
} LCR THEN PRNT; 02999690
|
|
PUT; % NAME 02999700
|
|
NCR ~ NCR + NFCI + 3; 02999710
|
|
NAMEV ~ CHR&" ="[12:36:12]; NFCI ~3; PUT; 02999720
|
|
NM2: IF ELMTYP = CMPLXV THEN 02999740
|
|
BEGIN 02999750
|
|
IF (NCR+W+W+6) } LCR THEN PRNT; 02999760
|
|
NCR ~ NCR + (NFCI ~1); NAMEV ~ CHR&"("[12:42:6]; PUT; 02999770
|
|
NCR ~ NCR + W; CONVERT; 02999780
|
|
NCR ~ NCR + (NFCI~1); NAMEV ~ CHR&","[12:42:6]; PUT; 02999790
|
|
CTOG ~ TRUE; 02999800
|
|
GETLIST; 02999810
|
|
NCR ~ NCR + W; CONVERT; 02999820
|
|
NCR ~ NCR + (NFCI ~4); 02999830
|
|
NAMEV ~ CHR&"),"[12:36:12]; PUT; 02999840
|
|
END 02999850
|
|
ELSE 02999860
|
|
BEGIN 02999870
|
|
IF (NCR + W + 3) } LCR THEN PRNT; 02999880
|
|
NCR ~ NCR + W; CONVERT; 02999890
|
|
NCR ~ NCR + (NFCI ~ 3); 02999900
|
|
NAMEV ~ CHR&","[12:42:6]; PUT; 02999910
|
|
END; 02999920
|
|
IF NOT ATOG THEN GO TO NM1; 02999930
|
|
GETLIST; GO TO NM2; 02999940
|
|
FMERR: 02999950
|
|
P(MKS,FIB[6],FILX.[33:15],0,FORTERR); 02999960
|
|
END FOUTNAME; 02999970
|
|
PROCEDURE DABS ; % 052 03000000
|
|
COMMENT ABSOLUTE VALUE OF A DOUBLE PRECISION NUMBER; % PF JUNE 67 03000100
|
|
BEGIN REAL X = -1, 03000200
|
|
XL = -2, 03000300
|
|
JUNK = 17; 03000400
|
|
P(X,SSP,.JUNK,STD,XL,RTN); 03000500
|
|
END DABS; 03000600
|
|
PROCEDURE CABS ; % 053 03100000
|
|
COMMENT COMPLEX ABSOLUTE INTRINSIC; % PF JUNE 67 03100100
|
|
BEGIN REAL X = -1, 03100200
|
|
Y = -2, 03100300
|
|
SQRT=+1 ; 03100400
|
|
P(INTDESC(SQRTI)) ; 03100410
|
|
IF (X ~ ABS(X)) = 0 OR (Y ~ ABS(Y)) = 0 THEN P(X,Y,ADD,RTN) 03100500
|
|
ELSE IF X > Y THEN P(MKS,1,Y,X,/,DUP,MUL,ADD,SQRT,X,MUL) 03100600
|
|
ELSE P(MKS,1,X,Y,/,DUP,MUL,ADD,SQRT,Y,MUL); 03100700
|
|
P(RTN); 03100800
|
|
END CABS; 03100900
|
|
PROCEDURE AINT ; % 054 03200000
|
|
BEGIN REAL X = -1; 03200100
|
|
P(X,1,DIV,RTN); 03200200
|
|
END AINT; 03200300
|
|
PROCEDURE MATH; % 055 03300000
|
|
COMMENT MATHEMATIC MANIPULATION INTRINSIC % PF JUNE 67 03300100
|
|
CODE = 3|TYPE(OP 1) + 9|0PERATOR + TYPE(OP 2) 03300200
|
|
TYPE VALUE OPERAIOR VALUE 03300300
|
|
REAL 0 + 0 03300400
|
|
DOUBLE 1 - 1 03300500
|
|
COMPLEX 2 * 2 03300600
|
|
/ 3; 03300700
|
|
BEGIN REAL CODE = -1, 03300800
|
|
A = -3, 03300900
|
|
B = -4, 03301000
|
|
C = -5, 03301100
|
|
D = -6, 03301200
|
|
ERR = 24, 03301250
|
|
T; 03301300
|
|
LABEL RPLUSD,RPLUSC,DPLUSC,CPLUSD,CPLUSC,RLESSD,RLESSC,DLESSC, 03301400
|
|
CLESSD,CLESSC,RTIMED,RTIMEC,DTIMEC,CTIMED,CTIMEC,RDIVDD, 03301500
|
|
RDIVDC,DDIVDC,CDIVDD,CDIVDC,CTIMER,CDIVDR,INLINE; 03301600
|
|
GO TO P(CODE,DUP,ADD); 03301700
|
|
GO TO INLINE; % REAL + REAL 0 03301800
|
|
GO TO RPLUSD; % REAL + DOUBLE 1 03301900
|
|
GO TO RPLUSC; % REAL + COMPLEX 2 03302000
|
|
GO TO INLINE; % DOUBLE + REAL 3 03302100
|
|
GO TO INLINE; % DOUBLE + DOUBLE 4 03302200
|
|
GO TO DPLUSC; % DOUBLE + COMPLEX 5 03302300
|
|
GO TO INLINE; % COMPLEX + REAL 6 03302400
|
|
GO TO CPLUSD; % COMPLEX + DOUBLE 7 03302500
|
|
GO TO CPLUSC; % COMPLEX + COMPLEX 8 03302600
|
|
GO TO INLINE; % REAL - REAL 9 03302700
|
|
GO TO RLESSD; % REAL - DOUBLE 10 03302800
|
|
GO TO RLESSC; % REAL - COMPLEX 11 03302900
|
|
GO TO INLINE; % DOUBLE - REAL 12 03303000
|
|
GO TO INLINE; % DOUBLE - DOUBLE 13 03303100
|
|
GO TO DLESSC; % DOUBLE - COMPLEX 14 03303200
|
|
GO TO INLINE; % COMPLEX - REAL 15 03303300
|
|
GO TO CLESSD; % COMPLEX - DOUBLE 16 03303400
|
|
GO TO CLESSC; % COMPLEX - COMPLEX 17 03303500
|
|
GO TO INLINE; % REAL * REAL 18 03303600
|
|
GO TO RTIMED; % REAL * DOUBLE 19 03303700
|
|
GO TO RTIMEC; % REAL * COMPLEX 20 03303800
|
|
GO TO INLINE; % DOUBLE * REAL 21 03303900
|
|
GO TO INLINE; % DOUBLE * DOUBLE 22 03304000
|
|
GO TO DTIMEC; % DOUBLE | COMPLEX 23 03304100
|
|
GO TO CTIMER; % COMPLEX | REAL 24 03304200
|
|
GO TO CTIMED; % COMPLEX | DOUBLE 25 03304300
|
|
GO TO CTIMEC; % COMPLEX | COMPLEX 26 03304400
|
|
GO TO INLINE; % REAL / REAL 27 03304500
|
|
GO TO RDIVDD; % REAL / DOUBLE 28 03304600
|
|
GO TO RDIVDC; % REAL / COMPLEX 29 03304700
|
|
GO TO INLINE; % DOUBLE / REAL 30 03304800
|
|
GO TO INLINE; % DOUBLE / DOUBLE 31 03304900
|
|
GO TO DDIVDC; % DOUBLE / COMPLEX 32 03305000
|
|
GO TO CDIVDR; % COMPLEX / REAL 33 03305100
|
|
GO TO CDIVDD; % COMPLEX / DOUBLE 34 03305200
|
|
GO TO CDIVDC; % COMPLEX / COMPLEX 35 03305300
|
|
RPLUSD: P(0,C,B,A,DLA,.B,STD,.C,STD,XIT); 03305400
|
|
RPLUSC: P(A,C,ADD,B,.C,STD,.B,STD,XIT); 03305500
|
|
DPLUSC: P(A,C,ADD,.C,STD,B,.D,STD,XIT); 03305600
|
|
CPLUSD: P(A,C,ADD,.C,STD,XIT); 03305700
|
|
CPLUSC: P(A,C,ADD,.C,STD,B,D,ADD,.D,STD,XIT); 03305800
|
|
RLESSD: P(0,C,B,A,DLS,.B,STD,.C,STD,XIT); 03305900
|
|
RLESSC: P(C,A,SUB,B,CHS,.C,STD,.B,STD,XIT); 03306000
|
|
DLESSC: P(C,A,SUB,.C,STD,B,CHS,.D,STD,XIT); 03306100
|
|
CLESSD: P(C,A,SUB,.C,STD,XIT); 03306200
|
|
CLESSC: P(D,B,SUB,.D,STD,C,A,SUB,.C,STD,XIT); 03306300
|
|
RTIMED: P(0,C,B,A,DLM,.B,STD,.C,STD,XIT); 03306400
|
|
RTIMEC: P(C,DUP,B,MUL,.C,STD,A,MUL,.B,STD,XIT); 03306500
|
|
DTIMEC: P(C,DUP,A,MUL,.C,STD,B,MUL,.D,STD,XIT); 03306600
|
|
CTIMER: P(A,DUP,B,MUL,.B,STD,C,MUL,.C,STD,XIT); 03306700
|
|
CTIMED: P(A,DUP,C,MUL,.C,STD,D,MUL,.D,STD,XIT); 03306800
|
|
CTIMEC: P(A,C,MUL,D,B,MUL,SUB,C,B,MUL,A,D,MUL,ADD,.D,STD,.C,STD,XIT); 03306900
|
|
RDIVDD: P(0,C,B,A,DLD,.B,STD,.C,STD,XIT); 03307000
|
|
RDIVDC: P(C,A,DUP,MUL,B,DUP,MUL,ADD,/,DUP,B,MUL,CHS, 03307100
|
|
C,STD,A,MUL,.B,STD,XIT); 03307200
|
|
DDIVDC: P(C,A,DUP,MUL,B,DUP,MUL,ADD,/,DUP,B,MUL,CHS, 03307300
|
|
D,STD,A,MUL,.C,STD,XIT); 03307400
|
|
CDIVDR: P(B,A,/,.B,STD,C,A,/,.C,STD,XIT); 03307500
|
|
CDIVDD: P(C,A,/,.C,STD,D,A,/,.D,STD,XIT); 03307600
|
|
CDIVDC: P(A,C,MUL,B,D,MUL,ADD,A,DUP,MUL,B,DUP,MUL,ADD,.T,STN,/, 03307700
|
|
A,D,MUL,B,C,MUL,SUB,T,/,.D,STD,.C,STD,XIT); 03307800
|
|
INLINE: P(MKS,10,ERR); % COMPILER WRITERS ERROR 03307900
|
|
END MATH; 03308000
|
|
PROCEDURE XTOI; % 056 03400000
|
|
COMMENT VARIOUS COMBINATIONS OF X TO THE I % PF JUNE 67 03400100
|
|
CODE = 3|TYPE(OP 1) + TYPE(OP 2) 03400200
|
|
TYPE VALUE 03400300
|
|
REAL 0 03400400
|
|
DOUBLE 1 03400500
|
|
COMPLEX 2; 03400600
|
|
BEGIN REAL CODE = -1, 03400700
|
|
A = -3, 03400800
|
|
B = -4, 03400900
|
|
C = -5, 03401000
|
|
D = -6, 03401100
|
|
JUNK = 17, 03401200
|
|
T=+1,V=+2,ERR=+3,BOOL=+4,CDTOG=+5 ; 03401300
|
|
REAL EXPINT=27, LNINT=29 ; 03401350
|
|
INTEGER J=+6,I=J,R=CDTOG ; 03401400
|
|
REAL EXP=+7,LN=+8,DEXP=EXP,DLOG=LN,CABS=+9,ATAN2=+10,SQRT=+11, 03401500
|
|
COS=+12,SIN=+13 ; 03401510
|
|
DEFINE DF(DF1)=FLAG(DF1 OR T) # ; 03401520
|
|
LABEL REXPOR,DEXPOR,REXPOD,DEXPOD,CEXPOD,CEXPOR,REXPOC,DEXPOC,L1, 03401600
|
|
L2,L3,L4,CEXPOC,CDENT,RDENT,TOPI,TOPIL,PI2,TPI2,HAF,PI,MAX, 03401700
|
|
F096,L5,PIT,CREL,PICK,RX1,RX2,REXPOR1,CEXPOD2 ; 03401710
|
|
P(0&85[1:41:7],0,DF(FORTERRI),0,0,0); IF CODE=0 THEN GO REXPOR ; 03401800
|
|
IF CODE<5 THEN IF CODE!2 THEN BEGIN P(DF(DEXPI),DF(DLOGI)); GO PICK END;03401900
|
|
P(DF(EXPI),DF(LNI),DF(CABSI),DF(ATAN2I),DF(SQRTI),DF(COSI),DF(SINI)) ; 03401910
|
|
PICK: T~0 ; 03401920
|
|
GO TO P(CODE,DUP,ADD); 03402000
|
|
GO TO REXPOR; % REAL ** REAL 0 03402100
|
|
GO TO REXPOD; % REAL ** DOUBLE 1 03402200
|
|
GO TO REXPOC; % RLAL ** COMPLEX 2 03402300
|
|
GO TO DEXPOR; % DOUBLE ** REAL 3 03402400
|
|
GO TO DEXPOD; % DOUBLE ** DOUBLE 4 03402500
|
|
GO TO DEXPOC; % DOUBLE ** COMPLEX 5 03402600
|
|
GO TO CEXPOR; % COMPLEX ** REAL 6 03402700
|
|
GO TO CEXPOD; % COMPLEX ** DOUBLE 7 03402800
|
|
GO TO CEXPOC; % COMPLEX ** COMPLEX 8 03402810
|
|
DEXPOC: R~P(.C); I~P(.D); C~C+0&C[1:1:8]&D[47:9:1]; GO L3 ; 03402815
|
|
REXPOC: R~P(.B); I~P(.C) ; 03402820
|
|
L3: IF C=0 THEN BEGIN P(0); GO L1 END ; 03402825
|
|
IF B=0 THEN 03402830
|
|
BEGIN 03402835
|
|
IF A=0 THEN BEGIN P(1); GO L1 END ; 03402837
|
|
IF C>0 THEN GO L5 ; 03402840
|
|
IF ABS(A) LEQ P(MAX) THEN IF P(A,.BOOL,ISN)=A THEN 03402845
|
|
L4: BEGIN A~BOOL ; 03402850
|
|
L5: P(ABS(C),A,MKS,.EXP,LOD,INTCALL(*P(.LN),XTOII),DEL) ;03402855
|
|
IF B!0 THEN GO L2; IF BOOL THEN P(CHS) ; 03402860
|
|
L1: P(R,STD,0,I,STD,XIT) ; 03402865
|
|
END ; 03402870
|
|
T~P(PI)|A; P(MKS,MKS,ABS(C),LN,A,|,EXP); GO L2 ; 03402875
|
|
END ; 03402880
|
|
T~(V~P(MKS,ABS(C),LN))|B ; 03402885
|
|
IF A=0 THEN 03402890
|
|
BEGIN 03402895
|
|
IF C>0 THEN P(MKS,T,COS,R,STD,MKS,T,SIN,I,STD,XIT) ; 03402900
|
|
P(MKS,(-P(PI))|B,EXP) ; 03402905
|
|
L2: P(V~P,MKS,T,COS,|,R,STD,MKS,T,SIN,V,|,I,STD,XIT) ; 03402910
|
|
END ; 03402915
|
|
IF C<0 THEN 03402920
|
|
BEGIN P(MKS,V|A-B|P(PI),EXP); T~T+P(PI)|A; GO L2 END ; 03402925
|
|
IF ABS(A) LEQ 1023 THEN IF P(A,.BOOL,ISN)=A THEN GO L4 ; 03402930
|
|
P(MKS,A|V,EXP); GO L2 ; 03402950
|
|
CEXPOC: IF B=0 THEN GO CEXPOD2 ; 03402965
|
|
R~P(.C); I~P(.D); IF D=0 THEN GO L3 ; 03402970
|
|
IF C=0 THEN BEGIN T~ABS(D); P(PIT); IF D<0 THEN P(SSN); V~P END03402975
|
|
ELSE BEGIN T~P(MKS,D,C,CABS); V~P(MKS,D,C,ATAN2) END ; 03402980
|
|
T~(BOOL~P(MKS,T,LN))|B+V|A; P(MKS,BOOL|A-V|B,EXP); GO L2 ; 03402985
|
|
PI::: 3.14159265359 ; 03402990
|
|
MAX::: @0007777777777777 ; 03402991
|
|
PIT::: @1141444176652104 ; 03402992
|
|
REXPOR: IF B = 0 OR B = 1 THEN P(XIT); 03403000
|
|
IF A = 0 THEN P(1,.B,STD,XIT); 03403100
|
|
IF ABS(A)<4096 THEN IF (J~A)=A THEN 03403200
|
|
REXPOR1: BEGIN IF BOOL~J<0 THEN J~-J ; 03403300
|
|
P(J,.T,STD,B); 03403400
|
|
WHILE (T ~ (J ~ T).[36:11]) ! 0 DO 03403500
|
|
BEGIN P(DUP); 03403600
|
|
IF J THEN 03403700
|
|
BEGIN V ~ V + 1; 03403800
|
|
P(DUP); 03403900
|
|
END; 03404000
|
|
P(MUL); 03404100
|
|
END; 03404200
|
|
WHILE (V ~ V - 1) } 0 DO P(MUL); 03404300
|
|
IF BOOL THEN P(1,XCH,/); 03404400
|
|
IF CDTOG!0 THEN 03404410
|
|
BEGIN 03404415
|
|
IF CDTOG>2 THEN P(.C,.D) ELSE P(.B,.C) ; 03404420
|
|
J~(J~A) AND 3; 03404422
|
|
IF BOOL AND J THEN J~(J+2) AND 3; 03404424
|
|
IF C=0 THEN RX1: P(0,XCH,STD,STD,XIT) ; 03404425
|
|
IF J = 0 THEN GO RX1; 03404430
|
|
IF J=1 THEN BEGIN P(XCH); GO RX1 END ; 03404435
|
|
IF J=2 THEN RX2: P(0,XCH,STD,XCH,CHS,XCH,STD,XIT) ; 03404440
|
|
P(XCH); GO RX2 ; 03404445
|
|
END ; 03404450
|
|
P(.B,STD,XIT); 03404500
|
|
END; 03404600
|
|
IF B>0 03404700
|
|
THEN P(MKS,MKS,B,LNINT,A,|,EXPINT,.B,STD,XIT); %FORTRAN ONLY 03404710
|
|
P(MKS,11,ERR); 03404800
|
|
REXPOD: P(0,.B,.C); GO RDENT ; 03404900
|
|
DEXPOR: P(C,.B,.C); C~B; B~0; GO RDENT ; 03405000
|
|
DEXPOD: P(D,.C,.D) ; 03405100
|
|
RDENT: CODE~P; R~P; JUNK~P; IF C=0 THEN P(0,CODE,STD,XIT) ; 03405200
|
|
IF A=0 THEN P(1,R,STD,0,CODE,STD,XIT) ; 03408100
|
|
IF B = 0 THEN 03408200
|
|
IF ABS(A)<P(F096) THEN IF (J~A)=A THEN 03408300
|
|
BEGIN IF BOOL ~ J < 0 THEN J ~ -J; 03408400
|
|
P(J,.T,STD,JUNK,C) ; 03408500
|
|
WHILE (T ~ (J ~ I).[36:11]) ! 0 DO 03408600
|
|
BEGIN P(.A,STD,DUP,A,XCH,A); 03408700
|
|
IF J THEN 03408800
|
|
BEGIN V ~ V + 1; 03408900
|
|
P(.A,STD,DUP,A,XCH,A); 03409000
|
|
END; 03409100
|
|
P(DLM); 03409200
|
|
END; 03409300
|
|
WHILE (V ~ V - 1) } 0 DO P(DLM); 03409400
|
|
IF BOOL THEN P(.T,STD,0,XCH,1,XCH,T,DLD) ; 03409500
|
|
P(R,STD,CODE,STD,XIT) ; 03409600
|
|
END; 03409700
|
|
IF C>0 THEN P(MKS,MKS,JUNK,C,DLOG,JUNK,B,A,DLM,DEXP,CODE,STD, 03409800
|
|
JUNK,R,STD,XIT) ; 03409900
|
|
P(MKS,11,ERR); 03410000
|
|
CEXPOR: IF B =0 THEN IF C = 0 THEN P(XIT); 03410100
|
|
IF A = 0 THEN P(1,.B,STD,0,.C,STD,XIT); 03410200
|
|
CDENT: IF ABS(A)<P(F096) THEN IF (J~A)=A THEN 03410300
|
|
BEGIN 03410305
|
|
IF C=0 OR B=0 THEN 03410310
|
|
BEGIN CDTOG~CDTOG OR 2; IF B=0 THEN B~C; GO REXPOR1 END ; 03410315
|
|
IF BOOL~J<0 THEN J~-J ; 03410400
|
|
GO CREL; F096::: 4096; CREL: 03410450
|
|
P(J,.T,STD,C,B); 03410500
|
|
WHILE (T ~ (J ~ T).[36:11]) ! 0 DO 03410600
|
|
BEGIN P(.A,STD,DUP,A,XCH,A); 03410700
|
|
IF J THEN 03410800
|
|
BEGIN V ~ V + 1; 03410900
|
|
P(.A,STD,DUP,A,XCH,A); 03411000
|
|
END; 03411100
|
|
P(DUP,MUL,XCH,DUP,MUL,SUB,.A,STD,MUL,DUP,ADD,A); 03411200
|
|
END; 03411300
|
|
WHILE (V ~ V - 1) } 0 DO 03411400
|
|
P(.A,STD,.B,STD,.C,STD,DUP,A,MUL,B,C,MUL,ADD, 03411500
|
|
XCH,CHS,B,MUL,A,C,MUL,ADD); 03411600
|
|
IF BOOL THEN P(.A,STD,CHS,DUP,DUP,MUL,A,DUP, 03411700
|
|
MUL,ADD,.B,STN,/,A,B,/); 03411800
|
|
IF CDTOG THEN P(.C,STD,.D,STD,XIT) 03411900
|
|
ELSE P(.B,STD,.C,STD,XIT); 03412000
|
|
END; 03412100
|
|
C ~ (V ~ P(MKS,MKS,MKS,0,B,CABS,LN,A,MUL,EXP)) 03412200
|
|
|(A ~ P(MKS,MKS,C,B,ATAN2,A,MUL,TOPI,MOD,.T,STN,SIN)); 03412300
|
|
P(MKS,1,A,DUP,MUL,SUB,SQRT); 03412400
|
|
IF T > P(PI2) THEN IF T < P(TPI2) THEN P(CHS); 03412500
|
|
P(V,MUL,.B,STD); 03412600
|
|
IF CDTOG THEN P(C,.D,STD,B,.C,STD); 03412700
|
|
P(XIT); 03412800
|
|
CEXPOD: A~A+0&A[1:1:8]&B[47:9:1] ; 03412900
|
|
CEXPOD2: IF C=0 THEN IF D=0 THEN P(XIT) ; 03413000
|
|
IF A=0 THEN P(1,.C,STD,0,.D,STD,XIT) ; 03413050
|
|
B ~ C; 03413100
|
|
C ~ D; 03413200
|
|
CDTOG ~ TRUE; 03413300
|
|
GO TO CDENT; 03413400
|
|
TOPI ::: @1146220773250420; TOPIL ::: @0005506043230461; 03413500
|
|
HAF ::: @1154000000000000; 03413600
|
|
PI2 ::: @1141444176652104; 03413700
|
|
TPI2 ::: @1144554574376314; 03413800
|
|
03413900
|
|
END XTOI; 03414000
|
|
PROCEDURE IDINT ; % 057 03500000
|
|
COMMENT DOUBLE TO INTEGER CONVERT; % PF JULY 67 03501000
|
|
BEGIN REAL X = -1, 03501001
|
|
XL = -2; 03501002
|
|
P(X + 0&X[1:1:8]&XL[47:9:1],1,DIV,RTN); 03501004
|
|
END IDINT; 03501005
|
|
PROCEDURE FLOAT ; % 060 03600000
|
|
BEGIN REAL X = -1; 03600100
|
|
P(X, RTN); 03600200
|
|
END FLOAT; 03600300
|
|
PROCEDURE SNGL ; % 061 03700000
|
|
COMMENT SNGL INTRINSIC (DOUBLE TO SINGLE CONVERT); % PF JUNE 67 03700100
|
|
BEGIN REAL X = -1, 03700200
|
|
XL= -2; 03700300
|
|
P(X + 0&X[1:1:8]&XL[47:9:1],RTN); 03700400
|
|
03700500
|
|
END SNGL; 03700600
|
|
PROCEDURE DBLE ; % 062 03800000
|
|
COMMENT DBLE INTRINSIC (SINGLE TO DOUBLE); % PF JUNE 67 03800100
|
|
BEGIN REAL X = -1, 03800200
|
|
JUNK = 17; 03800300
|
|
P(X,.JUNK,STD,0,RTN); 03800400
|
|
END DBLE; 03800500
|
|
PROCEDURE AMOD ; % 063 03900000
|
|
BEGIN REAL X = -2, Y = -1; 03900100
|
|
P(X MOD Y, RTN); 03900200
|
|
END AMOD; 03900300
|
|
PROCEDURE TIME ; % 064 04000000
|
|
COMMENT FORTRAN TIME INTRINSIC (LIKE ALGOL); % PF JULY 67 04001000
|
|
BEGIN REAL X =-1; 04001002
|
|
P(X,1,COM,RTN); 04001003
|
|
END TIME; 04001004
|
|
PROCEDURE DMOD ; % DOUBLE PRECISION MOD INTRINSIC # @065. 04100000
|
|
BEGIN 04100100
|
|
REAL H=+2, B=-1, BL=-2, A=-3, AL=-4, E=17; LABEL G,Q ; 04100200
|
|
IF B=0 THEN IF BL=0 THEN P(MKS,INTCALL(13,FORTERRI)) ; 04100300
|
|
IF P(AL,ABS(A),BL,NABS(B),DLA,DUP)=0 THEN GO Q ; 04100400
|
|
IF P<0 THEN P(AL,A,.E,~,RTN) ; 04100500
|
|
IF (E~P(AL,A,BL,8,DLD,DUP).[3:6])>13 THEN P(.E,ISD) ; 04100550
|
|
P(XCH) ; 04100600
|
|
IF E=0 OR H.[2:1] THEN BEGIN P(DEL,0,XCH,E);::P(.G,+,LOD,LND,XCH)END04100700
|
|
ELSE BEGIN P(13-E); :: P(.G,+,LOD,LND) END ; 04100750
|
|
IF P(DUP,ABS(H),0,1,DLA,BL,NABS(B),DLM,AL,ABS(A),DLA)}0 THEN 04100800
|
|
Q: P(E~0,RTN) ; 04100850
|
|
P(DEL,XCH,BL,B,DLM,CHS,AL,A,DLA,.E,~,RTN) ; 04100900
|
|
G:::@3777777777777777, % DYNAMIC MASK CONSTANTS. 04101000
|
|
@3777777777777770,@3777777777777700,@3777777777777000,@3777777777770000,04101050
|
|
@3777777777700000,@3777777777000000,@3777777770000000,@3777777700000000,04101100
|
|
@3777777000000000,@3777770000000000,@3777700000000000,@3777000000000000;04101200
|
|
END OF DMOD ; 04101300
|
|
PROCEDURE DMAX1 ; % 066 04200000
|
|
COMMENT DOUBLE PRCISION MAX ROUTINE; % PF JUNE 67 04200100
|
|
BEGIN REAL X = -1, 04200200
|
|
XL = -2, 04200300
|
|
JUNK = 17, 04200400
|
|
RCW = +0, SIZE = +1, NEW = +2, NEWL = +3, JUNKL = +4; 04200500
|
|
P([RCW] INX 0,0,RCW,FCX,1,INX,SUB,0,0,XL,X,.JUNK,STD); 04200600
|
|
WHILE (SIZE ~ SIZE - 2) > 0 DO 04200700
|
|
IF P(NEWL ~ *P(.X,SIZE,ADD,.NEW,STN,1,ADD),NEW ~ *P(NEW), 04200800
|
|
JUNKL,JUNK,DLS,XCH,DEL) > 0 THEN 04200900
|
|
BEGIN JUNKL ~ NEWL; 04201000
|
|
JUNK ~ NEW; 04201100
|
|
END; 04201200
|
|
P(JUNKL,RTN); 04201300
|
|
END DMAX1; 04201400
|
|
PROCEDURE DMIN1 ; % 067 04300000
|
|
COMMENT DOUBLE PRCISION MIN ROUTINE; % PF JUNE 67 04300100
|
|
BEGIN REAL X = -1, 04300200
|
|
XL = -2, 04300300
|
|
JUNK = 17, 04300400
|
|
RCW = +0, SIZE = +1, NEW = +2, NEWL = +3, JUNKL = +4; 04300500
|
|
P([RCW] INX 0,0,RCW,FCX,1,INX,SUB,0,0,XL,X,.JUNK,STD); 04300600
|
|
WHILE (SIZE ~ SIZE - 2) > 0 DO 04300700
|
|
IF P(NEWL ~ *P(.X,SIZE,ADD,.NEW,STN,1,ADD),NEW ~ *P(NEW), 04300800
|
|
JUNKL,JUNK,DLS,XCH,DEL) < 0 THEN 04300900
|
|
BEGIN JUNKL ~ NEWL; 04301000
|
|
JUNK ~ NEW; 04301100
|
|
END; 04301200
|
|
P(JUNKL,RTN); 04301300
|
|
END DMIN1; 04301400
|
|
PROCEDURE SIGNV ; % 070 04400000
|
|
COMMENT SIGN INTRINSIC; % PF JUNE 67 04400100
|
|
BEGIN REAL S = -1, 04400200
|
|
X = -2; 04400300
|
|
P(X); 04400400
|
|
IF S.[1:1] THEN P(SSN,RTN) ELSE P(SSP,RTN); 04400500
|
|
END SIGN; 04400600
|
|
PROCEDURE DSIGN ; % 071 04500000
|
|
COMMENT COMPLEX DOUBLE SIGN INTRINSIC; % PF JUNE 67 04500100
|
|
BEGIN REAL S = -1, 04500200
|
|
X = -3, 04500300
|
|
XL = -4, 04500400
|
|
JUNK = 17; 04500500
|
|
P(X); 04500600
|
|
IF S.[1:1] THEN P(SSN) ELSE P(SSP); 04500700
|
|
P(.JUNK,STD,XL,RTN); 04500750
|
|
END DSIGN; 04500800
|
|
PROCEDURE DIIM ; % 072 04600000
|
|
BEGIN REAL X = -2, Y = -1; 04600100
|
|
P(X -(IF X { Y THEN X ELSE Y),RTN); 04600200
|
|
END DIIM; 04600300
|
|
PROCEDURE REALP ; % 073 04700000
|
|
COMMENT COMPLEX TO REAL INTRINSIC; % PF JUNE 67 04700100
|
|
BEGIN REAL X = -1; 04700200
|
|
P(X,RTN); 04700300
|
|
END REALP; 04700400
|
|
PROCEDURE AIMAG ; % 074 04800000
|
|
COMMENT IMAGINARY PART OF COMPLEX NUMBER; % PF JULY 67 04801000
|
|
BEGIN REAL Y = -2; 04801010
|
|
P(Y,RTN); 04801020
|
|
END AIMAG; 04801030
|
|
PROCEDURE CMPLX ; % 075 04900000
|
|
COMMENT TWO REALS TO A COMPLEX; % PF JULY 67 04900100
|
|
BEGIN REAL Y = -1, 04900200
|
|
X = -2, 04900250
|
|
JUNK = 17; 04900300
|
|
P(X,.JUNK,STD,Y,RTN); 04900400
|
|
END CMPLX; 04900500
|
|
PROCEDURE CONJG ; % 076 05000000
|
|
COMMENT CONJUGATF INTRINSIC; % PF JUNE 67 05000100
|
|
BEGIN REAL X = -1, 05000200
|
|
XL = -2, 05000300
|
|
JUNK = 17; 05000400
|
|
P(X,.JUNK,STD,XL,CHS,RTN); 05000500
|
|
END CONJG; 05000600
|
|
PROCEDURE DEXP ; % 077 05100000
|
|
COMMENT DOUBLE PRECISION EXPONENTIAL INTRINSIC; % PF JUNE 67 05100100
|
|
BEGIN REAL X = -1, 05100200
|
|
XL = -2, 05100300
|
|
JUNK = 17, 05100400
|
|
T,TL; 05100500
|
|
BOOLEAN SIG,HUGE; 05100600
|
|
INTEGER N; 05100700
|
|
LABEL AT13,LG2,LG2L,EMAX,HAF,A,AL,B,BL,C,CL,D,DL,E,EL,F,FL,G,GL, 05100800
|
|
CLGL,H,HL,I,IL,J,JL,K,KL,L,LL,M,ML; 05100900
|
|
DEFINE TIMES = NOP,DLA,XL,X,NOP,DLM#; 05101000
|
|
IF SIG ~ X.[1:1] THEN X ~ ABS(X); 05101100
|
|
IF HUGE~X>27 THEN IF X>P(EMAX) THEN P(MKS,INTCALL(14,FORTERRI)) ; 05101150
|
|
05101250
|
|
P(XL,X,LG2L,LG2,DLD,.X,STD,DUP,X,XCH,X,0,AT13,DLA,0,AT13,DLS, 05101300
|
|
.JUNK,STN,DLS,.X,STD,.XL,STD); 05101400
|
|
T ~ 1; IF HUGE THEN WHILE (N ~ N + 1) { JUNK DO P(TL,DUP,T,XCH,T,DLA, 05101500
|
|
T,STD,.TL,STD) 05101501
|
|
ELSE WHILE (N ~ N + 1) { JUNK DO T ~ P(T,DUP,ADD); 05101502
|
|
P(ML,M,XL,X,DLM); 05101600
|
|
:: P(LL,L,TIMES,KL,K,TIMES,JL,J,TIMES,IL,I,TIMES,HL,H,TIMES,GL,G,TIMES, 05101700
|
|
FL,F,TIMES,EL,F,TIMES,DL,D,TIMES,CL,C,TIMES,BL,B,TIMES,AL,A,TIMES, 05101800
|
|
CLGL,LG2,TIMES,0,1,DLA,TL,T,DLM,.JUNK,STD); 05101900
|
|
IF SIG THEN P(0,XCH,1,XCH,JUNK,DLD,.JUNK,STD); 05102000
|
|
P(RTN); 05102100
|
|
AT13 ::: @0151000000000000; 05102200
|
|
HAF ::: @1154000000000000; 05102300
|
|
EMAX ::: @1122360000000000; CLGL ::: @0007173632567030; 05102400
|
|
LG2 ::: @1155427102775750; LG2L ::: @0007173632571165; 05102500
|
|
M ::: @1333302330351773; ML ::: @0005405676153645; 05102600
|
|
L ::: @1325447251503330; LL ::: @0003745760641244; 05102700
|
|
K ::: @1301616647307714; KL ::: @0002676025700645; 05102800
|
|
J ::: @1273641733265077; JL ::: @0006664462403121; 05102900
|
|
I ::: @1267446477210572; IL ::: @0003454166117342; 05103000
|
|
H ::: @1241552224137002; HL ::: @0007263626741044; 05103100
|
|
G ::: @1232613001073174; GL ::: @0002061610334651; 05103200
|
|
F ::: @1223777137704414 FL ::: @0000407415212622; 05103300
|
|
E ::: @1215030221137052; EL ::: @0005757400272176; 05103400
|
|
D ::: @1205354177717051; DL ::: @0002237577766326; 05103500
|
|
C ::: @1174731253337351; CL ::: @0001657523134265; 05103600
|
|
B ::: @1163432604327011; BL ::: @0002027630376772; 05103700
|
|
A ::: @1151727757377602; AL ::: @0006130725275347; 05103800
|
|
END DEXP; 05103900
|
|
PROCEDURE CEXP ; % 100 05200000
|
|
COMMENT COMPLEX EXPONENTIAL INTRINSIC; % PF JUNE 67 05200100
|
|
BEGIN REAL X = -1, 05200200
|
|
Y = -2, 05200300
|
|
JUNK = 17 ; 05200400
|
|
LABEL EMAX,TOPI,PI2,TPI2; 05200800
|
|
IF ABS(X)>P(EMAX) THEN P(MKS,INTCALL(15,FORTERRI)) ; 05200900
|
|
P(MKS,INTCALL(X,EXPI),.X,STN,MKS,1,MKS,Y,TOPI,MOD,DUP,SSP,.Y,STD, 05201000
|
|
CALLINT(SINI),DUP,X,MUL,.JUNK,STD,DUP,MUL,SUB,CALLINT(SQRTI),MUL) ; 05201100
|
|
IF Y > P(PI2) THEN IF Y < P(TPI2) THEN P(CHS); 05201200
|
|
P(JUNK,XCH,.JUNK,STD,RTN); 05201300
|
|
EMAX ::: @1122360000000000; 05201400
|
|
TOPI ::: @1146220773250421; 05201500
|
|
PI2 ::: @1141444176652104; 05201600
|
|
TPI2 ::: @1144554574376314; 05201700
|
|
END CEXP; 05201800
|
|
PROCEDURE DLOG ; % 101 05300000
|
|
COMMENT DOUBLE PRECISION NATURAL LOG INTRINSIC; % PF JUNE 67 05300100
|
|
BEGIN REAL X = -1, 05300200
|
|
XL = -2, 05300300
|
|
JUNK = 17, 05300400
|
|
T,TL; 05300500
|
|
INTEGER N; 05300600
|
|
BOOLEAN LESS1; 05300700
|
|
LABEL HAF,LG2,LG2L,SQ2,SQ2L,A,AL,B,BL,C,CL,D,DL,E,EL,F,FL,G,GL, 05300800
|
|
H,HL,I,IL,J,JL; 05300900
|
|
DEFINE TIMES = NOP,DLA,XL,X,NOP,DLM#; 05301000
|
|
IF X LEQ 0 THEN P(MKS,INTCALL(16+(X!0),FORTERRI)) ; 05301100
|
|
IF LESS1 ~ X < 1 THEN P(0,1,XL,X,DLD,.X,STD,.XL,STD); 05301200
|
|
P(1,.N,STN,.JUNK,STD); 05301300
|
|
WHILE (JUNK ~ P(JUNK,DUP,ADD)) { X DO N ~ N + 1; 05301400
|
|
IF P(XL,X,0,JUNK,DLD,.JUNK,STD,.T,STN,JUNK,SQ2L,SQ2,DLS,XCH,DEL) < 0 05301500
|
|
THEN 05301550
|
|
BEGIN N ~ N - 1; 05301600
|
|
P(HAF,.IL,STD); 05301700
|
|
END ELSE TL ~ 1; 05301800
|
|
P(T,JUNK,0,TL,DLS,T,JUNK,0,TL,DLA,DLD,.JUNK,STD,.T,STN,DUP,JUNK,XCH, 05301900
|
|
JUNK,DLM,.X,STD,.XL,STN,X,JL,J,DLM); 05301950
|
|
:: P(IL,I,TIMES,HL,H,TIMES,GL,G,TIMES,FL,F,TIMES,EL,E,TIMES, 05302000
|
|
DL,D,TIMES,CL,C,TIMES,BL,B,TIMES,AL,A,TIMES, 05302100
|
|
0,2,DLA,T,JUNK,DLM,0,N,LG2L,LG2,DLM,DLA,.JUNK,STD); 05302200
|
|
IF LESS1 THEN P(JUNK,CHS,.JUNK,STD); 05302300
|
|
P(RTN); 05302400
|
|
HAF ::: @1154000000000000; 05302500
|
|
LG2 ::: @1155427102775750; LG2L ::: @0007173632571165; 05302600
|
|
SQ2 ::: @1155520236314774; SQ2L ::: @0007363110213136; 05302700
|
|
J ::: @1167100510467432; JL ::: @0002164460474016; 05302800
|
|
I ::: @1166521204435224; IL ::: @0007651024467003; 05302900
|
|
H ::: @1167420605757260; HL ::: @0002135500773125; 05303000
|
|
G ::: @1151042101275720; GL ::: @0000102676565544; 05303100
|
|
F ::: @1151166116643351; FL ::: @0001161621531011; 05303200
|
|
E ::: @1151350564271710; EL ::: @0007071635510300; 05303300
|
|
D ::: @1151616161616162; DL ::: @0006643172311051; 05303400
|
|
C ::: @1152222222222222; CL ::: @0002176633022026; 05303500
|
|
B ::: @1153146314631463; BL ::: @0001463176726243; 05303600
|
|
A ::: @1155252525252525; AL ::: @0002525252507053; 05303700
|
|
END DLDC; 05303800
|
|
PROCEDURE CLOG ; % 102 05400000
|
|
COMMENT COMPLEX LOG INTRINSIC; % PF JUNE 67 05400100
|
|
BEGIN REAL X = -1, 05400200
|
|
Y = -2, 05400300
|
|
JUNK = 17 ; 05400400
|
|
IF Y=0 THEN 05400900
|
|
IF X=0 THEN P(MKS,INTCALL(18,FORTERRI)) 05400950
|
|
ELSE IF X>0 THEN P(MKS,INTCALL(X,LNI),.JUNK,STD,0,RTN) ; 05400975
|
|
JUNK~P(MKS,INTCALL(P(MKS,X,INTCALL(Y,CABSI)),LNI)) ; 05401000
|
|
P(MKS,Y,INTCALL(X,ATAN2I),RTN) ; 05401100
|
|
END CLOG; 05401200
|
|
PROCEDURE ALOG10; % 103 05500000
|
|
COMMENT LOG BASE 10 INTRINSIC; % PF JUNE 67 05500100
|
|
BEGIN REAL X=-1 ; 05500200
|
|
LABEL LGI; 05500400
|
|
IF X LEQ 0 THEN P(MKS,INTCALL(19+(X!0),FORTERRI)) ; 05500500
|
|
P(MKS,INTCALL(X,LNI),LGI,MUL,RTN) ; 05500600
|
|
LGI ::: @1153362675425116; 05500700
|
|
END ALOC10; 05500800
|
|
PROCEDURE DLOG10; % 104 05600000
|
|
COMMENT DOUBLE PRECISION COMMON LOG INTRINSIC; % PF JUNE 67 05600100
|
|
BEGIN REAL X = -1, 05600200
|
|
XL = -2, 05600300
|
|
JUNK = 17 ; 05600400
|
|
LABEL LGI,LGIL; 05600600
|
|
IF X LEQ 0 THEN P(MKS,INTCALL(21+(X!0),FORTERRI)) ; 05600700
|
|
P(MKS,XL,INTCALL(X,DLOGI),JUNK,LGIL,LGI,DLM,.JUNK,STD,RTN) ; 05600800
|
|
LGI ::: @1153362675425115; LGIL ::: @0006241614523261; 05600900
|
|
END DLOG10; 05601000
|
|
PROCEDURE DSIN ; % 105 05700000
|
|
COMMENT DOUBLE PRECISION SINE INTRINSIC; % PF JUNE 67 05700100
|
|
BEGIN REAL X = -1, 05700200
|
|
XL = -2, 05700300
|
|
JUNK = 17, 05700400
|
|
T; 05700600
|
|
BOOLEAN SIG; 05700700
|
|
LABEL TOPI,TOPIL,PI,PIL,PI2,PI2L,TPI2,TPI2L, 05700800
|
|
A,AL,B,BL,C,CL,D,DL,E,EL,F,FL,G,GL,H,HL,I,IL,J,JL; 05700900
|
|
DEFINE ADDER = NOP,DLA,T,JUNK,NOP,DLM#, 05701000
|
|
SUBER = NOP,DLS,T,JUNK,NOP,DLM#; 05701050
|
|
IF SIG ~ X.[1:1] THEN X ~ P(X,SSP); 05701100
|
|
IF P(MKS,XL,X,TOPIL,INTCALL(TOPI,DMODI),JUNK,.X,STD,.XL,STN,X,PI2L,PI2, 05701200
|
|
DLS,XCH,DEL)>0 05701250
|
|
THEN IF P(XL,X,PIL,PI,DLS,XCH,DEL) { 0 05701300
|
|
THEN P(PIL,PI,XL,X,DLS) 05701400
|
|
ELSE BEGIN SIG ~ NOT SIG; 05701500
|
|
IF P(XL,X,TPI2L,TPI2,DLS,XCH,DEL) { 0 05701600
|
|
THEN P(XL,X,PIL,PI,DLS) 05701700
|
|
ELSE P(TOPIL,TOPI,XL,X,DLS); 05701800
|
|
END 05701900
|
|
ELSE P(XL,X); 05702000
|
|
P(.X,STD,.XL,STN,DUP,X,XCH,X,DLM,.JUNK,STD,.T,STN,JUNK,JL,J,DLM); 05702100
|
|
:: P(IL,I,SUBER,HL,H,ADDER,GL,G,SUBER,FL,F,ADDER,EL,E,SUBER,DL,D,ADDER, 05702200
|
|
CL,C,SUBER,BL,B,ADDER,AL,A,SUBER,0,1,DLA,XL,X,DLM,.JUNK,STD); 05702300
|
|
IF SIG THEN P(JUNK,CHS,.JUNK,STD); 05702400
|
|
P(RTN); 05702500
|
|
PI2 ::: @1141444176652104; PI2L ::: @0001321410646113; 05702600
|
|
PI ::: @1143110375524210; PIL ::: @0002643021514230; 05702700
|
|
TPI2 ::: @1144554574376314; TPI2L ::: @0004164432362343; 05702800
|
|
TOPI ::: @1146220773250420; TOPIL ::: @0005506043230461; 05702900
|
|
J ::: @1421317506616043; JL ::: @0004106341505647; 05703000
|
|
I ::: @1371136261610121; IL ::: @0001561406721354; 05703100
|
|
G ::: @1323271771732327; GL ::: @0001122361440352; 05703200
|
|
F ::: @1271302221411627; FL ::: @0002101305056316; 05703300
|
|
E ::: @1253271442547752; EL ::: @0002347333135765; 05703400
|
|
D ::: @1235616743512533; DL ::: @0000704703144000; 05703500
|
|
C ::: @1216400640064006; CL ::: @0004006354436671; 05703600
|
|
B ::: @1174210421042104; BL ::: @0002104210366543; 05703700
|
|
A ::: @1151252525252525; AL ::: @0002525252525234; 05703800
|
|
H ::: @1356251301236324;; HL ::: @0007344376112457; 05703900
|
|
END DSIN; 05704000
|
|
PROCEDURE CSIN ; % 106 05800000
|
|
COMMENT COMPLEX SINE INTRINSIC; % PF JUNE 67 05800100
|
|
BEGIN REAL X = -1, 05800200
|
|
Y = -2, 05800300
|
|
JUNK = 17, 05800400
|
|
T; 05800800
|
|
LABEL EMAX,HAF,TOPI,PI2,TPI2; 05800900
|
|
IF ABS(Y)>P(EMAX) THEN P(MKS,INTCALL(23,FORTERRI)) ; 05801000
|
|
P(MKS,INTCALL(Y,EXPI),DUP,DUP,1,XCH,/,.Y,STN,SUB,HAF,MUL,.T,STD, 05801100
|
|
Y,ADD,HAF,MUL,MKS,X,TOPI,MOD,DUP,SSP,.X,STD,CALLINT(SINI),.Y,STN,MUL, 05801200
|
|
MKS,1,Y,DUP,MUL,SUB,CALLINT(SQRTI),T,MUL) ; 05801300
|
|
IF X > P(PI2) THEN IF X < P(TPI2) THEN P(CHS); 05801400
|
|
P(XCH,.JUNK,STD,RTN); 05801500
|
|
EMAX ::: @1122360000000000; 05801600
|
|
HAF ::: @1154000000000000; 05801700
|
|
TOPI ::: @1146220773250421; 05801800
|
|
PI2 ::: @1141444176652104; 05801900
|
|
TPI2 ::: @1144554574376314; 05802000
|
|
END CSINE; 05802100
|
|
PROCEDURE DCOS ; % 107 05900000
|
|
COMMENT DOUBLE PRECISION COSINE INTRINSIC; % PF JUNE 67 05900100
|
|
BEGIN REAL X = -1, 05900200
|
|
XL = -2, 05900300
|
|
LOW = -4 ; 05900400
|
|
LABEL PI2,PI2L; 05900600
|
|
P(MKS,XL,X,PI2L,PI2,DLA,CALLINT(DSINI),RTN) ; 05900700
|
|
PI2 ::: @1141444176652104; PI2L ::: @0001321410646113; 05900800
|
|
END DCOS; 05900900
|
|
PROCEDURE CCOS ; % 110 06000000
|
|
COMMENT COMPLEX COSINE INTRINSIC; % PF JUN 67 06000100
|
|
BEGIN REAL X = -1, 06000200
|
|
Y = -2, 06000300
|
|
JUNK = 17, 06000400
|
|
T; 06000800
|
|
LABEL EMAX,HAF,TOPI,TPI2,PI2,MHAF; 06000900
|
|
IF ABS(Y)>P(EMAX) THEN P(MKS,INTCALL(24,FORTERRI)) ; 06001000
|
|
P(MKS,INTCALL(Y,EXPI),DUP,DUP,1,XCH,/,.Y,STN,SUB,MHAF,MUL,MKS,X,TOPI, 06001100
|
|
MOD,DUP,SSP,.X,STD,CALLINT(SINI),.T,STN,MUL,.JUNK,STD,Y,ADD,HAF,MUL, 06001200
|
|
MKS,1,T,DUP,MUL,SUB,CALLINT(SQRTI),MUL) ; 06001300
|
|
IF X > P(PI2) THEN IF X < P(TPI2) THEN P(CHS); 06001400
|
|
P(JUNK,XCH,.JUNK,STD,RTN); 06001500
|
|
EMAX ::: @1122360000000000; 06001600
|
|
HAF ::: @1154000000000000; 06001700
|
|
TOPI ::: @1146220773250421; 06001800
|
|
TPI2 ::: @1144554574376314; 06001900
|
|
PI2 ::: @1141444176652104; 06002000
|
|
MHAF ::: @3154000000000000; 06002100
|
|
END CCOS; 06002200
|
|
PROCEDURE TANF ; % 111 06100000
|
|
COMMENT TANGENT INTRINSIC; % PF MAY 67 06100100
|
|
BEGIN REAL RSQ; 06100200
|
|
REAL X = -1; 06100300
|
|
INTEGER Q; BOOLEAN S; 06100400
|
|
LABEL L1,L2,PMAX,MMAX,PI,PI2,PI4; 06100500
|
|
IF S ~ X.[1:1] THEN X ~ P(X,SSP); 06100600
|
|
IF (Q ~ P(X,PI,MOD,.X,STN,PI4,DIV)) ! 0 THEN X ~ 06100700
|
|
IF Q=1 THEN P(PI2,X,SUB) ELSE IF Q=2 THEN P(X,PI2,SUB) ELSE P(PI,X,SUB);06100800
|
|
IF X = 0 THEN BEGIN IF Q = 1 THEN P(PMAX) ELSE IF Q = 2 THEN P(MMAX) 06100900
|
|
ELSE P(0); GO TO L1; 06101000
|
|
END; 06101100
|
|
P(1,X,DUP,MUL,.RSQ,STN,DUP,.0097433825958,MUL,CHS,1,ADD,MUL, 06101200
|
|
16.248537744,SUB, 06101300
|
|
48.7456132319,RSQ,/,6.2497075488,SUB,RSQ,DUP, 06101400
|
|
.000361003565256,MUL,CHS,.136381360679,ADD,MUL,ADD, 06101500
|
|
/,ADD); 06101600
|
|
IF Q = 0 THEN P(X,XCH,/) 06101700
|
|
ELSE IF Q = 1 THEN P(X,/) 06101800
|
|
ELSE IF Q = 2 THEN P(X,/,CHS) 06101900
|
|
ELSE P(X,XCH,/,CHS); 06102000
|
|
L1: 06102100
|
|
IF S THEN P(CHS); 06102200
|
|
P(RTN); 06102300
|
|
PMAX ::: @0777777777777777; 06102400
|
|
MMAX ::: @2777777777777777; 06102500
|
|
PI ::: @1143110375524210; 06102600
|
|
PI2 ::: @1141444176652104; 06102700
|
|
PI4 ::: @1156220773250421; 06102800
|
|
END TAN; 06102900
|
|
PROCEDURE COTAN ; % 112 06200000
|
|
COMMENT COTANGENT INTRINSIC; % PF MAY 67 06200100
|
|
BEGIN REAL T ; 06200200
|
|
REAL X = -1; 06200300
|
|
LABEL PMAX; 06200400
|
|
IF (T~P(MKS,INTCALL(X,TANI)))=0 THEN P(PMAX) 06200500
|
|
ELSE P(1,T,/); 06200600
|
|
P(RTN); 06200700
|
|
PMAX ::: @0777777777777777; 06200800
|
|
END COTAN; 06200900
|
|
PROCEDURE DATAN ; % 113 06300000
|
|
COMMENT DOUBLE PRECISION ARC TANGENT INTRINSIC; % PF JUNE 67 06300100
|
|
BEGIN REAL X = -1, 06300200
|
|
XL = -2, 06300300
|
|
JUNK = 17, 06300400
|
|
T; 06300500
|
|
BOOLEAN S,U,Y; 06300600
|
|
LABEL SR3,SR3L,PI6,PI6L,PI2,PI2L,A,AL,B,BL,C,CL,D,DL,E,EL,F,FL, 06300700
|
|
G,GL,H,HL,I,IL,J,JL,K,KL,L,LL,M,ML; 06300800
|
|
DEFINE AM = NOP,DLA,T,JUNK,NOP,DLM#, SM = NOP,DLS,T,JUNK,NOP,DLM#; 06300900
|
|
IF S ~ X.[1:1] THEN X ~ P(X,SSP); 06301000
|
|
IF Y ~ X > 1 THEN P(0,1,XL,X,DLD,.X,STD,.XL,STD); 06301100
|
|
IF U ~ X > .2679491924311 THEN P(SR3L,SR3,0,4,SR3L,SR3,XL,X,DLA, 06301200
|
|
DLD,DLS,.X,STD,.XL,STD); 06301300
|
|
P(XL,DUP,X,XCH,X,DLM,.JUNK,STD,.T,STN,JUNK,ML,M,DLM); 06301400
|
|
:: P(LL,L,AM,KL,K,SM,JL,J,AM,IL,I,SM,HL,H,AM,GL,G,SM,FL,F,AM,EL,E,SM, 06301500
|
|
DL,D,AM,CL,C,SM,BL,B,AM,AL,A,SM,0,1,DLA,XL,X,DLM,.JUNK,STD); 06301600
|
|
IF U THEN P(JUNK,PI6L,PI6,DLA,.JUNK,STD); 06301700
|
|
IF Y THEN P(JUNK,PI2L,PI2,DLS,CHS,.JUNK,STD); 06301800
|
|
IF S THEN P(JUNK,CHS,.JUNK,STD); 06301900
|
|
P(RTN); 06302000
|
|
SR3 ::: @1141566636564130; SR3L ::: @0002312516354455; 06302100
|
|
PI6 ::: @1154140522160265; PI6L ::: @0006331302145566; 06302200
|
|
PI2 ::: @1141444176652104; PI2L ::: @0001321410646113; 06302300
|
|
M ::: @3161401124046414; ML ::: @0004072764260344; 06302400
|
|
L ::: @1162303273323564; LL ::: @0001630262103372; 06302500
|
|
K ::: @1162605113035023; KL ::: @0004301553367304; 06302600
|
|
J ::: @1163027321345406; JL ::: @0003326323362544; 06302700
|
|
I ::: @1163274446267506; IL ::: @0001464411354576; 06302800
|
|
H ::: @1163607415673413; HL ::: @0001424256207512; 06302900
|
|
G ::: @1164210421020314; GL ::: @0001737716236562; 06303000
|
|
F ::: @1164730473047014; FL ::: @0006266260505571; 06303100
|
|
E ::: @1165642721350561; EL ::: @0006467443753240; 06303200
|
|
D ::: @1167070707070707; DL ::: @0000552165603175; 06303300
|
|
C ::: @1151111111111111; CL ::: @0001111051232710; 06303400
|
|
B ::: @1151463146314631; BL ::: @0004631463070633; 06303500
|
|
A ::: @1152525252525252; AL ::: @0005252525252470; 06303600
|
|
END DATAN; 06303700
|
|
PROCEDURE ATAN2 ; % 114 06400000
|
|
COMMENT ARC TANGENT OF A/B INTRINSIC; % PF MAY 67 06400100
|
|
BEGIN 06400200
|
|
REAL A = -2, B = -1; 06400300
|
|
LABEL PI,PI2,MPI2; 06400400
|
|
IF B > 0 THEN 06400500
|
|
IF A!0 THEN P(MKS,INTCALL(A/B,ARCTANI)) 06400550
|
|
ELSE P(0) 06400600
|
|
ELSE 06400650
|
|
IF B < 0 THEN 06400700
|
|
IF A>0 THEN P(MKS,INTCALL(A/B,ARCTANI),PI,ADD) 06400750
|
|
ELSE 06400800
|
|
IF A<0 THEN P(MKS,INTCALL(A/B,ARCTANI),PI,SUB) 06400850
|
|
ELSE P(PI) 06400900
|
|
ELSE 06400950
|
|
IF A < 0 THEN P(MPI2) 06401000
|
|
ELSE P(PI2); 06401050
|
|
P(RTN); 06401100
|
|
PI ::: @1143110375524210; 06401200
|
|
PI2 ::: @1141444176652104; 06401300
|
|
MPI2 ::: @3141444176652104; 06401400
|
|
END ATAN2; 06401500
|
|
PROCEDURE DATAN2; % 115 06500000
|
|
COMMENT DOUBLE PRECISION ARC TANGENT OF A/B INTRINSIC; % PF JUNE 67 06500100
|
|
BEGIN REAL B = -1, 06500200
|
|
BL = -2, 06500300
|
|
A = -3, 06500400
|
|
AL = -4, 06500500
|
|
JUNK = 17 ; 06500600
|
|
LABEL PI,PIL,PI2,MPI2,PI2L; 06500800
|
|
IF A ! 0 AND B ! 0 THEN 06500900
|
|
BEGIN P(MKS,AL,A,BL,B,DLD,CALLINT(DATANI)) ; 06501000
|
|
IF B.[1:1] THEN IF A > 0 THEN P(JUNK,PIL,PI,DLA,.JUNK,STD,RTN) 06501100
|
|
ELSE P(JUNK,PIL,PI,DLS,.JUNK,STD,RTN); 06501300
|
|
END ELSE 06501500
|
|
IF B = 0 THEN IF A.[1:1] THEN P(MPI2,.JUNK,STD,PI2L,RTN) 06501600
|
|
ELSE P( PI2,.JUNK,STD,PI2L,RTN) 06501700
|
|
ELSE IF B.[1:1] THEN P(PI,.JUNK,STD,PIL,RTN) 06501800
|
|
ELSE P(0,.JUNK,STN,RTN); 06501900
|
|
P(RTN); 06502000
|
|
PI ::: @1143110375524210; PIL ::: @0002643021514230; 06502100
|
|
PI2 ::: @1141444176652104; PI2L ::: @0001321410646113; 06502200
|
|
MPI2 ::: @3141444176652104; 06502300
|
|
END DATAN2; 06502400
|
|
PROCEDURE ARSIN ; % 116 06600000
|
|
COMMENT ARC SINE INTRINSIC; % PF MAY 67 06600100
|
|
BEGIN REAL X =-1, 06600200
|
|
XSQ; 06600300
|
|
BOOLEAN S,U; 06600400
|
|
LABEL PI2,HAF,A,B,C,D,E,F,G,H,I,J,K,L,M,N; 06600500
|
|
DEFINE TIMES = ADD,XSQ,MUL#; 06600600
|
|
IF S ~ X.[1:1] THEN X ~ P(X,SSP); 06600700
|
|
IF X>1 THEN P(MKS,INTCALL(26,FORTERRI)) ; 06600800
|
|
IF U~X>P(HAF) THEN X~P(MKS,1,X,SUB,HAF,MUL,.XSQ,STN,CALLINT(SQRTI)) 06600900
|
|
ELSE XSQ ~ X|X; 06601000
|
|
:: P(NOP,A,XSQ,MUL,B,TIMES,C,TIMES,D,TIMES,E,TIMES,F,TIMES,G,TIMES, 06601100
|
|
H,TIMES,I,TIMES,J,TIMES,K,TIMES,L,TIMES,M,TIMES,N,TIMES, 06601200
|
|
1,ADD,X,MUL); 06601300
|
|
IF U THEN P(DUP,ADD,CHS,PI2,ADD); 06601400
|
|
IF S THEN P(CHS); 06601500
|
|
P(RTN); 06601600
|
|
PI2 ::: @1141444176652104; HAF ::: @1154000000000000; 06601700
|
|
A ::: @1172506721410650; B ::: @1172740556641135; 06601800
|
|
C ::: @1173232061727030; D ::: @1173574736467510; 06601900
|
|
E ::: @1174227363636371; F ::: @1174776745032742; 06602000
|
|
G ::: @1175724170360740; H ::: @1177114631463146; 06602100
|
|
I ::: @1161070473047305; J ::: @1161335056427214; 06602200
|
|
K ::: @1161743434343434; L ::: @1162666666666667; 06602300
|
|
M ::: @1164631463146315; N ::: @1151252525252526; 06602400
|
|
END ARSIN; 06602500
|
|
PROCEDURE ARCOS ; % 117 06700000
|
|
COMMENT ARC COSINE INTRINSIC; % PF MAY 67 06700100
|
|
BEGIN REAL X = -1 ; 06700200
|
|
LABEL PI2; 06700400
|
|
IF ABS(X)>1 THEN P(MKS,INTCALL(25,FORTERRI)) ; 06700500
|
|
P(PI2,MKS,INTCALL(X,ARSINI),SUB) ; 06700600
|
|
P(RTN); 06700700
|
|
PI2 ::: @1141444176652104; 06700800
|
|
END ARCOS; 06700900
|
|
PROCEDURE SINH ; % 120 06800000
|
|
COMMENT HYPERBOLIC SINE INTRINSIC; % PF MAY 67 06800100
|
|
BEGIN REAL X = -1 ; 06800200
|
|
BOOLEAN S; 06800400
|
|
LABEL EMAX; 06800500
|
|
DEFINE S1AM = /,1,ADD,MUL#; 06800600
|
|
IF S ~ X.[1:1] THEN X ~ P(X,SSP); 06800700
|
|
IF X>P(EMAX) THEN P(MKS,INTCALL(29,FORTERRI)) ; 06800800
|
|
IF X { .5 THEN 06800900
|
|
P(X,DUP,DUP,MUL,DUP,DUP,DUP,72,S1AM,42,S1AM,20,S1AM,6,S1AM) ELSE 06801000
|
|
P(MKS,INTCALL(X,EXPI),DUP,1,XCH,/,SUB,.5,MUL) ; 06801100
|
|
IF S THEN P(CHS); 06801200
|
|
P(RTN); 06801300
|
|
EMAX ::: @1122360000000000; 06801400
|
|
END SINH; 06801500
|
|
PROCEDURE COSH ; % 121 06900000
|
|
COMMENT HYPFRBOL1C COSINE INTRINSIC; % PF MAY 67 06900100
|
|
BEGIN REAL X = -1, 06900200
|
|
T; 06900300
|
|
LABEL EMAX; 06900400
|
|
DEFINE S1AM = /,1,ADD,MUL#; 06900500
|
|
IF (T~ABS(X))>P(EMAX) THEN P(MKS,INTCALL(30,FORTERRI)) ; 06900600
|
|
IF T { .75 THEN 06900700
|
|
P(X,DUP,MUL,DUP,DUP,DUP,DUP,90,S1AM,56,S1AM,30,S1AM,12,S1AM, 06900800
|
|
.5,MUL,1,ADD) ELSE P(MKS,INTCALL(X,EXPI),DUP,1,XCH,/,ADD,.5,MUL) ; 06900900
|
|
P(RTN); 06901000
|
|
EMAX ::: @1122360000000000; 06901100
|
|
END COSH; 06901200
|
|
PROCEDURE TANH ; % 122 07000000
|
|
COMMENT HYPERBOLIC TANGENT INTRINSIC; % PF MAY 67 07000100
|
|
BEGIN REAL T ; 07000200
|
|
REAL X = -1; 07000300
|
|
BOOLEAN S; 07000400
|
|
IF S ~ X.[1:1] THEN X ~ P(X,SSP); 07000600
|
|
IF X > 27 THEN IF S THEN P(1,CHS,RTN) ELSE P(1,RTN); 07000700
|
|
IF X { .14 THEN 07000800
|
|
P(X,DUP,DUP,MUL,DUP,DUP,DUP,6.8888888889,MUL,17,SUB, 07000900
|
|
MUL,21,/,2,ADD,MUL,5,/,1,SUB,MUL,3,/,1,ADD,MUL)07001000
|
|
ELSE P(MKS,INTCALL(X,EXPI),DUP,.T,STN,1,XCH,/,DUP,T,ADD,.T,STD,SUB,T,/);07001100
|
|
IF S THEN P(CHS); 07001200
|
|
P(RTN); 07001300
|
|
END TANH; 07001500
|
|
PROCEDURE DSQRT ; % 123 07100000
|
|
COMMENT DOUBLE PRECISION SQUARE ROOT INTRINSIC; % PF JUNE 67 07100100
|
|
BEGIN REAL X = -1, 07100200
|
|
XL = -2, 07100300
|
|
JUNK = 17 ; 07100400
|
|
LABEL HAF; 07100600
|
|
IF X LEQ 0 THEN IF X=0 THEN P(0,.JUNK,STN,RTN) 07100700
|
|
ELSE P(MKS,INTCALL(27,FORTERRI)) ; 07100710
|
|
P(XL,X,0,MKS,INTCALL(X,SQRTI),.JUNK,STN,DLD,0,JUNK,DLA,0,HAF,DLM,.JUNK, 07100800
|
|
STD,RTN) ; 07100810
|
|
HAF ::: @1154000000000000; 07100900
|
|
END DSQRT; 07101000
|
|
PROCEDURE CSQRT ; % 124 07200000
|
|
COMMENT COMPLEX SQUARE ROOT INTRINSIC; % PF JUNE 67 07200100
|
|
BEGIN REAL X = -1, 07200200
|
|
Y = -2, 07200300
|
|
JUNK = 17 ; 07200400
|
|
LABEL HAF; 07200700
|
|
IF X = 0 THEN IF Y = 0 THEN P(0,.JUNK,STN,RTN); 07200800
|
|
P(MKS,INTCALL(P(MKS,X,INTCALL(Y,CABSI),X,SSP,ADD,HAF,MUL),SQRTI)) ; 07200900
|
|
IF X } 0 THEN P(.JUNK,STN,DUP,ADD,Y,XCH,/,RTN) 07201000
|
|
ELSE BEGIN IF Y.[1:1] THEN P(CHS); 07201100
|
|
P(DUP,DUP,ADD,Y,XCH,/,.JUNK,STD,RTN); 07201200
|
|
END; 07201300
|
|
HAF ::: @1154000000000000; 07201400
|
|
END CSQRT; 07201500
|
|
PROCEDURE ERF ; % 125 07300000
|
|
COMMENT THE ERROR FUNCTION INTRINSIC; % PF MAY 67 07300100
|
|
BEGIN REAL X = -1, 07300200
|
|
XSQ,T,W; 07300400
|
|
LABEL A,B,C,D,E,F,G,H,I,J,K,L,M,N,OVER,MSRTPI; 07300500
|
|
DEFINE MORE = ADD,XSQ,MUL#, LESS = SUB,XSQ,MUL#; 07300600
|
|
IF (XSQ ~ X|X) < 2.22 THEN 07300700
|
|
:: P(NOP,A,XSQ,MUL,B,LESS,C,MORE,D,LESS,E,MORE,F,LESS,G,MORE,H,LESS, 07300800
|
|
I,MORE,J,LESS,K,MORE,L,LESS,M,MORE,N,LESS,OVER,ADD,X,MUL,RTN); 07300900
|
|
IF XSQ < 24 THEN 07301000
|
|
BEGIN W ~ (XSQ + 14.5)|(T ~ XSQ + 6.6267867473) - 39.1779586414; 07301100
|
|
T ~ (XSQ + 12.5)|W - 45.5|T; 07301200
|
|
W ~ (XSQ + 10.5)|T - 33|W; 07301300
|
|
T ~ (XSQ + 8.5)|W - 22.5|T; 07301400
|
|
W ~ (XSQ + 6.5)|T - 14|W; 07301500
|
|
T ~ (XSQ + 4.5)|W - 7.5|T; 07301600
|
|
W ~ (XSQ + 2.5)|T - 3|W; 07301700
|
|
T ~ (XSQ + .5)|W - .5|T; 07301800
|
|
P(ABS(X),W,MUL,MKS,INTCALL(XSQ,EXPI),MSRTPI,MUL,T,MUL,/,1,ADD) ; 07301850
|
|
END ELSE P(1); 07301900
|
|
IF X.[1:1] THEN P(CHS); 07302000
|
|
P(RTN); 07302100
|
|
A ::: @1321164756260433; B ::: @1313314675626043; 07302200
|
|
C ::: @1306316666647563; D ::: @1261242725431173; 07302300
|
|
E ::: @1251771347130371; F ::: @1242575635313531; 07302400
|
|
G ::: @1233347466027367; H ::: @1223723222675344; 07302500
|
|
I ::: @1213746431157302; J ::: @1203400555500006; 07302600
|
|
K ::: @1172531336320715; L ::: @1161560263430450; 07302700
|
|
M ::: @1167161362064016; N ::: @1153004472153007; 07302800
|
|
OVER ::: @1141101565650103; MSRTPI:::@3141613376110665; 07302900
|
|
END ERF; 07303000
|
|
PROCEDURE GAMMA ; % 126 07400000
|
|
COMMENT GAMMA INTRINSIC; % PF MAY 67 07400100
|
|
BEGIN REAL X = -1, 07400200
|
|
E,V,Y; 07400400
|
|
BOOLEAN S; INTEGER K; 07400500
|
|
LABEL L1,PMAX,MMAX,PI,MPI; 07400600
|
|
DEFINE SUBMUL = SUB,E,MUL#, ADDMUL = ADD,E,MUL#; 07400700
|
|
IF S ~ X { 0 THEN X ~ P(X,SSP); 07400800
|
|
IF X>52 THEN P(MKS,INTCALL(28,FORTERRI)) ; 07400900
|
|
IF (E ~ P(X,DUP,.Y,SND,.5,SUB,.K,ISN,SUB)) = 0 THEN 07401000
|
|
BEGIN IF S THEN IF K.[47:1] THEN P(MMAX)ELSE P(PMAX) 07401100
|
|
ELSE IF K { 2 THEN P(1) 07401200
|
|
ELSE GO TO L1; 07401300
|
|
P(RTN); 07401400
|
|
END; 07401500
|
|
IF K < 2 THEN V ~ (IF K = 0 THEN P(1,X,DUP,1,ADD,MUL,/) ELSE 07401600
|
|
IF K = 1 THEN 1/X ELSE 1) 07401700
|
|
ELSE L1: BEGIN X ~ X - (V ~ 1); 07401800
|
|
DO V ~ X|V UNTIL (X ~ X - 1) < 2; 07401900
|
|
IF E = 0 THEN P(V,RTN); 07402000
|
|
END; 07402100
|
|
:: P(NOP,E,.00006771057117,MUL, 07402200
|
|
00034423420456,SUBMUL, 07402300
|
|
.00153976810472,ADDMUL, 07402400
|
|
00246674798054,SUBMUL, 07402500
|
|
0109736958417,ADDMUL, 07402600
|
|
00021090746731,SUBMUL, 07402700
|
|
.074237907606,ADDMUL, 07402800
|
|
081578218785,ADDMUL, 07402900
|
|
411840251796,ADDMUL, 07403000
|
|
422784336962,ADDMUL, 07403100
|
|
99999999999,ADD,V,MUL,.V,STN); 07403200
|
|
IF S THEN P(DEL,MPI,MKS,INTCALL(P(PI)|Y,SINI),V,MUL,Y,MUL,/) ; 07403300
|
|
P(RTN); 07403400
|
|
PI ::: @1143110375524210; 07403500
|
|
MPI ::: @3143110375524210; 07403600
|
|
PMAX ::: @0777777777777777; 07403700
|
|
MMAX ::: @2777777777777777; 07403800
|
|
END GAMMA; 07403900
|
|
PROCEDURE ALGAMA; % 127 07500000
|
|
COMMENT LOG GAMMA INTRINSIC; % PF MAY 67 07500100
|
|
BEGIN REAL X = -1, 07500200
|
|
T; 07500400
|
|
DEFINE SUBMUL = SUB,T,MUL#, ADDMUL = ADD,T,MUL#; 07500500
|
|
IF X LEQ 0 THEN P(MKS,INTCALL(31+(X!0),FORTERRI)) ; 07500600
|
|
IF X<3.28 THEN P(MKS,INTCALL(P(MKS,INTCALL(X,GAMMAI)),LNI),RTN) ; 07500700
|
|
P(1,X,DUP,MUL,/,.T,SND); 07500800
|
|
:: P(NOP,1.392432216906,CHS,MUL, 07500900
|
|
.179644372369,ADDMUL, 07501000
|
|
0295506535948,SUBMUL, 07501100
|
|
0064102564103,ADDMUL, 07501200
|
|
00191752691753,SUBMUL, 07501300
|
|
00084175084175,ADDMUL, 07501400
|
|
00059523809524,SUBMUL, 07501500
|
|
00079365079365,ADDMUL, 07501600
|
|
.00277777777778,SUBMUL, 07501700
|
|
083333333333,ADD,X,/,.91893853321,ADD, 07501800
|
|
X,DUP,.5,SUB,MKS,INTCALL(X,LNI),MUL,XCH,SUB,ADD) ; 07501900
|
|
P(RTN); 07502000
|
|
END ALGAMA; 07502100
|
|
PROCEDURE ANDI ; % 130 07600000
|
|
BEGIN 07600100
|
|
REAL A = - 1,B = -2; 07600200
|
|
P(A AND B,RTN); 07600300
|
|
END ANDI; 07600400
|
|
PROCEDURE ORI ; % 131 07700000
|
|
BEGIN 07700100
|
|
REAL A =-1,B = -2; 07700200
|
|
P(A OR B,RTN); 07700300
|
|
END ORI; 07700400
|
|
PROCEDURE CMPL ; % 132 07800000
|
|
BEGIN 07800100
|
|
REAL A = - 1; 07800200
|
|
P( (NOT A),RTN); 07800300
|
|
END CMPL; 07800400
|
|
PROCEDURE EQUIVP; % 133 07900000
|
|
BEGIN 07900100
|
|
REAL A=-1,B = -2; 07900200
|
|
P(A EQV B,RTN); 07900300
|
|
END EQUIVP; 07900400
|
|
PROCEDURE FORTERR; % 134 RUN-TIME ERRORS 07900410
|
|
BEGIN 07900500
|
|
COMMENT PROGRAM GENERATING VARIOUS ERROR MESSAGES WITH A DS. 07900600
|
|
CODES 0 THRU 3 ARE USED BY THE FORMATING INTRINSICS. CODES 07900700
|
|
10 THRU 32 ARE USED BY VARIOUS MATH INTRINSICS; 07900800
|
|
REAL CODE = -1,FID,MFID,IND,BUFF,A=-2,B=-3,C=-4,D=-5; 07900900
|
|
ARRAY TPAR[*],FIB[*],FPB=3[*] ; 07901000
|
|
NAME MEM = 2; 07901100
|
|
LABEL CD, FO95, CD1, CD2, DC, DC1, DC2, GO95 ; 07901110
|
|
LABEL CPLR,XTOI,CSSC,DMOD,DEXP,CEXP,DLGZ,DLGM,CLOG,ALTZ,ALTM,DLTZ,DLTM, 07901200
|
|
CSIN,CCOS,ACOS,ASIN,DSQR,GAMA,SINH,COSH,ALGZ,ALGM,MAXN,ZERO,NGTV, 07901300
|
|
L0,L1,L2,L3,LX,WRAPUP,FIGER; 07901400
|
|
LABEL L4, L5, L6; 07901410
|
|
SWITCH SW1 ~ L0, L1, L2, L3, L4, L5, L6; 07901500
|
|
SWITCH SW2 ~ CPLR,XTOI,CSSC,DMOD,DEXP,CEXP,DLGZ,DLGM,CLOG,ALTZ,ALTM, 07901600
|
|
DLTZ,DLTM,CSIN,CCOS,ACOS,ASIN,DSQR,GAMA,SINH,COSH,ALGZ,ALGM; 07901700
|
|
DEFINE STREM = STREAM(D ~ [TPAR[#, ST0 = STREM 0]])#, ST2 = STREM 2]])#;07901800
|
|
DEFINE CC55(CC551) = CC551(DS~LIT"<"; SI~A1; DS~A13 CHR; DS~LIT">") #, 07901810
|
|
NAS(NAS1,NAS2,NAS3) = SI~LOC NAS1; DS~NAS2 DEC; NAS3(DI~DI-4 ; 07901820
|
|
DS~LIT"*") #, 07901825
|
|
CD5(CD51,CD52,CD53,CD54,CD55) = CC55(CD51); CD52(NAS(CD53,CD54, 07901830
|
|
CD55)) #, 07901835
|
|
SAVW=F #, SAVD=E #, WH2=B #, WH1=C #, R=G #; 07901850
|
|
SUBROUTINE GETFILE; 07901900
|
|
BEGIN 07902000
|
|
FIB ~ MEM[(NOT 2) INX A]; 07902100
|
|
MFID ~ FPB[IND ~ FIB[4].[13:11]]; 07902200
|
|
FID ~ FPB[IND+1]; 07902300
|
|
B ~ B + 1; 07902400
|
|
END GETFILE ; 07902405
|
|
REAL T1,T2,T3,T4,T5,E=-6,F=-7,G=-8,H=-9,I=-10,J=-11,K=-12 ; 07902410
|
|
INTEGER IT2=T2 ; 07902415
|
|
ARRAY TEN=22[*] ; 07902417
|
|
LABEL LOOP, ALFA ; 07902420
|
|
REAL SUBROUTINE SIZ ; 07902425
|
|
BEGIN 07902430
|
|
TEN[T3]~TEN[68]; T1~0 ; 07902435
|
|
LOOP: IF TEN[T1~T1+1]{T2 THEN GO LOOP; SIZ~T1 ; 07902440
|
|
END OF SIZ ; 07902445
|
|
% * * * * * * * * * * * * * * PROGRAM STARTS * * * * * * * * * * * 07902447
|
|
TPAR~P([TPAR[1]],CFX,SFB)&17[8:38:10] ; 07902448
|
|
IF CODE=(-2) THEN 07902450
|
|
BEGIN T3~5; T2~B ; 07902455
|
|
STREAM(E,D,C,B,A,N3~P(ALFA),N1~SIZ,T2~T2~A,N2~SIZ,TPAR) ; 07902460
|
|
BEGIN 07902465
|
|
DS~15LIT"-DATA STMT ERR#"; SI~LOC E; DS~DEC ; 07902470
|
|
DS~4LIT",LT="; SI~LOC N3; SI~SI+D; DS~CHR ; 07902475
|
|
DS~4LIT",DT="; SI~LOC N3; SI~SI+C; DS~CHR ; 07902480
|
|
DS~3LIT",L="; SI~LOC B; DS~N1 DEC ; 07902485
|
|
DS~3LIT",D="; DS~N2 DEC; DS~2LIT":~" ; 07902490
|
|
END ; 07902495
|
|
GO WRAPUP ; 07902500
|
|
END ; 07902505
|
|
IF CODE=(-1) THEN 07902510
|
|
BEGIN 07902515
|
|
STREAM(TPAR); DS~33LIT"-MIXD UNFMT/ALPHA-MODE TAPE I/O:~" ; 07902520
|
|
GO WRAPUP ; 07902523
|
|
END ; 07902525
|
|
IF CODE=(-3) THEN 07902530
|
|
BEGIN T3~4; T2~I; FID~(MFID~P(GO95))-1 ; 07902535
|
|
STREAM(J,K,I,F1~SIZ,D~T2~H,F2~SIZ,F3~G>10 AND 15>G,F, 07902540
|
|
N3~P(ALFA),C1~IT2~E,C~SIZ,R1~IT2~D+1,R~SIZ, 07902545
|
|
BUFF~C,V~B.[42:1] AND B.[46:2]=0,A4~T2~B.[6:12],A5~SIZ 07902548
|
|
|I~T2!1,A55~J~(K~T2)=MFID,A2~(T5~B AND 15)=12 OR T5=8, 07902551
|
|
A3~T5=12 OR T5=4,CD~P(DC),CD1~P(DC1),Z~0,CD2~P(DC2), 07902554
|
|
A6~(T4~B.[1:5])-2,A7~T2~B.[18:12],A8~SIZ|((T4!30 OR 07902557
|
|
T2!FID) AND (T4!9 OR T2!0)),A85~MFID=T2,A9~T4}11 AND 07902560
|
|
T4{14 OR (T4=30 AND (T2~B.[30:12])!FID),A10~T2,A11~SIZ, 07902563
|
|
A115~T2=MFID,A12~T2~IF J THEN A.[18:15] ELSE K, 07902566
|
|
A13~SIZ|I,TPAR) ; 07902568
|
|
BEGIN DS~11LIT"-DATA ERR #"; SI~LOC J; SI~SI+7; DS~CHR ; 07902569
|
|
DS~2LIT"= "; V(NAS(A4,A5,A55); A2(DS~LIT"K"); A3(DS~LIT 07902572
|
|
"$"); SI~LOC CD; SI~SI+A6; DS~CHR; NAS(A7,A8,A85) ; 07902575
|
|
A9(DS~LIT"."; NAS(A10,A11,A115)); DS~4LIT" => "; JUMP OUT 07902578
|
|
TO L1); DS~7LIT"FMT IS "; L1: SI~LOC A12; DS~A13 DEC ; 07902581
|
|
A2(DS~LIT"K"); A3(DS~LIT"$"); SI~LOC K; SI~SI+7; DS~CHR ; 07902584
|
|
DS~F1 DEC; F3(DS~LIT"."; SI~LOC D; DS~F2 DEC); DS~6LIT 07902587
|
|
" TYP="; SI~LOC N3; SI~SI+F; DS~CHR; DS~6LIT", COL#" ; 07902590
|
|
DS~C DEC; DS~6LIT", CHR="; SI~BUFF; SI~SI-1; DS~CHR ; 07902593
|
|
DS~6LIT", REC#"; SI~LOC R1; DS~R DEC; DS~3LIT" :~" ; 07902596
|
|
END OF STREAM ; 07902599
|
|
GO WRAPUP ; 07902602
|
|
ALFA::: @2531625143242300 ; 07902605
|
|
DC::: "PXTAOLJ"; DC1::: @3127262524230000; DC2::: "(V000" ; 07902606
|
|
GO95::: 4095 ; 07902607
|
|
END ; 07902608
|
|
IF CODE=(-4) THEN 07902610
|
|
BEGIN 07902614
|
|
IF CODE.[2:1] THEN 07902615
|
|
BEGIN 07902616
|
|
STREAM(TPAR); DS~24LIT"-UNINITIALIZED POINTER:~" ; 07902617
|
|
GO WRAPUP ; 07902618
|
|
END ; 07902619
|
|
STREAM(TPAR); DS~32LIT"-BINARY TAPE REC HAS < 3 WORDS:~" ; 07902620
|
|
GO WRAPUP ; 07902625
|
|
END ; 07902630
|
|
IF CODE=(-5) THEN 07902631
|
|
BEGIN T3~8; CODE~H ; 07902632
|
|
IF D=2 THEN BEGIN CODE~30; IF WH1>63 OR WH1<10 THEN D~12 END ; 07902633
|
|
IF A.[1:5]<5 THEN BEGIN A.[6:12]~A.[18:12]; R~SAVW; D~10 END ; 07902634
|
|
IF D>9 THEN 07902635
|
|
BEGIN FIB~P([FIB[1]],CFX,SFB)&5[8:38:10]; FIB[0]~0 ; 07902636
|
|
BUFF~((BUFF~EDITIT(FID~FIB.[33:15],0,2,WH2,WH1)).[33:15]- 07902637
|
|
FID)|8+BUFF.[30:3] ; 07902638
|
|
END ; 07902639
|
|
FID~(MFID~P(FO95))-1 ; 07902640
|
|
IND~CODE>14 AND (CODE!30 OR A.[30:12]=FID) ; 07902641
|
|
STREAM(A1~FIB,A2~(T5~A AND 15)=12 OR T5=8,A3~T5=12 OR T5=4, 07902642
|
|
A4~T2~A.[6:12],A5~SIZ|T5~T2!1,A55~T2=MFID,A6~(T4~A.[1:5]07902643
|
|
)-2,A7~T2~A.[18:12],A8~SIZ| (T4!29 AND T4!3 AND T4!4 07902645
|
|
AND (T4!30 OR T2! FID) AND (T4!9 OR T2!0)),A85~(T2= 07902647
|
|
MFID) ,A9~T4}11 AND T4{14 OR (T4=30 AND (T2~A.[30:12])07902650
|
|
! FID),A10~T2,A11~SIZ,A115~T2=MFID,A12~T4=3 AND A.[41:1]07902655
|
|
,R10~D=10,R~D!10,R1~T2~R,R2~SIZ|T5, 07902660
|
|
V12~D=12,VV~D=2 AND WH1!31,V~D>2 AND D!12, 07902665
|
|
V1~CODE-2,SKPWD~CODE=3 OR CODE=29 OR (CODE=30 AND 07902670
|
|
SAVW= FID) OR CODE=4 OR (CODE=9 AND SAVW=0),W14~D=14, 07902672
|
|
W~D!14,WW~SAVW=FID,W5~SAVW=MFID,SKPD~CODE 07902675
|
|
<11 OR IND,D16~D=16,D~D!16,DD~ 07902680
|
|
SAVD=FID,D5~SAVD=MFID,D1~T2~SAVD,D2~SIZ,W1~T2~SAVW, 07902685
|
|
W2~SIZ,WH1,A13~BUFF,CD~P(CD),CD1~P(CD1),R5~0, 07902690
|
|
CD2~P(CD2),TPAR) ; 07902692
|
|
BEGIN DS~16LIT"-VARBL FMT ERR= "; A12(DS~LIT"-") ; 07902695
|
|
NAS(A4,A5,A55); A2(DS~LIT"K"); A3(DS~LIT"$") ; 07902700
|
|
SI~LOC CD; SI~SI+A6; DS~CHR; NAS(A7,A8,A85) ; 07902705
|
|
A9(DS~LIT"."; NAS(A10,A11,A115)); DS~4LIT" => " ; 07902710
|
|
A12(DS~LIT"-"); CD5(R10,R,R1,R2,R5); A2(DS~LIT"K"); A3(DS~07902720
|
|
LIT"$"); CC55(V12); V(SI~LOC CD; SI~SI+V1; DS~CHR); VV(DS~07902725
|
|
LIT"<"; SI~LOC WH1; SI~SI+7; DS~CHR; DS~LIT">");SKPWD(JUMP07902730
|
|
OUT TO XX);WW(DS~11LIT"<MISSING W>"; SKPD(JUMP OUT 2 TO XX07902735
|
|
); DI~DI-1; DS~7LIT" AND D>";JUMP OUT TO XX); CD5(W14,W,W107902740
|
|
,W2,W5); GO XV; XX: GO XT; XV: SKPD(JUMP OUT 1 TO XI); DS~07902745
|
|
LIT"."; DD(DS~11LIT"<MISSING D>"; JUMP OUT 1 TO XT) ; 07902750
|
|
CD5(D16,D,D1,D2,D5); XT: DS~3LIT" :~" ; 07902755
|
|
END OF STREAM ; 07902760
|
|
GO WRAPUP ; 07902765
|
|
FO95::: 4095 ; 07902770
|
|
CD::: "PXTAOLJ"; CD1::: @3127262524230000; CD2::: "(V000" ; 07902771
|
|
END ; 07902775
|
|
IF CODE<10 THEN GO SW1[CODE] ; 07902780
|
|
GO TO SW2[CODE - 10]; 07902800
|
|
L0: % 0 07902900
|
|
STREAM(P1~0:P2 ~ [TPAR[0]]); 07903000
|
|
BEGIN 07903100
|
|
DS ~ 14 LIT "-FORMAT ERROR "; 07903200
|
|
P1 ~ DI; 07903300
|
|
END; 07903400
|
|
BUFF ~ P; 07903500
|
|
GO TO LX; 07903600
|
|
L1: % 1 07903700
|
|
STREAM(P1~0:D ~ [TPAR[0]]); 07903800
|
|
BEGIN 07903900
|
|
DS ~ 16 LIT "-NAMELIST ERROR "; 07904000
|
|
P1 ~ DI; 07904100
|
|
END; 07904200
|
|
BUFF ~ P; 07904300
|
|
GO TO LX; 07904400
|
|
L2: % 2 07904500
|
|
STREAM(P1~0:D ~ [TPAR[0]]); 07904600
|
|
BEGIN 07904700
|
|
DS ~ 12 LIT "-TYPE ERROR "; 07904800
|
|
P1 ~ DI; 07904900
|
|
END; 07905000
|
|
BUFF ~ P; 07905100
|
|
LX: 07905200
|
|
GETFILE; 07905300
|
|
STREAM(MFID,FID,B,BUFF); 07905400
|
|
BEGIN 07905500
|
|
DI~BUFF; DS~8LIT"ON FILE " ; 07905600
|
|
SI ~ LOC MFID; SI ~ SI + 1; DS ~ 7 CHR; DS ~ LIT "/"; 07905700
|
|
SI~LOC FID; SI~SI+1; DS~7CHR; DS~7LIT", REC #" ; 07905800
|
|
SI ~ LOC B; DS ~ 8 DEC; DS ~ 2 LIT ":~"; 07905900
|
|
END; 07906000
|
|
GO TO WRAPUP; 07906100
|
|
L3: % 3 07906200
|
|
ST0; 07906300
|
|
DS ~ 18 LIT "-DATA STMT ERROR:~"; 07906500
|
|
GO TO WRAPUP; 07906700
|
|
L4: % 4 07906710
|
|
STREAM(P1~0:D~[TPAR[0]]); 07906720
|
|
BEGIN 07906730
|
|
DS~26LIT"-MIXED FMT/UNFMT TAPE I/O " ; 07906740
|
|
% VOID 07906750
|
|
P1 ~ DI; 07906760
|
|
END; 07906770
|
|
BUFF ~ P; 07906780
|
|
GO TO LX; 07906790
|
|
L5: % 5 07906800
|
|
STREAM(P1~0:D~[TPAR[0]]); 07906810
|
|
BEGIN 07906820
|
|
DS:=18 LIT "-LIST SIZE ERROR "; 07906830
|
|
P1 ~ DI; 07906840
|
|
END; 07906850
|
|
BUFF ~ P; GO TO LX; 07906860
|
|
L6: ST0; % 6 07906861
|
|
DS ~ 21 LIT "-INVALID ARG CONCAT:~"; 07906862
|
|
GO TO WRAPUP; 07906863
|
|
CPLR: ST0; % 10 07906890
|
|
DS ~ 31 LIT "-EXPRESSION COMPILATION ERROR:~"; 07906900
|
|
GO TO FIGER; 07907000
|
|
XTOI: ST0; % 11 07907100
|
|
DS ~ 21 LIT "-NEGATIVE BASE XTOI:~"; 07907200
|
|
GO TO FIGER; 07907300
|
|
CSSC: ST0; % 12 07907400
|
|
DS ~ 24 LIT "-COMPLEX EXPONENT XTOI:~"; 07907500
|
|
GO TO FIGER; 07907600
|
|
DMOD: ST0; % 13 07907700
|
|
DS ~ 20 LIT "-ZERO MODULUS DMOD:~"; 07907800
|
|
GO TO FIGER; 07907900
|
|
DEXP: ST2; % 14 07908000
|
|
DS ~ 6 LIT "DEXP:~"; 07908100
|
|
GO TO MAXN; 07908200
|
|
CEXP: ST2; % 15 07908300
|
|
DS ~ 6 LIT "CEXP:~"; 07908400
|
|
GO TO MAXN; 07908500
|
|
DLGZ: BUFF ~ TRUE; % 16 07908600
|
|
DLGM: ST2; % 17 07908700
|
|
DS ~ 6 LIT "DLOG:~"; 07908800
|
|
IF BUFF THEN GO TO ZERO ELSE GO TO NGTV; 07908900
|
|
CLOG: ST2; % 18 07909000
|
|
DS ~ 6 LIT "CLOG:~"; 07909100
|
|
GO TO ZERO; 07909200
|
|
ALTZ: BUFF ~ TRUE; % 19 07909300
|
|
ALTM: ST2; % 20 07909400
|
|
DS ~ 8 LIT "ALOG10:~"; 07909500
|
|
IF BUFF THEN GO TO ZERO ELSE GO TO NGTV; 07909600
|
|
DLTZ: BUFF ~ TRUE; % 21 07909700
|
|
DLTM: ST2; % 22 07909800
|
|
DS ~ 8 LIT "DLOG10:~"; 07909900
|
|
IF BUFF THEN GO TO ZERO ELSE GO TO NGTV; 07910000
|
|
CSIN: ST2; % 23 07910100
|
|
DS ~ 6 LIT "CSIN:~"; 07910200
|
|
GO TO MAXN; 07910300
|
|
CCOS: ST2; % 24 07910400
|
|
DS ~ 6 LIT "CCOS:~"; 07910500
|
|
GO TO MAXN; 07910600
|
|
ACOS: BUFF ~ TRUE; % 25 07910700
|
|
ASIN: STREAM(B ~ BUFF,D ~ [TPAR[0]]); % 26 07910800
|
|
BEGIN DS ~ 19 LIT "-ABS(ARG) .GT. 1 AR"; 07910900
|
|
SI ~ LOC B; SI ~ SI + 7; 07911000
|
|
IF SC = "1" THEN DS ~ 5 LIT "COS:~" 07911100
|
|
ELSE DS ~ 5 LIT "SIN:~"; 07911200
|
|
END; 07911400
|
|
GO TO FIGER; 07911500
|
|
DSQR: ST2; % 27 07911600
|
|
DS ~ 7 LIT "DSQRT:~"; 07911700
|
|
NGTV: ST0; 07911800
|
|
DS ~ 16 LIT "-NEGATVE ARGMNT "; 07911900
|
|
GO TO FIGER; 07912000
|
|
GAMA: ST2; % 28 07912100
|
|
DS ~ 7 LIT "GAMMA:~"; 07912200
|
|
GO TO MAXN; 07912300
|
|
SINH: ST2; % 29 07912400
|
|
DS ~ 6 LIT "SINH:~"; 07912500
|
|
GO TO MAXN; 07912600
|
|
COSH: ST2; % 30 07912700
|
|
DS ~ 6 LIT "COSH:~"; 07912800
|
|
MAXN: ST0; 07912900
|
|
DS ~ 16 LIT "-ARGMT .GT. MAX "; 07913000
|
|
GO TO FIGER; 07913100
|
|
ALGZ: BUFF ~ TRUE; % 31 07913200
|
|
ALGM: ST2; % 32 07913300
|
|
DS ~ 8 LIT "ALGAMA:~"; 07913400
|
|
IF NOT BUFF THEN GO TO NGTV; 07913500
|
|
ZERO: ST0; 07913600
|
|
DS ~ 16 LIT "-ZERO ARGUMENT "; 07913700
|
|
WRAPUP: FIGER: 07913800
|
|
P([TPAR[0]].[33:15],34,COM); 07913900
|
|
END FORTERR; 07914000
|
|
PROCEDURE MAX; % 135 08000000
|
|
COMMENT MAX INTRINSIC RETURNING INTEGERS; % PF JULY 67 08000100
|
|
BEGIN REAL X = -1, RCW = +0, SIZE = +1, JUNK = +2; 08000200
|
|
P(0,RCW,FCX,[RCW] INX NOT 0 INX 0,XCH,SUB,0,X); 08000300
|
|
WHILE (SIZE ~ SIZE - 1) > 0 DO 08000400
|
|
BEGIN P(DUP); 08000500
|
|
JUNK ~ *(P(.X) + SIZE); 08000600
|
|
IF P < JUNK THEN P(DEL,DUP); 08000700
|
|
END; 08000800
|
|
P(1,DIV,RTN); 08000900
|
|
END IMAX; 08001000
|
|
PROCEDURE MIN; % 136 08100000
|
|
COMMENT MIN INTRINSIC RETURNING INTEGERS; % PF JULY 67 08100100
|
|
BEGIN REAL X = -1, RCW = +0, SIZE = +1, JUNK = +2; 08100200
|
|
P(0,RCW,FCX,[RCW] INX NOT 0 INX 0,XCH,SUB,0,X); 08100300
|
|
WHILE (SIZE ~ SIZE - 1) > 0 DO 08100400
|
|
BEGIN P(DUP); 08100500
|
|
JUNK ~ *(P(.X) + SIZE); 08100600
|
|
IF P > JUNK THEN P(DEL,DUP); 08100700
|
|
END; 08100800
|
|
P(1,DIV,RTN); 08100900
|
|
END IMIN; 08101000
|
|
PROCEDURE IMOD; % 137 08200000
|
|
COMMENT INTEGER MOD INTRINSIC; % PF JULY 67 08200100
|
|
BEGIN INTEGER X = -2, 08200200
|
|
Y = -1; 08200300
|
|
P(X MOD Y,1,DIV,RTN); 08200400
|
|
END IMOD; 08200500
|
|
PROCEDURE CONCAT ; % INTRINSIC NUMBER @140. 08300000
|
|
BEGIN % FORTRAN CONCATENATE INTRINSIC: CONCAT=Y&Z[A:B:X]. 08300100
|
|
REAL Y=-5, Z=-4, ERR=24 ; 08300200
|
|
INTEGER A=-3, B=-2, X=-1 ; 08300250
|
|
DEFINE R= @0055005570267022 #, % NOP,DIA,OPDC Y,OPDC,Z. 08300260
|
|
S= @0055006100650235 #; % NOP,DIB,TRB,RTN. 08300270
|
|
IF (A~A)<1 OR (B~B)<1 OR (X~X)<1 OR (P(48-X,DUP)<A OR P(XCH)<B) 08300300
|
|
THEN P(MKS,6,ERR) ; 08300400
|
|
GO P(P(R)&(B DIV 6)[12:45:3]&(B MOD 6)[15:9:3],P(S),A MOD 6,TRB 3, 08300500
|
|
P&(A DIV 6)[12:45:3]&X[24:42:6],.B,~,.A,~,[A]) ; 08300600
|
|
END OF CONCAT ; 08300700
|
|
PROCEDURE FORTRANMEMHANDLER(A,H); VALUE H; REAL H; ARRAY A[*]; %@164 08301000
|
|
BEGIN % H=0 => VARYING, H=6 => FIXED, H=-1 => RELEASE. 08301100
|
|
REAL I ; 08301200
|
|
P(*A,TOP) ; 08301300
|
|
IF H}0 THEN 08301400
|
|
IF P THEN P(A&H[3:45:3],(*2)&(A)[33:18:15],~) 08301500
|
|
ELSE FOR I~A.[8:10]-1 STEP -1 UNTIL 0 DO P([A[I]],DUP,LOD, 08301600
|
|
P&H[3:45:3],XCH,~) 08301700
|
|
ELSE IF P THEN P(A,38,COM,DEL) 08301800
|
|
ELSE FOR I~A.[8:10]-1 STEP -1 UNTIL 0 DO P(*[A[I]],38,COM,DEL);08301900
|
|
END OF FORTRANMEMHANDLER ; 08301950
|
|
PROCEDURE SISO; % 35 08400000
|
|
BEGIN 08400200
|
|
COMMENT STRING ISOLATE. INVOKED AS REAL(PTR,N). N COUNTS CHARS.; 08400400
|
|
DEFINE CSIZE=[31:02]#, COMMENT CHAR-SIZE FIELD OF PTR; 08400600
|
|
EIGHT=01#; COMMENT VALUE OF CSIZE FOR 8 BITS-CHAR; 08400800
|
|
INTEGER 08401000
|
|
SOFF; %BIT OFFSET TO BIT 1 OF S FOR 8-BIT CHAR 08401200
|
|
INTEGER 08401400
|
|
PTR =-3, 08401600
|
|
RCW =-2, %SISO IS REALLY A REAL PROC:VALUE IN PTR 08401800
|
|
N =-1; 08402000
|
|
REAL RESULT =PTR; 08402010
|
|
ARRAY 08402200
|
|
STRING[*]; %UNINDEXED DD FOR SOURCE CHARS 08402400
|
|
NAME 08402600
|
|
M=2; 08402800
|
|
IF PTR=0 THEN P(MKS,INTCALL((-4)&1[2:47:1],FORTERRI)) ; 08402900
|
|
IF PTR.[01:01] THEN 08402925
|
|
P(M&1[14:47:01],PTR.[09:22]+(PTR.[33:15]!0),CHS,CDC,DEL); 08402950
|
|
STRING~M[PTR]; 08403000
|
|
N~ABS(N); 08403100
|
|
IF PTR.CSIZE=EIGHT THEN 08403200
|
|
BEGIN 08403400
|
|
IF N>6 THEN POLISH((STRING)&6[08:38:10],N,CDC,DEL); 08403600
|
|
SOFF~0&PTR[32:18:13]; N~0&N[09:12:36]; COMMENT BIT INDICES; 08403800
|
|
POLISH([STRING[(SOFF+N-8) DIV 48]],DEL); 08404000
|
|
STREAM(RESULT~0:S~[STRING[SOFF DIV 48]],SKS~(SOFF~SOFF MOD 48), 08404200
|
|
SKD~48-N,N); 08404400
|
|
BEGIN 08404600
|
|
SI~S; SKIP SKS SB; 08404800
|
|
DI~LOC RESULT; SKIP SKD DB; 08405000
|
|
N(IF SB THEN DS~1 SET ELSE DS~1 RESET; SKIP 1 SB); 08405200
|
|
END; 08405400
|
|
RESULT := P(DUP); % SAVE IT 08405600
|
|
END ELSE 08405800
|
|
BEGIN 08406000
|
|
COMMENT SOURCE HAS 6 BITS/CHAR; 08406200
|
|
IF N>8 THEN POLISH((STRING)&8[08:38:10],N,CDC,DEL); 08406400
|
|
POLISH([STRING[(PTR.[18:13]+N-1).[35:10]]],DEL); 08406600
|
|
STREAM(RESULT~0:S~[STRING[PTR.[18:10]]],SKS~PTR.[28:03], 08406800
|
|
N,SKD~8-N); 08407000
|
|
BEGIN 08407200
|
|
SI~S; SI~SI+SKS; 08407400
|
|
DI~LOC RESULT; DI~DI+SKD; 08407600
|
|
DS~N CHR; 08407800
|
|
END; 08408000
|
|
RESULT := P(DUP); % SAVE IT 08408200
|
|
END; 08408400
|
|
IF NOT (P(TOP)) THEN % IT IS BAD 08408500
|
|
P([RCW]&1[8:38:10],0,COC);% FLAG II 08408510
|
|
END SISO; 08408600
|
|
PROCEDURE SCAN(UPDPDD,PTR,UPDCDD,HISCOUNT,CASECODE,CHAR); 08410000
|
|
VALUE PTR, HISCOUNT, CASECODE, CHAR; 08410050
|
|
NAME UPDPDD, UPDCDD; 08410100
|
|
INTEGER PTR, HISCOUNT, CASECODE, CHAR; 08410150
|
|
08410200
|
|
BEGIN 08410250
|
|
COMMENT RELATION WHILE UNTIL 08410300
|
|
{ 0 20 08410350
|
|
} 4 16 08410400
|
|
! 8 12 08410450
|
|
= 12 8 08410500
|
|
< 16 4 08410550
|
|
> 20 0 08410600
|
|
IN ALPHA 24 29 08410650
|
|
IN NUMERIC 25 30 08410660
|
|
IN TRUTHSET 26 31 08410670
|
|
NOTE: THE TRUTH SET IS THE 64 BITS BEGINNING AT BIT 1 08410680
|
|
DF THE WORD POINTED TO BY THE DESCRIPTOR IN CHAR. 08410690
|
|
; 08410700
|
|
08410750
|
|
NAME M=2; 08410800
|
|
ARRAY STRINGDESC[*]; 08410850
|
|
INTEGER OURCOUNT, WOFSET, CHOFSET, N, N1, JUNK=17; 08410900
|
|
INTEGER AWHILE; % "IN" SCAN IS FOR WHILE. 08410925
|
|
BOOLEAN MORE; 08410950
|
|
DEFINE PW=[18:10]#, PC=[28:03]#, CSIZE=[31:02]#, 08411000
|
|
SIX=00#, ALONE=@777777#,POFSET=[18:13]#; 08411050
|
|
08411100
|
|
SUBROUTINE CHARSCAN; 08411150
|
|
BEGIN; 08411200
|
|
COMMENT SCAN FOR CONDITIONS OTHER THAN ALPHA MEMBERSHIP.; 08411250
|
|
STREAM(N, CHOFSET, CHAR : DD1~[STRINGDESC[0]], CASECODE, 08411300
|
|
DD~[STRINGDESC[WOFSET]]); 08411350
|
|
BEGIN 08411400
|
|
SI~DD; SI~SI+CHOFSET; 08411450
|
|
DI~LOC CHAR; DI~DI+6; 08411500
|
|
CI~CI+CASECODE; 08411550
|
|
GO TO LE; %00 08411600
|
|
GO TO GE; %01 08411650
|
|
GO TO NE; %02 08411700
|
|
GO TO EQ; %03 08411750
|
|
GO TO LS; %04 08411800
|
|
%GO TO GR; %05 08411850
|
|
GR:N(IF SC{DC THEN JUMP OUT TO XX; DI~DI-1); GO TO XY; 08411900
|
|
LS:N(IF SC}DC THEN JUMP OUT TO XX; DI~DI-1); GO TO XY; 08411950
|
|
EQ:N(IF SC!DC THEN JUMP OUT TO XX; DI~DI-1); GO TO XY; 08412000
|
|
NE:N(IF SC=DC THEN JUMP OUT TO XX; DI~DI-1); GO TO XY; 08412050
|
|
GE:N(IF SC<DC THEN JUMP OUT TO XX; DI~DI-1); GO TO XY; 08412100
|
|
LE:N(IF SC>DC THEN JUMP OUT TO XX; DI~DI-1); GO TO XY; 08412150
|
|
XY:TALLY~1; SI~SI+1; 08412200
|
|
XX:N~TALLY; SI~SI-1; CHAR~SI; 08412250
|
|
SI~DD1; CHOFSET~SI; 08412300
|
|
END; 08412350
|
|
CHOFSET~POLISH(SUB,DUP).[18:15]; 08412400
|
|
%WE ONLY NEED [30:03], BUT REST OF FIELD IS 0 AND ESPOL KNOWS TO 08412450
|
|
%OPTIMIZE [18:15] TO AN "FTC" OPERATOR. 08412500
|
|
WOFSET~POLISH.[33:15]; 08412550
|
|
MORE~POLISH; 08412600
|
|
END CHARSCAN; 08412650
|
|
08412700
|
|
SUBROUTINE ALFSCAN; 08412750
|
|
BEGIN; 08412800
|
|
COMMENT SCAN . . . WHILE/UNTIL IN ALPHA, NUMERIC, TRUTHSETID; 08412850
|
|
STREAM (CHOFSET, SWITCHER:=CASECODE, N : TSET:=[CHAR], AWHILE, 08412900
|
|
DD1:=[STRINGDESC[0]], DD:=[STRINGDESC[WOFSET]]); 08412950
|
|
BEGIN 08413000
|
|
SI:=DD; SI:=SI+CHOFSET; 08413010
|
|
CI:=CI+AWHILE; GO UCASE; % GO WCASE; 08413020
|
|
WCASE: 08413030
|
|
CI:=CI+SWITCHER; GO ATESTW; GO NTESTW; % GO TTESTW; 08413040
|
|
TTESTW: DI:=LOC SWITCHER; 08413050
|
|
N ( DD:=SI; DI:=DI-1; DS:=CHR; 08413060
|
|
SI:=TSET; SKIP CHOFSET SB; SKIP SB; 08413070
|
|
IF SB THEN; SI:=DD; 08413080
|
|
IF TOGGLE THEN SI:=SI+1 ELSE JUMP OUT TO TSTOPW; 08413090
|
|
); 08413100
|
|
GO AWAYW; 08413110
|
|
NTESTW: 08413120
|
|
N ( IF SC GEQ "0" THEN IF SC LEQ "9" THEN; 08413130
|
|
IF TOGGLE THEN SI:=SI+1 ELSE JUMP OUT TO TSTOPW; 08413140
|
|
); 08413150
|
|
GO AWAYW; 08413160
|
|
ATESTW: 08413170
|
|
N ( IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO TSTOPW ); 08413180
|
|
AWAYW: 08413190
|
|
TALLY:=1; 08413200
|
|
TSTOPW: GO TO DONE; 08413210
|
|
UCASE: 08413220
|
|
CI:=CI+SWITCHER; GO ATESTU; GO NTESTU; % GO TTESTU; 08413230
|
|
TTESTU: DI:=LOC SWITCHER; 08413240
|
|
N ( DD:=SI; DI:=DI-1; DS:=CHR; 08413250
|
|
SI:=TSET; SKIP CHOFSET SB; SKIP SB; 08413260
|
|
IF SB THEN; SI:=DD; 08413270
|
|
IF TOGGLE THEN JUMP OUT TO TSTOPU; SI:=SI+1; 08413280
|
|
); 08413290
|
|
GO AWAYU; 08413300
|
|
NTESTU: 08413310
|
|
N ( IF SC GEQ "0" THEN IF SC LEQ "9" THEN JUMP OUT TO TSTOPU; 08413320
|
|
SI:=SI+1; 08413330
|
|
); 08413340
|
|
GO AWAYU; 08413350
|
|
ATESTU: 08413360
|
|
N ( IF SC=ALPHA THEN JUMP OUT TO TSTOPU; SI:=SI+1 ); 08413370
|
|
AWAYU: 08413380
|
|
TALLY:=1; 08413390
|
|
TSTOPU: DONE: 08413400
|
|
N:=TALLY; SWITCHER:=SI; SI:=DD1; CHOFSET:=SI; 08413410
|
|
END; 08413500
|
|
MORE~POLISH; 08413550
|
|
CHOFSET~POLISH(SUB,DUP).[18:15];%OPTIMIZED [30:03] ISOLATE. 08413600
|
|
WOFSET~POLISH.[33:15]; 08413650
|
|
END ALFSCAN; 08413700
|
|
08413750
|
|
IF PTR=0 THEN P(MKS,INTCALL((-4)&1[2:47:1],FORTERRI)) ; 08413755
|
|
IF PTR.[01:01] THEN 08413760
|
|
P(M&1[14:47:01],PTR.[09:22]+(PTR.[33:15]!0),CHS,CDC,DEL); 08413770
|
|
IF PTR.CSIZE!SIX THEN POLISH(M&1[14:47:01],8686,CDC,DEL); 08413800
|
|
STRINGDESC~M[PTR]; 08413850
|
|
IF (OURCOUNT~0&(STRINGDESC)[35:08:10]-PTR.POFSET) <0 THEN 08413900
|
|
POLISH([STRINGDESC[PTR.POFSET]]); 08413950
|
|
IF HISCOUNT { 0 THEN 08413960
|
|
BEGIN UPDCDD[0]~0;UPDPDD[0]~PTR+0&WOFSET[18:35:13];P(XIT);END; 08413970
|
|
IF (HISCOUNT~(JUNK~HISCOUNT).[33:15])<OURCOUNT THEN 08414000
|
|
OURCOUNT~HISCOUNT; 08414050
|
|
WOFSET~PTR.PW; CHOFSET~PTR.PC; 08414100
|
|
N~N1~OURCOUNT; MORE~TRUE; 08414200
|
|
IF CASECODE GEQ 24 THEN % IN ALPHA, NUMERIC, TRUTHSET 08414250
|
|
BEGIN 08414300
|
|
IF AWHILE:=(CASECODE LEQ 26) THEN % CONDITION IS "WHILE IN" 08414350
|
|
ELSE CASECODE:=CASECODE-1; % CONDITION IS "UNTIL IN" 08414360
|
|
CASECODE:=CASECODE.[46:2]; % 0,1,2 08414370
|
|
IF N1>63 THEN 08414400
|
|
BEGIN 08414450
|
|
N~63; 08414500
|
|
DO ALFSCAN UNTIL (N1~N1-63){63 OR NOT MORE; 08414550
|
|
N~N1; 08414600
|
|
END; 08414650
|
|
IF N>0 AND MORE THEN ALFSCAN; 08414700
|
|
END ELSE 08414750
|
|
BEGIN 08414800
|
|
CASECODE:=CASECODE.[43:3]; CHAR:=0&CHAR[36:42:6]; 08414825
|
|
IF N1>63 THEN 08414850
|
|
BEGIN 08414900
|
|
N~63; 08414950
|
|
DO CHARSCAN UNTIL (N1~N1-63){63 OR NOT MORE; 08415000
|
|
N~N1; 08415050
|
|
END; 08415100
|
|
IF N>0 AND MORE THEN CHARSCAN; 08415150
|
|
END; 08415200
|
|
IF HISCOUNT>OURCOUNT AND MORE THEN 08415250
|
|
POLISH([STRINGDESC[CHOFSET&WOFSET[30:33:15]]]); 08415300
|
|
IF POLISH(.UPDPDD,LOD,RFB,.UPDCDD,LOD,RFB,OR)!0 THEN 08415350
|
|
BEGIN 08415400
|
|
WOFSET~CHOFSET&WOFSET[30:33:15]-PTR.[18:13]; 08415450
|
|
UPDCDD[0] ~HISCOUNT-WOFSET; 08415500
|
|
UPDPDD[0]~PTR+0&WOFSET[18:35:13]; 08415550
|
|
END; 08415600
|
|
END SCAN; 08415650
|
|
PROCEDURE REPL; 08420000
|
|
BEGIN 08420020
|
|
COMMENT STRING REPLACE INTRINSIC FOR B5500 TS ALGOL 08420040
|
|
MARCH 1968. RATCHFORD 08420060
|
|
8-BIT CHARS, WORD XFERS & UNCONDITIONAL XFER ADDED APRIL 1968 HJR; 08420080
|
|
DEFINE 08420100
|
|
CSIZE=[31:02]#, EIGHT=01#, TCOND=45#, DOT=[18:13]#, 08420120
|
|
DECNVRT=(-32)#, 08420130
|
|
AMPER=[18:35:13]#, 08420140
|
|
POTZ=IF SB THEN DS~1 SET ELSE DS~1 RESET; SKIP 1 SB;#; 08420160
|
|
ARRAY 08420180
|
|
SORC[*] , COMMENT DESC FOR SOURCE STRING; 08420200
|
|
DEST[*] ; COMMENT DATA DESC FOR DESTINATION STRING; 08420220
|
|
NAME 08420240
|
|
UPDPDD =-08, COMMENT DESC FOR UPDATE DESI POINTER; 08420260
|
|
UPSPDD =-06, COMMENT DESC FOR UPDATE SOURCE POINTER; 08420280
|
|
UPCTDD =-04, COMMENT DESC FOR UPDATE COUNT VARIABLE; 08420300
|
|
M = 02; 08420320
|
|
INTEGER 08420340
|
|
DPTR =-07, COMMENT DESTINATION POINTER; 08420360
|
|
SPTR =-05, COMMENT SOURCE POINIER OR 1 TO 8 LIIERAL CHRS. 08420380
|
|
8 ONLY IF LITERAL IS ARITHMETIC; 08420400
|
|
HISCNT =-03, COMMENT CALLER"S IDEA OF HOW BIG MAXCOUNT IS; 08420420
|
|
RELATION =-02, COMMENT SWITCH INDEX FOR SCAN CODE. THE INDEX 08420440
|
|
VALUES ARE SUPPOSED TO BE THE SAME FOR REPL 08420460
|
|
AND SCAN. RELATION IS <0 IF THE SOURCE IS 08420480
|
|
A LITERAL AND IS }0 IF SOURCE IS A POINIER; 08420500
|
|
COMMENT COMPARE USES THE SAME VALUES OF RELAT; 08420520
|
|
CHAR =-01, COMMENT THE WHILE/UNTIL COMPARISON CHAR; 08420540
|
|
CHAR1 , COMMENT SDA-FORMAT ADDR OF 1ST XFERRED CHAR; 08420560
|
|
CHARN , COMMENT SDA FORMAT ADDR OF LAST XFERRED CHAR; 08420580
|
|
SORCL =CHAR1,COMMENT LENGTH OF SOURCE CALCULATED BY US; 08420600
|
|
DESTL =CHARN,COMMENT REMAINING CHARS IN DEST STRING; 08420620
|
|
SWI=CHAR1, DWI=CHARN, ITERC, 08420630
|
|
OURCNT , COMMENT SAFE MAX LENGTH FOR REPLACE. 08420640
|
|
FOR POINTER-SOURCE, MIN(HISCNT,SORCL,DESTL), 08420660
|
|
FOR LITERAL SOURCE, MIN(DESTL,HISCNT); 08420680
|
|
SOFF , COMMENT CHARACTER OFFSET IN SOURCE; 08420700
|
|
SSIZE =SOFF,COMMENT SOURCE CHAR SIZE (6 OR 8 BITS/CHAR); 08420720
|
|
DOFF , COMMENT CHARACTER OFFSET IN DESTINATION; 08420740
|
|
DSIZE =DOFF,COMMENT DEST CHAR SIZE; 08420760
|
|
UPDTOG , COMMENT TRUE IF ANY UPDATE(S) REQUESTED; 08420780
|
|
JUNK =17, COMMENT USED FOR BUILDING CONCATENATED LITRL; 08420800
|
|
TOGL , COMMENT "TOGGLE" FOR REPLACE WHILE/UNTIL; 08420820
|
|
REFETCH =TOGL,COMMENT THE "INVALIDATOR" FOR REPL UNTIL; 08420840
|
|
INITIAL =TOGL;COMMENT LOCAL 4 USE BY REPL FROM LITERAL; 08420860
|
|
INTEGER AWHILE; % CONDITION IS "WHILE IN" 08420865
|
|
BOOLEAN MORE; %CONDITIONAL REPLACE ISN"T DONE YET. 08420870
|
|
ARRAY NAME 08420880
|
|
SORCI =SORC,COMMENT INDEXED DESC FOR POINTER-SOURCE; 08420900
|
|
DESTI =DEST;COMMENT INDEXED DATA DESC FOR DEST STRING; 08420920
|
|
SUBROUTINE CREPL; 08420921
|
|
BEGIN; 08420922
|
|
STREAM(DOFF,CHAR,SOFF,ITERC,MORE~0: 08420923
|
|
D1~[DEST[0]],S1~[SORC[0]],RELATION,T~0,S2~[SORC[SWI]], 08420924
|
|
D2~[DEST[DWI]]); 08420925
|
|
BEGIN 08420926
|
|
DI~DI+DOFF; D2~DI; DI~LOC CHAR; 08420927
|
|
DI~DI+6; T~DI; SI~S2; 08420928
|
|
SI~SI+SOFF; 08420929
|
|
ITERC(CI~CI+RELATION; 08420930
|
|
GO TO LE; 08420931
|
|
GO TO GE; 08420932
|
|
GO TO NE; 08420933
|
|
GO TO EQ; 08420934
|
|
GO TO LS; 08420935
|
|
%GO TO GR; 08420936
|
|
GR:IF SC{DC THEN; GO TO XX; 08420937
|
|
LS:IF SC}DC THEN; GO TO XX; 08420938
|
|
EQ:IF SC!DC THEN; GO TO XX; 08420939
|
|
NE:IF SC=DC THEN; GO TO XX; 08420940
|
|
GE:IF SC<DC THEN; GO TO XX; 08420941
|
|
LE:IF SC>DC THEN; %GO TO XX; 08420942
|
|
XX:IF TOGGLE THEN JUMP OUT TO XY; 08420943
|
|
SI~SI-1; DI~D2; DS~CHR; 08420944
|
|
D2~DI; DI~T; 08420945
|
|
); 08420946
|
|
TALLY~1; SI~SI+1; 08420947
|
|
XY:MORE~TALLY; SI~SI-1; CHAR~SI; 08420948
|
|
SI~S1; DOFF~SI; DI~D2; 08420949
|
|
ITERC~DI; DI~D1; SOFF~DI; 08420950
|
|
END; 08420951
|
|
MORE~POLISH; 08420952
|
|
DOFF~POLISH(SUB,DUP).[18:15]; %OPTIMIZED [30:03] ISOLATE. 08420953
|
|
DWI~POLISH.[33:15]; 08420954
|
|
SOFF~POLISH(SUB,DUP).[18:15]; 08420955
|
|
SWI~POLISH.[33:15]; 08420956
|
|
END CONDITIONAL REPLACE; 08420957
|
|
SUBROUTINE CRA; 08420958
|
|
BEGIN; COMMENT REPLACE . WHILE/UNTIL IN ALPHA, NUMERIC, TRUTHSET;08420959
|
|
STREAM(DOFF, T1:=0, SOFF, N:=ITERC, MORE:=0 : TSET:=[CHAR], AWHILE, 08420960
|
|
D1:=[DEST[0]], S1:=[SORC[0]], RELATION, 08420961
|
|
S2:=[SORC[SWI]], D2:=[DEST[DWI]]); 08420962
|
|
BEGIN 08420963
|
|
DI:=DI+DOFF; SI:=S2; SI:=SI+SOFF; 08420964
|
|
CI:=CI+AWHILE; GO UCASE; % GO WCASE; 08420965
|
|
WCASE: 08420966
|
|
CI:=CI+RELATION; GO ATESTW; GO NTESTW; % GO TTESTW; 08420967
|
|
TTESTW: D2:=DI; DI:=LOC T1; DI:=DI-1; T1:=DI; DI:=D2; 08420968
|
|
N ( D2:=DI; S2:=SI; DI:=T1; DS:=CHR; 08420969
|
|
SI:=TSET; SKIP DOFF SB; SKIP SB; 08420970
|
|
IF SB THEN; SI:=S2; DI:=D2; 08420971
|
|
IF TOGGLE THEN DS:=CHR ELSE JUMP OUT TO TSTOPW; 08420972
|
|
); 08420973
|
|
GO AWAYW; 08420974
|
|
NTESTW: 08420975
|
|
N ( IF SC GEQ "0" THEN IF SC LEQ "9" THEN; 08420976
|
|
IF TOGGLE THEN DS:=CHR ELSE JUMP OUT TO TSTOPW; 08420977
|
|
); 08420978
|
|
GO AWAYW; 08420979
|
|
ATESTW: 08420980
|
|
N ( IF SC=ALPHA THEN DS:=CHR ELSE JUMP OUT TO TSTOPW ); 08420981
|
|
AWAYW: 08420982
|
|
TALLY:=1; 08420983
|
|
TSTOPW: GO TO DONE; 08420984
|
|
UCASE: 08420985
|
|
CI:=CI+RELATION; GO ATESTU; GO NTESTU; % GO TTESTU; 08420986
|
|
TTESTU: D2:=DI; DI:=LOC T1; DI:=DI-1; T1:=DI; DI:=D2; 08420987
|
|
N ( D2:=DI; S2:=SI; DI:=T1; DS:=CHR; 08420988
|
|
SI:=TSET; SKIP DOFF SB; SKIP SB; 08420989
|
|
IF SB THEN; SI:=S2; DI:=D2;; 08420990
|
|
IF TOGGLE THEN JUMP OUT TO TSTOPU; DS:=CHR; 08420991
|
|
); 08420992
|
|
GO AWAYU; 08420993
|
|
NTESTU: 08420994
|
|
N ( IF SC GEQ "0" THEN IF SC LEQ "9" THEN JUMP OUT TO TSTOPU; 08420995
|
|
DS:=CHR; 08420996
|
|
); 08420997
|
|
GO AWAYU; 08420998
|
|
ATESTU: 08420999
|
|
N ( IF SC=ALPHA THEN JUMP OUT TO TSTOPU; DS:=CHR ); 08421000
|
|
AWAYU: 08421001
|
|
TALLY:=1; 08421002
|
|
TSTOPU: DONE: 08421003
|
|
MORE:=TALLY; N:=SI; T1:=DI; SI:=S1; SOFF:=SI; DI:=D1; DOFF:=DI; 08421004
|
|
END; 08421005
|
|
MORE:=P; SOFF:=P(SUB,DUP).[18:15]; SWI:=P.[33:15]; 08421006
|
|
DOFF:=P(SUB,DUP).[18:15]; DWI:=P.[33:15]; 08421007
|
|
END CBNDITIONAL ALPHA REPLACE; 08421008
|
|
IF DPTR.[01:01] THEN 08421009
|
|
P(M&1[14:47:01],DPTR.[09:22]+(DPTR.[33:15]!0),CHS,CDC,DEL); 08421010
|
|
IF (SPTR=0 AND RELATION.[1:1]=0) OR DPTR=0 08421011
|
|
THEN P(MKS,INTCALL((-4)&1[2:47:1],FORTERRI)) ; 08421012
|
|
DEST:=M[DPTR]; 08421013
|
|
DSIZE:=IF DPTR.CSIZE=EIGHT THEN 8 ELSE 6; 08421014
|
|
IF (TOGL:=RELATION.[01:01]=0) THEN 08421015
|
|
SSIZE:=IF SPTR.CSIZE=EIGHT THEN 8 ELSE 6 08421016
|
|
ELSE SSIZE~6; COMMENT LITERAL OR AEXP SOURCE; 08421020
|
|
IF TOGL AND DSIZE!SSIZE THEN 08421040
|
|
POLISH(DEST&1[08:38:10],8686,CDC,DEL); 08421060
|
|
UPDTOG~ 08421080
|
|
POLISH(.UPDPDD,LOD,RFB,.UPSPDD,LOD,RFB,OR,.UPCTDD,LOD,RFB,OR)!0; 08421100
|
|
IF (HISCNT~HISCNT) { 0 THEN 08421120
|
|
BEGIN UPCTDD[0]~0;UPDPDD[0]~DPTR;UPSPDD[0]~SPTR;P(XIT);END; 08421130
|
|
IF DSIZE=8 THEN 08421140
|
|
BEGIN 08421160
|
|
$ SET OMIT = NOT EIGHTBIT 08421170
|
|
COMMENT CAUSE INVALID INDEX, 9898 GEQ ASZ IF 8 BIT REPLACE IS DONE; 08423273
|
|
POLISH(DEST&1[8:38:10],9898,CDC,DEL); 08423275
|
|
$ RESET OMIT 08423276
|
|
END ELSE %8-BIT DEST FINISHED 08423280
|
|
COMMENT IF WE GET THIS FAR, DSIZE!EIGHT & SSIZE=DSIZE, SO 08423300
|
|
SPTR CAN"T BE 8 BITS/CHAR; 08423320
|
|
IF RELATION.[42:06]=TCOND THEN 08423340
|
|
BEGIN 08423360
|
|
COMMENT UNCONDITIONAL XFER OF 6-BIT CHARS OR WORDS; 08423380
|
|
IF RELATION.[40:01]=1 THEN 08423400
|
|
BEGIN 08423420
|
|
COMMENT WORD TRANSFER; 08423440
|
|
DPTR.DOT~0&(DOFF~(0&DPTR[35:18:13]+7).[35:10])[35:38:10]; 08423460
|
|
OURCNT~HISCNT.[38:10]; 08423480
|
|
IF (DOFF+OURCNT)>(DEST).[08:10] THEN 08423500
|
|
POLISH([DEST[(DEST.[8:10])]]); 08423520
|
|
IF TOGL THEN 08423540
|
|
BEGIN 08423560
|
|
IF SPTR.[01:01] THEN 08423570
|
|
P(M&1[14:47:01],SPTR.[09:22]+(SPTR.[33:15]!0),CHS, 08423571
|
|
CDC,DEL); 08423572
|
|
COMMENT POINTER SOURCE; 08423580
|
|
SORC~M[SPTR]; 08423600
|
|
SPTR.DOT~0&(SOFF~(0&SPTR[35:18:13]+7).[35:10])[35:38:10]; 08423620
|
|
IF (SOFF+OURCNT)>(SORC).[08:10] THEN 08423640
|
|
POLISH([SORC[(SORC.[8:10])]]); 08423660
|
|
IF OURCNT>0 THEN 08423670
|
|
STREAM(SOURCE~[SORC[SOFF]], 08423680
|
|
N1~OURCNT,N2~OURCNT.[38:04], 08423700
|
|
DESTAD~[DEST[DOFF]]); 08423720
|
|
BEGIN 08423740
|
|
SI~SOURCE; 08423760
|
|
DS~N1 WDS; N2(2(DS~32 WDS)); 08423780
|
|
END; 08423800
|
|
END ELSE %6-BIT POINTER SOURCE FINISHED FOR WD XFER 08423820
|
|
BEGIN 08423840
|
|
COMMENT LITERAL/AEXP SOURCE; 08423860
|
|
SORCL~HISCNT.[18:15]; 08423880
|
|
IF SORCL=0 THEN SORCL~HISCNT; 08423900
|
|
INITIAL~IF OURCNT>0 THEN 1 ELSE 0; 08423920
|
|
OURCNT~OURCNT-INITIAL; 08423940
|
|
STREAM(START~SPTR,SORCL,INITIAL, 08423960
|
|
SOFSET~8-SORCL,IN1~(JUNK~8 DIV SORCL), 08423980
|
|
IN2~8-JUNK|SORCL,N1~OURCNT,N2~OURCNT.[38:04], 08424000
|
|
DESTAD~[DEST[DOFF]], 08424020
|
|
SETDI~[JUNK]); 08424040
|
|
BEGIN 08424060
|
|
SI~LOC START; SI~SI+SOFSET; 08424080
|
|
SOFSET~SI; 08424100
|
|
IN1(DS~SORCL CHR; SI~SOFSET); 08424120
|
|
DS~IN2 CHR; SI~SETDI; DI~DESTAD; 08424140
|
|
START~DI; 08424160
|
|
DS~INITIAL WDS; SI~START; 08424180
|
|
DS~N1 WDS; N2(2(DS~32 WDS)); 08424200
|
|
END; 08424220
|
|
OURCNT~OURCNT+INITIAL; 08424240
|
|
END;%OF WORD-XFER FROM LIT-AEXP SOURCE 08424260
|
|
IF UPDTOG THEN CHAR~0&OURCNT[32:35:13]; 08424280
|
|
END ELSE %WORD TRANSFER DONE 08424300
|
|
BEGIN 08424320
|
|
COMMENT CHAR XFER FROM 6-BIT SOURCES; 08424340
|
|
DOFF~DPTR.DOT; OURCNT~HISCNT.[35:13]; 08424360
|
|
IF (DOFF+OURCNT)>0&(DEST)[35:08:10] THEN 08424380
|
|
POLISH([DEST[(DEST.[8:10])]]); 08424400
|
|
IF TOGL THEN 08424420
|
|
BEGIN 08424440
|
|
COMMENT SOURCE IS A POINTER; 08424460
|
|
IF SPTR.[01:01] THEN 08424470
|
|
P(M&1[14:47:01],SPTR.[09:22]+(SPTR.[33:15]!0),CHS, 08424471
|
|
CDC,DEL); 08424472
|
|
SORC~M[SPTR]; 08424480
|
|
SOFF~0&SPTR[35:18:13]; 08424500
|
|
IF (SOFF + OURCNT) > 0 & (SORC)[35:8:10] THEN 08424503
|
|
BEGIN 08424504
|
|
INITIAL := HISCNT.[35:13] - HISCNT.[20:13]; 08424506
|
|
STREAM(START:=SPTR.[28:3], FINISH:=DPTR.[28:3], 08424508
|
|
N1:=INITIAL, N2:=INITIAL.[37:5], 08424510
|
|
N3:=INITIAL.[35:2], INITIAL:= HISCNT.[20:13], 08424511
|
|
IN1:= HISCNT.[22:5], IN2:= HISCNT.[20:2], 08424512
|
|
SOURCE:= [SORC[SPTR.[18:10]]], 08424513
|
|
DESTAD:= [DEST[DPTR.[18:10]]]); 08424514
|
|
BEGIN 08424516
|
|
SI:=SOURCE; SI:=SI+START; DI:=DI+FINISH; 08424518
|
|
SOURCE:= DI; 08424520
|
|
DS:= INITIAL CHR; IN1(2(DS:=32 CHR )); 08424522
|
|
IN2(2(32(DS:= 32 CHR ))); 08424524
|
|
SI := SOURCE; 08424526
|
|
DS:= N1 CHR; N2(2(DS:= 32 CHR )); 08424530
|
|
N3(2(32(DS:= 32 CHR ))); 08424540
|
|
END; 08424544
|
|
END ELSE 08424546
|
|
IF OURCNT>0 THEN 08424550
|
|
STREAM(START~SPTR.[28:03],FINISH~DPTR.[28:03], 08424560
|
|
N1~OURCNT,N2~OURCNT.[37:05],N3~OURCNT.[35:02], 08424580
|
|
SOURCE~[SORC[SPTR.[18:10]]], 08424600
|
|
DESTAD~[DEST[DPTR.[18:10]]]); 08424620
|
|
BEGIN 08424640
|
|
SI~SOURCE; SI~SI+START; 08424660
|
|
DI~DI+FINISH; 08424680
|
|
DS~N1 CHR; N2(2(DS~32 CHR)); 08424700
|
|
N3(2(32(DS~32 CHR))); 08424720
|
|
END; 08424740
|
|
END ELSE %POINTER SOURCE FINISHED 08424760
|
|
BEGIN 08424780
|
|
COMMENT LITERAL/AEXP SOURCE, UNCOND XFER, 6-BIT DEST; 08424800
|
|
SORCL~HISCNT.[18:15]; 08424820
|
|
IF SORCL=0 THEN SORCL~HISCNT; 08424840
|
|
INITIAL~IF OURCNT>7 THEN 8 ELSE OURCNT; 08424860
|
|
OURCNT~OURCNT-INITIAL; 08424880
|
|
IF INITIAL>0 THEN 08424885
|
|
IF INITIAL{SORCL THEN 08424890
|
|
STREAM(INITIAL,SPTR,SSKP~ 8-SORCL, 08424891
|
|
DOFSET~DPTR.[28:03],D~[DEST[DPTR.[18:10]]]); 08424892
|
|
BEGIN 08424893
|
|
DI~DI+DOFSET; SI~LOC SPTR; 08424894
|
|
SI~SI+SSKP; DS~INITIAL CHR; 08424895
|
|
END ELSE 08424896
|
|
STREAM(START~SPTR,SORCL,INITIAL, 08424900
|
|
SOFSET~8-SORCL,IN1~(JUNK~8 DIV SORCL), 08424920
|
|
IN2~8-JUNK|SORCL,N1~OURCNT,N2~OURCNT.[37:05], 08424940
|
|
N3~OURCNT.[35:02],DOFSET~DPTR.[28:03], 08424960
|
|
DESTAD~[DEST[DPTR.[18:10]]],SETDI~[JUNK]); 08424980
|
|
BEGIN 08425000
|
|
SI~LOC START; SI~SI+SOFSET; 08425020
|
|
SOFSET~SI; IN1(DS~SORCL CHR; SI~SOFSET); 08425040
|
|
DS~IN2 CHR; SI~SETDI; DI~DESTAD; 08425060
|
|
DI~DI+DOFSET; START~DI; 08425080
|
|
DS~INITIAL CHR; SI~START; 08425100
|
|
DS~N1 CHR; N2(2(DS~32 CHR)); 08425120
|
|
N3(2(32(DS~32 CHR))); 08425140
|
|
END; 08425160
|
|
OURCNT~OURCNT+INITIAL; 08425180
|
|
END;%OF LITERAL/AEXP 6-BIT SOURCE 08425200
|
|
CHAR~OURCNT; 08425220
|
|
END % OF 6-BIT UNCONDITIONAL XFER 08425240
|
|
END ELSE% UNCONDITIONAL XFER FINISHED 08425260
|
|
IF RELATION=DECNVRT THEN 08425264
|
|
BEGIN 08425265
|
|
DOFF~DPTR.[28:03]; DWI~DPTR.[18:10]; 08425266
|
|
IF (HISCNT~ (JUNK~ HISCNT).[33:15])>8 THEN 08425267
|
|
POLISH(M&8[08:38:10],HISCNT,CDC,DEL); 08425268
|
|
IF (0&(DEST) [35:08:10]-DPTR.DOT)-HISCNT<0 THEN 08425269
|
|
POLISH([DEST[DPTR.DOT+HISCNT]],DEL); 08425270
|
|
SPTR~SPTR; STREAM(SPTR,DOFF,HISCNT,D~[DEST[DWI]]); 08425271
|
|
BEGIN 08425272
|
|
DI~ DI + DOFF; SI~ LOC SPTR; 08425273
|
|
DS~HISCNT DEC; 08425274
|
|
END; 08425275
|
|
CHAR~HISCNT; 08425276
|
|
END ELSE 08425277
|
|
BEGIN 08425280
|
|
COMMENT CONDITIONAL XFER W/ SOURCE & DEST BOTH 6-BIT POINTERS; 08425300
|
|
IF SPTR.[01:01] THEN 08425312
|
|
P(M&1[14:47:01],SPTR.[09:22]+(SPTR.[33:15]!0),CHS,CDC,DEL); 08425314
|
|
SORC~M[SPTR]; 08425320
|
|
SORCL~0&(SORC)[35:08:10]-SPTR.DOT; 08425340
|
|
DESTL~0&(DEST)[35:08:10]-DPTR.DOT; 08425360
|
|
OURCNT~IF SORCL>DESTL THEN 08425380
|
|
(IF HISCNT>DESTL THEN DESTL ELSE HISCNT) ELSE 08425400
|
|
IF HISCNT>SORCL THEN SORCL ELSE HISCNT; 08425420
|
|
SOFF~SPTR.[28:03]; DOFF~DPTR.[28:03]; 08425440
|
|
SWI~SPTR.[18:10]; DWI~DPTR.[18:10]; 08425460
|
|
MORE~TRUE; 08425480
|
|
IF RELATION GEQ 24 THEN % IN ALPHA, NUMERIC, TRUTHSEI 08425500
|
|
BEGIN 08425520
|
|
IF AWHILE:=(RELATION LEQ 26) THEN % "WHILE IN" 08425540
|
|
ELSE RELATION:=31-RELATION; % "UNTIL IN" (MUST INVERT) 08425545
|
|
RELATION:=RELATION.[46:2]; % 0,1,2 08425550
|
|
IF (ITERC~OURCNT)>63 THEN 08425560
|
|
BEGIN 08425580
|
|
TOGL~OURCNT; ITERC~63; 08425600
|
|
DO CRA UNTIL (TOGL~TOGL-63){63 OR NOT MORE; 08425620
|
|
ITERC~TOGL; 08425640
|
|
END; 08425660
|
|
IF MORE AND ITERC>0 THEN CRA; 08425680
|
|
END ELSE 08425700
|
|
BEGIN 08425720
|
|
CHAR:=0&CHAR[36:42:6]; RELATION:=RELATION.[43:3]; 08425740
|
|
IF (ITERC~OURCNT)>63 THEN 08425760
|
|
BEGIN 08425780
|
|
TOGL~OURCNT; ITERC~63; 08425800
|
|
DO CREPL UNTIL (TOGL~TOGL-63){63 OR NOT MORE; 08425820
|
|
ITERC~TOGL; 08425840
|
|
END; 08425860
|
|
IF MORE AND ITERC>0 THEN CREPL; 08425880
|
|
END; 08425900
|
|
IF MORE AND HISCNT>OURCNT THEN 08425920
|
|
POLISH([DEST[DOFF&DWI[30:33:15]]],DEL, 08425940
|
|
[SORC[SOFF&SWI[30:33:15]]],DEL); 08425960
|
|
IF UPDTOG THEN CHAR~DOFF&DWI[30:33:15]-DPTR.DOT; 08425980
|
|
END;% CONDITIONAL XFER OF 6-BIT CHARS DONE 08427840
|
|
IF UPDTOG THEN 08427860
|
|
BEGIN 08427880
|
|
UPCTDD[0]~HISCNT.[35:13]-CHAR; 08427900
|
|
UPDPDD[0]~DPTR&( DPTR.DOT+CHAR )AMPER; 08427920
|
|
UPSPDD[0]~SPTR&( SPTR.DOT+CHAR )AMPER; 08427940
|
|
END; 08427960
|
|
END REPL; 08427980
|
|
PROCEDURE COMPARE; %043 08430000
|
|
BEGIN 08430020
|
|
COMMENT STRING/POINTER COMPARISON INTRINSIC FOR B5500 IS ALGOL. 08430040
|
|
MARCH 1968. POINTER UPDATES ADDED FOR STRING CMPR JUNE 1968. 08430060
|
|
MAJOR REWRITE TO CORRECT BAD ALGORITHM--OCT 69. 08430062
|
|
RATCHFORD; 08430080
|
|
COMMENT THERE ARE FOUR FLAVORS OF STRING/POINTER COMPARE: 08430100
|
|
1. <AEXP> IN ALPHA. AEXP IS IN [42:06] OF F-7. RELATION=29. 08430120
|
|
2. <PEXP1>=<PEXP2> OR <PEXP1> ! <PEXP2>. 08430140
|
|
RELATION=65 FOR = & 66 FOR ! 08430160
|
|
3. <PUP1>:<PEXP1> <RELATION> <PUP2>:<PEXP2> FOR <COUNT>. 08430180
|
|
4. <PEXP1> <RELATION> <LITERAL> FOR <COUNT>. 08430200
|
|
VALUES OF <RELATION> ARE SAME AS FOR SCAN & REPLACE. FOR #4, 08430220
|
|
F-FIELD OF F-2 IS LENGTH OF LITERAL STRING & C-FIELD IS VALUE 08430240
|
|
OF <COUNT> IN SOURCE STMT (8192 IF OMITTED). 08430260
|
|
RELATION HAS SIGN-BIT=1 FOR CASE #4. 08430280
|
|
; 08430300
|
|
DEFINE 08430320
|
|
DOT=[18:13]#, 08430340
|
|
AMPER=[18:35:13]#, 08430360
|
|
CSIZE=[31:02]#, SIX=00#; 08430380
|
|
INTEGER 08430400
|
|
RELATION =-01, %SAME CODES AS FOR SCAN/REPLACE. 08430420
|
|
HISCNT =-02, %LENGTH OF LITERAL IN F-FIELD, 08430440
|
|
%LENGTH OF COMPARE IN C-FIELD. 08430460
|
|
P2 =-03, %SOURCE STMT IS "P1 RELATION P2 FOR 08430480
|
|
%HISCNT" 08430500
|
|
LITERAL =P2 , %P2 MAY BE A LITERAL OF 1->8 CHARS. 08430520
|
|
P1 =-07, 08430540
|
|
CHAR =P1 , %LOC"N OF CHAR FOR "CHAR IN ALPH A" 08430560
|
|
R1C, R1W, %CHAR & WORD OFFSET FOR P1 08430580
|
|
R2C, R2W, 08430600
|
|
N, %LENGTH OF COMPARE FOR CURRENT CALL OF 08430620
|
|
%FINDIT. 08430640
|
|
LOOPCOUNT =P2, %USED FOR LITERAL COMPARISONS. 08430660
|
|
JUNK = 17; 08430680
|
|
REAL RJUNK=JUNK; 08430690
|
|
BOOLEAN 08430700
|
|
RESULT =P1, %THIS IS ALSO ONE OF THE POINTER ARGS. 08430720
|
|
DONE; %SOMETIMES MEANS WE FOUND SOME ! CHARS. 08430740
|
|
NAME 08430760
|
|
UPP2DD =-04, %DD FOR UPDATE OF P2 POINTER. 08430780
|
|
UPP1DD =-05, 08430800
|
|
M = 02; 08430820
|
|
ARRAY 08430840
|
|
ROW1[*], ROW2[*]; %ARRAY ROWS REFERENCED BY P1/P2. 08430860
|
|
SUBROUTINE FINDIT; %FIND BLOCK OF 64 CONTAINING 1ST ! CHARS. 08430880
|
|
BEGIN; 08430890
|
|
STREAM(N:R1C,R2C,R1~[ROW1[R1W]],R2~[ROW2[R2W]]); 08430900
|
|
BEGIN 08430910
|
|
SI~R1; SI~SI+R1C; 08430920
|
|
DI~DI+R2C; 08430930
|
|
IF N SC!DC THEN TALLY~1; 08430940
|
|
N~TALLY; 08430950
|
|
END; 08430960
|
|
IF NOT (DONE~POLISH) THEN 08430970
|
|
BEGIN %SET UP WORD & CHAR OFFSET FOR NEXT CALL. 08430980
|
|
R1C~POLISH(R1C&R1W[35:38:10]+N,DUP).[45:03]; 08430990
|
|
R1W~POLISH.[35:10]; 08431000
|
|
R2C~POLISH(R2C&R2W[35:38:10]+N,DUP).[45:03]; 08431010
|
|
R2W~POLISH.[35:10]; 08431020
|
|
END UPDATE OF CHAR AND WORD INDICES; 08431030
|
|
END FINDIT; 08431040
|
|
SUBROUTINE COMP; %COMPARE 2 ! CHARS FOR < OR >. 08431050
|
|
BEGIN; 08431060
|
|
STREAM(RELATION:R1C,R2C,R1~[ROW1[R1W]],R2~[ROW2[R2W]]); 08431070
|
|
BEGIN 08431080
|
|
SI~R1; SI~SI+R1C; 08431090
|
|
DI~DI+R2C; 08431100
|
|
COMMENT COMP SHOULD ONLY BE CALLED IF FINDIT FINDS 2 ! CHARS.;08431110
|
|
63(IF SC!DC THEN JUMP OUT); 08431120
|
|
SI~SI-1; DI~DI-1; 08431130
|
|
CI~CI+RELATION; 08431140
|
|
GO GR; 08431150
|
|
%GO LS; 08431160
|
|
LS:IF SC<DC THEN ; GO XX; 08431170
|
|
GR:IF SC>DC THEN ; % GO XX; 08431180
|
|
XX:IF TOGGLE THEN TALLY~1; 08431190
|
|
RELATION~TALLY; 08431200
|
|
END COLLATING SEQ COMPARE; 08431210
|
|
DONE~POLISH; 08431220
|
|
END COMP; 08431230
|
|
HISCNT ~ (HISCNT} 0) | HISCNT; 08431520
|
|
IF RELATION.[43:5] GEQ 29 THEN % IN ALPHA, NUMERIC, TRUTHSET 08431540
|
|
BEGIN; 08431560
|
|
COMMENT CHAR IN ALPHA TEST; 08431580
|
|
STREAM(TALLIE:=0 : CHAR, ITS:=RELATION.[46:2]-1, TSET:=[HISCNT]);08431600
|
|
BEGIN 08431620
|
|
SI~LOC CHAR; SI~SI+7; 08431640
|
|
CI:=CI+ITS; GO TO ALP; GO TO NMR; % GO TO TSET; 08431660
|
|
TST: SI:=TSET; SKIP CHAR SB; SKIP SB; 08431665
|
|
IF SB THEN BEGIN TALLY:=1; TALLIE:=TALLY END; GO DUN; 08431670
|
|
NMR: IF SC GEQ "0" THEN IF SC LEQ "9" THEN % 08431675
|
|
BEGIN TALLY:=1; TALLIE:=TALLY END; GO DUN; 08431680
|
|
ALP: IF SC=ALPHA THEN BEGIN TALLY:=1; TALLIE:=TALLY END; 08431685
|
|
DUN: 08431690
|
|
END; 08431695
|
|
RESULT~POLISH; 08431700
|
|
END ELSE 08431720
|
|
IF RELATION>64 THEN 08431740
|
|
COMMENT P1=P2 OR P1!P2:COMPARE THE ABSOLUTE ADDRESSES THAT THE 08431760
|
|
2 POINTERS REFERENCE WITHOUT LOOKING AT THE CONTENTS OF THESE 08431780
|
|
LOCATIONS. NOTE THAT UNINITIALIZED POINTERS COMPARE EQUAL.; 08431800
|
|
RESULT~(RELATION=65) EQV (P1.[18:30]=P2.[18:30]) ELSE 08431820
|
|
BEGIN 08431840
|
|
COMMENT A RELATIONAL COMPARISON OF TWO STRINGS.; 08431860
|
|
COMMENT NOTE THAT THE 5500 SIMULATIONS USE THE BCL COLLATING 08431880
|
|
SEQUENCE FOR RELATIONAL COMPARISONS, WHEREAS THE 6500 WILL 08431900
|
|
COMPARE THE MAGNITUDES OF THE TWO CHARACTERS AS 4- 6- OR 8-BIT 08431920
|
|
INTEGERS. THE 5500 SIMULATION ALSO ONLY ALLOWS 6-BIT BCL CHARS; 08431940
|
|
IF (P2=0 AND RELATION.[1:1]=0) OR P1=0 08431945
|
|
THEN P(MKS,INTCALL((-4)&1[2:47:1],FORTERRI)) ; 08431946
|
|
IF P1.[01:01] THEN 08431950
|
|
P(M&1[14:47:01],P1.[09:22]+(P1.[33:15]!0),CHS,CDC,DEL); 08431951
|
|
IF P1.CSIZE!SIX THEN POLISH(M&1[14:47:01],8686,CDC,DEL); 08431960
|
|
ROW1~M[P1]; R1C~P1.[28:03]; 08431980
|
|
R1W~P1.[18:10]; HISCNT~ABS(HISCNT); 08432000
|
|
IF (JUNK~HISCNT.[35:13]+P1.DOT)>0&(ROW1)[35:08:10] THEN 08432020
|
|
POLISH([ROW1[JUNK]],DEL); 08432040
|
|
IF RELATION.[01:01]=0 THEN 08432060
|
|
BEGIN 08432080
|
|
COMMENT BOTH P1&P2 ARE POINTERS; 08432100
|
|
IF P2.[01:01] THEN 08432110
|
|
P(M&1[14:47:01],P2.[09:22]+(P2.[33:15]!0),CHS,CDC,DEL); 08432111
|
|
IF P2.CSIZE!SIX THEN 08432120
|
|
POLISH(M&1[14:47:01], 8686,CDC,DEL); 08432140
|
|
ROW2~M[P2]; R2C~P2.[28:03]; 08432160
|
|
R2W~P2.[18:10]; 08432180
|
|
IF (HISCNT+P2.DOT)>0&(ROW2)[35:08:10] THEN 08432200
|
|
POLISH([ROW2[HISCNT+P2.DOT]],DEL); 08432220
|
|
IF (JUNK~HISCNT)>63 THEN 08432240
|
|
BEGIN 08432260
|
|
N~63; 08432280
|
|
DO FINDIT UNTIL ((JUNK~JUNK-63){63) OR DONE; 08432300
|
|
END; 08432320
|
|
IF (NOT DONE) AND (N~JUNK)!0 THEN FINDIT; 08432340
|
|
END ELSE 08432380
|
|
BEGIN 08432400
|
|
COMMENT P2 IS A LITERAL STRING; 08432420
|
|
IF (N~HISCNT.[18:15])=0 THEN N~HISCNT; 08432440
|
|
RJUNK~P2; ROW2~[RJUNK]&1[17:47:01]; 08432460
|
|
R2W~0; 08432480
|
|
COMMENT IF HISCNT.[18:15]!0 THEN [18:15]=STRING LENGTH & 08432481
|
|
[33:15]=EXPLICIT LENGTH OF COMPARE. OTHERWISE, [33:15] IS 08432482
|
|
BOTH LENGTH OF COMPARE AND LENGTH OF LITERAL.; 08432483
|
|
IF (HISCNT~HISCNT.[33:15]){N THEN 08432500
|
|
BEGIN 08432520
|
|
COMMENT LENGTH OF COMPARE IS { LENGTH OF LITERAL: WE DON"T 08432540
|
|
HAVE TO REPEAT THE LITERAL; 08432560
|
|
R2C~8-N; FINDIT; 08432580
|
|
END ELSE 08432600
|
|
BEGIN; 08432620
|
|
COMMENT LITERAL MUST BE DUPLICATED TO FILL 8 CHARS ; 08432640
|
|
STREAM(P2,N,SOFF~8-N,N1~8 DIV N,N2~(JUNK~8 MOD N), 08432660
|
|
D~[JUNK]); 08432680
|
|
BEGIN 08432700
|
|
SI~LOC P2; SI~SI+SOFF; D~SI; 08432720
|
|
N1(DS~N CHR; SI~D); 08432740
|
|
DS~N2 CHR; 08432760
|
|
END; 08432780
|
|
N~IF HISCNT{8 THEN HISCNT ELSE 8; 08432800
|
|
LOOPCOUNT~HISCNT-N; R2C~0; 08432820
|
|
FINDIT; 08432840
|
|
IF NOT DONE THEN 08432860
|
|
BEGIN 08432880
|
|
R2C~P1.[28:03]; R2W~P1.[18:10]; 08432900
|
|
ROW2~ROW1; 08432920
|
|
IF LOOPCOUNT>63 THEN 08432940
|
|
BEGIN 08432960
|
|
N~63; 08432980
|
|
DO FINDIT UNTIL DONE OR (LOOPCOUNT~LOOPCOUNT-63){63; 08433000
|
|
END; 08433020
|
|
IF (NOT DONE) AND (N~LOOPCOUNT)!0 THEN FINDIT; 08433040
|
|
END; 08433060
|
|
END 08433120
|
|
END; 08433140
|
|
BEGIN 08433141
|
|
UPP1DD[0] ~ P1 +0&HISCNT[18:35:13]; 08433142
|
|
UPP2DD[0] ~ P2 +0&HISCNT[18:35:13]; END; 08433143
|
|
IF (RELATION~ABS(RELATION))=8 THEN RESULT~(NOT DONE).[47:01] ELSE08433145
|
|
IF RELATION=12 THEN RESULT~DONE ELSE 08433147
|
|
IF DONE THEN 08433149
|
|
BEGIN %FINDIT DISCOVERED A ! CHAR IN THE TWO STRINGS 08433151
|
|
RELATION~RELATION.[45:01]; %0 & 16 TEST >, 4 & 20 TEST < 08433153
|
|
COMP; RESULT~DONE; 08433155
|
|
END ELSE 08433157
|
|
COMMENT STRINGS WERE = AND RELATION IS NOT = OR !. PLUCK THE 08433159
|
|
"=" HALF OF "{" OR "}" OUT OF RELATION.; 08433161
|
|
RESULT~RELATION.[43:01]; 08433163
|
|
END COLLATING SEQUENCE COMPARES; 08433320
|
|
END COMPARE; 08433340
|
|
PROCEDURE BASICPRINT(TYPE); 08500000
|
|
VALUE TYPE; 08500100
|
|
REAL TYPE; 08500200
|
|
08500300
|
|
BEGIN REAL ALGOLWRITE = 12, 08500400
|
|
ALGOLSELECT = 14; 08500450
|
|
REAL RCW = +0; 08500500
|
|
ARRAY POT = 25[*]; 08500600
|
|
NAME M = 2; 08500700
|
|
REAL T, 08500800
|
|
WH1, 08500900
|
|
WH2; 08501000
|
|
BOOLEAN THISTYPE; 08501100
|
|
INTEGER BSIZE, 08501200
|
|
BUFF, 08501300
|
|
BUFFLOAD, 08501400
|
|
COL, 08501500
|
|
COUNTER, 08501600
|
|
E, 08501700
|
|
ESIGN, 08501800
|
|
EXPCHR, 08501900
|
|
I, 08502000
|
|
ITEMS, 08502100
|
|
NUMCHR, 08502200
|
|
NUMROWS, 08502300
|
|
ROW, 08502400
|
|
ROWLENGTH, 08502500
|
|
SIGN, 08502600
|
|
SKIP, 08502700
|
|
TAB, 08502800
|
|
WRITESTMT; 08502810
|
|
NAME POINTER; 08502900
|
|
NAME FILX; 08502950
|
|
NAME STRING = T; 08503000
|
|
ARRAY FIB[*], 08503100
|
|
MATRIX[*], 08503200
|
|
MATRIXROW[*]; 08503300
|
|
BOOLEAN DATACOM, FIRSTIME; 08503325
|
|
LABEL COMMON, 08503400
|
|
LOGEIGHT, 08503500
|
|
MAXINT, 08503600
|
|
MINVALUE, 08503700
|
|
TENSEVEN, 08503800
|
|
TENSIX, 08503900
|
|
CONVERTED, 08504000
|
|
NORMAL, 08504100
|
|
DUMMYLABEL; 08504200
|
|
DEFINE LOG8 = P(LOGEIGHT)#, 08504300
|
|
MAX = P(MAXINT) #, 08504400
|
|
DELTA= P(MINVALUE)#, 08504500
|
|
TEN6 = P(TENSIX) #, 08504600
|
|
TEN7 = P(TENSEVEN)#; 08504700
|
|
DEFINE COMMA = 1#, 08504800
|
|
SEMICOLON = 2#, 08504900
|
|
ENDLINE = 3#; 08505000
|
|
08505100
|
|
08505200
|
|
REAL SUBROUTINE GETNEXT; 08505300
|
|
BEGIN THISTYPE ~ (TYPE ~ 0&TYPE[6:7:40]).[6:1]; 08505400
|
|
ITEMS ~ ITEMS-1; TAB ~ *(1 INX POINTER); 08505500
|
|
P(*POINTER); POINTER ~ 2 INX POINTER; 08505600
|
|
GETNEXT ~ POLISH 08505700
|
|
END GETNEXT; 08505800
|
|
BOOLEAN SUBROUTINE DIMENSION; 08505900
|
|
BEGIN COMMENT TRUE FOR SINGLE DIMENSIONED (INCLUDES STRINGS);; 08506000
|
|
STREAM(T~POLISH(XCH, 0, CDC):A~0); 08506100
|
|
BEGIN SI~T; DI~T; SI~SI-16; SKIP 2 SB; 08506200
|
|
IF SB THEN ELSE TALLY~1; T ~ TALLY; 08506300
|
|
END STREAM; 08506400
|
|
DIMENSION ~ THISTYPE OR POLISH; 08506500
|
|
END DIMENSION; 08506600
|
|
SUBROUTINE SETUPANDEXIT; 08506700
|
|
BEGIN IF DATACOM THEN 08506800
|
|
IF COUNTER NEQ 0 THEN 08506810
|
|
BEGIN;STREAM(BUFF); DS:=LIT "~"; 08506820
|
|
POLISH(MKS, 16, 0, 0, BSIZE, FILX, ALGOLWRITE); 08506830
|
|
BUFF := -(*FILX).[CF]; 08506850
|
|
END; 08506860
|
|
FIB[20]:=BUFF&COUNTER[3:33:15]&BSIZE[18:38:10]&1[29:47:1]; 08506900
|
|
POLISH(XIT); 08507000
|
|
END SETUPANDEXIT; 08507100
|
|
SUBROUTINE PRINT; 08507200
|
|
BEGIN P(MKS,1,0,0,BSIZE+((NOT DATACOM).[47:1]),FILX,ALGOLWRITE); 08507300
|
|
IF NOT DATACOM THEN 08507310
|
|
STREAM(A:="10",B:=[FIB[0]]); 08507320
|
|
BEGIN SI:=LOC A; DS:=8 ADD; END STREAM; 08507330
|
|
END PRINT ROUTINF; 08507340
|
|
SUBROUTINE CLEAR; 08507400
|
|
BEGIN;STREAM(A~BSIZE-1+DATACOM:D~*FILX); 08507450
|
|
BEGIN DS:=8 LIT " "; SI:=D; DS:=A WDS; DI:=D; A:=DI; END;08507500
|
|
BUFF:=POLISH; BUFFLOAD:=BSIZE|8; 08507550
|
|
END CLEAR ROUTINE; 08507600
|
|
SUBROUTINE CHECKPRESENCE; 08507700
|
|
BEGIN FIB[20]~(*P(DUP))&(COUNTER~0)[3:33:15]; 08507800
|
|
BSIZE~P(MKS,1,0,0,(-1),FILX,ALGOLWRITE); 08507825
|
|
IF DATACOM~FIB[4].[8:4]=10 OR FIB[4].[8:4]=13 THEN 08507850
|
|
BSIZE ~ 9 ELSE 08507855
|
|
BEGIN BSIZE~BSIZE-1; 08507860
|
|
STREAM(A~FIB[0],B~BSIZE INX (*FILX)); 08507870
|
|
BEGIN SI~LOC A; DS~WDS; END; 08507880
|
|
END; 08507890
|
|
CLEAR; 08507895
|
|
END CHECKPRESENCE; 08507900
|
|
SUBROUTINE PRINTEXIT; 08508000
|
|
BEGIN PRINT; 08508100
|
|
COUNTER ~ 0; 08508200
|
|
SETUPANDEXIT; 08508300
|
|
END PRINTEXIT; 08508400
|
|
SUBROUTINE PRINTRETURN; 08508500
|
|
BEGIN PRINT; 08508600
|
|
CHECKPRESENCE; 08508700
|
|
END PRINTRETURN; 08508800
|
|
SUBROUTINE FINDE; 08508900
|
|
BEGIN COMMENT DETFRMINE THE EXPONENT OF A REAL NUMBER. THE NUMBER 08509000
|
|
IS POSITIVE AND PASSED IN T. WHEN DONE, STORE THE 08509100
|
|
EXPONENT IN E, AND ROUND T TO 10*6 { T < 10*7; 08509200
|
|
E ~ ((0&T[42:3:6]&T[1:2:1]+12)|LOG8)+0.5; 08509300
|
|
WHILE T<(IF E}0 THEN POT[E] ELSE 1/POT[-E]) DO E ~ E-1; 08509400
|
|
T ~ IF (6-E)}0 THEN T|POT[6-E] ELSE T/POT[E-6]; 08509500
|
|
END FIND EXPONENT AND ROUND NUMBER; 08509600
|
|
SUBROUTINE CONVERT; 08509700
|
|
BEGIN 08509800
|
|
IF THISTYPE THEN 08509900
|
|
BEGIN; STREAM(A~0:S~STRING); 08510000
|
|
BEGIN SI~S; SI~SI+15; DI~LOC A; DI~DI+7; DS~CHR; END; 08510100
|
|
IF (I ~ POLISH+6)>15 THEN I ~ I-20; 08510200
|
|
NUMCHR := I + 3 | WRITESTMT; 08510250
|
|
IF(COUNTER + NUMCHR) GTR BUFFLOAD THEN PRINTRETURN; 08510300
|
|
STREAM(I:STRING,WRITESTMT,BUFF); 08510400
|
|
BEGIN SI:=STRING; WRITESTMT(DS~LIT """); DS~I CHR; 08510500
|
|
WRITESTMT(DS~LIT """; DS~LIT ","); I~DI; 08510550
|
|
END STREAM; 08510575
|
|
BUFF := POLISH; COUNTER := COUNTER + NUMCHR; 08510600
|
|
08510650
|
|
GO TO CONVERTED; 08510700
|
|
LOGEIGHT::: @1157163034761674; 08510750
|
|
END STRING HANDLING; 08510800
|
|
COMMENT THAT WAS EASY -- NOW FOR THE NUMERICAL STUFF; 08510900
|
|
ESIGN ~ EXPCHR ~ SIGN ~ SKIP ~ NUMCHR ~ 0; 08511000
|
|
SIGN ~ T!(T ~ ABS(T)); 08511100
|
|
IF T<MAX THEN 08511200
|
|
IF (IF T=0 THEN TRUE ELSE (ABS(((I ~ T)-T)/T)<DELTA)) THEN 08511300
|
|
BEGIN; COMMENT INTEGER, OR NEAR ENOUGH; 08511400
|
|
STREAM(I~I ~ T:T~[WH1]); 08511500
|
|
BEGIN SI~LOC I; DS~8 DEC; SI~T; 08511600
|
|
7(IF SC="0" THEN SI~SI+1); I~SI; 08511700
|
|
END STREAM; 08511800
|
|
NUMCHR ~ 8-(SKIP ~ P(XCH).[30:3]); 08511900
|
|
GO TO COMMON; 08512000
|
|
END INTEGER CASE; 08512100
|
|
T ~ 1.0|T; FINDE; 08512200
|
|
IF (I ~ T)}TEN7 THEN 08512300
|
|
BEGIN I ~ TEN6; E ~ E+1; END; 08512400
|
|
IF E<0 AND E}(-7) THEN 08512500
|
|
IF I=((I DIV (T ~ POT[ABS(E+1)]))|T) THEN 08512600
|
|
BEGIN T ~ I DIV T; 08512700
|
|
STREAM(P1~0:P2~P(ABS(E+1),DUP), 08512800
|
|
P3~7-P(XCH),P4~P(DUP)-1,P5~I,P6~[WH1]); 08512900
|
|
BEGIN DS~2 LIT "0."; P2(DS ~ LIT "0"); 08513000
|
|
SI~LOC P5; DS~P3 DEC; P1~DI; DI~P6; SI~P1; 08513100
|
|
SI~SI-1; P4(IF SC!"0" THEN JUMP OUT; 08513200
|
|
TALLY~TALLY+1; SI~SI-1); 08513300
|
|
P1~TALLY; 08513400
|
|
END STREAM; 08513500
|
|
NUMCHR ~ 9-P(XCH); 08513600
|
|
GO TO COMMON; 08513700
|
|
END F TYPE STUFF; 08513800
|
|
IF E}0 AND E<7 THEN 08513810
|
|
BEGIN COMMENT THE OTHER HALF OF F-FORMATTING;; 08513820
|
|
STREAM(P0~0: P1~P(E+1, DUP), 08513830
|
|
P2~7-P(XCH), P3~I, P4~[WH1]); 08513840
|
|
BEGIN DI~DI+1; SI~LOC P3; DS~7 DEC; 08513845
|
|
DI~P4; SI~P4; SI~SI+1; DS~P1 CHR; 08513850
|
|
DS~LIT "."; SI~SI+P2; SI~SI-1; 08513855
|
|
P2(IF SC!"0" THEN JUMP OUT; 08513860
|
|
TALLY~TALLY+1; SI~SI-1); P0~TALLY; 08513865
|
|
END STREAM; 08513870
|
|
NUMCHR ~ 8-P(XCH); GO TO COMMON; 08513880
|
|
END OTHER HALF FORMATTING; 08513890
|
|
STREAM(P1~ABS(E):P2~I,P3~[E],P4~[WH1]); 08513900
|
|
BEGIN DI~DI+1; SI~LOC P2; DS~7 DEC; DI~P4; SI~P4; 08514000
|
|
SI~SI+1; DS~CHR; DS~LIT "."; SI~SI+5; 08514100
|
|
6(IF SC!"0" THEN JUMP OUT; SI~SI-1; TALLY~TALLY+1); 08514200
|
|
DI~P3; SI~LOC P1; DI~DI+6; DS~2 DEC; P1~TALLY; 08514300
|
|
END STREAM; 08514400
|
|
EXPCHR ~ 1+(ABS(E)>9); ESIGN ~ E<0; NUMCHR ~ 8-P(XCH); 08514500
|
|
COMMON:: T ~ 1+NUMCHR+EXPCHR+((EXPCHR!0)+P(DUP))+WRITESTMT; 08514600
|
|
IF (COUNTER+T)>BUFFLOAD THEN PRINTRETURN; 08514700
|
|
STREAM(P1~SKIP:NUMCHR,SIGN,EXPCHR,P2~P(DUP)!0, 08514800
|
|
LSIGN,P3~[WH1],P4~[E],WRITESTMT,BUFF); 08514900
|
|
BEGIN DS~LIT " "; SIGN(DI~DI-1; DS~LIT "-"); 08515000
|
|
SI~P3; SI~SI+P1; DS~NUMCHR CHR; 08515100
|
|
P2(DS~2 LIT "E+"; ESIGN(DI~DI-1; DS~LIT "-"); 08515200
|
|
SI~P4; SI~SI+8; SI~SI-EXPCHR; DS~EXPCHR CHR); 08515300
|
|
WRITESTMT(DS~LIT ","); P1~DI; 08515400
|
|
END STREAM; 08515500
|
|
BUFF ~ POLISH; COUNTER ~ COUNTER+T; 08515600
|
|
GO TO CONVERTED; 08515700
|
|
08515800
|
|
MAXINT ::: @1045753603774000; 08515900
|
|
MINVALUE::: @1256553762465363; 08516000
|
|
TENSEVEN::: @1054611320000000; 08516100
|
|
TENSIX ::: @1063641100000000; 08516200
|
|
CONVERTED: 08516300
|
|
END CONVERT; 08516400
|
|
SUBROUTINE TABCONTROL; 08516500
|
|
BEGIN COMMENT DOES ROUTINE TABBING OPERATIONS; 08516600
|
|
IF TAB<0 THEN COMMENT TAB CONTROL GIVEN EXPLICITLY; 08516700
|
|
BEGIN TAB:= (ABS(TAB)-1) MOD BUFFLOAD; 08516800
|
|
IF FIRSTIME THEN BEGIN FIRSTIME:= FALSE; 08516900
|
|
IF TAB LSS COUNTER THEN PRINTRETURN; END; 08516910
|
|
BEGIN COMMENT SPACE FWD;% 08517000
|
|
STREAM(A:=BUFF:TAB:=TAB-COUNTER, 08517050
|
|
T:=P(DUP).[36:6]);% 08517060
|
|
BEGIN 08517100
|
|
SI:= LOC TAB; SKIP SB; 08517110
|
|
IF SB THEN 08517120
|
|
BEGIN COMMENT SPACE BACKWARD; 08517130
|
|
SI:= A; T(SI:= SI- 32; SI:= SI - 32); 08517140
|
|
SI:= SI - TAB; 08517150
|
|
END ELSE 08517160
|
|
BEGIN COMMENT SPACE FORWARD; 08517170
|
|
SI:= A; T(SI:= SI + 32; SI:= SI + 32); 08517180
|
|
SI := SI + TAB; 08517190
|
|
END; 08517200
|
|
A:= SI; 08517210
|
|
END STREAM;% 08517300
|
|
BUFF:=POLISH; COUNTER:=TAB;% 08517400
|
|
END SPACE FWD THRU BUFFER;% 08517410
|
|
END ELSE BEGIN COMMENT NORMAL TAB CONTROL FUNCTION; 08517500
|
|
IF TAB=ENDLINE THEN PRINTEXIT; 08517600
|
|
IF WRITESTMT = 0 THEN BEGIN 08517650
|
|
IF TAB=COMMA THEN 08517700
|
|
T ~ COUNTER-(COUNTER ~ ((COUNTER+14) DIV 15)|15) 08517800
|
|
ELSE IF TAB=SEMICOLON THEN 08517900
|
|
T := COUNTER-(COUNTER :=((COUNTER+5) DIV 3) | 3); 08518000
|
|
IF COUNTER>BUFFLOAD THEN PRINTRETURN ELSE 08518100
|
|
IF TAB!0 THEN BEGIN; 08518200
|
|
STREAM(BUFF:T); 08518300
|
|
BEGIN SI~BUFF; SI~SI+T; BUFF~SI; END; 08518400
|
|
BUFF ~ POLISH; 08518500
|
|
END END END END TABCONTROL; 08518600
|
|
COMMENT*********START OF CODE******; 08518700
|
|
ITEMS ~ TYPE.[1:6]; WRITESTMT ~ TYPE.[46:1]; 08518800
|
|
POINTER ~ 1 INX ([RCW]&RCW[FTC]); 08518900
|
|
FILX ~ *POINTER; FILX[NOT 4] ~ *(1 INX POINTER); 08518910
|
|
POINTER ~ 2 INX POINTER; 08518920
|
|
FIB ~ FILX[NOT 2]; 08519000
|
|
IF FIB[5].[43:1] THEN P(MKS, 0, 0, FILX, 1, ALGOLSELECT); 08519100
|
|
IF FIB[0]=0 THEN BEGIN FIB[0]:="1000"; THISTYPE:=TRUE; END; 08519150
|
|
DATACOM ~ FIB[4].[8:4] = 10 OR FIB[4].[8:4] = 13; 08519175
|
|
IF (COUNTER ~ (T ~ FIB[20]).[3:15])=0 THEN CHECKPRESENCE ELSE 08519200
|
|
BEGIN BUFF ~ T.[30:18]; BUFFLOAD ~ 8|(BSIZE ~ T.[18:10]) END; 08519300
|
|
IF THISTYPE AND FIB[4].[8:4]=4 THEN 08519320
|
|
P(*[FIB[14]],7,CDC,1,SSN,XCH,STD); 08519330
|
|
IF DATACOM THEN CLEAR 08519350
|
|
ELSE IF FIB[21] NEQ 0 THEN P(FILX,8,11,COM); 08519360
|
|
TAB:= *POINTER; POINTER:= 1 INX POINTER; 08519400
|
|
FIRSTIME := TRUE; TABCONTROL; 08519410
|
|
IF ITEMS=0 THEN SETUPANDEXIT; 08519500
|
|
IF NOT TYPE THEN GO TO NORMAL; 08519600
|
|
DO BEGIN COMMENT MATRIX PRINI ROUTINE; 08519700
|
|
POLISH(MATRIX ~ GETNEXT); 08519800
|
|
IF P(TAB, DUP)=ENDLINE THEN TAB ~ COMMA; P(XCH); 08519900
|
|
IF DIMENSION THEN 08520000
|
|
BEGIN COL ~ THISTYPE+1; ROWLENGTH ~ MATRIX.[8:10]; 08520100
|
|
DO BEGIN 08520200
|
|
T ~ [MATRIX[COL]]; 08520300
|
|
CONVERT; TABCONTROL; 08520400
|
|
END UNTIL (COL ~ COL+THISTYPE+1)=ROWLENGTH; 08520500
|
|
IF (TAB ~ POLISH)=ENDLINE THEN PRINTEXIT; 08520550
|
|
END ELSE BEGIN 08520600
|
|
NUMROWS ~ MATRIX.[8:10]; 08520700
|
|
ROWLENGTH ~ (*[MATRIX[ROW ~ 1]]).[8:10]; 08520800
|
|
DO BEGIN 08520900
|
|
MATRIXROW ~ *[MATRIX[ROW]]; COL ~ 1; 08521000
|
|
DO BEGIN 08521100
|
|
T ~ [MATRIXROW[COL]]; 08521200
|
|
CONVERT; TABCONTROL; 08521300
|
|
END UNTIL (COL ~ COL+1)=ROWLENGTH; 08521400
|
|
IF COUNTER!0 THEN PRINTRETURN; 08521450
|
|
END UNTIL (ROW ~ ROW+1)=NUMROWS; 08521500
|
|
IF (TAB ~ POLISH)=ENDLINE THEN SETUPANDEXIT; 08521600
|
|
END; 08521700
|
|
END UNTIL (POINTER INX 0)=[TYPE].[CF]; 08521800
|
|
SETUPANDEXIT; 08521900
|
|
NORMAL: DO BEGIN T ~ GETNEXT; 08522000
|
|
CONVERT; TABCONTROL; 08522100
|
|
END UNTIL (POINTER INX 0)=[TYPE].[CF]; 08522200
|
|
SETUPANDEXIT; 08522300
|
|
END BASIC PRINT ROUTINE; 08522400
|
|
PROCEDURE READATA(TYPE); 08600000
|
|
VALUE TYPE; 08600100
|
|
REAL TYPE; 08600200
|
|
BEGIN 08600300
|
|
ARRAY DATA = 21[*], 08600400
|
|
COMPANION = 22[*]; 08600500
|
|
INTEGER PTR = 23, 08600600
|
|
ENDATA = 24; 08600700
|
|
INTEGER COL, 08600800
|
|
COUNT, 08600900
|
|
D, 08601000
|
|
NUMROWS, 08601100
|
|
R, 08601200
|
|
ROW, 08601300
|
|
ROWLENGTH, 08601400
|
|
T; 08601500
|
|
BOOLEAN THISTYPE; 08601600
|
|
ARRAY MATRIX[*], 08601700
|
|
MATRIXROW[*], 08601800
|
|
DATAROW[*], 08601900
|
|
COMPROW[*]; 08602000
|
|
NAME N; 08602100
|
|
LABEL NORMAL; 08602200
|
|
REAL SUBROUTINE GETNEXT; 08602300
|
|
BEGIN COMMENT GET NEXT ITEM FROM STACK, AND DO 08602400
|
|
SOME ROUTINE HOUSEKEEPING OPERATIONS; 08602500
|
|
P(*(P(.TYPE)+COUNT)); 08602600
|
|
THISTYPE ~ (TYPE ~ 0&TYPE[6:7:40]).[6:1]; 08602700
|
|
GETNEXT ~ POLISH 08602800
|
|
END GETNEXT; 08602900
|
|
BOOLEAN SUBROUTINE DIMENSION; 08603000
|
|
BEGIN COMMENT TRUE FOR SINGLE DIMENSIONED (INCLUDES STRINGS);; 08603100
|
|
STREAM(T~POLISH(XCH, 0, CDC):A~0); 08603200
|
|
BEGIN SI~T; DI~T; SI~SI-16; SKIP 2 SB; 08603300
|
|
IF SB THEN ELSE TALLY~1; T ~ TALLY; 08603400
|
|
END STREAM; 08603500
|
|
DIMENSION ~ THISTYPE OR POLISH; 08603600
|
|
END DIMENSION; 08603700
|
|
SUBROUTINE PUT; 08603800
|
|
BEGIN COMMENT GETS AND STORES NEXT DATUM; 08603900
|
|
IF (R|256+D)=ENDATA THEN POLISH((-48), 26, COM); 08604000
|
|
IF DATAROW=0 THEN 08604100
|
|
BEGIN DATAROW ~ *[DATA[R]]; 08604200
|
|
COMPROW ~ *[COMPANION[R]]; 08604300
|
|
END; 08604400
|
|
STREAM(A~T.[43:5]:B~[COMPROW[T.[40:3]]]); 08604500
|
|
BEGIN SI~B; SI~SI+2; SKIP 4 SB; SKIP A SB; 08604600
|
|
IF SB THEN TALLY~1; A~TALLY; 08604700
|
|
END STREAM; 08604800
|
|
IF POLISH+THISTYPE THEN P((-44), 26, COM); 08604900
|
|
IF THISTYPE THEN 08605000
|
|
BEGIN COMMENT STRING;; 08605100
|
|
STREAM(S~[DATAROW[D]],N); 08605200
|
|
BEGIN SI~S; DS~2 WDS; END; 08605300
|
|
END ELSE COMMENT NUMERICAL STUFF (OR WE ARE IN TROUBLE); 08605400
|
|
P(DATAROW[D],[N],~); 08605500
|
|
IF (D ~ D+THISTYPE+1)}256 THEN 08605600
|
|
BEGIN COMMENT ROW OVERFLOW; 08605700
|
|
R := R+1; T := D := DATAROW := 0; 08605800
|
|
END ELSE T ~ T+1; 08605900
|
|
END PUT; 08606000
|
|
SUBROUTINE EXIT; 08606100
|
|
BEGIN COMMENT FUTZ UP PTR AND GO BACK TO THE REAL WDRLD; 08606200
|
|
PTR ~ R&D[CTF]&T[9:39:9]; 08606300
|
|
POLISH(XIT); 08606400
|
|
END EXIT; 08606500
|
|
COMMENT**********START OF CODE**********; 08606600
|
|
COUNT ~ TYPE.[1:6]; 08606700
|
|
R ~ PTR.[CF]; D ~ PTR.[FF]; T ~ PTR.[9:9]; 08606800
|
|
IF NOT TYPE THEN GO TO NORMAL; 08606900
|
|
DO BEGIN 08607000
|
|
POLISH(MATRIX ~ GETNEXT); 08607100
|
|
IF DIMENSION THEN 08607200
|
|
BEGIN COL ~ THISTYPE+1; ROWLENGTH ~ MATRIX.[8:10]; 08607300
|
|
DO BEGIN 08607400
|
|
N ~ [MATRIX[COL]]; 08607500
|
|
PUT; 08607600
|
|
END UNTIL (COL ~ COL+THISTYPE+1)=ROWLENGTH; 08607700
|
|
END ELSE BEGIN 08607800
|
|
NUMROWS ~ MATRIX.[8:10]; 08607900
|
|
ROWLENGTH ~ (*[MATRIX[ROW ~ 1]]).[8:10]; 08608000
|
|
DO BEGIN 08608100
|
|
MATRIXROW ~ *[MATRIX[ROW]]; COL ~ 1; 08608200
|
|
DO BEGIN 08608300
|
|
N ~ [MATRIXROW[COL]]; 08608400
|
|
PUT; 08608500
|
|
END UNTIL (COL ~ COL+1)=ROWLENGTH; 08608600
|
|
END UNTIL (ROW ~ ROW+1)=NUMROWS; 08608700
|
|
END; 08608800
|
|
END UNTIL (COUNT ~ COUNT-1)=0; 08608900
|
|
EXIT; 08609000
|
|
NORMAL: 08609100
|
|
DO BEGIN 08609200
|
|
N ~ GETNEXT; PUT; 08609300
|
|
END UNTIL (COUNT ~ COUNT-1)=0; 08609400
|
|
EXIT; 08609500
|
|
END READATA; 08609600
|
|
PROCEDURE BASICINPUT(TYPES); 08700000
|
|
VALUE TYPES; 08700100
|
|
REAL TYPES; 08700200
|
|
08700300
|
|
BEGIN REAL RCW = +0, 08700400
|
|
ALGOLREAD = 13, 08700500
|
|
ALGOLSELECT = 14; 08700600
|
|
ARRAY POT = 25[*]; 08700700
|
|
INTEGER BSIZE, 08700800
|
|
BUFF, 08700900
|
|
CHAR, 08701000
|
|
COL, 08701100
|
|
COUNT, 08701200
|
|
COUNTER, 08701300
|
|
DECADES, 08701400
|
|
E, 08701500
|
|
ESIGN, 08701600
|
|
NUMBER, 08701700
|
|
NUMROWS, 08701800
|
|
ROW, 08701900
|
|
ROWLENGTH, 08702000
|
|
SIGN; 08702100
|
|
BOOLEAN GOTDIGIT, 08702200
|
|
READSTMT, 08702250
|
|
STOG, 08702300
|
|
THISTYPE; 08702400
|
|
ARRAY FIB[*], 08702500
|
|
MATRIX[*], 08702600
|
|
MATRIXROW[*]; 08702700
|
|
NAME ADDRESS, 08702800
|
|
FILX, 08702850
|
|
POINTER, 08702900
|
|
STRING = ADDRESS; 08703000
|
|
LABEL LOOK, 08703100
|
|
SIGNED, 08703200
|
|
PASTPOINT, 08703300
|
|
AT, 08703400
|
|
EXPSIGNED, 08703500
|
|
DECIMAL, 08703600
|
|
ERROR, 08703700
|
|
STRUNG, 08703800
|
|
QUOTEDSTRING, 08703810
|
|
SETCOUNT, 08703820
|
|
NORMAL, 08703900
|
|
EXIT, 08704000
|
|
DUMMYLABEL; 08704100
|
|
REAL SUBROUTINE GETNEXT; 08704200
|
|
BEGIN COUNT ~ COUNT-1; 08704300
|
|
P(*POINTER); POINTER ~ 1 INX POINTER; 08704400
|
|
THISTYPE ~ (TYPES ~ 0&TYPES[6:7:39]).[6:1]; 08704500
|
|
GETNEXT ~ POLISH 08704600
|
|
END GETNEXT; 08704700
|
|
BOOLEAN SUBROUTINE DIMENSION; 08704800
|
|
BEGIN COMMENT TRUE FOR SINGLE DIMENSIONED (INCLUDES STRINGS);; 08704900
|
|
STREAM(T~POLISH(XCH, 0, CDC):A~0); 08705000
|
|
BEGIN SI~T; DI~T; SI~SI-16; SKIP 2 SB; 08705100
|
|
IF SB THEN ELSE TALLY~1; T ~ TALLY; 08705200
|
|
END STREAM; 08705300
|
|
DIMENSION ~ THISTYPE OR POLISH; 08705400
|
|
END DIMENSION; 08705500
|
|
SUBROUTINE CHECKPRESENCE; 08705600
|
|
BEGIN COMMENT CALL ALGOL READ INTRINSIC TO 08705700
|
|
AWAIT TOP BUFFER BEING PRESENT; 08705800
|
|
BSIZE ~ POLISH(MKS, 0, 1, FILX, ALGOLREAD); 08705900
|
|
IF FIB[4].[8:4]=10 THEN BSIZE ~ 9 ELSE BSIZE ~ BSIZE-1; 08705950
|
|
BSIZE ~ BSIZE|8; BUFF ~ (*FILX).[CF]; 08706000
|
|
END CHECK PRESENCE BIT; 08706100
|
|
SUBROUTINE READIT; 08706200
|
|
POLISH(MKS, 0, 0, FILX, ALGOLREAD); 08706300
|
|
SUBROUTINE SETUPANDEXIT; 08706310
|
|
BEGIN FIB[21]:=BUFF&BSIZE[18:38:10]&1[29:47:1]; P(XIT); END; 08706320
|
|
SUBROUTINE SCAN; 08706400
|
|
BEGIN COMMENT GENERAL-PURPOSE SCANNER -- CHARACTER AT A TIME; 08706500
|
|
LOOK: IF BSIZE=0 THEN BEGIN READIT; CHECKPRESENCE; END; 08706600
|
|
STREAM(I~-1,BUFF,N~IF BSIZE<63 THEN BSIZE ELSE 63:STOG); 08706700
|
|
BEGIN SI~BUFF; CI~CI+STOG; GO TO DEBLANK; 08706800
|
|
COMMENT SWITCH ON WHETHER WITHIN STRING OR NOT; 08706900
|
|
GNC: TALLY~TALLY+1; DI~LOC I; DS~LIT "0"; 08707000
|
|
DI~DI+6; DS~CHR; GO TO EXIT; 08707100
|
|
DEBLANK: N(IF SC!" " THEN JUMP OUT TO GNC; 08707200
|
|
TALLY~TALLY+1; SI~SI+1); 08707300
|
|
EXIT: N~TALLY; BUFF~SI; 08707400
|
|
END STREAM; 08707500
|
|
BSIZE ~ BSIZE-P(XCH); COMMENT UPDATE COUNT; 08707600
|
|
BUFF ~ POLISH; COMMENT UPDATE POINTER; 08707700
|
|
IF P(DUP)<0 THEN COMMENT ONLY FOUND BLANKS; 08707800
|
|
BEGIN P(DEL); 08707900
|
|
IF (BSIZE=0) AND GOTDIGIT THEN P(",") ELSE GO TO LOOK; 08707920
|
|
END; 08707940
|
|
CHAR ~ POLISH; 08708000
|
|
END SCAN ROUTINE; 08708100
|
|
BOOLEAN SUBROUTINE TESTCOLLECT; COMMENT PUTS CURRENT CHAR 08708110
|
|
INTO STRING AND UPDATES CHAR COUNTER,ALSO DETECTS OVERFLOW; 08708115
|
|
BEGIN 08708120
|
|
STREAM(CHAR, N:=COUNTER:=COUNTER+1, STRING);% 08708125
|
|
BEGIN SI := LOC N; SI := SI-1;% 08708130
|
|
DI := DI+N; DS := CHR;% 08708135
|
|
END STREAM;% 08708140
|
|
TESTCOLLECT:=COUNTER=15;% 08708145
|
|
END TESTCOLLECT;% 08708150
|
|
SUBROUTINE FREEREAD; 08708200
|
|
BEGIN COMMENT READS AND STORES NEXT DATUM, DOING APPROPRIATF 08708300
|
|
CONVERSIONS. HANDLES STRINGS AND NUMBERS, AND 08708400
|
|
ACCEPTS A VARIETY OF FORMATS; 08708500
|
|
DECADES ~ E ~ ESIGN ~ GOTDIGIT ~ NUMBER ~ STOG ~ 0; SCAN; 08708600
|
|
IF CHAR="," THEN GO TO EXIT; 08708700
|
|
IF THISTYPE THEN GO TO STRUNG; 08708800
|
|
GOTDIGIT ~ 1; 08708850
|
|
IF (SIGN ~ CHAR="-") OR CHAR="+" OR CHAR="&" THEN SCAN; 08708900
|
|
IF CHAR>9 THEN GO TO DECIMAL; 08709000
|
|
DO BEGIN NUMBER ~ 10|NUMBER+CHAR; SCAN; 08709100
|
|
END UNTIL CHAR>9; 08709200
|
|
IF CHAR="." THEN 08709300
|
|
BEGIN SCAN; 08709400
|
|
PASTPOINT:: WHILE CHAR{9 DO 08709500
|
|
BEGIN NUMBER ~ 10|NUMBER+CHAR; 08709600
|
|
DECADES ~ DECADES+1; SCAN; 08709700
|
|
END END; 08709800
|
|
IF CHAR="@" OR CHAR="E" THEN 08709900
|
|
AT:: BEGIN SCAN; 08710000
|
|
IF (ESIGN ~ CHAR="-") OR CHAR="+" OR CHAR="&" THEN SCAN; 08710100
|
|
IF (E ~ CHAR)>9 THEN GO TO ERROR; SCAN; 08710200
|
|
WHILE CHAR{9 DO BEGIN E ~ 10|E+CHAR; SCAN; END; 08710300
|
|
IF ESIGN THEN E ~ -E; 08710400
|
|
END; 08710500
|
|
WHILE CHAR!"," DO SCAN; 08710600
|
|
P(NUMBER, E-DECADES, POT[ABS(P(DUP))], XCH); 08710700
|
|
IF P(DUP)=0 THEN P(DEL, DEL) 08710800
|
|
ELSE IF P<0 THEN P(/) ELSE P(|); 08710900
|
|
IF SIGN THEN P(CHS); P([ADDRESS], ~); 08711000
|
|
GO TO EXIT; 08711100
|
|
DECIMAL:: IF CHAR="." THEN BEGIN SCAN; 08711200
|
|
IF CHAR{9 THEN GO TO PASTPOINT ELSE GO TO ERROR; END; 08711300
|
|
NUMBER ~ 1; 08711400
|
|
IF CHAR="@" OR CHAR="E" THEN GO TO AT; 08711500
|
|
ERROR: COMMENT ERROR TERMINATE - INVALID INPUT DATUM;% 08711600
|
|
POLISH((-41), 26, COM);% 08711610
|
|
STRUNG:: COMMENT COLLECT STRING ITEM;% 08711700
|
|
COUNTER:=-(STOG:=1);% 08711800
|
|
STREAM(STRING); DS:=16 LIT" "; % BLANK STRING 08711900
|
|
IF CHAR =""" THEN GO QUOTEDSTRING;% 08712000
|
|
WHILE (CHAR NEQ " " AND CHAR NEQ ",") 08712100
|
|
DO IF TESTCOLLECT THEN GO ERROR ELSE SCAN;% 08712200
|
|
GO TO SETCOUNT;% 08712210
|
|
QUOTEDSTRING:: 08712300
|
|
SCAN; IF CHAR=""" THEN GO SETCOUNT;% 08712400
|
|
IF TESTCOLLECT THEN GO ERROR ELSE GO QUOTEDSTRING;% 08712500
|
|
COMMENT CONVERT COUNTER TO COLLATING SEQUENCE;% 08712600
|
|
SETCOUNT: 08712700
|
|
IF COUNTER LSS 0 THEN GO ERROR % NULL STRING 08712800
|
|
ELSE IF (COUNTER:=COUNTER-5) LSS 0 THEN COUNTER:=COUNTER+20;% 08712810
|
|
COMMENT PUT IN CHAR COUNT REQUIRED BY BASIC STRINGVARB;% 08712900
|
|
STREAM(COUNTER,STRING);% 08712920
|
|
BEGIN SI:=LOC STRING; SI:=SI-1; 08713000
|
|
DI:=DI+15; DS:=CHR;% 08713010
|
|
END STREAM;% 08713020
|
|
GOTDIGIT:=1; STOG:=0;% 08713100
|
|
IF CHAR NEQ "," THEN DO SCAN UNTIL CHAR=",";% 08713110
|
|
EXIT:: 08713200
|
|
END FREE FIELD READ ROUTINE; 08713300
|
|
COUNT ~ TYPES.[1:6]; READSTMT ~ TYPES.[46:1]; 08713400
|
|
FILX ~ *(POINTER ~ 1 INX ([RCW]&RCW[FTC])); 08713500
|
|
FILX[NOT 4] ~ *(1 INX POINTER); FIB ~ FILX[NOT 2]; 08713510
|
|
POINTER ~ 2 INX POINTER; 08713520
|
|
IF FIB[5].[43:2]!2 THEN P(MKS, 0, 2, FILX, 1, ALGOLSELECT); 08713600
|
|
IF (E:=FIB[4].[8:4])=10 OR E=13 THEN FIB[20]:=0 08713610
|
|
ELSE IF FIB[20] NEQ 0 THEN P(FILX,8,11,COM); 08713620
|
|
IF (BUFF ~ (E ~ FIB[21]).[30:18]) = 0 08713700
|
|
THEN CHECKPRESENCE ELSE BSIZE ~ E.[18:10]; 08713710
|
|
IF NOT TYPES THEN GO TO NORMAL; 08713800
|
|
DO BEGIN 08713900
|
|
POLISH(MATRIX ~ GETNEXT); 08714000
|
|
IF DIMENSION THEN 08714100
|
|
BEGIN COL ~ THISTYPE+1; ROWLENGTH ~ MATRIX.[8:10]; 08714200
|
|
DO BEGIN 08714300
|
|
ADDRESS ~ [MATRIX[COL]]; 08714400
|
|
FREEREAD; 08714500
|
|
END UNTIL (COL ~ COL+THISTYPE+1)=ROWLENGTH; 08714600
|
|
END ELSE BEGIN 08714700
|
|
NUMROWS ~ MATRIX.[8:10]; 08714800
|
|
ROWLENGTH ~ (*[MATRIX[ROW ~ 1]]).[8:10]; 08714900
|
|
DO BEGIN 08715000
|
|
MATRIXROW ~ *[MATRIX[ROW]]; COL ~ 1; 08715100
|
|
DO BEGIN 08715200
|
|
ADDRESS ~ [MATRIXROW[COL]]; 08715300
|
|
FREEREAD; 08715400
|
|
END UNTIL (COL ~ COL+1)=ROWLENGTH; 08715500
|
|
END UNTIL (ROW ~ ROW+1)=NUMROWS; 08715600
|
|
END; 08715700
|
|
END UNTIL COUNT=0; 08715800
|
|
SETUPANDEXIT; 08715900
|
|
NORMAL: 08716000
|
|
DO BEGIN 08716100
|
|
ADDRESS ~ GETNEXT; 08716200
|
|
FREEREAD; 08716300
|
|
END UNTIL COUNT=0; 08716400
|
|
SETUPANDEXIT; 08716490
|
|
END BASIC INPUT ROUTINE; 08716500
|
|
%***********************************************************************08800000
|
|
PROCEDURE MATRIXDIDDLER(A, B, C, TYPE);% MAT ARITH INTRINSIC 08800050
|
|
VALUE A, % RESULTANT MOM 08800100
|
|
B, % ARG 1 MOM OR SCALAR VALUE 08800110
|
|
C; % ARG 2 MOM 08800120
|
|
ARRAY A[*], B[*], C[*]; 08800200
|
|
INTEGER TYPE; 08800300
|
|
%***********************************************************************08800310
|
|
BEGIN REAL SCALE = B; 08800400
|
|
INTEGER I, 08800500
|
|
J, 08800600
|
|
LASTI, 08800700
|
|
LASTJ; 08800800
|
|
ARRAY AROW[*], 08800900
|
|
BROW[*], 08801000
|
|
CROW[*]; 08801100
|
|
BOOLEAN SINGLE; 08801200
|
|
LABEL ERROR, 08801300
|
|
DIMERR, %% 08801350
|
|
CHKSI, 08801355
|
|
CHKSIZE, 08801360
|
|
NORMAL, 08801400
|
|
SCALEFACTOR; 08801500
|
|
DEFINE SF = [8:10]#;% 08801600
|
|
BOOLEAN SUBROUTINE DIMENSION; % 08801700
|
|
BEGIN COMMENT TRUE FOR SINGLY-DIMENSIONED MATRIX;; 08801800
|
|
STREAM(T:=P(XCH, 0, CDC):A:=0); 08801900
|
|
BEGIN SI:=T; DI:=T; SI:=SI-16; SKIP 2 SB;%% 08802000
|
|
IF SB THEN ELSE TALLY:=1; T:=TALLY; 08802100
|
|
END STREAM; 08802200
|
|
DIMENSION := POLISH; 08802300
|
|
END DIMENSION; 08802400
|
|
COMMENT * * * * * * * * * * * START OF CODE * * * * * * * * * * *; 08802500
|
|
I := J:= 1; POLISH(CROW := C);% 08802600
|
|
IF (SINGLE := DIMENSION) THEN 08802700
|
|
BEGIN COMMENT ROW VECTOR CASE;% 08802800
|
|
LASTI := 2; LASTJ := C.SF;% 08802850
|
|
IF NOT POLISH(AROW :=A, DIMENSION) THEN GO ERROR; % 08802900
|
|
IF TYPE = 2 THEN GO CHKSI; % 08803000
|
|
IF POLISH(BROW := B, DIMENSION) THEN 08803050
|
|
IF LASTJ = BROW.SF THEN GO CHKSI;% 08803100
|
|
ERROR: COMMENT NON CONFORMAL ARGUMENTS; 08803200
|
|
POLISH((-50), 26, COM); % 08803300
|
|
CHKSI: COMMENT CHECK DIMESION BOUNDS; 08803310
|
|
IF LASTJ GTR A.SF THEN 08803400
|
|
DIMERR: COMMENT DIMESION SIZE ERROR; 08803500
|
|
POLISH((-72), 26, COM);% 08803510
|
|
END ROW VECTOR CASE ELSE 08803600
|
|
BEGIN COMMENT MATRIX CASE;% 08803610
|
|
LASTI := C.SF; LASTJ := (*[C[1]]).SF;% 08803700
|
|
IF POLISH(A, DIMENSION) THEN GO ERROR;% 08803800
|
|
IF TYPE = 2 THEN GO CHKSIZE;% 08803900
|
|
IF NOT POLISH(B,DIMENSION) THEN 08804000
|
|
IF LASTI = B.SF THEN 08804100
|
|
IF LASTJ = (*[B[1]]).SF THEN GO CHKSIZE;% 08804200
|
|
GO TO ERROR;% 08804300
|
|
CHKSIZE: COMMENT CHEK DIMENSION BOUNDS;% 08804310
|
|
IF LASTI GTR A.SF OR 08804400
|
|
LASTJ GTR (*[A[1]]).[8:10] THEN %% 08804500
|
|
GO TO DIMERR; %% 08804600
|
|
END MATRIX CASE;% 08804700
|
|
IF TYPE = 2 THEN GO TO SCALEFACTOR; %% 08804800
|
|
NORMAL:: 08804900
|
|
DO BEGIN 08805000
|
|
IF NOT SINGLE THEN 08805100
|
|
BEGIN AROW := *[A[I]]; BROW := *[B[I]]; 08805200
|
|
CROW := *[C[I]]; J := 1; 08805300
|
|
END; 08805400
|
|
IF TYPE=0 THEN 08805500
|
|
:: DO AROW[J] := BROW[J]+P(CROW[J], XCH) 08805600
|
|
UNTIL (J := J+1)=LASTJ 08805700
|
|
ELSE 08805800
|
|
:: DO AROW[J] := CROW[J]-P(BROW[J], XCH) 08805900
|
|
UNTIL (J := J+1)=LASTJ; 08806000
|
|
COMMENT NOTE FANCY WAY OF SAYING A=B-C; 08806100
|
|
END UNTIL (I := I+1)=LASTI; 08806200
|
|
P(XIT); 08806300
|
|
SCALEFACTOR:: 08806400
|
|
DO BEGIN 08806500
|
|
IF NOT SINGLE THEN 08806600
|
|
BEGIN AROW := *[A[I]]; CROW := *[C[I]]; END; %% 08806700
|
|
IF SCALE = 1 THEN %% 08806800
|
|
BEGIN; STREAM(F:=[CROW[1]],N:=LASTJ-1, 08806900
|
|
T:=P(DUP).[36:6],DES := [AROW[1]]); %% 08807000
|
|
BEGIN SI:=F; T(DS:=32 WDS; DS:=32 WDS); %% 08807100
|
|
DS := N WDS; %% 08807200
|
|
END STREAM; %% 08807300
|
|
END ELSE %% 08807400
|
|
BEGIN J := 1; %% 08807500
|
|
:: DO AROW[J] := CROW[J]|P(SCALE, NOP, XCH) %% 08807600
|
|
UNTIL (J := J+1)=LASTJ; %% 08807700
|
|
END; %% 08807800
|
|
END UNTIL (I := I+1)=LASTI; %% 08807900
|
|
END MATRIX DIDDLER; %% 08808000
|
|
%********************************************************* 08900000
|
|
PROCEDURE TRANSPOSE(A,B); %%%% MATRIX TRANSPOSE %%%% 08900010
|
|
VALUE A,B; %%%% INTRINSIC %%%% 08900100
|
|
ARRAY A[*], % MOM DLSC FOR RESULTANT MATRIX OR ROW VECTOR 08900200
|
|
B[*]; % MOM DESC FOR ARGUMENT " " 08900210
|
|
%********************************************************* 08900220
|
|
BEGIN LABEL ERR50,ERR72,NORMAL,PLACE,TRANSPOSEIT;% 08900300
|
|
INTEGER I,J,LASTI,LASTJ;% 08900320
|
|
ARRAY ROW[*];% 08900400
|
|
DEFINE SF=[8:10]#;% 08900405
|
|
COMMENT THERE ARE THREE SPECIES OF MATRIX TRANSPOSITION; 08900420
|
|
% 1. ROW INTO COLUMN 08900430
|
|
% 2. COLUMN INTO ROW 08900440
|
|
% 3. MATRIX INTO MATRIX 08900450
|
|
% IN THIS CASE TRANSPOSITION MAY BE DONE IN PLACE 08900500
|
|
COMMENT TRANPOSITION WILL BE PERFORMED WHEN THE RESULTANT 08900501
|
|
MATRIX DIMENSIONS ARE LARGE ENOUGH TO ACCOMMODATE 08900502
|
|
THE DIMENSIONS OF THE ARGUMENT MATRIX,EVEN THO THE MATRICES 08900503
|
|
MAY NOT BE MATHEMATICALLY CONFORMABLE;% 08900504
|
|
08900505
|
|
BOOLEAN SUBROUTINE DIMENSION; 08900510
|
|
BEGIN COMMENT TRUE IF SINGLY DIMENSIONED;; 08900515
|
|
STREAM(T:=POLISH(XCH, 0, CDC):A:=0); 08900520
|
|
BEGIN SI:=T; DI:=T; SI:=SI-16; SKIP 2 SB; 08900525
|
|
IF SB THEN ELSE TALLY:=1; T:=TALLY; 08900530
|
|
END STREAM; 08900535
|
|
DIMENSION := POLISH; 08900540
|
|
END; 08900545
|
|
%*********** START OF CODE ************* 08900549
|
|
POLISH(A); IF DIMENSION THEN% 08900550
|
|
BEGIN COMMENT 1-DIM RESULTANT,ALLOW 2. ONLY; 08900555
|
|
POLISH(B); IF DIMENSION THEN % ERROR - ROW TO ROW 08900560
|
|
BEGIN ERR50:P((-50),26,COM);% 08900600
|
|
ERR72: P((-72),26,COM);% 08900605
|
|
END ERRORS;% 08900607
|
|
IF (LASTI:=(*[B[1]]).SF) NEQ 2 THEN GO ERR50;% 08900610
|
|
IF (LASTJ:=B.SF) GTR A.SF THEN GO ERR72;% 08900630
|
|
I:=1; ROW:=A;% 08900650
|
|
GO TRANSPOSEIT;% 08900700
|
|
END 1 DIM RESULTANT ELSE 08900710
|
|
BEGIN COMMENT 2-DIM RESULTANT, ALLOW 1. OR 3.; 08900750
|
|
POLISH(B); IF NOT DIMENSION THEN GO NORMAL;% 08900800
|
|
IF (*[A[1]]).SF NEQ 2 THEN GO ERR50;% 08900810
|
|
IF (LASTJ:=B.SF) GTR A.SF THEN GO ERR72;% 08900830
|
|
:: DO POLISH(B[J],*[A[J]],1,CDC,STD) UNTIL (J:=J+1)=LASTJ;% 08900850
|
|
POLISH(XIT);% 08900870
|
|
END 2 DIM RESULTANT;% 08900890
|
|
NORMAL: 08900900
|
|
IF (LASTI:=(*[B[1]]).SF) GTR A.SF 08901000
|
|
OR (LASTJ:=B.SF) GTR(*[A[1]]).SF THEN GO ERR72;% 08901010
|
|
I:=1; IF A.[FF]=B.[FF] THEN GO PLACE; % TRN IN PLACE 08901020
|
|
:: DO BEGIN ROW:=*[A[I]];% 08901100
|
|
TRANSPOSEIT: J:=1;% 08901110
|
|
:: DO P(*[B[J]], I, COC, [ROW[J]], ~) UNTIL (J ~ J+1)=LASTJ; 08901200
|
|
END UNTIL (I ~ I+1)=LASTI; 08901300
|
|
POLISH(XIT); 08901400
|
|
PLACE:: IF LASTI=2 THEN POLISH(XIT); 08901500
|
|
:: DO BEGIN ROW ~ *[A[I]]; J ~ I+1; 08901600
|
|
:: DO P(ROW[J], *[A[J]], I, CDC, DUP, LOD, [ROW[J]], ~, ~) 08901700
|
|
UNTIL (J ~ J+1)=LASTJ; 08901800
|
|
END UNTIL (I ~ I+1)=LASTI-1; 08901900
|
|
END TRANSPOSE ROUTINE; 08902000
|
|
%***********************************************************************09000000
|
|
PROCEDURE MATRIXMULTIPLY(A,B,C); %%% MATRIX MULTIPLICATION %%% 09000100
|
|
VALUE A,B,C; %%% INTRINSIC %%% 09000200
|
|
ARRAY A[*], % RESULTANT MAT OR ROW VECTOR MOM 09000300
|
|
B[*], % ARG-1 " 09000400
|
|
C[*]; % ARG-2 " 09000500
|
|
%***********************************************************************09000600
|
|
BEGIN 09000700
|
|
LABEL ERR50,ERR72,DOTPRODUCT,CROSSPRODUCT;% 09000800
|
|
ARRAY AROW[*], % 09000900
|
|
BROW[*], % 09001000
|
|
CROW[*];% 09001100
|
|
INTEGER I,J,K,LASTI,LASTJ,LASTK;% 09001200
|
|
DEFINE SF = [8:10]#, X = BROW#;% 09001300
|
|
DEFINE SETTOSAVEBIT(SETTOSAVEBIT1)=SI:=SETTOSAVEBIT1; 09001400
|
|
SI:=SI-16; SKIP 2 SB; IF SB THEN DS:=SET ELSE DS:=RESET#; 09001500
|
|
LABEL RRM,MRM,MMR,MMM; % 09001600
|
|
SWITCH SWL :=ERR50,RRM,ERR72,ERR72,ERR50, 09001700
|
|
MRM,MMR,MMM;% 09001800
|
|
REAL SUBROUTINE DIMENSIONS; 09001900
|
|
BEGIN COMMENT SETS BIT IN SWVAL TO INDICATE MAT;% 09002000
|
|
STREAM(SWVAL:=0:A1:=[A[0]],B1:=[B[0]],C1:=[C[0]]);% 09002100
|
|
BEGIN DI:=LOC SWVAL; SKIP 45 DB;% 09002200
|
|
SETTOSAVEBIT(A1); SETTOSAVEBIT(B1); SETTOSAVEBIT(C1); 09002300
|
|
END STREAM;% 09002400
|
|
DIMENSIONS:=POLISH;% 09002500
|
|
END DIMENSIONS;% 09002600
|
|
BOOLEAN SUBROUTINE DIMERR;% 09002610
|
|
DIMERR:=(LASTI GTR A.SF) OR (LASTJ GTR AROW.SF);% 09002620
|
|
COMMENT ********** START OF CODE *************; 09002700
|
|
LASTI:=B.SF; LASTJ:=(CROW:=*[C[1]]).SF; % 09002710
|
|
LASTK:=C.SF; AROW:=*[A[I:=1]]; BROW:=*[B[1]];% 09002800
|
|
GO TO SWL[DIMENSIONS];% 09002900
|
|
MMM: COMMENT A(A1,A2)=B(B1,B2)*C(C1,C2);% 09003000
|
|
IF LASTK NEQ BROW.SF THEN 09003100
|
|
ERR50: COMMENT NON-CONFORMAL ARGUMENT MATRICES;% 09003200
|
|
POLISH((-50),26,COM);% 09003300
|
|
IF DIMERR THEN 09003400
|
|
ERR72: COMMENT RESULTANT BOUNDS TOO SMALL - DIM ERR;% 09003600
|
|
POLISH((-72),26,COM);% 09003700
|
|
IF LASTK=2 THEN GO CROSSPRODUCT ELSE GO DOTPRODUCT;% 09003800
|
|
:: DO BEGIN 09004000
|
|
BROW:=*[B[I]]; AROW:=*[A[I]];% 09004100
|
|
DOTPRODUCT: J:=1;% 09004200
|
|
:: DO BEGIN 09004300
|
|
K:=1; POLISH(0);% 09004400
|
|
:: DO P(*[C[K]],J,COC,BROW[K],MUL,ADD) 09004500
|
|
UNTIL (K:=K+1)=LASTK;% 09004600
|
|
POLISH( [AROW[J]], STD);% 09004700
|
|
END UNTIL (J:=J+1)=LASTJ;% 09004800
|
|
END UNTIL (I:=I+1)=LASTI;% 09004900
|
|
POLISH(XIT);% 09005000
|
|
RRM: COMMENT A(A1)=B(B1)*C(C1,C2);% 09005100
|
|
AROW:=A; % 09005200
|
|
MRM: COMMENT A(A1,A2)=B(B1)*C(C1,C2);% 09005400
|
|
IF LASTK NEQ (BROW:=B).SF THEN GO ERR50; % 09005700
|
|
LASTI:=2; IF DIMERR THEN GO TO ERR72;% 09005800
|
|
GO TO DOTPRODUCT;% 09005900
|
|
MMR: COMMENT A(A1,A2)=B(B1,1)*C(C1);% 09006100
|
|
IF BROW.SF NEQ 2 THEN GO TO ERR50;% 09006200
|
|
LASTJ:=LASTK; IF DIMERR THEN GO TO ERR72;% 09006300
|
|
CROW:=C;% 09006600
|
|
CROSSPRODUCT:: 09006700
|
|
DO BEGIN 09006800
|
|
AROW:=*[A[I]]; J:=1; % 09006900
|
|
X:=POLISH(*[B[I]],1,COC);% 09007000
|
|
:: DO P(X,CROW[J],MUL,[AROW[J]],STD) 09007100
|
|
UNTIL(J:=J+1)=LASTJ;% 09007200
|
|
END UNTIL(I:=I+1)=LASTI;% 09007300
|
|
END MATRIXMULTIPLY;% 09007400
|
|
PROCEDURE INVERT(A, B); 09100000
|
|
VALUE A, B; 09100100
|
|
ARRAY A[*], B[*]; 09100200
|
|
BEGIN REAL BIG, 09100300
|
|
DIAG = BIG; 09100400
|
|
DEFINE EPS = COMMENT 10@-13; 0.0000000000001#; 09100500
|
|
INTEGER I, 09100600
|
|
II, 09100700
|
|
J, 09100800
|
|
K, 09100900
|
|
K2, 09101000
|
|
L, 09101100
|
|
N, 09101200
|
|
N1; 09101300
|
|
REAL BLOCKCOUNTER = 16, 09101400
|
|
BLOCKROUTINE = 5; 09101500
|
|
ARRAY AROW[*], 09101600
|
|
COPY[*], 09101700
|
|
PLACEHOLDER[*]; 09101800
|
|
DEFINE MOVEWORDS = N1(DS~32 WDS; DS~32WDS); DS~N WDS#; 09101900
|
|
SUBROUTINE SWAPROWS; 09102000
|
|
BEGIN;STREAM(A~*[A[I]],B~*[A[K2]],N~N+1,N1~P(DUP).[36:6],COPY); 09102100
|
|
BEGIN SI~A; MOVEWORDS; 09102200
|
|
SI~B; DI~A; MOVEWORDS; 09102300
|
|
SI~COPY; DI~B; MOVEWORDS; 09102400
|
|
END END SWAPROWS; 09102500
|
|
;STREAM(T:=[A[0]]:T1:=[B[0]]); 09102505
|
|
BEGIN SI:=T; DI:=T; SI:=SI-16; SKIP 2 SB; 09102510
|
|
IF SB THEN 09102515
|
|
BEGIN SI:=T1; DI:=T1; SI:=SI-16; SKIP 2 SB; 09102520
|
|
IF SB THEN ELSE TALLY:=1; 09102525
|
|
END ELSE TALLY:=1; 09102530
|
|
T:=TALLY; 09102535
|
|
END STREAM; 09102540
|
|
IF POLISH THEN POLISH((-50), 26, COM); 09102545
|
|
IF (N ~ A.[8:10])!(*[A[1]]).[8:10] THEN P((-54), 26, COM); 09102600
|
|
N1 ~ (N ~ N-1)-1; 09102700
|
|
IF A.[FF]!B.[FF] THEN 09102800
|
|
BEGIN IF B.[8:10]!N+1 OR (*[B[1]]).[8:10]!N+1 09102900
|
|
THEN POLISH((-50), 26, COM); 09103000
|
|
IF N1=0 THEN P(*[B[1]], 1, COC, *[A[1]], 1, CDC, ~) ELSE 09103100
|
|
FOR I~1 STEP 1 UNTIL N DO 09103200
|
|
STREAM(N, N1~P(DUP).[36:6], S~*[B[I]], D~*[A[I]]); 09103300
|
|
BEGIN SI~S; SI~SI+8; DI~D; DI~DI+8; MOVEWORDS; END; 09103400
|
|
END; 09103500
|
|
IF N=0 THEN 09103600
|
|
POLISH(*[A[1]], 1, CDC, DUP, LOD, 1, XCH, /, XCH, ~, XIT); 09103700
|
|
BLOCKCOUNTER ~ BLOCKCOUNTER+1; 09103800
|
|
POLISH(MKS, [PLACEHOLDER[P]], N+1, 1, 1, 0, BLOCKROUTINE); 09103900
|
|
BLOCKCOUNTER ~ BLOCKCOUNTER+1; 09104000
|
|
POLISH(MKS, [COPY[P]], N+1,1,1,1,BLOCKROUTINE); 09104100
|
|
COMMENT REDUCE THE MATRIX BY ROW PIVOTS TO TRI-DIAGONAL FORM; 09104200
|
|
FOR I~1 STEP 1 UNTIL N DO 09104300
|
|
BEGIN II ~ (K2 ~ I)-1; BIG ~ 0; 09104400
|
|
FOR J~I STEP 1 UNTIL N DO 09104500
|
|
BEGIN AROW ~ *[A[J]]; POLISH(0); 09104600
|
|
FOR K~1 STEP 1 UNTIL II DO 09104700
|
|
POLISH(*[A[K]], I, COC, AROW[K], |, -); 09104800
|
|
POLISH(AROW[I], +); 09104900
|
|
IF POLISH([AROW[I]], SND, SSP, DUP)>BIG THEN 09105000
|
|
POLISH(.BIG, ~, J, .K2, ~) ELSE P(DEL); 09105100
|
|
END; 09105200
|
|
IF BIG{EPS THEN POLISH((-57), 26, COM);% NEARLY SINGULAR 09105300
|
|
IF (PLACEHOLDER[I] ~ K2)!I THEN SWAPROWS; 09105400
|
|
DIAG ~ POLISH((AROW ~ *[A[I]]), I, COC); 09105500
|
|
FOR J~I+1 STEP 1 UNTIL N DO 09105600
|
|
BEGIN POLISH(0); 09105700
|
|
FOR K~1 STEP 1 UNTIL II DO 09105800
|
|
POLISH(*[A[K]], J, COC, AROW[K], |, -); 09105900
|
|
POLISH(AROW[J], +, DIAG, /, [AROW[J]], ~); 09106000
|
|
END END; 09106100
|
|
POLISH(10, COM); COMMENT RETURN COPY ARRAY; 09106200
|
|
COMMENT INVERT LOWER TRIANGULAR MATRIX; 09106300
|
|
FOR I~1 STEP 1 UNTIL N DO 09106400
|
|
BEGIN II ~ I-1; DIAG ~ POLISH((AROW ~ *[A[I]]), I, COC); 09106500
|
|
FOR J~1 STEP 1 UNTIL II DO 09106600
|
|
BEGIN POLISH(0); 09106700
|
|
FOR K~J STEP 1 UNTIL II DO 09106800
|
|
POLISH(*[A[K]], J, COC, AROW[K], |, -); 09106900
|
|
POLISH(DIAG, /, [AROW[J]], ~); 09107000
|
|
END; 09107100
|
|
AROW[I] ~ 1.0/DIAG; 09107200
|
|
END; 09107300
|
|
COMMENT INVERT UPPER TRIANGULAR MATRIX; 09107400
|
|
FOR I~N1 STEP -1 UNTIL 1 DO 09107500
|
|
BEGIN II ~ I+1; AROW ~ *[A[I]]; 09107600
|
|
FOR J~N STEP -1 UNTIL II DO 09107700
|
|
BEGIN L ~ J-1; POLISH(0); 09107800
|
|
FOR K~II STEP 1 UNTIL L DO 09107900
|
|
POLISH(*[A[K]], J, COC, AROW[K], |, -); 09108000
|
|
POLISH(AROW[J], CHS, +, [AROW[J]], ~); 09108100
|
|
END END; 09108200
|
|
COMMENT MULTIPLY UPPER AND LOWER HALVES TO PRODUCE INVERSE; 09108300
|
|
FOR I~1 STEP 1 UNTIL N1 DO 09108400
|
|
BEGIN AROW ~ *[A[I]]; 09108500
|
|
FOR J~1 STEP 1 UNTIL N DO 09108600
|
|
BEGIN IF (K2 ~ J){I THEN K2 ~ I+1; POLISH(0); 09108700
|
|
FOR K~K2 STEP 1 UNTIL N DO 09108800
|
|
POLISH(*[A[K]], J, COC, AROW[K], |, +); 09108900
|
|
IF I}J THEN POLISH(AROW[J], +); 09109000
|
|
POLISH([AROW[J]], ~); 09109100
|
|
END END; 09109200
|
|
COMMENT EXCHANGE COLUMN ELEMENTS TO ABSOLVE ROW PIVOTING; 09109300
|
|
FOR J~N STEP -1 UNTIL 1 DO 09109400
|
|
IF (I ~ PLACEHOLDER[J])!J THEN 09109500
|
|
FOR K~1 STEP 1 UNTIL N DO 09109600
|
|
BEGIN AROW ~ *[A[K]]; 09109700
|
|
POLISH(AROW[I], [AROW[J]], DUP, LOD, [AROW[I]], ~, ~); 09109800
|
|
END; 09109900
|
|
POLISH(10, COM); COMMENT RETURN PLACEHOLDER ARRAY; 09110000
|
|
END INVERT; 09110100
|
|
PROCEDURE FORTRANFREEREAD; 09200000
|
|
BEGIN REAL PARL = -1, % PARITY LABEL WORD 09200100
|
|
EOFL = -2, % END-OF-FILE "LABEL WORD" 09200200
|
|
LISX = -3, % ACCIDENTAL ENTRY FOR LIST 09200300
|
|
DKADR = -4; % DISK ADDRESS 09200400
|
|
NAME FILX = -5; % FILE TANK DESCRIPTOR 09200500
|
|
REAL BLOCK = 5, % INTRINSIC INTRINSIC DESCRIPTOR 09200600
|
|
ALGOLREAD = 13, % NORMAL-STATE I/O INTRINSIC 09200700
|
|
SELECT = 14, % FILE STATUS INTRINSIC 09200800
|
|
JUNK = 17, % ANOTHER TEMPORARY 09200900
|
|
ARRAYSTUFF = 18, % USED BY LIST FOR ARRAYS 09201000
|
|
LSTRN = 19, % INTERNAL LIST POINTER 09201100
|
|
LISTYPE = 20, % TELLS TYPE OF LIST ITEM 09201200
|
|
HOLTOG = 21; % FOR CHARACTER TRANSLATION 09201300
|
|
ARRAY POT = 22[*]; % POWERS-OF-TEN TABLE 09201400
|
|
REAL FORTERR = 24; % FORTRAN ERROR MESSAGE ROUTINE 09201450
|
|
ARRAY ARRY[*], % GLOBAL TEMPORARY ARRAY 09201600
|
|
FIB[*]; % FILE INFORMATION BLOCK 09201700
|
|
09201800
|
|
BOOLEAN ARRAYTOG, % LIST ELEMENT WAS ARRAY NAME 09201900
|
|
COMPLEXTOG, % FIRST HALF OF COMPLEX NUMBER 09202000
|
|
DBLTOG, % LIST ELEMENT DOUBLE TYPE 09202100
|
|
DONE, % FLAG FOR LIST EXHAUSTED 09202200
|
|
ESIGN, % EXPONENT NEGATIVE FLAG 09202300
|
|
GOTDIGIT, % TELLS IF CHARACTER SEEN 09202400
|
|
SEQ, % TRUE IFF FILE HAS SEQ NUMBERS. 09202450
|
|
READREC, % TRUE IFF SCANNER MAY READ A RECORD 09202460
|
|
SIGN, % MANTISSA NEGATIVE FLAG 09202500
|
|
STRINGTOG, % CONTROLS SCANNER ACTION 09202600
|
|
TWODIMTOG; % ON IF ARRAY IS TWO-DIMENSIONAL 09202700
|
|
09202800
|
|
INTEGER BSIZE, % NUMBER OF CHARACTERS LEFT IN BUFFER09202900
|
|
BUFF, % CURRENT BUFFER POSITION 09203000
|
|
CHAR, % CONTAINS LAST CHARACTER SCANNED 09203100
|
|
COUNTER, % NUMBER CHARACTERS IN STRING 09203200
|
|
DECADES, % NUMBER OF DECIMAL PLACES 09203300
|
|
E, % CONTAINS EXPONENT 09203400
|
|
INDEX, % INDEX INTO ARRAY IF ARRAYTOG 09203500
|
|
SIZE, % ARRAY SIZE IF ARRAYTOG 09203600
|
|
TYPE; % TYPE OF LAST LIST ELEMENT 09203700
|
|
NAME ADDRESS, % HOLDS ADDRESS TO STORE NEXT DATUM 09203900
|
|
LISTADR = ARRY; % HOLDS RESULT OF [LISX] 09204000
|
|
09204100
|
|
REAL NUMBER, % TEMPORARY NUMBER HOLDER 09204200
|
|
NUMBERL, NUMBERH ; % DBLPREC NUMBER BUILT BY FREEREAD 09204205
|
|
09204300
|
|
LABEL LISTSTART, 09204400
|
|
LISTEXIT, 09204500
|
|
LOOK, 09204600
|
|
NUMERICAL, 09204700
|
|
PASTPOINT, 09204800
|
|
BYE, 09204850
|
|
SCNR, 09204860
|
|
AT, 09204900
|
|
DECIMAL, 09205000
|
|
ERROR, 09205100
|
|
STRING, 09205200
|
|
STRUNG, 09205300
|
|
GETCOMMA, 09205400
|
|
LOGICAL, 09205500
|
|
EXIT; 09205600
|
|
09205700
|
|
SWITCH SWISH := EXIT, NUMERICAL, STRING, NUMERICAL, 09205800
|
|
LOGICAL, NUMERICAL, NUMERICAL; 09205900
|
|
09206000
|
|
DEFINE INTEGERV = 1#, 09206100
|
|
STRINGV = 2#, 09206200
|
|
REALV = 3#, 09206300
|
|
LOGICALV = 4#, 09206400
|
|
DOUBLEV = 5#, 09206500
|
|
COMPLEXV = 6#; 09206600
|
|
09206700
|
|
DEFINE KIND = (FIB[4].[8:4])#, 09206800
|
|
DATATYPE = (LISTYPE.[44:4])#, 09206900
|
|
TWOD = (LISTYPE.[38:1])#, 09207000
|
|
SIZEF = [33:15]#, 09207100
|
|
BASEF = [18:15]#, 09207200
|
|
IOD = (*FILX)#; 09207300
|
|
09207400
|
|
SUBROUTINE CHECKPRESENCE; 09207500
|
|
BEGIN COMMENT GETS NEXT BUFFER FROM ALGOLREAD; 09207600
|
|
BSIZE~(P(MKS,DKADR,1,FILX,ALGOLREAD)-SEQ)|8 ; 09207700
|
|
BUFF := IOD.[33:15]; 09207800
|
|
END CHECKPRESENCE; 09207900
|
|
09208000
|
|
SUBROUTINE READIT; 09208100
|
|
BEGIN COMMENT ORDER NEXT RECORD READ FROM MEDIUM; 09208200
|
|
P(MKS, DKADR, 0, FILX, ALGOLREAD); 09208300
|
|
IF DONE THEN P(XIT); 09208400
|
|
IF IOD.[27:1] THEN P(XIT); 09208700
|
|
CHECKPRESENCE; 09208800
|
|
END READIT; 09208900
|
|
09209000
|
|
REAL SUBROUTINE NEXT; 09209100
|
|
BEGIN COMMENT GET DESCRIPTOR POINTING INTO AN ARRAY; 09209200
|
|
IF TWODIMTOG THEN 09209300
|
|
P(*[ARRY[INDEX.[33:7]]], INDEX.[40:8], CDC) 09209400
|
|
ELSE P([ARRY[INDEX]]); 09209500
|
|
NEXT := POLISH; 09209600
|
|
END NEXT ITEM INSIDE AN ARRAY; 09209700
|
|
09209800
|
|
SUBROUTINE LISTELEMENT; 09209900
|
|
BEGIN COMMENT GETS ADDRESS TO STORE NEXT DATUM, AND 09210000
|
|
DIDDLES CERTAIN TOGGLES AS REQUIRED; 09210100
|
|
LISTSTART: 09210200
|
|
IF ARRAYTOG THEN 09210300
|
|
BEGIN ADDRESS := NEXT; 09210400
|
|
IF (INDEX := INDEX+DBLTOG+1)}SIZE THEN 09210500
|
|
ARRAYSTUFF~ARRAYTOG~COMPLEXTOG~0 ; 09210600
|
|
GO TO LISTEXIT; 09210700
|
|
END; 09210800
|
|
IF COMPLEXTOG THEN 09210900
|
|
BEGIN ADDRESS := [LISTADR[1]]; COMPLEXTOG := 0; 09211000
|
|
GO TO LISTEXIT; 09211100
|
|
END; 09211200
|
|
P(0); LISTADR := [LISX]; 09211300
|
|
COMPLEXTOG~(TYPE~DATATYPE)=COMPLEXV; DBLTOG~TYPE=DOUBLEV ; 09211310
|
|
IF ARRAYSTUFF!0 THEN 09211400
|
|
BEGIN 09211500
|
|
ARRAYTOG~1; P(LISTADR~MEM[LISTADR.[18:15]]) ; 09211600
|
|
SIZE~(INDEX~ARRAYSTUFF.BASEF)+ARRAYSTUFF.SIZEF ; 09211700
|
|
TWODIMTOG~NOT P(LOD,TOP); P(DEL) ; 09211800
|
|
GO TO LISTSTART; 09211900
|
|
END; 09212000
|
|
ADDRESS ~ [LISTADR[0]]; P(DEL); 09212100
|
|
LISTEXIT: 09212150
|
|
09212300
|
|
END GET NEXT LIST ELEMENT; 09212400
|
|
09212500
|
|
SUBROUTINE SCANNER ; 09212600
|
|
BEGIN COMMENT GENERAL PURPOSE SCANNER -- CHARACTER AT A TIME. 09212700
|
|
PURLOINED FROM BASICINPUT ROUTINE BY WWF4; 09212800
|
|
LOOK: IF BSIZE=0 THEN READIT; 09212900
|
|
STREAM(I:=-1, BUFF, 09213000
|
|
N:=IF BSIZE<63 THEN BSIZE ELSE 63: STRINGTOG); 09213100
|
|
BEGIN SI:=BUFF; CI:=CI+STRINGTOG; GO TO DEBLANK; 09213200
|
|
COMMENT BLANKS SIGNIFICANT WITHIN STRINGS; 09213300
|
|
GNC: TALLY:=TALLY+1; DI:=LOC I; DS:=LIT "0"; 09213400
|
|
DI:=DI+6; DS:=CHR; GO TO EXIT; 09213500
|
|
DEBLANK: N(IF SC!" " THEN JUMP OUT TO GNC; 09213600
|
|
TALLY:=TALLY+1; SI:=SI+1); 09213700
|
|
EXIT: N:=TALLY; BUFF:=SI; 09213800
|
|
END STREAM; 09213900
|
|
BSIZE := BSIZE-P(XCH); % UPDATE CHARACTER COUNT 09214000
|
|
BUFF := POLISH; % UPDATE BUFFER POINTER 09214100
|
|
IF (CHAR~POLISH)<0 THEN 09214200
|
|
IF BSIZE=0 THEN 09214250
|
|
BEGIN 09214275
|
|
IF GOTDIGIT THEN CHAR~"," 09214300
|
|
ELSE IF READREC THEN GO LOOK 09214350
|
|
END 09214355
|
|
ELSE GO LOOK ; 09214360
|
|
END SCANNER; 09214400
|
|
09214405
|
|
SUBROUTINE LOGICALCOMPARE ; 09214410
|
|
BEGIN COMMENT COMPARES LOGICAL TO .TRUE.,.TRU.,.TR.,.T., OR 09214415
|
|
.FALSE.,.FALS.,.FAL.,.FA.,.F. ; 09214416
|
|
STREAM(C~P(XCH):C2~COUNTER-1,C1~8-COUNTER,E,NUMBER) ; 09214425
|
|
BEGIN 09214430
|
|
SI~LOC NUMBER; SI~SI+C1; DI~LOC C; DI~DI+E ; 09214435
|
|
IF C2 SC=DC THEN IF SC="." THEN TALLY~1; C~TALLY ; 09214440
|
|
END ; 09214445
|
|
E~P ; 09214450
|
|
END OF LOGICALCOMPARE ; 09214455
|
|
09214460
|
|
SUBROUTINE SCAN ; 09214465
|
|
SCNR: BEGIN SCANNER ; 09214470
|
|
IF CHAR="/" THEN 09214475
|
|
BEGIN READREC~0 ; 09214480
|
|
WHILE CHAR!"=" AND BSIZE>0 DO SCANNER; READREC~1 ; 09214485
|
|
IF BSIZE=0 AND GOTDIGIT THEN CHAR~"," ELSE GO SCNR ; 09214487
|
|
END ; 09214490
|
|
END OF SCAN ; 09214495
|
|
09214500
|
|
SUBROUTINE BUILDNUMBER ; 09214505
|
|
BEGIN COMMENT BUILDS DBLPREC NUMBER NUMBERL,NUMBERH ; 09214510
|
|
P(NUMBERL,NUMBERH) ; 09214515
|
|
WHILE CHAR<10 DO 09214520
|
|
BEGIN 09214525
|
|
COUNTER~NUMBER~0 ; 09214530
|
|
DO BEGIN COUNTER~COUNTER+1; NUMBER~NUMBER|10+CHAR;SCAN END09214540
|
|
UNTIL CHAR>9 OR COUNTER=11 ; 09214545
|
|
DECADES~DECADES+COUNTER ; 09214546
|
|
IF DBLTOG THEN P(0,POT[COUNTER],DLM,0,NUMBER,DLA) 09214547
|
|
ELSE P(POT[COUNTER],|,NUMBER,+) ; 09214550
|
|
END ; 09214555
|
|
NUMBERL~P(.NUMBERH,~) ; 09214560
|
|
END OF BUILDNUMBER ; 09214565
|
|
09214570
|
|
REAL SUBROUTINE ALFA ; 09214575
|
|
BEGIN 09214577
|
|
STREAM(CHAR:Q~0) ; 09214579
|
|
BEGIN 09214581
|
|
SI~LOC CHAR; SI~SI+7; IF SC=ALPHA THEN TALLY~1; CHAR~TALLY09214583
|
|
END ; 09214585
|
|
ALFA~P ; 09214587
|
|
END OF ALFA ; 09214589
|
|
09214591
|
|
SUBROUTINE FREEREAD; 09214600
|
|
BEGIN COMMENT READS AND STORES NEXT DATUM, DOING APPROPRIATE 09214700
|
|
CONVERSIONS. TYPE OF SCAN IS DEPENDENT ON TYPE OF 09214800
|
|
LIST ITEM. OPERATES INDIFFERENTLY ON A VARIETY OF 09214900
|
|
NUMERICAL FORMATS; 09215000
|
|
GOTDIGIT := STRINGTOG := FALSE; 09215100
|
|
COUNTER~E~ESIGN~NUMBERL~NUMBERH~NUMBER~DECADES~0 ; 09215200
|
|
SCAN; IF CHAR="," THEN GO TO EXIT; 09215300
|
|
IF CHAR>9 THEN 09215310
|
|
IF ALFA THEN 09215315
|
|
BEGIN 09215320
|
|
DO SCAN UNTIL NOT ALFA ; 09215325
|
|
IF CHAR="(" THEN 09215330
|
|
BEGIN 09215335
|
|
DO BEGIN DO SCAN UNTIL CHAR>9 END UNTIL CHAR!58;09215340
|
|
IF CHAR!")" THEN GO ERROR; SCAN ; 09215345
|
|
END ; 09215350
|
|
IF CHAR="-" THEN 09215355
|
|
BEGIN 09215360
|
|
SCAN; IF NOT(CHAR="R" OR CHAR="I")THEN GO ERROR;09215365
|
|
SCAN ; 09215370
|
|
END ; 09215375
|
|
IF CHAR!"=" THEN GO ERROR; SCAN ; 09215380
|
|
END ; 09215385
|
|
BYE: IF (DONE~CHAR="*") THEN READIT ; 09215400
|
|
IF CHAR = """ THEN GO TO STRING; 09215405
|
|
IF CHAR="|" THEN GO GETCOMMA ; 09215410
|
|
GOTDIGIT := TRUE; 09215500
|
|
GO TO SWISH[TYPE]; 09215600
|
|
NUMERICAL:: 09215700
|
|
IF (SIGN := CHAR="-") OR CHAR="+" OR CHAR="&" THEN SCAN; 09215800
|
|
IF CHAR>9 THEN GO TO DECIMAL; 09215900
|
|
BUILDNUMBER ; 09216000
|
|
DECADES~0 ; 09216100
|
|
IF CHAR="." THEN 09216200
|
|
BEGIN SCAN; 09216300
|
|
PASTPOINT:: 09216400
|
|
BUILDNUMBER ; 09216500
|
|
END ; 09216800
|
|
IF CHAR="@" OR CHAR="E" OR CHAR="D" THEN 09216900
|
|
AT:: BEGIN SCAN; 09217000
|
|
IF (ESIGN := CHAR="-") OR CHAR="+" OR CHAR="&" THEN SCAN; 09217100
|
|
IF (E := CHAR)>9 THEN GO TO ERROR; SCAN; 09217200
|
|
WHILE CHAR{9 DO 09217300
|
|
BEGIN E := 10|E+CHAR; SCAN; END; 09217400
|
|
IF ESIGN THEN E := -E; 09217500
|
|
END; 09217600
|
|
09217700
|
|
IF ABS(NUMBER~E-DECADES)>69 THEN GO ERROR ; 09217800
|
|
P(NUMBERL,NUMBERH) ; 09217900
|
|
IF NUMBER!0 THEN 09218000
|
|
IF DBLTOG THEN P(POT[69+ABS(NUMBER)],POT[ABS(NUMBER)], 09218025
|
|
IF NUMBER<0 THEN P(DLD) ELSE P(DLM)) 09218050
|
|
ELSE P(POT[ABS(NUMBER)],IF NUMBER<0 THEN P(/) ELSE P(|)) ;09218100
|
|
IF SIGN THEN P(CHS) ; 09218400
|
|
IF DBLTOG THEN P([ADDRESS],STD,[ADDRESS[1]],STD) 09218500
|
|
ELSE BEGIN 09218600
|
|
P(XCH,DEL,[ADDRESS]) ; 09218615
|
|
IF TYPE=INTEGERV THEN 09218620
|
|
BEGIN 09218625
|
|
IF P(DUP)>@7777777777777 THEN GO ERROR ; 09218630
|
|
P(ISD) ; 09218635
|
|
END 09218640
|
|
ELSE P(STD) ; 09218645
|
|
END ; 09218650
|
|
GO TO GETCOMMA; 09218700
|
|
DECIMAL:: 09218800
|
|
IF CHAR="." THEN 09218900
|
|
BEGIN SCAN; 09219000
|
|
IF CHAR{9 THEN GO TO PASTPOINT ELSE GO TO ERROR; 09219100
|
|
END; 09219200
|
|
NUMBERH~1 ; 09219300
|
|
IF CHAR="@" OR CHAR="E" OR CHAR="D" THEN GO TO AT; 09219400
|
|
ERROR:: 09219500
|
|
IF PARL!0 THEN 09219600
|
|
P(PARL, MKS, 9, BLOCK); 09219700
|
|
P(MKS, FIB[6], FILX.[33:15], 2, FORTERR); 09219800
|
|
STRING:: 09219900
|
|
IF CHAR!""" THEN GO TO ERROR; 09220000
|
|
COUNTER := 0; STRINGTOG := 1; NUMBER := " "; 09220100
|
|
DO BEGIN SCANNER ; 09220200
|
|
STRUNG:: 09220300
|
|
IF CHAR!""" THEN 09220400
|
|
BEGIN COUNTER:=COUNTER+1; 09220500
|
|
STREAM(CHAR,N:=COUNTER,T:=[NUMBER]); 09220600
|
|
BEGIN SI:=LOC N; SI:=SI-1; 09220700
|
|
DI:=DI+1; DI:=DI+N; DS:=CHR; 09220800
|
|
END STREAM; 09220900
|
|
END; 09221000
|
|
END UNTIL (COUNTER=6) OR CHAR="""; 09221100
|
|
IF COUNTER=0 THEN GO TO ERROR; 09221200
|
|
P(NUMBER, [ADDRESS], STD); 09221300
|
|
IF CHAR!""" THEN 09221400
|
|
BEGIN SCANNER; IF CHAR=""" THEN GO GETCOMMA ; 09221500
|
|
IF LSTRN=(-1) THEN GO TO ERROR; 09221600
|
|
LISTELEMENT; 09221700
|
|
IF LSTRN=(-1) THEN GO ERROR ; 09221750
|
|
NUMBER := " "; COUNTER := 0; GO TO STRUNG; 09221800
|
|
END; 09221900
|
|
GETCOMMA:: 09222000
|
|
WHILE CHAR!"," AND CHAR!"*" DO SCAN; IF CHAR="*" THEN GO BYE ;09222100
|
|
GO TO EXIT; 09222200
|
|
LOGICAL:: 09222300
|
|
IF CHAR="." THEN 09222400
|
|
BEGIN COMMENT SHOULD BE ".TRUE.", ".FALSE.", OR ABBREVIAIIONS; 09222500
|
|
NUMBER := COUNTER := E := 0; 09222600
|
|
DO BEGIN 09222700
|
|
SCAN; NUMBER := CHAR & NUMBER[12:18:30]; 09222800
|
|
END UNTIL (COUNTER := COUNTER+1)=6 OR 09222900
|
|
CHAR="," OR CHAR="."; 09223000
|
|
IF NOT (E~COUNTER=2 AND NUMBER="T,") THEN 09223100
|
|
BEGIN E~4; P("TRUE"); LOGICALCOMPARE ; 09223110
|
|
IF NOT E THEN 09223115
|
|
BEGIN 09223120
|
|
IF COUNTER!2 OR NUMBER!"F," THEN 09223125
|
|
BEGIN E~3; P("FALSE"); LOGICALCOMPARE ; 09223130
|
|
IF NOT E THEN GO ERROR ; 09223135
|
|
END ; 09223140
|
|
E~0 ; 09223145
|
|
END ; 09223200
|
|
END ; 09223300
|
|
END ELSE IF (E~CHAR="T") OR CHAR="F" THEN 09223400
|
|
BEGIN SCAN ; 09223405
|
|
IF NOT (CHAR="." OR CHAR=",") THEN GO ERROR ; 09223410
|
|
END 09223420
|
|
ELSE IF NOT ((E~CHAR=1) OR CHAR=0) THEN GO ERROR ; 09223425
|
|
P(E, [ADDRESS], STD); GO TO GETCOMMA; 09223500
|
|
EXIT:: 09223600
|
|
END FREEREAD; 09223700
|
|
09223800
|
|
COMMENT ***** ***** START OF CODE ***** ***** *****; 09223900
|
|
FILX[NOT 3]~PARL; FILX[NOT 4]~EOFL; 09224000
|
|
FIB := FILX[NOT 2]; 09224100
|
|
IF FIB[5].[43:2]!2 THEN 09224200
|
|
POLISH(MKS, 0, 2, FILX, 1, SELECT); 09224300
|
|
CHECKPRESENCE; ARRAYSTUFF := 0; 09224400
|
|
IF FIB[0]=0 THEN FIB[0] := 1; 09224500
|
|
IF FIB[0]!1 AND KIND=2 THEN 09224600
|
|
POLISH(MKS, FIB[6], FILX.[33:15], 4, FORTERR); 09224700
|
|
IF P(*[FIB[14]],TOP) THEN P(DEL) 09224710
|
|
ELSE BSIZE~-(SEQ~(SEQ~(*(4 INX P(XCH))).[36:6])!0 AND SEQ!8 09224720
|
|
AND SEQ!9)|8 09224730
|
|
+BSIZE ; 09224740
|
|
LSTRN~READREC~1 ; 09224800
|
|
DO BEGIN IF DONE~LSTRN=(-1) THEN READIT; LISTELEMENT ; 09224900
|
|
IF (DONE := (LSTRN=(-1))) THEN READIT; 09225000
|
|
FREEREAD; 09225050
|
|
END UNTIL FALSE; 09225100
|
|
END FORTRAN FREE FIELD READ; 09225300
|
|
PROCEDURE COBOLDECIMALTOOCTALCONVERT(A) ; %% INTRINSIC # @151 09300000
|
|
VALUE A; NAME A ; 09300100
|
|
% THIS PROCEDURE CONVERTS A STRING OF N BCD DIGITS, STARTING AT WORD09300200
|
|
% ADDRESS A, CHARACTER OFFSET S, INTO A DOUBLE-LENGTH VALUE. THE LOW09300300
|
|
% PART OF THIS IS STORED IN S, THE HIGH PART IN N. IF N.[1:1]=1,THEN09300400
|
|
% THE SIGN OF THE VALUE IS OBTAINED FROM THE ZONE BITS OF THE 1-SY 09300500
|
|
% CHARACTER (BCD DIGIT), OTHERWISE FROM THE LAST. 0{S{7, 0{ABS(N){2309300600
|
|
BEGIN 09300700
|
|
REAL N=A-2, S=N-1, Q=9, C ; 09300800
|
|
REAL HOLD1,HOLD2,HOLD3 ; NAME A1; 09300850
|
|
LABEL B,D,E,T8,G ; 09300900
|
|
C:=N}0; A1:=[HOLD1]; 09301000
|
|
STREAM(A,S,JSIGN:=IF Q THEN 0 ELSE 1,NUMD:=ABS(N)-1, 09301005
|
|
SAVSI:=0,HOLD:=[HOLD1]); 09301010
|
|
BEGIN 09301012
|
|
SI:=A; SI:=SI+S; SAVSI:=SI; 09301015
|
|
SI:=SI+JSIGN; 09301020
|
|
DI:=DI+JSIGN; 09301025
|
|
DS:=NUMD NUM; 09301030
|
|
JSIGN(SI:=SAVSI; DI:=HOLD;); 09301050
|
|
DS:=CHR; 09301065
|
|
END; 09301070
|
|
A:=A1; S:=0; 09301075
|
|
P(DIB 1); 09301080
|
|
IF (N~ABS(N)){8 THEN 09301100
|
|
BEGIN 09301200
|
|
STREAM(C:S,A,N); BEGIN SI~A; SI~SI+S; DI~LOC C; DS~N OCT END ; 09301300
|
|
IF NOT Q THEN GO D; N~P ; 09301400
|
|
END 09301500
|
|
ELSE BEGIN P(0) ; 09301600
|
|
IF N>16 THEN 09301700
|
|
BEGIN 09301800
|
|
STREAM(S,Z~0,A:N~N-16,CA~[C]) ; 09301900
|
|
BEGIN 09302000
|
|
SI~A; SI~SI+S; DI~LOC A; DS~N OCT; DI~LOC S ; 09302100
|
|
DS~8 OCT; DI~CA; DS~8 OCT ; 09302200
|
|
END ; 09302300
|
|
P(0,T8,DLM,DLA) ; 09302400
|
|
B: P(0,T8,DLM,0,ABS(C),DLA) ; 09302500
|
|
END 09302600
|
|
ELSE BEGIN 09302700
|
|
STREAM(S:A,N~N-8,CA~[C]) ; 09302800
|
|
BEGIN 09302900
|
|
SI~A; SI~SI+S; DI~LOC S; DS~N OCT; DI~CA; DS~8 OCT ; 09303000
|
|
END ; 09303100
|
|
IF P(DUP)>P(G) THEN GO B; P(T8,|,ABS(C),+) ; 09303200
|
|
END ; 09303300
|
|
IF C!0 AND Q THEN 09303400
|
|
BEGIN 09303500
|
|
P(C,DIA 1); GO E ; 09303600
|
|
T8::: 100000000.0 ; 09303700
|
|
G::: 5496.0 ; 09303800
|
|
END ; 09303900
|
|
IF Q THEN S~S+N-1 ; 09304000
|
|
D: STREAM(S:A); BEGIN SI~A; SI~SI+S; S~TALLY; DI~LOC S; DI~DI+7; 09304100
|
|
DS~ZON; END; 09304200
|
|
P(P=@40,DIA 47) ; 09304300
|
|
E: N~P(TRB 1) ; 09304400
|
|
END ; 09304500
|
|
S~P ; 09304600
|
|
END OF COBOLDECIMALTOOCTALCONVERT ; 09304700
|
|
PROCEDURE COBOLOCTOLTODECIMALCONVERT(A,L,H,S,N,R,T); % INTRINSIC # @152.09400000
|
|
VALUE L,H,R,N,S,T; REAL L,H,R,N,S,T; NAME A ; 09400100
|
|
% THIS PROCEDURL CONVERTS THE DOUBLE-LENGTH WORD (L,H) INTO A STRING09400200
|
|
% OF N BCD DIGITS. THE STRING STARTS AT WORD ADDRESS A, 0HARACTER 09400300
|
|
% OFFSET S. PRIOR TO THE CONVERSION, (L,H) IS SCALED-TO-THE-LEFT/RHT09400400
|
|
% BY R DIGITS, I.E. (L,H) IS DIVIDED/MULTED BY 10*R. T IS A COMBINED09400500
|
|
% TRUNCATION/J-SIGN TOGGLE: T.[2:1]=1 => PUT THE SIGN OF (L,H) IN 09400600
|
|
% 1-ST CHR OF THE STRING; T.[1:1]=1 => PUT SIGN IN THE LAST CHR; 09400700
|
|
% ABS(T).[47:1]=1 => TRUNCATE (L,H) BEFORE CONVERSION (AND AFTER 09400800
|
|
% SCALING); ABS(T).[46:1]=1 => ROUND (L,H) BEFORE CONVERSION (AND 09400900
|
|
% AFTER SCALING). NOTE THAT 0{S{7, 0{N{23. 09401000
|
|
BEGIN 09401100
|
|
INTEGER IR=R, IH=H, IL=L ; 09401200
|
|
REAL B=17, SERR=19, WH=11, DMOD=21, Q=9 ; 09401300
|
|
ARRAY TEN=23[*] ; 09401400
|
|
LABEL HLF,T8,T16 ; 09401500
|
|
IF R<0 THEN 09401600
|
|
BEGIN 09401700
|
|
STREAM(S,N,A); BEGIN DI~DI+S; N(DS~LIT"0") END ; 09401800
|
|
N~N+R; R~0 ; 09401900
|
|
END ; 09402000
|
|
IF T.[1:2]=0 THEN H ~ ABS(H); 09402100
|
|
IF H.[2:1] THEN P(0,H/TEN[R]) ELSE P(L,H,TEN[R+27],TEN[R],DLD) ; 09402200
|
|
L~0 ; 09402300
|
|
IF P(ABS(Q~P),DUP)<P(HLF) THEN H~R~SERR~0 09402400
|
|
ELSE BEGIN 09402500
|
|
IF SERR~P(DUP)>TEN[23] THEN P(TEN[27+N],TEN[N],DMOD,B,XCH) ; 09402600
|
|
IF P(DUP).[2:1] THEN 09402700
|
|
BEGIN IF T THEN P(HLF,-); H~(IR~P) DIV P(T8) END 09402800
|
|
ELSE BEGIN 09402900
|
|
IF NOT T THEN P(0,HLF,DLA); H~P ; 09403000
|
|
H~P(L~P,H,0,IL~P(L,H,0,T16,DLD,HLF,-),XCH,DEL,0,T16,DLM, 09403100
|
|
DLS) ; 09403200
|
|
IR~P(R~P,H,0,IH~P(R,H,0,T8,DLD,HLF,-),XCH,DEL,0,T8,DLM, 09403300
|
|
DLS,HLF,-) ; 09403400
|
|
END ; 09403500
|
|
END ; 09403600
|
|
IF N{8 THEN 09403700
|
|
BEGIN P(L!0 OR H!0 OR R}TEN[N] OR N=0) ; 09403800
|
|
STREAM(R,N,S,A); BEGIN DI~DI+S; SI~LOC R; DS~N DEC END ; 09403900
|
|
END 09404000
|
|
ELSE IF N{16 THEN 09404100
|
|
BEGIN P(L!0 OR H}TEN[N-8]) ; 09404200
|
|
STREAM(H,R,N~N-8,S,A) ; 09404300
|
|
BEGIN DI~DI+S; SI~LOC H; DS~N DEC; DS~8 DEC END ; 09404400
|
|
END 09404500
|
|
ELSE BEGIN P(L}TEN[N-16]) ; 09404600
|
|
STREAM(L,H,R,N~N-16,S,A) ; 09404700
|
|
BEGIN DI~DI+S; SI~LOC L; DS~N DEC; DS~8DEC; DS~8DEC END09404800
|
|
END ; 09404900
|
|
IF P OR SERR THEN IF P(1,WH.[18:15],DUP)!0 THEN P(DIB 0,~) ; 09405000
|
|
IF Q<0 THEN 09405100
|
|
BEGIN 09405200
|
|
IF T>0 THEN 09405300
|
|
BEGIN 09405400
|
|
STREAM(N~N-2,S,A) ; 09405500
|
|
BEGIN 09405600
|
|
DI~DI+S; DS~SET; DS~RESET; DI~DI+N; DS~RESET;DS~RESET09405700
|
|
END ; 09405800
|
|
P(XIT) ; 09405900
|
|
HLF::: 0.499999999999 ; 09406000
|
|
T16::: 10000000000000000.0 ; 09406100
|
|
T8::: 100000000.0 ; 09406200
|
|
END ; 09406300
|
|
STREAM(S~S+N-1,A); BEGIN DI~DI+S; DS~SET; DS~RESET END ; 09406400
|
|
END ; 09406500
|
|
END OF COBOLOCTALTODECIMALCONVERT ; 09406600
|
|
PROCEDURE COBOLVARSZ; 09500000
|
|
BEGIN 09500100
|
|
REAL 09500200
|
|
TYPE = -1; % 0-2: EXAMINE 09500300
|
|
% 0=REPLACING FIRST 09500400
|
|
% 1=RFP/TALLY ALL, 09500500
|
|
% 2=LEADING/UNTIL FIRST 09500600
|
|
% 3: VARIABLE SIZE SMEAR 09500700
|
|
% 4-9: VARIABLE SIZE RELATE 09500800
|
|
% 4=<, 5=}, 6=>, 7={,8==,9=!09500900
|
|
% 10: VARIABLE SIZE MOVE 09501000
|
|
% 11: NEG ALPHA TEST 09501100
|
|
% 12: POSITIVE ALPHA TEST 09501200
|
|
ARRAY DESC = -2[*]; % RELATE: JUNKA DESCRIPIOR 09501300
|
|
% MOVE,SMEAR: =0 09501400
|
|
REAL CODE = -2, % EXAMINE:[47:1]=1 IF REP 09501500
|
|
% [46:1]=1 IF TALLYING 09501600
|
|
% [45:1]=1 IF REPLACING OR 09501700
|
|
% TALLYING UNTIL FIRST 09501800
|
|
DLENGTH = -3, % MOVE & RELATE: DEST LENGTH09501900
|
|
% SMEAR: LENGTH TO SMEAR 09502000
|
|
LNGTH = -3, % EXAMINE: LENGTH 09502100
|
|
SLENGTH = -4, % SOURCE LENGTH (SMEAR: =0) 09502200
|
|
RCHR = -4, % EXAMINE: 0HAR TO REPLACE 09502300
|
|
DOFSET = -5, % MOVE,RELATE,SMEAR:DEST OFF09502400
|
|
SCHR = -5, % EXAMINE: CHAR SOUGHT 09502500
|
|
SMCHR = -6, % SMEAR: CHAR TO SMEAR 09502600
|
|
% EXAMINE: MKS 09502700
|
|
SOFSET = -6, % MOVE&RELATE: SOURCE OFFSET09502800
|
|
OFFSET = -7; % EXAMINE: OFFSET 09502900
|
|
ARRAY 09503000
|
|
DEST = -7[*], % MOVE,RELATE,SMEAR:DESI 09503100
|
|
SOURCE = -8[*]; % MOVE,RELATE,EXAMINE:SOURCE09503200
|
|
REAL 09503300
|
|
RELATE, 09503400
|
|
DIFFER, 09503500
|
|
NMOD64, 09503600
|
|
SAVOFF, 09503700
|
|
NDIV64, 09503800
|
|
N, 09503900
|
|
NWDS; 09504000
|
|
ARRAY D[*]; 09504100
|
|
DEFINE 09504200
|
|
REPLACECHR = DI~DI-1; SI~LOC P6; SI~SI-1; DS~1 CHR#, 09504300
|
|
LISTP1TOP6 = P1~NMOD64,P2~NDIV64,P3~(NDIV64 DIV 64), 09504400
|
|
P4~SCHR,P5~RCHR,P6~OFFSET#; 09504500
|
|
LABEL VARIEXAM,CMD,SMEAR;% 09504600
|
|
%****************************** START HERE *****************************09504700
|
|
IF TYPE{2 THEN GO TO VARIEXAM;% 09504800
|
|
D ~ [DEST];% 09504900
|
|
IF TYPE=3 THEN GO TO SMEAR;% 09505000
|
|
IF (DIFFER ~ DLENGTH-SLENGTH)<0 THEN % VARIABLE MOVE ONLY 09505100
|
|
IF TYPE=10 THEN% 09505200
|
|
BEGIN% 09505300
|
|
SLENGTH ~ DLENGTH; 09505400
|
|
NMOD64 ~ SLENGTH.[42:6];% 09505500
|
|
END; 09505600
|
|
IF DIFFER!0 AND TYPE}4 AND TYPE{9 THEN % IF THERE IS A DIFFER-09505700
|
|
BEGIN % THEN MOVE SHORTER TO JUNKA&FILL OUT WITH BLANKS 09505800
|
|
IF DIFFER<0 THEN % INTERCHANGE TO MAKE OEST THE 09505900
|
|
BEGIN % LONGER, SOURCE THE SHORTER 09506000
|
|
D ~ [DEST]; DEST ~ [SOURCE]; SOURCE ~ [D]; 09506100
|
|
SAVOFF ~ SOFSET; SOFSET ~ DOFSET; DOFSET~0;09506200
|
|
NWDS~DLENGTH;DLENGTH~SLENGTH;SLENGTH~NWDS; 09506300
|
|
DIFFER ~ ABS(DIFFER);% 09506350
|
|
END ELSE% 09506400
|
|
BEGIN% 09506500
|
|
IF TYPE<8 THEN TYPE~TYPE-TYPE.[47:1]% 09506600
|
|
+(TYPE.[47:1]=0);% 09506700
|
|
SAVOFF ~ DOFSET;% 09506800
|
|
DOFSET ~ 0;% 09506900
|
|
END;% 09507000
|
|
RELATE ~ TYPE; 09507100
|
|
TYPE ~ 10; 09507200
|
|
D ~ [DESC[0]];% 09507300
|
|
END;% 09507400
|
|
CMD: % TRANSFER OR COMPARE FIELDS 09507500
|
|
IF TYPE!10 OR DIFFER}0 OR RELATE>0 THEN NMOD64~SLENGTH.[42:6]; 09507600
|
|
NDIV64 ~ SLENGTH DIV 64;% 09507700
|
|
IF TYPE<8 THEN% 09507800
|
|
BEGIN% 09507900
|
|
STREAM(P0~0:P1~NMOD64,P2~NDIV64,P2A~NDIV64!0,P3~(NDIV64 DIV 64)09508000
|
|
,P4~SOURCE,P5~SOFSET,P6~DOFSET,P7~TYPE}6,% 09508100
|
|
P8~TYPE.[47:1],P9~D);% 09508200
|
|
BEGIN 09508300
|
|
SI ~ P4; SI ~ SI+P5; DI ~ DI+P6; 09508400
|
|
CI ~ CI+P7; GO TO GREQ; GO TO GOLSQ;% 09508500
|
|
GREQ: 09508600
|
|
P3(63(P0~SI;P9~DI;IF 63SC=DC THEN ELSE% 09508700
|
|
BEGIN SI~P0;DI~P9;IF 63 SC>DC THEN;% 09508800
|
|
JUMP OUT 2 TO XYT1;% 09508900
|
|
END);% 09509000
|
|
2(P0~SI;P9~DI;IF 63SC=DC THEN ELSE% 09509100
|
|
BEGIN SI~P0;DI~P9;IF 63 SC>DC THEN;% 09509200
|
|
JUMP OUT 2 TO XYT1;% 09509300
|
|
END);% 09509400
|
|
IF SC=DC THEN ELSE% 09509500
|
|
BEGIN SI~SI-1;DI~DI-1;IF SC>DC THEN;% 09509600
|
|
JUMP OUT 1 XYT1;% 09509700
|
|
END); GO TO L1;% 09509800
|
|
XYT1: GO TO XYT2;% 09509900
|
|
GOLSQ:GO TO LSEQ;% 09510000
|
|
L1: P2 (P0~SI;P9~DI;IF 63SC=DC THEN ELSE% 09510100
|
|
BEGIN SI~P0;DI~P9;IF 63 SC>DC THEN; 09510200
|
|
JUMP OUT 1 TO XYT2;% 09510300
|
|
END);% 09510400
|
|
P2A (P0~SI;P9~DI;IF P2 SC=DC THEN ELSE% 09510500
|
|
BEGIN SI~P0;DI~P9;IF P2 SC>DC THEN;% 09510600
|
|
JUMP OUT 1 TO XYT2;% 09510700
|
|
END);% 09510800
|
|
IF P1 SC}DC THEN;% 09510900
|
|
XYT2: GO TO XYT3;% 09511000
|
|
LSEQ: 09511100
|
|
P3(63(P0~SI;P9~DI;IF 63SC=DC THEN ELSE% 09511200
|
|
BEGIN SI~P0;DI~P9;IF 63 SC<DC THEN;% 09511300
|
|
JUMP OUT 2 TO XYT3;% 09511400
|
|
END);% 09511500
|
|
2(P0~SI;P9~DI;IF 63SC=DC THEN ELSE% 09511600
|
|
BEGIN SI~P0;DI~P9;IF 63 SC<DC THEN;% 09511700
|
|
JUMP OUT 2 TO XYT3;% 09511800
|
|
END);% 09511900
|
|
IF SC=DC THEN ELSE% 09512000
|
|
BEGIN SI~SI-1;DI~DI-1;IF SC<DC THEN;% 09512100
|
|
JUMP OUT 1 TO XYT3;% 09512200
|
|
END); GO TO L2;% 09512300
|
|
XYT3: GO TO XYT;% 09512400
|
|
L2: P2 (P0~SI;P9~DI;IF 63SC=DC THEN ELSE% 09512500
|
|
BEGIN SI~P0;DI~P9;IF 63 SC<DC THEN;% 09512600
|
|
JUMP OUT 1 TO XYT;% 09512700
|
|
END);% 09512800
|
|
P2A (P0~SI;P9~DI;IF P2 SC=DC THEN ELSE% 09512900
|
|
BEGIN SI~P0;DI~P9;IF P2 SC<DC THEN;% 09513000
|
|
JUMP OUT 1 TO XYT;% 09513100
|
|
END);% 09513200
|
|
IF P1 SC{DC THEN;% 09513300
|
|
XYT: P8(IF TOGGLE THEN TALLY~1; JUMP OUT 1 TO STOR);% 09513400
|
|
IF TOGGLE THEN ELSE TALLY~1;% 09513500
|
|
STOR:P0~TALLY;% 09513600
|
|
END STREAM;% 09513700
|
|
END ELSE% 09513800
|
|
BEGIN% 09513900
|
|
STREAM(P0~0:P1~NMOD64,P2~NDIV64,P2A~NDIV64!0,P3~(NDIV64 DIV 64)09514000
|
|
,P4~SOURCE,P5~SOFSET,P6~DOFSET,P7~(TYPE}10)+(TYPE>10),% 09514100
|
|
P8~TYPE.[47:1],P9~D);% 09514200
|
|
BEGIN% 09514300
|
|
SI ~ P4; SI ~ SI+P5; DI ~ DI+P6; 09514400
|
|
CI ~ CI+P7; GO TO EQUL; GO TO TRFR; GO TO GOTAN;% 09514500
|
|
EQUL:% 09514600
|
|
P3( 63(IF 63 SC=DC THEN ELSE JUMP OUT 2 TO XYT1);% 09514700
|
|
2(IF 63 SC=DC THEN ELSE JUMP OUT 2 TO XYT1);% 09514800
|
|
IF 1 SC=DC THEN ELSE JUMP OUT 1 TO XYT1); GO TO L;% 09514900
|
|
GOTAN: GO TO TANL;% 09515000
|
|
L: P2(IF 63 SC=DC THEN ELSE JUMP OUT 1 TO XYT1);% 09515100
|
|
P2A(IF P2 SC=DC THEN ELSE JUMP OUT 1 TO XYT1);% 09515200
|
|
IF P1 SC=DC THEN; GO TO XYT1;% 09515300
|
|
TRFR:% 09515400
|
|
P3(63(DS~63 CHR); 2(DS~63 CHR); DS~CHR);% MOVE 64|64 09515500
|
|
P2(DS ~ 63 CHR); DS ~ P2 CHR; DS ~ P1 CHR; GO TO DONE1;% 09515600
|
|
XYT1: GO TO XYT2;% 09515700
|
|
TANL:% 09515800
|
|
P3(63(63(IF SC=ALPHA THEN IF SC{"Z" THEN SI~SI+1 ELSE% 09515900
|
|
JUMP OUT 3 TO XYT2 ELSE JUMP OUT 3 TO XYT2));% 09516000
|
|
2(63(IF SC=ALPHA THEN IF SC{"Z" THEN SI~SI+1 ELSE% 09516100
|
|
JUMP OUT 3 TO XYI2 ELSE JUMP OUT 3 TO XYI2));% 09516200
|
|
IF SC=ALPHA THEN IF SC{"Z" THEN SI~SI+1 ELSE% 09516300
|
|
JUMP OUT 1 TO XYT2 ELSE JUMP OUT 1 TO XYT2);% 09516400
|
|
GO TO L1; 09516500
|
|
XYT2: GO TO XYT; 09516600
|
|
DONE1: GO TO DONE; 09516700
|
|
L1: P2(63(IF SC=ALPHA THEN IF SC{"Z" THEN SI~SI+1 ELSE% 09516800
|
|
JUMP OUT 2 TO XYT ELSE JUMP OUT 2 TO XYT));% 09516900
|
|
P2(IF SC=ALPHA THEN IF SC{"Z" THEN SI~SI+1 ELSE% 09517000
|
|
JUMP OUT 1 TO XYT ELSE JUMP OUT 1 TO XYT);% 09517100
|
|
P1(IF SC=ALPHA THEN IF SC{"Z" THEN SI~SI+1 ELSE% 09517200
|
|
JUMP OUT 1 TO XYT ELSE JUMP OUT 1 TO XYT);% 09517300
|
|
XYT: P8(IF TOGGLE THEN ELSE TALLY~1; JUMP OUT 1 TO STOR);% 09517400
|
|
IF TOGGLE THEN TALLY~1;% 09517500
|
|
STOR: P0~TALLY;% 09517600
|
|
DONE:% 09517700
|
|
END STREAM;% 09517800
|
|
END;% 09517900
|
|
IF TYPE!10 THEN P(RTN);% 09518000
|
|
IF DIFFER>0 THEN 09518100
|
|
BEGIN % FILL OUT DEST WITH BLANKS TO MAKE UP DIFF09518200
|
|
P(SLENGTH+DOFSET,DUP,8,IDV,*P(.D),INX,.D,~,7,LND,.DOFSET,~); 09518300
|
|
SMEAR::NDIV64 ~(NWDS~(((DIFFER~(DLENGTH-SLENGTH)-% 09518500
|
|
(N~(8-DOFSET).[45:3])) DIV 8) - (DIFFER}8))) DIV 64;% 09518600
|
|
STREAM(P1~DIFFER.[45:3],P2~DOFSET,P3~8|(DIFFER}8)+N,P4~NWDS, 09518700
|
|
P4A~NWDS!0,P5~NDIV64,P5A~NDIV64!0,P6~SMCHR,P7~(TYPE=3 09518800
|
|
AND SMCHR!" "),P8~D);% 09518850
|
|
BEGIN 09518900
|
|
DI ~ DI+P2; P8~DI; P7(SI~LOC P7; SI~SI-1);% 09519000
|
|
CI~CI+P7; GO TO BLNK; GO TO SMR;% 09519100
|
|
BLNK:P3(DS ~ LIT " "); GO TO CONT;% 09519200
|
|
SMR: P3(DS ~ 1 CHR; SI~SI-1);% 09519300
|
|
CONT:SI ~ P8; P5(DS ~ 63 WDS); P5A(DS ~ P5 WDS);% 09519400
|
|
P4A(DS ~ P4 WDS);% 09519450
|
|
CI~CI+P7; GO TO FINB; GO TO FINS;% 09519500
|
|
FINB:P1(DS ~ LIT " "); GO TO XYT;% 09519600
|
|
FINS:P1(DS ~ 1 CHR; SI~SI-1);% 09519700
|
|
XYT:% 09519800
|
|
END STREAM; 09519900
|
|
END;% 09520000
|
|
IF RELATE>0 THEN % BLANK FILL DONE 09520100
|
|
BEGIN % GO BACK AND DO COMPARE 09520200
|
|
SOFSET ~ SAVOFF;% 09520300
|
|
SOURCE ~ [DEST];% 09520400
|
|
SLENGTH ~ DLENGTH;% 09520500
|
|
TYPE ~ RELATE;% 09520600
|
|
DOFSET ~ 0;% 09520650
|
|
D ~ [DESC];% 09520660
|
|
GO TO CMD;% 09520700
|
|
END;% 09520800
|
|
P(XIT); 09520900
|
|
VARIEXAM::% 09521000
|
|
NMOD64 ~ LNGTH.[42:6];% 09521100
|
|
NDIV64 ~ LNGTH DIV 64;% 09521200
|
|
IF TYPE=0 THEN 09521300
|
|
BEGIN % REPLACING FIRST 09521400
|
|
STREAM(LISTP1TOP6,P7~SOURCE);% 09521500
|
|
BEGIN 09521600
|
|
DI~DI+P6; SI~LOC P5; SI~SI-1; 09521700
|
|
P3(63(63(IF SC=DC THEN JUMP OUT 3 TO REP; SI~SI-1));% 09521800
|
|
2(63(IF SC=DC THEN JUMP OUT 3 TO REP; SI~SI-1));% 09521900
|
|
IF SC=DC THEN JUMP OUT 1 TO REP; SI~SI-1; );% 09522000
|
|
P2(63(IF SC=DC THEN JUMP OUT 2 TO REP; SI~SI-1));% 09522100
|
|
P2(IF SC=DC THEN JUMP OUT 1 TO REP; SI~SI-1);% 09522200
|
|
P1(IF SC=DC THEN JUMP OUT 1 TO REP; SI~SI-1);% 09522300
|
|
GO TO XYT; 09522400
|
|
REP: REPLACECHR; 09522500
|
|
XYT: 09522600
|
|
END STREAM; 09522700
|
|
END ELSE IF TYPE=1 THEN 09522800
|
|
BEGIN % REP AND/OR TALLYING ALL 09522900
|
|
STREAM(P0~0:LISTP1TOP6,P7~3-CODE)"0=REP&TALLY,1=TALLY ONLY, 09523000
|
|
2=REP ONLY"(P8~SOURCE);% 09523100
|
|
BEGIN 09523200
|
|
DI~DI+P6; SI~LOC P5; SI~SI-1;% 09523300
|
|
P3(63(63(IF 1 SC=DC THEN% 09523400
|
|
BEGIN CI~CI+P7; GO TO TALL1; GO TO TALL1; GO TO REP1;09523500
|
|
TALL1: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09523600
|
|
CI~CI+P7; GO TO REP1; GO TO NXT1;% 09523700
|
|
REP1: REPLACECHR; SI~LOC P5;% 09523800
|
|
END;% 09523900
|
|
NXT1: SI~SI-1;)));% 09524000
|
|
P3( 2(63(IF 1 SC=DC THEN% 09524100
|
|
BEGIN CI~CI+P7; GO TO TALL2; GO TO TALL2; GO TO REP2;09524200
|
|
TALL2: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09524300
|
|
CI~CI+P7; GO TO REP2; GO TO NXT2;% 09524400
|
|
REP2: REPLACECHR; SI~LOC P5;% 09524500
|
|
END;% 09524600
|
|
NXT2: SI~SI-1;)));% 09524700
|
|
P3( IF 1 SC=DC THEN% 09524800
|
|
BEGIN CI~CI+P7; GO TO TALL3; GO TO TALL3; GO TO REP3;09524900
|
|
TALL3: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09525000
|
|
CI~CI+P7; GO TO REP3; GO TO NXT3;% 09525100
|
|
REP3: REPLACECHR; SI~LOC P5;% 09525200
|
|
END;% 09525300
|
|
NXT3: SI~SI-1;);% 09525400
|
|
P2(63(IF 1 SC=DC THEN% 09525500
|
|
BEGIN CI~CI+P7; GO TO TALL4; GO TO TALL4; GO TO REP4;09525600
|
|
TALL4: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09525700
|
|
CI~CI+P7; GO TO REP4; GO TO NXT4;% 09525800
|
|
REP4: REPLACECHR; SI~LOC P5;% 09525900
|
|
END;% 09526000
|
|
NXT4: SI~SI-1;));% 09526100
|
|
P2(IF 1 SC=DC THEN% 09526200
|
|
BEGIN CI~CI+P7; GO TO TALL5; GO TO TALL5; GO TO REP5;09526300
|
|
TALL5: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09526400
|
|
CI~CI+P7; GO TO REP5; GO TO NXT5;% 09526500
|
|
REP5: REPLACECHR; SI~LOC P5;% 09526600
|
|
END;% 09526700
|
|
NXT5: SI~SI-1;);% 09526800
|
|
P1(IF 1 SC=DC THEN% 09526900
|
|
BEGIN CI~CI+P7; GO TO TALL6; GO TO IALL6; GO TO REP6;09527000
|
|
TALL6: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09527100
|
|
CI~CI+P7; GO TO REP6; GO TO NXT6;% 09527200
|
|
REP6: REPLACECHR; SI~LOC P5;% 09527300
|
|
END;% 09527400
|
|
NXT6: SI~SI-1;);% 09527500
|
|
END STREAM; 09527600
|
|
END ELSE 09527700
|
|
BEGIN %REP/TALLY UNTIL 1ST/LEADING09527800
|
|
STREAM(P0~0:LISTP1TOP6,P7~3-CODE.[46:2],P8~CODE.[45:1],% 09527900
|
|
P9~SOURCE);% 09528000
|
|
BEGIN 09528100
|
|
DI~DI+P6; SI~LOC P5; SI~SI-1;% 09528200
|
|
P3(63(63(CI~CI+P8; GO TO REPL1; GO TO REPUF1;% 09528300
|
|
REPL1: IF 1SC!DC THEN JUMP OUT 3 TO XYT1;GO TO DOIT1;09528400
|
|
REPUF1: IF 1SC=DC THEN JUMP OUT 3 TO XYT1;% 09528500
|
|
DOIT1: CI~CI+P7; GO TO TALL1; GO TO TALL1;GO TO REP1;09528600
|
|
TALL1: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09528700
|
|
CI~CI+P7; GO TO REP1; GO TO NXT1;% 09528800
|
|
REP1: REPLACECHR; SI~LOC P5;% 09528900
|
|
NXT1: SI~SI-1 ))); GO TO L2; XYT1: GO TO XYT2; 09529000
|
|
L2: P3( 2(63(CI~CI+P8; GO TO REPL2; GO TO REPUF2;% 09529100
|
|
REPL2: IF 1SC!DC THEN JUMP OUT 3 TO XYT2;GO TO DOIT2;09529200
|
|
REPUF2:IF 1SC=DC THEN JUMP OUT 3 TO XYT2;% 09529300
|
|
DOIT2: CI~CI+P7; GO TO TALL2; GO TO TALL2;GO TO REP2;09529400
|
|
TALL2: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09529500
|
|
CI~CI+P7; GO TO REP2; GO TO NXT2;% 09529600
|
|
REP2: REPLACECHR; SI~LOC P5;% 09529700
|
|
NXT2: SI~SI-1 ))); GO TO L3; XYT2: GO TO XYI3; 09529800
|
|
L3: P3( CI~CI+P8; GO TO REPL3; GO TO REPUF3;% 09529900
|
|
REPL3: IF 1SC!DC THEN JUMP OUT 1 TO XYT3;GO TO DOIT3;09530000
|
|
REPUF3:IF 1SC=DC THEN JUMP OUT 1 TO XYT3;% 09530100
|
|
DOIT3: CI~CI+P7; GO TO TALL3; GO TO TALL3;GO TO REP3;09530200
|
|
TALL3: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09530300
|
|
CI~CI+P7; GO TO REP3; GO TO NXT3;% 09530400
|
|
REP3: REPLACECHR; SI~LOC P5;% 09530500
|
|
NXT3: SI~SI-1 ); GO TO L4; XYT3: GO TO XYT4; 09530600
|
|
L4: P2(63(CI~CI+P8; GO TO REPL4; GO TO REPUF4;% 09530700
|
|
REPL4: IF 1SC!DC THEN JUMP OUT 2 TO XYT4;GO TO DOIT4;09530800
|
|
REPUF4:IF 1SC=DC THEN JUMP OUT 2 TO XYT4;% 09530900
|
|
DOIT4: CI~CI+P7; GO TO TALL4; GO TO IALL4;GO TO REP4;09531000
|
|
TALL4: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09531100
|
|
CI~CI+P7; GO TO REP4; GO TO NXT4;% 09531200
|
|
REP4: REPLACECHR; SI~LOC P5;% 09531300
|
|
NXT4: SI~SI-1 )); GO TO L5; XYT4: GO TO XYT5; 09531400
|
|
L5: P2(CI~CI+P8; GO TO REPL5; GO TO REPUF5;% 09531500
|
|
REPL5: IF 1SC!DC THEN JUMP OUT 1 TO XYT5;GO TO DOIT5;09531600
|
|
REPUF5:IF 1SC=DC THEN JUMP OUT 1 TO XYT5;% 09531700
|
|
DOIT5: CI~CI+P7; GO TO TALL5; GO TO TALL5;GO TO REP5;09531800
|
|
TALL5: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09531900
|
|
CI~CI+P7; GO TO REP5; GO TO NXT5;% 09532000
|
|
REP5: REPLACECHR; SI~LOC P5;% 09532100
|
|
NXT5: SI~SI-1 ); GO TO L6; XYT5: GO TO XYT; 09532200
|
|
L6: P1(CI~CI+P8; GO TO REPL6; GO TO REPUF6;% 09532300
|
|
REPL6: IF 1SC!DC THEN JUMP OUT 1 TO XYT; GO TO DOIT6;09532400
|
|
REPUF6:IF 1SC=DC THEN JUMP OUT 1 TO XYT;% 09532500
|
|
DOIT6: CI~CI+P7; GO TO TALL6; GO TO TALL6;GO TO REP6;09532600
|
|
TALL6: SI~P0; SI~SI+8; P0~SI; SI~LOC P5;% 09532700
|
|
CI~CI+P7; GO TO REP6; GO TO NXT6;% 09532800
|
|
REP6: REPLACECHR; SI~LOC P5;% 09532900
|
|
NXT6: SI~SI-1 );% 09533000
|
|
XYT:% 09533100
|
|
END STREAM;% 09533200
|
|
END;% 09533300
|
|
IF CODE.[46:1] THEN P(RTN);% 09533400
|
|
END COBOLVARSZ;% 09533500
|
|
PROCEDURE COBOLIONONDSK; % PRONOUNCED COBOL-IO-NON-DISK 09600000
|
|
BEGIN 09600100
|
|
REAL CODE = -1; % 0=READ,1=WRITE,6=WRTBLK 09600200
|
|
NAME DLOC = -2; % POINTS TO BUFFER IO DESCRIPTOR 09600300
|
|
REAL NUMWDS = -3, % # WDS TO BE WRITTEN 09600400
|
|
KEY = -4, % CARRIAGE RETURN 09600500
|
|
CHNNL = -4, % LP CHANNEL SKIP 09600600
|
|
LINES = -5, % # LINES TO BE SPACED 09600700
|
|
SKIPBFR = -6; % 1=SPACE BEFORE PRINT 09600800
|
|
INTEGER 09600900
|
|
LINAGE = -7; % LINE PRINTER: [1:1]=1 IF LINAGE 09601000
|
|
% CLAUSE PRESENT,[33:15]= LINAGE LIMIT09601100
|
|
% ON NEXT END-OF-PAGE 09601200
|
|
%LOCALS 09601300
|
|
REAL IOMASK; 09601400
|
|
ARRAY FIB [*]; % FIB ARRAY 09601500
|
|
REAL FILECTRL = 12, % USED TO CALL COBOLFCR 09601600
|
|
PERFORMGEN= 13, % USED FOR PERFORMING USE ROUTINES 09601700
|
|
COBOLIODSK= 15; 09601800
|
|
NAME FLOC; % POINTER TO FIB 09601900
|
|
ARRAY FPB = 3[*]; % FILE PARAMETER BLOCK 09602000
|
|
NAME MEM = 2; % DUMMY DATA DESC 09602100
|
|
ARRAY PGUSE = 24[*]; % PROGRAM USE ROUTINES 09602200
|
|
REAL 09602300
|
|
T,RT, % TEMPORARY 09602400
|
|
TCW, % TECH C: NUMBER WORDS TO BE READ 09602500
|
|
TCDIF, % TECH C: (ACTUAL RECORD - MIN REC) 09602600
|
|
UNITYPE, % STORE UNIT TYPE FOR MANY TESTS 09602700
|
|
ENDREEL; % USED ONLY ON READ 09602800
|
|
ARRAY DEST[*]; % DESTINATION IN MOVEREC 09602900
|
|
DEFINE 09603000
|
|
AF = [12:12]#, % FILE USE ROUTINE 09603100
|
|
ARR = [36:12]#, % REEL USE ROUTINE 09603200
|
|
ARROW = P(0,NOT,(BUFFSIZE-WORDSLEFT),TIP,INX,STD)#, 09603300
|
|
% THIS INSERTS THE GROUP MARK 09603400
|
|
BCOUNT = FIB[6]#, % BLOCK COUNT 09603500
|
|
BINARY = FIB[13].[24:1]#, % 1=BINARY,0=ALPHA 09603600
|
|
BF = [1:11]#, % FILE USE ROUTINE 09603700
|
|
BREAK = FIB[9] ! 0 # , % BREAKOUT RESTART POINT 09603800
|
|
BREAKOUT = IF(RCOUNT MOD FIB[9])=0 THEN 09603900
|
|
P(0,0,12,COM,DEL,DEL)#,% CALL BREAKOUT 09604000
|
|
BRR = [24:12]#, % REEL USE ROUTINE 09604100
|
|
BUFFNUM = FIB[13].[1:9] #, % # OF BUFFS REQUSTED 09604200
|
|
BUFFSIZE = FIB[18].[3:15]#, % BUFFER SIZE (REQUESTED) 09604300
|
|
BUFFSZ = FIB[18][8:8:10]#, % SIZE FOR CONCATINATES 09604400
|
|
BUFTOP = FIB[16]#,% COPY OF TOP IOD: POINTS TO BEG BUFF09604500
|
|
CHECK(CHECK1) = IF P(DUP)!(CHECK1) THEN P(CHECK1,0,FLOC,#, 09604600
|
|
ONERR(ONERR1) = ONERR1,17,COM,DEL,DEL,DEL,DEL); P(DEL)#, 09604700
|
|
% THE ABOVE ARE USED ON BLOCK+REC CHKS09604800
|
|
CLOSEANDOPEN =P(MKS,1,0,FLOC,4,FILECTRL, %CLOSE NO RWD 09604900
|
|
MKS,FLOC,1,FILECTRL)#, % OPEN INPUT 09605000
|
|
COUNT = FIB[12] #, % USED FOR BLOCKING TECH-A,B09605100
|
|
DELAY = TIP.[20:1] #, % THIS ALLOWS ONE CYCLE DELY09605200
|
|
DISK = (UNITYPE~(FIB[4].[8:4]))=4#, 09605300
|
|
DONE = TIP.[19:1] #, % 1= IO COMPLETED 09605400
|
|
ENDFILE = FIB[5].[40:1] #, % ALREADY PASSED EOF 09605500
|
|
ENDPROCESS = FIB[5].[39:2]#, % SEE OPTIONAL AND ENDFILE 09605600
|
|
EOF =((*DLOC).[27:1])#, % FIRST EOF OR EOT 09605700
|
|
FNAM = FIB[4].[13:11]#, % FILE NAME INDEX IN FPB 09605800
|
|
FOREVER =(NOT 0).[9:39] #, % UNTIL END TIME 09605900
|
|
HOWOPEN = FIB[5].[41:3]#, % 1=OPEN INPUT,0= OPEN OUTPT09606000
|
|
% 1 > CLOSED 09606100
|
|
INFILE = FIB[13].[27:1]#, % FILE OPEN INPUT 09606200
|
|
INVALIDUSER = FIB[5]<0#, % INVALID USER NOT PARITY 09606300
|
|
INXLINAGE = P(LOCOFCTR,DUP,LOD,LINES,ADD,XCH,~)#, 09606400
|
|
IOERR(IOERR1) = P(0,FLOC,IOERR1,17,COM,DEL,DEL,DEL)#, 09606500
|
|
% ABOVE CALLS IOERROR ROUTINE 09606600
|
|
LABELED = NOT FIB[4].[2:1]#, 09606700
|
|
LABE0 = FIB[5].[17:1] #, % LABEL EQUATED FROM DISK 09606800
|
|
LBLPTR = FLOC[1] #, % LABEL POINTER 09606900
|
|
LINAGELIM = FIB[1]#, % LOGICAL LENGTH OF PRINTED PAGE 09607000
|
|
LINEPRINT = FIB[20] #, % CF=1 IS PRINTFILE 09607100
|
|
LINTOG = LINAGE.[1:1]#, % TRUE IF LINAGE PRESENT 09607300
|
|
LOCOFCTR = FIB[3]#, % PRT LOC OF LINAGE COUNTER09607400
|
|
MABUSE = FIB[4].[1:1]#, % MAY BE USE RTNS PRESENT 09607500
|
|
MAXR = FIB[18][8:38:10]#,% MAX REC SZ FOR CONCATS 09607600
|
|
MAXREC = FIB[18].[33:15]#, % MAX REC SZ 09607700
|
|
MINREC = FIB[18].[FF] #, % MINIMUM RECORD SIZE 09607800
|
|
NONSTD = FIB [5].[16: 1]#, % NON-STANDARD LABELS 09607900
|
|
NUMBUF = FIB[13].[10: 9]#, % NUMBER OF BUFFERS ASSIGNED09608000
|
|
NUMREC = FIB[11] #, % RECORDS PER BLOCK 09608100
|
|
NXTLINAGE = LINAGE.[33:15]#, % PRINTER: LINAGE LIMIT 09608200
|
|
NXTREEL = P(MKS,2,1,FLOC,4, % THIS DOES REEL SWITCHING 09608300
|
|
FILECTRL)#, % 09608400
|
|
OPTIONAL = FIB[ 5].[39:1]#, % OPTIONAL FILE NOT PRESENT 09608500
|
|
PARITY = TIP.[28:1]#, % PARITY BIT ON DESC 09608600
|
|
PBIT = [2:1]#, % PRESENCE BIT 09608700
|
|
PRESENT =((*DLOC).[2:1])#, % CHECKS PRESENTSBIT 09608800
|
|
PROPER =P(CODE,P(DUP),+,P(DUP)=12,+,REVERSE,+,21,+) #, 09608900
|
|
% GENERATES PROPER IOERROR 09608910
|
|
PUNCH = UNITYPE=6#, % UNIT IS CARD PUNCH 09609000
|
|
RCOUNT = FIB[7] #, % RECORD COUNT 09609100
|
|
RCPRT = (FIB[20].[FF])#, %PRT OF DESC POINTING TO REC09609200
|
|
READER =(UNITYPE MOD 11=0)#,% 0=READER 11=PSUDOREADER 09609300
|
|
READLBL =P(DLOC INX 0,11,11 % THIS READS THE LABEL. 09609400
|
|
,COM,DEL,DEL)#, % 09609500
|
|
RECPERBLK = H[0].[30:12] #, % RECORDS PER BLOCK 09609600
|
|
$ SET OMIT = TIMESHARING 09609690
|
|
REMOTEUNIT =10#, % DATACOM IS TYPE 14 ON TSS 09610100
|
|
REMOTEREAD =BEGIN P(BUFFSIZE,TIP,1,(-13),COM); 09610200
|
|
P(TIP); MOVEREC; 09610220
|
|
P([DLOC[0]],:=,1,SUB,RTN); 09610240
|
|
END#, 09610260
|
|
REMOTEWRIT =BEGIN P(TIP); MOVEREC; 09610300
|
|
P([DLOC[0]],STN); % RESTORE TIP 09610320
|
|
P(NUMWDS|8,LINES&KEY[CTF],0,(-11),COM, 09610340
|
|
DEL,RTN); 09610360
|
|
END#, 09610380
|
|
$ POP OMIT OMIT 09610390
|
|
REVERSE = FIB[5].[44:1] #, % 1=REVERSE 09610400
|
|
SETPRESENCEBIT =P(TIP OR MEM ,DLOC,~)#,% SET PRESENCE BIT 09610500
|
|
$ SET OMIT = NOT(TIMESHARING) 09610600
|
|
SLEEP = 36 #, 09610700
|
|
$ POP OMIT 09610701
|
|
$ SET OMIT = TIMESHARING 09610800
|
|
TAPEE = TIP.[7:1] #, % 1= TAPES 0=ALL ELSE 09611000
|
|
TECHA =(FIB[5].[46:2]=1) #,% TECHNIQUL-A 09611100
|
|
TECHC =(FIB[5].[46:2]=3) #,% TECHNIQUE-C 09611200
|
|
TERM(TERM1) = P(1,FLOC,TERM1,17,COM)#,%TERMINATE I/O ERROR 09611300
|
|
TIP = (*DLOC) #, % LOAD I/O DESC 09611400
|
|
TOSZF = [8:38:10]#, 09611500
|
|
UNBLKD = (FIB[5].[46:2]=0)#, % 1 RECORD PER BLOCK 09611600
|
|
WAITIO = P(DLOC,IOMASK, % THIS SLEEPS ON I/O 09611700
|
|
SLEEP,COM,DEL,DEL)#,% WAITING FOR A COMPLETE 09611800
|
|
WRITEPARITY = FIB[5].[3:1]#, % INDICATES FORCED REELSWITCH09611810
|
|
WORDSLEFT = FIB[17]#; % WORDS LEFT IN BUFFER 09611900
|
|
LABEL LPRETURN,START,IMPROPER,ROVER,EOFSETCK; 09612000
|
|
SUBROUTINE GOUSE; % CALLS USE ROUTINES 09612100
|
|
BEGIN P(MKS,[FIB],T,0,PERFORMGEN); END;% 09612200
|
|
SUBROUTINE INPUTPARITY;% 09612300
|
|
BEGIN% 09612400
|
|
IF (T ~ RT ~ PGUSE[4].BRR)!0 THEN GOUSE; % INPUT ERROR USE RTN 09612600
|
|
IF (T ~ FIB[15].BF) ! 0 THEN GOUSE; 09612700
|
|
IF NOT PRESENT THEN IF NOT (T OR RT) THEN 09612800
|
|
IOERR(19 + 10 | REVERSE); 09612850
|
|
SETPRESENCEBIT; 09612900
|
|
END INPUTPARITY;% 09613000
|
|
SUBROUTINE OUTPUTERROR;% 09613100
|
|
BEGIN% 09613200
|
|
IF NOT EOF THEN % TAPE WRITE PARITY OR BLANK TAPE 09613300
|
|
BEGIN % OUTPUT ERROR USE ROUTINES 09613400
|
|
IF (T ~ PGUSE[5].BRR)!0 THEN GOUSE;% 09613500
|
|
IF (T ~ FIB[15].BF) ! 0 THEN GOUSE; 09613600
|
|
TERM(20);% 09613700
|
|
END;% 09613800
|
|
SETPRESENCEBIT;% 09613900
|
|
NXTREEL; % REEL SWITCH 09614000
|
|
END OUTPUTERROR;% 09614100
|
|
SUBROUTINE INPUTEOFEOR; 09614200
|
|
BEGIN % EOF OR EOR 09614300
|
|
ENDFILE ~ TRUE;% 09614400
|
|
SETPRESENCEBIT;% 09614500
|
|
IF READER OR REVERSE THEN P(1,RTN);% 09614600
|
|
IF LABELED THEN% 09614700
|
|
BEGIN% 09614800
|
|
READLBL;% 09614900
|
|
STREAM(SENT~0,BC~0,RC~0,WP~0:L~5 INX LBLPTR);09615000
|
|
BEGIN % THIS RETREIVES END OF REEL09615100
|
|
DI~LOC SENT; % SENTINEL,BLOCK & REC COUNT09615200
|
|
DI~DI+7; SI~L; SI~SI-1;% 09615300
|
|
DS~CHR; DS~5 OCT; DS~7 OCT;% 09615400
|
|
DI~DI+7; DS~ CHR; 09615410
|
|
END;% 09615500
|
|
IF P=1 THEN WRITEPARITY ~ TRUE; 09615510
|
|
CHECK(RCOUNT) ONERR(16); 09615600
|
|
CHECK(BCOUNT) ONERR(17); 09615700
|
|
ENDREEL ~ P; % STORE SENTINEL 09615800
|
|
IF MABUSE THEN% 09615900
|
|
IF NOT WRITEPARITY THEN 09615950
|
|
BEGIN % END INPUT REEL USE RTNS 09616000
|
|
IF (T~PGUSE[1].BRR)!0 THEN GOUSE;% 09616100
|
|
IF (T~PGUSE[1].ARR)!0 THEN GOUSE;% 09616200
|
|
IF NOT ENDREEL THEN% 09616300
|
|
BEGIN % END INPUT FILE USE RINS 09616400
|
|
IF (T~PGUSE[1].BF)!0 THEN GOUSE; 09616500
|
|
IF (T~PGUSE[1].AF)!0 THEN GOUSE; 09616600
|
|
END;% 09616700
|
|
IF (T~FIB[2].BRR)!0 THEN GOUSE; % END 09616800
|
|
IF (T~FIB[2].ARR)!0 THEN GOUSE; % REEL09616900
|
|
IF NOT ENDREEL THEN% 09617000
|
|
BEGIN % END FILE USE ROUTINES% 09617100
|
|
IF (T~FIB[2].BF)!0 THEN GOUSE;% 09617200
|
|
IF (T~FIB[2].AF)!0 THEN GOUSE;% 09617300
|
|
END;% 09617400
|
|
END USE;% 09617500
|
|
END LABELED;% 09617600
|
|
IF LABELED AND NOT ENDREEL THEN P(1,RTN);% 09617700
|
|
IF NONSTD THEN% 09617800
|
|
BEGIN% 09617900
|
|
ENDFILE ~ FALSE;% 09618000
|
|
CLOSEANDOPEN;% 09618100
|
|
P(1,RTN);% 09618200
|
|
END;% 09618300
|
|
NXTREEL;% 09618600
|
|
P(DEL,DEL); % DELETE BRANCH RETURNS 09618700
|
|
WRITEPARITY ~ FALSE; 09618710
|
|
IF TECHC THEN P(.TCW,LOD,.NUMWDS,STD); 09618750
|
|
GO TO START;% 09618800
|
|
END INPUTEOFEOR; 09618900
|
|
SUBROUTINE MOVEREC; % MOVES RECORD BETWEEN WORK AREA AND BUFFER 09619000
|
|
BEGIN% 09619100
|
|
IF NOT DONE THEN WAITIO;% 09619200
|
|
P(*RCPRT,TIP INX 0); 09619300
|
|
IF NOT PRESENT THEN % MAY BE ERROR OR EOF 09619400
|
|
IF CODE THEN 09619500
|
|
IF EOF THEN BEGIN OUTPUTERROR; P(DEL,TIP INX 0); END 09619600
|
|
ELSE P(XCH,P(DUP).[8:10],.NUMWDS,ISD) 09619700
|
|
ELSE IF EOF THEN INPUTEOFEOR; 09619800
|
|
DEST ~ IF CODE THEN P ELSE P(XCH);% 09619900
|
|
STREAM(FROM~P:NUMWDS,E~P(DUP).[36:6],X~DEST);% 09620000
|
|
BEGIN% 09620100
|
|
SI~FROM;E(DS~32 WDS;DS~32 WDS); DS~NUMWDS WDS;% 09620200
|
|
END;% 09620300
|
|
P(DEL);% 09620400
|
|
WORDSLEFT ~ *P(DUP) - NUMWDS; 09620500
|
|
DLOC[0] ~ (IF REVERSE THEN NOT(NUMWDS-1) ELSE NUMWDS) INX TIP; 09620600
|
|
RCOUNT ~ *P(DUP) + 1; 09620700
|
|
IF CODE THEN % CHECK FOR 09620800
|
|
IF NOT PRESENT THEN OUTPUTERROR % OUTPUT PARITY ERROR 09620900
|
|
ELSE ELSE 09621000
|
|
IF NOT PRESENT THEN INPUTPARITY; % INPUT PARITY 09621100
|
|
IF BREAK THEN BREAKOUT; 09621200
|
|
END MOVERECORDTOANDFROMWORKAREA; 09621300
|
|
SUBROUTINE PREL; % DOES ACTUAL I/O 09621700
|
|
BEGIN% 09621800
|
|
P(TIP,DLOC,PRL,DEL); % DO IO 09621900
|
|
BCOUNT ~ *P(DUP) + 1; % UP BLOCK COUNT 09622100
|
|
END PREL;% 09622300
|
|
SUBROUTINE SKIPPER; % DOES SPACING ON PRINTER 09622400
|
|
BEGIN 09622500
|
|
WHILE LINES > 0 DO 09622600
|
|
BEGIN 09622700
|
|
IF NOT DONE THEN WAITIO; 09622800
|
|
IF NOT PRESENT THEN OUTPUTERROR; 09622900
|
|
DLOC[0] ~ TIP & 1[18:47:1] & 16[27:42:6]; 09623000
|
|
IF LINES = 1 THEN 09623100
|
|
DLOC[0] ~ TIP & 2[27:46:2]; 09623200
|
|
PREL; 09623300
|
|
LINES ~ LINES - 2; 09623400
|
|
END; 09623500
|
|
END SKIPPINGALLTHOSELINES; 09623600
|
|
SUBROUTINE GOLP; % MAKES THY PRYNTER GO 09624600
|
|
BEGIN 09624700
|
|
IF LINTOG THEN INXLINAGE; 09624800
|
|
IF NUMWDS > 17 THEN NUMWDS ~ 17; 09624810
|
|
IF MAXREC > 17 THEN MAXREC ~ 17; 09624820
|
|
RT ~ BUFFSIZE - WORDSLEFT; % !0 MEANS DATA PRESENT 09624900
|
|
IF NOT UNBLKD THEN 09625000
|
|
BEGIN 09625100
|
|
IF TECHC THEN 09625200
|
|
BEGIN 09625300
|
|
IF NUMWDS > MAXREC THEN NUMWDS ~ MAXREC; 09625400
|
|
IF NUMWDS { 0 THEN TERM(36); 09625500
|
|
END; 09625600
|
|
IF NUMWDS > WORDSLEFT THEN SKIPBFR ~ TRUE 09625700
|
|
ELSE BEGIN MOVEREC; GO LPRETURN; END; 09625800
|
|
END; 09625900
|
|
IF CHNNL ! 0 THEN LINES ~ 0; 09626000
|
|
IF SKIPBFR THEN 09626100
|
|
BEGIN 09626200
|
|
IF NOT DONE THEN WAITIO; 09626300
|
|
IF NOT PRESENT THEN OUTPUTERROR; 09626400
|
|
DLOC[0] ~ FLAG(BUFTOP & (RT = 0) [18:47:1] 09626500
|
|
&RT TOSZF 09626550
|
|
&(LINES>0)[27:46:2] & CHNNL[29:44:4]);09626600
|
|
IF LINES = 1 THEN DLOC[0]~TIP & 2[27:46:2]; 09626700
|
|
PREL; 09626800
|
|
WORDSLEFT ~ BUFFSIZE; 09626850
|
|
IF (LINES ~ LINES - 2) > 0 THEN SKIPPER; 09626900
|
|
IF UNITYPE=12 THEN IF NOT DONE THEN WAITIO; 09627000
|
|
BUFTOP.[CF] ~ TIP; 09627100
|
|
MOVEREC; 09627200
|
|
END ELSE 09627300
|
|
BEGIN 09627400
|
|
IF RT ! 0 THEN 09627500
|
|
BEGIN 09627600
|
|
DLOC[0] ~ FLAG(BUFTOP & 0[27:42:6] 09627700
|
|
& RT TOSZF); 09627750
|
|
PREL; 09627800
|
|
WORDSLEFT ~ BUFFSIZE; 09627850
|
|
IF UNITYPE=12 THEN IF NOT DONE THEN WAITIO; 09627900
|
|
BUFTOP.[CF] ~ TIP; 09628000
|
|
END; 09628100
|
|
MOVEREC; 09628200
|
|
DLOC[0] ~ FLAG(BUFTOP & (LINES>0)[27:46:2] 09628300
|
|
& (BUFFSIZE-WORDSLEFT) TOSZF 09628350
|
|
& CHNNL [29:44:4]); 09628400
|
|
IF LINES = 1 THEN DLOC[0]~TIP & 2[27:46:2]; 09628500
|
|
PREL; 09628600
|
|
WORDSLEFT ~ BUFFSIZE; 09628650
|
|
IF (LINES ~ LINES - 2) > 0 THEN SKIPPER; 09628700
|
|
IF UNITYPE=12 THEN IF NOT DONE THEN WAITIO; 09628800
|
|
BUFTOP.[CF] ~ TIP; 09628900
|
|
END; 09629100
|
|
LPRETURN: 09629200
|
|
IF LINTOG THEN IF (*P(LOCOFCTR))}LINAGELIM THEN 09629300
|
|
BEGIN 09629400
|
|
P(0,LOCOFCTR,STD); 09629500
|
|
LINAGELIM ~ NXTLINAGE; 09629600
|
|
P(1,RTN); 09629700
|
|
END; 09629800
|
|
P(0,RTN); 09629900
|
|
END GOINTOPRINTER; 09630000
|
|
SUBROUTINE WRIT; % WRITES A BLOCK 09630900
|
|
BEGIN 09631000
|
|
DLOC[0] ~ FLAG(BUFTOP & (BUFFSIZE-WORDSLEFT) TOSZF); 09631100
|
|
IF TAPEE THEN IF NOT BINARY THEN ARROW ELSE 09631200
|
|
ELSE IF PUNCH THEN DLOC[0] ~ TIP & CHNNL[32:47:1]; 09631300
|
|
PREL; 09631400
|
|
WORDSLEFT ~ BUFFSIZE; 09631500
|
|
BUFTOP.[CF] ~ TIP; 09631600
|
|
END WRIT;% 09631700
|
|
SUBROUTINE REED; % READS A BLOCK 09631800
|
|
BEGIN% 09631900
|
|
DLOC[0] ~ FLAG(FIB[16]);% 09632100
|
|
PREL;% 09632200
|
|
BUFTOP.[CF] ~ TIP;% 09632300
|
|
WORDSLEFT ~ 0; 09632500
|
|
END REED;% 09632700
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% START HERE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%09632800
|
|
FIB ~ *(FLOC ~ (NOT 2) INX DLOC);% 09632900
|
|
IF FPB[FNAM+3].[42:6]=43 THEN % DUMMY 09632910
|
|
IF CODE=0 THEN GO EOFSETCK ELSE P(0,RTN); 09632920
|
|
IF DISK THEN GO TO P(COBOLIODSK);% 09633000
|
|
IOMASK ~ @2000000000;% 09633100
|
|
START:IF NOT(ENDPROCESS=0 OR CODE) THEN GO TO EOFSETCK; 09633200
|
|
IF CODE > 1 THEN % SHOULD BE WRITE BLOCK 09633300
|
|
BEGIN 09633400
|
|
IF CODE ! 6 THEN TERM(25); % UNRECOGNIZED CODE 09633500
|
|
IF HOWOPEN ! 0 THEN GO IMPROPER; % IO ERROR 09633600
|
|
IF WORDSLEFT < BUFFSIZE THEN 09633700
|
|
IF LINEPRINT THEN GOLP ELSE WRIT; 09633800
|
|
P(0,RTN); 09633900
|
|
END WRITEBLOCK; 09634000
|
|
IMPROPER:IF (1-CODE)!HOWOPEN THEN % CHECK USE VS HOW OPEN 09634200
|
|
IF HOWOPEN>1 THEN TERM(31+CODE) % CLOSED 09634300
|
|
ELSE TERM(PROPER);% % USAGE 09634400
|
|
IF UNITYPE=10 OR UNITYPE=13 THEN 09634500
|
|
BEGIN 09634600
|
|
IF CODE THEN REMOTEWRIT; 09634700
|
|
REMOTEREAD; 09634800
|
|
END; 09634900
|
|
IF CODE THEN % WRITE A RECORD 09635000
|
|
IF LINEPRINT THEN GOLP ELSE 09635100
|
|
BEGIN 09635200
|
|
IF TECHC THEN 09635300
|
|
BEGIN 09635400
|
|
IF NUMWDS > MAXREC THEN NUMWDS ~ MAXREC; 09635500
|
|
IF NUMWDS > WORDSLEFT THEN WRIT; 09635600
|
|
IF NUMWDS < MINREC THEN TERM(36); 09635700
|
|
END; 09635800
|
|
MOVEREC; 09635900
|
|
IF WORDSLEFT < MINREC THEN WRIT; 09636000
|
|
P(0,RTN); 09636100
|
|
END; 09636200
|
|
% READ A RECORD 09636300
|
|
ROVER: IF WORDSLEFT { 0 THEN 09636400
|
|
BEGIN % A NEW BLOCK WAS READ 09636500
|
|
IF NOT DONE THEN WAITIO; 09636600
|
|
WORDSLEFT ~ 09636800
|
|
MEM[(IF REVERSE THEN 1 ELSE NOT 0) INX TIP]; 09636900
|
|
IF REVERSE THEN DLOC[0] ~ NOT(MAXREC-2) INX TIP; 09637000
|
|
END; 09637100
|
|
IF TECHC THEN 09637200
|
|
BEGIN 09637300
|
|
NUMWDS ~ P(.NUMWDS,LOD,.TCW,STD,MINREC); 09637400
|
|
MOVEREC; 09637500
|
|
IF (TCW~TCW) > MAXREC THEN TCW ~ MAXREC; 09637600
|
|
IF TCW < NUMWDS THEN 09637700
|
|
IF (TCW=0) AND (WORDSLEFT+NUMWDS=1) THEN 09637800
|
|
BEGIN 09637900
|
|
REED; 09638000
|
|
RCOUNT ~ *P(DUP) - 1; 09638100
|
|
GO ROVER; 09638200
|
|
END ELSE TERM(26 + (TCW!0)); 09638300
|
|
IF (TCDIF ~ TCW - NUMWDS) > 0 THEN 09638400
|
|
BEGIN 09638500
|
|
STREAM(TCDIF,E~P(DUP).[36:6], 09638600
|
|
FROM~ TIP INX 0, 09638700
|
|
DEST ~ NUMWDS INX (*RCPRT)); 09638800
|
|
BEGIN SI ~ FROM; 09638900
|
|
E(DS~32 WDS; DS~32 WDS); 09639000
|
|
DS ~ TCDIF WDS; 09639100
|
|
END STREAM; 09639200
|
|
DLOC[0] ~ TCDIF INX TIP; 09639300
|
|
WORDSLEFT ~ *P(DUP) - TCDIF; 09639400
|
|
NUMWDS ~ TCW; 09639450
|
|
END; 09639500
|
|
P(RCPRT,DUP,LOD,NUMWDS,DIA 38,DIB 8,TRB 10,XCH,STD); 09639550
|
|
END % TECH C FILE READING 09639600
|
|
ELSE MOVEREC; 09639700
|
|
IF WORDSLEFT { 0 OR UNBLKD THEN REED; 09639800
|
|
P(0,RTN); 09639900
|
|
EOFSETCK: 09640000
|
|
IF ENDFILE THEN TERM(15); 09640100
|
|
ENDFILE ~ TRUE; 09640200
|
|
P(1,RTN); 09640300
|
|
END COBOLIONONDISK; 09640500
|
|
PROCEDURE COBOLIODSK; 09700000
|
|
BEGIN 09700100
|
|
REAL RCW = +0; %USED TO CALL COBOLIONONDSK 09700200
|
|
REAL CODE = -1; % 0=READ,1=WRITE,2=SEEK,6=WRTBLK, 09700300
|
|
NAME DLOC = -2; % POINTS TO BUFFER I/O DESC 09700400
|
|
REAL NUMWDS = -3; % # WDS TO BE WRITTEN 09700500
|
|
%LOCALS 09700600
|
|
INTEGER BS ; % USED IN COMPUTING DISK ADDR 09700700
|
|
REAL COBOLIONONDSK= 14; 09700800
|
|
REAL DEST ; % DESTINATION IN RANDDM MOVE 09700900
|
|
ARRAY FIB [*]; % FIB ARRAY 09701000
|
|
NAME FLOC; % POINTER TO FIB 09701100
|
|
ARRAY FPB = 3[*]; % FILE PARAMETER BLOCK 09701200
|
|
ARRAY H[*]; % DISK FILE HEADER 09701300
|
|
REAL INTINT = 5; % INTRINSIC INTRINSIC 09701400
|
|
NAME MEM = 2; % DUMMY DATA DESC 09701500
|
|
NAME PERFORMER = 13; % USED FOR PERFORMING USE ROUTINES 09701600
|
|
ARRAY PGUSE=24[*]; % PROGRAM USE ROUTINES 09701700
|
|
INTEGER RT ; % USED IN COMPUTING DISK ADDR 09701800
|
|
REAL T; % TEMPORARY 09701900
|
|
INTEGER DAS; % USED TO COMPUTE DISK ADDRESS 09702000
|
|
$ SET OMIT = NOT SHAREDISK 09702004
|
|
DEFINE 09702100
|
|
AF = [12:12]#, % FILE USE ROUTINE 09702200
|
|
ARR = [36:12]#, % REEL USE ROUTINE 09702300
|
|
BCOUNT = FIB[6]#, % BLOCK COUNT 09702400
|
|
BF = [1:11]#, % FILE USE ROUTINE 09702500
|
|
BOUNDED = FIB[9].[2:1]#, % TRUE IF BOUNED FROM ABOVE 09702600
|
|
BREAK = FIB[9] ! 0 # , % BREAKOUT RESTART POINT 09702700
|
|
BREAKOUT = IF(RCOUNT MOD FIB[9])=0 THEN 09702800
|
|
P(0,0,12,COM,DEL,DEL)#,% CALL BREAKOUT 09702900
|
|
BRR = [24:12]#, % REEL USE ROUTINE 09703000
|
|
BUFFNUM = FIB[13].[1:9] #, % # OF BUFFS REQUSTED 09703100
|
|
BUFFSIZE = FIB[18].[3:15]#, % BUFFER SIZE (REQUESTED) 09703200
|
|
BUFFSZ = FIB[18][8:8:10]#, % SIZE FOR CONCATINATES 09703300
|
|
BUFTOP = FIB [16]#, % USED ON I-O AND RANDOM 09703400
|
|
COUNT = FIB[12] #, % USED FOR BLOCKING TECH-A,B09703500
|
|
DINXPRT = P(*RCPRT & TIP [CTC],RCPRT,~)#,%UPDATE POINTER09703600
|
|
DONE = TIP.[19:1] #, % 1= IO COMPLETED 09703700
|
|
DISK = (UT =4)#, % DISK IS UNIT TYPE OF 4 09703800
|
|
ERBIT = FIB[13].[19:1] #, % IOERR 19 NOT YET SPOUTED 09703900
|
|
FLAGINWA = 0[1:1:1]#, % SAYS WE ARE IN WORK AREA 09704000
|
|
FNAM = FIB[4].[13:11]#, % FILE NAME INOEX IN FPB 09704100
|
|
ENDFILE = FIB[5].[40:1] #, % ALREADY PASSED EOF 09704200
|
|
ENDPROCESS = FIB[5].[39:2]#, % SEE OPTIONAL AND ENDFILE 09704300
|
|
EOF =((*DLOC).[27:1])#, % FIRST EOF OR EOT 09704400
|
|
GETSEG = P(FPB[(BS:=FNAM)+3],FPB[BS],FPB[BS+1], 09704500
|
|
T,H,4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL)#, 09704600
|
|
KEY = FIB[15].[12:10]#, % REL PRT LOC OF ACIUAL KEY 09704700
|
|
HAVEWA =(INWA OR FIB[20].[CF]>1)#,% TRUE IF WE ARE NOW 09704800
|
|
%IN WORK AREA OR HAVE MADE IT PRESENT PREVIOUSLY09704900
|
|
HOWOPEN = FIB[5].[41:3]#, % 1=OPEN INPUT,0= OPEN OUTPT09705000
|
|
% 1 > CLOSED 09705100
|
|
INVALIDUSER = FIB[5]<0#, % INVALID USER NOT PARIIY 09705200
|
|
INWA = FIB[20]}0#, % SAYS WE ARE IN WORK AREA 09705300
|
|
INXPRT = P(NUMWDS INX *RCPRT,RCPRT,~)#,% UPDATE POINTER09705400
|
|
IOERR(IOERR1) = P(0,FLOC,IOERR1,17,COM,DEL,DEL,DEL)#, 09705500
|
|
% ABOVE CALLS IOERROR ROUTINE 09705600
|
|
IOMASK = 0&1[19:47:1] #, % USED TO WAIT FOR IOFINISH 09705700
|
|
LASTDONE = FIB[13].[21:1] #, % NOT OF LAST OPERATION DONE09705800
|
|
LBLPTR = FLOC[1] #, % LABEL POINTER 09705900
|
|
LSUBL = FIB [1] #, % LOWER BOUND FOR RANDOM 09706000
|
|
LSUBU = FIB [3] #, % UPPER BOUND FOR DISK REC 09706100
|
|
MABUSE = FIB[4].[1:1]#, % MAY BE USE RTNS PRESENT 09706200
|
|
MAKEPRFSENTWA = P(*RCPRT & 1 [CTC],0,CDC)#, 09706300
|
|
MAXR = FIB[18][8:38:10]#,% MAX REC SZ FOR CONCATS 09706400
|
|
MAXREC = FIB[18].[33:15]#, % MAX REC SZ 09706500
|
|
MINREC = FIB[18].[CF]#, % MINIMUM RECORD SIZE 09706600
|
|
NOAIT = FIB[20].[3:1]#, % AIT FOR WA WAS DESIROYED 09706700
|
|
NUMBUF = FIB[13].[10: 9]#, % NUMBER OF BUFFERS ASSIGNED09706800
|
|
NUMBSPC = H[9].[43:5] #, % NUMBER OF ROWS SPECIFIED 09706900
|
|
NUMREC = FIB[11] #, % RECORDS PER BLOCK 09707000
|
|
OPENIO = FIB[13].[22:1]#, % 1= OPEN INPUT-OUPUT (DISK)09707100
|
|
PARITY = FIB[13].[20:1] #, % IO ERROR OCCURED IN BLOCK 09707200
|
|
PBIT = [2:1]#, % PRESENCE BIT 09707300
|
|
POINTPRTTOBUF = P((*RCPRT OR MEM) & TIP [CTC],RCPRT,~)#, 09707400
|
|
POINTPRTTOWA = P(*RCPRT & FIB[20] [CTC],RCPRI,~)#, 09707500
|
|
PRESENT =((*DLOC).[2:1])#, % CHECKS PRESENTSBIT 09707600
|
|
PROPER =REVERSE+CODE+CODE+21#,%GENERATES PROPER IOERR 09707700
|
|
RCOUNT = FIB[7] #, % RECORD COUNT 09707800
|
|
RCPRT = (FIB[20].[FF])#, %PRT OF DESC POINTING TO REC09707900
|
|
RECPERBLK = H[0].[30:12] #, % RECORDS PER BLOCK 09708000
|
|
REDECWA = P(MKS,RCPRT,MAXREC,1,1,1,INTINT)#, 09708100
|
|
% DECLARE SAVE ARRAY FOR WORK AREA 09708200
|
|
REEDING = ((*DLOC).[24:1])#,%LASI IO WAS READ 09708300
|
|
RESETPANDERBIT = FIB[13]:=*P(DUP)&0[19:19:2]#,%RESET ERR BIIS 09708400
|
|
RESETREADBIT = 0[24:24:1]#, % USED IO TURN OFF READ BIT 09708500
|
|
REVERSE = FIB[5].[44:1] #, % 1=REVERSE INPUT 09708600
|
|
ROWLGTH = H[1]#, % ROW LGTH FROM HEADER 09708700
|
|
SAVEWADDR = FIB[20]~*P(DUP)&*P(RCPRT)[CTC]#,% SAVE ADDRESS09708800
|
|
SERIAL = FIB[4].[27:3]=0 #,% FILE ACCESS = SERIAL 09708900
|
|
SEGPERBLK = H[0].[42:6] #, % SEGMENTS PER BLOCK 09709000
|
|
SETPANDERBIT = FIB[13]:=*P(DUP)&3[19:46:2]#, 09709100
|
|
% SET PARITY AND IOERR 19 BITS 09709200
|
|
SETPRESENTSBIT =P(TIP OR MEM ,DLOC,~)#,% SET PRESENCE BIT 09709300
|
|
SETREADBIT = 1[24:47:1]#, %USED TO TURN READ BII ON 09709400
|
|
$ SET OMIT = NOT(TIMESHARING) 09709500
|
|
SLEEP = 36 #, 09709600
|
|
$ POP OMIT 09709601
|
|
$ SET OMIT = TIMESHARING 09709700
|
|
TECHA =(FIB[5].[46:2]=1)#,% TECHNIQUE-A 09709900
|
|
TERM(TERM1) = P(1,FLOC,TERM1,17,COM)#,%TERMINATE I/O ERROR 09710000
|
|
TIP = (*DLOC) #, % LOAD I/O DESC 09710100
|
|
TOSZF = [8:38:10]#, % TO SIZE FIELD 09710200
|
|
TOTREC = H[7] #, % TOTAL RECORDS ON FILE 09710300
|
|
UT = (FIB[4].[8:4])#, % HARDWARE TYPE 09710400
|
|
WA = P(RCPRT,DIB 0,LOD)#,% LOAD WORK AREA PTR 09710500
|
|
WAITIO = P(DLOC,IOMASK, % THIS SLEEPS ON I/O 09710600
|
|
SLEEP,COM,DEL,DEL)#,% WAITING FOR A COMPLETE 09710700
|
|
WORDSLEFT = FIB[17]#, % WORDS LEFT IN BUFFER 09710800
|
|
WRITBACK = FIB[13].[23:1]#; % FLAG TO SAY WRITE BACK 09710900
|
|
LABEL MOOVE,FLOTE,SEEKRTN,START,READREV; 09711000
|
|
LABEL SERIALIO,SIOEOD,RNDEOD,EOFSETCK; 09711100
|
|
LABEL ERREND,MOOVERR,REREAD,LCKHANDLER; 09711150
|
|
SUBROUTINE GOUSE; % THIS CALLS USE ROUTINES 09711200
|
|
BEGIN 09711300
|
|
P(MKS,T,0,PERFORMER); 09711400
|
|
END GOUSE; 09711500
|
|
SUBROUTINE ERROR; %THIS PROCESSES ALL ERRORS 09711600
|
|
BEGIN 09711700
|
|
IF REEDING AND CODE AND (NUMREC=1) 09711800
|
|
$ SET OMIT = NOT SHAREDISK 09711809
|
|
THEN % SKIP ERROR CODE 09711820
|
|
ELSE BEGIN 09711900
|
|
IF OPENIO THEN IF (T:=RT:=PGUSE[4].ARR) ! 0 THEN 09712000
|
|
GOUSE ELSE ELSE %WAS ERROR ON IO 09712100
|
|
IF REEDING AND (NOT CODE) THEN %READ ERROR 09712200
|
|
IF (T:=RT:=PGUSE[4].BRR) ! 0 THEN 09712300
|
|
GOUSE ELSE ELSE 09712400
|
|
IF (T:=PGUSE[5].BRR) ! 0 THEN GOUSE; %WRITE ERROR 09712500
|
|
IF (T~FIB[15].BF) ! 0 THEN GOUSE; % ERROR ON FILE-N 09712600
|
|
$ SET OMIT = NOT SHAREDISK 09712609
|
|
IF REEDING AND (NOT CODE) THEN 09712700
|
|
BEGIN %CHECK USE PROC FOR 09712800
|
|
IF ERBIT THEN %INPUT ERRORS 09712900
|
|
IF (T OR RT) = 0 THEN IOERR(19); 09713000
|
|
ERBIT := FALSE; 09713100
|
|
END ELSE TERM(20); %WRITE ERR TERM 09713200
|
|
END; 09713300
|
|
ERREND: 09713350
|
|
END ERROR; 09713400
|
|
SUBROUTINE MOVEREC; %MOVES DAIA TO AND FROM WORKAREA 09713500
|
|
BEGIN 09713600
|
|
IF NOT DONE THEN % DONT MOVE TILL IO DONE 09713700
|
|
$ SET OMIT = NOT SHAREDISK 09713709
|
|
WAITIO; 09713750
|
|
IF NOT PRESENT THEN 09713800
|
|
BEGIN %GOT AN ERROR 09713900
|
|
SETPRESENTSBIT; 09714000
|
|
SETPANDERBIT; %SET ERROR FLAGS 09714100
|
|
$ SET OMIT = NOT SHAREDISK 09714104
|
|
IF NOT REEDING THEN 09714200
|
|
BEGIN %ERROR ON OUTPUT 09714300
|
|
DEST := WA; %MOVE FIRST RECORD 09714400
|
|
P(TIP INX 1); %TO WORK AREA 09714500
|
|
GO MOOVE; 09714600
|
|
END; 09714700
|
|
$ SET OMIT = SHAREDISK 09714799
|
|
END; 09714800
|
|
$ POP OMIT 09714801
|
|
$ SET OMIT = NOT SHAREDISK 09714809
|
|
P(BUFTOP INX(BS~NUMWDS|(RCOUNT MOD NUMREC)+ 1)); 09714900
|
|
WA; %MOVE TO/FROM WA 09715000
|
|
DEST ~ IF CODE THEN P(XCH) ELSE P; %FOR READ OR WRITE 09715100
|
|
MOOVE: STREAM(FROM~P:NUMWDS,E~P(DUP).[37:5],DEST~P(*P(.DEST))); 09715200
|
|
BEGIN 09715300
|
|
SI:=FROM; E(DS:=32 WDS; DS:=32 WDS); DS:=NUMWDS WDS;09715400
|
|
END STREAM; 09715500
|
|
P(DEL); 09715600
|
|
IF PARITY THEN 09715700
|
|
BEGIN 09715710
|
|
MOOVERR: ERROR; 09715730
|
|
$ SET OMIT = NOT SHAREDISK 09715739
|
|
END; 09715760
|
|
END MOVEREC; 09715800
|
|
$ SET OMIT = NOT SHAREDISK 09715809
|
|
SUBROUTINE DISKADDRESS; %THIS COMPUIES THE DISK ADDRESS READ & WRIT09715900
|
|
BEGIN 09716000
|
|
RT ~ SEGPERBLK | DAS; % REL SEGMENT NO 09716100
|
|
IF P(RT DIV ROWLGTH,DUP) GEQ NUMBSPC THEN 09716200
|
|
BEGIN 09716210
|
|
$ SET OMIT = NOT SHAREDISK 09716219
|
|
P(1,RTN); 09716240
|
|
END; 09716250
|
|
IF (BS~H[(T~ P + 10)]) = 0 THEN 09716300
|
|
BEGIN 09716400
|
|
GETSEG; 09716500
|
|
IF HOWOPEN!0 THEN IF NOT OPENIO THEN IOERR(22); 09716600
|
|
BS ~ H[T]; 09716700
|
|
END; 09716800
|
|
STREAM( A ~ BS ~ BS + RT MOD ROWLGTH, 09716900
|
|
B~T~BUFTOP.[CF]-(IF CODE THEN 0 ELSE WRITBACK)); 09717000
|
|
BEGIN SI~LOC A; DS~8 DEC; END; 09717100
|
|
$ SET OMIT = NOT SHAREDISK 09717109
|
|
END DISKADDRESS; 09717200
|
|
SUBROUTINE ROTATEBUF; %THIS ROTATES BUFFERS 09717300
|
|
BEGIN 09717400
|
|
IF NUMBUF > 1 THEN 09717500
|
|
P(NUMBUF,DLOC,13,11,COM,DEL,DEL,DEL); 09717600
|
|
WORDSLEFT := BUFFSIZE; 09717700
|
|
RESETPANDERBIT; 09717800
|
|
FIB[16].[CF] := TIP; 09717900
|
|
END ROTATEBUF; 09718000
|
|
SUBROUTINE PREL; % THIS DOES ACTUAL I/D 09718100
|
|
BEGIN 09718200
|
|
P( TIP,DLOC); 09718300
|
|
IF WRITBACK THEN % DO SPECIAL WRITE-IO 09718400
|
|
BEGIN 09718500
|
|
WRITBACK ~ FALSE; % TURN OFF READ BIT 09718600
|
|
DLOC[0]~ TIP&RESETREADBIT;% TO MAKE WRITE 09718700
|
|
END; 09718800
|
|
P(PRL,DEL); % DO I-O 09718900
|
|
IF BREAK THEN BREAKOUT; 09719000
|
|
END PREL; 09719100
|
|
SUBROUTINE REED; %THIS READS BLOCKS 09719200
|
|
BEGIN 09719300
|
|
WORDSLEFT := BUFFSIZE; 09719400
|
|
DLOC[0] := FLAG(BUFTOP & SETREADBIT); %TO RESET IOD 09719500
|
|
CODE ~ P(CODE,0); 09719600
|
|
DISKADDRESS; 09719700
|
|
CODE ~ P; 09719800
|
|
$ SET OMIT = NOT SHAREDISK 09719804
|
|
MEM[BUFTOP INX NOT 2] ~ DAS; % SAVE BLOCK NUMBER 09719900
|
|
PREL; 09720000
|
|
FIB[16].[CF] := TIP; %SAVE BUFF ADDRESS 09720100
|
|
END REED; 09720200
|
|
SUBROUTINE WRIT; %THIS WRITES BLOCKS 09720300
|
|
BEGIN 09720400
|
|
WORDSLEFT := BUFFSIZE; 09720500
|
|
WRITBACK ~ FALSE; 09720600
|
|
DAS := BCOUNT; %BLOCK ADDRESS 09720700
|
|
DLOC[0] := FLAG(BUFTOP & RESETREADBIT); %RESET IOD 09720800
|
|
DISKADDRESS; 09720900
|
|
$ SET OMIT = NOT SHAREDISK 09720904
|
|
PREL; 09721000
|
|
FIB[16].[CF] := TIP; %SAVE BUFF ADDRESS 09721100
|
|
IF NOT(SERIAL) THEN BCOUNT := MEM[BUFTOP INX NOT 2]; 09721120
|
|
END WRIT; 09721200
|
|
SUBROUTINE SEEK; %THIS FINDS AND/OR READS BLOCKS 09721300
|
|
BEGIN 09721400
|
|
IF (DAS ~ RCOUNT DIV NUMREC) = BCOUNT THEN 09721500
|
|
BEGIN 09721510
|
|
$ SET OMIT = NOT SHAREDISK 09721519
|
|
GO SEEKRTN; 09721570
|
|
END; 09721580
|
|
IF SERIAL THEN 09721600
|
|
BEGIN 09721700
|
|
IF NOT HOWOPEN THEN 09721800
|
|
BEGIN %NOT INPUT 09721900
|
|
IF RCOUNT < TOTREC THEN TOTREC := RCOUNT; 09722000
|
|
IF NUMREC > 1 THEN 09722100
|
|
BEGIN %BLOCKED OUTPUI 09722200
|
|
NUMBUF := 1; %FILL ONLY ONE 09722300
|
|
IF (WORDSLEFT<BUFFSIZE) THEN 09722400
|
|
BEGIN 09722405
|
|
IF NOT OPENIO THEN 09722410
|
|
BEGIN % SERIAL OUTPUT - NO ADDR IN BUFF 09722415
|
|
DAS:=P(DAS,BCOUNT); 09722420
|
|
CODE:=P(CODE,1); 09722425
|
|
DISKADDRESS; 09722430
|
|
CODE:=P; DAS:=P; 09722435
|
|
END; 09722440
|
|
WRITBACK:=TRUE; 09722445
|
|
END; 09722450
|
|
END; 09722500
|
|
END; 09722600
|
|
IF NUMBUF ! 1 THEN 09722700
|
|
IF (DAS{COUNT) AND (DAS>BCOUNT) THEN %BLOCK IS PRESENT 09722800
|
|
IF MEM[DLOC[NUMBUF-1] INX NOT 2] = COUNT THEN 09722900
|
|
DAS := COUNT + 1; 09723000
|
|
COUNT := (RCOUNT DIV NUMREC) + NUMBUF - 1; 09723100
|
|
DO BEGIN 09723200
|
|
IF NOT DONE THEN WAITIO; 09723300
|
|
IF NOT PRESENT THEN 09723400
|
|
IF NOT REEDING 09723500
|
|
THEN MOVEREC ELSE SETPRESENTSBIT; 09723600
|
|
IF DAS | NUMREC { LSUBU 09723700
|
|
THEN REED ELSE ROTATEBUF; 09723800
|
|
END UNTIL (DAS := DAS + 1) > COUNT; 09723900
|
|
IF NOT HOWOPEN THEN WAITIO; 09724000
|
|
BCOUNT := DAS ~ DAS - NUMBUF; 09724100
|
|
NUMBUF := BUFFNUM; 09724200
|
|
END ELSE %MUST BE RANDOM 09724300
|
|
IF HOWOPEN OR (NUMREC > 1) 09724400
|
|
$ SET OMIT = NOT SHAREDISK 09724409
|
|
THEN BEGIN % INPUT OR BLOCKED OR LOCK 09724500
|
|
REREAD: 09724550
|
|
IF NUMBUF = 1 THEN % JUST READ DONT TRY TO FIND 09724600
|
|
BEGIN IF NOT DONE THEN 09724700
|
|
$ SET OMIT = NOT SHAREDISK 09724709
|
|
WAITIO; 09724750
|
|
REED; 09724760
|
|
BCOUNT~DAS; 09724770
|
|
END 09724780
|
|
ELSE BEGIN 09724800
|
|
FOR T := 1 STEP 1 UNTIL NUMBUF -1 09724900
|
|
DO %FIND BLOCK IN CORE 09725000
|
|
IF MEM[DLOC[T] INX NOT 2] = DAS THEN 09725100
|
|
$ SET OMIT = SHAREDISK 09725109
|
|
GO FLOTE; 09725110
|
|
$ POP OMIT 09725111
|
|
$ SET OMIT = NOT SHAREDISK 09725119
|
|
IF NOT DONE THEN 09725300
|
|
$ SET OMIT = NOT SHAREDISK 09725309
|
|
WAITIO; 09725390
|
|
REED; %MAKE PRESENT IN CORE 09725400
|
|
FLOTE: IF CODE < 2 09725500
|
|
$ SET OMIT = NOT SHAREDISK 09725549
|
|
THEN BEGIN 09725600
|
|
IF WRITBACK THEN %READ OR 09725700
|
|
BEGIN %WRITE 09725800
|
|
WRIT; 09725900
|
|
DAS := RCOUNT DIV NUMREC; 09726000
|
|
END ELSE ROTATEBUF; 09726100
|
|
WHILE MEM[TIP INX NOT 2] ! DAS 09726200
|
|
DO ROTATEBUF; 09726300
|
|
BCOUNT := DAS; 09726400
|
|
END; 09726500
|
|
END; 09726600
|
|
END; 09726700
|
|
SEEKRTN: 09726800
|
|
ENDFILE := FALSE; 09726900
|
|
WORDSLEFT := BUFFSIZE - ((RCOUNT MOD NUMREC) | NUMWDS); 09727000
|
|
LASTDONE ~ FALSE; % PREVENT SERIALIO OVERWRITE 09727100
|
|
IF CODE = 2 THEN P(XIT); 09727200
|
|
END SEEK; 09727300
|
|
%***% S T A R T Y E E H E R E Y E E D I S K E R S %***% 09727400
|
|
START: 09727500
|
|
FIB := *(FLOC := (NOT 2) INX DLOC); 09727600
|
|
IF NOT DISK THEN 09727700
|
|
BEGIN 09727800
|
|
FLOC := P(.RCW,LOD); 09727900
|
|
FIB ~ ABS(CODE); 09728000
|
|
DEST := P(.DLOC,LOD); 09728100
|
|
BS := NUMWDS; 09728200
|
|
CODE := 1; 09728300
|
|
RCW := DLOC := NUMWDS := 0; 09728400
|
|
P([FLOC],DUP,0,XCH,CFX,STF,1,INX,STS); 09728500
|
|
GO TO P(COBOLIONONDSK); 09728600
|
|
END; 09728700
|
|
H := *[FIB[14]]; 09728800
|
|
$ SET OMIT = NOT SHAREDISK 09728804
|
|
IF CODE.[1:1] THEN 09728815
|
|
BEGIN CODE~ABS(CODE); 09728820
|
|
$ SET OMIT = NOT SHAREDISK 09728824
|
|
END; 09728890
|
|
IF CODE > 2 THEN IF CODE ! 6 THEN TERM(25) ELSE %WRITE BLOCK 09728900
|
|
BEGIN IF HOWOPEN > 1 THEN TERM(37); 09728930
|
|
IF NOT OPENIO THEN IF HOWOPEN THEN TERM(34+REVERSE); 09728960
|
|
$ SET OMIT = NOT SHAREDISK 09728979
|
|
GO EOFSETCK; %WRITES BLOCK:IMMEDIATE-NO ROTATION 09729000
|
|
END; 09729050
|
|
IF HOWOPEN > 1 THEN TERM(31 + CODE); 09729100
|
|
IF CODE = 2 THEN 09729200
|
|
BEGIN RCOUNT~(IF KEY=0 THEN 0 ELSE P(KEY,DIB 0,LOD)) - 1; 09729300
|
|
IF (RCOUNT<LSUBL) OR (RCOUNT>LSUBU) THEN 09729400
|
|
GO EOFSETCK % INVALID KEY 09729500
|
|
ELSE IF INVALIDUSER THEN TERM(0)% DS WITH INVALID USER 09729510
|
|
ELSE SEEK; %ONLY SEEK VALID RECORDS 09729520
|
|
END; 09729600
|
|
IF NOT OPENIO THEN 09729700
|
|
IF (1 - CODE) ! HOWOPEN THEN TERM(PROPER); 09729800
|
|
IF SERIAL THEN % PROCESS SERIAL FILE 09729900
|
|
BEGIN 09730000
|
|
IF OPENIO THEN GO SERIALIO; 09730100
|
|
IF (RCOUNT<LSUBL) OR (RCOUNT>LSUBU) THEN GO EOFSETCK; 09730200
|
|
IF CODE = 0 OR CODE = 2 THEN% READ OR SEEK (SERIAL) 09730210
|
|
IF INVALIDUSER THEN TERM(0); % DS WITH INVALID USER 09730220
|
|
MOVEREC; 09730300
|
|
IF REVERSE THEN GO READREV; 09730400
|
|
IF CODE THEN IF RCOUNT > TOTREC THEN TOTREC := RCOUNT; 09730500
|
|
IF (WORDSLEFT := *P(DUP) - NUMWDS) { 0 THEN 09730600
|
|
BEGIN %BLOCK IS EXHAUSTED 09730700
|
|
IF CODE THEN WRIT ELSE 09730800
|
|
IF (DAS := BCOUNT + NUMBUF) | NUMREC { LSUBU THEN 09730900
|
|
BEGIN %READ AHEAD TO KEEP 09731000
|
|
REED; %BUFFERS READY 09731100
|
|
COUNT := DAS; 09731200
|
|
END ELSE ROTATEBUF; 09731300
|
|
BCOUNT := * P(DUP) + 1; 09731400
|
|
END; 09731500
|
|
RCOUNT := *P(DUP) + 1; 09731600
|
|
IF FALSE THEN % THIS CODE EXECUTED ONLY FOR TAPE 09731700
|
|
READREV: BEGIN % OPEN-REVERSE EQUATED TO DISK 09731800
|
|
IF (WORDSLEFT ~ *P(DUP) - NUMWDS) { 0 THEN 09731900
|
|
BEGIN % BLOCK IS EXHAUSTED 09732000
|
|
IF (DAS ~ BCOUNT - NUMBUF) | NUMREC } LSUBL THEN 09732100
|
|
BEGIN REED; COUNT ~ DAS; 09732200
|
|
END ELSE ROTATEBUF; 09732300
|
|
BCOUNT ~ *P(DUP) - 1; 09732400
|
|
END; 09732500
|
|
RCOUNT ~ *P(DUP) - 1; 09732600
|
|
END REVINPUT; 09732700
|
|
IF KEY ! 0 THEN P(RCOUNT,KEY,DIB 0,ISD); 09732800
|
|
P(0,RTN); 09732900
|
|
% % E N D O F S E R I A L ---- I O N E X T % % 09733000
|
|
SERIALIO: 09733100
|
|
RCOUNT ~ *P(DUP) - (T ~ (CODE AND LASTDONE)); 09733200
|
|
IF (RCOUNT<LSUBL) OR (RCOUNT>LSUBU) THEN GO EOFSETCK; 09733300
|
|
IF CODE = 0 OR CODE = 2 THEN %READ OR SEEK (SERIAL I/O) 09733310
|
|
IF INVALIDUSER THEN TERM(0);% DS WITH INVALID USER 09733320
|
|
IF T THEN WORDSLEFT ~ *P(DUP) + NUMWDS ELSE 09733400
|
|
IF WORDSLEFT { 0 THEN 09733500
|
|
BEGIN %BLOCK IS EXHAUSTED 09733600
|
|
IF (DAS := BCOUNT + NUMBUF) | NUMREC { TOTREC THEN 09733700
|
|
BEGIN %ANOTHER BLOCK 09733800
|
|
REED; % IN SIGHT 09733900
|
|
COUNT := DAS; 09734000
|
|
END ELSE 09734100
|
|
IF WRITBACK THEN % WRITE CURRENT BLOCK 09734200
|
|
WRIT % LESS WE FORGIT 09734300
|
|
ELSE % OR USE NEXT BUFFER 09734400
|
|
ROTATEBUF; % BECAUSE ITS THERE 09734500
|
|
BCOUNT := *P(DUP) + 1; 09734600
|
|
END; 09734700
|
|
IF RCOUNT > TOTREC THEN 09734800
|
|
IF CODE THEN TOTREC ~ RCOUNT ELSE 09734900
|
|
BEGIN CODE~32; GO SIOEOD; END; 09735000
|
|
MOVEREC; 09735100
|
|
SIOEOD: IF (WORDSLEFT := *P(DUP) - NUMWDS) { 0 THEN 09735200
|
|
IF CODE THEN %WROTE LAST RECORD 09735300
|
|
BEGIN % OF YEE BLOCK 09735400
|
|
IF (DAS:=BCOUNT+NUMBUF)|NUMREC { TOTREC THEN 09735500
|
|
BEGIN %READ AHEAD TOO 09735600
|
|
WRITBACK := TRUE; %KEEP BUFFERS FULL 09735700
|
|
REED; 09735800
|
|
COUNT := DAS; 09735900
|
|
END ELSE % WRITE BLOCK NOW 09736000
|
|
WRIT; % ...A WRITE IN TIME... 09736100
|
|
BCOUNT := *P(DUP) + 1; 09736200
|
|
END ELSE 09736300
|
|
ELSE IF CODE THEN WRITBACK := TRUE; %NOT FULL BLK 09736400
|
|
LASTDONE := NOT CODE; 09736500
|
|
IF KEY ! 0 THEN P(RCOUNT,1,+,KEY,DIB 0,ISD); 09736600
|
|
RCOUNT := *P(DUP) + 1; 09736700
|
|
IF CODE=32 THEN GO EOFSETCK ELSE P(0,RTN); 09736800
|
|
END SERIAL; % END OF ALL SERIAL PROCESSING 09736900
|
|
%%% RANDOM AND RANDOM IO START HERE %%% 09737000
|
|
RCOUNT := (IF KEY = 0 THEN 0 ELSE P(KEY,DIB 0,LOD)) - 1; 09737100
|
|
IF (RCOUNT<LSUBL) OR (RCOUNT>LSUBU) THEN GO EOFSETCK; 09737200
|
|
IF CODE = 0 OR CODE = 2 THEN %READ OR SEEK (RDM OR RDM I/O) 09737210
|
|
IF INVALIDUSER THEN TERM(0);% DS WITH INVALID USER 09737220
|
|
IF RCOUNT > TOTREC THEN 09737300
|
|
IF CODE THEN TOTREC ~ RCOUNT ELSE 09737400
|
|
BEGIN CODE ~ 32; GO RNDEOD; END; 09737500
|
|
$ SET OMIT = NOT SHAREDISK 09737549
|
|
IF (DAS ~ RCOUNT DIV NUMREC) ! BCOUNT THEN 09737600
|
|
IF (NUMREC!CODE) 09737700
|
|
THEN SEEK % READ OR BLOCKED WRITE 09737710
|
|
ELSE MEM[BUFTOP INX NOT 2]:=BCOUNT:=DAS; 09737720
|
|
MOVEREC; 09737800
|
|
RNDEOD: WORDSLEFT := *P(DUP) - NUMWDS; 09737900
|
|
IF CODE THEN 09738000
|
|
IF NUMREC = 1 %UNBLOCKED OUTPUT 09738100
|
|
$ SET OMIT = NOT SHAREDISK 09738109
|
|
THEN BEGIN 09738120
|
|
WRIT; 09738140
|
|
$ SET OMIT = NOT SHAREDISK 09738149
|
|
END ELSE 09738200
|
|
WRITBACK ~ TRUE; 09738300
|
|
IF CODE!32 THEN P(0,RTN); 09738400
|
|
EOFSETCK: 09738500
|
|
IF (WORDSLEFT < BUFFSIZE) AND 09738600
|
|
(NOT(HOWOPEN) OR (OPENIO AND WRITBACK)) 09738700
|
|
THEN BEGIN 09738800
|
|
NUMBUF := 1; %WRITE LAST BUFFER 09738900
|
|
WRIT; %AND CHECK FOR 09739000
|
|
WAITIO; %ERRORS 09739100
|
|
NUMBUF := BUFFNUM; 09739200
|
|
IF NOT PRESENT THEN 09739300
|
|
BEGIN 09739400
|
|
SETPRESENTSBIT; 09739500
|
|
$ SET OMIT = NOT SHAREDISK 09739549
|
|
ERROR; 09739600
|
|
END END; 09739700
|
|
IF CODE = 6 THEN P(0,RTN); 09739750
|
|
IF SERIAL AND CODE ! 2 THEN % ONLY 1 EOF ALLOWED 09739800
|
|
IF ENDFILE THEN TERM(15) ELSE ENDFILE ~ TRUE; 09739900
|
|
IF CODE = 32 THEN % CLEAR WORK AREA 09740000
|
|
BEGIN H ~ WA; % IF READ BEYOND EOF 09740100
|
|
FOR RT ~ 0 STEP 1 UNTIL (NUMWDS-1) DO H[RT] ~ 0; 09740200
|
|
END; 09740300
|
|
IF CODE ! 2 THEN % LET PROGRAM KNOW ITS EOF 09740400
|
|
BEGIN 09740410
|
|
$ SET OMIT = NOT SHAREDISK 09740419
|
|
P(1,RTN); 09740430
|
|
END ELSE 09740440
|
|
LASTDONE ~ FALSE; % PREVENT SERIALIO OVERWRITE 09740500
|
|
%%% END OF EOF CHECKING 09740600
|
|
END OF COBOL DISK INTRINSICS; 09740700
|
|
PROCEDURE INTERRUPTER; % EXECUTION FORCED BY SOFTWARE INTERRUPT CODE AT09800000
|
|
BEGIN % INITIATE. INTERRUPTER PROCESSES ENABLED 09800100
|
|
REAL ADDR=+1, % INTERRUPTS IN SFINTQ. AN IP1 HAS JUST BEEN 09800200
|
|
I =+2, % EXECUTED, POINTING REG-F AND REG-S IO THE 09800300
|
|
NOTDONE=+3, % STACK COPY OF THE OLD INCW. 09800400
|
|
DONE=+4; 09800500
|
|
REAL PERFORMGEN=13; 09800700
|
|
ARRAY TSKA =22[*], % TASK ARRAY 09800750
|
|
% CONTENTS OF TSKA[8]: 09800755
|
|
% [1:1]=1 IFF INTERRUPTER HAS JUSI RUN AND 09800760
|
|
% SFINTQ IS NON-EMPTY 09800765
|
|
% [2:1]=1 IFF SFINTQ IS NON-EMPTY 09800770
|
|
% [3:1]=1 IFF INTERRUPTER IS RUNNING 09800775
|
|
% [4:1]: SFINTQ INIERLOCK BIT 09800780
|
|
% [FF] = ADDRESS OF OLD IRCW 09800785
|
|
% [CF] = RELATIVE PRT ADDRESS OF FIRST IN LINKED 09800790
|
|
% LIST OF DECLARLD INTERRUPTS 09800795
|
|
SFINTQ =27[*], % SOFTWARE INTERRUPT QUEUE 09800800
|
|
PRTBASE =10[*]; 09800900
|
|
LABEL AGAIN; 09800920
|
|
DEFINE IMASK = @200000000000000#; 09800940
|
|
% * * * * * * * * * * * S T A R T H E R E * * * * * * * * * * * * * * 09800950
|
|
TSKA[8] ~ ABS(*P(DUP)) & 1 [3:47:1]; 09800955
|
|
IF NOT TSKA[8].[4:1] THEN P([TSKA[8]],IMASK,2,COM,DEL,DEL); 09800970
|
|
TSKA[8].[4:1] ~ 0; 09800980
|
|
P(0,0,0,0); 09801000
|
|
AGAIN: WHILE I<SFINTQ.[8:10] DO 09801100
|
|
BEGIN IF SFINTQ[I]!0 THEN % VALID ENTRY 09801150
|
|
IF M[SFINTQ[I]+1]<0 % LINK WORD 09801200
|
|
THEN NOTDONE ~ 1 % SKIP DISABLED INTERRUPT 09801300
|
|
ELSE % PERFORM ENABLED INTERRUPT 09801400
|
|
BEGIN ADDR ~ SFINTQ[I]; 09801410
|
|
TSKA[8] ~ *P(DUP) OR IMASK; 09801420
|
|
P(MKS,ADDR-PRTBASE.[CF],0,PERFORMGEN); 09801450
|
|
IF NOT TSKA[8].[4:1] THEN 09801460
|
|
P([TSKA[8]],IMASK,2,COM,DEL,DEL); 09801470
|
|
TSKA[8].[4:1] ~ 0; 09801480
|
|
SFINTQ[I] ~ 0; 09801500
|
|
DONE ~ 1; 09801600
|
|
END; 09801700
|
|
I ~ I+1; 09801800
|
|
END; 09801900
|
|
IF DONE THEN BEGIN I ~ DONE ~ NOTDONE ~ 0; GO AGAIN; END; 09801950
|
|
TSKA[8].[1:4] ~ 12|NOTDONE + 1; 09802000
|
|
P(47,COM); 09802100
|
|
END INTERRUPTER; 09802200
|
|
COMMENT DO NOT PUT ANY DECLARATIONS PAST THIS POINT OR THE CONTROL 99998000
|
|
STATE PROCEDURE WHATINTRNSIC WILL PROBABLY HANG THE SYSTEM; 99998010
|
|
PROCEDURE WHATINTRINSIC; 99998020
|
|
BEGIN 99998030
|
|
LABEL L; 99998040
|
|
P(XIT); P(.L,DEL); 99998050
|
|
L::: 99998100
|
|
"INTRINS", 99998200
|
|
"ICS @@", 99998300
|
|
"XVI.0.@", 99998400
|
|
% PATCH LEVEL ON NEXT CARD PLEASE 99998500
|
|
"00@@@@@", 99999000
|
|
$ SET OMIT = NOT(TIMESHARING) 99999100
|
|
" INCLUD", 99999840
|
|
"ES @@@@", 99999850
|
|
"TIMESHA", 99999860
|
|
"RING@@@", 99999870
|
|
$ POP OMIT 99999880
|
|
"~ "; 99999890
|
|
END WHATINTRINSIC; 99999900
|
|
END. 99999990
|