mirror of
https://github.com/retro-software/B5500-software.git
synced 2026-01-13 15:17:03 +00:00
Release emulator version 0.17:
1. Enable (finally!) functioning of P2, the second processor, in CentralControl and Processor. 2. Fix bugs in Character Mode syllables FAD, FSU: initial compare of operands was alphanumeric instead of numeric. 3. Fix bugs in Character Mode syllables TRN, TRZ, TBN: non-boundary destination words were not being fetched into the B register. 4. Enable configuration of additional tape drives (up to the maximum of 16). 5. Implement new flip-flop latching mechanism in CentralControl for use by B5500Console. 6. Optimize clearing of interrupts in Central Control. 7. Implement preliminary mechanism to allow P2 to be added to the configuration temporarily without altering B5500SystemConfiguration.js. 8. Implement new average slack and delay algorithms in Processor.schedule(). 9. Optimize some Character Mode syllables by substituting local variables for "this" properties. 10. Fix bugs in Processor single-precision divide syllables leaving the stack in an incorrect state after a divide by zero in Control State. 11. Further minor tweaks to performance throttling. 12. Optimize references to this.cc in Processor.run(). 13. Minor improvements to B5500MagTapeDrive: eliminate oscillation at load point, improve timing of rewind operations. 14. Implement build-release.cmd script to generate emulator release archive files. 15. Commit initial Mark-XVI TSSINT transcription from Fausto Saporito.
This commit is contained in:
Paul Kimpel
parent
44dc63133e
commit
f07b2579e1
@ -23927,3 +23927,191 @@ ONE: BEGIN STREAM(I: F~"ENDPACK", D~M[ALPHA-2]);% 38711000
|
||||
I~TALLY;% 38716000
|
||||
END;% 38717000
|
||||
IF NOT P THEN% 38718000
|
||||
BEGIN BLASTQ(U);% 38719000
|
||||
DO UNTIL WAITIO(M[ALPHA-2],@40,U)!0;% 38720000
|
||||
GO TO ONE;% 38721000
|
||||
END;% 38722000
|
||||
END;% 38723000
|
||||
BLASTQ(U); 38724000
|
||||
CC:: 38725000
|
||||
M[M[ALPHA-2] INX NOT 3].[9:6]:=0; 38726000
|
||||
LABELTABLE[U]~-@14; 38730000
|
||||
RDCTABLE[U]~0; 38731000
|
||||
IF 32{U AND U{63 THEN PSEUDOCOPY~PSEUDOCOPY+1; 38732000
|
||||
INDEPENDENTRUNNER(P(..CONTROLCARD),(M[ALPHA-2].[CF])& 38732100
|
||||
$ SET OMIT = NOT(DATACOM AND RJE ) 38732199
|
||||
U[2:42:6]&JAR[P1MIX,6][1:1:1], 38732300
|
||||
192); 38732400
|
||||
GO CLOSEOUT;% 38733000
|
||||
CP: EMPTY;% 38735000
|
||||
IF NOT UNLABELED THEN P(WAITIO(M[ALPHA-2],0,U),DEL);% 38736000
|
||||
SETNOTINUSE(U,FORMS OR PUNCHLCK); 38737000
|
||||
GO CLOSEOUT;% 38738000
|
||||
LP: EMPTY;% 38740000
|
||||
IF SEPARATE THEN P(WAITIO(@4000100000,0,U),DEL) %150-38741000
|
||||
ELSE P(WAITIO(@4002000000,0,U),DEL); %150-38741100
|
||||
IF NOT UNLABELED THEN P(WAITIO(M[ALPHA-2],0,U),DEL);% 38742000
|
||||
IF NOT SEPARATE THEN P(WAITIO(@4000100000,0,U),DEL); %150-38742100
|
||||
SETNOTINUSE(U,FORMS); 38743000
|
||||
GO CLOSEOUT;% 38744000
|
||||
SP: IF STATE.[43:1] THEN COOLOFF ELSE EMPTY;% 38746000
|
||||
GO CLOSEOUT;% 38747000
|
||||
MT: IF NOT STATE.[41:1] THEN% 38749000
|
||||
BEGIN IF STATE.[43:1] THEN% 38750000
|
||||
BEGIN COOLOFF; BLASTQ(U);% 38751000
|
||||
IF NOT REW THEN 38752000
|
||||
BEGIN T~@1000000140000005&STATE[22:44:1];% 38753000
|
||||
IF I}NBUFS THEN DO UNTIL WAITIO(T,@377,U).[42:1]; 38754000
|
||||
IF NOT UNLABELED THEN 38754100
|
||||
P(WAITIO(T,@377,U),DEL); 38755000
|
||||
END;% 38756000
|
||||
END ELSE% 38757000
|
||||
BEGIN EMPTY;% 38758000
|
||||
EOFIT: T~@1737000000000000;% 38759000
|
||||
P(WAITIO([T],@40,U),DEL);% 38760000
|
||||
IF NOT UNLABELED THEN% 38761000
|
||||
BEGIN;STREAM(BC~FIB[6],RC~FIB[7],D~M[ALPHA-2]);% 38762000
|
||||
BEGIN SI~LOC BC; DI~DI+40;% 38763000
|
||||
DS~5 dec; DS~7 DEC;% 38764000
|
||||
END;% 38765000
|
||||
P(WAITIO(M[ALPHA-2],@40,U),DEL);% 38766000
|
||||
P(WAITIO([T],@40,U),DEL);% 38767000
|
||||
T~@1000000340000005;% 38768000
|
||||
P(WAITIO(T,@40,U) ,DEL);% 38769000
|
||||
END;% 38770000
|
||||
END;% 38771000
|
||||
END ELSE% 38772000
|
||||
IF FIB[18].[1:1]THEN BEGIN FIB[18].[1:1]~FIB[16]~0; 38773000
|
||||
FIB[10].[3:15]:=0; GO EOFIT END; 38773100
|
||||
IF REW THEN% 38774000
|
||||
BEGIN P(WAITIO(@4200000000,@377,U),DEL);% 38775000
|
||||
STATE.[40:1]~0;% 38776000
|
||||
END ELSE STATE.[40:1]~NOT STATE.[44:1];% 38777000
|
||||
PX: IF REL THEN% 38778000
|
||||
BEGIN SETNOTINUSE(U,0); 38779000
|
||||
STATE.[41:2]~1;% 38780000
|
||||
END ELSE STATE.[41:2]~2;% 38781000
|
||||
IF LOCK THEN% 38782000
|
||||
BEGIN SETNOTINUSE(U,1); 38783000
|
||||
STATE.[41:2]~1;% 38784000
|
||||
END;% 38785000
|
||||
IF U LSS 16 THEN 38786000
|
||||
IF PURGE THEN% 38787000
|
||||
BEGIN IF PRNTABLE[U]<0 THEN% 38788000
|
||||
BEGIN RDCTABLE[U].[8:6]~0; %538-38788500
|
||||
INDEPENDENTRUNNER(P(.PURGEID),U,64) 38789000
|
||||
END %538-38789050
|
||||
ELSE SETNOTINUSE(U,0); 38789100
|
||||
STATE.[41:2]~2;% 38790000
|
||||
END;% 38791000
|
||||
GO TO CLEANUP;% 38792000
|
||||
PP:: IF NOT STATE.[41:1] THEN% 38794000
|
||||
BEGIN EMPTY; P(WAITIO(@2004500000000,@40,U),DEL) END;% 38795000
|
||||
GO TO PX; 38796000
|
||||
PR:: IF NOT STATE.[41:1] THEN BEGIN COOLOFF; BLASTQ(U) END;% 38798000
|
||||
IF REW THEN P(WAITIO(@10340000000,@377,U),DEL);% 38799000
|
||||
GO TO PX;% 38800000
|
||||
CD:: 38802000
|
||||
IF M[ALPHA].[27:1] THEN MOVE(10,FIB[16].[33:15],M[ALPHA-2]) ELSE 38803000
|
||||
EOD: DO UNTIL READMEFROMDISK(CIDROW[U-32],M[ALPHA-2]); 38804000
|
||||
$ SET OMIT = PACKETS 38804999
|
||||
IF JAR[P1MIX,0]<0 AND PRT[P1MIX,21]!0 OR JAR[P1MIX,1]<0 THEN 38806000
|
||||
BEGIN 38806050
|
||||
$ SET OMIT = NOT(PACKETS) 38806099
|
||||
PACKETERR[U-32]:=TRUE; 38806200
|
||||
IF CIDTABLE[U-32,3] LEQ CIDTABLE[U-32,7] THEN 38806300
|
||||
$ POP OMIT 38806301
|
||||
BEGIN STREAM(E~"ENDWAIT": Q~@14, D~M[ALPHA-2]); 38807000
|
||||
BEGIN SI~LOC Q; SI~SI+7; IF SC!DC THEN DI~DI+1; Q~DI; SI~Q; 38808000
|
||||
L: IF SC=" " THEN BEGIN SI~SI+1; GO TO L END; 38809000
|
||||
DI~LOC E; DI~DI+1; IF 3 SC!DC THEN TALLY~1; 38810000
|
||||
$ SET OMIT = NOT(PACKETS) 38810099
|
||||
IF TOGGLE THEN 38810100
|
||||
BEGIN SI~SI-3; IF 4 SC=DC THEN TALLY~0; END; 38810200
|
||||
$ POP OMIT 38810201
|
||||
E~TALLY; 38810500
|
||||
END; 38811000
|
||||
IF P THEN GO TO EOD; 38812000
|
||||
END; 38813000
|
||||
END; 38813100
|
||||
KIND~0; 38814000
|
||||
GO TO CC; 38815000
|
||||
CLOSEOUT:: STATE.[39:4]~1; TIME~1; 38817000
|
||||
CLEANUP:: CLOSED: DK: BKUP: DC: 38818000
|
||||
P(P&RCW[CTC],0,RDS,0,XCH,P&P[CTF],STF); 38819000
|
||||
END OTHER CLOSE; 38820000
|
||||
PROCEDURE FILEOPEN(XTRA,ALPHA); 39000000
|
||||
VALUE ALPHA,XTRA; INTEGER ALPHA,XTRA; 39000100
|
||||
BEGIN REAL RCW=+0;% 39001000
|
||||
REAL IOM=IOMASK, IOMASK; 39001100
|
||||
REAL XTRAR=-4,XTRAC=-6; 39001200
|
||||
INTEGER NBUFS,FNUM,RLEN,TYPE,IO,BLEN,U,KIND, 39002000
|
||||
MODE,DIREC,FORMS,COBOL,UNLABELED,OPTIONAL,CNTCTL; 39003000
|
||||
REAL T1,T2,MASK,STATE; 39004000
|
||||
REAL MFID,FID; INTEGER REEL,CDATE,CYCLE; %KEEP THESE TOGETHER 39004100
|
||||
ARRAY FIB[*],FPB[*];% 39005000
|
||||
INTEGER ACCESS,FIB7; 39006000
|
||||
LABEL DCIN,PBS; 39006100
|
||||
LABEL DC19; 39006800
|
||||
LABEL DKRN,SPN,DKSN,DKUN,DKPN,DCN; 39007000
|
||||
SWITCH INSW~DKRN,SPN,DKSN,DKUN,DCIN; 39008000
|
||||
LABEL LOOK,EXIT,LOOKOUT,LPS,FINALIN,FINALOUT,SPDC;% 39009000
|
||||
REAL SUBROUTINE DSED; DSED:=TERMSET(P1MIX); 39009050
|
||||
REAL SUBROUTINE CNTLBITS;% 39026000
|
||||
CNTLBITS~IOMASK&MODE[21:47:1]&DIREC[22:47:1]&CNTCTL[23:47:1]39027000
|
||||
&IO[24:47:1]&(KIND=7 OR KIND>9 AND KIND{12)[20:47:1] 39028000
|
||||
&(IF KIND=1OR KIND=7OR KIND=12THEN@20ELSE 0)[27:42:6];39029000
|
||||
SUBROUTINE MAKEIODS;% 39031000
|
||||
BEGIN FIB[16]~T1~((BLEN-1)|DIREC+M[ALPHA])&CNTLBITS[18:18:15]% 39032000
|
||||
&(IF BLEN{1023 THEN BLEN ELSE 1023)[838:10]% 39033000
|
||||
&TINU[IF (KIND=7 OR KIND=12) THEN IF TYPE<20 39034000
|
||||
THEN 20 ELSE 22 ELSE 39034050
|
||||
IF KIND=11 THEN 23 ELSE U][3:3:5] OR M; 39034100
|
||||
FIB[19]~(IF STATE.[46:2]=0 THEN (DIREC INX T1)% 39035000
|
||||
&(2|DIREC+(BLEN>1023)+1)[3:43:5] ELSE% 39036000
|
||||
IF STATE.[46:2]=1 THEN ((NOT RLEN INX 2)|DIREC INX T1)39037000
|
||||
&RLEN[8:38:10]&(3|DIREC+2)[3:43:5] ELSE% 39038000
|
||||
(1-DIREC INX T1)&RLEN[8:38:10]&(DIREC+6)[3:43:5])% 39039000
|
||||
&IO[25:47:1];% 39040000
|
||||
IF NOT (IO OR COBOL)THEN% 39041000
|
||||
T1~FIB[19]&T1[3:3:5]&0[25:25:1];% 39042000
|
||||
FIB[10],[3:15]~M[ALPHA]-2; %HEAD OF BUFFER RING 39042100
|
||||
T2~T1.[33:15]-M[ALPHA];% 39043000
|
||||
FOR MASK~0 STEP 1 UNTIL NBUFS-1 DO% 39044000
|
||||
BEGIN %P 39045000
|
||||
M[ALPHA+MASK]~FLAG((P(DUP,LOD)+T2)&P(T1,XCH)[33:33:15]);% 39046000
|
||||
END;% 39047000
|
||||
END MAKEIODS;% 39048000
|
||||
LABEL DKR0,SPO,DKS0,DKU0,DKP0,DC0; 39049000
|
||||
SWITCH OUTSW~DKR0,SPO,DKS0,DKU0,DC0;% 39050000
|
||||
LABEL FIXFIB,FIND,SPACER;% 39054000
|
||||
LABEL PREFINAL,DK1;% 39055000
|
||||
ARRAY HEADER[*];% 39056000
|
||||
REAL TOG; 39056100
|
||||
LABEL AGN; 39056500
|
||||
FIB~M[ALPHA-3]; FPB~PRT[P1MIX,3];% 39083000
|
||||
IOMASK:=IOM; 39083100
|
||||
NBUFS~FIB[13].[1:9]; FNUM~FIB[4].[13:11]; BLEN~FIB[18].[3:15];% 39084000
|
||||
TYPE~FPB[FNUM+3].[43;5];% 39085000
|
||||
STREAM(S ~ [FPB[FNUM+2]], D ~ [REEL]);% 39086000
|
||||
BEGIN SI:=S;DS:=3OCT;DS:=5OCT;DS:=OCT END;% 39087000
|
||||
P(CDATE, RSB, .CDATE,~); 39087100
|
||||
IF FPB[FNUM+4]>0 THEN REEL ~ CDATE ~ CYCLE ~ 0; 39087500
|
||||
MODE~FIB[13].[24:1]; IO~FIB[13].[27:1]; RLEN~FIB[18].[33:15];% 39088000
|
||||
DIREC~FIB[13].[25:1]; FORMS~FPB[FNUM+3].[42:1];% 39089000
|
||||
STATE~FIB[5]; UNLABELED~FIB[4].[2:1]; 39090000
|
||||
MFID~FPB[FNUM]; FOD~FPB[FNUM+1]; OPTIONAL~FIB[4].[5:1];% 39091000
|
||||
COBOL~(FIB[13] AND 1)&([FIB].[8:10]=22)[1:47:1]; % COBOL 60 & 68 39091100
|
||||
KIND~FIB[4].[8:4]; IF FIB[13].[28:10]!0 THEN REEL~FIB[13].[28:10]; 39092000
|
||||
IF COBOL>0 OR FIB[4].[7:1] THEN % COBOL 60 OR SORT 39092010
|
||||
M[FIB INX NOT 1].[3:6]~2 39092020
|
||||
ELSE M[ALPHA-7].[3:6]~2; 39092030
|
||||
$ SET OMIT = NOT(DATACOM AND RJE ) 39092039
|
||||
IF TYPE=19 THEN GO TO DC19 ELSE 39092045
|
||||
IF TYPE=26 THEN GO TO DKPN ELSE 39092050
|
||||
IF TYPE>26 THEN GO TO DCN; 39092055
|
||||
IF (TYPE=0 AND NOT IO) OR TYPE GTR 20 THEN 39092060
|
||||
BEGIN IF USEPBD 39092070
|
||||
$ SET OMIT = NOT(DATACOM AND RJE ) 39092074
|
||||
THEN TYPE:=22; GO TO LOOKOUT; 39092080
|
||||
END; 39092090
|
||||
|
||||
690
Mark-XVI/SYMBOL/TSSINT.esp_m
Normal file
690
Mark-XVI/SYMBOL/TSSINT.esp_m
Normal file
@ -0,0 +1,690 @@
|
||||
% I N T R I N S I C S M A R K XVI.0.00 10/01/74
|
||||
COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE *
|
||||
* FILE ID: SYMBOL/INTRINS TAPE ID: SYMBOL1/FILE000 *
|
||||
* THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION *
|
||||
* AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED *
|
||||
* EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON *
|
||||
* WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF *
|
||||
* BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 *
|
||||
* *
|
||||
* COPYRIGHT (C) 1971, 1972, 1974 *
|
||||
* BURROUGHS CORPORATION *
|
||||
* AA320206 AA393180 AA332366 *;
|
||||
BEGIN
|
||||
DEFINE ETRLNG = 5#,
|
||||
INTDESC(INTDESC1) = FLAG(INTDESC1 & 85[1:41:7]) #,
|
||||
INTCALL(INTCALL1,INTCALL2) = P(INTCALL2 & 85[1:41:7],
|
||||
INTCALL1,COC) #,
|
||||
CALLINT(CALLINT1) = P(CALLINT1 & 85[1:41:7],XCH,COC) #,
|
||||
COBOLDCI= @167 #,
|
||||
FORTERRI= @134 #,
|
||||
EXPI = @20 #,
|
||||
LNI = @17 #,
|
||||
DEXPI = @77 #,
|
||||
DLOGI = @101 #,
|
||||
CABSI = @53 #,
|
||||
SINI = @14 #,
|
||||
SQRTI = @13 #,
|
||||
ATAN2I = @114 #,
|
||||
DMODI = @65 #,
|
||||
DSINI = @105 #,
|
||||
DSQRTI = @123 #,
|
||||
XTOII = @6 #,
|
||||
CXTOII = @56 #,
|
||||
COSI = @15 #,
|
||||
TANI = @111 #,
|
||||
ARCTANI = @16 #,
|
||||
DATANI = @113 #,
|
||||
ARSINI = @116 #,
|
||||
GAMMAI = @126 #,
|
||||
EDITIT(EDITIT1,EDITIT2,EDITIT3,EDITIT4,EDITIT5) = P(MKS,
|
||||
EDITIT1,EDITIT2,EDITIT3,(-1),(EDITIT4),(EDITIT5),
|
||||
@153&85[1:41:7],XCH,COC) #,
|
||||
% EDITIT(BUFFADDRESS,FIELDWIDTH(W),TYPE,LOWPART,HIGHPART)
|
||||
% WILL EDIT THE VALUE (LOWPART,HIGHPART) INTO A FIELD
|
||||
% STARTING AT BUFFADDRESS. EDITIT RETURNS THE ENDING
|
||||
% ADDRESS. THE WIDTH OF THE EDITED FIELD IS CONSTRAINED
|
||||
% TO W CHARACTERS (EDITED VALUE IS RIGHT JUSTIFIED WITH
|
||||
% LEADING BLANKS IF W IS LARGER THAN NEEDED) -- BUT IF
|
||||
% W=0, THEN EDITIT WILL ADJUST THE FIELD WIDTH TO
|
||||
% ACCOMODATE FULL NUMERICAL SIGNIFICANCE. TYPE=2 => EDITIT
|
||||
% WILL CHOOSE BETWEEN REAL, INTEGER, AND DOUBLEPRECISION
|
||||
% EDITING (DOUBLEPRECISION IS USED IF LOWPART!0).
|
||||
% TYPE=1 => USE ONLY INTEGER, TYPE=3 => USE ONLY REAL,
|
||||
% TYPE=4 => USE ONLY LOGICAL, TYPE=5 => USE ONLY DOUBLE-
|
||||
% PRECISION.
|
||||
CTC = 33:33:15#,
|
||||
CTF = 18:33:15#,
|
||||
FTC = 33:18:15#,
|
||||
FTF = 18:18:15#,
|
||||
CF = 33:15#,
|
||||
FF = 18:15#;
|
||||
REAL JUNK = 5;
|
||||
NAME MEM=2, M=2, MEMORY=2 ;
|
||||
REAL BLKCNTRL = 5;
|
||||
DEFINE DUMPNOW(DUMPNOW1)=P(DUMPNOW1,0,48,COM,DEL,DEL)#,
|
||||
TRACENOW(TRACENOW1,TRACENOW2)=
|
||||
P(TRACENOW1,1,TRACENOW2 ,+ ,48,COM,DEL,DEL)#;
|
||||
PROCEDURE OUTPUTINT(TEN, FILX, CHSKP, LNSKP, FI, FRMT, LISX);% %WF
|
||||
VALUE CHSKP, LNSKP, FI, LISX;% %WF
|
||||
NAME FILX;% %WF
|
||||
ARRAY TEN[*], FRMT[*];% %WF
|
||||
REAL LISX;% %WF
|
||||
INTEGER CHSKP, LNSKP, FI;% %WF
|
||||
FORWARD;% CODE=00200000, INTRINSIC NUMBER=@ 1 %WF
|
||||
PROCEDURE INTRINSIC(DUPE, D, NUMDIM, SIZE, TYPE);% %WF
|
||||
VALUE DUPE, D, NUMDIM, SIZE, TYPE;% %WF
|
||||
NAME D;% %WF
|
||||
ARRAY DUPE[*];% %WF
|
||||
INTEGER NUMDIM, SIZE, TYPE;% %WF
|
||||
FORWARD;% CODE=00400000, INTRINSIC NUMBER=@ 2 %WF
|
||||
PROCEDURE INPUTINT(TEN, FILX, DKADR, ACT,% %WF
|
||||
FI, FRMT, LISX, EOFL, PARL);% %WF
|
||||
VALUE ACT, FI;% %WF
|
||||
NAME FILX, LISX;% %WF
|
||||
ARRAY TEN[*], FRMT[*];% %WF
|
||||
REAL EOFL, PARL;% %WF
|
||||
INTEGER DKADR, ACT, FI;% %WF
|
||||
FORWARD;% CODE=00600000, INTRINSIC NUMBER=@ 3 %WF
|
||||
PROCEDURE DISKSORT(T1, T2, RELA, ENDQ, BINGO, IPFIDX,% %WF
|
||||
OUTPRO, INPRO, OUTF, INF, OPTOG, IPTOG, DKO, DKI,% %WF
|
||||
TP1, TP2, TP3, TP4, TP5, NT, HIVALU, EQUALS,% %WF
|
||||
R, ALFA, CORESIZE, DISKSIZE);% %WF
|
||||
VALUE OPTOG, IPTOG, NT, HIVALU, EQUALS, R, ALFA,% %WF
|
||||
CORESIZE, DISKSIZE;% %WF
|
||||
NAME TP1, TP2, TP3, TP4, TP5;% %WF
|
||||
REAL T1, T2, RELA, ENDQ, BINGO, IPFIDX, OUTPRO, INPRO,% %WF
|
||||
OUTF, INF, DKO, DKI, NT, HIVALU, EQUALS, CORESIZE;% %WF
|
||||
BOOLEAN OPTOG, IPTOG, ALFA;% %WF
|
||||
INTEGER R, DISKSIZE;% %WF
|
||||
FORWARD;% CODE=00700000, INTRINSIC NUMBER=@ 4 %WF
|
||||
REAL PROCEDURE DUMPINT(SN, CV, BV, TIPE,% %WF
|
||||
TENS, ALFA, CHAR, FIEL, FORMT);% %WF
|
||||
VALUE SN, CV, BV, TIPE, TENS, ALFA, CHAR, FORMT;% %WF
|
||||
NAME FIEL;% %WF
|
||||
REAL SN, CV, BV, TIPE, TENS, ALFA, CHAR, FORMT;% %WF
|
||||
FORWARD;% CODE=42000000, INTRINSIC NUMBER=@ 5 %WF
|
||||
PROCEDURE XTOTHEIINT(BASE, EXPON, M, LOG, EXP);% %WF
|
||||
VALUE BASE, EXPON, M, LOG, EXP;% %WF
|
||||
REAL BASE, EXPON, M, LOG, EXP;%
|
||||
FORWARD;% CODE=42254000, INTRINSIC NUMBER=@ 6
|
||||
REAL PROCEDURE ABSINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@ 7
|
||||
REAL PROCEDURE SIGNINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@10
|
||||
INTEGER PROCEDURE ENTIERINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@11
|
||||
REAL PROCEDURE TIMEINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@12
|
||||
PROCEDURE SQRTINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@13
|
||||
PROCEDURE SININT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@14
|
||||
PROCEDURE COSINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@15
|
||||
REAL PROCEDURE ARCTANINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@16
|
||||
PROCEDURE LNINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@17
|
||||
REAL PROCEDURE EXPINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@20
|
||||
REAL PROCEDURE GOTOSOLVERINT(L, X, F, B);%
|
||||
VALUE L, X, F, B;%
|
||||
ARRAY F[*];%
|
||||
REAL L, X, B;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@21
|
||||
PROCEDURE ALGOLWRITE(TEN, FILX, CHSKP, LNSKP, FI, AEXP,%
|
||||
ARRY, LINESKIP, CHANSKIP, SUPRS, NUMWDS, TANK);%
|
||||
VALUE CHSKP, LNSKP, FI, AEXP, LINESKIP,%
|
||||
CHANSKIP, SUPRS, NUMWDS, TANK;%
|
||||
NAME FILX, TANK;%
|
||||
ARRAY TEN[*], ARRY[*];%
|
||||
INTEGER CHSKP, LNSKP, FI, AEXP, LINESKIP,%
|
||||
CHANSKIP, SUPRS, NUMWDS;%
|
||||
FORWARD;% CODE=00100100, INTRINSIC NUMBER=@22
|
||||
PROCEDURE ALGOLREAD(TEN, FILX, DKADD, ACT, FI, AEXP,%
|
||||
ARRY, EOFL, PARL, DKADR, CODE, TANK);%
|
||||
VALUE ACT, FI, AEXP, DKADR, CODE, TANK;%
|
||||
NAME FILX, TANK;%
|
||||
ARRAY TEN[*], ARRY[*];%
|
||||
REAL DKADD, EOFL, PARL, DKADR, CODE;%
|
||||
INTEGER ACT, FI, AEXP;%
|
||||
FORWARD;% CODE=00500000, INTRINSIC NUMBER=@23
|
||||
PROCEDURE ALGOLSELECT(ACT1, ACT2, TANK, I);%
|
||||
VALUE ACT1, ACT2, TANK, I;%
|
||||
NAME TANK;%
|
||||
INTEGER ACT1, ACT2, I;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@24
|
||||
PROCEDURE COBOLFCR;%
|
||||
FORWARD;% CODE=43000000, INTRINSIC NUMBER=@25
|
||||
PROCEDURE COBOLID;% % GO TO 02700000
|
||||
FORWARD;% CODE=43230000, INTRINSIC NUMBER=@26
|
||||
PROCEDURE POLYMERGE(T1, T2, T3, ENDQ, BINGO, IPFIDX,%
|
||||
OUTPRO, INPRO, OUTF, INF, OPTOG, IPTOG, DKO, DKI,%
|
||||
TP1, TP2, TP3, TP4, TP5, NT, HIVALU, EQUALS,%
|
||||
R, ALFA, CORESIZE, DISKSIZE);%
|
||||
VALUE OPTOG, IPTOG, NT, HIVALU, EQUALS, R, ALFA,%
|
||||
CORESIZE, DISKSIZE;%
|
||||
NAME TP1, TP2, TP3, TP4, TP5;%
|
||||
REAL T1, T2, T3, ENDQ, BINGO, IPFIDX, OUTPRO, INPRO,%
|
||||
OUTF, INF, DKO, DKI, NT, HIVALU, EQUALS, R, CORESIZE;
|
||||
BOOLEAN OPTOG, IPTOG, ALFA;%
|
||||
INTEGER DISKSIZE;%
|
||||
FORWARD;% CODE=40140000, INTRINSIC NUMBER=@27
|
||||
PROCEDURE STATUSINT(T, C);%
|
||||
VALUE T, C;%
|
||||
REAL T;%
|
||||
INTEGER C;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@30
|
||||
REAL PROCEDURE MAXINT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@31
|
||||
REAL PROCEDURE MININT(X);%
|
||||
VALUE X;%
|
||||
REAL X;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@32
|
||||
PROCEDURE DELAYINT(ARRY, MASK, TIME);%
|
||||
VALUE ARRY, MASK, TIME;%
|
||||
ARRAY ARRY[*];%
|
||||
REAL MASK;%
|
||||
INTEGER TIME;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@33
|
||||
PROCEDURE SUPERMOVERINT(SORCE, DEST, AEXP);%
|
||||
VALUE AEXP;%
|
||||
ARRAY SORCE[*], DEST[*];%
|
||||
INTEGER AEXP;%
|
||||
FORWARD;% CODE= INTRINSIC NUMBER=@34
|
||||
PROCEDURE SISO; FORWARD; %INT#35,SEQ#08400000
|
||||
INTEGER PROCEDURE DELTA(P1,P2);%INT#36,SEQ#00022300
|
||||
VALUE P1,P2; INTEGER P1,P2; FORWARD;
|
||||
PROCEDURE ICVD; FORWARD; %INT#37,SEQ#00022500
|
||||
PROCEDURE DYNAMICDIALER(B, A, X, F);
|
||||
VALUE B, A, X, F;
|
||||
INTEGER B, A, X; BOOLEAN F;
|
||||
FORWARD;% CODE=00022700, INTRINSIC NUMBER=@40
|
||||
PROCEDURE SCAN(UPDPDD,PRT,UPDCDD,HISCOUNT,CASECODE,CHAR);
|
||||
VALUE PTR, HISCOUNT, CASECODE, CHAR;
|
||||
NAME UPDPDD, UPDCDD;
|
||||
INTEGER PTR, HISCOUNT, CASECODE, CHAR;
|
||||
FORWARD;
|
||||
PROCEDURE REPL; FORWARD; %INT#42,SEQ#08420000
|
||||
PROCEDURE COMPARE;FORWARD; %INT#43,SEQ#08430000
|
||||
PROCEDURE BASICPRINT(TYPE);
|
||||
VALUE TYPE;
|
||||
REAL TYPE;
|
||||
FORWARD; CODE=08500000, INTRINSIC NUMBER=@44
|
||||
PROCEDURE SWAP; FORWARD; %INT#45,SEQ#00023700
|
||||
PROCEDURE BASICINPUT(TYPES);
|
||||
VALUE TYPES;
|
||||
REAL TYPES;
|
||||
FORWARD;% CODE=08700000, INTRINSIC NUMBER=@46
|
||||
PROCEDURE READATA(TYPE);
|
||||
VALUE TYPE;
|
||||
REAL TYPE;
|
||||
FORWARD;% CODE=08600000, INTRINSIC NUMBER=@47
|
||||
PROCEDURE FTINT ; FORWARD; % 050
|
||||
PROCEDURE FTOUT ; FORWARD; % 051
|
||||
PROCEDURE DABS ; FORWARD; % 052
|
||||
PROCEDURE CABS ; FORWARD; % 053
|
||||
PROCEDURE AINT ; FORWARD; % 054
|
||||
PROCEDURE MATH ; FORWARD; % 055
|
||||
PROCEDURE XTOI ; FORWARD; % 056
|
||||
PROCEDURE IDINT ; FORWARD; % 057
|
||||
PROCEDURE FLOAT ; FORWARD; % 060
|
||||
PROCEDURE SNGL ; FORWARD; % 061
|
||||
PROCEDURE DBLE ; FORWARD; % 062
|
||||
PROCEDURE AMOD ; FORWARD; % 063
|
||||
PROCEDURE TIME ; FORWARD; % 064
|
||||
PROCEDURE DMOD ; FORWARD; % 065
|
||||
PROCEDURE DMAX1 ; FORWARD; % 066
|
||||
PROCEDURE DMIN1 ; FORWARD; % 067
|
||||
PROCEDURE SIGNV ; FORWARD; % 070
|
||||
PROCEDURE DSIGN ; FORWARD; % 071
|
||||
PROCEDURE DIIM ; FORWARD; % 072
|
||||
PROCEDURE REALP ; FORWARD; % 073
|
||||
PROCEDURE AIMAG ; FORWARD; % 074
|
||||
PROCEDURE CMPLX ; FORWARD; % 075
|
||||
PROCEDURE CONJG ; FORWARD; % 076
|
||||
PROCEDURE DEXP ; FORWARD; % 077
|
||||
PROCEDURE CEXP ; FORWARD; % 100
|
||||
PROCEDURE DLOG ; FORWARD; % 101
|
||||
PROCEDURE CLOG ; FORWARD; % 102
|
||||
PROCEDURE ALOG10; FORWARD; % 103
|
||||
PROCEDURE DLOG10; FORWARD; % 104
|
||||
PROCEDURE DSIN ; FORWARD; % 105
|
||||
PROCEDURE CSIN ; FORWARD; % 106
|
||||
PROCEDURE DCOS ; FORWARD; % 107
|
||||
PROCEDURE CCOS ; FORWARD; % 110
|
||||
PROCEDURE TANF ; FORWARD; % 111
|
||||
PROCEDURE COTAN ; FORWARD; % 112
|
||||
PROCEDURE DATAN ; FORWARD; % 113
|
||||
PROCEDURE ATAN2 ; FORWARD; % 114
|
||||
PROCEDURE DATAN2; FORWARD; % 115
|
||||
PROCEDURE ARSIN ; FORWARD; % 116
|
||||
PROCEDURE ARCOS ; FORWARD; % 117
|
||||
PROCEDURE SINH ; FORWARD; % 120
|
||||
PROCEDURE COSH ; FORWARD; % 121
|
||||
PROCEDURE TANH ; FORWARD; % 122
|
||||
PROCEDURE DSQRT ; FORWARD; % 123
|
||||
PROCEDURE CSQRT ; FORWARD; % 124
|
||||
PROCEDURE ERF ; FORWARD; % 125
|
||||
PROCEDURE GAMMA ; FORWARD; % 126
|
||||
PROCEDURE ALGAMA; FORWARD; % 127
|
||||
PROCEDURE ANDI ; FORWARD; % 130
|
||||
PROCEDURE ORI ; FORWARD; % 131
|
||||
PROCEDURE CMPL ; FORWARD; % 132
|
||||
PROCEDURE EQUIVP; FORWARD; % 133
|
||||
PROCEDURE FORTERR;FORWARD; % 134
|
||||
PROCEDURE MAX; FORWARD; % 135
|
||||
PROCEDURE MIN; FORWARD; % 136
|
||||
PROCEDURE IMOD; FORWARD; % 137
|
||||
PROCEDURE CONCAT; FORWARD; % 140
|
||||
PROCEDURE CONCAT;
|
||||
FORWARD;% CODE=08400000, INTRINSIC NUMBER=@140
|
||||
PROCEDURE MATRIXDIDDLER(A, B, C, TYPE);
|
||||
VALUE A, B, C, TYPE;
|
||||
ARRAY A[*], B[*], C[*];
|
||||
INTEGER TYPE;
|
||||
FORWARD;% CODE=08800000, INTRINSIC NUMBER=@~4~
|
||||
PROCEDURE INVERT(A, B);
|
||||
VALUE A, B;
|
||||
ARRAY A[*], B[*];
|
||||
FORWARD;% CODE=09100000, INTRINSIC NUMBER=@142
|
||||
PROCEDURE TRANSPOSE(A, B);
|
||||
VALUE A, B;
|
||||
ARRAY A[*], B[*];
|
||||
FORWARD;% CODE=08900000, INTRINSIC NUMBER=@143
|
||||
PROCEDURE MATRIXMULTIPLY(A, B, C);
|
||||
VALUE A, B, C;
|
||||
ARRAY A[*], B[*], C[*];
|
||||
FOWARD;% CODE=09000000, INTRINSIC NUMBER=@144
|
||||
PROCEDURE RANDOM(NUMBER, BASE);
|
||||
VALUE NUMBER;
|
||||
REAL NUMBER;
|
||||
INTEGER BASE;
|
||||
FORWARD;% CODE=00022900, INTRINSIC NUMBER=@145
|
||||
PROCEDURE FORTRANFREEREAD;
|
||||
FORWARD;% CODE=09200000, INTRINSIC NUMBER=@146
|
||||
PROCEDURE BASICLOSE(FILX);
|
||||
VALUE FILX; NAME FILX;
|
||||
BEGIN REAL SELECT=14, ALGOLWRITE=12; ARRAY AIT=6[*];
|
||||
REAL T,I; ARRAY FIB[*]; NAME M=2;
|
||||
SUBROUTINE MAYBEPRINT;
|
||||
BEGIN FIB:=FILX[NOT 2];
|
||||
IF FIB[5].[41:3]=0 THEN %NOT CLOSED-NOT INPUT
|
||||
IF FIB[4].[8:4] NEQ 10 THEN %NOT DATA COM
|
||||
IF FIB[20].[3:15]!0 THEN % DATA LEFT
|
||||
P(MKS,1,0,0,(FIB[20].[18:10]+1),FILX,ALGOLWRITE);
|
||||
END;
|
||||
IF P(.FILX,LOD)=0 THEN %EOJ FILE CLOSE
|
||||
BEGIN I:=AIT[0]+1; WHILE (T:=AIT[I:=I-1]).[8:10] NEQ 0
|
||||
DO IF T.[1:1] THEN
|
||||
BEGIN FILX:=M[M[T.[18:15]] INX 4]; MAYBEPRINT END;
|
||||
END ELSE %FILE RESTORE
|
||||
BEGIN MAYBEPRINT;
|
||||
P(MKS,2,0,[FILX[NOT 2]],4,SELECT);
|
||||
FIB[0]:=FIB[8]:=FIB[20]:=FIB[21]:=0;
|
||||
END;
|
||||
END BASIC FILE RESTORE;
|
||||
PROCEDURE FILEATTRIBUTES(T,E,D,V,G,I,TN); VALUE T,I,V,D,G; REAL D,G,I,E;
|
||||
INTEGER V; ARRAY TN[*]; NAME T; FORWARD; % CODE @ 0043000, INT # @150
|
||||
PROCEDURE COBOLDECIMALTOOCTALCONVERT(A); % INT #=@151, CODE=09300000
|
||||
VALUE A; NAME A; FORWARD ;
|
||||
PROCEDURE COBOLOCTOLTODECIMALCONVERT(A,L,H,R,N,S,T); % INT #=@152
|
||||
VALUE L,H,R,N,S,T; REAL L,H,R,N,S,T; NAME A; FORWARD; % CODE=09400000
|
||||
PROCEDURE FORTRANFREEWRITE(F,D,R,W,L,I,N,S); VALUE I,D,R,W,L; INTEGER R,
|
||||
W; REAL I,D,L; NAME F; ARRAY S[*],N[*]; FORWARD ;%COD @02976019.INT@153
|
||||
PROCEDURE FINNAME; FORWARD;
|
||||
PROCEDURE FOUTNAME; FORWARD;
|
||||
PROCEDURE FTINTFIX(F1,D2,F2,F3,L1,E1,E2,P1); VALUE D1,F2,L1,E1,E2,P1 ;
|
||||
REAL D1,F2,L1,E1,E2,P1; ARRAY F3[*]; NAME F1; FORWARD; % INTRINSIC @156
|
||||
PROCEDURE FTOUTFIX(F,D,R,Q,L,E,EL,PL); VALUE D,R,L,E,EL,PL; REAL D,R,L,E
|
||||
,EL,PL; NAME F; ARRAY Q[*]; FORWARD ; % CODE AT SEQ # 02886040, INT@157
|
||||
PROCEDURE FBINBACKBLOCK(F1,D,F2,F3,L,E1,E2,P1); VALUE D,F2,L,E1,E2,P1 ;
|
||||
REAL D,F2,L,E1,E2,P1; ARRAY F3[*]; NAME F1; FORWARD; % INT # @160.
|
||||
PROCEDURE COBOLVARSZ; FORWARD;% CODE=09500000 INT #=@161
|
||||
PROCEDURE COBOLIONONDSK; FORWARD;% CODE=096000000 INT #=@162
|
||||
PROCEDURE COBOLIODSK; FORWARD;% CODE=09700000 INT #=@163
|
||||
PROCEDURE FORTRANMEMHANDLER(A,H);VALUE H;REAL H;ARRAY A[*];FORWARD;%164
|
||||
PROCEDURE COBOLATT; FORWARD; % CODE = 02650000 INT # = @165 %CJC 103I
|
||||
PROCEDURE INTERRUPTER; FORWARD; % CODE=09800000; INT #=@166
|
||||
PROCEDURE COBOLDC; FORWARD; % CODE = 02690000 INT #=@167
|
||||
INTEGER PROCEDURE DELTA(P1,P2); VALUE P1,P2; REAL P1,P2; %@036
|
||||
BEGIN
|
||||
DEFINE
|
||||
DOT=[18:13]#, AMPER=[18:35:13]#;
|
||||
COMMENT @4000000=2|20, WHICH IS 1 LARGER THAN ANY 6500 COUNT.;
|
||||
COMMENT DELTA=2|20 IF DESC(P1)!DESC(P2) OR CSIZE-S ARE !;
|
||||
IF (P2-P1).[31:17]!0 THEN DELTA~@4000000 ELSE
|
||||
DELTA~P2.DOT-P1.DOT;
|
||||
END DELTA;
|
||||
|
||||
PROCEDURE ICVD; %37
|
||||
BEGIN
|
||||
DEFINE DOT=[18:13]#, AMPER=[18:35:13]#, CSIZE=[31:02]#,SIX=0#;
|
||||
ARRAY STRING[*];
|
||||
NAME M = 2;
|
||||
REAL PTR=-3; INTEGER N=-1;
|
||||
IF PTR.CSIZE!SIX THEN POLISH(M&1[17:47:01],9999,CDC,DEL);
|
||||
STRING ~ M[PTR];
|
||||
N~N; COMMENT MAKE SURE N IS INTEGERIZED;
|
||||
IF N>8 THEN POLISH(M&1[14:47:01],N,CDC,DEL);
|
||||
POLISH([STRING[(PTR.DOT+N-1).[35:10]]], DEL);
|
||||
STREAM(RESULT~0:S~[STRING[PTR.[18:10]]], N,
|
||||
SKS~PTR.[28:03]);
|
||||
BEGIN
|
||||
DI ~ LOC RESULT;
|
||||
SI ~ S; SI ~ SI+SKS
|
||||
DS ~ N OCT;
|
||||
END;
|
||||
PTR ~ P;
|
||||
END ICVD;
|
||||
PROCEDURE DYNAMICDIALER(A,B,X,F) ;
|
||||
VALUE B, A, X, F;
|
||||
INTEGER B, A, X; BOOLEAN F;
|
||||
BEGIN % A,B,X,Y,Z ARE AS IN Y&Z[A:B:X].
|
||||
% F=TRUE => X WAS LITERAL, AND TRB WILL BE DONE AFTER XITING.
|
||||
REAL Y=-7, Z=-6, C=+1 ;
|
||||
DEFINE Q= @3403007777777777 #, % MASK FOR ZERO-ING OUT THE G,H,K&V-
|
||||
% REGISTER PARTS OF THE ROW.
|
||||
R= @0055005500610065 #, % NOP,DIA,DIB,TRB.
|
||||
S= @0055703404210435 #; % NOP,LITC Y,STD,XIT.
|
||||
IF (A~A)<1 OR (B~B)<1 OR (X~X)<1 OR X+A>48 OR X+B>48
|
||||
THEN P((-63),26,COM) ;
|
||||
IF F THEN P(Q,AND,0&(B MOD 6)[4:9:3],A MOD 6,DIB 7,TRB 3,
|
||||
P&(B DIV 6)[12:45:3],A DIV 6,DIB 15,TRB 3,OR,0,0,XIT) ;
|
||||
GO P(P(R)&(B DIV 6)[12:45:3],A DIV 6,DIB 24,TRB 3,P&(B MOD 6)
|
||||
[15:9:3],A MOD 6,DIB 27,TRB 3,P&X[36:42:6],.A,~,S,.B,~,Y,Z,[A]);
|
||||
END DYNAMICDIALER;
|
||||
|
||||
|
||||
PROCEDURE RANDOM(NUMBER, BASE);
|
||||
VALUE NUMBER;
|
||||
REAL NUMBER;
|
||||
INTEGER BASE;
|
||||
BEGIN INTEGER N;
|
||||
REAL T;
|
||||
IF (T := NUMBER MOD 1.0)>0 THEN
|
||||
BEGIN BASE := T.[9:38]; P(RTN); END;
|
||||
IF NUMBER!0 THEN
|
||||
BEGIN T := POLISH(1, 1, COM);
|
||||
N := 0 & T[10:36:6] & T[16:42:6] & T[22:30:6]
|
||||
& ((T.[30:18])|P(DUP))[28:22:20];
|
||||
END ELSE IF (N := BASE)=0 THEN N := @2631353020000;
|
||||
T := 3 & (N.[10:26]|6137 + 2197513)[10:12:36];
|
||||
POLISH((((BASE := T) OR 0.5) - 0.5) + P(DUP), RTN);
|
||||
END RANDOM;
|
||||
|
||||
|
||||
PROCEDURE SWAP; % 045
|
||||
BEGIN
|
||||
ARRAY A = -2 [*,*], B = -1 [*,*];
|
||||
STREAM(A, B, CA~0, CB~0, FA~A.[18:15], FB~B.[18:15]);
|
||||
BEGIN
|
||||
SI ~ A; CA ~ SI;
|
||||
SI ~ B; CB ~ SI;
|
||||
DI ~ LOC B; DI ~ DI+5; SKIP 3 DB;
|
||||
SI ~ LOC CA; SI ~ SI+5; SKIP 3 SB;
|
||||
3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); DS ~ 2 CHR;
|
||||
DI ~ DB; SI ~ LOC B; DS ~ WDS;
|
||||
DI ~ LOC A; DI ~ DI+5; SKIP 3 DB;
|
||||
SI ~ LOC CB; SI ~ SI+5; SKIP 2 SB;
|
||||
3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); DS ~ 2 CHR;
|
||||
DI ~ FA; SI ~ LOC A; DS ~ WDS;
|
||||
END;
|
||||
END SWAP;
|
||||
|
||||
|
||||
|
||||
|
||||
COMMENT ALGOL WRITE INTRINSIC;%
|
||||
PROCEDURE ALGOLWRITE(TEN, FILX, CHSKP, LNSKP, FI, AEXP,
|
||||
ARRY, LINESKIP, CHANSKIP, SUPRS, NUMWDS, TANK);
|
||||
VALUE LINESKIP, CHANSKIP, SUPRS, NUMWDS, TANK,
|
||||
CHSKP, LNSKP, FI, ARRY;
|
||||
INTEGER CHSKP, LNSKP, FI, AEXP,
|
||||
LINESKIP, CHANSKIP, NUMWDS, SUPRS;
|
||||
NAME FILX, TANK;
|
||||
ARRAY ARRY[*], TEN[*];
|
||||
BEGIN REAL SELECT=14,REED=13,ADDRESS;%
|
||||
NAME MEM=2;%
|
||||
LABEL AB,ACTION;
|
||||
LABEL DS,WINDUP1;
|
||||
ARRAY FPB=3[*],FIB[*],HEADER[*];%
|
||||
INTEGER I,RSIZE;%
|
||||
INTEGER SPOUT;
|
||||
ARRAY TINK=TANK[*];
|
||||
REAL CHNSKP=CHANSKIP;
|
||||
REAL ALGOLWRITE=12;
|
||||
DEFINE FNUM = FIB[4].[11:31] #;
|
||||
$ SET OMIT = NOT(TIMESHARING)
|
||||
SUBROUTINE WAIT; POLISH(TANK, @2000000000, 36, COM, DEL DEL);
|
||||
$ POP OMIT
|
||||
$ SET OMIT = TIMESHARING
|
||||
LABEL ERR,LP1,MT1,CLOSED,DK1,SP1,CP1,DC1,PP1;%
|
||||
LABEL DCN1,DCN2,SPIN;
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
SWITCH SW1~ ERR,LP1,MT1,CLOSED,DK1,SP1,CP1,LP1,PP1,ERR,DC1,
|
||||
ERR,LP1,DCN1;
|
||||
LABEL LP2,MT2,DK2,SP2,CP2,DC2,PP2;%
|
||||
SWITCH SW2~ ERR,LP2,MT2,ERR,DK2,SP2,CP2,LP2,PP2,ERR,DC2,ERR,
|
||||
LP2,DCN2;
|
||||
LABEL DS1,DR1,DU1;%
|
||||
SWITCH DSW1~DS1,DR1,DU1,CLOSED;
|
||||
LABEL UT,PBIT,DWT,D19,RELEASE,STA,EXIT,L1,WINDUP,DBIT;%
|
||||
LABEL TYPEU,TYPEA,TYPEC;%
|
||||
SWITCH TYPE~TYPEU,TYPEA,ERR,TYPEC;%
|
||||
LABEL DS2,DR2,DU2;%
|
||||
SWITCH DSW2~DS2,DR2,DU2;%
|
||||
SUBROUTINE BLOCK;%
|
||||
BEGIN GO TO TYPE[I~FIB[5].[46:2]];%
|
||||
TYPEC: STREAM(D1~IOD,S~(NUMWDS~NUMWDS+1)|8,%
|
||||
D2~(TANK[0]~NUMWDS INX IOD));%
|
||||
BEGIN SI~LOC S; DI~DI-8; DS~4 DEC; DI~D1;%
|
||||
SI~D2; SI~SI-8; DI~DI-4; DS~4 CHR;%
|
||||
END;%
|
||||
IF (FIB[17]~FIB[17]-NUMWDS)>RSIZE+1 THEN BEGIN%
|
||||
OWT: FIB[7]~FIB[7]+1; P(XIT);%
|
||||
TYPEA: IF (FIB[17]~FIB[17]-RSIZE)}RSIZE THEN%
|
||||
BEGIN TANK[0]~RSIZE INX IOD; GO OWT END END;%
|
||||
NUMWDS~FIB[18].[18:5]-FIB[17]+(I=3);%
|
||||
TYPEU: END BLOCK;%
|
||||
REAL SUBROUTINE DISKADDRESS;%
|
||||
BEGIN%
|
||||
ADDRESS~(CHANSKIP DIV HEADER[0].[30:12])|HEADER[0].[42:6];%
|
||||
IF (SUPRS~ADDRESS DIV HEADER[1]+10)}30 THEN
|
||||
BEGIN P(0); GO TO EXIT END;
|
||||
IF HEADER[SUPRS]=0 THEN
|
||||
IF HEADER[9]>(SUPRS-10) THEN%
|
||||
P(FPB[FNUM+3],FPB[FNUM],FPB[FNUM+1],SUPRS,HEADER,
|
||||
4,11,COM,DEL,DEL,DEL,DEL,DEL,DEL) ELSE
|
||||
BEGIN P(0); GO TO EXIT END;%
|
||||
ADDRESS~HEADER[SUPRS]+SUPRS+ADDRESS MOD HEADER[1];%
|
||||
STREAM(D~[ADDRESS]); BEGIN SI~D; DS~8 DEC END; P(1);%
|
||||
EXIT: DISKADDRESS~P;%
|
||||
END DISKADDRESS;%
|
||||
IF TINK=0 THEN %WF
|
||||
BEGIN FIB ~ FILX[NOT 2]; %WF
|
||||
IF FIB[5].[11:2]<2 THEN P(MKS,"WRITING",FILX,7,SELECT) ;
|
||||
IF FIB[5].[43:1] THEN
|
||||
P(MKS, CHSKP, 0, FILX, 1, SELECT);
|
||||
IF LNSKP>1 AND ARRY{0 AND (I~FIB[4].[8:4])!1
|
||||
$ SET OMIT = NOT(TIMESHARING)
|
||||
AND I!7 AND I!12 AND I!10 THEN
|
||||
$ SET OMIT = TIMESHARING
|
||||
P(XIT);%CARRIAGE CONTROL ON NON-PRINTER FILE
|
||||
|
||||
|
||||
RSIZE ~ P(MKS, LNSKP, CHSKP, SUPRS, %WF
|
||||
(-1), FILX, ALGOLWRITE); %WF
|
||||
IF ARRY{0 THEN SUPRS ~ 1 ELSE %WF
|
||||
BEGIN % 11/24/72 - CORRECTED 10/3/73
|
||||
IF ARRY.[8:10]=P(DUP,0) THEN % INDEXED WRITE
|
||||
P(DEL,AEXP) % WRITE MIN(AEXP,RSIZE) WORDS
|
||||
ELSE % WRITE MIN(ARRY, SIZE,AEXP,RSIZE) WORDS
|
||||
IF P GTR P(DUP,AEXP) %
|
||||
THEN P(DEL,AEXP); %WF
|
||||
IF P(DUP)}RSIZE THEN P(DEL) ELSE RSIZE ~ P; %WF
|
||||
STREAM(P4 ~ [ARRY[0]], P3 ~ RSIZE, %WF
|
||||
P2 ~ P(DUP).[36:6], P1 ~ *FILX); %WF
|
||||
END; %WF
|
||||
END; %WF
|
||||
IF RSIZE>0 THEN P(MKS, LNSKP, %WF
|
||||
CHSKP, SUPRS, RSIZE, FILX, ALGOLWRITE); %WF
|
||||
FILX[NOT 4] ~ FILX[NOT 3] ~ 0; %WF
|
||||
P(XIT); %WF
|
||||
END; %WF
|
||||
FIB~TANK[NOT 2];%
|
||||
UT: I~FIB[4].[8:4]; RSIZE~FIB[18].[33:15];%
|
||||
SPOUT:=(I=5);
|
||||
$ SET OMIT = TIMESHARING
|
||||
IF CHNSKP.[4:1] THEN
|
||||
BEGIN CHNSKP.[4:1]~0;
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
END;
|
||||
IF NUMWDS<0 THEN GO TO SW1[I]; GO TO SW2[I];%
|
||||
LP1: MT1: SP1: CP1: PP1:
|
||||
%
|
||||
D19: IF IOD.[19:1] THEN%
|
||||
PBIT: IF IOD.[2:1] THEN P(RSIZE,RTN) ELSE%
|
||||
IF IOD.[25:1] THEN%
|
||||
CLOSED: BEGIN
|
||||
FIB[13].[27:1]~0;
|
||||
IF (I~(FPB[FNUM+3] AND 31)!10 AND I!12
|
||||
AND I!13 AND I!26 THEN FIB[5].[45:1]~0 ELSE
|
||||
FIB[5].[45:1]~P(TANK[NOT 3],DUP)!0 AND P(XCH)!15;
|
||||
P(TANK,0,11,COM,DEL,DEL) ;
|
||||
IF NOT FIB[5].[45:1] THEN GO UT ;
|
||||
P(TANK[NOT 3]); TANK[NOT 3]~TANK[NOT 4]~0 ;
|
||||
P(MKS,9,BLKCNTRL,DEL) ;% TAKE PARITY ACTION LBL BRNCH.
|
||||
P(1); GO TO DS;
|
||||
END ELSE
|
||||
IF IOD.[27:1] AND (I=2 OR I=7 OR I=8) THEN%
|
||||
BEGIN IF NOT FIB[4].[2:1] THEN%
|
||||
BEGIN HEADER~TANK[NOT 1];HEADER[4].[42:6]~1 END;
|
||||
IF I=7 THEN FIB[9].[1:1]~1; % MULTI-REEL PBT FILE
|
||||
I~FIB[13].[28:10]+1;%
|
||||
P(MKS,6,0,(NOT 2) INX TANK,4,SELECT);%
|
||||
FIB[13].[28:10]~I; GO TO CLOSED;%
|
||||
END ELSE%
|
||||
BEGIN
|
||||
ERR: P(3);
|
||||
DS: P(TANK,XCH,11,COM);
|
||||
END;
|
||||
WAIT; GO TO PBIT;%
|
||||
DK1: HEADER~*[FIB[14]]; GO TO DSW1[FIB[4].[27:3]];%
|
||||
DK2: HEADER~*[FIB[14]]; GO TO DSW2[FIB[4].[27:3]];%
|
||||
CP2: BLOCK; TANK[0]~FLAG(FIB[16])&CHANSKIP[32:47:1]; GO TO RELEASE;%
|
||||
LP2: IF SUPRS THEN STREAM(RSIZE,D~IOD); BEGIN RSIZE(DS~8 LIT " ") END;
|
||||
CHANSKIP~CHANSKIP+LINESKIP.[45:1];
|
||||
IF CHANSKIP!0 THEN%
|
||||
BEGIN IF (I~FIB[17]-RSIZE)>0 THEN%
|
||||
STREAM(I,D~RSIZE INX IOD); BEGIN I(DS~8 LIT " ") END;%
|
||||
END ELSE BLOCK;%
|
||||
TANK[0]~FLAG(FIB[16])&LINESKIP[27:47:1]&LINESKIP[28:46:1]%
|
||||
&CHANSKIP[29:44:4]&NUMWDS[8:38:10];%
|
||||
GO TO RELEASE;%
|
||||
SP2: PP2:%
|
||||
MT2: BLOCK;%
|
||||
P(TANK[0]~FLAG(FIB[16])&NUMWDS[8:38:10],NUMWDS,XCH,INX,%
|
||||
@3700000000000000,XCH,~);%
|
||||
IF SPOUT THEN % SPO OUTPUT
|
||||
IF FPB[FNUM+3].[42:6]=43 THEN P(XIT) ELSE %DUMMY
|
||||
P(0,0,NOT,IOD,INX,15,COM,XIT)
|
||||
ELSE
|
||||
RELEASE: P(FLAG(FIB[19])&IOD[3:3:5],TANK,PRL,DEL);%
|
||||
WINDUP: I~FIB[19].[33:15]-FIB[16].[33:15];%
|
||||
FIB[16].[33:15]~SUPRS~MEM[P(DUP) INX NOT 1].[18:15];%
|
||||
FIB[19].[33:15]~SUPRS+I;%
|
||||
WINDUP1:
|
||||
FIB[6]~FIB[6]+1; FIB[7]~FIB[7]+1; FIB[17]~FIB[18].[18:15];%
|
||||
P(XIT);%
|
||||
DU1:%
|
||||
DS1: IF LINESKIP!0 THEN%
|
||||
BEGIN IF IOD.[27:1] AND IOD.[19:1] THEN GO AB;
|
||||
IF FIB[17]=FIB[18].[18:15] THEN
|
||||
BEGIN CHANSKIP~FIB[7];%
|
||||
L1: IF DISKADDRESS THEN%
|
||||
IF IOD.[19:1] THEN DBIT: IF IOD.[2:1] THEN%
|
||||
BEGIN
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
MEM[FIB[16]]~ADDRESS;
|
||||
P(RSIZE,RTN);
|
||||
END ELSE
|
||||
IF IOD.[25:1] THEN GO TO CLOSED ELSE
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
BEGIN
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
GO TO AB;
|
||||
END ELSE
|
||||
BEGIN WAIT; GO TO DBIT; END ELSE
|
||||
BEGIN
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
GO TO AB;
|
||||
END;
|
||||
END; P(RSIZE,RTN);%
|
||||
END;%
|
||||
P(MKS,CHANSKIP,4,TANK,1,SELECT); GO TO L1;
|
||||
DS2: IF FIB[7]>HEADER[7] THEN HEADER[7]~FIB[7];%
|
||||
BLOCK; TANK[0]~FLAG(FIB[16]); GO RELEASE;%
|
||||
DR1: IF LINESKIP!0 THEN CHANSKIP~FIB[7] ELSE FIB[7]~CHANSKIP;%
|
||||
IF HEADER[7]<CHANSKIP THEN HEADER[7]~CHANSKIP;%
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
IF FIB[5].[46:2]=0 THEN GO TO L1;%
|
||||
IF DISKADDRESS THEN%
|
||||
BEGIN FIB[16].[24:1]~1;%
|
||||
$ SET OMIT = SHAREDISK
|
||||
P(MKS,CHANSKIP+1,1,TANK,REED,RTN);%
|
||||
$ SET POP OMIT
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
END;%
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
GO TO AB;
|
||||
DR2:
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
TANK[0]~FLAG(FIB[16])&0[24:24:1];
|
||||
P(FLAG(FIB[19])&IOD[3:3:5]&1[27:47:1],TANK,PRL,DEL);%
|
||||
$ SET OMIT = NOT SHAREDISK
|
||||
GO TO WINDUP;%
|
||||
DU2:: FIB[5].[43:2]~2;%
|
||||
IF FIB[7]>HEADER[7] THEN HEADER[7]~FIB[7];%
|
||||
BLOCK;%
|
||||
CHANSKIP~FIB[7]+FIB[13].[10:9]|HEADER[0].[30:12];%
|
||||
IF DISKADDRESS THEN%
|
||||
BEGIN P(TANK[0]~FLAG(FIB[16])&0[24:24:1],(NOT 0),XCH,INX,%
|
||||
ADDRESS,XCH,~);%
|
||||
P(FLAG(FIB[19])&1[24:47:1],TANK,PRL,DEL);%
|
||||
END ELSE%
|
||||
BEGIN TANK[0]~FLAG(FIB[16])&0[24:24:1];%
|
||||
P(FLAG(FIB[19]&1[24:44:4],TANK,PRL,DEL);%
|
||||
END;%
|
||||
GO TO WINDUP;%
|
||||
$ SET OMIT = NOT(TIMESHARING)
|
||||
DC1:: P(RSIZE, RTN);
|
||||
$ SET OMIT = TIMESHARING
|
||||
AB:: BEGIN IF(ADDRESS~TANK[NOT 4])=0 THEN GO ERR;
|
||||
ACTION:: TANK[NOT 3]~TANK[NOT 4] ~0;
|
||||
TANK[0] := IOD OR MEM;
|
||||
P(ADDRESS,MKS,9,JUNK); GO TO ERR;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user