github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-11 23:42:42 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/B6500-Simulator/B65SIM.alg_m
Paul Kimpel 13642bcfdd Correct line-endings for Windows vs Linux. 
Correct bad line endings in the repository files that caused problems
between checking out in Windows vs Linux clients.
2019-03-24 12:03:28 -07:00

6545 lines
582 KiB
Plaintext
Raw Permalink Blame History

COMMENT 00099999
***************************** 00100000
***** B6500 SIMULATOR ***** 00101000
***************************** 00102000
********************************* 00200000
***** ERROR MESSAGE INDEX ***** 00201000
********************************* 00202000
# PROCEDURE EXPLANATION 00203000
-- --------- ----------- 00204000
0 CONTROLSECTION MORE THAN 1 OF VARF,LEEF,TEEF,SEEF ON 00205000
1 VARI TRIED TO EXECUTE VARI OPERATOR 00206000
2 (RESERVED FOR TEED) 00207000
3 (RESERVED FOR TEEU) 00208000
4 (RESERVED FOR ILED) 00209000
5 (RESERVED FOR ILEU) 00210000
6 EXSD TRIED TO EXECUTE EXSD OPERATOR 00211000
7 EXSU TRIED TO EXECUTE EXSU OPERATOR 00212000
10 ERVSFLOW INVALID CALL ON ERVSFLOW (FELL THRU SWITCH) 00213000
11 ERVSFLOW NOT(AROF AND BROF) IN SPECIALINDEX 00214000
13 ERVSFLOW STACK UNDERFLOW P22 NOTE THIS WILL BE INTERRUPT 00215000
14 ERVSFLOW PAGE 7A AROF TRUE 00216000
15 ERVSFLOW BROF FALSE IN NORMALINDEX 00217000
98 ADJ INVALID PARAMETERS TO ADJ 00218000
99 ADJ ADJ DIDNT PERFORM REQUESTED ACTION 00219000
100 RDIV QUOTIENT CANNOT BE INTEGERIZED. 00220000
101 INTERRUPTCONTROL INT HAS IMPROPER VALUE. 00221000
200 MULTIPLEXOR A NON-EXISTENT HARDWARE TYPE WAS REQUESTED. 00222000
201 MULTIPLEXOR THE BUFFER LENGTH FOR A FILE IS TO SMALL. 00223000
202 IDLE NO INTERRUPTS PENDING FOR IDLE OPERATOR 00224000
% ## TYPE OF TRACE 00225000
% -- ------------- 00226000
% 0 NO TRACE 00227000
% 1 A X B Y REGISTERS 00228000
% 2 C REGISTERS 00229000
% 3 P REGISTER 00230000
% 4 DISPLAY REGISTERS 00231000
% 5 STACK CONTENTS 00232000
% 6 A X B Y C 00233000
% 7 A X B Y P 00234000
% 6 A X B Y DISPLAY 00235000
% 9 A X B Y STACK 00236000
% 10 A X B Y C P 00237000
% 11 A X B Y C DISPLAY 00238000
% 12 A X B Y C STACK 00239000
% 13 A X B Y P DISPLAY 00240000
% 14 A X B Y P STACK 00241000
% 15 A X B Y DISPLAY STACK 00242000
% 16 A X B Y C P DISPLAY 00243000
% 17 A X B Y C P STACK 00244000
% 18 A X B Y C P DISPLAY STACK 00245000
% 19 TYPE 18 TRACE AND MEMORY DUMP % 00246000
% 00247000
% SIMULATOR DIRECTORY 00248000
% 00249000
% SEQ. NR. ITEM 00250000
% 00200000 ERROR MESSAGE INDEX 00251000
% 00400000 HARDWARE 00252000
% 00600000 MISCELLANEOUS DECLARATIONS(SEE ALSO 01000000 AND 01700000)00253000
% 00700000 B6500 REGISTER,FLIP-FLOP,FLAG,LINE AND BUSS DECLARATIONS 00254000
% 01000000 MISCELLANEOUS DECLARATIONS(SEE ALSO 00600000 AND 01700000)00255000
% 01200000 B6500 PARTIAL FIELD DEFINES 00256000
% 01400000 WORD FORMAT DESCRIPTIONS 00257000
% 01600000 FORWARD PROCEDURE DECLARATIONS 00258000
% 01700000 MISCELLANEOUS PROCEDURE,DEFINE AND OTHER DECLARATIONS 00259000
% (SEE ALSO 00600000 AND 01000000) 00260000
% 01800000 INTERRUPT CONTROLLER 00261000
% 02000000 SIMULATOR CONTROL SECTION 00262000
% 04000000 SIMULATOR UTILITY PROCEDURES(PSYLLABLES, STEPPSR, ETC.) 00263000
% 07000000 B6500 OPERATOR PROCEDURES 00264000
% 50000000 ERVSFLOW 00265000
% 51000000 STORE (STOD, STON, OVRD, OVRN) 00266000
% 60000000 B6500 MICRO-OPERATORS (ADJ, ETC.) 00267000
% 71000000 SIMULATOR INITIALIZATION 00268000
% 72000000 MULTIPLEXOR 00269000
% 73000000 SIMULATOR 00270000
% 74000000 TRACE 00271000
% 75000Q00 B6500 MEMORY DUMP 00272000
% 76000000 ERROR ROUTINE 00273000
% 77000000 HEADINGLINE 00274000
% 78000000 SIMULATOR STARTS ( I.E. DECLARATIONS AND PROCEDURES END) 00275000
; 00276000
BEGIN COMMENT SIMULATOR OUTER BLOCK; 00277000
COMMENT DO NOT CHANGE THE PRT LOCATION OF THE FOLLOWING 5 VARIABLES; 00278000
INTEGER TRACEWORD % 25 00278001
,STATUSWORD % 26 00278002
,HALTING % 27 00278003
,TRACTER % 30 00278004
,MONITORVALUE % PRT 31 THE SIMULATOR READS AND ACCEPTS THIS 00278005
% VALUE & PLACES IT IN D[31]. THE MCP MOVES IT 00278006
% FROM D[31] AND PLACES IT IN A GLOBAL 00278007
; 00278010
REAL PROCCLOCK, % PROCESSOR CLOCK RATE IN MEGACYCLES DEFAULT=10 00279000
MPXQUAN , % NUMBER OF MULTIPLEXORS DEFAULT= 1 00280000
MPXAOPS , % MAXIMUM OPERATIONS FOR MPXA DEFAULI=10 00281000
MPXBOPS , % MAXIMUM OPERATIONS FOR MPXB DEFAULT=10 00282000
MEMMODS , % NUMBER OF 16K MEMORY MODULES DEFAULT= 2 00283000
MEMTIME , % MEMORY CYCLE TIME DEFAULT=1.200284000
PROCID , % PROCESSOR IDENTIFICATION DEFAULT = 1 00284500
DISKLOAD, % ESPOL = 0; ALGOL = 1; COBOL = 2; 00285000
BUFRMAX , % MAXIMUM BUFFER SIZE 00286000
ROWLENGTH; % LENGTH OF M ARRAY ROW (6500 WORDS) 00287000
REAL ETIME, PTIME, STARTDATE; 00288000
REAL TIMEOFDAY; % WHAT IT SAYS - SEE SCNI - SCNO 00288010
SAVE ARRAY TBUF [0:16]; % FORMATTING AREA FOR TRACE AND MEMDUMP 00289000
BOOLEAN PRINTERNOTYETOPENED; 00290000
REAL STREAM PROCEDURE MKABS (A); BEGIN SI ~ A; MKABS ~ SI END; 00291000
ARRAY EBCTOBCL [0:31]; % INDEXED BY AN 8 BIT EBCDIC CHARACTER TO 00292000
% FIND A 6 BIT BCL CHARACTER-MOSTLY INV CHR00293000
ARRAY BUFFERS [0:3, 0:13]; % BUFFER LENGTHS FOR LOGICAL UNITS 00294000
% INDEXED BY HDWE TYPE AND SWITCH FILE INDX00295000
INTEGER NCR; % ABSOLUTE ADDRESS MESS [0] 00296000
DEFINE FILLBUFFERS = % DEFAULT BUFFER LENGTHS 00297000
% HDWE TYPES: DSC SPO BIDS LP CR CP TAPE 00298000
FILL BUFFERS [0,*] WITH 0, 30, 10, 0,0,0,15,0,0,10,10,0,0,1023;00299000
FILL BUFFERS [1,*] WITH 0, 30, 0, 0,0,0,15,0,0, 0, 0,0,0,1023;00300000
FILL BUFFERS [2,*] WITH 0, 30, 0, 0,0,0, 0,0,0, 0, 0,0,0,1023;00301000
FILL BUFFERS [3,*] WITH 0, 30, 0, 0,0,0, 0,0,0, 0, 0,0,0,1023;00302000
#; 00303000
ARRAY PERIPHERALT[0:69]; %TIMING CONSTANTS FOR PERIPHERAL UNITS 00304000
DEFINE FILLT=FILL PERIPHERALT[*] WITH 00305000
0,0,0,0,0, %000306000
80,2@5,0,0,0, %DISK-MPX CYCLE TIME, LATENCY TIME 100307000
0,0,0,0,0, %200308000
0,0,0,0,0, %300309000
0,0,0,0,0, %400310000
0,0,0,0,0, %500311000
2.42@4,57.6@4,24.3@4,6.6@4,10@4, %BUFFERED PRINTER 600312000
%MPX BUSY TIME,DRUM ROTATION TIME, 00313000
%FIRST SPACING TIME,EACH ADDITIONAL 00314000
%SPACING TIME 00315000
27.1@4,75@4,24.3@4,6.6@4,10@4, %UNBUFFERED PRINTER 700316000
%SAME AS BUFFERED PRINTER 00317000
0,0,0,0,0, %800318000
24.3@4,75@4,0.0,0, %CARD READER -EL.CYCLE,ME.CYCLE 900319000
24.3@4,6@6,0,0,0, %CARD PUNCH-EL.CYCLE,ME.CYCLE 1000320000
0,0,0,0,0, %1100321000
0,0,0,0,0, %1200322000
120,800,6.7@4,.6,0; %MAGNETIC TAPE- 1300323000
%SPEED,DENSITY,START TIME,RECORD GAP00324000
#; 00325000
ARRAY STATVECTOR [0:7]; % PERIPHERAL STATUS WORDS 00325100
ARRAY OLDSTATVEC [0:7]; % TO SAVE OFF CHANGED STATUS WORD 00325300
ALPHA 00326000
ARRAY MPX [0:6, 0:31]; COMMENT INDEXED BY MULTIPLEXOR 00327000
AND LOGICAL UNIT NO. CONTAINS: 00328000
RESULT DESCRIPTOR MPX [MPXUNIT+4,LOGICALUNIT] 00329000
AND MPX INFO WORD 00330000
; 00331000
BOOLEAN MULTIPLEX; % TRUE FOR SCNO (IIO) 00332000
BOOLEAN SPOED; % TRUE FOR NOTHINGTODO READ 00333000
ARRAY CUP[0:11]; 00334000
REAL TUBA, 00335000
PID; % PROCESSOR I.D. 00335500
SAVE ALPHA 00336000
ARRAY EVENTS [0:31]; COMMENT INDEXED BY LOGICAL UNIT OR SELF. 00337000
CONTAINS THE REAL TIME FOR THE COMPLETION OF THE I-O 00338000
BEING PERFORMED ON THIS UNIT AND A LINK TO THE NEXT 00339000
EVENT AND A MULTIPLEXOR INDICATOR. 00340000
; 00341000
ARRAY UNITAVAILTIME[0:31]; COMMENT-INDEXED BY LOGICAL UNIT. 00342000
CONTAINS REALTIME WHEN NEXT I/O COULD BE 00343000
INITIATED ON THIS UNIT.; 00344000
DEFINE % DEFINES FOR MPX AND EVENTS PARTIAL FIELDS 00345000
EVTIME = [12:36]#, % I-O COMPLETE TIME 00346000
EVLINK = [ 7: 5]#, % EVENT LINK 00347000
EVBUSY = [ 6: 1]#, % BUSY BIT 00348000
EVMPX = [ 1: 2]#, % MPX FOR THIS I-O 00349000
RSLTERR = [31:17]#, % ERROR FIELD 00350000
RSLTUNIT = [23: 8]#, % UNIT 00351000
TCHRS = [20: 3]#, % RESULT CHRS 00352000
RSLTADRS = [ 1:19]#, % ADDRESS 00353000
MPXINT = [38:10]#, % MPX INTERRUPT VALUE 00354000
MPXHDWE = [32: 6]#, % HARDWARE UNIT TYPE 00355000
MPXSWFI = [24: 6]#, % SWITCH FILE INDEX 00356000
MPXWLO = [ 1: 1]#, % 1 = WRITE LOCK-OUT 00357000
TUB = [ 2:9]#, % TU & BUF ADDRESS 00358000
MPXBUFF = [14:10]#; % BUFFER LENGTH 00359000
%>RETRO00360000
REAL ARRAY FIRSTEVENT [0:15], LASTEVENT [0:15]; %>RETRO00361000
INTEGER ARRAY FIRSTEVENTI[0:15], LASTEVENTI[0:15]; %>RETRO00362000
REAL CURRENTT, % THE TIME FOR THE NEXT MULTIPLEXOR INTERRUPT 00363000
CURRENTMPX; % THE MPX FOR THE NEXT MULTIPLEXOR INTERRUPT 00364000
ARRAY MPXOPS [0:2];%OPERATIONS PER MPX 00365000
DEFINE DELTAMPX = 4#; % THE INCREMENT REQUIRED TO FIND THE RESULT 00366000
% DESCRIPTOR IN MPX ARRAY. 00367000
INTEGER INTTIMER; % THE NEXT REAL TIME FOR A TIME INTERRUPT 00368000
REAL MONITORMASKOLD;% TEMPORARY MONITOR MASK 00369000
REAL MONITORMASK; 00369100
PROCEDURE HARDWARE; 00400000
BEGIN 00401000
DEFINE LUNIT= TBUF [0]#, 00402000
HTYPE= TBUF [1]#, 00403000
MPXAB= TBUF [2]#, 00404000
BUFLG= TBUF [3]#, 00405000
WLO = TBUF [4]#; 00406000
INTEGER I, J, S; 00407000
LABEL EOF; 00408000
DEFINE 00409000
TIMEADJUST = ;#; %%%%%%%%%% 00410000
TBUF [16] ~ MKABS (TBUF); 00411000
PRINTERNOTYETOPENED ~ TRUE; 00412000
FILLBUFFERS; 00413000
FILLT; 00414000
FILL EBCTOBCL [*] WITH % GRAPHIC UNDER LOW-ORDER OCTADE 00415000
OCT1414141414141414, 00416000
OCT1414141414141414, 00417000
OCT1414141414141414, 00418000
OCT1414141414141414, 00419000
OCT1414141414141414, 00420000
OCT1414141414141414, 00421000
OCT1414141414141414, 00422000
OCT1414141414141414, 00423000
OCT6014141414141414, 00424000
% BLANK 00425000
OCT1414143236352037, 00426000
% . < ( + ~ 00427000
OCT3414141414141414, 00428000
% & 00429000
OCT1414405253555657, 00430000
% | $ * ) ; { 00431000
OCT5461141414141414, 00432000
% - / 00433000
OCT1414767273741614, 00434000
% ] , % ! > QUESTION MARK 00435000
OCT3314141414141414, 00436000
% [ 00437000
OCT1414151213177577, 00438000
% : # @ } = " 00439000
OCT1414141414141414, 00440000
OCT1414141414141414, 00441000
OCT1414141414141414, 00442000
OCT1414141414141414, 00443000
OCT1414141414141414, 00444000
OCT1414141414141414, 00445000
OCT1414141414141414, 00446000
OCT1414141414141414, 00447000
OCT1421222324252627, 00448000
% A B C D E F G 00449000
OCT3031141414141414, 00450000
% H I 00451000
OCT1441424344454647, 00452000
% J K L M N O P 00453000
OCT5051141414141414, 00454000
% Q R 00455000
OCT1414626364656667, 00456000
% S T U V W X 00457000
OCT7071141414141414, 00458000
% Y Z 00459000
OCT0001020304050607, 00460000
% 0 1 2 3 4 5 6 7 00461000
OCT1011141414141414; 00462000
% 8 9 00463000
BEGIN 00464000
FILE CONFIGURATION (1, 10); 00465000
READ (CONFIGURATION, /, PROCCLOCK, MPXQUAN, MPXAOPS, 00466000
MPXBOPS, MEMMODS, MEMTIME, PROCID, DISKLOAD 00467000
,HALTING 00467010
,MONITORMASK 00467100
,MONITORVALUE 00467200
); 00468000
MONITORMASKOLD ~ MONITORVALUE; 00468900
IF PROCCLOCK = 0 THEN PROCCLOCK ~ 10; % MEGACYCLES 00469000
IF MPXQUAN = 0 THEN MPXQUAN ~ 1; % MULTIPLEXORS 00470000
MPXAOPS ~ 00471000
MPXOPS [1] ~ IF MPXAOPS = 0 THEN 10 ELSE MPXAOPS; 00472000
MPXBOPS ~ 00473000
MPXOPS [2] ~ IF MPXBOPS = 0 THEN 10 ELSE MPXBOPS; 00474000
IF MEMTIME = 0 THEN MEMTIME ~ 1.2;% MICROSECONDS 00475000
MEMTIME ~ MEMTIME | 10; 00476000
MEMMODS ~ (2*14|2|(IF MEMMODS = 0 THEN 2 ELSE MEMMODS))-1; 00477000
IF PROCID = 0 THEN PID ~ 1 ELSE PID ~ PROCID; 00477500
IF DISKLOAD > 0 THEN INTTIMER ~ 0 ; 00478000
END; 00479000
BEGIN 00480000
FILE CABLING (2, 10); 00481000
STREAM PROCEDURE STATUS(SWORD, LUNIT); VALUE LUNIT; 00481100
BEGIN DI ~ SWORD; SKIP LUNIT DB; DS ~ 1 SET END STATUS; 00481200
LABEL EOF; 00482000
STATUSWORD ~ 1; 00482100
DO BEGIN 00483000
READ (CABLING, /, LUNIT, HTYPE, MPXAB, BUFLG 00484000
, WLO , TUBA )[EOF]; 00485000
IF MPXAB = 0 THEN MPXAB ~ 1; 00486000
MPX [I ~ MPXAB, J ~ LUNIT].MPXWLO ~ WLO; 00487000
MPX [I, J].MPXHDWE ~ HTYPE; 00488000
MPX [I, J].MPXSWFI ~ S ~ MPX [0, HTYPE]; 00489000
MPX [0, HTYPE] ~ MPX [0, HTYPE] + 1; 00490000
IF BUFLG ! 0 THEN BUFFERS [S, HTYPE] ~ 00491000
BUFLG; 00492000
MPX [I, J].MPXBUFF ~ BUFLG; 00493000
I ~ 46 - LUNIT; 00493100
STATUS (STATUSWORD, I); 00493200
END UNTIL FALSE; 00494000
EOF: END; 00495000
S ~ 10; % MINIMUM BUFFER SIZE IS 10 00496000
FOR I ~ 0 STEP 1 UNTIL 3 DO 00497000
FOR J ~ 0 STEP 1 UNTIL 13 DO 00498000
IF BUFFERS [I, J] > S THEN S ~ BUFFERS [I, J]; 00499000
BUFRMAX ~ S; 00500000
LUNIT ~ 0; 00501000
ETIME ~ TIME (1); 00502000
PTIME ~ TIME (2); 00503000
STARTDATE ~ TIME (0); 00504000
TIMEADJUST; 00505000
ROWLENGTH ~ 256; 00506000
END OF HARDWARE INITIALIZE; 00507000
HARDWARE; 00508000
BEGIN 00509000
LABEL EOJ; 00600000
INTEGER T; 00601000
DEFINE STACKVECTOR = D0+2#; 00602000
%**************************************** 00700000
%***** B6500 REGISTER DECLARATIONS ***** 00701000
%**************************************** 00702000
%NAME #BITS DESCRIPTION 00703000
REAL A,AX, % 51 TOP OPERAND IN STACK 00704000
X,XX, % 51 EXTENSION OF A 00705000
B,BX, % 51 SECOND OPERAND IN STACK 00706000
Y,YX, % 51 EXTENSION OF B 00707000
C,CX, % 51 GENERAL PURPOSE REGISTER 00708000
P,PX; % 51 PROGRAM REGISTER 00709000
BOOLEAN AROF, % 1 A REGISTER OCCUPIED 00710000
BROF, % 1 B REGISTER OCCUPIED 00711000
PROF; % 1 P REGISTER OCCUPIED 00712000
DEFINE MEMCYCLE = DELTATIME ~ DELTATIME + MEMTIME;#; 00713000
LONG ARRAY M [0:MEMMODS]; 00714000
%NOTE: INDICIES ARE AUTOMATICALLY DOUBLED 00715000
% AND THE ARRAY IS PARTIONED INTO A 00716000
% TWO-DIMENSIONAL ARRAY WITH 256-WD ROWS00717000
% BY SPECIAL COMPILER PATCHES. 00718000
REAL MA, % 3 MANTISSA EXTENSION OF A 00719000
MB, % 3 MANTISSA EXTENSION OF B 00720000
EA, % 1 EXPONENT EXTENSION OF A 00721000
EB, % 1 EXPONENT EXTENSION OF B 00722000
AA, % 42 10 MC ADDER CAPTIVE REGISTER (ADDEND) 00723000
BB, % 42 10 MC ADDER CAPTIVE REGISTER (AUGEND) 00724000
CC, % 42 10 MC ADDER CAPTIVE REGISTER (IDLER) 00725000
SGNF, % 1 EXTERNAL SIGN 00726000
MM, % 20 MAIN MEMORY ADDRESSING REGISTER 00727000
LL, % 5 LEXIOGRAPHIC LEVEL (DISPLAY MEMORY POINTER) 00728000
BRS, % 7 BASE READ SELECT (I.C. MEMORY ADDRESSING REG.)00729000
BWS, % 7 BASE WRITE SELECT (I.C. MEMORY ADDRESSING REG.)00730000
IRS, % 4 INDEX READ SELECT (I.C. MEMORY ADDRESSING REG.)00731000
IWS, % 4 INDEX WRITE SELECT (I.C. MEMORY ADDRESSINS REG.)00732000
OPSR,% 3 OLD PSR 00733000
PICR,% 20 PROGRAM INDEX COUNTER FOR SINGLE INSTRUCTION 00734000
DRS; % 6 DISPLAY READ SELECT REGISTER 00735000
ARRAY D[0:31];%20 I.C. DISPLAY MEMORY 00736000
DEFINE D0 = D[ 0]#, D8 = D[ 8]#, D16 = D[16]#, D24 = D[24]#, 00737000
D1 = D[ 1]#, D9 = D[ 9]#, D17 = D[17]#, D25 = D[25]#, 00738000
D2 = D[ 2]#, D10 = D[10]#, D18 = D[18]#, D26 = D[26]#, 00739000
D3 = D[ 3]#, D11 = D[11]#, D19 = D[19]#, D27 = D[27]#, 00740000
D4 = D[ 4]#, D12 = D[12]#, D20 = D[20]#, D28 = D[28]#, 00741000
D5 = D[ 5]#, D13 = D[13J#, D21 = D[21]#, D29 = D[29]#, 00742000
D6 = D[ 6]#, D14 = D[14]#, D22 = D[22]#, D30 = D[30]#, 00743000
D7 = D[ 7]#, D15 = D[15]#, D23 = D[23]#, D31 = D[31]#, 00744000
D00 = D[ 0]#, D03 = D[03]#, D06 = D[06]#, D09 = D[09]#, 00745000
D01 = D[ 1]#, D04 = D[04]#, D07 = D[07]#, 00746000
D02 = D[02]#, D05 = D[05]#, D08 = D[08]#; 00747000
INTEGER SP, % 6 SOURCE REGISTER POINTER 00748000
DP, % 6 DESTINATION REGISTER POINTER 00749000
G, % 6 00750000
K, % 6 00751000
TP, % 4 TABLE BASE POINTER 00753000
PSR; % 3 PROGRAM SYLLABLE REGISTER 00754000
COMMENT THE FOLLOWING DECLARATION IS FOR THE 8 I.C. BASE REGISTERS00755000
AND ITS INTERNAL SEQUENCE SHOULD NOT BE DISTURBED WITHOUT 00756000
CHECKING THE ARRAY BRSR, PROCEDURES RPRR AND SPRR, ETC.; 00757000
REAL PBR, SBR, DBR, TBR, S, SNR, PDR, TEMP; %DLK00758000
DEFINE BUF2 = TBR#; % SHARED REGISTERS 00759000
REAL TSR; 00760000
COMMENT THE FOLLOWING DECLARATION IS FOR THE 8 I.C. INDEX REGISTERS00761000
AND ITS INTERNAL SEQUENCE SHOULD NOT BE DISTURBED WITHOUT 00762000
CHECKING THE ARRAY BRSR, PROCEDURES RPRR AND SPRR, ETC.; 00763000
REAL PIR, SIR, DIR, TIR, LOSR, BOSR, F, BUF1; %DLK00764000
DEFINE BUF3 = TIR#; % SHARED REGISTERS 00765000
COMMENT ***** EXPLANATORY ONLY (SEE ABOVE) ******************00766000
PBR, % 20 PROGRAM BASE REGISTER 00767000
SBR, % 20 SOURCE BASE REGISTER 00768000
DBR, % 20 DESTINATION BASE REGISTER 00769000
BUF2, % 20 UTILITY REGISTER - SHARED WITH TBR 00770000
S, % 20 TOP OF STACK POINTER 00771000
SNR, % 20 STACK NUMBER REGISTER 00772000
PDR, % 20 PROGRAM DESCRIPTOR REGISTER 00773000
TEMP, % 20 TEMPORARY G.P. REGISTER 00774000
PIR, % 20 PROGRAM INDEX REGISTER 00775000
PICR, %4 DELTA PIR FOR OPERATOR, USED TO RESTORE PIR 00776000
SIR, % 20 SOURCE INDEX REGISTER 00777000
DIR, % 20 DESTINATION INDEX REGISTER 00778000
TIR, % 20 TABLE INDEX REGISTER 00779000
BUF3, % 20 UTILITY REGISTER - SHARED WITH TIR 00780000
LOSR, % 20 LIMIT OF STACK REGISTER 00781000
BOSR, % 20 BASE OF STACK REGISTER 00782000
F, % 20 MARK STACK POINTER 00783000
BUF; % 20 BUFFER G.P. REGISTER 00784000
DEFINE BUF = BUF1#; % TO OVERCOME NOMENCLATURE DIFFICULTY 00785000
INTEGER 00786000
SIB, % 6 SOURCE BIT INDEX REGISTER 00787000
DIB, % 6 DESTINATION BIT INDEX REGISTER 00788000
RPF, % 20 REPEAT FIELD REGISTER 00789000
DIS, % 00790000
TOM, % 6 TOP OF MASK 00791000
TOA; % 6 TOP OF APERATURE 00792000
ARRAY IRSR, BRSR [0:7]; % USED TO HOLD BASE AND INDEX REGISTERS 00793000
ARRAY MONITOROUTPUT [0:13]; 00793100
FORMAT MONFMT (X1,A1,A6,X1,I1, X1, 16I1, 7(X2, I5, X1, I5)); 00793200
DEFINE NULLB=0#,% NULL STATE FOR I.C. MEMORY BASE REGISTERS 00794000
NULLI=0#;% NULL STATE FOR I.C. MEMORY INDEX REGISTERS 00795000
REAL AB, % 20 ADDRESS BASE BUSS 00796000
AI; % 20 ADDRESS INDEX BUSS 00797000
BOOLEAN NCSF; % 1 NORMAL STATE FF 00798000
REAL QP; % MISC CONTROL FLIP/FLOPS (STRING OPERATORS) 00798500
REAL Q; % 18 Q0 AND QC SETS OF G.P. LOGICAL FFS (CLEARED AT SECL) 00799000
DEFINE Q00F = Q.[47:1]#, Q03F = Q.[44:1]#, Q06F = Q.[41:1]#, 00800000
Q01F = Q.[46:1]#, Q04F = Q.[43:1]#, Q07F = Q.[40:1]#, 00801000
Q02F = Q.[45:1]#, Q05F = Q.[42:1]#, Q08F = Q.[39:1]#, 00802000
QC0F = Q.[38:1]#, QC3F = Q.[35:1]#, QC6F = Q.[32:1]#, 00803000
QC1F = Q.[37:1]#, QC4F = Q.[34:1]#, QC7F = Q.[31:1]#, 00804000
QC2F = Q.[36:1]#, QC5F = Q.[33:1]#, QC8F = Q.[30:1]#; 00805000
REAL N; % 4 G.P. COUNT REGISTER (CLEARED AT SECL) 00806000
BOOLEAN LPF, % 1 LINE PARITY--READ 00807000
IIHF, % 1 00807500
SUFL, % 1 STACK UNDER FLOW FLIP/FLOP 00807600
EXTF, % 1 ENTERNAL SIGN FLIP FLOP 00808000
TFFF, % 1 TRUE/FALSE FF 00809000
OFFF, % 1 OVERFLOW FF 00810000
FLTF , % 1 FLOAT FLIP FLOP 00811000
TEEF, % 1 TABLE EDIT ESCAPE 00812500
LEEF, % 1 LINE EDIT ESCAPE 00813000
EDITF , % 1 EDIT MODE FLIP FLOP 00814000
EXSF , % 1 EXECUTE SINGLE SHOT 00815000
ESPF , % 1 EXECUTE SINGLE POINTER 00815500
UPDF , % 1 UPDATE 00816000
SOPF , % 1 SINGLE PRECISION OPERAND 00817000
RNTF , % 1 RE-ENTER FLIP/FLOP FOR CHARACTER MODE 00818000
VARF; % 1 VARIANT ESCAPE 00819000
DEFINE SEEF = EXSF#; 00820000
REAL SSZ, % 2 SOURCE CHARACTER SIZE 00821000
DSZ, % 2 DESTINATION CHARACTER SIZE 00822000
TCS, % 2 TABLE CHARACTER SIZE 00823000
OFS, % 6 OFFSET REGISTER (SIEERING CONTROL) 00824000
J1F, % 6 FAMILY 1 SEQUENCE COUNTER 00825000
J2F; % 6 FAMILY 2 SEQUENCE COUNTER 00826000
BOOLEAN REQ, % 1 REQUEST (MEM. INTERFACE) 00827000
WRT, % 1 WRITE (MEM. INTERFACE) 00828000
PRO, % 1 PROTECT (MEM. INTERFACE) 00829000
MROF; % 1 MEM. READ OBTAINED (MEM. INTERFACE) 00830000
BOOLEAN STKOVFF; % ADJ SETS TRUE FOR STACK OVERFLOW 00830100
DEFINE % ALARM INTERRUPTS 00831000
LOOPI = 33554433 #, % 2*25+2*0 OPERATOR LOOP 00832000
MEMPARI = 33554434 #, % 2*25+2*1 MEMORY PARITY 00833000
MPXPARI = 33554436 #, % 2*25+2*2 MULTIPLEXOR PARITY 00834000
INVADRI = 33554440 #, % 2*25+2*3 INVALID ADDRESS 00835000
STKUNFI = 33554448 #, % 2*25+2*4 STACK UNDERFLOW 00836000
INVOPA = 33554464 #, % 2*25+2*5 UNKNOWN OPERATOR 00837000
% SYLLABLE DEPENDENT INTERRUPTS 00838000
MEMPROI = 16777217 #, % 2*24+2*0 MEMORY PROTECT 00839000
INVOP = 16777218 #, % 2*24+2*1 INVALID OPERATOR 00840000
DIVZROI = 16777220 #, % 2*24+2*2 DIVIDE BY ZERO 00841000
EXPOVFI = 16777224 #, % 2*24+2*3 EXPONENT OVERFLOW 00842000
EXPUNFI = 16777232 #, % 2*24+2*4 EXPONENT UNDERFLOW 00843000
INVINXI = 16777248 #, % 2*24+2*5 INVALID INDEX 00844000
INTOVFI = 16777280 #, % 2*24+2*6 INTEGER OVERFLOW 00845000
BOSINT = 16777344 #, % 2*24+2*7 BOTTOM OF STACK 00846000
PRESBIT = 16777472 #, % 2*24+2*8 PRESENCE BIT 00847000
SEQERRI = 16777728 #, % 2*24+2*9 SEQUENCE ERROR 00848000
% GENERAL CONTROL INTERRUPTS 00849000
INTTIMI = 4194305 #, % 2*22+2*0 INTERVAL TIMER 00850000
STKOVFI = 4194306 #, % 2*22+2*1 STACK OVERFLOW 00851000
% EXTERNAL INTERRUPTS 00852000
EXTINTI = 1048816#, % BITS 20, 7-4 ON EXTERNAL INTERRUPT 00853000
%I/O FINISH BEING FORCED, MLC NOT HONORD 00854000
PTOPI = 2097152 #, % 2*21 PROCESSOR TO PROCESSOR 00855000
DUMMYI = 0#; 00856000
REAL INT; % INTERRUPT FLIP/FLOPS 00857000
% FLIP/FLOP FUNCTION 00858000
DEFINE EXIA = INT.[27:1]#, % [20:1] EXIA MPXA 00859000
PTPI = INT.[26:1]#, %[21:1] PTPI PROCESSOR 00860000
GCIF = INT.[25:1]#, % [22:1] GENERAL CONTROL 00861000
SDIS = INT.[23:2]#, %[24:2] SDIS SYLLABLE DEPENDENT00862000
ALRM = INT.[22:1]#, %[25:1] ALRM ALARM INTERRUPT 00863000
% GCIF & ALRM HAVE NOONES APPROVAL 00864000
DUMMYF = 0#; 00865000
REAL E, % 4 MEM. CYCLE REQUEST (MEM. INTERFACE) 00866000
RF; % 8 REPEAT FIELD REGISTER 00867000
REAL ICR1; % INTERRUPT CONTROL REGISTER 00868000
INTEGER 01000000
NSTACK, % VALUE USED FOR TRACING STACK 01001000
NDISPLAY; % VALUE USED FOR TRACING DISPLAYS 01002000
REAL TANK; % ABSOLUTE ADDRESS OF SAVE ARRAY TBUF 01003000
SAVE 01004000
ARRAY TBUF[0:16]; % FORMATING AREA FOR TRACE AND MEMDUMP 01005000
ALPHA MULFILID, FILID; % THE SOURCE FILE FOR INITIALIZE 01005100
REAL JUNK; 01007000
INTEGER INTG; 01008000
ARRAY MNEMONIC[0:2,0:255]; 01009000
INTEGER TS1; 01010000
SAVE ARRAY DELTAMASK[0:31]; % MASKS OUT DELTA PART OF ADRCPL FIELDS 01011000
SAVE ARRAY REFLECTION[0:31];% REFLECTS LL PARTS OF ADRCPL FIELDS 01012000
FILE TRACK 14(1,5); % DATA COM FILE TO READ TRACE PARAMETERS 01013000
DEFINE BITS=(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP 1 SB)#, 01014000
DIG=(DS:=3 RESET; 3 BITS)#, 01015000
PRINT=WRITE(LP,15,TBUF[*])#; 01016000
DEFINE HEADING = IF PRINTERNOTYETOPENED THEN 01017000
IF PRINTERNOTYETOPENED.[46:1] 01017250
THEN HEADINGLINE(TAPED) 01017500
ELSE HEADINGLINE(LP)#; 01017750
REAL INTMASKA, % INTERRUPT MASKS AND REGISTERS FOR MPXA AND MPXB 01018000
INTMASKB, % 10 BITS EACH 01019000
INTREGA, 01020000
INTREGB; 01021000
REAL SCANBUSA, SCANBUSAX,% SCAN AND DATA BUSES FOR MPXS 01022000
DATABUSA, DATABUSAX;% WITH MOVE EXTENSIONS 01023000
REAL ABORTTIME,% THE REAL TIME FOR NEXT ABORT INTERRUPT 01024000
IDLETIME ;% THE REAL TIME FOR NEXT INTERRUPT 01025000
REAL REALTIME, COMMENT THE TIME IN 100 NANOSECOND UNITS SINCE THE 01026000
BEGINNING OF SIMULATION. USED WITH TIMEOFDAY AND 01027000
REALETIME FOR SCAN IN AND OUT OF TIME OF DAY CLOCK.; 01028000
TIMEOFDAY, 01029000
REALETIME, 01030000
DELTATIME;COMMENT THE TIME INCREMENT SINCE THE REAL TIME CLOCK 01031000
WAS UPDATED. USUALLY THE TIME REQUIRED FOR AN OPER- 01032000
ATOR.; 01033000
%********************************************** 01200000
%***** B6500 FIELD ABBREVIATION DEFINES ***** 01201000
%********************************************** 01202000
DEFINE % ABBR. B5500 B6500 FIELD/BIT NAME 01203000
TAG = [44: 3]#, % [50: 3] TAG FIELD 01204000
% TAG VALUES... 01205000
SINGL = 0#, % SINGLE PRECISION OPERAND 01206000
IRW = 1#, % INDIRECT REFERENCE WORD 01207000
DOUBL = 2#, % DOUBLE PRECISION OPERAND 01208000
MEMLINK= 3#, % STORAGE LINK 01209000
CODE = 3#, % CODE 01210000
SEGDESC= 3#, % SEGMENT DESCRIPTOR 01211000
MSCW = 3#, % MARK STACK CONTROL WORD 01212000
TOS = 3#, % TOP OF STACK CONTROL WORD 01213000
RCW = 3#, % RETURN CONTROL WORD 01214000
SIW = 4#, % STEP INDEX WORD 01214100
DATADESC=5#, % DATA DESCRIPTOR 01215000
UNITAL = 6#, % UNINITIALIZED OPERAND 01216000
PCW = 7#, % PROGRAM CONTROL WORD (PGM DESC) 01217000
% END TAG VALUES 01218000
ROBIT = [46:1]#, % [48:1] READ ONLY FIELD 01219000
LOBIT = [47:1]#, % [0:1] LOW ORDER BIT 01220000
PBIT = [47: 1]#, % [47: 1] PRESENCE BIT (IN DATADESC,SEGDESC01221000
DSBIT = [47: 1]#, % [47: 1] DIFFERENT STACK BIT (IN MSCW) 01222000
SGNFF = [47:1]#, % [47:1] SGNF FIELD IN TOS CONTROL WORD 01223000
EXPEXT = [ 1: 8]#, % [47: 9] EXPONENT EXTENTION (DBL PREC) 01223100
INCRF = [ 1:11]#, % [47:12] INCREMENT FIELD (IN STEP INDEX) 01223500
CBIT = [ 1: 1]#, % [46: 1] COPY BIT (IN DATADESC,SEGDESC) 01224000
EBIT = [ 1: 1]#, % [46: 1] ENVIRONMENT BIT (IN IRW,MSCW) 01225000
SOBIT = [ 1: 1]#, % [46:1] SIGN OF OPERAND BIT 01226000
OFFFF = [1:1]#, % [46:1] OFFF FIELD IN TOS CONTROL WORD 01227000
IBIT = [ 2: 1]#, % [45: 1] INDEXED BIT 01228000
SEBIT = [ 2: 1]#, % [45: 1] SIGN OF EXPONENT BIT 01229000
TFFFF = [2:1]#, % [45:1] TFFF FIELD IN TOS CONTROL WORD 01230000
STKNR = [ 2:10]#, % [45:10] STACK NR FIELD (IN IRW,MSCW) 01231000
SBIT = [ 3: 1]#, % [44: 1] SEGMENTED BIT (DATADESC) 01232000
FLTFF = [ 3: 1]#, % [44: 1] FLOAT FLIP/FLOP 01232500
EXPF = [ 3: 6]#, % [44: 6] EXPONENT FIELD 01233000
SEXPF = [2:7]#, % [45:7] SIGNED EXPONENT FIELD 01234000
RBIT = [ 4: 1]#, % [43: 1] READ-ONLY-DATA BIT 01235000
SZ = [ 5: 3]#, % [42:3] CHARACTER SIZE FIELD 01236000
CHRSZ = [ 5: 2]#, % [42:2] CHARACTER SIZE IN DATA DESC. 01237000
CHARF = [ 8: 4]#, % [39: 4] CHARACTER NUMBER FIELD 01238000
DBIT = [ 7: 1]#, % [40: 1] DOUBLE PRECISION BIT (IN DATADESC01239000
SIBF = [ 7: 6]#, % [40: 6] SIB FOR STRING DESCRIPTORS 01240000
INDEX = [ 8:20]#, % [39:20] INDEX/LENGTH FIELD 01241000
LENGTH = [ 8:20]#, % [39:20] INDEX/LENGTH FIELD 01242000
DS = [8:20]#, % [39:20] DISPLACEMENT FIELD IN TOS CW 01243000
PSRF = [12: 3]#, % [35: 3] PSR FIELD (IN PCW, RCW) 01244000
MANF = [ 9:39]#, % [38:39] MANTISSA FIELD 01245000
PIRF = [15:13]#, % [32:13] PIR FIELD (IN PCW, RCW) 01246000
DISP = [12:16]#, % [35:16] BASE-OF-STACK-RELATIVE DISPLACMNT01247000
SIRF = [12:16]#, % [35:16] INDEX FIELD FOR STRING DESCRIPTORS01248000
FVF = [12:16]#, % [35:16] FINAL VALUE FIELD (IN SIW) 01248500
VBIT = [28: 1]#, % [19: 1] ACC. ENTRY ON VALC OR EVAL 01249000
NBIT = [28: 1]#, % [19: 1] NORMAL/CONTROL STATE BIT 01250000
NCSFF = [28:1]#, % [19:1] NCSF FIELD IN TOS CONTROL WORD 01251000
ADDR = [28:20]#, % [19:20] MEMORY ADDRESS/DISK ADDRESS FIELD01252000
LLF = [29: 5]#, % [18: 5] LL FIELD 01253000
CVF = [32:16]#, % [15:16] CURRENT VALUE FIELD (IN SIW) 01253500
ADRCPL = [34:14]#, % [13:14] ADDRESS COUPLE FIELD (11,DELTA) 01254000
ADRCPLSIR = [35:13]#, % [12:13] ADDRESS COUPLE STUFFED IRW(DEL) 01255000
DF = [34:14]#, % [13:14] SELF-RELATIVE INDEX 01256000
% TO PREVIOUS MSCW (LODELTAF) 01257000
LEVELPCW = [34:1]#,%[13:1] ONE BIT LEVEL ADDRESS PCW 01258000
DELTAPCW = [35:13]#,%[12:13] DELTA ADDRESS PCW 01259000
SDIF = [34:14]#; % [13:14] SEGMENT DICTIONARY INDEX FIELD 01260000
DEFINE 01261000
SBRF = ADDR#, 01262000
DBRF = ADDR#, 01263000
DIRF = SIRF#, TIRF = SIRF#, 01264000
DIBF = SIBF#, 01265000
DSZF = SZ #; 01266000
DEFINE % FUNCTION CODE DEFINES 6.33 01267000
MPXAB = [47: 1]#, % [ 0: 1] RESPONDING MULTIPLEXOR(S) 01268000
MPXFC = [43: 4]#, % [ 4: 4] MPX DESIGNATOR 01269000
VARIF = [39: 4]#, % [ 8: 4] SCAN VARIANT 01270000
GCARF = [37: 2]#, % [10: 2] GCA REGISTER 01271000
REGIV = [39: 1]#, % [ 9: 1] READ REGISTER VARIANT 01272000
VECTF = [36: 2]#, % [11: 2] VECTOR NUMBER 01273000
LUNIT = [31: 8]#; % [16: 8] LOGICAL UNIT NUMBER 01274000
DEFINE % RESULT ERROR DEFINES 01275000
RSLTPRO= [31: 1]#, % [16: 1] PROTECT TERMINATE ON MEMORY WRITE 01276000
RSLTEXC= [47: 1]#, % [ 0: 1] EXCEPTION 01277000
RSLTATT= [46: 1]#, % [ 1: 1] ATTENTION 01278000
RSLTBSY= [45: 1]#, % [ 2: 1] BUSY 01279000
RSLTNRY= [44: 1]#, % [ 3: 1] NOT READY 01280000
RSLTDSC= [43: 1]#, % [ 4: 1] DESCRIPTOR ERROR 01281000
RSLTMAD= [42: 1]#, % [ 5: 1] MEMORY ADDRESS 01282000
RSLTPAR= [41: 1]#; % [ 6: 1] MEMORY PARITY 01283000
DEFINE % RESULT DESCRIPTOR UNIT ERRORS 01284000
RSLTTO = [32: 1]#, % [15: 1] BLANK TAPE 01285000
RSLTRW = [33: 1]#, % [14: 1] REWINDING 01286000
RSLTOP = [34: 1]#, % [13: 1] NON-PRESENT 01287000
RSLTCR = [35: 1]#, % [12: 1] CRC CORRECTION 01288000
RSLTOF = [36: 1]#, % [11: 1] OVERFLOW 01289000
RSLTCC = [37: 1]#, % [10: 1] CONTROL CARD 01290000
RSLTVY = [38: 1]#, % [ 9: 1] VALIDITY 01291000
RSLTET = [39: 1]#, % [ 8: 1] END OF TAPE 01292000
RSLTMA = [40: 1]#, % [ 7: 1] MEMORY ACCESS 01293000
RSLTUF = RSLTCC#,% UNDERFLOW 01294000
RSLTWL = RSLTVY#;% WRITE LOCK-OUT 01295000
DEFINE % I/O CONTROL WORD DEFINES 01296000
IOABIT = [ 2: 1]#, % [45: 1] ATTENTION 01297000
IOWBIT = [ 3: 1]#, % [44: 1] MEMORY WRITE 01298000
IOIBIT = [ 4: 1]#, % [43: 1] MEMORY INHIBIT 01299000
IOXBIT = [ 5: 1]#, % [42: 1] TRANSLATE 01300000
IOSBIT = [ 6: 1]#, % [41: 1] FRAME LENGTH (0 = 6 BIT;1= 8 BIT)01301000
IOPBIT = [ 7: 1]#, % [40: 1] MEMORY PROTECT 01302000
IOBBIT = [ 8: 1]#, % [39: 1] BACKWARD TRANSFER 01303000
IOTBIT = [ 9: 1]#, % [38: 1] 01304000
IOTAGS = [10: 2]#, % [37: 1] & [36:1] TAG TRANSFER 01305000
IOSKIP = [12: 4]#, % [35: 4] PRINTER SKIP 01306000
IOSPAC = [16: 2]#; % [31: 2] PRINTER SPACE 01307000
DEFINE RECS = [24:10]#; % [23:10] TAPE SPACE 01308000
SAVE ARRAY MESS [0:BUFRMAX-1];%UTILITY INPUT-OUTPUT AREA 01309000
COMMENT BUFFERS IS INDEXED BY SWITCH FILE INDEX AND HARDWARE TYPE; 01310000
FILE DISKA DISK RANDOM [20:1000] (1, BUFFERS [0, 1],SAVE 99), 01311000
DISKB DISK RANDOM [20:1000] (1, BUFFERS [1, 1],SAVE 99), 01312000
DISKC DISK RANDOM [20:1000] (1, BUFFERS [2, 1],SAVE 99), 01313000
DISKD DISK RANDOM [20:1000] (1, BUFFERS [3, 1],SAVE 99), 01314000
SPO 14 (1, BUFFERS [0, 2]), 01315000
AIDS 14 (1, BUFFERS [0, 3]), 01316000
LP 4 (1, BUFFERS [0, 6]), 01317000
SIMLP 14 (1, BUFFERS [1, 6]), 01318000
CARD (1, BUFFERS [0, 9]), 01319000
PUNCH 0 (1, BUFFERS [0,10]), 01320000
TAPEA 2 (1, BUFFERS [0,13], SAVE 1), 01321000
TAPEB 2 (1, BUFFERS [1,13], SAVE 1), 01322000
TAPEC 2 (1, BUFFERS [2,13], SAVE 1), 01323000
TAPED 2 (1, BUFFERS [3,13], SAVE 1); 01324000
SWITCH FILE TAPES ~ TAPEA, TAPEB, TAPEC, TAPED; 01325000
SWITCH FILE DISKS ~ DISKA, DISKB, DISKC, DISKD; 01326000
SWITCH FILE LINES ~ LP, SIMLP; 01327000
COMMENT 01328000
******************************* 01329000
***** B6500 WORD FORMAT ***** 01330000
******************************* 01331000
SEGMENT DESCRIPTOR 01332000
5 5 4 4 4 4 4 4 4 4 3 2 1 01333000
1 0 8 7 6 5 4 3 2 0 9 0 9 0 01334000
-------------------------------------------------------------- 01335000
:X:011:P:C: UNUSED : LENGTH : ADDR : 01336000
-------------------------------------------------------------- 01337000
INDIRECT REFERENCE WORD (NORMAL) 01338000
5 5 4 4 4 4 1 1 01339000
1 0 8 7 6 5 4 3 0 01340000
-------------------------------------------------------------- 01341000
:X:001:U:0: . . . . . .UNUSED. . . . . . . . :ADDRESSCOUPLE : 01342000
-------------------------------------------------------------- 01343000
INDIRECT REFERENCE WORD (STUFFED) 01343100
5 5 4 4 4 4 3 3 2 1 1 1 . 01343200
1 0 8 7 6 5 6 5 0 9 3 2 0 01343300
-------------------------------------------------------------- 01343400
:X:001:U:1: STKNR : DISP :UNUSED :INDEX FIELD : 01343500
-------------------------------------------------------------- 01343600
MARK STACK CONTROL WORD 01344000
5 5 4 4 4 4 3 3 2 1 1 1 1 01345000
1 0 8 7 6 5 6 5 0 9 8 4 3 0 01346000
-------------------------------------------------------------- 01347000
:X:011:DS:E: STKNR : DISP :V:LLF: DF : 01348000
-------------------------------------------------------------- 01349000
PROGRAM CONTROL WORD 01350000
5 5 4 4 4 4 3 3 3 3 2 1 1 1 1 01351000
1 0 8 7 6 5 6 5 3 2 0 9 8 4 3 0 01352000
-------------------------------------------------------------- 01353000
:X:111:UU : STKNR : PSRF : PIRF :N:LLF: SDIF : 01354000
-------------------------------------------------------------- 01355000
RETURN CONTROL WORD 01356000
5 5 4 4 4 4 4 4 3 3 3 3 2 1 1 1 1 01357000
1 0 8 7 6 5 4 3 6 5 3 2 0 9 8 4 3 0 01358000
-------------------------------------------------------------- 01359000
:X:011:X:O:T:F: UNUSED : PSRF : PIRF :N:LLF: SDIF : 01360000
-------------------------------------------------------------- 01361000
SINGLE PRECISION OPERAND 01362000
5 5 4 4 4 4 4 3 3 01363000
1 0 8 7 6 5 4 9 8 01364000
-------------------------------------------------------------- 01365000
:X:000:U:SO:SE: EXPF : MANF : 01366000
-------------------------------------------------------------- 01367000
DOUBLE PRECISION OPERAND 01368000
5 5 4 4 4 4 4 3 3 (FIRST HALF) 01369000
1 0 8 7 6 5 4 9 8 0 01370000
-------------------------------------------------------------- 01371000
:X:010:U:SO:SE: EXPX : MANF : 01372000
-------------------------------------------------------------- 01373000
5 5 4 4 3 3 (SECOND HALF) 01374000
1 0 8 7 9 8 0 01375000
-------------------------------------------------------------- 01376000
:X:010: EXPD EXT. : MANF : 01377000
-------------------------------------------------------------- 01378000
WORD DATA DESCRIPTOR 01379000
5 5 4 4 4 4 4 4 44 4 3 2 1 01380000
1 0 8 7 6 5 4 3 21 0 9 0 9 0 01381000
-------------------------------------------------------------- 01382000
:X:101:P:C:I:S:R:SZ:D: LENGTH/INDEX : ADDR : 01383000
-------------------------------------------------------------- 01384000
STRING DESCRIPTOR (NON-INDEXED) 01385000
5 5 4 4 4 4 4 4 44 4 3 2 1 01386000
1 0 8 7 6 5 4 3 21 0 9 0 9 0 01387000
-------------------------------------------------------------- 01388000
:X:101:P:C:O:S:R: SZ : LENGTH IN CHR : ADDR : 01389000
-------------------------------------------------------------- 01390000
STRING DESCRIPTOR (INDEXED) 01391000
5 5 4 4 4 4 4 4 44 4 3 3 2 1 01392000
1 0 8 7 6 5 4 3 21 0 5 4 0 9 0 01393000
-------------------------------------------------------------- 01394000
:X:101:P:C:1:S:R: SZ :BYTE INX:WORD INDEX: ADDR : 01395000
-------------------------------------------------------------- 01396000
STEP INDEX WORD 01397000
5 5 4 4 3 3 2 1 1 1 01398000
1 0 8 7 6 5 0 9 6 5 0 01399000
-------------------------------------------------------------- 01400000
:X:100: INCREMENT : FINAL VALUE : U :CURRENT VALUE : 01401000
-------------------------------------------------------------- 01402000
; 01403000
%******************************************** 01600000
%***** FORWARD PROCEDURE DECLARATIONS ***** 01601000
%******************************************** 01602000
%%%%% BEGIN OPERATOR FORWARDS %%%%%%%%%% 01603000
DEFINE V = PROCEDURE#, W = ; FORWARD;#; 01604000
V MKST W V IMKS W V NAMC W V VALC W V EVAL W V ENTR W V EXIT W V RETN W 01605000
V IRWL W V PCWL W V BRUN W V BRTR W V BRFL W V DBUN W V DBTR W V DBFL W 01606000
V NOOP W V HALT W V NVLD W V VARI W V ADD W V SUBT W V MULT W V MULX W 01607000
V DIVD W V IDIV W V RDIV W V NTIA W V NTGR W V SNGT W V SNGL W V XTND W 01608000
V JOIN W V SPLT W V LAND W V LOR W V LNOT W V SAME W V LEQV W V GRTR W 01609000
V GREQ W V EQUL W V LSEQ W V LESS W V NEQL W V INDX W V STBR W V NXLN W 01610000
V NXLV W V LOAD W V LODT W V EXCH W V RSDN W V RSUP W V DUPL W V DLET W 01611000
V MVST W V PUSH W V STOD W V STON W V OVRD W V OVRN W V FLTR W V DFTR W 01612000
V ISOL W V DISO W V INSR W V DINS W V SRCH W V LLLU W V ZERO W V ONE W 01613000
V LT8 W V LT16 W V LT48 W V MPCW W V BSET W V DBST W V BRST W V DBRS W 01614000
V CHSN W V CBON W V LOG2 W V STAG W V RTAG W V SINT W V RDLK W V STFF W 01615000
V WHOI W V EEXI W V DEXI W V IDLE W V HEYU W V RPRR W V SPRR W V SCNI W 01616000
V SCNO W V TWSD W V TWSU W V TWOD W V TWOU W V TGTD W V TGTU W V TGED W 01617000
V TGEU W V TEQD W V TEQU W V TLED W V TLEU W V TLSD W V TLSU W V TNED W 01618000
V TNEU W V TWTD W V TWTU W V TWFD W V TWFU W V TUND W V TUNU W V SGTD W 01619000
V SGTU W V SGED W V SGEU W V SEQD W V SEQU W V SLED W V SLEU W V SLSD W 01620000
V SLSU W V SNED W V SNEU W V SWTD W V SWTU W V SWFD W V SWFU W V CGTD W 01621000
V CGTU W V CGED W V CGEU W V CEQD W V CEQU W V CLED W V CLEU W V CLSD W 01622000
V CLSU W V CNED W V CNEU W V UABD W V UABU W V USND W V USNU W V PACD W 01623000
V PACU W V TRNS W V SCLF W V DSLF W V SCRS W V DSRS W V SCRT W V DSRT W 01624000
V SCRR W V DSRR W V SCRF W V DSRF W V OCRX W V SISO W V SXSN W V RTFF W 01625000
V ROFF W V ICVD W V ICVU W V TEED W V TEEU W V EXSD W V EXSU W V EXPU W 01626000
V MCHR W V MVNU W V SFSC W V SRSC W V SFDC W V SRDC W V INSU W V INSC W 01627000
V INSG W V INOP W V RSTF W V ENDF W V MINS W V MFLT W V ENDE W 01628000
%%%%% END OPERATOR FORWARDS %%%%%%%%%% 01629000
DEFINE CHECOP=( (AX.TAG=SINGL OR AX.TAG=DOUBL ) 01700000
AND(BX.TAG=SINGL OR BX.TAG=DOUBL))#, 01701000
CHECOPRNDB=IF NOT (BX.TAG=SINGL OR BX.TAG=DOUBL) 01702000
THEN BEGIN SETINTERRUPT (INVOP)#, 01703000
CHECOPRNDA=IF NOT (AX.TAG=SINGL OR AX.TAG=DOUBL) 01704000
THEN BEGIN SETINTERRUPT(INVOP)#; 01705000
DEFINE PRESENCEBITINTERRUPT= 01706000
BEGIN SETINTERRUPT(PRESBIT); GO TO OC END#, 01707000
INVALIDINDEXINTERRUPT= 01708000
BEGIN SETINTERRUPT(INVINXI); GO TO OC END#, 01709000
INVALIDOPERATORINTERRUPT= 01710000
BEGIN SETINTERRUPT(INVOP); GO TO OC END#; 01711000
PROCEDURE ADJ(NEWAROF,NEWBROF); VALUE NEWAROF,NEWBROF; 01712000
INTEGER NEWAROF,NEWBROF; FORWARD; 01713000
STREAM PROCEDURE MOVE(SOURCE,DESTINATION); 01714000
BEGIN SI~SOURCE; DI~DESTINATION; DS~2 WDS; END MOVE; 01715000
PROCEDURE ERROR(ERRNUM); VALUE ERRNUM; REAL ERRNUM; FORWARD; 01716000
BOOLEAN PROCEDURE EQUAL (A,AX,B,BX); VALUE A,AX,B,BX; REAL A,AX,B,BX; 01717000
EQUAL ~ (AX.[44:4] = BX.[44:4]) AND 01718000
(REAL(BOOLEAN(A) EQV BOOLEAN (B)) = REAL (NOT FALSE)); 01719000
STREAM PROCEDURE DYALS (P, A, N, N1, TURN); VALUE N, N1, TURN; 01720000
BEGIN 01721000
DI ~ P; SI ~ P; SI ~ SI + 15; 01722000
SKIP 5 SB; IF SB THEN DS ~ SET ELSE DS ~ RESET; 01723000
SI ~ A; SI ~ SI + 15; SKIP 5 SB; 01724000
DI ~ A; IF SB THEN DS ~ SET ELSE DS ~ RESET; 01725000
SI ~ P; DI ~ A; SKIP N SB; SKIP N1 DB; TURN BITS; 01726000
DI ~ A; DI ~ DI + 15; SKIP 5 DB; 01727000
SI ~ A; IF SB THEN DS ~ SET ELSE DS ~ RESET; 01728000
DI ~ P; DS ~ RESET; 01729000
DI ~ A; DS ~ RESET; 01730000
END OF DYAL; 01731000
PROCEDURE DYAL (P, A, N, N1, TURN); VALUE N, N1, TURN; 01732000
REAL P, A; 01733000
INTEGER N, N1, TURN; 01734000
BEGIN 01735000
INTEGER NN, NN1; 01736000
NN ~ 47-N; 01737000
NN1 ~ 47-N1; 01738000
DYALS (P, A, NN, NN1, TURN); 01739000
END; 01740000
DEFINE SYLLABLE = (IF PROF THEN SYLLABLES[PSR] ELSE PSYLLABLES)#; 01741000
INTEGER ARRAY SYLLABLES[0:5]; 01742000
INTEGER PROCEDURE PSYLLABLES; FORWARD; % RETURNS P[PSR] 01743000
PROCEDURE STEPPSR(N); VALUE N; INTEGER N; FORWARD; % STEPS PSR+PIR,PROF 01744000
PROCEDURE TRACE; FORWARD; 01745000
PROCEDURE MEMDUMP; FORWARD; 01746000
PROCEDURE SETINTERRUPT(I); VALUE I; INTEGER I; FORWARD; 01747000
INTEGER PROCEDURE LEVEL(WORD); VALUE WORD; REAL WORD; FORWARD; 01748000
INTEGER PROCEDURE DELTA(WORD); VALUE WORD; REAL WORD; FORWARD; 01749000
PROCEDURE ERVSFLOW(OP); VALUE OP; INTEGER OP; FORWARD; 01750000
BOOLEAN PROCEDURE INTEGERIZE(ROUND,REG);VALUE ROUND; 01751000
BOOLEAN ROUND; REAL REG; FORWARD; 01752000
REAL PROCEDURE GETRESULT (MPXAB); VALUE MPXAB; REAL MPXAB; FORWARD; 01753000
PROCEDURE STORE(OP); VALUE OP; REAL OP; FORWARD; 01754000
PROCEDURE WRITETIME; FORWARD; % WRITES OUT TIME SINCE INITIALIZATION 01755000
PROCEDURE HEADINGLINE (LP); FILE LP; FORWARD; 01756000
PROCEDURE INTFAMD(TYPE); VALUE TYPE; REAL TYPE; 01757000
BEGIN 01757100
LABEL INVALIDOP1 , INVALIDOP2 , INVALIDOP3 , INVALIDOP4 , 01757200
INVALIDOP5 , MEMPROT , 01757300
INVINDX2 , PRESBIT1 , PRESBIT2 01757400
,OC , LO , BACKUP , L2 01757500
; 01757600
SWITCH INTERRUPT ~ 01757700
INVALIDOP1 , INVALIDOP2 , INVALIDOP3 , INVALIDOP4 , 01757701
INVALIDOP5 , MEMPROT , 01757702
INVINDX2 , PRESBIT1 , PRESBIT2 01757703
; 01757704
GO TO INTERRUPT[TYPE]; 01757800
INVALIDOP1: ADJ(0,0); GO LO; 01757900
INVALIDOP2: ADJ(0,0); MOVE(C,A); GO LO; 01758000
INVALIDOP3: MOVE(B,A); GO LO; 01758100
INVALIDOP4: AROF ~ TRUE; MOVE(B,A); ADJ(1,0); GO LO; 01758200
INVALIDOP5: ADJ(0,0); MOVE(B,A); 01758300
LO: BX ~ 0; 01758400
AROF ~ BROF ~ TRUE; SDIS ~ 1; 01758500
B ~ INVOP ; 01758600
BACKUP: 01758700
PIR ~ PIR - PICR; PSR ~ OPSR; GO OC; 01758800
MEMPROT: 01758900
ADJ(0,0); 01759000
MOVE(C,A); 01759100
BX ~ 0; 01759200
AROF~BROF~TRUE; SDIS ~ 1; 01759300
B ~ MEMPROI; 01759400
GO BACKUP; 01759500
INVINDX2: 01759600
ADJ(0,0); 01759700
BX ~ A ~ AX ~ 0; 01759800
AROF~BROF~TRUE; SDIS ~ 1; 01759900
B ~ INVINXI; 01760000
GO BACKUP; 01760100
PRESBIT1: 01760200
AROF~FALSE; 01760250
ADJ(0,0); 01760300
MOVE(C,A); 01760500
GO L2; 01760600
PRESBIT2: 01760700
MOVE(X,A); 01760800
AROF ~ TRUE; 01760900
ADJ(0,0); 01761000
MOVE(C,A); 01761200
AROF ~ TRUE; 01761300
ADJ(0,0); 01761400
L2: 01761500
BX ~ 0; 01761600
AROF~BROF~TRUE; SDIS ~ 1; 01761700
B ~ PRESBIT; 01761800
B.SOBIT ~ 1; 01761900
GO BACKUP; 01762000
OC: 01762100
END; 01762200
01762300
PROCEDURE INTFAMA(TYPE); VALUE TYPE; REAL TYPE; 01765000
BEGIN 01765100
DEFINE CLEARAB = A~AX~B~BX ~ 0#; 01765200
IF TYPE < 0 THEN 01765300
BEGIN 01765400
ADJ(0,0); 01765500
CLEARAB; 01765600
B ~ INVOP; 01765700
01765800
END ELSE 01765900
BEGIN 01766000
CLEARAB; 01766100
B ~ ABS(TYPE); 01766200
END; 01766300
AROF ~ BROF ~ TRUE; 01766400
SDIS ~ 1; 01766500
PIR ~ PIR - PICR; PSR ~ OPSR; 01766600
END INTFAMD; 01766700
PROCEDURE INTFAMB(TYPE); VALUE TYPE; REAL TYPE; 01767000
BEGIN 01767100
01767200
IF TYPE=2 THEN 01767300
BEGIN 01767400
ADJ(0,0); MOVE(C,A); 01767500
END ELSE 01767600
MOVE(B,A); 01767700
B ~ BX ~ 0; 01767800
SDIS ~ 1; 01767900
BROF ~ AROF ~ TRUE; 01768000
B ~ INVOP; 01768100
PIR ~ PIR - PICR; PSR ~ OPSR; 01768200
END INFAMB; 01768300
PROCEDURE INTERRUPTCONTROLLER; 01800000
IF BOOLEAN (PTPI) THEN INT ~ 0 ELSE % IGNORE PROC TO PROC IN SIM01800100
BEGIN COMMENT INTERRUPT CONTROLLER IS PRIMARILY CONCERNED WITH01801000
MAKING THE STACK LOOK LIKE A PROCEDURE IS TO BE 01802000
CALLED AND THEN CALLING IT. MUCH OF THE CURRENT CODE01803000
IS CONCERNED WITH INFORMING PEOPLE AS TO WHAT IS 01804000
HAPPENING. 01805000
9/12/67; 01806000
REAL TEMPB, SWFI; 01807000
DEFINE 01808000
BASSDI = 0#, 01809000
BASEXI = 10#, 01810000
BASGCI = 12#, 01811000
BASALI = 14#; 01812000
SWITCH FORMAT INTS 01813000
~(10 ("X"), " INTERRUPT ERROR." ,X2,10("X"))01814000
,(10 ("X"), " MEMORY PROTECT INTERRUPT." ,X2,10("X"))01815000
,(10 ("X"), " INVALID OPERATOR INTERRUPT." ,X2,10("X"))01816000
,(10 ("X"), " DIVIDE BY ZERO INTERRUPT." ,X2,10("X"))01817000
,(10 ("X"), " EXPONENT OVERFLOW INTERRUPT." ,X2,10("X"))01818000
,(10 ("X"), " EXPONENT UNDERFLOW INTERRUPT." ,X2,10("X"))01819000
,(10 ("X"), " INVALID INDEX INTERRUPT." ,X2,10("X"))01820000
,(10 ("X"), " INTEGER OVERFLOW INTERRUPT." ,X2,10("X"))01821000
,(10 ("X"), " BOTTOM OF STACK INTERRUPT." ,X2,10("X"))01822000
,(10 ("X"), " PRESENCE BIT INTERRUPT." ,X2,10("X"))01823000
,(10 ("X"), " SEQUENCE ERROR INTERRUPT," ,X2,10("X"))01824000
,(10 ("X"), " MULTIPLEXOR A INTERRUPT." ,X2,10("X"))01825000
,(10 ("X"), " MULTIPLEXOR B INTERRUPT." ,X2,10("X"))01826000
,(10 ("X"), " INTERVAL TIMER INTERRURT." ,X2,10("X"))01827000
,(10 ("X"), " STACK OVERFLOW INTERRUPT." ,X2,10("X"))01828000
,(10 ("X"), " OPERATOR LOOP INTERRUPT." ,X2,10("X"))01829000
,(10 ("X"), " MEMORY PARITY INTERRUPT." ,X2,10("X"))01830000
,(10 ("X"), " MULTIPLEXOR PARITY INTERRUPT." ,X2,10("X"))01831000
,(10 ("X"), " INVALID ADDRESS INTERRUPT." ,X2,10("X"))01832000
,(10 ("X"), " STACK UNDERFLOW INTERRUPT." ,X2,10("X"))01833000
; 01834000
IF SDIS ! 0 01835000
THEN BEGIN 01836000
TEMPB ~ B; 01837000
ADJ (0, 0); 01838000
AX ~ 0; 01839000
AROF ~ TRUE; 01840000
A ~ 0 & TEMPB [33:33:15]; 01841000
LOG2; 01842000
SWFI ~ B; 01843000
BROF ~ FALSE; 01844000
ADJ (1, 1); 01845000
MOVE (M[D[0] +3], C); 01846000
IF CX.TAG ! PCW 01847000
THEN BEGIN 01848000
WRITE(LP [DBL], INTS [SWFI]); 01849000
MEMDUMP; 01850000
GO EOJ; 01851000
END; 01852000
END 01853000
ELSE IF EXIA ! 0 01854000
THEN BEGIN 01855000
SWFI ~ BASEXI + B - EXTINTI; 01856000
IF SWFI > BASGCI THEN SWFI ~ BASEXI + 1; 01856100
END 01857000
ELSE IF GCIF ! 0 01858000
THEN BEGIN 01859000
SWFI ~ B - INTTIMI + BASGCI + 1; 01860000
INTTIMER ~ 2*36 ; 01861000
END 01862000
ELSE IF INT.[43:5] ! 0 01863000
%LOOP + MPEI + MPXP + INVA + SUFL !0 01864000
THEN BEGIN 01865000
TEMPB ~ B; 01866000
ADJ (0, 0); 01866100
A ~ B - LOOPI + 1; AX ~ 0; 01866200
AROF ~ TRUE; 01866300
LOG2; 01866400
SWFI ~ B + BASALI; 01866450
BROF ~ FALSE; 01866600
ADJ (1, 1); 01866700
END 01867000
ELSE ERROR (101); 01868000
IMKS; 01869000
ADJ (0, 1); 01870000
A ~ 3; 01871000
AX.TAG ~ IRW; 01872000
AROF ~ TRUE; 01873000
RSDN; 01874000
ENTR; 01875000
INT ~ 0; 01876000
IF NOT (TRACEWORD = 0 OR (TRACEWORD } 100 AND TRACTER = 0)) 01877000
THEN BEGIN 01878000
WRITE (LP, INTS [SWFI MOD 20]); 01879000
END; 01880000
END INTERRUPT CONTROLLER; 01881000
PROCEDURE TIMING (OP); 01882000
VALUE OP; 01883000
INTEGER OP; 01884000
BEGIN 01885000
DELTATIME ~ DELTATIME + OP.[41:6]; %%%%%%%%%%% 01886000
REALTIME ~ REALTIME + DELTATIME; 01887000
TIMEOFDAY ~ TIMEOFDAY + DELTATIME; 01887100
DELTATIME ~ 0; 01888000
END; 01889000
PROCEDURE CONTROLSECTION; 02000000
BEGIN 02001000
DEFINE VARIANTESCAPE = 149#, 02002000
SINGLESHOTESCAPED = 210#, 02003000
TRACESCAPE = 202#, 02004000
SINGLESHOTESCAPEU = 218#; 02005000
DEFINE XXXX = NVLD#; 02006000
DEFINE PRIMARYMODETABLE = 02007000
BEGIN 02008000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02009000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02010000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02011000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02012000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02013000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02014000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02015000
VALC; VALC; VALC; VALC; VALC; VALC; VALC; VALC; 02016000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02017000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02018000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02019000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02020000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02021000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02022000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02023000
NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; NAMC; 02024000
ADD ; SUBT; MULT; DIVD; IDIV; RDIV; NTIA; NTGR; 02025000
LESS; GREQ; GRTR; LSEQ; EQUL; NEQL; CHSN; MULX; 02026000
LAND; LOR ; LNOT; LEQV; SAME; VARI; BSET; DBST; 02027000
FLTR; DFTR; ISOL; DISO; INSR; DINS; BRST; DBRS; 02028000
BRFL; BRTR; BRUN; EXIT; STBR; NXLN; INDX; RETN; 02029000
DBFL; DBTR; DBUN; ENTR; EVAL; NXLV; MKST; STFF; 02030000
ZERO; ONE ; LT8 ; LT16; PUSH; DLET; EXCH; DUPL; 02031000
STOD; STON; OVRD; OVRN; XXXX; LOAD; LT48; MPCW; 02032000
SCLF; DSLF; SCRT; DSRT; SCRS; DSRS; SCRF; DSRF; 02033000
SCRR; DSRR; ICVD; ICVU; SNGT; SNGL; XTND; IMKS; 02034000
TEED; PACD; EXSD; TWSD; TWOD; SISO; SXSN; ROFF; 02035000
TEEU; PACU; EXSU; TWSU; TWOU; EXPU; RTFF; HALT; 02036000
TLSD; TGED; TGTD; TLED; TEQD; TNED; TUND; XXXX; 02037000
TLSU; TGEU; TGTU; TLEU; TEQU; TNEU; TUNU; XXXX; 02038000
CLSD; CGED; CGTD; CLED; CEQD; CNED; XXXX; XXXX; 02039000
CLSU; CGEU; CGTU; CLEU; CEQU; CNEU; NOOP; NVLD; 02040000
END#; % OF PRIMARYMODETABLE 02041000
DEFINE VARIANTMODETABLE = 02042000
BEGIN 02043000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02044000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02045000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02046000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02047000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02048000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02049000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02050000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02051000
XXXX; XXXX; JOIN; SPLT; IDLE; SINT; EEXI; DEXI; 02052000
XXXX; XXXX; SCNI; SCNO; XXXX; XXXX; WHOI; HEYU; 02053000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02054000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02055000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02056000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02057000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02058000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02059000
XXXX; XXXX; XXXX; XXXX; XXXX; OCRX; XXXX; XXXX; 02060000
XXXX; XXXX; XXXX; LOG2; XXXX; XXXX; XXXX; XXXX; 02061000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02062000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02063000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02064000
XXXX; XXXX; XXXX; XXXX; XXXX; IRWL; PCWL; MVST; 02065000
XXXX; XXXX; XXXX; XXXX; STAG; RTAG; RSUP; RSDN; 02066000
RPRR; SPRR; RDLK; CBON; LODT; LLLU; SRCH; XXXX; 02067000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02068000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02069000
USND; UABD; TWFD; TWTD; SWFD; SWTD; XXXX; TRNS; 02070000
USNU; UABU; TWFU; TWTU; SWFU; SWTU; XXXX; HALT; 02071000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02072000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02073000
SLSD; SGED; SGTD; SLED; SEQD; SNED; XXXX; XXXX; 02074000
SLSU; SGEU; SGTU; SLEU; SEQU; SNEU; NOOP; NVLD; 02075000
END#; % OF VARIANTMODETABLE 02076000
DEFINE EDITMODETABLE = 02077000
BEGIN 02078000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02079000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02080000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02081000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02082000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02083000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02084000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02085000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02086000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02087000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02088000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02089000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02090000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02091000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02092000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02093000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02094000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02095000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02096000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02097000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02098000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02099000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02100000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02101000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02102000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02103000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02104000
MINS; MFLT; SFSC; SRSC; RSTF; ENDF; MVNU; MCHR; 02105000
INOP; INSG; SFDC; SRDC; INSU; INSC; ENDE; HALT; 02106000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02107000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02108000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; 02109000
XXXX; XXXX; XXXX; XXXX; XXXX; XXXX; NOOP; NVLD; 02110000
END#; % OF EDITMODETABLE 02111000
LABEL PSC,ESCP; 02112000
PSC: VARF~FALSE; 02113000
Q ~ QP ~ N ~ 0; 02114000
OPSR ~ PSR; 02116000
PICR ~ 0; 02117000
ESCP:IF (TS1~REAL(VARF)+REAL(LEEF)+REAL(TEEF)+REAL(SEEF))>1 THEN 02118000
BEGIN ERROR(0); MEMDUMP; GO TO EOJ; 02119000
END; 02120000
T~SYLLABLE; 02121000
IF TS1=0 THEN 02122000
IF (VARF~(T=VARIANTESCAPE)) THEN 02123000
BEGIN 02124000
STEPPSR (1); 02125000
GO TO ESCP; 02126000
END 02127000
ELSE IF T = TRACESCAPE THEN 02128000
BEGIN STEPPSR(1); TRACTER ~ SYLLABLE; 02129000
STEPPSR(1); GO TO PSC; 02130000
END 02131000
ELSE IF NOT BOOLEAN(T.[40:1]) THEN DRS.[42:6] ~ T; 02132000
STEPPSR (1); 02133000
IF TS1=0 THEN CASE T OF PRIMARYMODETABLE 02134000
ELSE IF VARF THEN CASE T OF VARIANTMODETABLE 02135000
ELSE CASE T OF EDITMODETABLE; 02136000
IF STKOVFF THEN BEGIN SETINTERRUPT(STKOVFI); STKOVFF~FALSE END;02136100
TIMING (T); 02137000
END OF CONTROL SECTION; 02138000
INTEGER PROCEDURE PSYLLABLES; 04000000
BEGIN 04001000
IF NOT PROF THEN 04002000
BEGIN MOVE(M[PIR+PBR],P); MEMCYCLE; 04003000
IF PX.TAG!CODE THEN SETINTERRUPT(INVOP); 04004000
PROF:=TRUE; 04005000
SYLLABLES[0] ~P.[ 1:7] & PX [40:47:1]; 04006000
SYLLABLES[1] ~ P.[8:8]; 04007000
SYLLABLES[2] ~ P.[16:8]; 04008000
SYLLABLES[3] ~ P.[24:8]; 04009000
SYLLABLES[4] ~ P.[32:8]; 04010000
SYLLABLES[5] ~ P.[40:8]; 04011000
END; 04012000
PSYLLABLES ~ SYLLABLES[PSR]; 04013000
END PSYLLABLES; 04014000
PROCEDURE STEPPSR(N); VALUE N; INTEGER N; 04015000
BEGIN 04016000
LABEL L; 04017000
INTEGER PICRT; 04018000
L: IF (PSR ~ PSR + N) } 6 04019000
THEN BEGIN 04020000
PICRT ~ PSR DIV 6; 04021000
PICR ~ PICR + PICRT; 04022000
PIR ~ PIR + PICRT; 04023000
PSR ~ PSR MOD 6; 04024000
PROF ~ FALSE; 04025000
END; 04026000
IF PSR < 0 04027000
THEN BEGIN 04028000
PSR ~ PSR + ABS(N); 04029000
DO PIR ~ PIR - 1 UNTIL N ~ N + 6 } 0; 04030000
GO L; 04031000
END; 04032000
END STEPPSR; 04033000
PROCEDURE SETINTERRUPT(I); VALUE I; INTEGER I; 04034000
BEGIN 04035000
ADJ (0, 0); % TEMPORARY NO FLOWS 04036000
INT ~ B ~ I; 04037000
BX ~ 0; 04038000
BROF ~ TRUE; 04039000
AROF ~ TRUE; 04040000
END SETINTERRUPT; 04041000
PROCEDURE NOTYETCODED; 04042000
BEGIN 04043000
FORMAT F (10("X")," OPERATOR NOT YET CODED ",84("X")); 04044000
WRITETIME; 04045000
HEADING; 04046000
WRITE(LP,F); 04047000
MEMDUMP; 04048000
GO TO EOJ; 04049000
END NOTYETCODED; 04050000
PROCEDURE WRITETIME; 04051000
BEGIN 04052000
REAL E,P; 04053000
FORMAT TIMES (10("-")," B5500 TIME SINCE START OF RUN: ", 04054000
"PROCESSOR TIME =",F9.3," SECONDS, ", 04055000
"ELAPSED TIME =",F9.3," SECONDS "8("-")); 04056000
E~(TIME(1)-ETIME)/60; P~(TIME(2)-PTIME)/60; 04057000
HEADING; 04058000
WRITE(LP,TIMES,P,E); 04059000
END WRITETIME; 04060000
PROCEDURE MKST ; % MARK STACK 07000000
BEGIN 07001000
ERVSFLOW (10); 07002000
07003000
07004000
07005000
07006000
07007000
07008000
END MKST; 07009000
PROCEDURE IMKS ; % INSERT MARK STACK * 07010000
BEGIN 07011000
% REVISED PER L. HANSON FLOWS 8/8/68 BY B.M.M. 07012000
ADJ(1,1); 07013000
MOVE(B,C); 07014000
BX ~ 2|MSCW; 07015000
B ~ S + 1 - F; 07016000
F ~ S + 1; 07017000
ADJ(1,0); 07018000
MOVE(C,B); 07019000
BROF~TRUE; 07020000
END IMKS; 07021000
PROCEDURE NAMC ; % NAME CALL 07022000
BEGIN 07023000
ADJ(0,2); 07024000
C ~ SYLLABLE & DRS [34:42:6]; 07025000
CX ~ 2|IRW; 07026000
AROF:=TRUE; 07027000
MOVE (C, A); 07028000
STEPPSR(1); 07029000
END NAMC; 07030000
PROCEDURE VALC ; % VALUE CALL 07031000
BEGIN 07032000
ERVSFLOW(1); 07033000
END VALC; 07034000
PROCEDURE EVAL ; % EVALUATE DESCRIPTOR 07035000
BEGIN 07036000
ERVSFLOW(2); 07037000
END EVAL; 07038000
PROCEDURE ENTR ; % ENTER 07039000
BEGIN 07040000
ERVSFLOW(3); 07041000
END ENTR; 07042000
PROCEDURE EXIT ; % EXIT 07043000
BEGIN 07044000
ERVSFLOW(4); 07045000
END EXIT; 07046000
PROCEDURE RETN ; % RETURN 07047000
BEGIN 07048000
ERVSFLOW(5); 07049000
END RETN; 07050000
PROCEDURE IRWL ; % (HARDWARE PSEUDO-INSTRUCTION) 07051000
BEGIN 07052000
ERVSFLOW(19); 07053000
END IRWL; 07054000
PROCEDURE PCWL ; % (HARDWARE PSEUDO INSTRUCTION) 07055000
BEGIN 07056000
ERVSFLOW (20); 07057000
END PCWL; 07058000
PROCEDURE BRUN ; % BRANCH UNCONDITIONAL 07059000
BEGIN 07060000
ERVSFLOW(17); 07061000
END BRUN; 07062000
PROCEDURE BRTR ; % BRANCH TRUE 07063000
BEGIN 07064000
ERVSFLOW(15); 07065000
END BRTR; 07066000
PROCEDURE BRFL ; % BRANCH FALSE 07067000
BEGIN 07068000
ERVSFLOW(16); 07069000
END BRFL; 07070000
PROCEDURE PCWORD; % PROGRAM CONTROL WORD 07071000
BEGIN 07072000
LABEL OC; 07073000
IF LL ! C.LLF 07074000
THEN SETINTERRUPT (INVOP) 07075000
ELSE BEGIN 07076000
PDR ~ C.SDIF; 07077000
PSR ~ C.PSRF; 07078000
PIR ~ C.PIRF; 07079000
MOVE (M[D[C.[34:1]] + C.[35:13]], C); 07080000
MEMCYCLE; 07081000
IF CX.TAG ! SEGDESC 07082000
THEN BEGIN 07083000
SETINTERRUPT (INVOP); 07084000
GO OC; 07085000
END 07086000
ELSE IF CX.PBIT ! 1 07087000
THEN BEGIN 07088000
SETINTERRUPT (PRESBIT); 07089000
GO OC; 07090000
END 07091000
ELSE BEGIN 07092000
PBR ~ C.ADDR; 07093000
PROF ~ AROF ~ FALSE; 07094000
END; 07095000
END; 07096000
OC: END FETCH OF PROGRAM CONTROL WORD; 07097000
PROCEDURE DYNAMICBRANCH; % UTILITY PROCEDURE FOR DYNAMIC BRANCHES 07098000
BEGIN 07099000
INTEGER TTAG; 07100000
LABEL IRWORD; 07101000
IF (TTAG ~ AX.TAG) = SINGL OR TTAG = DOUBL 07102000
THEN BEGIN 07103000
IF A < 0 OR A } 2*21 OR INTEGERIZE(TRUE, A) 07104000
THEN SETINTERRUPT (INVOP) 07105000
ELSE BEGIN 07106000
PSR ~ IF BOOLEAN (A)THEN 3 ELSE 0; 07107000
PIR ~ A.[27:20]; 07108000
PROF ~ AROF ~ FALSE; 07109000
END 07110000
END 07111000
ELSE BEGIN 07112100
MOVE (A, C); 07113000
IRWORD: IF TTAG ~ CX. TAG = IRW 07114000
THEN BEGIN 07115000
IF C.EBIT = 0 07116000
THEN BEGIN 07117000
MOVE(M[D[LEVEL(C)]+DELTA(C)],C); 07118000
MEMCYCLE; 07119000
GO TO IRWORD; 07120000
END 07121000
ELSE SETINTERRUPT (INVOP); 07122000
END 07123000
ELSE IF TTAG ! PCW 07124000
THEN SETINTERRUPT (INVOP) 07125000
ELSE PCWORD; 07126000
END; 07127000
END OF DYNAMIC BRANCH UTILITY ROUTINE; 07128000
PROCEDURE DBUN; % DYNAMIC BRANCH UNCONDITIONAL DBUN07129000
BEGIN 07130000
ERVSFLOW(14); 07131000
END DBUN; 07132000
PROCEDURE DBTR; % DYNAMIC BRANCH ON TRUE DBTR07133000
BEGIN 07134000
ERVSFLOW(12); 07135000
END DBTR; 07136000
PROCEDURE DBFL; % DYNAMIC BRANCH ON FALSE 07137000
BEGIN 07138000
ERVSFLOW(13); 07139000
END DBFL; 07140000
PROCEDURE NOOP ; % NO OPERATION 07141000
BEGIN 07142000
END NOOP; 07143000
PROCEDURE HALT ; % CONDITIONAL HALT 07144000
BEGIN 07145000
FILE SPO 11(1,10); 07145010
FORMAT HALTER("**B6500/SIM: PDR = ",I3,":PIR = ",I4,"~"); 07145020
IF HALTING=0 THEN WRITE(SPO,HALTER,PDR,PIR); 07145030
WHILE HALTING=0 DO WHEN(10); 07145040
CASE HALTING MOD 4 OF 07145050
BEGIN 07145060
; 07145070
NOTYETCODED; 07145080
MEMDUMP; 07145090
; 07145100
END; 07146000
END HALT; 07147000
PROCEDURE NVLD ; % INVALID OPERATOR 07148000
BEGIN 07149000
SETINTERRUPT(INVOP); 07150000
END NVLD; 07151000
PROCEDURE VARI ; % ESCAPE TO 16-BIT INSTRUCTION 07156000
BEGIN 07157000
ERROR(1); MEMDUMP; GO TO EOJ; 07158000
END VARI; 07159000
PROCEDURE ADD ; % ADD 07160000
BEGIN 07161000
DEFINE FORCESEGMENTATION = #; %>RETRO07161099
ADJ(1,1); 07162000
IF NOT CHECOP THEN INTFAMA(-1) ELSE 07163000
IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07164000
BEGIN 07165000
B:= B + A; 07166000
BX.PBIT:= REAL(AROF:=FALSE); 07167000
END ELSE 07168000
BEGIN 07169000
IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07170000
IF BX.TAG=SINGL THEN Y:=YX:= 0; 07171000
DOUBLE(A,X,B,Y,+,~,B,Y); 07172000
BX~DOUBL+DOUBL; 07173000
AROF:=FALSE; 07174000
END; 07175000
END ADD ; 07176000
PROCEDURE SUBT ; % SUBTRACT 07177000
BEGIN 07178000
DEFINE FORCESEGMENTATION = #; %>RETRO07178099
ADJ(1,1); 07179000
IF NOT CHECOP THEN INTFAMA(-1) ELSE 07180000
IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07181000
BEGIN 07182000
B:= B - A; 07183000
BX.PBIT:= REAL(AROF:=FALSE); 07184000
END ELSE 07185000
BEGIN 07186000
IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07187000
IF BX.TAG=SINGL THEN Y:=YX:= 0; 07188000
DOUBLE(B,Y,A,X,-,~,B,Y); 07189000
BX~DOUBL+DOUBL; 07190000
AROF:=FALSE; 07191000
END; 07192000
END SUBT; 07193000
PROCEDURE MULT ; % MULTIPLY 07194000
BEGIN 07195000
DEFINE FORCESEGMENTATION = #; %>RETRO07195099
ADJ(1,1); 07196000
IF NOT CHECOP THEN INTFAMA(-1) ELSE 07197000
IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07198000
BEGIN 07199000
B:= B | A; 07200000
BX.PBIT:= REAL(AROF:=FALSE); 07201000
END ELSE 07202000
BEGIN 07203000
IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07204000
IF BX.TAG=SINGL THEN Y:=YX:= 0; 07205000
DOUBLE(A,X,B,Y,|,~,B,Y); 07206000
BX:=YX:=DOUBL+DOUBL; 07207000
AROF:=FALSE; 07208000
END; 07209000
END MULT; 07210000
PROCEDURE MULX ; % EXTENDED MULTIPLY 07211000
BEGIN 07212000
NOTYETCODED; 07213000
END MULX; 07214000
PROCEDURE DIVD ; % DIVIDE 07215000
BEGIN 07216000
LABEL OC; 07217000
ADJ(1,1); 07218000
IF NOT CHECOP THEN INTFAMA(-1) ELSE 07219000
IF AX.TAG=SINGL AND BX.TAG=SINGL THEN 07220000
IF A=0 THEN BEGIN INTFAMA( DIVZROI); GO OC END ELSE 07221000
BEGIN 07222000
B:= B/A; 07223000
BX.PBIT:= REAL(AROF:=FALSE); 07224000
END ELSE 07225000
BEGIN 07226000
IF AX.TAG=SINGL THEN X:=XX:= 0 ELSE 07227000
IF BX.TAG=SINGL THEN Y:=YX:=0; 07228000
IF A=0 AND X=0 THEN BEGIN INTFAMA(DIVZROI); 07229000
GO TO OC; 07230000
END; 07231000
DOUBLE(B,Y,A,X,/,~,B,Y); 07232000
BX~DOUBL+DOUBL; 07233000
AROF:=FALSE; 07234000
END; 07235000
OC: 07236000
END DIVD; 07237000
PROCEDURE IDIV ; % INTEGER DIVIDE 07238000
BEGIN 07239000
DIVD; 07240000
IF INT =0 07241000
THEN IF INTEGERIZE(FALSE,B) THEN INTFAMA(INTOVFI); 07242000
END IDIV; 07243000
PROCEDURE RDIV ; % REMAINDER DIVIDE 07244000
BEGIN 07245000
LABEL OC; 07246000
INTEGER SIGNQ, SIGNQH; 07247000
REAL TA, TX, TB, TY; 07248000
ADJ (1, 1); 07249000
TA~A; TX~IF AX.TAG!SINGL THEN X ELSE 0; 07250000
TB~B; TY~IF BX.TAG!SINGL THEN Y ELSE 0; 07251000
DIVD; 07252000
IF INT !0 THEN GO TO OC; 07253000
SIGNQ ~ SIGN(B); 07254000
B.SOBIT ~ 0; 07255000
IF INTEGERIZE (FALSE, B) THEN BEGIN ERROR(100); GO OC END; 07256000
Y ~ 0; 07257000
DOUBLE (TB, TY, TA, TX, SIGNQ, SIGNQH, B, Y, |,|, -, ~, B, Y); 07258000
IF INTEGERIZE(FALSE,B) THEN INTFAMA(INTOVFI); 07259000
OC: 07260000
END RDIV; 07261000
PROCEDURE NTIA ; % INTEGER TRUNCATED 07262000
BEGIN 07263000
INTEGER EB; % EXPONENT IN B AT ENTRY,IN CODE USED 07264000
% AS 8-BASED EXPONENT,IN COMMENTS,FOR 07265000
% CONVENIENCE,REFERENCED AS 2-BASED 07266000
DEFINE I1INVALIDOPERATOR = BEGIN 07269000
INTFAMA(-1); 07270000
GO TO OC END#, 07271000
I2INTEGEROVERFLOW = BEGIN 07272000
INTFAMA(INTOVFI); 07273000
GO TO OC END#; 07274000
% INTERRUPT PROCESSING TO BE DEFINED 07275000
LABEL L1,NEGEXPLBL,OC; 07276000
INTEGER T1,T2; % WORKING LOCAL INTEGERS 07277000
ADJ(0,1); 07278000
IF BX.TAG !SINGL AND BX.TAG ! DOUBL THEN I1INVALIDOPERATOR; 07279000
IF(EB~B.EXPF)=0 THEN GO TO L1; 07280000
IF BX.TAG = SINGL THEN Y ~ 0; 07281000
IF B.SEBIT=1 THEN GO TO NEGEXPLBL; 07282000
IF (T1~B.MANF)>8*(13-EB)-1 THEN I2INTEGEROVERFLOW; % IF EB< NB 07283000
T1 ~ T1|8*EB; % T1.[36:39-EB] ~ B.[38-EB:39-EB] 07284000
B.MANF~T1+(T2~Y.MANF) DIV (8*(13-EB));%B~B.[38-EB:39-EB] 07285000
%+Y.[38-EB] 07286000
B.SEXPF ~ 0; 07287000
GO TO L1; 07288000
NEGEXPLBL: 07289000
B.MANF~(T1~B.MANF) DIV (8*EB);%B.[38-EB:39-EB]~B.[38:39-EB] 07290000
% B.[38-EB] ~ 0 IMPLIED 07291000
B.SEXPF ~ 0; 07292000
L1: BX.TAG ~ SINGL; 07293000
OC: 07294000
END NTIA; 07295000
PROCEDURE NTGR; % INTEGERISE ROUNDED 07296000
BEGIN 07297000
INTEGER EB; % EXPONENT IN B AT ENTRY,IN CODE USED 07298000
% AS 8-BASED EXPONENT,IN COMMENTS,FOR 07299000
% CONVENIENCE,REFERENCED AS 2-BASED 07300000
DEFINE I1INVALIDOPERATOR = BEGIN 07303000
INTFAMA(-1); 07304000
GO TO OC END#, 07305000
I2INTEGEROVERFLOW = BEGIN 07306000
INTFAMA(INTOVFI); 07307000
GO TO OC END#; 07308000
% INTERRUPT PROCESSING TO BE DEFINED 07309000
LABEL L1,NEGEXPLBL,L2,L3,L4,OC; 07310000
INTEGER T1,T2; % WORKING LOCAL INTEGERS 07311000
ADJ(0,1); 07312000
IF BX.TAG ! SINGL AND BX.TAG ! DOUBL THEN I1INVALIDOPERATOR; 07313000
IF BX.TAG = SINGL THEN Y ~ 0; 07314000
IF (EB~B.EXPF) = 0 THEN GO TO L1; 07315000
IF B.SEBIT =1 THEN GO TO NEGEXPLBL; 07316000
IF (T1 ~ B.MANF) > 8*(13-EB)-1 THEN I2INTEGEROVERFLOW; % EB{NB 07317000
T1 ~ T1|8*EB; % T1~ B.[38-EB:39-EB] 07318000
B.MANF~T1+(T2~Y.MANF) DIV (8*(13-EB));%B~B.[38-EB:39-EB] 07319000
%+Y.[38:EB] 07320000
Y ~ (T1 ~ Y.MANF)| 8*EB; % Y.[38:39-EB] ~ Y.[38-EB:39-EB] 07321000
% Y.[EB:EB] ~ 0 IMPLIED 07322000
B.SEXPF ~ 0; 07323000
IF BX.TAG=SINGL THEN GO TO L4; 07324000
L1: IF B.SOBIT = 0 THEN GO TO L3; 07325000
IF Y.MANF { 274877906944 THEN GO TO L4; % IF FRACTION { 0.5 07326000
L2: IF B.MANF = 549755813887 THEN I2INTEGEROVERFLOW; % IF B=2*39-1 07327000
B.MANF ~ B.MANF+1; 07328000
GO TO L4; 07329000
L3: IF Y.MANF } 274877906944 THEN GO TO L2 ELSE GO TO L4; 07330000
% LAST STATEMENT EQUIVALENT TO IF FRACTION } 0.5.... 07331000
NEGEXPLBL: 07332000
B.MANF~(T1~B.MANF) DIV (8*EB);%B.[38-EB:39-EB]~B.[38:39-EB] 07333000
% B.[38:EB] ~ 0 IMPLIED 07334000
Y~T1|8*(13-EB); % Y.[38:EB] ~ B.[EB:EB] 07335000
B.SEXPF ~ 0; 07336000
GO TO L1; 07337000
L4: BX.TAG ~ SINGL; 07338000
OC: 07339000
END NTGR; 07340000
PROCEDURE NTGD; % DOUBLE PRECISION INTEGERIZE 07340010
BEGIN 07340020
INTEGER XA, XB, KT, LZCT; 07340060
LABEL OC, L1, L2, L10; 07340070
ADJ (0,1); 07340080
CHECOPRNDB END; IF SDIS = 1 THEN GO TO OC; 07340090
BX.TAG ~ DOUBL; 07340100
A.SEXPF ~ 013; 07340110
IF B.MANF = 0 AND Y.MANF = 0 THEN GO TO L10; 07340120
XA ~ XA & XX[33:47:1] & X[34:1:8] & A[42:3:6]; 07340130
XB ~ XB & YX[33:47:1] & Y[34:1:8] & A[42:3:6]; 07340140
IF XA = XB THEN GO TO OC; 07340150
IF XA > XB THEN 07340160
BEGIN 07340170
IF B.SEXPF ! 1 THEN 07340180
BEGIN 07340190
FOR KT ~ XA - XB STEP -1 UNTIL 0 DO 07340200
BEGIN 07340210
X.[12:36] ~ X.[9:36]; 07340220
X.[9:3] ~ Y.[45:3]; 07340230
Y.[12:36] ~ Y.[9:36]; 07340240
Y.[9:3] ~ B.[45:3]; 07340250
B.[12:36] ~ B.[9:36]; 07340260
B.[9:3] ~ 0; 07340270
END; 07340280
L1: IF X.[9:3] > 4 THEN 07340290
BEGIN 07340300
AX ~ A ~ 0; XX ~ X ~ 0; 07340310
X ~ 1; AX.TAG ~ DOUBL; 07340320
AROF ~ TRUE; 07340330
ADD; 07340340
END; 07340350
GO TO L10; 07340360
END; 07340370
IF B.MANF ! 0 THEN 07340380
BEGIN 07340390
Y.[9:39] ~ B.[9:39]; 07340400
B.[9:39] ~ 0; 07340410
XB ~ XB - XA; 07340420
IF XB < XA THEN 07340430
BEGIN 07340440
FOR KT ~ XA - XB STEP -1 UNTIL 0 DO 07340450
BEGIN 07340460
X.[9:3] ~ Y.[45:3]; 07340470
Y.[12:36] ~ Y.[9:36]; 07340480
Y.[9:3] ~ 0; 07340490
END; 07340500
GO TO L1; 07340510
END; 07340520
END; 07340530
Y.[9:39] ~ 0; 07340540
GO TO L10; 07340550
END; 07340560
XB ~ XB - 13; 07340570
IF XA < XB THEN 07340580
BEGIN 07340590
IF B.MANF ! 0 THEN BEGIN 07340600
SETINTERRUPT (INTOVFI); 07340601
GO TO OC; END; 07340602
B.[9:39] ~ Y.[9:39]; 07340610
Y.[9:39] ~ 0; 07340620
XB ~ XB - 13; 07340630
IF XB > XA THEN BEGIN SETINTERRUPT (INTOVFI); 07340640
GO TO OC; 07340641
END; 07340642
END; 07340650
MOVE (B, JUNK); 07340660
LZCT ~ 0; 07340670
L2: IF JUNK.[9:3] = 0 THEN 07340680
BEGIN 07340690
LZCT ~ LZCT + 1; 07340700
JUNK.[9:36] ~ JUNK.[12:36]; 07340710
GO TO L2; 07340720
END; 07340730
IF LZCT < XB THEN BEGIN SETINTERRUPT (INTOVFI); 07340740
GO TO OC; 07340741
END; 07340742
FOR KT ~ XB STEP -1 UNTIL 0 DO 07340750
BEGIN 07340760
B.[9:36] ~ B.[12:36]; 07340770
B.[45:3] ~ Y.[9:3]; 07340780
Y.[9:36] ~ Y.[12:36]; 07340790
Y.[45:3] ~ 0; 07340800
END; 07340810
B.SEXPF ~ A.SEXPF; 07340820
GO TO OC; 07340830
L10: 07340840
Y.EXPEXT ~ 0; 07340850
B.SEXPF ~ A.SEXPF; 07340860
OC: 07340870
END OF DOUBLE PRECISION INTEGERIZE; 07340880
PROCEDURE SNGT ; % SET TO SINGLE PRECISION, TRUNCATED 07341000
BEGIN 07342000
ADJ(0,1); 07343000
CHECOPRNDB END; 07344000
BX.TAG~Y~YX~0 07345000
END SNGT; 07346000
PROCEDURE SNGL ; % SET TO SINGLE PRECISION; ROUNDED 07347000
BEGIN 07348000
ADJ(0,1); 07349000
CHECOPRNDB END 07350000
ELSE IF BX.TAG=DOUBL THEN 07351000
BEGIN IF X.[9:1]=1 THEN A~ (A+1)&A[1:1:8]; 07352000
AX.TAG ~ X ~ XX ~0; 07353000
BX.TAG~Y~YX~0; 07354000
END; 07355000
END SNGL; 07356000
PROCEDURE XTND ; % SET TO DOUBLE PRECISION 07357000
BEGIN 07358000
ADJ(0,1); 07359000
CHECOPRNDB END 07360000
ELSE IF BX.TAG=SINGL THEN 07361000
BEGIN BX.TAG~DOUBL; 07362000
Y~YX~0; 07363000
END; 07364000
END XTND; 07365000
PROCEDURE JOIN; % MAKE TWO SINGLES INTO A DOUBLE PRECISION OPERAND 07366000
BEGIN 07367000
ADJ (1,1); 07368000
IF NOT CHECOP THEN SETINTERRUPT (INVOP) ELSE 07368200
BEGIN 07368300
Y ~ A; 07368400
BX.TAG ~ DOUBL; 07368500
AROF ~ FALSE 07368600
END; 07368700
END JOIN; 07369000
PROCEDURE SPLT; % MAKE A DOUBLE PRECISION INTO TWO SINGLE OPERANDS 07370000
BEGIN 07371000
ADJ (0,1); 07371100
CHECOPRNDB END 07371200
ELSE IF BX.TAG = DOUBL THEN A ~ Y 07371300
ELSE A ~ 0; 07372000
AX.TAG ~ SINGL; 07372050
BX.TAG ~ SINGL; 07372100
AROF ~ TRUE; 07372200
END SPLT; 07373000
PROCEDURE LAND ; % LOGICAL AND 07374000
BEGIN 07375000
ADJ(1,1); 07376000
B:=REAL(BOOLEAN(A)AND BOOLEAN(B)); 07377000
BX ~ REAL(BOOLEAN(AX) AND BOOLEAN(BX)); 07378000
IF AX.TAG=DOUBL OR BX.TAG=DOUBL THEN 07379000
BEGIN 07380000
IF AX.TAG!DOUBL THEN X:=XX:=0; 07381000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07382000
Y:=REAL(BOOLEAN(Y)AND BOOLEAN(X)); 07383000
YX.PBIT:=REAL(BOOLEAN(YX.PBIT)AND BOOLEAN(XX.PBIT)); 07384000
BX.TAG~DOUBL; 07385000
END; 07386000
AROF:=FALSE; 07387000
END LAND; 07388000
PROCEDURE LOR ; % LOGICAL OR 07389000
BEGIN 07390000
ADJ(1,1); 07391000
B:=REAL(BOOLEAN(A) OR BOOLEAN(B)); 07392000
BX ~ REAL(BOOLEAN(AX) OR BOOLEAN(BX)); 07393000
IF AX.TAG=DOUBL OR BX.TAG=DOUBL THEN 07394000
BEGIN 07395000
IF AX.TAG!DOUBL THEN X:=XX:=0; 07396000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07397000
Y:=REAL(BOOLEAN(Y) OR BOOLEAN(X)); 07398000
YX.PBIT:=REAL(BOOLEAN(YX.PBIT) OR BOOLEAN(XX.PBIT)); 07399000
BX.TAG~DOUBL; 07400000
END; 07401000
AROF:=FALSE; 07402000
END LOR ; 07403000
PROCEDURE LNOT ; % LOGICAL NEGATE 07404000
BEGIN 07405000
ADJ(1,2); 07406000
A:=REAL(NOT BOOLEAN(A)); 07407000
AX ~ REAL(NOT BOOLEAN(AX)); 07408000
IF AX.TAG=DOUBL THEN 07409000
BEGIN 07410000
X:=REAL(NOT BOOLEAN(X)); 07411000
XX.PBIT:=REAL(NOT BOOLEAN(XX.PBIT)); 07412000
END; 07413000
END LNOT; 07414000
PROCEDURE SAME ; % LOGICAL EQUAL 07415000
BEGIN 07416000
REAL PROCEDURE EQUAL(A,B,C,D);VALUE A,B,C,D; REAL A,B,C,D; 07417000
EQUAL~ REAL(REAL(BOOLEAN(A)EQV BOOLEAN(B)) = REAL(NOT FALSE) 07418000
AND C=D); 07419000
ADJ(1,1); 07420000
IF AX.TAG!BX.TAG THEN B:=0 ELSE 07421000
BEGIN 07422000
B:=EQUAL(A,B,AX.PBIT,BX.PBIT); 07423000
IF AX.TAG=DOUBL THEN 07424000
B:=REAL(BOOLEAN(B)AND BOOLEAN(EQUAL(X,Y, 07425000
XX.PBIT,YX.PBIT))); 07426000
END; 07427000
AROF:=FALSE; 07428000
BX.[44:4]:=0; 07429000
END SAME; 07430000
PROCEDURE LEQV ; % LOGICAL EQUIVALENCE 07431000
BEGIN 07432000
ADJ(1,1); 07433000
B:=REAL(BOOLEAN(A)EQV BOOLEAN(B)); 07434000
BX ~ REAL(BOOLEAN(AX) EQV BOOLEAN(BX)); 07435000
IF AX.TAG=DOUBL OR BX.TAG=DOUBL THEN 07436000
BEGIN 07437000
IF AX.TAG!DOUBL THEN X:=XX:=0; 07438000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07439000
Y:=REAL(BOOLEAN(Y)EQV BOOLEAN(X)); 07440000
YX.PBIT:=REAL(BOOLEAN(YX.PBIT)EQV BOOLEAN(XX.PBIT)); 07441000
BX.TAG~DOUBL; 07442000
END; 07443000
AROF:=FALSE; 07444000
END LEQV; 07445000
DEFINE NOTOPERAND= IF NOT CHECOP THEN BEGIN SETINTERRUPT(INVOP); 07446000
GO TO OC; END#; 07447000
PROCEDURE GRTR ; % GREATER THAN 07448000
BEGIN 07449000
LABEL OC; 07450000
ADJ(1,1); 07451000
NOTOPERAND; 07452000
C:=B; 07453000
B:=REAL(B>A); 07454000
IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07455000
BEGIN 07456000
IF AX.TAG!DOUBL THEN X:=XX:=0 ELSE 07457000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07458000
B:= REAL(Y>X); 07459000
END; 07460000
BX.[44:4 ]:= REAL(AROF:=FALSE); 07461000
OC: 07462000
END GRTR; 07463000
PROCEDURE GREQ ; % GREATER THAN OR EQUAL 07464000
BEGIN 07465000
LABEL OC; 07466000
ADJ(1,1); 07467000
NOTOPERAND; 07468000
C:=B; 07469000
B:=REAL(B}A); 07470000
IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07471000
BEGIN 07472000
IF AX.TAG!DOUBL THEN X:=XX:=0 ELSE 07473000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07474000
B:=REAL(Y}X); 07475000
END; 07476000
BX.[44:4 ]:= REAL(AROF:=FALSE); 07477000
OC: 07478000
END GREQ; 07479000
PROCEDURE EQUL ; % EQUAL 07480000
BEGIN 07481000
LABEL OC; 07482000
ADJ(1,1); 07483000
NOTOPERAND; 07484000
B:=REAL(B=A); 07485000
IF(AX.TAG=DOUBL OR BX.TAG=DOUBL) AND BOOLEAN(B) THEN 07486000
BEGIN 07487000
IF AX.TAG!DOUBL THEN X:=XX:=0 ELSE 07488000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07489000
B:=REAL(Y=X); 07490000
END; 07491000
BX.[44:4 ]:= REAL(AROF:=FALSE); 07492000
OC: 07493000
END EQUL; 07494000
PROCEDURE LSEQ ; % LESS THAN OR EQUAL 07495000
BEGIN 07496000
LABEL OC; 07497000
ADJ(1,1); 07498000
NOTOPERAND; 07499000
C:=B; 07500000
B:=REAL(B{A); 07501000
IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07502000
BEGIN 07503000
IF AX.TAG!DOUBL THEN X:=XX:=0 ELSE 07504000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07505000
B:=REAL(Y{X); 07506000
END; 07507000
BX.[44:4 ]:= REAL(AROF:=FALSE); 07508000
OC: 07509000
END LSEQ; 07510000
PROCEDURE LESS ; % LESS THAN 07511000
BEGIN 07512000
LABEL OC; 07513000
ADJ(1,1); 07514000
NOTOPERAND; 07515000
C:=B; 07516000
B:=REAL(B<A); 07517000
IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07518000
BEGIN 07519000
IF AX.TAG!DOUBL THEN X:=XX:=0 ELSE 07520000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07521000
B:=REAL(Y<X); 07522000
END; 07523000
BX.[44:4 ]:= REAL(AROF:=FALSE); 07524000
OC: 07525000
END LESS; 07526000
PROCEDURE NEQL ; % NOT EQUAL 07527000
BEGIN 07528000
LABEL OC; 07529000
ADJ(1,1); 07530000
NOTOPERAND; 07531000
C:=B; 07532000
B:=REAL(B!A); 07533000
IF (AX.TAG=DOUBL OR BX.TAG=DOUBL) AND (C=A) THEN 07534000
BEGIN 07535000
IF AX.TAG!DOUBL THEN X:=XX:=0 ELSE 07536000
IF BX.TAG!DOUBL THEN Y:=YX:=0; 07537000
B:=REAL(Y!X); 07538000
END; 07539000
BX.[44:4 ]:= REAL(AROF:=FALSE); 07540000
OC: 07541000
END NEQL; 07542000
PROCEDURE INDX ; % INDEX 07543000
BEGIN 07544000
ERVSFLOW(6); 07545000
END INDX; 07546000
PROCEDURE STBR; % STEP AND BRANCH 07547000
BEGIN 07548000
ERVSFLOW (9); 07549000
END STBR; 07550000
PROCEDURE NXLN ; % INDEX AND LOAD NAME 07551000
BEGIN 07552000
ERVSFLOW(7); 07553000
END NXLN; 07554000
PROCEDURE NXLV ; % INDEX AND LOAD VALUE 07555000
BEGIN 07556000
ERVSFLOW(8); 07557000
END NXLV; 07558000
PROCEDURE LOAD ; % LOAD 07559000
BEGIN 07560000
LABEL OC; 07561000
ADJ(1,2); 07562000
MOVE(A,C); 07563000
CASE CX.TAG OF 07564000
BEGIN 07565000
INVALIDOPERATORINTERRUPT; 07566000
IF NOT BOOLEAN(C.EBIT) THEN % NORMAL IRW 07567000
MM~D[LEVEL(C)]+DELTA(C) 07568000
ELSE BEGIN %STUFFED IRW 07569000
IF(SNR=C.STKNR)THEN TEMP~BOSR 07570000
ELSE BEGIN 07571000
MOVE(M[D0+2],C); MEMCYCLE; 07572000
IF NOT BOOLEAN(CX.PBIT) THEN 07573000
PRESENCEBITINTERRUPT; 07574000
IF C.LENGTH<A.STKNR THEN 07575000
INVALIDINDEXINTERRUPT; 07576000
MOVE(M[C.ADDR+A.STKNR],C); MEMCYCLE; 07577000
IF NOT BOOLEAN(CX.PBIT) THEN 07578000
PRESENCEBITINTERRUPT; 07579000
TEMP~C.ADDR; 07580000
END; 07581000
MM~A.DISP+A.[35:13]+TEMP; 07582000
END; 07583000
INVALIDOPERATORINTERRUPT; 07584000
INVALIDOPERATORINTERRUPT; 07585000
INVALIDOPERATORINTERRUPT; 07586000
% D A T A D E S C R I P T O R 07587000
IF NOT BOOLEAN(CX.PBIT) THEN PRESENCEBITINTERRUPT 07588000
ELSE IF NOT BOOLEAN(C.IBIT) THEN 07589000
INVALIDOPERATORINTERRUPT 07590000
ELSE MM~C.ADDR+C.LENGTH; 07591000
INVALIDOPERATORINTERRUPT; 07592000
INVALIDOPERATORINTERRUPT; 07593000
END; 07594000
IF MM + MM > MEMMODS %LOAD 07594100
THEN BEGIN 07594200
SETINTERRUPT (INVADRI); 07594300
GO OC 07594400
END; 07594500
MOVE(M[MM],A); MEMCYCLE; 07595000
CASE AX.TAG OF 07596000
BEGIN 07597000
; % SINGLE PRECISION OPERAND 07598000
; % IRW 07599000
BEGIN MOVE (M[MM+1], X); MEMCYCLE END; % DOUBLE PRECISION 07600000
INVALIDOPERATORINTERRUPT; % TAG=3 S.D MSCW RCW 07601000
; %UNASSIGNED 07602000
% D A T A D E S C R I P T O R 07603000
BEGIN 07603100
IF (AX.PBIT=0 AND A.CBIT=0) THEN 07604000
A.ADDR ~ MM; A.CBIT ~ 1 END; 07605000
; %UNINITIALIZED OPERAND 07606000
INVALIDOPERATORINTERRUPT; % PROGRAM CONTROL WORD 07607000
END; 07608000
OC: 07609000
END LOAD; 07610000
PROCEDURE LODT ; % LOAD TRANSPARENT 07611000
BEGIN 07612000
LABEL OC; 07613000
ADJ(1,2); 07614000
MOVE(A,C); MM~ C.ADDR; 07615000
CASE CX.TAG OF 07616000
BEGIN 07617000
; % SINGLE PRECISION OPERAND 07618000
IF NOT BOOLEAN(C.EBIT) THEN % NORMAL IRW 07619000
MM~ D[LEVEL(C)] + DELTA(C) 07620000
ELSE BEGIN % STUFFED IRW 07621000
IF SNR=C.STKNR THEN TEMP~ BOSR 07622000
ELSE BEGIN 07623000
MOVE(M[D0+2],C); MEMCYCLE; 07624000
IF NOT BOOLEAN(CX.PBIT) THEN 07625000
PRESENCEBITINTERRUPT; 07626000
IF C.LENGTH < A.STKNR THEN 07627000
INVALIDINDEXINTERRUPT; 07628000
MOVE(M[C.ADDR+A.STKNR],C); MEMCYCLE; 07629000
IF NOT BOOLEAN(CX.PBIT) THEN 07630000
PRESENCEBITINTERRUPT; 07631000
TEMP~ C.ADDR; 07632000
END; 07633000
MM~ A.DISP + A.[35:13] + TEMP; 07634000
END; 07635000
; % DOUBLE PRESESION OPERAND 07636000
; % TAG = 3 S.D. MSCW RCW 07637000
; % UNASSIGNED 07638000
% D A T A D E S C R I P T O R 07639000
IF NOT BOOLEAN(CX.PBIT) THEN PRESENCEBITINTERRUPT 07640000
ELSE IF BOOLEAN(C.IBIT) THEN MM~ C.ADDR + C.LENGTH; 07641000
; % UNINITIALIZED OPERAND 07642000
; % PROGRAM CONTROL WORD 07643000
END; 07644000
IF MM + MM > MEMMODS THEN SETINTERRUPT (INVADRI) ELSE % LODT 07644900
MOVE(M[MM],A); MEMCYCLE; 07645000
OC: 07646000
END LODT; 07647000
PROCEDURE EXCH ; % EXCHANGE 07648000
BEGIN 07649000
REAL T1,T2; 07650000
ADJ(1,1); 07651000
MOVE(A,T1); 07652000
MOVE(B,A); 07653000
MOVE(T1,B); 07654000
MOVE(X,T1); 07655000
MOVE(Y,X); 07656000
MOVE(T1,Y); 07657000
END EXCH; 07658000
PROCEDURE RSDN ; % ROTATE STACK DOWN 07659000
BEGIN 07660000
ADJ(1,1); 07661000
MOVE(B,C); 07662000
MOVE(Y,AA); 07663000
BROF:=FALSE; 07664000
ADJ(1,1); 07665000
EXCH; 07666000
ADJ(1,0); 07667000
MOVE(C,B); 07668000
BROF~TRUE; 07669000
MOVE(C,B); 07670000
MOVE(AA,Y); 07671000
EXCH; 07672000
AROF~TRUE; 07673000
END RSDN; 07674000
PROCEDURE RSUP ; % ROTATE STACK UP 07675000
BEGIN 07676000
ADJ(1,1); 07677000
MOVE(A,C); 07678000
MOVE(X,AA); 07679000
AROF:=FALSE; 07680000
ADJ(1,1); 07681000
EXCH; 07682000
ADJ(1,0); 07683000
MOVE(C,B); 07684000
MOVE(AA,Y); 07685000
BROF:=TRUE; 07686000
END RSUP; 07687000
PROCEDURE DUPL ; % DUPLICATE TOP OF STACK 07688000
BEGIN 07689000
ADJ(0,1); 07690000
MOVE(B,A); 07691000
MOVE(Y,X); 07692000
AROF:=TRUE; 07693000
END DUPL; 07694000
PROCEDURE DLET ; % DELETE TOP OF STACK 07695000
BEGIN 07696000
ADJ(1,2); 07697000
AROF:=FALSE; 07698000
END DLET; 07699000
PROCEDURE MVST ; % MOVE STACK 07700000
BEGIN 07701000
ERVSFLOW(11); 07702000
END MVST; 07703000
PROCEDURE PUSH ; % PUSH DOWN STACK REGISTERS 07704000
BEGIN 07705000
ADJ(0,0); 07706000
END PUSH; 07707000
PROCEDURE STOD ; % STORE DESTRUCTIVE 07708000
BEGIN 07709000
STORE(0); 07710000
END STOD; 07711000
PROCEDURE STON ; % STORE NON-DESTRUCTIVE 07712000
BEGIN 07713000
STORE(1); 07714000
END STON; 07715000
PROCEDURE OVRD ; % OVERWRITE DESTRUCTIVE 07716000
BEGIN 07717000
STORE(2); 07718000
END OVRD; 07719000
PROCEDURE OVRN ; % OVERWRITE NON-DESTRUCTIVE 07720000
BEGIN 07721000
STORE(3); 07722000
END OVRN; 07723000
BOOLEAN PROCEDURE GETSYLLABLES (N);% UTILITY FOR FLTR, ISOL AND INSR. 07724000
VALUE N; INTEGER N; 07725000
BEGIN 07726000
DEFINE S = TBUF#; 07727000
INTEGER I,T,J; 07728000
BOOLEAN B; 07729000
LABEL OC; 07729100
DO BEGIN 07730000
T ~ S [I] ~ IF PROF THEN SYLLABLES [PSR] 07731000
ELSE PSYLLABLES; 07732000
J~IF I=N-1 THEN 48 ELSE 47; 07733000
IF B~T>J 07734000
THEN BEGIN INTFAMB(2); GO OC END; 07735000
STEPPSR (1); 07736000
END UNTIL I ~ I + 1 } N OR B; 07737000
GETSYLLABLES ~ B; 07738000
OC: 07738100
END GETSYLLABLES; 07739000
STREAM PROCEDURE MOVEN (S, D, N); VALUE N; 07740000
BEGIN SI ~ S; DI ~ D; DS~N WDS END MOVE OF N WORDS FROM S TO D; 07741000
BOOLEAN PROCEDURE GETGKL (N); % UTILITY FOR DFTR, DISO AND DINS. 07742000
VALUE N; INTEGER N; 07743000
BEGIN 07744000
DEFINE GKL = TBUF#; % MOMENTARY STORAGE 07745000
INTEGER I,J; 07746000
BOOLEAN BOOLE; 07747000
LABEL OC; 07747100
J~48; 07748000
DO BEGIN 07749000
ADJ (0, 1); 07750000
IF BOOLE~INTEGERIZE(TRUE,B) OR B<0 OR B>J 07751000
THEN BEGIN INTFAMB(3); GO OC END 07752000
ELSE GKL [I] ~ B; 07753000
BROF ~ FALSE; 07754000
J~47; 07755000
END UNTIL I ~ I + 1 } N OR BOOLE; 07756000
GETGKL ~ BOOLE; 07757000
OC: 07757100
END VALIDATION OF OPERANDS FOR DYNAMIC FIELD OPERATORS; 07758000
PROCEDURE FLTR ; % FIELD TRANSFER 07759000
BEGIN 07760000
DEFINE S = TBUF#; 07761000
INTEGER K, G, L; 07762000
IF NOT GETSYLLABLES (3) 07763000
THEN BEGIN 07764000
ADJ (1, 1); 07765000
MOVEN (S[0], K, 3); % SYLLABLES TO LOCALS 07766000
DYAL (A, B, G, K, L); % B.[K:L]; ~ A.[G:L] 07767000
AROF ~ FALSE; 07768000
END; 07769000
END FLTR; 07770000
PROCEDURE DFTR ; % DYNAMIC FIELD TRANSFER 07771000
BEGIN 07772000
DEFINE LGK = TBUF#; 07773000
INTEGER L, G, K; % DO NOT DISTURB G, K, OR L 07774000
IF NOT GETGKL (3) % STACK ADJUST AND VALIDITY 07775000
THEN BEGIN 07776000
ADJ (1, 1); 07777000
MOVEN (LGK [0], L, 3); % OPERANDS TO LOCALS 07778000
DYAL (A, B, G, K, L); % B.[K:L] ~ A.[G,L] 07779000
AROF ~ FALSE; 07780000
END; 07781000
END DFTR; 07782000
PROCEDURE ISOL ; % FIELD ISOLATE 07783000
BEGIN 07784000
DEFINE S = TBUF#; 07785000
INTEGER G, L, K ; % DO NOT DISTURB G AND L 07786000
IF NOT GETSYLLABLES (2) 07787000
THEN BEGIN 07788000
ADJ (1, 0); 07789000
MOVEN (S[0], G, 2); % SYLLABLES TO LOCALS 07790000
K ~ L - 1; 07791000
B ~ BX ~ 0; 07792000
DYAL (A, B, G, K, L); % B.[K:L] ~ A.[G:L] 07793000
AROF ~ FALSE; 07794000
BROF ~ TRUE; 07795000
END; 07796000
END ISOL; 07797000
PROCEDURE DISO ; % DYNAMIC FIELD ISOLATE 07798000
BEGIN 07799000
DEFINE LG = TBUF#; 07800000
INTEGER L, G, K; % DO NOT DISTURB L AND G 07801000
IF NOT GETGKL (2) % STACK ADJ & VALIDITY CHECK07802000
THEN BEGIN 07803000
AROF ~ TRUE; % GETGKL SETS FALSE; 07804000
MOVEN (LG[0], L, 2); % OPERANDS TO LOCALS 07805000
K ~ L - 1; 07806000
A ~ AX ~ 0; 07807000
ADJ(1,1); 07808000
DYAL (B, A, G, K, L); % A.[K:L] ~ B.[G:L] 07809000
BROF ~ FALSE; 07810000
END; 07811000
END DISO; 07812000
PROCEDURE INSR ; % FIELD INSERT 07813000
BEGIN 07814000
INTEGER K, L; % DO NOT DISTURB ORDER OF K AND L 07815000
DEFINE S = TBUF#; % ALSO SEE GETSYLLABLES 07816000
IF NOT GETSYLLABLES (2) 07817000
THEN BEGIN 07818000
ADJ (1, 1); 07819000
MOVEN (S[0], K, 2); % SYLLABLES TO LOCALS 07820000
G ~ L - 1; 07821000
DYAL (A, B, G, K, L); % B.[K:L] ~ A.[G:L]; 07822000
AROF ~ FALSE; 07823000
END; 07824000
END INSR; 07825000
PROCEDURE DINS ; % DYNAMIC FIELD INSERT 07826000
BEGIN 07827000
DEFINE LK = TBUF#; 07828000
INTEGER L, K, G; % DO NOT DISTURB ORDER 07829000
ADJ (1, 1); % SAVE A WHILE L & K ARE& 07830000
AROF ~ FALSE; 07831000
IF NOT GETGKL (2) 07832000
THEN BEGIN 07833000
ADJ (0, 1); 07834000
% AROF ~ TRUE; 07835000
MOVEN (LK[0], L, 2); % L AND K TO LOCALS 07836000
G ~ L - 1; 07837000
DYAL (A, B, G, K, L); % B.[K:L] ~ A.[G:L] 07838000
% AROF ~ FALSE; 07839000
END; 07840000
END DINS; 07841000
PROCEDURE SRCH ; % MASKED SEARCH FOR EQUAL 07842000
BEGIN 07843000
BOOLEAN FINIS; 07844000
LABEL OC,LOOP,JUMP; 07845000
ADJ (1, 1); % DESCRIPTOR AND MASK 07846000
IF AX.TAG ! DATADESC 07847000
THEN BEGIN 07848000
SETINTERRUPT (INVOP); 07849000
GO OC; 07850000
END; 07851000
IF AX.PBIT!1 THEN BEGIN SETINTERRUPT(PRESBIT); GO OC END; 07852000
MOVE (A, C); 07853000
AROF ~ FALSE; 07854000
ADJ (1, 1); % MASK AND VALUE 07855000
MOVE (A, X); 07856000
IF C.LENGTH=0 THEN GO JUMP; 07857000
LOOP: 07858000
C.LENGTH ~ C.LENGTH - 1; 07859000
JUMP: 07860000
MOVE (M[C.ADDR + C.LENGTH], A); 07861000
MEMCYCLE; 07862000
A ~ REAL (BOOLEAN (A) AND BOOLEAN (X)); 07863000
AX ~ REAL(BOOLEAN(AX) AND BOOLEAN (XX)); 07864000
FINIS ~ EQUAL (A, AX, B, BX); 07865000
IF C.LENGTH!0 AND (NOT FINIS) THEN GO LOOP; 07866000
IF (NOT FINIS) THEN A~1 ELSE A~0&C[28:8:20]; 07867000
AX ~ 0; 07868000
BROF~FALSE; 07869000
OC: 07870000
END SRCH; 07871000
PROCEDURE LLLU ; % LINKED LIST LOOKUP 07872000
BEGIN 07873000
LABEL OC,LOOP,NEG; 07874000
INTEGER PSEUDOA, PSEUDOC; % TO EXPEDITE FLAG BIT TESTING 07875000
ADJ (1, 1); % INDEX AND DATA DESCRIPTOR 07876000
IF INTEGERIZE (TRUE, A) 07877000
THEN BEGIN SETINTERRUPT (INTOVFI); GO OC; END; 07878000
IF BX.TAG ! DATADESC 07879000
THEN BEGIN SETINTERRUPT (INVOP); GO OC END; 07880000
BUF ~ B.ADDR; 07881000
X ~ A & B [8:8:20]; % INITIAL INDEX AND SIZE 07882000
BROF ~ FALSE; 07883000
ADJ (1, 1); % INDEX AND ARGUMENT 07884000
MOVE (A, C); 07885000
PSEUDOA ~ B.[20:28]; % ARGUMENT TO A 07886000
LOOP: IF A.ADDR > X.LENGTH 07887000
THEN BEGIN SETINTERRUPT (INVINXI);GO OC END; 07888000
MOVE (M[BUF + A.ADDR], C); % NEW LINK WORD TO C 07889000
PSEUDOC ~ 0 &C[21:1:27] 07890000
&CX[20:47:1]; 07891000
MEMCYCLE; 07892000
IF PSEUDOA > PSEUDOC 07893000
THEN BEGIN 07894000
X.ADDR ~ A.ADDR; % SAVE THIS INDEX 07895000
A.ADDR ~ C.ADDR; 07896000
IF(A.ADDR=0)THEN BEGIN A~-1; GO NEG END; 07897000
GO LOOP; 07898000
END; 07899000
A ~ X.ADDR; 07900000
NEG: 07901000
AX ~ 0; 07902000
BROF ~ FALSE; 07903000
OC: 07904000
END LLLU; 07905000
PROCEDURE ZERO ; % LIT CALL ZERO 07906000
BEGIN 07907000
ADJ(0,2); 07908000
AX.[44:4]:=A:=0; 07909000
AROF:=TRUE; 07910000
END ZERO; 07911000
PROCEDURE ONE ; % LIT CALL ONE 07912000
BEGIN 07913000
ZERO; 07914000
A:=1; 07915000
END ONE ; 07916000
PROCEDURE LT8 ; % LIT CALL 8 BITS 07917000
BEGIN 07918000
ZERO; 07919000
A:=SYLLABLE; 07920000
STEPPSR(1); 07921000
END LT8; 07922000
PROCEDURE LT16 ; % LIT CALL 16 BITS 07923000
BEGIN 07924000
ZERO; 07925000
A.[32:8]:=SYLLABLE; 07926000
STEPPSR(1); 07927000
A.[40:8]:=SYLLABLE; 07928000
STEPPSR(1); 07929000
END LT16; 07930000
PROCEDURE LT48 ; % LIT CALL 48 BITS 07931000
BEGIN 07932000
REAL T1,T2; 07933000
ZERO; 07934000
IF PSR!0 THEN STEPPSR(6-PSR); T1~SYLLABLE; 07935000
A:=P; 07936000
AX:=PX.PBIT; 07937000
STEPPSR(6); 07938000
END LT48; 07939000
PROCEDURE MPCW ; % MAKE PROGRAM CONTROL WORD 07940000
BEGIN 07941000
LT48; 07942000
AX.TAG ~ PCW; 07943000
END LPCW; 07944000
PROCEDURE BITSET; % UTILITY FOR BIT SETTING OPERATORS 07945000
BEGIN 07946000
INTEGER Z10, Z10X; % Z10X - SAFE IN DYALS 07947000
Z10 ~ T.[44:1] + 1; % NEGATE BIT 3 OF OPERATOR 07948000
DYAL (Z10, B, 0, C, 1); 07949000
END BITSET; 07950000
PROCEDURE BSET ; % BIT SET 07951000
BEGIN 07952000
BRST ; 07953000
END BSET; 07954000
PROCEDURE DBST ; % DYNAMIC BIT SET 07955000
BEGIN 07956000
DBRS; 07957000
END DBST; 07958000
PROCEDURE BRST ; % BIT RESET 07959000
BEGIN 07960000
C ~ PSYLLABLES; 07961000
STEPPSR (1); 07962000
IF C > 47 THEN INTFAMB(2) ELSE BEGIN 07962100
ADJ (0, 1); 07963000
BITSET; 07964000
END; 07964100
END BRST; 07965000
PROCEDURE DBRS ; % DYNAMIC BIT RESET 07966000
BEGIN 07967000
ADJ (0, 1); 07968000
IF INTEGERIZE (TRUE, B) OR B < 0 OR B > 47 07969000
THEN INTFAMB(3) 07970000
ELSE BEGIN 07971000
MOVE (B, C); 07972000
BROF ~ FALSE; 07973000
ADJ (0, 1); 07974000
BITSET; 07975000
END; 07976000
END DBRS; 07977000
PROCEDURE CHSN ; % CHANGE SIGN BIT 07978000
BEGIN 07979000
ADJ(1,2); 07980000
CHECOPRNDA END; 07981000
A.SOBIT~ REAL(NOT BOOLEAN(A.SOBIT)); 07982000
END CHSN; 07983000
PROCEDURE CBON ; % COUNT BINARY ONES 07984000
BEGIN 07985000
INTEGER STREAM PROCEDURE COUNT (W); 07986000
BEGIN 07987000
SI ~ W; 47 (SKIP SB; IF SB THEN TALLY ~ TALLY + 1); 07988000
COUNT ~ TALLY; 07989000
END; 07990000
CHECOPRNDA END; 07991000
AA~COUNT(A)+AX.PBIT; 07992000
IF AX.TAG=DOUBL THEN 07993000
AA~COUNT(X)+XX.PBIT+AA; 07994000
AX ~ 0; 07995000
A~AA; 07996000
END CBON; 07997000
PROCEDURE LOG2; % LEADING ONE TEST LOG207998000
BEGIN 07999000
INTEGER STREAM PROCEDURE LEADING (ONE); 08000000
BEGIN 08001000
SI ~ ONE; 08002000
47 (SKIP SB; IF SB THEN JUMP OUT ELSE TALLY ~ TALLY + 1); 08003000
LEADING ~ TALLY; 08004000
END LEADING; 08005000
ADJ(0,1); 08006000
B~IF BOOLEAN(BX) THEN 48 ELSE 47-LEADING(B); 08007000
BX~0; 08008000
END LOG2; 08009000
PROCEDURE STAG ; % SET TAG FIELD 08010000
BEGIN 08011000
ADJ(1,1); 08012000
BX.TAG:=A.[45:3]; 08013000
AROF:=FALSE; 08014000
END STAG; 08015000
PROCEDURE RTAG ; % READ TAG FIELD 08016000
BEGIN 08017000
ADJ(1,2); 08018000
A:=0&AX[45:44:3]; 08019000
AX.[44:4]:=0; 08020000
END RTAG; 08021000
PROCEDURE SINT ; % SET INTERVAL TIMER 08022000
BEGIN 08023000
ADJ (1, 2); % TEMPORARY NO FLOWS 08024000
INTTIMER ~ (INTTIMER ~ A + .5).[37:11] | 5000 + REALTIME; 08025000
AX ~ 0; 08026000
AROF ~ FALSE; 08027000
IF INTTIMER < IDLETIME OR IDLETIME = 0 THEN IDLETIME~INTTIMER; 08028000
END SINT; 08029000
PROCEDURE RDLK ; % READ WITH LOCK 08030000
BEGIN 08031000
STORE(7); 08032000
END RDLK; 08033000
PROCEDURE STFF ; % STUFF ENVIRONMENT 08034000
BEGIN 08035000
ERVSFLOW(18); 08036000
END STFF; 08037000
PROCEDURE WHOI ; % READ PROCESSOR IDENTIFICATION 08038000
BEGIN 08039000
ADJ (0,2); 08039500
A ~ AX ~ 0; 08040000
A ~ PID; AROF ~ TRUE; 08040500
END WHOI; 08041000
PROCEDURE EEXI ; % ENABLE EXTERNAL INTERRUPTS 08042000
BEGIN 08043000
IF IDLETIME } REALTIME THEN REALTIME ~ IDLETIME; 08043100
IIHF ~ FALSE; 08044000
END EEXI; 08045000
PROCEDURE DEXI ; % DISABLE EXTERNAL IMTERRUPTS 08046000
BEGIN 08047000
IIHF ~ TRUE; 08048000
END DEXI; 08049000
PROCEDURE IDLE ; % IDLE UNTIL INTERRUPT 08050000
BEGIN 08051000
IF NOT NCSF THEN SETINTERRUPT (INVOP) ELSE 08051100
IF IDLETIME } REALTIME % TEMPORARY - NO FLOWS 08052000
THEN BEGIN 08053000
IF DISKLOAD > 0 08054000
THEN BEGIN 08055000
DISKLOAD ~ -1 ; 08056000
INTTIMER ~ IDLETIME ~ CURRENTT ~ 08057000
REALTIME ~ 1 ; 08058000
END ; 08059000
REALTIME ~ IDLETIME; 08060000
IDLETIME ~ CURRENTT; 08061000
END 08062000
ELSE SETINTERRUPT (LOOPI); 08063000
END IDLE; 08064000
PROCEDURE HEYU ; % INTERRUPT OTHER PROCESSOR 08065000
BEGIN 08066000
PTPI ~ 1; 08067000
END HEYU; 08068000
PROCEDURE RPRR ; % READ PROCESSOR REGISTER 08069000
BEGIN 08070000
INTEGER I, J, FREG, CHI, PREG, PREGX; 08070050
LIST MONLIST(M[F+2].[6:6], M[F+2], CX.TAG, CHI, 08070100
C.[3:3],C.[6:3], C.[9:3], C.[12:3], C.[15:3], C.[18:3],C.[21:3]08070200
,C.[24:3],C.[27:3],C.[30:3],C.[33:3],C.[36:3],C.[39:3],C.[42:3]08070300
,C.[45:3], FOR J ~ 0 STEP 1 UNTIL I DO MONITOROUTPUT [J]); 08070400
ADJ (1, 2); 08071000
MOVE (A, C); 08072000
IF C = 64 % TO PROVIDE A MEANS OF 08073000
THEN A ~ TRACTER % PRESERVING TRACTER 08074000
ELSE IF C =63 08074050
THEN BEGIN 08074100
IF PRINTERNOTYETOPENED 08074120
THEN BEGIN PRINTERNOTYETOPENED.[46:1] ~ TRUE; HEADING END; 08074140
FREG ~ F - M[F].DF; 08074150
MOVE (M[F+3], C); 08074200
CHI ~ C.[1:2] & CX[45:47:1]; 08074250
WHILE I < 14 AND FREG > BOSR +2 DO 08074300
BEGIN 08074350
MOVE(M[FREG+1], PREG); 08074375
MONITOROUTPUT [I] ~ PREG .SDIF; 08074400
MONITOROUTPUT[I~I+1] ~ PREG .PIRF; 08074450
FREG ~ FREG - M[FREG].DF; 08074500
I ~ I + 1; 08074550
END; 08074600
I ~ I - 1; 08074650
WRITE (TAPED, MONFMT, MONLIST); 08074700
END ELSE IF C = 62 THEN A ~ IDLETIME ELSE IF C = 61 THEN A ~ REALTIME 08074750
ELSE 08075000
IF C < 32 08076000
THEN A ~ D [C.[43:5]] 08077000
ELSE IF C.[42:2] = 2 08078000
THEN BEGIN % THE MOVES ARE THE SIMULATORS 08079000
%"CORRECTING NETWORK" 08080000
MOVEN (PIR, IRSR, 8); 08081000
A ~ IRSR [C.[45:3]]; 08082000
END 08083000
ELSE BEGIN 08084000
MOVEN (PBR, BRSR, 8); 08085000
A ~ BRSR [C.[45:3]]; 08086000
END; 08087000
END RPRR; 08088000
PROCEDURE SPRR ; % SET PROCESSOR REGISTER 08089000
BEGIN 08090000
ADJ (1, 1); 08091000
MOVE (B, C); 08092000
IF C = 64 % TO PROVIDE A MEANS OF SETTING 08093000
THEN TRACTER ~ A % TRACTER 08094000
ELSE 08095000
IF C < 32 08096000
THEN D [C] ~ A. ADDR 08097000
ELSE IF C.[42:2] = 2 08098000
THEN BEGIN % THE MOVENS ARE THE SIMULATORS 08099000
% "CORRECTING NETWORK 08100000
MOVEN (PIR, IRSR, 8); 08101000
IRSR [C.[45:3]] ~ A.ADDR; 08102000
MOVEN (IRSR, PIR, 8); 08103000
END 08104000
ELSE BEGIN 08105000
MOVEN (PBR, BRSR, 8); 08106000
BRSR [C.[45:3]] ~ A.ADDR; 08107000
MOVEN (BRSR, PBR, 8); 08108000
END; 08109000
AROF ~ BROF ~ FALSE; 08110000
END SPRR; 08111000
PROCEDURE SCNI ; % SCAN IN 08112000
BEGIN 08113000
DEFINE MBIT = MPXAB#, 08114000
HTYPE= MPXHDWE#, 08114050
Z = MPXFC#; 08114100
ADJ (1, 0); 08114200
Y ~ 0; 08114300
CASE A.VARIF OF 08114400
BEGIN 08114500
BEGIN % IO PATH INTERROGATE 0 08114600
IF EVENTS [A.LUNIT].EVBUSY = 0 THEN % UNIT NOT BUSY 08114700
BEGIN 08114800
Y.LUNIT ~ A.LUNIT; 08114810
IF MPX [1, A.LUNIT].HTYPE ! 0 % U CABLED TO MPA08114900
AND MPXOPS [1] ! 0 % MPXA NOT LOADED08115000
THEN BEGIN Y.Z ~ 1; Y.MBIT ~ 1 END; 08115100
IF A.Z = 2 THEN Y ~ 0; 08115150
IF MPX [2, A.LUNIT].HTYPE ! 0 % U CABLED TO MPB08115200
AND MPXOPS [2] ! 0 % MPXB NOT LOADED08115300
THEN BEGIN Y.Z ~ Y.Z + 2; Y.MBIT ~ 1 END; 08115400
END 08115500
END PATH INTERROGATE; 08115600
BEGIN % READ STATUS WORD 1 08115700
IF A.LUNIT = 0 THEN Y ~ STATUSWORD; 08115800
% ONLY ONE VECTOR IN SIMULATOR 08115900
% STATUSWORD BUILT INITIALLY AT CABLING TIME 08116000
END STATUS; 08116100
BEGIN % READ RESULT DESCRIPTOR 2 08116200
Y ~ GETRESULT (A.Z); 08116300
END READ RESULT DESCRIPTOR; 08116500
Y ~ ENTIER (TIMEOFDAY DIV 24); % TIME OF DAY 3 08116600
BEGIN % READ INTERRUPT MASK OR REGISTER 4 08116800
Y ~ IF BOOLEAN (A.LUNIT) % READ MASK 08116900
THEN IF A.Z = 1 THEN INTMASKA ELSE INTMASKB 08117000
ELSE IF A.Z = 1 THEN INTREGA ELSE INTREGB; 08117100
END; 08117200
BEGIN % READ GCA 5 08117300
NOTYETCODED; 08117400
END; 08117500
BEGIN % INTERROGATE UNIT TYPE 6 08117600
IF BOOLEAN (A) 08117700
THEN Y ~ MPX [A.Z, A.LUNIT].HTYPE 08117800
ELSE IF Y ~ MPX [1, A.LUNIT].HTYPE = 0 08117900
THEN Y ~ MPX [2, A.LUNIT].HTYPE; 08118000
END UNIT TYPE; 08118100
; % 7 08118150
; % 8 08118200
; % 9 08118250
; % 10 08118300
; % 11 08118350
; % 12 08118400
; % 13 08118450
; % 14 08118500
BEGIN % READ INTERRUPT LITERAL 15 08118550
BOOLEAN B; 08118560
INTEGER I, MPXI; 08118600
REAL E; 08118605
MPXI ~A.Z; 08118610
IF FIRSTEVENT [MPXI] { REALTIME 08118630
AND FIRSTEVENT[MPXI] !0 08118640
THEN BEGIN 08118650
I ~ FIRSTEVENTI[MPXI]; 08118660
Y ~ MPX[MPXI, I].MPXINT; 08118670
B ~ Y !0; 08118672
MPX [MPXI, I].MPXINT ~ 0; 08118675
WHILE (E ~ EVENTS[I]).EVTIME { REALTIME 08118680
AND E ! 0 AND NOT B 08118685
DO BEGIN 08118690
IF E.EVMPX = MPXI 08118695
THEN BEGIN 08118700
Y ~ MPX[MPXI,I].MPXINT;08118705
B ~ TRUE; 08118707
MPX[MPXI, I].MPXINT ~0;08118710
END; 08118715
I ~ E.EVLINK; 08118720
END 08118725
END 08118730
ELSE Y ~ 0; 08118740
END; 08118750
END CASE; 08118800
B ~ Y; BX ~ 0; 08118850
AROF ~ FALSE; BROF ~ TRUE; 08118900
END SCNI; 08119000
PROCEDURE SCNO ; % SCAN OUT 08120000
BEGIN 08121000
DEFINE MBIT = MPXAB#, 08122000
Z = MPXFC#; 08122200
INTEGER T; 08122400
ADJ (1, 1); 08123000
IF T ~ A.VARIF = 4 OR T = 0 AND NOT NCSF 08124000
THEN SETINTERRUPT (INVOP) 08124300
ELSE CASE T OF 08124600
BEGIN 08124900
BEGIN% INITIATE I/O 0 08125000
MOVE (A, SCANBUSA); 08125300
MOVE (B, DATABUSA); 08125600
MULTIPLEX ~ TRUE; 08125900
MOVE (B, DATABUSA); 08126000
END IIO; 08126300
; % 1 08126600
; % 2 08126900
TIMEOFDAY ~ ENTIER (B | 24); % 3 08127000
IF A.Z = 1 THEN INTMASKA ~ B ELSE INTMASKB ~ B; % 4 08127300
NOTYETCODED; % SET GCA 5 08127600
END CASE; 08127900
AROF ~ BROF ~ FALSE; 08128000
END SCNO; 08129000
BOOLEAN SCANORXFER, XLATE, XFERWD, XFERW, SCANWH; 08130000
08131000
DEFINE QF01 = QP.[47:1]#, QF02 = QP.[46:1]#, QF03 = QP.[45:1]#, 08132000
QF04 = QP.[44:1]#, QH01 = QP.[43:1]#, QH02 = QP.[42:1]#, 08133000
QH03 = QP.[41:1]#, SPSF = QP.[40:1]#, SPRF = QP.[39:1]#, 08134000
DPSF = QP.[38:1]#, P2R2 = QP.[37:1]#, P2R3 = QP.[36:1]#, 08135000
P2R4 = QP.[35:1]#, FWDT = QP.[34:1]#, BKIP = QP.[33:1]#, 08136000
LHFF = QP.[32:1]#, XROF = QP.[31:1]#, SWPS = QP.[30:1]#; 08137000
DEFINE INVOPI = BEGIN SETINTERRUPT (INVOP); GO TO OC END#, 08138000
INTOFL = BEGIN SETINTERRUPT (INTOVFI); GO TO OC END#, 08139000
INVINX = BEGIN SETINTERRUPT (INVINXI); GO TO OC END#, 08140000
MEMPRO = BEGIN SETINTERRUPT (MEMPROI); GO TO OC END#, 08141000
PRESBI = BEGIN SETINTERRUPT (PRESBIT); GO TO OC END#, 08142000
JFIF = BEGIN 08143000
ADJ (0,0); BROF ~ TRUE; AROF ~ TRUE; 08144000
A ~ AX ~ 0; 08144500
B ~ BX ~ 0; SDIS ~ 1; BKIP ~ 1; 08145000
IF QF01 = 1 THEN B.[46:1] ~ 1 ELSE 08146000
IF QF02 = 1 THEN B.[39:1] ~ 1 ELSE 08147000
IF QF03 = 1 THEN B.[47:1] ~ 1 ELSE 08148000
B.[37:1] ~ 1; 08149000
IF P2R2 = 1 THEN A.[46:1] ~ 1 ELSE 08150000
IF P2R3 = 1 THEN A.[46:2] ~ 3 ELSE 08151000
A.[45:3] ~ 4; 08152000
IF QF01 = 1 THEN INVOPI ELSE 08153000
IF QF02 = 1 THEN PRESBI ELSE 08154000
IF QF03 = 1 OR QF04 = 1 THEN MEMPRO 08155000
END#, 08156000
JGIF = BEGIN 08157000
ADJ (0,0); A ~ AX + 0; B ~ BX ~ 0; 08158000
B ~ RPF; BROF ~ TRUE; 08159000
IF TEEF THEN 08160000
BEGIN 08161000
A.ADDR ~ TBR; A.INDEX ~ TIR; 08162000
A.PSRF ~ PSR; A.SBIT ~ 1; AROF ~ TRUE 08163000
END ELSE 08164000
IF FWDT = 1 THEN 08165000
BEGIN AROF ~ TRUE; MOVE (Y, A) END; 08166000
JFIF; 08167000
END#, 08168000
MEMPROTECT = BEGIN 08168100
UPDF ~ TRUE; ENDE; 08168200
QF04 ~ 1; JGIF; 08168300
GO TO OC; 08168310
END#, 08168400
FETCHSOURCE = 08169000
BEGIN 08170000
IF SOPF THEN ELSE 08171000
BEGIN 08172000
IF NOT AROF THEN 08173000
BEGIN 08174000
MM ~ SBR ~ SIR; 08175000
MOVE (M[MM], A); MEMCYCLE; 08176000
AROF ~ TRUE; 08177000
IF BOOLEAN(AX.TAG)THEN MEMPROTECT 08178000
END; 08179000
END; 08180000
END#, 08181000
FETCHDESTINATION = 08182000
BEGIN 08183000
IF NOT BROF THEN 08184000
BEGIN 08185000
MM ~ DBR ~ DIR; 08186000
MOVE (M[MM], B); MEMCYCLE; 08187000
BROF ~ TRUE; 08188000
IF BOOLEAN (BX.TAG) THEN MEMPROTECT 08189000
END; 08190000
END#, 08191000
CHARSZ = BEGIN 08192000
IF SSZ = 0 THEN 08193000
BEGIN 08194000
IF DSZ = 0 THEN SSZ ~ DSZ ~ 6 ELSE 08195000
SSZ ~ DSZ 08196000
END ELSE 08197000
IF DSZ = 0 THEN DSZ ~ SSZ 08198000
END#, 08199000
08200000
08201000
08202000
08203000
COMPARECHAR = IF ACHAR ! BCHAR THEN 08204000
IF ACHAR > BCHAR THEN 08205000
IF RELATION < 3 OR RELATION=5 THEN ELSE 08206000
TFFF ~ FALSE 08207000
ELSE 08208000
IF RELATION.[46:1]=1 THEN ELSE 08209000
TFFF ~ FALSE 08210000
ELSE 08211000
IF RELATION> 3 THEN ELSE TFFF~FALSE#, 08218000
SWITCHSOURCE = 08219000
BEGIN 08220000
IF SIB = 0 THEN 08221000
BEGIN 08222000
IF SOPF THEN 08223000
BEGIN 08224000
IF AX.TAG = DOUBL THEN 08225000
BEGIN 08226000
08227000
JUNK ~ A; 08228000
A ~ X; 08229000
X ~ JUNK; 08230000
END; 08231000
END ELSE 08232000
BEGIN 08232100
AROF ~ FALSE; 08233000
SIR ~ SIR + 1; 08234000
END; 08234100
END; 08235000
END#, 08236000
STOREB = BEGIN 08237000
MOVE (B, M[DBR + DIR]); MEMCYCLE; 08238000
BROF ~ FALSE; 08239000
END#, 08240000
STEPSP = BEGIN 08241000
SIB ~ 0; 08242000
SIR ~ SIR ~ 1; 08243000
END#, 08244000
STEPDP = BEGIN 08245000
DIB ~ 0; 08246000
DIR ~ DIR + 1; 08247000
END#, 08248000
SIBLNG = 2 | REAL (SSZ = 6) + 4 | REAL (SSZ = 8)#, 08249000
DIBLNG = 2 | REAL (DSZ = 6) + 4 | REAL (DSZ = 8)#, 08250000
TWOTO20 = 1048576#, 08251000
DYALSIB = 47 - SIB | SSZ#, 08252000
DYALDIB = 47 - DIB | SSZ#, 08253000
DYALSET = SIB| SSZ - 1#, 08253100
DYALSZ = SIB| SSZ #, 08253200
DYALSIZ = 48 - SIB | SSZ #, 08253300
BUMPSIB = SIB ~ (SIB + 1) MOD (48 DIV SSZ)#, 08254000
BUMPDIB = DIB ~ (DIB + 1) MOD (48 DIV SSZ)#, 08255000
BASE = (IF SOURCE THEN SBR ELSE DBR)#, 08256000
WORDZ = (IF SOURCE THEN SIR ELSE DIR)#, 08257000
BYTE = (IF SOURCE THEN SIB ELSE DIB)#, 08258000
SYZE = (IF SOURCE THEN SSZ ELSE DSZ)#, 08259000
SETUPEXSF = IF EXSF THEN ELSE 08260000
IF NOT RNTF THEN 08261000
BEGIN 08262000
C ~ SYLLABLE; 08263000
CX ~ 0; 08264000
END ELSE 08265000
STEPPSR (1)#; 08266000
PROCEDURE ENTEREDIT (TYPE, UPDATE); 08267000
VALUE TYPE, UPDATE; 08268000
INTEGER TYPE; 08269000
BOOLEAN UPDATE; 08270000
BEGIN 08271000
DEFINE TABLENTER = TYPE = 3#, 08272000
SINGLEPOINT = TYPE = 1#, 08273000
SINGLESHOT = TYPE = 0#; 08274000
LABEL OC, L1, L2, L3, L4, L5; 08275000
IF TABLENTER THEN 08276000
BEGIN 08277000
ADJ (0,1); 08278000
IF BX.TAG ! DATADESC THEN 08279000
BEGIN 08280000
QF01 ~ 1; 08281000
JFIF; 08282000
GO TO OC 08283000
END; 08284000
IF BX.PBIT ! 1 THEN 08285000
BEGIN 08286000
QF02 ~ 1; 08287000
JFIF; 08288000
GO TO OC 08289000
END; 08290000
BROF ~ FALSE; 08291000
TBR ~ B.ADDR; 08292000
IF B.IBIT = 1 THEN TIR ~ B.INDEX 08293000
ELSE TIR ~ 0; 08294000
IF B.SBIT = 1 THEN RNTF ~ TRUE; 08295000
MOVE (B, C); 08296000
GO TO L1; 08297000
END; 08298000
ADJ (0,1); 08299000
IF BX.TAG ! SINGL AND BX.TAG ! DOUBL THEN 08300000
BEGIN 08301000
IF NOT SCANORXFER THEN 08302000
BEGIN 08303000
QF01 ~ 1; 08304000
JFIF; 08305000
GO TO OC 08306000
END ELSE 08307000
BEGIN MOVE(C,Y); C~ 0&REAL(NOT BOOLEAN(CX~0)) 08308000
[28:28:20] END 08308100
END ELSE 08309000
BEGIN NTGR; IF SDIS = 1 THEN INTOFL; 08310000
MOVE (C,Y); MOVE (B,C); 08311000
BROF ~ FALSE; 08312000
END; 08313000
08314000
IF SINGLEPOINT THEN 08315000
BEGIN 08316000
ADJ (0,1); 08317000
AROF ~ TRUE; 08318000
MOVE (B,A) 08319000
END; 08320000
L1: 08321000
ADJ (1,1); 08322000
08322100
SPSF ~ A.SBIT; 08323000
SPRF ~ A.RBIT; 08324000
DPSF ~ B.SBIT; 08325000
IF AX.TAG = SINGL OR AX.TAG = DOUBL THEN 08326000
BEGIN 08327000
08328000
SSZ ~ 0; 08329000
SIB ~ 0; 08330000
SOPF ~ TRUE; 08330500
IF AX.TAG = SINGL THEN MOVE (A,X); 08331000
GO TO L2 08332000
END; 08333000
IF AX.PBIT ! 1 THEN 08334000
BEGIN QF02 ~ 1; GO TO L3 END; 08335000
SBR ~ A.ADDR; 08336000
SSZ ~ IF A.SZ = 0 THEN 6 ELSE 2|A.SZ; 08337000
SIB ~ 0; 08338000
IF A.IBIT ! 0 THEN 08339000
BEGIN 08340000
IF A.SZ ! 0 THEN 08341000
BEGIN 08342000
SIB ~ A.[8:4]; 08343000
SIR ~ A.[12:16]; 08344000
END 08345000
ELSE 08346000
SIR ~ A.INDEX 08347000
END ELSE 08348000
SIR ~ 0; 08349000
08350000
AROF ~ FALSE; 08351000
L2: IF SWPS = 1 THEN GO TO L5; 08352000
IF BX.TAG ! DATADESC THEN 08353000
BEGIN 08354000
L4: 08355000
QF01 ~ 1; 08356000
L3: 08357000
IF SINGLEPOINT THEN 08358000
BROF ~ FALSE; 08359000
AROF ~ TRUE; 08359500
ADJ (0,0); 08360000
MOVE (Y,A); 08360500
IF TABLENTER THEN AROF ~ TRUE ELSE 08361000
BEGIN 08361500
MOVE (C,B); 08362000
BROF ~ TRUE; 08362500
IF FWDT = 1 THEN AROF ~ TRUE; 08363000
END; 08363500
JFIF; 08364000
GO TO OC 08365000
END; 08366000
IF BX.PBIT ! 1 THEN 08367000
BEGIN QF02 ~ 1; GO TO L3 END; 08367500
DBR ~ B.ADDR; 08368000
DSZ ~ IF B.SZ=0 THEN 6 ELSE 2|B.SZ; 08368500
IF AX.TAG = DATADESC THEN 08369000
BEGIN 08369500
IF NOT XLATE THEN 08370000
BEGIN 08370500
IF SSZ ! DSZ THEN GO TO L4 08371000
END; 08371500
END; 08372000
IF NOT XFERWD THEN 08373000
BEGIN 08374000
IF B.RBIT = 1 THEN 08375000
BEGIN 08376000
QF03 ~ 1; 08377000
GO TO L3 08378000
END; 08379000
END; 08380000
L5: DBR ~ B.ADDR; 08380500
DSZ ~ IF B.SZ = 0 THEN 6 ELSE 2 | B.SZ; 08380600
DIB ~ 0; 08381000
IF B.IBIT ! 0 THEN 08382000
BEGIN 08383000
IF B.SZ ! 0 THEN 08384000
BEGIN 08385000
DIB ~ B.[8:4]; 08386000
DIR ~ B.[12:16] 08387000
END ELSE 08388000
DIR ~ B.INDEX 08389000
END ELSE 08390000
DIR ~ 0; 08391000
BROF ~ FALSE; 08392000
IF UPDATE THEN UPDF ~ TRUE; 08393000
IF NOT TABLENTER THEN EXSF ~ ESPF ~ TRUE 08394000
ELSE 08395000
BEGIN 08396000
TEEF ~ TRUE; PSR ~ C.[38:3] 08397000
END; 08398000
OC: 08399000
END ENTEREDIT; 08400000
PROCEDURE XFERWDS (UPDATE,OVERITE); 08400010
VALUE UPDATE, OVERITE; 08400020
BOOLEAN UPDATE, OVERITE; 08400030
BEGIN 08400040
LABEL OC, L1; 08400050
XFERWD ~ OVERITE; 08400055
ENTEREDIT (0,UPDATE); 08400060
IF SIB ! 0 THEN STEPSP; 08400070
IF DIB ! 0 THEN STEPDP; 08400080
IF C.ADDR > 0 THEN 08400090
BEGIN 08400100
RPF ~ C.ADDR; 08400110
WHILE (RPF ~ RPF - 1) } 0 DO 08400120
BEGIN 08400130
IF SOPF THEN ELSE 08400140
BEGIN 08400150
MM ~ SBR ~ SIR; 08400160
MOVE (M[MM], A); MEMCYCLE; 08400170
IF NOT OVERITE THEN 08400180
IF BOOLEAN (AX.TAG) THEN GO L1;08400190
END; 08400200
MM ~ DBR ~ DIR; 08400210
MOVE (M[MM], C); 08400220
IF NOT OVERITE THEN 08400230
BEGIN 08400240
IF BOOLEAN (CX.TAG) THEN GO TO L1;08400250
END; 08400260
MOVE (A, M[MM]); MEMCYCLE; 08400270
IF SOPF THEN 08400280
BEGIN 08400290
IF AX.TAG ! SINGL THEN 08400300
BEGIN 08400310
MOVE (A, JUNK); 08400320
MOVE (X, A); 08400330
MOVE (JUNK, A); 08400340
END 08400350
END ELSE 08400360
SIR ~ SIR + 1; 08400370
DIR ~ DIR + 1; 08400380
END; 08400390
END; 08400400
ENDE; GO TO OC; 08400500
L1: 08400600
UPDF ~ TRUE; 08400700
ENDE; 08400750
QF04 ~ 1; 08400800
JGIF; 08400850
08400900
OC: 08400950
END XFERWDS; 08401000
PROCEDURE XFERWHILE (UPDATE,RELATION); 08402000
VALUE UPDATE, RELATION; 08403000
BOOLEAN UPDATE; 08404000
INTEGER RELATION; 08405000
BEGIN 08406000
REAL ACHAR, BCHAR; 08407000
LABEL OC, L1, L2, L3, L4; 08408000
ADJ (1,1); 08409000
IF AX.TAG ! SINGL THEN 08410000
BEGIN 08411000
QF01 ~ 1; 08412000
JFIF; 08413000
GO TO OC 08414000
END; 08415000
MOVE (A, C); 08416000
AROF ~ FALSE; SCANORXFER ~ TRUE; XFERW ~ TRUE; 08417000
ENTEREDIT (0, UPDATE); 08418000
CHARSZ; 08419000
DYAL (Y, BCHAR, SSZ-1, SSZ-1, SSZ); 08420000
TFFF ~ TRUE; 08420500
RPF ~ C.ADDR; 08421000
IF C.ADDR = 0 THEN 08422000
BEGIN 08423000
ENDE; GO TO OC; 08424000
END; 08425000
L1: FETCHSOURCE; 08426000
FETCHDESTINATION; 08427000
08428000
DYAL (A, ACHAR, DYALSIB, SSZ-1, SSZ); 08429000
COMPARECHAR; 08430000
IF TFFF THEN 08431000
BEGIN 08432000
DYAL (A, B, DYALSIB, DYALDIB, SSZ); 08433000
RPF ~ RPF - 1; 08434000
IF RPF = 0 THEN QH03 ~ 1 ELSE 08435000
L2: BEGIN 08436000
BUMPSIB; 08437000
SWITCHSOURCE; 08438000
BUMPDIB; 08439000
IF DIB = 0 THEN 08440000
BEGIN 08440010
STOREB; DIR ~ DIR + 1 08440020
END; 08440030
IF QH03 = 0 THEN GO TO L1; 08440040
IF UPDF THEN GO TO L3 ELSE GO TO L4; 08440050
END; 08440060
END; 08440070
STOREB; 08440080
IF TFFF THEN GO TO L2; 08440090
L3: ENDE; 08440100
ADJ (0,2); 08440110
A ~ RPF; AX ~ 0; 08440120
AROF ~ TRUE; 08440130
GO TO OC; 08440140
L4: ENDE; 08440150
OC: SCANORXFER ~ FALSE; XFERW ~ FALSE; 08440160
END XFERWHILE; 08440170
PROCEDURE TWSD; % TRANSFER WORDS, DESTRUCTIVE 08440180
BEGIN P2R3 ~ 1; 08440190
XFERWDS (FALSE, FALSE); P2R3 ~ 0; 08440200
END TWSD; 08440210
PROCEDURE TWSU; % TRANSFER WORDS, UPDATE 08440220
BEGIN P2R3 ~ 1; 08440230
XFERWDS (TRUE, FALSE); P2R3 ~ 0; 08440240
END TWSU; 08440250
PROCEDURE TWOD; % TRANSFER WORDS OVERWRITE, DESTRUCTIVE 08440260
BEGIN P2R3 ~ 1; 08440270
XFERWDS (FALSE, TRUE); P2R3 ~ 0; 08440280
END TWOD; 08440290
PROCEDURE TWOU; % TRANSFER WORDS OVERWRITE, UPDATE 08440300
BEGIN P2R3 ~ 1; 08440310
XFERWDS (TRUE, TRUE); P2R3 ~ 0; 08440320
END TWOU; 08440330
PROCEDURE TGTD; % TRANSFER WHILE GREATER, DESTRUCTIVE 08440340
BEGIN P2R4 ~ 1; FWDT ~ 1; 08440350
XFERWHILE (FALSE, 1); P2R4 ~ 0; FWDT ~ 0; 08440360
END TGTD; 08440370
PROCEDURE TGTU; % TRANSFER WHILE GREATER, UPDATE 08440380
BEGIN P2R4 ~ 1; FWDT ~ 1; 08440390
XFERWHILE (TRUE, 1); P2R4 ~ 0; FWDT ~ 0; 08440400
END TGTU; 08440500
PROCEDURE TGED; % TRANSFER WHILE GREATER OR EQUAL, DESTRUCTIVE 08440600
BEGIN P2R4 ~ 1; FWDT ~ 1; 08440700
XFERWHILE (FALSE, 5); P2R4 ~ 0; FWDT ~ 0; 08440800
END TGED; 08440900
PROCEDURE TGEU; % TRANSFER WHILE GREATER OR EQUAL, UPDATE 08441000
BEGIN P2R4 ~ 1; FWDT ~ 1; 08441100
XFERWHILE (TRUE, 5); P2R4 ~ 0; FWDT ~ 0; 08441200
END TGEU; 08441300
PROCEDURE TEQD; % TRANSFER WHILE EQUAL, DESTRUCTIVE 08441400
BEGIN P2R4 ~ 1; FWDT ~ 1; 08441500
XFERWHILE (FALSE, 4); P2R4 ~ 0; FWDT ~ 0; 08441600
END TEQD; 08441700
PROCEDURE TEQU; % TRANSFER WHILE EQUAL, UPDATE 08441800
BEGIN P2R4 ~ 1; FWDT ~ 1; 08441900
XFERWHILE (TRUE, 4); P2R4 ~ 0; FWDT ~ 0; 08442000
END TEQU; 08442100
PROCEDURE TLED; % TRANSFER WHILE LESS OR EQUAL, DESTRUCTIVE 08442200
BEGIN P2R4 ~ 1; FWDT ~ 1; 08442300
XFERWHILE (FALSE, 6); P2R4 ~ 0; FWDT ~ 0; 08442400
END TLED; 08442500
PROCEDURE TLEU; % TRANSFER WHILE LESS OR EQUAL, UPDATE 08442600
BEGIN P2R4 ~ 1; FWDT ~ 1; 08442700
XFERWHILE (TRUE, 6); P2R4 ~ 0; FWDT ~ 0; 08442800
END TLEU; 08442900
PROCEDURE TLSD; % TRANSFER WHILE LESS, DESTRUCTIVE 08443000
BEGIN P2R4 ~ 1; FWDT ~ 1; 08444000
XFERWHILE (FALSE, 3); P2R4 ~ 0; FWDT ~ 0; 08445000
END TLSD; 08446000
PROCEDURE TLSU; % TRANSFER WHILE LESS, UPDATE 08447000
BEGIN P2R4 ~ 1; FWDT ~ 1; 08448000
XFERWHILE (TRUE, 3); P2R4 ~ 0; FWDT ~ 0; 08448500
END TLSU; 08449000
PROCEDURE TNED; % TRANSFER WHILE NOT EQUAL, DESTRUCTIVE 08449500
BEGIN P2R4 ~ 1; FWDT ~ 1; 08450000
XFERWHILE (FALSE, 2); P2R4 ~ 0; FWDT ~ 0; 08451000
END TNED; 08452000
PROCEDURE TNEU; % TRANSFER WHILE NOT EQUAL, UPDATE 08453000
BEGIN P2R4 ~ 1; FWDT ~ 1; 08454000
XFERWHILE (TRUE, 2); P2R4 ~ 0; FWDT ~ 0; 08455000
END TNEU; 08456000
DEFINE MEMPROT = MEMPRO #; 08456500
PROCEDURE XFERWHILETF(TOGLE,UPDATE); 08457000
VALUE TOGLE,UPDATE; 08458000
BOOLEAN TOGLE,UPDATE; 08459000
BEGIN 08460000
LABEL OC,L12,L13,L14,L100,L1; 08461000
BOOLEAN LHFF; 08461100
ADJ (1,2); 08462000
IF AX.TAG ! DATADESC THEN 08463000
BEGIN 08464000
QF01 ~ 1; 08465000
L1: JFIF; 08466000
GO OC; 08467000
END; 08468000
IF AX.PBIT = 0 THEN 08469000
BEGIN 08470000
QF02 ~ 1; 08471000
08472000
GO L1; 08473000
END; 08474000
IF A.IBIT ! 1 THEN TIR ~ 0 ELSE 08475000
TIR ~ IF A.SZ=0 THEN A.[12:16] ELSE A.INDEX; 08476000
TBR ~ A.ADDR + TIR; 08477000
MOVE(A,C); 08478000
AROF ~ FALSE; 08479000
IF UPDATE THEN EXSU ELSE EXSD; 08480000
CHARSZ; 08481000
IF RPF ~ C.ADDR = 0 THEN BEGIN ENDE; GO OC END; 08482000
QH03 ~ 1; 08483000
TFFF ~ TRUE; 08484000
L12: 08484100
FETCHSOURCE; 08485000
IF QH03 = 1 THEN QH03 ~ 0; 08486000
L13: FETCHDESTINATION; 08487000
L14: 08488000
MM ~ DIS ~ 0; 08489000
DYAL(A,MM,DYALSIB,2|REAL(SSZ=8),REAL(SSZ!4)+2|REAL(SSZ=8)); 08490000
MM ~ MM ~ TBR; 08491000
DYAL(A,DIS,DYALSIB+1+2|REAL(SSZ=8),4-REAL(SSZ=4), 08492000
5-REAL(SSZ=4)); 08493000
MOVE(M[MM],Y); MEMCYCLE; 08494000
IF BOOLEAN(YX.TAG) THEN MEMPROTECT; 08495000
DYAL(Y,AA,DIS,0,1); 08496000
Q03F ~ REAL(TFFF~ BOOLEAN(AA) EQV TOGLE); 08497000
IF Q03F=1 THEN DYAL(A,B,DYALSIB,DYALDIB,SSZ); 08498000
RPF ~ RPF -1; 08499000
IF RPF = 0 THEN 08500000
BEGIN 08501000
LHFF ~ TRUE; 08502000
STOREB; 08503000
IF TFFF THEN 08504000
BEGIN 08505000
L100: 08506000
ENDE; 08507000
ADJ(0,2); 08508000
A ~ RPF; AX ~ 0; 08509000
AROF ~ TRUE; 08510000
GO OC; 08511000
END; 08512000
END; 08513000
BUMPSIB; 08514000
SWITCHSOURCE; 08514100
IF BUMPDIB=0 THEN 08514200
BEGIN 08514300
STOREB; 08514400
STEPDP; 08514500
END; 08514600
IF LHFF THEN IF UPDF THEN BEGIN ENDE; GO OC END ELSE GO L100; 08514700
IF SIB=0 THEN GO L12; 08514800
GO L13; 08514900
OC: 08515000
END OF TRANSFER ; 08516000
PROCEDURE TWTD; % TRANSFER WHILE TRUE, DESTRUCTIVE 7.1.19 08517000
BEGIN 08518000
XFERWHILETF( TRUE , FALSE); % TRUE DESTRUCTIVE 08519000
END TWTD; 08520000
PROCEDURE TWTU ; % TRANSFER WHILE TRUE, UPDATE 7.1.20 08521000
BEGIN 08522000
XFERWHILETF( TRUE , TRUE ); % TRUE UPDATE 08523000
END TWTU; 08524000
PROCEDURE TWFD ; % TRANSFER WHILE FALSE, DESTRUCTIVE 7.1.21 08525000
BEGIN 08526000
XFERWHILETF( FALSE, FALSE); % FALSE DESTRUCTIVE 08527000
END TWFD; 08528000
PROCEDURE TWFU ; % TRANSFER WHILE FALSE, UPDATE 7.1.22 08529000
BEGIN 08530000
XFERWHILETF( FALSE, TRUE ); % FALSE UPDATE 08531000
END TWFU; 08532000
PROCEDURE TUND ; % TRANSFER UNCONDITIONAL , DESTRUCTIVE 7.1.23 08533000
BEGIN 08534000
ADJ(0,2); 08535000
A ~ AX ~ 0; 08536000
AROF ~ TRUE; 08537000
XFERWHILE(FALSE,5); 08538000
END TUND; 08539000
PROCEDURE TUNU ; % TRANSFER UNCONDITIONAL , UPDATE 7.1.24 08540000
BEGIN 08541000
ADJ(0,2); 08542000
A~AX~0; 08543000
AROF~TRUE; 08544000
XFERWHILE(TRUE,5); 08545000
END TUNU; 08546000
PROCEDURE SCANWHILE(UPDATE,RELATION); 08547000
VALUE UPDATE,RELATION; 08548000
BOOLEAN UPDATE; 08549000
INTEGER RELATION; 08550000
BEGIN 08551000
REAL ACHAR, BCHAR; 08552000
LABEL OC, L1, L2; 08553000
ADJ(1,1); 08553500
IF AX.TAG ! SINGL THEN 08554000
BEGIN 08554500
QF01 ~ 1; 08555000
JFIF; 08555500
GO TO OC; 08556000
END; 08556500
MOVE(A,C); 08557000
AROF ~ FALSE; SCANORXFER ~ TRUE; SCANWH ~ TRUE; 08557500
ENTEREDIT(1,UPDATE); 08558000
IF SSZ = 0 THEN SSZ ~ 6; 08558500
DYAL(Y,BCHAR, SSZ - 1, SSZ - 1, SSZ); 08559000
TFFF ~ TRUE; 08559500
IF C.ADDR = 0 THEN GO TO L2; 08560000
L1: FETCHSOURCE; 08561000
08562000
DYAL (A, ACHAR,DYALSIB, SSZ - 1, SSZ); 08563000
COMPARECHAR; 08564000
IF NOT TFFF THEN ELSE 08565000
BEGIN 08566000
RPF ~ RPF - 1; 08567000
IF RPF = 0 THEN LHFF ~ 1; 08568000
BUMPSIB; 08569000
SWITCHSOURCE; 08570000
IF LHFF ! 1 THEN GO TO L1; 08571000
L2: IF NOT UPDF THEN 08572000
BEGIN 08572100
ENDE; 08573000
GO TO OC; 08574000
END; 08574100
END; 08575000
ENDE; 08576000
ADJ(0,2); 08577000
A ~ RPF; AX ~ 0; 08578000
AROF ~ TRUE; 08579000
OC: SCANORXFER~ SCANWH ~ FALSE; 08580000
END OF SCANWHILE; 08581000
PROCEDURE SGTD ; % SCAN WHILE GREATER, DESTRUCTIVE 7.2.1 08582000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08583000
SCANWHILE ( FALSE , 1 ); 08584000
END SGTD; 08585000
PROCEDURE SGTU ; % SCAN WHILE GREATER, UPDATE 7.2.2 08586000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08587000
SCANWHILE ( TRUE , 1 ); 08588000
END SGTU; 08589000
PROCEDURE SGED ; % SCAN WHILE GREATER OR EQUAL, DESTRUCTIVE7.2.3 08590000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08591000
SCANWHILE ( FALSE , 5 ); 08592000
END SGED; 08593000
PROCEDURE SGEU ; % SCAN WHILE GREATER OR EQUAL, UPDATE 7.2.4 08594000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08595000
SCANWHILE ( TRUE , 5 ); 08596000
END SGEU; 08597000
PROCEDURE SEQD ; % SCAN WHILE EQUAL, DESTRUCTIVE 7.2.5 08598000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08599000
SCANWHILE ( FALSE , 4 ); 08600000
END SEQD; 08601000
PROCEDURE SEQU ; % SCAN WHILE EQUAL, UPDATE 7.2.6 08602000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08603000
SCANWHILE ( TRUE , 4 ); 08604000
END SEQU; 08605000
PROCEDURE SLED ; % SCAN WHILE LESS OR EQUAL, DESTRUCTIVE 7.2.7 08606000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08607000
SCANWHILE ( FALSE , 6 ); 08608000
END SLED; 08609000
PROCEDURE SLEU ; % SCAN WHILE LESS OR EQUAL, UPDATE 7.2.8 08610000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08611000
SCANWHILE ( TRUE , 6 ); 08612000
END SLEU; 08613000
PROCEDURE SLSD ; % SCAN WHILE LESS, DESTRUCTIVE 7.2.9 08614000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08615000
SCANWHILE ( FALSE , 3 ); 08616000
END SLSD; 08617000
PROCEDURE SLSU ; % SCAN WHILE LESS, UPDATE 7.2.10 08618000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08619000
SCANWHILE ( TRUE , 3 ); 08620000
END SLSU; 08621000
PROCEDURE SNED ; % SCAN WHILE NOT EQUAL, DESTRUCTIVE 7.2.11 08622000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08623000
SCANWHILE ( FALSE , 2 ); 08624000
END SNED; 08625000
PROCEDURE SNEU ; % SCAN WHILE NOT EQUAL, UPDATE 7.2.12 08626000
BEGIN P2R3 ~ 1; FWDT ~ 1; 08627000
SCANWHILE ( TRUE , 2 ); 08628000
END SNEU; 08629000
PROCEDURE SCANWHILETF(TOGLE,UPDATE); 08630000
VALUE TOGLE,UPDATE; 08631000
BOOLEAN TOGLE,UPDATE; 08632000
BEGIN 08633000
LABEL OC,L8 ,L100,L21; 08634000
BOOLEAN LHFF; 08634100
ADJ(1,2); 08635000
IF AX.TAG! DATADESC THEN 08636000
BEGIN 08637000
QF01 ~ 1; 08638000
L21: 08639000
JFIF; 08640000
GO OC; 08641000
END; 08642000
IF AX.PBIT=0 THEN 08643000
BEGIN 08644000
QF02~1; 08644100
GO L21; 08644200
END; 08644300
AROF ~ FALSE; 08645000
IF NOT(BOOLEAN(A.IBIT)) THEN TIR~0 ELSE 08646000
TIR ~ IF A.CHRSZ = 0 THEN A.INDEX ELSE A.TIRF; 08647000
TIR~A.ADDR+TIR; 08648000
ENTEREDIT(1,UPDATE); 08649000
IF SSZ = 0 THEN SSZ ~ 6; 08650000
RPF ~ C.ADDR; 08651000
IF RPF =0 THEN 08652000
BEGIN 08653000
L100: 08654000
ENDE; 08655000
ADJ(0,2); 08656000
A ~RPF; AX ~ 0; 08657000
AROF ~ TRUE; 08658000
GO OC; 08659000
END; 08660000
TFFF ~ TRUE; 08661000
L8: 08662000
FETCHSOURCE; 08663000
MM ~ DIS ~ 0; 08664000
DYAL(A,MM,DYALSIB,2|REAL(SSZ=8),REAL(SSZ!4)+2|REAL(SSZ=4)); 08665000
MOVE(M[MM],Y); MEMCYCLE; 08666000
IF BOOLEAN(YX.TAG) THEN MEMPROTECT; 08667000
DYAL(Y,AA,DIS,0,1); 08668000
Q03F ~ REAL(TFFF~BOOLEAN(AA) EQV TOGLE); 08669000
IF Q03F=0 THEN BEGIN TFFF~FALSE; GO L100 END; 08670000
RPF ~ RPF -1; 08671000
IF RPF = 0 THEN LHFF ~ TRUE; 08672000
BUMPSIB; SWITCHSOURCE; 08673000
IF LHFF THEN IF UPDF THEN GO L100 ELSE BEGIN ENDE; GO OC END; 08674000
GO TO L8; 08675000
08676000
OC: 08677000
END OF SCAN ; 08678000
PROCEDURE SWTD ; % SCAN WHILE TRUE, DESTRUCTIVE 7.2.13 08679000
BEGIN 08680000
SCANWHILETF( TRUE , FALSE); % TRUE DESTRUCTIVE 08681000
END SWTD; 08682000
PROCEDURE SWTU ; % SCAN WHILE TRUE, UPDATE 7.2.14 08683000
BEGIN 08684000
SCANWHILETF( TRUE , TRUE ); % TRUE UPDATE 08685000
END SWTU; 08686000
PROCEDURE SWFD ; % SCAN WHILE FALSE, DESTRUCTIVE 7.2.15 08687000
BEGIN 08688000
SCANWHILETF( FALSE, FALSE); % FALSE DESTRUCTIVE 08689000
END SWFD; 08690000
PROCEDURE SWFU ; % SCAN WHILE FALSE, UPDATE 7.2.16 08691000
BEGIN 08692000
SCANWHILETF( FALSE, TRUE ); % FALSE UPDATE 08693000
END SWFU; 08694000
PROCEDURE COMPARECHRS(UPDATE,RELATION); 08695000
VALUE UPDATE,RELATION; 08696000
BOOLEAN UPDATE; 08697000
INTEGER RELATION; 08698000
BEGIN 08699000
INTEGER ACHAR, BCHAR; 08700000
LABEL OC, L1; 08701000
ENTEREDIT(0,UPDATE); 08702000
CHARSZ; 08703000
RPF ~ C.ADDR; 08704000
IF RPF = 0 THEN 08705000
BEGIN 08706000
ENDE; 08707000
GO TO OC; 08708000
END; 08709000
L1: TFFF ~ TRUE; 08710000
FETCHSOURCE; 08711000
FETCHDESTINATION; 08712000
DYAL(A,BCHAR,DYALSIB, SSZ - 1, SSZ); 08713000
DYAL(B, ACHAR, DYALDIB, SSZ - 1, SSZ); 08714000
COMPARECHAR; 08715000
RPF ~ RPF - 1; 08716000
BUMPSIB; 08717000
SWITCHSOURCE; 08718000
IF BUMPDIB = 0 THEN 08719000
BEGIN 08720000
STEPDP; 08721000
BROF ~ FALSE; 08722000
END; 08723000
IF RPF = 0 THEN 08724000
BEGIN 08725000
BROF ~ FALSE; 08726000
ENDE; 08727000
GO TO OC; 08728000
END; 08729000
GO TO L1; 08730000
OC: 08730500
END OF COMPARE CHARACTERS; 08731000
PROCEDURE CGTD ; % COMPARE CHARACTERS GREATER, DESTRUCTIVE 7.3.1 08732000
BEGIN P2R3 ~ 1; 08733000
COMPARECHRS( FALSE , 1 ); % DESTRUCTIVE GREATER 08734000
END CGTD; 08735000
PROCEDURE CGTU ; % COMPARE CHARACTERS GREATER, UPDATE 7.3.2 08736000
BEGIN P2R3 ~ 1; 08737000
COMPARECHRS( TRUE , 1 ); % UPDATE GREATER 08738000
END CGTU; 08739000
PROCEDURE CGED ; % COMPARE CHARACTERS GREATER OR EQUAL, DST7.3.3 08740000
BEGIN P2R3 ~ 1; 08741000
COMPARECHRS( FALSE , 5 ); % DESTRUCTIVE GREATER EQUAL 08742000
END CGED; 08743000
PROCEDURE CGEU ; % COMPARE CHARACTERS GREATER OR EQUAL, UPD7.3.4 08744000
BEGIN P2R3 ~ 1; 08745000
COMPARECHRS( TRUE , 5 ); % UPDATE GREATER EQUAL 08746000
END CGEU; 08747000
PROCEDURE CEQD ; % COMPARE CHARACTERS EQUAL, DESTRUCTIVE 7.3.5 08748000
BEGIN P2R3 ~ 1; 08749000
COMPARECHRS( FALSE , 4 ); % DESTRUCTIVE EQUAL 08750000
END CEQD; 08751000
PROCEDURE CEQU ; % COMPARE CHARACTERS EQUAL, UPDATE 7.3.6 08752000
BEGIN P2R3 ~ 1; 08753000
COMPARECHRS( TRUE , 4 ); % UPDATE EQUAL 08754000
END CEQU; 08755000
PROCEDURE CLED ; % COMPARE CHARACTERS LESS OR EQUAL, DST 7.3.7 08756000
BEGIN P2R3 ~ 1; 08757000
COMPARECHRS( FALSE , 6 ); % DESTRUCTIVE LESS EQUAL 08758000
END CLED; 08759000
PROCEDURE CLEU ; % COMPARE CHARACTERS LESS OR EQUAL, UPD 7.3.8 08760000
BEGIN P2R3 ~ 1; 08761000
COMPARECHRS( TRUE , 6 ); % UPDATE LESS EQUAL 08762000
END CLEU; 08763000
PROCEDURE CLSD ; % COMPARE CHARACTERS LESS, DESTRUCTIVE 7.3.9 08764000
BEGIN P2R3 ~ 1; 08765000
COMPARECHRS( FALSE , 3 ); % DESTRUCTIVE LESS 08766000
END CLSD; 08767000
PROCEDURE CLSU ; % COMPARE CHARACTERS LESS, UPDATE 7.3.10 08768000
BEGIN P2R3 ~ 1; 08769000
COMPARECHRS( TRUE , 3 ); % UPDATE LESS 08770000
END CLSU; 08771000
PROCEDURE CNED ; % COMPARE CHARACTERS NOT EQUAL, DESTRUCTVE7.3.11 08772000
BEGIN P2R3 ~ 1; 08773000
COMPARECHRS( FALSE , 2 ); % DESTRUCTIVE NOT EQUAL 08774000
END CNED; 08775000
PROCEDURE CNEU ; % COMPARE CHARACTERS NOT EQUAL, UPDATE 7.3.12 08776000
BEGIN P2R3 ~ 1; 08777000
COMPARECHRS( TRUE , 2 ); % UPDATE NOT EQUAL 08778000
END CNEU; 08779000
DEFINE RPZF = BKIP#; 08779500
PROCEDURE UNPACKS(SIGNED,UPDATE); 08780000
VALUE SIGNED,UPDATE; 08781000
BOOLEAN SIGNED,UPDATE; 08782000
BEGIN 08783000
LABEL OC, L1, L2, L3, L4, L5, L6, L7, L8; 08784000
INTEGER RITEJUSTIFY; 08784500
ADJ (1,1); 08785000
IF BX.TAG = SINGL OR BX.TAG = DOUBL THEN ELSE 08785500
BEGIN 08786000
QF01 ~ 1; 08786500
JFIF; 08787000
GO TO OC; 08787500
END; 08788000
ENTEREDIT (0, UPDATE); 08788500
RPF ~ C.ADDR; 08789000
IF C.ADDR > 24 THEN 08789500
BEGIN 08790000
BROF ~ TRUE; 08790500
QF01 ~ 1; 08791000
JFIF; 08791500
GO TO OC; 08792000
END; 08792500
SSZ ~ 4; 08793000
IF DSZ = 0 THEN DSZ ~ 6; 08793500
IF RPF = 0 THEN 08794000
BEGIN 08794500
ENDE; GO TO OC; 08795000
END; 08795500
IF RPF = 1 THEN LHFF ~ 1; 08796000
IF DSZ = 4 THEN RPZF ~ 1; 08796500
L4: FETCHDESTINATION; 08797000
L7: IF DSZ = 4 THEN GO TO L1; 08797500
IF DSZ = 6 THEN GO TO L2; 08798000
IF NOT SIGNED THEN ELSE 08798500
IF LHFF ! 1 THEN ELSE 08799000
IF EXTF THEN 08799500
BEGIN 08800000
RITEJUSTIFY.[40:4] ~ 32; 08800500
GO TO L3; 08801000
END; 08801500
RITEJUSTIFY.[40:4] ~ 36; 08802000
L3: DYAL (RITEJUSTIFY, B, 40, DYALDIB, 4); 08802500
DYAL (A, B, DYALSIB, (DYALDIB - 4), 4); 08803000
GO TO L8; 08803500
L2: IF NOT SIGNED THEN ELSE 08804000
IF LHFF ! 1 THEN ELSE 08804500
IF EXTF THEN 08805000
BEGIN 08805500
RITEJUSTIFY.[42:2] ~ 2; 08806000
GO TO L6; 08806500
END; 08807000
RITEJUSTIFY.[42:2] ~ 0; 08807500
L6: DYAL (RITEJUSTIFY, B, 42, DYALDIB, 2); 08808000
DYAL (A, B, DYALSIB, (DYALDIB - 2), 4); 08808500
GO TO L8; 08809000
L1: IF SIGNED THEN 08809500
BEGIN 08810000
IF RPZF = 1 THEN 08810500
BEGIN 08811000
IF EXTF THEN RITEJUSTIFY ~ 14 ELSE 08811500
RITEJUSTIFY ~ 15; 08812000
DYAL(RITEJUSTIFY,B,3,DYALDIB,4); 08812500
GO TO L5; 08813000
END; 08813500
END; 08814000
DYAL (A, B, DYALSIB, DYALDIB, 4); 08815000
L8: BUMPSIB; 08816000
L5: IF BUMPDIB = 0 THEN 08817000
BEGIN 08818000
STOREB; 08819000
STEPDP; 08820000
END; 08821000
BEGIN 08822000
IF AX.TAG = DOUBL THEN 08822500
BEGIN 08823000
MOVE (A, JUNK); 08823500
MOVE (X, A); 08823800
MOVE (JUNK, X); 08824000
END; 08824400
END; 08824800
IF RPZF = 1 THEN RPZF ~ 0 ELSE 08825000
RPF ~ RPF - 1; 08825500
IF RPF = 0 THEN 08826000
BEGIN 08827000
IF DIB ! 0 THEN BROF ~ TRUE; 08828000
ENDE; 08828500
GO TO OC; 08829000
END; 08830000
IF RPF = 1 THEN LHFF ~ 1; 08831000
IF DIB = 0 THEN GO TO L4; 08832000
GO TO L7; 08833000
OC: 08834000
END OF UNPACKS; 08835000
PROCEDURE PACKS (UPDATE); 08835100
VALUE UPDATE; 08835200
BOOLEAN UPDATE; 08835300
BEGIN 08835400
LABEL OC, L1, L2, L3; 08835500
ENTEREDIT (1, UPDATE); 08835600
RPF ~ C.ADDR; 08835700
IF C.ADDR > 24 THEN 08835800
BEGIN 08835900
AROF ~ TRUE; 08836000
QF01 ~ 1; 08836100
JFIF; 08836200
GO TO OC; 08836300
END; 08836400
IF C.ADDR = 0 THEN 08836500
BEGIN 08836600
ENDE; 08836700
GO TO OC; 08836800
END; 08836900
TFFF~BOOLEAN(B~BX~0); 08836910
IF RPF > 12 THEN 08837000
BEGIN 08837100
BX.TAG ~ DOUBL; 08837200
QH02 ~ 1; 08837300
DIB ~ 24 -RPF; 08837400
END ELSE 08837500
DIB ~ 12 -RPF; 08837600
DSZ ~ 4; 08837700
IF SSZ = 0 THEN 08837800
BEGIN 08837900
SSZ ~ 6; 08838000
MOVE (A, Y); 08838100
END; 08838200
QH03 ~ 1; 08838300
IF NOT SOPF THEN 08838400
BEGIN 08838500
L1: MM ~ SBR + SIR; 08838600
MOVE (M[MM], A); 08838700
IF BOOLEAN (AX.TAG) THEN 08838800
BEGIN 08838900
MOVE (Y, A); 08839000
MOVE (C, B); 08839100
AROF ~ BROF ~ TRUE; 08839200
QF04 ~ 1; 08839300
JFIF; 08839400
GO TO OC; 08839500
END; 08839600
END; 08839700
L3: IF SSZ ! 4 THEN 08839800
BEGIN 08839900
IF SSZ = 6 THEN 08840000
BEGIN DYAL(A,B,DYALSIB-2,DYALDIB,4); 08840100
DYAL(A,INTG,DYALSIB,0,1); TFFF~BOOLEAN(INTG); 08840110
08840120
END ELSE 08840130
BEGIN DYAL(A,B,DYALSIB-4,DYALDIB,4); 08840200
DYAL(A,INTG,DYALSIB-2,0,1); 08840210
TFFF ~ INTG = 0; 08840220
END; 08840230
END ELSE 08840300
IF QH03 = 1 THEN 08840400
BEGIN 08840500
QH03 ~ 0; 08840600
DYAL (A, JUNK, DYALSIB, 44, 4); 08840700
IF JUNK.[44:4] > 9 THEN TFFF~JUNK.[44:4]=1308840800
ELSE DYAL(A,B,DYALSIB,DYALDIB,4); 08840900
END ELSE 08841000
GO TO L2; 08841100
BUMPDIB; 08841200
L2: IF BUMPSIB = 0 THEN 08841300
BEGIN 08841400
IF SOPF THEN 08841500
BEGIN 08841600
MOVE (A, JUNK); 08841700
MOVE (X, A); 08841800
MOVE (JUNK, X); 08841900
END ELSE 08842000
SIR ~ SIR + 1; 08842100
IF DIB ! 0 THEN GO TO L1; 08842200
IF QH02 = 1 THEN 08842300
BEGIN 08842400
QH02 ~ 0; 08842500
GO TO L1; 08842600
END ELSE 08842700
BEGIN 08842800
BROF ~ TRUE; 08842900
ADJ (2, 0); 08843000
ENDE; 08843100
GO TO OC; 08843200
END; 08843300
END ELSE 08843400
IF DIB ! 0 THEN GO TO L3; 08843500
BROF ~ TRUE; 08843600
IF AROF THEN ADJ(1,0) ELSE ADJ(0,0); 08843700
IF QH02 = 1 THEN 08844000
BEGIN 08844500
QH02 ~ 0; 08845000
GO TO L3; 08845500
END; 08846000
TFFF~DSZ=6 AND B.[42:1]=1 OR DSZ =8 AND B.[42:1]=0; 08847000
ENDE; 08847500
OC: 08848000
END OF PACKS; 08848500
08849000
PROCEDURE UABD; % UNPACK ABSOLUTE, DESTRUCTIVE 08849500
BEGIN P2R3 ~ 1; 08850000
UNPACKS (FALSE, FALSE); 08850500
END UABD; 08851000
PROCEDURE UABU; % UNPACK ABSOLUTE, UPDATE 08851500
BEGIN P2R3 ~ 1; 08852000
UNPACKS (FALSE, TRUE); 08852500
END UABU; 08853000
PROCEDURE USND; % UNPACK SIGNED, DESTRUCTIVE 08853500
BEGIN P2R3 ~ 1; 08854000
UNPACKS (TRUE, FALSE); 08854500
END USND; 08855000
PROCEDURE USNU; % UNPACK SIGNED, UPDATE 08855500
BEGIN P2R3 ~ 1; 08856000
UNPACKS (TRUE, TRUE); 08856500
END USNU; 08857000
PROCEDURE PACD; % PACK DESTRUCTIVE 08857500
BEGIN SWPS ~ 1; P2R2 ~ 1; 08858000
PACKS (FALSE); 08858500
END PACD; 08859000
PROCEDURE PACU; % PACK UPDATE 08859100
BEGIN SWPS ~ 1; P2R2 ~ 1; 08859200
PACKS (TRUE); 08859300
END PACU; 08859400
PROCEDURE TRNS ; % TRANSLATE 7.5 08860000
BEGIN 08861000
LABEL OC; 08862000
ADJ(1,2); 08863000
IF AX.TAG ! DATADESC THEN INVOPI; 08864000
IF BOOLEAN(AX) THEN ELSE 08865000
BEGIN 08866000
ADJ(0,0); 08867000
AX ~ BX ~ 0; 08868000
AROF ~ BROF ~ TRUE; 08869000
A ~ S; 08870000
SETINTERRUPT(B~PRESBIT); 08871000
END; 08872000
AROF ~ FALSE; 08873000
IF A.IBIT=0 THEN TIR ~ 0 ELSE 08874000
TIR ~ IF A.CHRSZ = 0 THEN A.INDEX ELSE A.TIRF; 08875000
TBR ~ TIR + A.ADDR; 08876000
ENTEREDIT( 0,FALSE); 08877000
CHARSZ; 08878000
DIS ~ 7; 08879000
RPF ~ C.ADDR - 1; 08880000
WHILE RPF } 0 DO 08881000
BEGIN 08882000
FETCHSOURCE; 08883000
FETCHDESTINATION; 08884000
MM ~ 0; 08885000
DYAL(A,JUNK,DYALSIB,5,SSZ-2); 08886000
IF SSZ=4 THEN MM~JUNK.[42:2] ELSE 08887000
IF SSZ=6 THEN MM~JUNK.[42:4] ELSE MM~JUNK.[42:6]; 08888000
MM ~ TBR + MM; 08889000
DYAL(A,JUNK,DYALSIB-SSZ+2,4,2); 08890000
DIS.[43:2] ~ REAL(NOT BOOLEAN(JUNK)).[43:2]; 08891000
MOVE(M[MM],C); MEMCYCLE; 08892000
DYAL(C,8,DIS,DYALDIB,DSZ); 08893000
RPF ~ RPF - 1; 08894000
BUMPSIB; 08895000
SWITCHSOURCE; 08896000
IF BUMPSIB = 0 THEN 08897000
BEGIN 08898000
STOREB; 08899000
STEPDP; 08900000
DIR ~ DIR + 1; 08901000
END; 08902000
END; 08903000
ENDE; 08904000
OC: 08905000
END TRNS; 08906000
PROCEDURE SCALE(TOG); VALUE TOG; BOOLEAN TOG; 08906010
BEGIN 08906020
DEFINE DYNAMIC = TOG #, %1 08906030
SAVER = TOG.[46:1]#, % 2 08906040
RIGHT = TOG.[45:1]#, % 4 08906050
FINAL = TOG.[44:1]#, % 6 08906060
ROUND = TOG.[43:1]#; % 16 08906070
REAL DIGR, TA, TX; 08906080
LABEL OC; 08906090
INTEGER SIGNQ,SIGNQH; 08906100
DEFINE SETINT = BEGIN 08906110
SETINTERRUPT(INVOP ); 08906120
ADJ(0,0); AROF ~ BROF ~ TRUE; 08906130
GO OC; 08906140
END#; 08906150
ADJ(0,1); 08906160
IF DYNAMIC THEN 08906170
BEGIN 08906180
NTGR; 08906190
IF SDIS=1 THEN 08906200
BEGIN 08906210
SETINTERRUPT(INTOVFI); 08906220
GO OC; 08906230
END; 08906240
END ELSE 08906250
BEGIN 08906260
C ~ SYLLABLE; CX ~ 0; 08906270
STEPPSR(1); 08906280
MOVE(C,A); 08906290
END; 08906300
DIGR ~ A.[44:4]; 08906310
AROF ~ FALSE; 08906320
IF INTEGERIZE(FALSE,B) THEN 08906330
BEGIN 08906340
SETINTERRUPT(INTOVFI); 08906350
GO OC; 08906360
END; 08906370
ADJ(1,0); 08906380
IF DIGR < 13 THEN ELSE 08906390
IF RIGHT THEN SETINT ELSE 08906400
BEGIN 08906410
OFFF ~ TRUE; 08906420
GO OC; 08906430
END; 08906440
IF RIGHT THEN 08906450
BEGIN 08906460
MOVE(A,TA); 08906470
DOUBLE(A,X,10*DIGR,0,/,~,A,X); 08906480
SIGNQ ~ SIGN(A); B.SOBIT ~ 0; 08906490
MOVE(A,SSZ); 08906500
IF INTEGERIZE(FALSE,SSZ) THEN 08906510
BEGIN 08906520
SETINTERRUPT(INTOVFI); 08906530
GO OC; 08906540
END; 08906550
DSZ ~ 0; 08906560
DOUBLE(TA,TX,10*DIGR,0,SIGNQ,SIGNQH,SSZ,DSZ, 08906570
|,|,-,~,TA,TX); 08906580
FOR JUNK~0 STEP 1 UNTIL DIGR-1 DO 08906590
DYAL(TA,B,36-6|JUNK,4|JUNK,4); 08906600
END ELSE 08906610
DOUBLE(A,X,10*DIGR,0,|,~,A,X); 08906620
IF ROUND THEN ELSE GO OC; 08906630
IF FINAL THEN 08906640
BEGIN 08906650
BROF ~ TRUE; 08906660
AROF ~ FALSE; EXTF ~ BOOLEAN(SIGN(A)); 08906670
IF A!0 THEN OFFF ~ TRUE; 08906680
END ELSE 08906690
IF SAVER THEN BROF ~ TRUE ELSE 08906700
IF ROUND THEN 08906710
IF BX.PBIT=1 OR B.[1:3]>4 THEN X ~ X + 1; 08906720
OC: 08906730
END SCALE; 08906740
PROCEDURE SCLF ; % SCALE LEFT 7.6.1 08907000
BEGIN 08908000
SCALE(BOOLEAN( 0)); 08909000
END SCLF; 08910000
PROCEDURE DSLF ; % DYNAMIC SCALE LEFT 7.6.2 08911000
BEGIN 08912000
SCALE(BOOLEAN( 1)); 08913000
END DSLF; 08914000
PROCEDURE SCRS ; % SCALE RIGHT SAVE 7.6.3 08915000
BEGIN 08916000
SCALE(BOOLEAN( 6)); 08917000
END SCRS; 08918000
PROCEDURE DSRS ; % DYNAMIC SCALE RIGHT SAVE 7.6.4 08919000
BEGIN 08920000
SCALE(BOOLEAN( 7)); 08921000
END DSRS; 08922000
PROCEDURE SCRT ; % SCALE RIGHT TRUNCATE 7.6.5 08923000
BEGIN 08924000
SCALE(BOOLEAN(20)); 08925000
END SCRT; 08926000
PROCEDURE DSRT ; % DYNAMIC SCALE RIGHT TRUNCATE 7.6.6 08927000
BEGIN 08928000
SCALE(BOOLEAN(21)); 08929000
END DSRT; 08930000
PROCEDURE SCRR ; % SCALE RIGHT ROUND 7.6.7 08931000
BEGIN 08932000
SCALE(BOOLEAN( 4)); 08933000
END SCRR; 08934000
PROCEDURE DSRR ; % DYNAMIC SCALE RIGHT ROUND 7.6.8 08935000
BEGIN 08936000
SCALE(BOOLEAN( 5)); 08937000
END DSRR; 08938000
PROCEDURE SCRF ; % SCALE RIGHT FINAL 7.6.9 08939000
BEGIN 08940000
SCALE(BOOLEAN(12)); 08941000
END SCRF; 08942000
PROCEDURE DSRF ; % DYNAMIC SCALE RIGHT FINAL 7.6.10 08943000
BEGIN 08944000
SCALE(BOOLEAN(13)); 08945000
END DSRF; 08946000
PROCEDURE OCRX ; % OCCURS INDEX 7.7 08947000
BEGIN 08948000
LABEL OC; 08949000
ADJ(1,1); 08950000
IF AX.TAG=SINGL AND BX.TAG=SINGL OR BX.TAG=DOUBL THEN ELSE 08951000
BEGIN INTFAMA(-1); GO OC END; 08952000
MOVE(A,C); A~AX ~X ~ XX ~ 0; 08953000
A.[32:1] ~ C.[16:16]; 08954000
X.[32:16] ~ 0&CX [32:47:1]&C[33:1:15]; 08955000
AROF ~ FALSE; 08956000
IF INTEGERIZE(FALSE,B) THEN BEGIN INTFAMA(INTOVFI);GO OC END; 08957000
IF B < 0 AND B > A THEN BEGIN INTFAMA(INVINXI); GO OC END; 08958000
MOVE(X,A); XX ~ 0; 08959000
X ~ C.[32:16]; 08960000
AROF ~ TRUE; 08961000
B ~ X + A | (B-1); 08962000
OC: 08966000
END OCRX; 08967000
PROCEDURE SISO; % STRING ISOLATE 08968000
BEGIN 08968100
LABEL OC, L1, L2, L3; 08968200
ENTEREDIT (1, FALSE); 08968300
IF SSZ = 0 THEN SSZ ~ 6; 08968400
IF C.ADDR > (96 DIV SSZ) THEN 08968500
BEGIN 08968600
MOVE (C, A); 08968700
AROF ~ BROF ~ TRUE; 08968800
QF01 ~ 1; 08968900
JFIF; 08969000
GO TO OC; 08969100
END; 08969200
RPF ~ C.ADDR; 08969300
BX ~ B ~ YX ~ Y ~ 0; 08969400
IF C.ADDR > (48 DIV SSZ) THEN 08969500
BEGIN 08969600
C.ADDR ~ (C.ADDR - 48 DIV SSZ); 08969700
QH02 ~ 1; 08969800
END; 08969900
DIB ~ (48 DIV SSZ - C.ADDR); 08970000
IF SOPF THEN 08970100
BEGIN 08970200
MOVE (A, X); 08970300
L3: MM ~ SBR + SIR; 08970400
MOVE (M[MM],A); 08970500
AROF ~ TRUE; 08970600
IF BOOLEAN (AX.TAG) THEN 08970700
BEGIN 08970800
IF SOPF THEN 08970900
BEGIN 08971000
MOVE (X, A); 08971100
AROF ~ TRUE; 08971200
END ELSE 08971300
BEGIN 08971400
IF QH01 = 1 THEN 08971500
BEGIN 08971600
MOVE (A, JUNK); 08971700
MOVE (X, A); 08971800
MOVE (JUNK, X); 08971900
END; 08972000
END; 08972100
QF04 ~ 1; 08972200
JGIF; 08972300
GO TO OC; 08972400
END; 08972500
END; 08972600
L1: IF LHFF = 1 THEN 08972700
BEGIN 08972800
BX.TAG ~ DOUBL; 08972900
DYAL (A, Y, DYALSIB, DYALDIB, SSZ); 08973000
END ELSE 08974000
DYAL (A, B, DYALSIB, DYALDIB, SSZ); 08975000
IF BUMPDIB = 0 THEN 08976000
BEGIN 08977000
IF LHFF ! 0 THEN GO TO L2; 08978000
IF QH02 ! 1 THEN GO TO L2; 08979000
LHFF ~ 1; 08980000
END; 08981000
IF BUMPSIB = 0 THEN 08982000
BEGIN 08983000
QH01 ~ 1; 08984000
IF NOT SOPF THEN GO TO L3 ELSE 08985000
BEGIN 08986000
MOVE (A, JUNK); 08987000
MOVE (X, A); 08988000
MOVE (JUNK, X); 08989000
END; 08990000
END; 08991000
GO TO L1; 08992000
L2: AROF ~ EXSF ~ SOPF ~ FALSE; 08993000
BROF ~ TRUE; 08994000
OC: 08995000
END OF STRING ISOLATE; 08996000
PROCEDURE SXSN ; % SET EXTERNAL SIGN 7.9 08997000
BEGIN 08998000
ADJ(1,2); 08999000
09000000
EXTF ~ BOOLEAN(A.SOBIT); 09001000
END SXSN; 09002000
PROCEDURE RTFF ; % READ TRUE/FALSE FLIP-FLOP 7.10 09003000
BEGIN 09004000
ADJ(0,2); 09005000
AX ~ A ~ 0; 09006000
AROF ~ TRUE; 09006500
A ~ REAL(TFFF); 09007000
END RTFF; 09008000
PROCEDURE ROFF ; % READ AND CLEAR OVERFLOW FLIP-FLOP 7.11 09009000
BEGIN 09010000
ADJ(0,2); 09011000
AX ~ A ~ 0; 09012000
AROF ~ TRUE; 09012500
A ~ REAL(OFFF); 09013000
OFFF ~ FALSE; 09014000
END ROFF; 09015000
PROCEDURE INPCONV( UPDATE); VALUE UPDATE; BOOLEAN UPDATE; 09015010
BEGIN 09015020
REAL DIGR ; 09015030
LABEL OC; 09015040
ADJ(0,1); 09015050
IF INTEGERIZE(FALSE,B) THEN 09015060
BEGIN 09015070
SETINTERRUPT(INTOVFI); 09015080
ADJ(0,0); AROF ~ BROF ~ TRUE; 09015090
GO OC; 09015100
END; 09015110
ADJ(1,1); 09015120
IF A.[43:5] > 23 THEN 09015130
BEGIN 09015140
SETINTERRUPT(INVOP); 09015150
ADJ(0,0); AROF ~ BROF ~ TRUE; 09015160
GO OC; 09015170
END; 09015180
IF UPDATE THEN 09015190
BEGIN 09015200
PACU; ADJ(1,1); 09015210
END ELSE 09015220
BEGIN 09015230
PACU; ADJ(0,1); 09015240
END; 09015250
MOVE(A,C); 09015260
JUNK ~ DIGR ~ 09015270
A ~ AX ~ X ~ XX ~ 0; 09015280
DO BEGIN 09015290
DOUBLE(A,X,10,0,|,~,A,X); 09015300
IF DIGR < 12 THEN 09015310
BEGIN 09015320
DYAL(B,JUNK,47-4|DIGR,3,4); 09015330
X ~ X + JUNK.[44:4]; 09015340
END ELSE 09015350
BEGIN 09015360
DYAL(Y,JUNK,48-4|DIGR,3,4); 09015370
X ~ X + JUNK.[44:4]; 09015380
END; 09015390
END UNTIL DIGR ~ DIGR + 1 = 24; 09015400
MOVE(A,B); MOVE(X,Y); MOVE(C,A); 09015410
IF B ! 0 THEN 09015420
BEGIN 09015430
B.SOBIT ~ 1; 09015440
TFFF ~ FALSE; 09015450
BX.TAG ~ DOUBL; 09015460
09015470
END ELSE 09015480
BEGIN 09015490
MOVE(Y,B); 09015500
B.SOBIT ~ REAL(TFFF); 09015510
TFFF ~ TRUE; 09015520
BX.TAG ~ SINGL; 09015530
END; 09015540
OC: 09015545
END OF INPCONV; 09015550
PROCEDURE ICVD ; % INPUT CONVERT, DESTRUCTIVE 7.12.1 09016000
BEGIN 09017000
INPCONV(FALSE); 09018000
END ICVD; 09019000
PROCEDURE ICVU ; % INPUT CONVERT, UPDATE 7.12.2 09020000
BEGIN 09021000
INPCONV(TRUE ); 09022000
END ICVU; 09023000
PROCEDURE TEED ; % TABLE ENTER EDIT, DESTRUCTIVE 7.13.1 09024000
BEGIN 09025000
ENTEREDIT(3,FALSE); 09026000
END TEED; 09027000
PROCEDURE TEEU ; % TABLE ENTER EDIT, UPDATE 7.13.2 09028000
BEGIN 09029000
ENTEREDIT(3, TRUE); 09030000
END TEEU; 09031000
PROCEDURE ILED ; % IN LINE ENTER EDIT, DESTRUCTIVE 7.13.3 09032000
BEGIN 09033000
ENTEREDIT(2,FALSE); 09034000
END ILED; 09035000
PROCEDURE ILEU ; % IN LINE ENTER EDIT, UPDATE 7.13.4 09036000
BEGIN 09037000
ENTEREDIT(2, TRUE); 09038000
END ILEU; 09039000
PROCEDURE EXPU ; % SINGLE PINTER ENTER EDIT 09040000
BEGIN 09041000
ENTEREDIT(1,TRUE); 09042000
END OF SPEE; 09043000
PROCEDURE EXSD ; % EXECUTE SINGLE MICRO, DESTRUCTIVE 7.13.5 09044000
BEGIN 09045000
ENTEREDIT(0,FALSE); 09046000
END EXSD; 09047000
PROCEDURE EXSU ; % EXECUTE SINGLE MICRO, UPDATE 7.13.6 09048000
BEGIN 09049000
ENTEREDIT(0, TRUE); 09050000
END EXSU; 09051000
PROCEDURE MOVES (NUMRIC); 09052000
VALUE NUMRIC; 09053000
BOOLEAN NUMRIC; 09054000
BEGIN 09055000
INTEGER PLUG; 09055500
LABEL OC, L1, L2, L3, L4, L5; 09056000
EDITF ~ TRUE; 09057000
SETUPEXSF; 09058000
CHARSZ; 09059000
IF C.ADDR = 0 THEN GO TO L1; 09060000
RPF ~ C.ADDR; 09061000
QH03 ~ 1; 09062000
L2: IF NOT SOPF THEN 09063000
BEGIN 09064000
MM ~ SBR + SIR; 09065000
MOVE (M[MM], A); MEMCYCLE; 09066000
IF BOOLEAN (AX.TAG) THEN 09067000
BEGIN 09068000
L4: BKIP ~ 1; 09069000
MEMPROTECT; 09070000
END; 09071000
END; 09072000
IF QH03 = 1 THEN QH03 ~ 0 ELSE 09073000
L5: IF DIB ! 0 THEN GO TO L3; 09074000
IF BROF THEN BROF ~ FALSE ELSE 09075000
BEGIN 09076000
MM ~ DBR + DIR; 09077000
MOVE (M[MM], B); MEMCYCLE; 09078000
IF BOOLEAN (BX.TAG) THEN GO TO L4; 09079000
END; 09080000
L3: IF NUMRIC THEN 09081000
BEGIN 09082000
IF SSZ = 4 THEN 09083000
BEGIN 09084000
DYAL (A, B, DYALSIB, DYALDIB, 4); 09085000
END ELSE 09086000
IF SSZ = 6 THEN 09087000
BEGIN 09088000
PLUG ~ 0; 09089000
DYAL (PLUG, B, 46, DYALDIB,2); 09089500
DYAL (A, B,(DYALSIB - 2), (DYALDIB -2),4); 09090000
END ELSE 09091000
BEGIN 09092000
PLUG ~ 17; 09093000
DYAL (PLUG, B, 44, DYALDIB, 4); 09093050
DYAL (A, B,(DYALSIB -4),(DYALDIB -4), 4); 09094000
END; 09095000
END ELSE 09096000
DYAL (A, B, DYALSIB, DYALDIB, SSZ); 09097000
BUMPSIB; 09098000
SWITCHSOURCE; 09099000
RPF ~ RPF - 1; 09100000
IF RPF = 0 THEN 09101000
BEGIN 09102000
MOVE (B, M[DBR + DIR]); MEMCYCLE; 09103000
LHFF ~ 1; 09104000
END; 09105000
IF BUMPDIB = 0 THEN 09106000
BEGIN 09107000
MOVE (B, M[DBR + DIR]); MEMCYCLE; 09108000
END; 09109000
STEPDP; 09110000
IF LHFF = 0 THEN 09111000
BEGIN 09112000
IF SIB = 0 THEN GO TO L2; 09113000
GO TO L5; 09114000
END; 09115000
L1: IF EXSF THEN ENDE ELSE BROF ~ TRUE; 09116000
OC: 09117000
END OF MOVES FOR MOVE CHARAS AND NUMERIC UNCOND; 09118000
PROCEDURE MCHR; % MOVE CHARACTERS 09119000
BEGIN 09120000
P2R3 ~ 1; 09121000
MOVES (FALSE); 09122000
END; 09123000
PROCEDURE MVNU; % MOVE NUMERIC UNCONDITIONAL 09124000
BEGIN 09125000
P2R3 ~ 1; 09126000
MOVES (TRUE); 09127000
END; 09128000
PROCEDURE SKIPS (FORWAD, SOURCE); 09130000
VALUE FORWAD, SOURCE; 09130500
BOOLEAN FORWAD, SOURCE; 09131000
BEGIN 09131500
LABEL OC, L1, L2, L3, MPERR, L4; 09132000
EDITF ~ TRUE; 09132500
SETUPEXSF; 09133000
RPF ~ BUF ~ C.ADDR; 09133500
IF C.ADDR { 0 THEN GO TO L3; 09134000
QH03 ~ 1; 09134500
IF SOURCE THEN 09135000
BEGIN 09135500
IF SSZ = 0 THEN SSZ ~ 6; 09136000
IF NOT SOPF THEN 09136500
BEGIN 09137000
L1: MM ~ SBR + SIR; 09137500
MOVE (M[MM], A); 09138000
IF BOOLEAN (AX.TAG) THEN GO TO MPERR; 09138500
IF QH03 = 0 THEN 09139000
L2: IF FORWAD THEN 09139500
BEGIN 09140000
BUF ~ RPF - 1; 09140500
RPF ~ RPF - 1; 09141000
IF RPF = 0 THEN GO TO L3; 09141500
END ELSE 09142000
BEGIN 09143000
SIB ~(48 DIV SSZ); 09144000
END ELSE 09145000
QH03 ~ 0; 09146000
END; 09147000
IF FORWAD THEN RPF ~ RPF -(48 DIV SSZ -(SIB+1)) 09148000
ELSE 09149000
BEGIN 09150000
RPF ~ RPF - SIB; 09151000
BUF ~ RPF; 09152000
END; 09153000
IF RPF < 0 THEN RPZF ~ 1; 09154000
IF RPF = 0 THEN LHFF ~ 1; 09155000
IF FORWAD THEN 09156000
BEGIN 09157000
IF LHFF = 1 OR RPZF = 1 THEN 09158000
BEGIN 09159000
SIB ~ SIB + BUF; 09160000
GO TO L3; 09161000
END; 09162000
SIB ~ 0; 09163000
IF NOT SOPF THEN 09164000
BEGIN 09165000
SIR ~ SIR + 1; 09166000
GO TO L1 09167000
END ELSE 09168000
BEGIN 09169000
MOVE (A, JUNK); 09170000
MOVE (X, A); 09171000
MOVE (JUNK, X); 09172000
GO TO L2; 09173000
END; 09174000
END ELSE 09175000
BEGIN 09176000
SIB ~ 0; 09177000
IF LHFF = 1 OR RPZF = 1 THEN 09178000
BEGIN 09179000
SIB ~ ABS (BUF + 0); 09180000
GO TO L3; 09181000
END; 09182000
IF NOT SOPF THEN 09183000
BEGIN 09184000
SIR ~ SIR - 1; 09185000
GO TO L1; 09186000
END ELSE 09187000
BEGIN 09188000
MOVE (A, JUNK); 09189000
MOVE (X, A); 09190000
MOVE (JUNK, X); 09191000
GO TO L2; 09192000
END; 09193000
END; 09194000
END ELSE 09195000
BEGIN 09196000
IF DSZ = 0 THEN DSZ ~ 6; 09197000
IF NOT BROF THEN 09198000
BEGIN 09199000
L4: MM ~ DBR + DIR; 09200000
MOVE (M[MM], B); 09201000
IF BOOLEAN (BX.TAG) THEN GO TO MPERR; 09202000
END; 09203000
IF FORWAD THEN 09204000
BEGIN 09205000
IF QH03 = 0 THEN 09206000
BEGIN 09207000
BUF ~ RPF - 1; 09208000
RPF ~ BUF; 09209000
IF RPF = 0 THEN GO TO L3; 09210000
END ELSE 09211000
QH03 ~ 0; 09212000
RPF ~ RPF - (48 DIV SSZ - (DIB + 1)); 09213000
END ELSE 09214000
BEGIN 09215000
IF QH03 = 0 THEN DIB ~ (48 DIV SSZ) ELSE 09216000
QH03 ~ 0; 09217000
RPF ~ RPF - DIB; 09218000
BUF ~ RPF; 09218500
END; 09219000
IF RPF < 0 THEN RPZF ~ 1; 09220000
IF RPF = 0 THEN LHFF ~ 1; 09221000
IF FORWAD THEN 09222000
BEGIN 09223000
IF LHFF = 1 OR RPZF = 1 THEN 09224000
BEGIN 09225000
DIB ~ DIB + BUF; 09226000
GO TO L3; 09227000
END ELSE 09228000
BEGIN 09229000
DIB ~ 0; 09230000
BROF ~ FALSE; 09231000
DIR ~ DIR + 1; 09232000
GO TO L4; 09233000
END; 09234000
END ELSE 09235000
BEGIN 09235500
DIB ~ 0; 09236000
IF LHFF = 1 OR RPZF = 1 THEN 09237000
BEGIN 09238000
DIB ~ ABS (RPF + 0); 09239000
GO TO L3; 09240000
END ELSE 09241000
BEGIN 09242000
BROF ~ FALSE; 09243000
DIR ~ DIR - 1; 09244000
GO TO L4; 09245000
END; 09245500
END; 09246000
END; 09246500
MPERR: 09247000
UPDF ~ TRUE; 09248000
ENDE; 09249000
BKIP ~ 1; QF04 ~ 1; 09250000
JGIF; 09251000
GO TO OC; 09252000
L3: IF EXSF THEN ENDE; 09253000
OC: 09254000
END OF SKIPS; 09255000
PROCEDURE SFSC; % SKIP FORWARD SOURCE CHARACTERS 09255500
BEGIN P2R3 ~ 1; 09256000
SKIPS (TRUE, TRUE); 09257000
END SFSC; 09258000
PROCEDURE SRSC; % SKIP REVERSE SOURCE CHARACTERS 09259000
BEGIN P2R3 ~ 1; 09260000
SKIPS (FALSE, TRUE); 09261000
END SRSC; 09262000
PROCEDURE SFDC; % SKIP FORWARD DESTINATION CHARACTERS 09263000
BEGIN P2R3 ~ 1; 09264000
SKIPS (TRUE, FALSE); 09265000
END SFDC; 09265500
PROCEDURE SRDC; % SKIP REVERSE DESTINATION CHARACTERS 09266000
BEGIN P2R3 ~ 1; 09267000
SKIPS (FALSE, FALSE); 09268000
END SRDC; 09269000
PROCEDURE INSERTS(CONDITIONAL); 09270000
VALUE CONDITIONAL; 09271000
BOOLEAN CONDITIONAL; 09272000
BEGIN 09273000
LABEL OC; 09274000
EDITF ~ TRUE; 09274100
SETUPEXSF; 09275000
RPF~C; 09276000
Y~SYLLABLE; 09277000
STEPPSR(1); 09278000
IF CONDITIONAL THEN 09279000
IF NOT FLTF THEN STEPPSR(1) ELSE 09280000
BEGIN 09281000
Y ~ SYLLABLE; YX ~ 0; 09282000
STEPPSR(1); 09283000
END; 09284000
WHILE RPF > 0 DO 09285000
BEGIN 09286000
FETCHDESTINATION; 09287000
DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09288000
IF BUMPDIB = 0 THEN 09289000
BEGIN 09290000
STOREB; 09291000
STEPDP; 09292000
END; 09293000
RPF ~ RPF - 1; 09294000
END; 09295000
IF EXSF THEN ENDE; 09296000
OC: 09297000
END OF INSERTS; 09298000
PROCEDURE INSU ; % INSERT UNCONDITIONAL 8.4.1 09299000
BEGIN 09300000
INSERTS(FALSE); 09301000
END INSU; 09302000
PROCEDURE INSC ; % INSERT CONDITIONAL 8.4.2 09303000
BEGIN 09304000
INSERTS(TRUE ); 09305000
END INSC; 09306000
PROCEDURE INSG ; % INSERT DISPLAY SIGN 8.4.3 09307000
BEGIN 09308000
LABEL OC; 09309000
EDITF ~ TRUE; 09309100
IF DSZ = 0 THEN DSZ ~ 6 ELSE 09310000
IF DSZ = 4 THEN 09311000
BEGIN 09311100
UPDF ~ TRUE; 09311200
ENDE; 09311300
QF01 ~ 1; 09311400
BKIP ~ 1; 09311500
JGIF; 09311600
GO OC; 09311700
END; 09311800
IF EXTF THEN ELSE STEPPSR(1); 09312000
Y~ SYLLABLE; YX~0; 09313000
IF EXTF THEN STEPPSR(2) ELSE STEPPSR(1); 09314000
FETCHDESTINATION; 09315000
DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09316000
BUMPDIB; 09317000
IF DIB = 0 THEN 09318000
BEGIN 09320000
STOREB; 09321000
STEPDP; 09322000
END; 09323000
IF EXSF THEN ENDE; 09324000
OC: 09325000
END INSG; 09326000
PROCEDURE INOP ; % INSERT OVERPUNCH 8.4.4 09327000
BEGIN 09328000
LABEL OC; 09329000
EDITF ~ TRUE; 09330000
IF DSZ=0 THEN DSZ~6 ELSE 09331000
IF DSZ=4 THEN 09332000
BEGIN 09333000
UPDF ~ TRUE; ENDE; 09334000
QF01~ 1; 09335000
BKIP ~ 1; 09336000
JGIF; 09337000
GO OC; 09338000
END; 09339000
FETCHDESTINATION; 09340000
IF EXTF THEN 09341000
IF (DIB~DIB-DSZ) < 0 THEN 09342000
IF DSZ=6 THEN DYAL(INTG~2,B,1,DYALDIB,2) 09343000
ELSE DYAL(INTG~13,B,3,DYALDIB,4); 09344000
BUMPDIB; 09345000
IF DIB=0 THEN 09346000
BEGIN 09347000
STOREB; 09347100
STEPDP; 09347200
END; 09347300
IF EXSF THEN ENDE; 09347400
OC: 09348000
END INOP; 09349000
PROCEDURE RSTF ; % RESET FLOAT 09350000
BEGIN 09351000
FLTF ~ FALSE; 09352000
END RFLT; 09353000
PROCEDURE ENDF ; % END FLOAT 8.9 09354000
BEGIN 09355000
LABEL OC; 09356000
EDITF ~ TRUE; 09356100
IF FLTF THEN 09357000
BEGIN 09358000
STEPPSR(2); 09359000
FLTF ~ FALSE; 09360000
GO OC; 09361000
END; 09362000
IF DSZ=0 THEN DSZ~6; 09363000
FETCHDESTINATION; 09364000
Y ~ SYLLABLE; YX ~ 0; 09365000
STEPPSR(1); 09366000
IF EXTF THEN Y ~ SYLLABLE; 09367000
STEPPSR(1); 09368000
DYAL(Y,B,DSZ-1,DIB,DSZ); 09369000
BUMPDIB; 09370000
IF DIB = 0 THEN 09371000
BEGIN 09372000
STOREB; 09373000
STEPDP; 09374000
END; 09375000
IF EXSF THEN ENDE; 09376000
OC: 09377000
END ENDF; 09378000
PROCEDURE MINS ; % MOVE WITH INSERT 8.10 09379000
BEGIN 09380000
BOOLEAN LHFF; 09381000
LABEL L12,L8,L10,L14,L20,L11,OC; 09382000
EDITF ~ TRUE; 09383000
SETUPEXSF; 09384000
Y ~ SYLLABLE; YX ~ 0; STEPPSR(1); 09385000
CHARSZ; 09386000
IF C = 0 THEN GO TO L11; 09387000
RPF ~ C.ADDR; 09388000
QH03 ~ 1; 09389000
L12: 09390000
FETCHSOURCE; 09391000
L8: 09392000
IF QH03 = 1 THEN QH03~0 ELSE IF DIB!0 THEN GO L14; 09393000
IF BROF THEN BROF ~ FALSE ELSE 09394000
L10: 09395000
FETCHDESTINATION; 09396000
L14: 09397000
IF FLTF THEN 09398000
BEGIN 09399000
INTG ~ 15|REAL(SSZ=8); 09400000
IF SSZ!4 THEN DYAL(INTG,B,SSZ-5,DYALDIB,SSZ-4); 09401000
DYAL(A,8,DYALSIB-SIBLNG,DYALDIB-DIBLNG,4); GO L20; 09402000
END; 09403000
09404000
DYAL(A,INTG,DYALSIB-SIBLNG,3,4); 09405000
IF INTG.[44:4] ! 0 THEN BEGIN FLTF~TRUE;GO L14 END; 09406000
09407000
DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09408000
L20: BUMPSIB; 09409000
SWITCHSOURCE; 09410000
BUMPDIB; 09411000
RPF ~ RPF - 1; 09412000
IF RPF = 0 THEN 09413000
BEGIN 09414000
STOREB; 09415000
LHFF ~ TRUE; 09416000
END; 09417000
IF DIB = 0 THEN 09418000
BEGIN 09418100
STOREB; 09418200
STEPDP; 09418300
END; 09418400
IF NOT LHFF THEN IF SIB=0 THEN GO L12 ELSE 09418500
GO L10; 09418600
L11: IF EXSF THEN ENDE ELSE BROF ~ TRUE; 09418700
OC: 09418800
END MINS; 09418900
PROCEDURE MFLT ; % MOVE WITH FLOAT 8.11 09419000
BEGIN 09420000
LABEL L11,L9,L14,L15,L22,L10,L12,OC; 09421000
BOOLEAN LHFF; 09421100
EDITF ~ TRUE; 09422000
SETUPEXSF; 09423000
Y ~ SYLLABLE; YX ~ 0; STEPPSR(1); 09424000
CHARSZ; 09425000
IF C = 0 THEN GO TO L10; 09426000
RPF ~ C.ADDR; 09427000
QH03 ~ 1; 09428000
L11: 09429000
FETCHSOURCE; 09430000
L9: 09431000
IF QH03 = 1 THEN QH03 ~ 0 ELSE IF DIB ! 0 THEN GO TO L15; 09432000
IF BROF THEN BROF ~ FALSE ELSE 09433000
L14: FETCHDESTINATION; 09434000
L15: 09435000
IF FLTF THEN 09436000
BEGIN 09437000
INTG ~ 15|REAL(SSZ=8); 09438000
IF SSZ ! 4 THEN DYAL(INTG,B,SSZ-5,DYALDIB,SSZ-4); 09439000
DYAL(A,B,DYALSIB-SIBLNG,DYALDIB-DIBLNG,4); 09440000
END ELSE 09441000
BEGIN 09442000
DYAL(A,INTG,DYALSIB-SIBLNG,3,4); 09443000
IF INTG.[44:4] = 0 THEN 09444000
DYAL(Y,B,DSZ-1,DYALDIB,DSZ) ELSE 09445000
BEGIN 09446000
FLTF ~ TRUE; 09447000
Y ~ SYLLABLE; YX ~ 0; STEPPSR(1); 09448000
IF EXTF THEN Y ~ SYLLABLE; STEPPSR(1); 09449000
DYAL(Y,B,DSZ-1,DYALDIB,DSZ); 09450000
QH01 ~ 1; 09451000
GO TO L22; 09452000
END; 09453000
END; 09454000
BUMPSIB; 09455000
IF SIB=0 AND NOT SOPF THEN SIR ~ SIR + 1; 09456000
L22: 09457000
BUMPDIB; 09458000
IF QH01 = 0 THEN 09459000
BEGIN 09460000
RPF ~ RPF - 1; 09461000
IF RPF = 0 THEN BEGIN STOREB; LHFF~TRUE END; 09462000
END ELSE QH01 ~ 0; 09463000
IF DIB = 0 THEN 09464000
BEGIN 09465000
STOREB; 09466000
STEPDP; 09467000
END; 09468000
IF LHFF THEN GO L12; 09469000
IF SIB = 0 THEN GO L11; 09470000
GO L14; 09471000
L10: 09472000
IF QH03 = 0 THEN STEPPSR(2); 09473000
L12: 09474000
IF EXSF THEN ENDE ELSE BROF ~ TRUE; 09474100
OC: 09474200
END MFLT; 09474300
PROCEDURE ENDE; % END EDIT 09475000
BEGIN 09476000
LABEL OC, L1; 09477000
IF BROF THEN 09478000
BEGIN 09479000
MM ~ DBR + DIR; 09480000
MOVE (B, M[MM]); MEMCYCLE; 09481000
BROF ~ FALSE 09482000
END; 09483000
IF NOT UPDF THEN 09484000
BEGIN 09485000
FLTF ~ FALSE; 09486000
AROF ~ FALSE; 09487000
GO TO L1 09488000
END; 09489000
BROF ~ TRUE; 09490000
B ~ BX ~ 0; 09490500
B ~ DBR; 09491000
B.DIRF ~ DIR; 09492000
B.CHARF ~ DIB; 09493000
B.SZ ~ DSZ DIV 2; 09494000
BX.TAG ~ DATADESC; 09495000
B.IBIT ~ 1; 09496000
BX.PBIT ~ 1; 09497000
B.CBIT ~ 1; 09498000
B.SBIT ~ DPSF; 09499000
09500000
IF SOPF THEN 09501000
BEGIN 09502000
IF AX.TAG = SINGL THEN 09503000
BEGIN 09504000
IF SIB ! 47 THEN 09505000
BEGIN 09506000
DYAL (A,C,DYALSIB,47,DYALSIZ); 09507000
DYAL (A,C,47,DYALSET,DYALSZ); 09508000
MOVE (C, A); 09509000
END; 09510000
AROF ~ TRUE; 09511000
XROF ~ 0; 09512000
END ELSE 09513000
IF SIB ! 47 THEN 09514000
BEGIN 09515000
DYAL (A,C,DYALSIB,47,DYALSIZ); 09516000
DYAL (X,C,47,DYALSET,DYALSZ); 09517000
DYAL (X,X,DYALSIB,47,DYALSIZ); 09518000
DYAL (A,X,47,DYALSET,DYALSZ); 09519000
MOVE (C, A); 09520000
END; 09521000
AROF ~ TRUE; 09522000
XROF ~ 1; GO TO L1; 09523000
END ELSE 09524000
AROF ~ TRUE; 09525000
A ~ AX ~ 0; 09525500
A ~ SBR; 09526000
A.SIRF ~ SIR; 09527000
A.CHARF ~ SIB; 09528000
A.SZ ~ SSZ DIV 2; 09529000
AX.TAG ~ DATADESC; 09530000
A.IBIT ~ 1; 09531000
AX.PBIT ~ 1; 09532000
A.CBIT ~ 1; 09533000
A.SBIT ~ SPSF; 09534000
A.RBIT ~ SPRF; 09535000
L1: IF NOT EDITF THEN 09536000
BEGIN 09537000
IF SWPS = 1 THEN BROF ~ FALSE 09538000
END ELSE 09539000
IF ESPF THEN AROF ~ FALSE; 09540000
ESPF ~ EXSF ~ UPDF ~ SOPF ~ EDITF ~ FALSE; 09541000
OC: 09542000
END ENDEDIT; 09543000
PROCEDURE ERVSFLOW(OP); VALUE OP; INTEGER OP; 50000000
BEGIN 50001000
LABEL STARTVALC,STARTEVAL,STARTENTR,STARTEXIT,STARTRETN, 50002000
STARTINDX,STARTNXLN,STARTNXLV,STARTSTBR,STARTMKST, 50003000
STARTMVST,STARTDBTR,STARTDBFL,STARTDBUN,STARTBRTR, 50004000
STARTBRFL,STARTBRUN,STARTSTFF,STARTIRWL,STARTPCWL; 50005000
SWITCH START ~ 50006000
STARTVALC,STARTEVAL,STARTENTR,STARTEXIT,STARTRETN, 50007000
STARTINDX,STARTNXLN,STARTNXLV,STARTSTBR, 50008000
STARTMKST,STARTMVST,STARTDBTR,STARTDBFL, 50009000
STARTDBUN,STARTBRTR,STARTBRFL,STARTBRUN, 50010000
STARTSTFF,STARTIRWL,STARTPCWL; 50011000
DEFINE VALC=OP=1#,EVAL=OP=2#,ENTR=OP=3#,EXIT=OP=4#,RETN=OP=5#, 50012000
INDX=OP=6#,NXLN=OP=7#,NXLV=OP=8#,STBR=OP=9#, 50013000
MKST=OP=10#,MVST=OP=11#,DBTR=OP=12#, 50014000
DBFL=OP=13#,DBUN=OP=14,BRTR=OP=15#,BRFL=OP=16#,50015000
BRUN=OP=17#,STFF =OP=18#,IRWL = OP=19#, 50016000
PCWL= OP=20#; 50017000
LABEL LABELA,LABELB,LABELC,LABELD,LABELE,LABELF,LABELG, 50018000
LABELH,LABELP,LABELQ,LABELS,LABELT,LABELW,LABELX, 50019000
LABELZ, L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13, 50020000
L14,L15,L16,L17,L18,DESCPAGE6,INDEXINDESC,NXLNPAGE9, 50021000
NORMALINDEX,SPECIALINDEX,OPERAND,INDEXWORD,STUFFEDIRW, 50022000
NORMALIRW,PCWPAGE22,DISPLAYUPDATE,BYPASUPDATE, 50023000
SEGMENTDESC,PCW2,INVOPLBL,INVINDLBL,STKUNFLBL,BOSLBL, 50024000
SEQERLBL,INTLBL,PRES10LBL,PRES11LBL,PRES12LBL, 50025000
PRES13LBL,OC,LABELOPND; 50026000
50027000
REAL TS,T1,T2; 50028000
DEFINE I1INVALIDOPERATOR = GO TO INVOPLBL#, % ON PAGE 44 50029000
I2INTEGERIZE = BEGIN B ~ BX ~ 0; 50030000
GO TO INTLBL END#, % ON PAGE 45 50030500
I2MULT = I2INTEGERIZE#, 50031000
I2INTEGERDIV = I2INTEGERIZE#, 50032000
I3INVALIDINDEX = BEGIN LL ~ X.LLF; 50033000
GO TO INVINDLBL END#, % PAGE 44 50033500
I4INVALIDINDEX = GO TO INVINDLBL#, % ON PAGE 44 50034000
I5BOSERROR = GO TO STKUNFLBL#, % ON PAGE 44 50035000
I6BOSNORMAL = GO TO BOSLBL#, % ON PAGE 45 50036000
I7SEQUENCEERROR = BEGIN LL ~ X.LLF; 50037000
GO TO SEQERLBL END#, % PAGE 45 50037500
I8SEQUENCEERROR = GO TO SEQERLBL#, % ON PAGE 45 50038000
I9INVALIDINDEX = BEGIN MOVE (A,C); AROF ~ FALSE; 50039000
GO TO INVINDLBL END#, % PAGE 44 50040000
I10PRESENCEBIT = GO TO PRES10LBL#, % ON PAGE 46 50041000
I11PRESENCEBIT = GO TO PRES11LBL#, % ON PAGE 46 50042000
I12PRESENCEBIT = GO TO PRES12LBL#, % ON PAGE 46 50043000
I13PRESENCEBIT = GO TO PRES13LBL#; % ON PAGE 46 50044000
%%% 50045000
DEFINE INTFL = SDIS=1#; %TO OVERCOME NOMENCLATURE DIFFICULTY 50046000
%%% 50047000
GO TO START[OP]; ERROR(10); MEMDUMP; GO TO EOJ; 50048000
% PAGE 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50049000
STARTEVAL: 50050000
STARTSTBR: 50051000
LABELE: 50052000
ADJ(1,2); 50053000
GO TO L1; 50054000
STARTNXLV: 50055000
STARTNXLN: 50056000
STARTINDX: 50057000
ADJ(1,1); 50058000
IF AX.TAG = SINGL OR AX.TAG = DOUBL THEN EXCH; 50059000
L1: MOVE(A,C); AROF ~ FALSE; 50060000
IF AX.TAG = IRW THEN GO TO LABELA ELSE GO TO DESCPAGE6; 50061000
% PAGE 3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50062000
STARTENTR: 50063000
ADJ(0,0); 50064000
MOVE(M[F + 1], C); MEMCYCLE; 50065000
IF CX.TAG ! IRW THEN I1INVALIDOPERATOR; % ON PAGE 44 50066000
STARTIRWL: 50067000
LABELA: 50068000
MOVE (C,A); 50069000
IF C.EBIT = 1 THEN GO TO STUFFEDIRW ELSE GO TO NORMALIRW; 50070000
% PAGE 4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50071000
STARTVALC: 50072000
T1 ~ T1&DRS[34:42:6] & SYLLABLE[40:40:8]; STEPPSR(1); 50073000
BUF2 ~ D[LEVEL(T1)] + DELTA(T1); 50074000
MOVE(M[D[LEVEL(T1)]+DELTA(T1)],C); MEMCYCLE; 50075000
QC1F ~ 1; 50076000
IF AROF THEN ADJ(0,2); 50077000
IF CX.TAG = SINGL OR CX.TAG = DOUBL THEN 50078000
BEGIN 50079000
IF CX.TAG = DOUBL THEN MOVE (M[BUF2 + 1],X); 50080000
MOVE (C,A); AROF ~ TRUE; 50081000
GO TO OC; 50082000
END; 50083000
IF CX.TAG = IRW THEN GO TO LABELA; % ON PAGE 3 50084000
% PAGE 6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50085000
DESCPAGE6: 50086000
IF CX.TAG ! DATADESC THEN I1INVALIDOPERATOR; 50087000
IF C.CHRSZ = 0 THEN 50088000
BEGIN 50089000
QC6F ~ 1; QC7F ~ C.DBIT 50090000
END; 50091000
IF C.IBIT = 1 THEN GO TO L2; % ON PAGE 7 50092000
IF EVAL THEN GO TO LABELZ; % ON PAGE 9 50093000
IF NOT (NXLV OR NXLN OR INDX) THEN I1INVALIDOPERATOR; 50094000
LABELT: 50095000
IF C.CHRSZ = 0 OR INDX THEN GO TO NORMALINDEX % ON PAGE 10 50096000
ELSE I1INVALIDOPERATOR; 50097000
% PAGE 7 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50098000
L2: 50099000
IF INDX THEN I1INVALIDOPERATOR; 50100000
IF EVAL THEN GO TO LABELZ; % ON PAGE 9 50101000
INDEXINDESC: 50102000
IF C.SBIT ! 1 AND C.CHRSZ ! 0 THEN I1INVALIDOPERATOR; 50103000
IF CX.PBIT ! 1 THEN I11PRESENCEBIT; 50104000
T1 ~ C.SBIT; 50105000
MOVE(M[BUF2 ~ C.INDEX + C.ADDR],C); MEMCYCLE; 50106000
IF T1 = 1 THEN GO TO DESCPAGE6; 50107000
% PAGE 8 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50108000
IF NXLN THEN GO TO NXLNPAGE9; 50109000
LABELC: 50110000
IF CX.TAG=SINGL OR CX.TAG=DOUBL THEN GO TO OPERAND; % ON PAGE1550111000
IF CX.TAG = SIW THEN GO TO INDEXWORD; % ON PAGE 17 50112000
IF NXLV THEN I1INVALIDOPERATOR; 50113000
GO TO DESCPAGE6; 50114000
% PAGE 9 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50115000
NXLNPAGE9: 50116000
IF CX.TAG ! DATADESC THEN I1INVALIDOPERATOR; 50117000
IF C.IBIT = 1 THEN I1INVALIDOPERATOR; 50118000
LABELZ: 50118100
IF CX.PBIT ! 1 THEN BEGIN 50119000
IF C.CBIT ! 1 THEN C.ADDR ~ BUF2 50120000
END; 50121000
50122000
C.CBIT ~ 1; 50123000
MOVE(C,A); AROF ~ TRUE; 50124000
GO TO OC; 50125000
% PAGE 10 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50126000
NORMALINDEX: 50127000
NTGR; IF INTFL THEN I2INTEGERIZE; 50128000
IF B.MANF < 0 OR B.MANF } C.INDEX THEN I4INVALIDINDEX; 50129000
IF C.SBIT = 1 THEN GO TO LABELP; % ON PAGE 12 50130000
IF C.CHRSZ ! 0 THEN GO TO LABELQ; % ON PAGE 14 50131000
IF C.DBIT = 1 THEN B ~ B | 2; 5013155550131000
C.INDEX ~ B.ADDR; 50132000
% PAGE 11 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50133000
SPECIALINDEX: 50134000
C.IBIT ~ 1; BROF ~ FALSE; 50135000
IF NOT INDX THEN GO TO INDEXINDESC; % ON PAGE 7 50136000
GO LABELZ; 50136600
MOVE (C,A); AROF ~ TRUE; 50137000
GO TO OC; 50138000
% PAGE 12 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50139000
LABELP: 50140000
CASE C.SZ OF 50141000
BEGIN 50142000
% SZ = 000 (DATA DESCRIPTOR) SINGLE PRECISION 50143000
BEGIN A ~ 256; GO TO L4 END; 50144000
% SZ = 001 (DATA DESCRIPTOR) DOUBLE PRECISION 50145000
BEGIN A ~ 128; GO TO L4 END; 50146000
% SZ = 010 4-BIT CHARACTERS (STRING DESCRIPTOR) 50147000
BEGIN A ~ 3072; GO TO L4 END; 50148000
% SZ = 011 6-BIT CHARACTERS (STRING DESCRIPTOR) 50149000
BEGIN A ~ 2048; GO TO L4 END; 50150000
% SZ = 100 8-BIT CHARACTERS (STRING DESCRIPTOR) 50151000
BEGIN A ~ 1536; GO TO L4 END; 50152000
END; 50153000
% PAGE 13 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50154000
L4: 50155000
AROF ~ TRUE; 50156000
IDIV; IF INTFL THEN I2INTEGERDIV; 50157000
C.INDEX ~ B.ADDR; MOVE (A,B); C.IBIT ~ 1; 50158000
GO TO INDEXINDESC; % ON PAGE 7 50159000
% PAGE 14 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50160000
LABELQ: 50161000
CASE C.SZ OF 50162000
BEGIN 50163000
% SZ = 000 NOT POSSIBLE AT THIS POINT 50164000
; 50165000
% SZ = 001 NOT POSSIBLE AT THIS POINT 50166000
; 50167000
% SZ = 010 4-BIT CHARACTERS 50168000
BEGIN T1 ~ 12; T2 ~ 4 END; 50169000
% SZ = 011 6-BIT CHARACTERS 50170000
BEGIN T1 ~ 8; T2 ~ 6 END; 50171000
% SZ = 100 8-BIT CHARACTERS 50172000
BEGIN T1 ~ 6; T2 ~ 8 END; 50173000
END; 50174000
MOVE (A,B); BROF ~ TRUE; A ~ T1; 50175000
IDIV; IF INTFL THEN I2INTEGERDIV; 50176000
C.[13:15] ~ B.[33:15]; AROF ~ TRUE; AX.TAG ~ SINGL; B ~ T2; 50177000
MULT; IF INTFL THEN I2MULT; 50178000
MOVE (B,A); B ~ 47; BROF ~ FALSE; 50179000
B ~ B - A; 50180000
C.[7:6] ~ B.[42:6]; 50181000
GO TO SPECIALINDEX; % ON PAGE 11 50182000
% PAGE 15 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50183000
OPERAND: 50184000
IF EVAL THEN GO TO L7; % ON PAGE 16 50185000
IF QC6F = 1 THEN 50186000
BEGIN 50187000
IF QC7F = 1 THEN BEGIN CX.TAG ~ DOUBL; 50188000
GO TO L5 END ELSE 50189000
BEGIN CX.TAG ~ SINGL; 50190000
GO TO L6 END; 50191000
END; 50192000
IF CX.TAG ! DOUBL THEN GO TO L6; 50193000
L5: 50194000
MOVE (M[BUF2 + 1], X); MEMCYCLE; 50195000
L6: 50196000
MOVE (C,A); 50197000
% PAGE 16 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50198000
L7: 50199000
AROF ~ TRUE; 50200000
IF NOT STBR THEN GO TO OC; 50201000
ADJ (0,1); 50202000
A ~ AX ~ 0; AROF ~ TRUE; STEPPSR (2); 50203000
GO TO OC; 50204000
% PAGE 17 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50205000
INDEXWORD: 50206000
C.CVF ~ C.CVF + C.INCRF; 50207000
MOVE (C, M[BUF2]); MEMCYCLE; 50208000
IF C.CVF { C.FVF THEN 50209000
BEGIN 50210000
A ~ AX ~ 1; STEPPSR (2); AROF ~ TRUE; 50211000
GO TO OC 50212000
END; 50213000
GO TO STARTBRUN; 50214000
50215000
% PAGE 18 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50216000
STUFFEDIRW: 50217000
QC6F ~ 0; Q04F ~ 1; 50218000
LABELX: 50219000
IF SNR = C.STKNR THEN 50220000
BEGIN QC7F ~ 0; TEMP ~ BOSR END 50221000
ELSE 50222000
BEGIN 50223000
MOVE(M[STACKVECTOR],C); MEMCYCLE; QC7F ~ 1; 50224000
IF CX.PBIT !1 THEN I10PRESENCEBIT; 50225000
IF C.LENGTH { A.STKNR THEN I4INVALIDINDEX; 50226000
MOVE (M[C.ADDR + A.STKNR], C); MEMCYCLE; 50227000
IF CX.PBIT !1 THEN I10PRESENCEBIT; 50228000
TEMP ~ C.ADDR; 50229000
END; 50230000
% PAGE 19 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50231000
IF Q04F ! 1 THEN 50232000
IF STFF THEN 50233000
GO TO LABELW % ON PAGE 42 50234000
ELSE GO TO LABELD; % ON PAGE 22 50235000
BUF ~ TEMP + A.DISP; 50236000
BUF2 ~ BUF + A.ADRCPLSIR; 50237000
IF IRWL THEN GO TO OC; 50238000
Q04F ~ 0; MOVE(M[BUF + A.ADRCPLSIR] ,C); MEMCYCLE; 50239000
IF CX.TAG = IRW AND C.EBIT = 0 THEN I1INVALIDOPERATOR 50240000
ELSE GO TO LABELH; % ON PAGE 20 50241000
% PAGE 20 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50242000
NORMALIRW: 50243000
BUF ~ D [LEVEL(C)]; BUF2 ~ BUF + DELTA(C); 50244000
IF IRWL THEN GO TO OC; 50245000
MOVE (M[BUF + DELTA(C)],C); MEMCYCLE; 50246000
LABELH: 50247000
IF CX.TAG = IRW THEN GO TO LABELA; % ON PAGE 3 50248000
IF CX.TAG = PCW THEN GO TO PCWPAGE22; 50249000
IF ENTR THEN I1INVALIDOPERATOR; 50250000
IF NOT (NXLN OR NXLV OR INDX) THEN 50251000
BEGIN 50252000
QC6F ~ 0; 50253000
GO TO LABELC % ON PAGE 8 50254000
END; 50255000
% PAGE 21 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50256000
IF CX.TAG ! DATADESC OR C.IBIT ! 0 THEN I1INVALIDOPERATOR; 50257000
GO TO DESCPAGE6; % ON PAGE 6 50258000
% PAGE 22 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50259000
STARTPCWL: 50260000
PCWPAGE22: 50261000
IF NOT (ENTR OR BOOLEAN (QC1F)) THEN 50262000
BEGIN 50263000
PIR ~ PIR - PICR; 50264000
PSR ~ OPSR; 50265000
END; 50266000
MOVE (C,X); 50267000
IF A.EBIT ! 0 THEN GO TO L8; 50268000
50269000
A.STKNR ~ C.STKNR; 50270000
GO TO LABELX; 50271000
LABELD: 50272000
TS ~ D[LEVEL(A)]; 50273000
A.DISP ~ TS - TEMP; 50274000
L8: 50275000
C ~ CX ~ 0; 50276000
C.NBIT ~ REAL(NCSF); IIHF ~ BOOLEAN(X.NBIT); 50277000
NCSF ~ BOOLEAN(X.NBIT); 50278000
C.SDIF ~ PDR; PDR ~ X.SDIF; 50279000
% PAGE 23 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50280000
C.PSRF ~ PDR; PDR ~ X.PSRF; 50281000
C.PIRF ~ PIR; PIR ~ X.PIRF; 50282000
C.FLTFF ~ REAL (FLTF); 50283000
C.TFFFF ~ REAL (TFFF); 50284000
C.OFFFF ~ REAL (OFFF); 50285000
CX.SGNFF ~ SGNF; 50286000
C.LLF ~ LL; 50287000
TS ~ LL; LL ~ X.LLF; X.[10:5] ~ TS; 50288000
CX.TAG ~ RCW; 50289000
IF ENTR THEN 50290000
BEGIN % EXPECTED PROCEDURE ENTRY 50291000
MOVE (C,M[F + 1]); MEMCYCLE; 50292000
MOVE (M[F],C); MEMCYCLE; 50293000
C.STKNR ~ A.STKNR; 50294000
C.DISP ~ A.DISP; 50295000
CX.DSBIT ~ QC7F; 50296000
C.LLF ~ LL; 50297000
C.EBIT ~ 1; 50298000
MOVE (C,M[F]); MEMCYCLE; 50299000
GO TO DISPLAYUPDATE; % ON PAGE 25 50300000
END; 50300500
% PAGE 24 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50301000
% ACCIDENTAL PROCEDURE ENTRY 50302000
ADJ (0,0); 50303000
MOVE (A,B); 50304000
MOVE (C,A); 50305000
B.DSBIT ~ QC7F; 50306000
B.DF ~ S + 1 - F; 50307000
F ~ S + 1; 50308000
B.VBIT ~ QC1F; 50309000
BX.TAG ~ MSCW; 50310000
B.LLF ~ LL; 50311000
B.EBIT ~ 1; 50312000
AROF ~ BROF ~ TRUE; 50313000
ADJ (0,0); 50314000
% PAGE 25 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50315000
DISPLAYUPDATE: 50316000
D [LL] ~ F; 50317000
X.LLF ~ LL; 50318000
L9: 50319000
IF LL = 0 OR QC6F = 1 THEN 50320000
BEGIN 50321000
BYPASUPDATE: 50322000
LL ~ X.LLF; 50323000
IF MVST THEN GO TO OC 50324000
ELSE GO TO SEGMENTDESC; % ON PAGE 28 50325000
END; 50326000
LL ~ LL - 1; 50327000
IF D[LL] = BUF AND LL { X.[10:5] THEN GO TO BYPASUPDATE; 50328000
D[LL] ~ BUF; MOVE (M[BUF], C); MEMCYCLE; 50329000
% PAGE 26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50330000
IF CX.TAG ! MSCW OR LL ! C.LLF THEN 50331000
BEGIN 50332000
QC2F ~ 1; I7SEQUENCEERROR; 50333000
END; 50334000
LABELF: 50335000
IF CX.DSBIT = 0 THEN 50336000
BEGIN 50337000
BUF ~ TEMP + C.DISP; 50338000
GO TO L9 50339000
END; 50340000
MOVE (C,A); 50341000
BUF2 ~ D0 + 2; 50342000
MOVE (M[STACKVECTOR], C); MEMCYCLE; 50343000
IF CX.PBIT ! 1 THEN I12PRESENCEBIT; 50344000
IF C.LENGTH { A.STKNR THEN 50345000
BEGIN 50346000
QC2F ~ 1; 50347000
I3INVALIDINDEX; 50348000
END; 50349000
% PAGE 27 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50350000
BUF2 ~ C.ADDR + A.STKNR; 50351000
MOVE (M[BUF2], C); MEMCYCLE; 50352000
IF CX.PBIT ! 1 THEN I12PRESENCEBIT; 50353000
TEMP ~ C.ADDR; 50354000
BUF ~ TEMP + A.DISP; 50355000
GO TO L9; 50356000
% PAGE 28 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50357000
SEGMENTDESC: 50358000
C.SDIF ~ PDR; 50359000
BUF2 ~ D[C.LEVELPCW] + C.DELTAPCW; 50360000
MOVE (M[D[C.LEVELPCW] + C.DELTAPCW], C); MEMCYCLE; 50361000
IF CX.TAG ! SEGDESC THEN 50362000
BEGIN 50363000
QC2F ~ 1; 50364000
I8SEQUENCEERROR; 50365000
END; 50366000
IF CX.PBIT ! 1 THEN I12PRESENCEBIT; 50367000
PBR ~ C.ADDR; PROF ~ FALSE; 50368000
IF NOT RETN THEN GO TO OC; 50369000
% PAGE 29 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50370000
IF QC1F ! 1 THEN GO TO OC; 50371000
OP ~ 1; % FORCE A VALC INTO THE T REGISTER AND CONTINUE THE 50372000
% PROCESSING AS A VALUE CALL OPERATOR 50373000
GO TO LABELE; % ON PAGE 2 50374000
% PAGE 30 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50375000
STARTRETN: 50376000
ADJ (0,1); 50377000
L10: 50378000
F ~ D[LL]; 50379000
MOVE (M[F + 1], C); MEMCYCLE; 50380000
IIHF ~BOOLEAN(C.NBIT); PDR ~ C.SDIF; PIR ~ C.PIRF; 50381000
PSR ~ C.PSRF; NCSF ~BOOLEAN(C.NBIT); X.[10:5] ~ LL; 50382000
FLTF ~BOOLEAN(C.FLTFF); TFFF ~BOOLEAN(C.TFFFF); OFFF ~ BOOLEAN 50383000
(C.OFFFF); SGNF ~ CX.SGNFF; LL ~ C.LLF; 50384000
S ~ F - 1; 50385000
TEMP ~ BOSR; X.LLF ~ LL; 50386000
IF F = BOSR + 1 THEN 50387000
BEGIN 50388000
QC2F ~ 1; 50389000
I6BOSNORMAL; 50390000
END; 50391000
GO TO LABELG; % ON PAGE 31 50392000
% PAGE 31 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50393000
STARTEXIT: 50394000
ADJ (0,0); 50395000
GO TO L10; % ON PAGE 30 50396000
LABELG: 50397000
MOVE (M[F], C); MEMCYCLE; 50398000
IF CX.TAG ! MSCW THEN 50399000
BEGIN 50400000
QC2F ~ 1; 50401000
I8SEQUENCEERROR; 50402000
END; 50403000
F ~ F - C.DF; 50404000
BUF ~ F; QC1F ~ C.VBIT; 50405000
LABELS: 50406000
IF BOSR > BUF THEN 50407000
BEGIN 50408000
SUFL ~ TRUE; 50409000
I5BOSERROR; 50410000
END; 50411000
D[LL] ~ BUF; MOVE (M[BUF], C); MEMCYCLE; 50412000
% PAGE 32 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50413000
IF CX.TAG ! MSCW THEN 50414000
BEGIN 50415000
QC2F ~ 1; I8SEQUENCEERROR; 50416000
END; 50417000
IF LL = C.LLF AND C.EBIT = 1 THEN GO TO LABELF; % ON PAGE 26 50418000
BUF ~ D[LL] - C.DF; 50419000
GO TO LABELS; % ON PAGE 31 50420000
% PAGE 33 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50421000
STARTMVST: 50422000
ADJ (0,1); 50423000
C.DF ~ S - F; C.LLF ~ LL; C.NBIT ~ REAL (NCSF); 50424000
C.DS ~ S - BOSR; 50425000
C.FLTFF ~REAL(FLTF); C.TFFFF ~REAL(TFFF); C.OFFFF ~REAL(OFFF); 50426000
CX.SGNFF ~ SGNF; CX.TAG ~ TOS; 50427000
MOVE (M[BOSR], T1); 50428000
IF T2.ROBIT ! 1 THEN 50429000
BEGIN MOVE (C,M[BOSR]); MEMCYCLE END; 50430000
COMMENT THE LAST TWO STATEMENTS USE PSEUDO REGISTER T1,T2 TO 50431000
SIMULATE PROTECT LOGIC IN MEMORY MODULES; 50432000
BUF2 ~ D0 + 2; 50433000
MOVE (M[STACKVECTOR], C); MEMCYCLE; 50434000
IF CX.PBIT ! 1 THEN I13PRESENCEBIT; 50435000
NTGR; IF INTFL THEN I2INTEGERIZE; 50436000
IF B.MANF < 0 OR B.MANF } C.LENGTH THEN I4INVALIDINDEX; 50437000
BUF2 ~ C.ADDR + B.ADDR; 50438000
MOVE (M[C.ADDR + B.ADDR], A); MEMCYCLE; 50439000
% PAGE 34 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50440000
IF AX.PBIT ! 1 THEN 50441000
BEGIN MOVE (A,C); I13PRESENCEBIT; END; 50442000
SNR ~ B.ADDR;BROF ~ FALSE; 50443000
BOSR ~ A.ADDR; TEMP ~ A.ADDR; LOSR ~ A.ADDR + A.LENGTH; 50444000
C ~ PID; CX.TAG ~ SINGL; 50445000
MOVE (M[BOSR], T1); MOVE (C, M[BOSR]); MOVE (T1, C); MEMCYCLE; 50446000
S ~ C.DS + BOSR; F ~ S - C.DF; BUF ~ S - C.DF; LL ~ C.LLF; 50447000
X.[10:5] ~ LL; NCSF ~ BOOLEAN (C.NBIT); IIHF ~ BOOLEAN(C.NBIT);50448000
FLTF ~ BOOLEAN (C.FLTFF); TFFF ~ BOOLEAN (C.TFFFF); 50449000
OFFF ~ BOOLEAN (C.OFFFF); SGNF ~ C.SGNFF; 50450000
X.LLF ~ LL; 50451000
GO TO LABELS; % ON PAGE 31 50452000
% PAGE 35 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50453000
STARTDBTR: 50454000
ADJ (1,1); 50455000
IF B.LOBIT ! 1 THEN GO TO L11 50456000
ELSE GO TO L12; 50457000
STARTDBFL: 50458000
ADJ (1,1); 50459000
IF B.LOBIT = 1 THEN 50460000
L11: BEGIN AROF ~ FALSE; BROF ~ FALSE; GO TO OC END; 50461000
L12: BROF ~ FALSE; 50462000
GO TO LABELB; % ON PA6E 36 50463000
% PAGE 36 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50464000
STARTDBUN: 50465000
ADJ (1,2); 50466000
LABELB: 50467000
IF AX.TAG = SINGL OR AX.TAG = DOUBL THEN 50468000
GO TO LABELOPND; % ON PAGE 36 50469000
MOVE (A,C); 50470000
L13: IF CX.TAG = IRW THEN 50471000
BEGIN 50472000
IF C.EBIT ! 0 THEN 50473000
BEGIN AROF ~ FALSE; I8SEQUENCEERROR END; 50474000
MOVE (M[D[LEVEL(C) ] + DELTA(C) ], C);MEMCYCLE; 50475000
GO TO L13; 50476000
END; 50477000
% PAGE 37 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50478000
IF CX.TAG = PCW THEN GO TO PCW2; % ON PAGE 39 50479000
AROF ~ FALSE; 50480000
I1INVALIDOPERATOR; 50481000
% PAGE 38 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50482000
LABELOPND: 50483000
NTGR; IF INTFL THEN I2INTEGERIZE; 50484000
IF B.MANF < 0 THEN I9INVALIDINDEX; 50485000
IF B.MANF } 2097152 THEN I9INVALIDINDEX; 50486000
IF B.LOBIT = 0 THEN PSR ~ 0 50487000
ELSE PSR ~ 3; 50488000
PIR ~ B.[27:20]; PROF ~ FALSE; BROF ~ FALSE; 50489000
GO TO OC; 50490000
% PAGE 39 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50491000
PCW2: 50492000
IF LL ! C.LLF THEN 50493000
BEGIN AROF ~ FALSE; I8SEQUENCEERROR END; 50494000
PDR ~ C.SDIF; PSR ~ C.PSRF; PIR ~ C.PIRF; 50495000
BUF2 ~ D[C.LEVELPCW] + C.DELTAPCW; 50496000
MOVE (M[D[C.LEVELPCW] + C.DELTAPCW], C); 50497000
AROF ~ FALSE; 50498000
IF CX.TAG ! SEGDESC THEN 50499000
BEGIN QC2F ~ 1; I8SEQUENCEERROR END; 50500000
IF CX.PBIT ! 1 THEN I12PRESENCEBIT; 50501000
PBR ~ C.ADDR; PROF ~ FALSE; 50502000
GO TO OC; 50503000
% PAGE 40 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50504000
STARTBRTR: 50505000
ADJ (1,2); 50506000
IF A.LOBIT ! 1 THEN 50507000
L14: BEGIN STEPPSR (2); AROF ~ FALSE; GO TO OC END; 50508000
L15: 50509000
AROF ~ FALSE; 50510000
STARTBRUN: 50511000
C.[32:8] ~ SYLLABLE; STEPPSR(1); C.[40:8] ~ SYLLABLE; 50512000
PSR ~ C.[32:3]; PIR ~ C.[35:13]; PROF ~ FALSE; 50513000
GO TO OC; 50514000
STARTBRFL: 50515000
ADJ (1,2); 50516000
IF A.LOBIT = 0 THEN GO TO L15 ELSE GO TO L14; 50517000
% PAGE 41 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50518000
STARTSTFF: 50519000
ADJ (1,2); 50520000
IF AX.TAG ! IRW THEN 50521000
BEGIN MOVE (A, C); I1INVALIDOPERATOR END; 50522000
BUF ~ BUF2 ~ D[LEVEL(A)]; 50523000
L16: 50524000
MOVE (M[BUF2], C); 50525000
IF CX.TAG ! MSCW THEN I8SEQUENCEERROR; 50526000
IF CX.DSBIT ! 0 THEN 50527000
BEGIN BUF2 ~ BUF2 - C.DF; GO TO L16 END; 50528000
A.STKNR ~ C.STKNR; 50529000
GO TO LABELX; % ON PAGE 18 50530000
% PAGE 42 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50531000
LABELW: 50532000
A.DISP ~ BUF - TEMP; A.ADRCPL ~ DELTA(A); A.EBIT ~ 1; 50533000
GO TO OC; 50534000
% PAGE 43 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50535000
STARTMKST: 50536000
ADJ (0,0); 50537000
B ~ BX ~ 0; 50538000
B.DF ~ S + 1 - F; F ~ S + 1; BX.TAG ~ MSCW; BROF ~ TRUE; 50539000
ADJ (0,0); 50540000
GO TO OC; 50541000
% PAGE 44 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SET INTERRUPTS FOR ALL ERVSFLOW50542000
% SYLLABLE DEPENDENT INTERRUPTS 50543000
% (NON-PRESENCE BIT) 50544000
INVOPLBL: 50545000
ADJ (0,0); 50546000
B ~ BX ~ 0; 50547000
B ~ INVOP; 50548000
GO TO L17; 50549000
INVINDLBL: 50550000
ADJ (0,0); 50551000
B ~ BX ~ 0; 50552000
B ~ INVINXI; 50553000
GO TO L17; 50554000
STKUNFLBL: 50555000
ADJ (0,0); 50556000
B ~ BX ~ 0; 50557000
B ~ STKUNFI; 50558000
BROF ~ TRUE; 50559000
GO TO OC; 50560000
% PAGE 45 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50561000
BOSLBL: 50562000
ADJ (0,0); 50563000
B ~ BX ~ 0; 50564000
B ~ BOSINT; 50565000
GO TO L17; 50566000
SEQERLBL: 50567000
ADJ (0,0); 50568000
B ~ BX ~ 0; 50569000
B ~ SEQERRI; 50570000
L17: PIR ~ PIR - PICR; PSR ~ OPSR; 50571000
INTLBL: % SET INTERRUPT FOR INTERRUPT CONDITION RECOGNISED WHEN 50572000
% INTEGERIZE USED AS SUB-OPERATOR IN ERVSFLOW. NOTE THAT 50573000
% SETTING OF B WITH INTERRUPT ID AND OTHER NECESSARY OPER-50574000
% ATIONS TOOK PLACE AT TIME INTERRUPT WAS RECOGNISED IN 50575000
% INTEGERIZE. 50576000
BROF ~ TRUE; 50577000
SDIS ~ 1; MOVE (C,A); AROF ~ TRUE; 50578000
GO TO OC; 50579000
% PAGE 46 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50580000
PRES13LBL: 50581000
ADJ (0,0); 50582000
PRES11LBL: 50583000
IF C.CBIT ! 1 THEN 50584000
BEGIN C.CBIT ~ 1; C.ADDR ~ BUF2 END; 50585000
MOVE (C,A); 50586000
PRES10LBL: 50587000
ADJ (0,0); 50588000
IF NOT (VALC OR ENTR OR MVST) THEN T1 ~ 1; % CHECK ** 50589000
PIR ~ PIR - PICR; PSR ~ OPSR; 50590000
L18: 50591000
B ~ BX ~ 0; 50592000
SDIS ~ 1; AROF ~ BROF ~ TRUE; B.SOBIT ~ T1; 50593000
B.[18:30] ~ PRESBIT; 50594000
GO TO OC; 50595000
PRES12LBL: 50596000
% PAGE 47 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 50597000
IF C.CBIT ! 1 THEN 50598000
BEGIN C.CBIT ~ 1; C.ADDR ~ BUF2 END; 50599000
MOVE (C,A); 50600000
ADJ (0,0); 50601000
GO TO L18; % ON PAGE 46 50602000
OC: 50603000
END ERVSFLOW; 50604000
PROCEDURE STORE(OP); VALUE OP; REAL OP; 51000000
COMMENT OP=0: STORE DESTRUCTIVE 51001000
OP=1: STORE NON-DESTRUCTIVE 51002000
OP=2: OVERWRITE DESTRUCTIVE 51003000
OP=3: OVERWRITE NON-DESTRUCTIVE 51004000
OP=7: READ-WITH-LOCK; 51005000
BEGIN 51006000
LABEL EVALDESC,EVALIRW,TRYWRITE,MIXEDTYPECHECK,FIXROFS, 51007000
LABELF,ACCIDENTALENTRY, 51008000
OC; 51009000
DEFINE INVALIDOP = BEGIN INTFAMD(2); GO OC; END#, 51010000
PRESENCEBIT = BEGIN INTFAMD(8); GO OC END#, 51011000
INVALIDINDEX= BEGIN INTFAMD(7); GO OC END#, 51012000
MEMORYPROTECT=BEGIN INTFAMD(6); GO OC END#; 51013000
DEFINE OVERWRITE = (OP=2 OR OP=3)#, 51014000
NONDESTRUCTIVE = BOOLEAN(OP)#, 51015000
DESTRUCTIVE = NOT NONDESTRUCTIVE#, 51016000
READWITHLOCK = (OP=7)#; 51017000
%%%%% PAGE 1 %%%%%%%%%%%%%%% 51018000
ADJ(1,1); 51026000
IF AX.TAG=SINGL OR AX.TAG=DOUBL THEN EXCH; 51027000
MOVE(A,C); 51029000
IF CX.TAG=IRW THEN GO TO EVALIRW; 51030000
IF CX.TAG!DATADESC OR C.IBIT!1 THEN INVALIDOP; 51031000
EVALDESC: 51032000
IF C.RBIT!0 THEN MEMORYPROTECT; 51033000
IF CX.PBIT!1 THEN PRESENCEBIT; 51034000
MM~C.INDEX+C.ADDR; 51035000
TRYWRITE: 51036000
IF MM + MM > MEMMODS % INVALID ADDRESS CHECK FOR STORES 51036100
THEN BEGIN 51036200
SETINTERRUPT (INVADRI); 51036300
GO OC 51036400
END; 51036500
MOVE(M[MM],C); MEMCYCLE; 51037000
IF OVERWRITE OR READWITHLOCK OR NOT BOOLEAN(CX.TAG) 51038000
THEN MOVE(B,M[MM]); 51039000
IF OVERWRITE OR READWITHLOCK THEN GO TO LABELF; 51040000
%%%%% PAGE 2 %%%%%%%%%%%%%%% 51041000
CASE CX.TAG OF 51042000
BEGIN % CASE TYPE 51043000
; % 0 SINGL 51044000
GO TO EVALIRW; % 1 IRW 51045000
; % 2 DOUBL 51046000
MEMORYPROTECT; % 3 LINKS,CODE,MSCW,RCW,L 51047000
; % 4 STEP INDEX WORD 51048000
IF C.IBIT=1 THEN GO EVALDESC ELSE MEMORYPROTECT; % 5 51049000
; % 6 UNINITIALIZED 51050000
GO TO ACCIDENTALENTRY; % 7 PCW 51051000
END; 51052000
MIXEDTYPECHECK: 51053000
CASE REAL(CX.TAG=DOUBL)|2 + REAL(BX.TAG=DOUBL) OF 51054000
BEGIN % C B 51055000
; % S S 51056000
BEGIN IF Y.[9:1]=1 THEN B~(B+1)&B[1:1:8]; % S D 51057000
BX.TAG~0; MOVE(B,M[MM]); MEMCYCLE; % 51058000
END; % 51059000
BEGIN BX.TAG~DOUBL; Y~YX~0; YX.TAG~DOUBL; % D S 51060000
MOVE(B,M[MM ]); MEMCYCLE; % 51061000
MOVE(Y,M[MM+1]); MEMCYCLE; % 51062000
END; % 51063000
BEGIN MOVE(Y,M[MM+1]); MEMCYCLE; % D D 51064000
END; % 51065000
END; 51066000
FIXROFS: 51067000
AROF~FALSE; 51068000
BROF~NONDESTRUCTIVE; 51069000
GO TO OC; 51070000
LABELF: 51071000
IF NOT READWITHLOCK THEN GO TO FIXROFS; 51072000
MOVE(C,A); 51073000
BROF ~ FALSE; 51073100
GO TO OC; 51074000
%%%%% PAGE 3 %%%%%%%%%%%%%%% 51075000
EVALIRW: 51076000
IF C.EBIT=0 THEN 51077000
BEGIN %%%%% NORMAL IRW %%%%% 51078000
Q02F~1; 51079000
A.DISP~D[LEVEL(C)] - BOSR; 51080000
A.STKNR~SNR; 51081000
TEMP~BOSR; 51082000
BUF~D[LEVEL(C)]; 51083000
MM~BUF+DELTA(C); 51084000
END 51085000
ELSE 51086000
BEGIN %%%%% STUFFED IRW %%%%% 51087000
Q02F~0; 51088000
MOVE(C,A); 51089000
IF SNR = C.STKNR THEN TEMP~BOSR 51090000
ELSE BEGIN 51091000
MOVE(M[STACKVECTOR],C); MEMCYCLE; 51092000
IF CX.PBIT=0 THEN PRESENCEBIT; 51093000
IF C.LENGTH{A.STKNR THEN INVALIDINDEX; 51094000
MOVE(M[C.ADDR+A.STKNR],C); MEMCYCLE; 51095000
IF CX.PBIT=0 THEN PRESENCEBIT; 51096000
TEMP~C.ADDR; 51097000
END; 51098000
BUF~TEMP+A.DISP; 51099000
MM~BUF+A.[35:13]; 51100000
END; 51101000
GO TO TRYWRITE; 51102000
ACCIDENTALENTRY: 51103000
Q01F~1; 51104000
NOTYETCODED; 51105000
OC: 51106000
END STORE; 51107000
PROCEDURE ADJ(NEWAROF,NEWBROF); VALUE NEWAROF,NEWBROF; 60000000
INTEGER NEWAROF,NEWBROF; 60001000
BEGIN DEFINE 60002000
PUSHA = 60003000
BEGIN 60003150
STKOVFF ~ S ~ S + 1 =LOSR; 60003300
MOVE(A, M[S]); MEMCYCLE; AROF ~ FALSE; 60004000
IF AX.TAG = DOUBL 60004300
THEN BEGIN 60004600
STKOVFF ~ S ~ S + 1 = LOSR; 60005000
XX.TAG ~ DOUBL; MOVE(X, M[S]); MEMCYCLE; 60006000
END 60006300
END#, 60006600
PUSHB = 60007000
BEGIN 60007150
STKOVFF ~ S ~ S + 1 =LOSR; 60007300
MOVE(B, M[S]); MEMCYCLE; BROF ~ FALSE; 60008000
IF BX.TAG = DOUBL 60008300
THEN BEGIN 60008600
STKOVFF ~ S ~ S + 1 = LOSR; 60009000
YX.TAG ~ DOUBL; MOVE(Y, M[S]); MEMCYCLE; 60010000
END 60010300
END#, 60010600
POPA = BEGIN MOVE(M[S],A); S~S-1; MEMCYCLE; AROF~TRUE; 60011000
IF AX.TAG=DOUBL THEN 60012000
BEGIN X~A; XX~AX; 60013000
MOVE(M[S],A); S~S-1; MEMCYCLE; 60014000
END; 60015000
END#, 60016000
POPB = BEGIN MOVE(M[S],B); S~S-1; MEMCYCLE; BROF~TRUE; 60017000
IF BX.TAG=DOUBL THEN 60018000
BEGIN Y~B; YX~BX; 60019000
MOVE(M[S],B); S~S-1; MEMCYCLE; 60020000
END; 60021000
END#, 60022000
ATOB = BEGIN B~A; BX~AX; AROF~FALSE; BROF~TRUE; 60023000
IF AX.TAG=DOUBL THEN BEGIN Y~x; YX~XX; END; 60024000
END#, 60025000
BTOA = BEGIN A~B; AX~BX; AROF~TRUE; BROF~FALSE; 60026000
IF BX.TAG=DOUBL THEN BEGIN X~Y; XX~YX; END; 60027000
END#; 60028000
IF NEWAROF<0 OR NEWAROF>1 OR NEWBROF<0 OR NEWBROF>2 60029000
THEN BEGIN ERROR(98); GO TO EOJ; END; 60030000
AROF~AROF AND TRUE; BROF~BROF AND TRUE; 60031000
CASE (0&NEWAROF[45:47:1]&NEWBROF[43:46:2] 60032000
&REAL(AROF)[46:47:1]&REAL(BROF)[47:47:1]) OF 60033000
BEGIN % NEWA NEWB AROF BROF CASE 60034000
; % 0 0 0 0 0 60035000
PUSHB; % 0 0 0 1 1 60036000
PUSHA; % 0 0 1 0 2 60037000
BEGIN PUSHB; PUSHA; END; % 0 0 1 1 3 60038000
POPA; % 1 0 0 0 4 60039000
BTOA; % 1 0 0 1 5 60040000
; % 1 0 1 0 6 60041000
PUSHB; % 1 0 1 1 7 60042000
POPB; % 0 1 0 0 8 60043000
; % 0 1 0 1 9 60044000
ATOB; % 0 1 1 0 10 60045000
BEGIN PUSHB; ATOB; END; % 0 1 1 1 11 60046000
BEGIN POPA; POPB; END; % 1 1 0 0 12 60047000
BEGIN BTOA; POPB; END; % 1 1 0 1 13 60048000
POPB; % 1 1 1 0 14 60049000
; % 1 1 1 1 15 60050000
; % 0 2 0 0 16 60051000
; % 0 2 0 1 17 60052000
ATOB; % 0 2 1 0 18 60053000
BEGIN PUSHB; ATOB; END; % 0 2 1 1 19 60054000
POPA; % 1 2 0 0 20 60055000
BTOA; % 1 2 0 1 21 60056000
; % 1 2 1 0 22 60057000
; % 1 2 1 1 23 60058000
END; 60059000
IF NOT (NEWAROF=REAL(AROF) AND (NEWBROF=2 OR 60060000
NEWBROF=REAL(BROF))) 60061000
THEN BEGIN ERROR(99); MEMDUMP; GO EOJ END; 60062000
END ADJ; 60063000
INTEGER PROCEDURE LEVEL(WORD); VALUE WORD; REAL WORD; 60064000
BEGIN 60065000
LEVEL ~ REFLECTION[REAL( 60066000
BOOLEAN(WORD) AND NOT BOOLEAN(DELTAMASK[LL])60067000
).[34:5]]; 60068000
END LEVEL; 60069000
INTEGER PROCEDURE DELTA(WORD); VALUE WORD; REAL WORD; 60070000
BEGIN 60071000
DELTA ~ REAL(BOOLEAN(WORD) AND BOOLEAN(DELTAMASK[LL])); 60072000
END DELTA; 60073000
BOOLEAN PROCEDURE INTEGERIZE(ROUND,REG); VALUE ROUND; 60074000
BOOLEAN ROUND; REAL REG; 60075000
BEGIN 60076000
STREAM PROCEDURE M0VE4(S,D); 60077000
BEGIN SI~S; DI~D; DS~4 WDS; 60078000
END M0VE4; 60079000
REAL OWNA,OWNAX,OWNX,OWNXX; 60080000
INTEGER I; 60081000
LABEL FINIS; 60082000
DEFINE MAXNTGR = 549755813887#; 60083000
M0VE4(REG,OWNA); 60084000
IF OWNAX.TAG!SINGL AND OWNAX.TAG!DOUBL THEN 60085000
INTEGERIZE ~ TRUE; 60086000
IF (INTEGERIZE~ABS(OWNA)>MAXNTGR) THEN GO TO FINIS; 60087000
IF NOT ROUND THEN 60088000
I ~ OWNA DIV 1 60089000
ELSE IF OWNAX.TAG =SINGL THEN 60090000
I ~ OWNA 60091000
ELSE % DOUBLE PRECISION ROUNDED CASE 60092000
BEGIN 60093000
DOUBLE(OWNA,OWNX,(I~OWNA DIV 1),0,-, 60094000
~,OWNAX,OWNXX); 60095000
IF I}0 AND OWNAX}(0.5) THEN 60096000
BEGIN 60097000
IF (INTEGERIZE~(I+1)>+(MAXNTGR)) THEN 60098000
GO TO FINIS; 60099000
I~I+1; 60100000
END 60101000
ELSE IF I<0 AND OWNAX<-(0.5) THEN 60102000
BEGIN 60103000
IF (INTEGERIZE~(I-1)<-(MAXNTGR)) THEN 60104000
GO TO FINIS; 60105000
I~I-1; 60106000
END; 60107000
END; 60108000
OWNA~1; OWNAX~SINGL+SINGL; MOVE(OWNA,REG); 60109000
FINIS: 60110000
END INTEGERIZE; 60111000
PROCEDURE INITIALIZE; 71000000
BEGIN 71001000
FILE CODE DISK SERIAL (2,30); 71002000
FORMAT ERROR ("EQUATED FILE IS NOT ON DISK. ", 32("X"), //); 71003000
LABEL EOF; 71004000
ARRAY JUNK[0:59],JUNK1[0:29]; 71005000
ARRAY MEMS[0:89]; 71005100
LABEL EOF1; 71006000
INTEGER MSTART; 71007000
STREAM PROCEDURE MOVEN(S,D,N); VALUE N; 71008000
BEGIN SI~S; DI~D; DS~N WDS END; 71009000
STREAM PROCEDURE STRIP(J,M); 71010000
BEGIN LOCAL S,SS; 71011000
SI~J; DI~M; 71012000
45(48 BITS; SKIP 31 DB; 16 BITS; SKIP 1 DB); 71013000
END; 71014000
STREAM PROCEDURE NFLAG(M); 71015000
BEGIN SI~M; DI~M; DI~DI+8; DI~DI+7; SKIP 5 DB; 71016000
1 BITS; DI~DI+4; DI~M; DS~1 RESET; END; 71017000
SEARCH(CODE,TBUF[*]); 71018000
IF TBUF[0] > 0 THEN 71019000
BEGIN 71020000
MULFILID ~ TBUF[1]; 71020100
FILID ~ TBUF [2]; 71020200
MSTART~0; 71021000
DO BEGIN 71022000
READ(CODE,30,JUNK[*])[EOF]; 71023000
READ(CODE,30,JUNK1[*])[EOF1]; 71024000
MOVEN(JUNK1,JUNK[30],30); 71025000
EOF1: 71026000
STRIP(JUNK,MEMS); 71027000
FOR INTG~0 STEP 2 UNTIL 89 DO 71028000
BEGIN 71028100
IF MSTART+INTG/2 > 8191 THEN GO EOF; 71028110
NFLAG(MEMS[INTG]); 71028200
MOVE(MEMS[INTG],M[MSTART+INTG/2]); 71028300
END; 71029000
MSTART~MSTART+45; 71030000
END UNTIL FALSE; 71031000
EOF: 71032000
END ELSE BEGIN WRITE (LP, ERROR); GO EOF END; 71033000
71034000
71035000
71036000
71037000
71038000
S~8192; PDR~2; SNR~2; 71039000
SNR ~0; 71040000
SETINTERRUPT (EXTINTI + 15); 71045000
P~0&32768[8:28:20]; 71046000
PX~11; 71047000
MOVE(P,M[4]); 71048000
END OF INITIALIZE; 71049000
PROCEDURE COBOLSIM; % SPECIAL INITIALIZATION FOR COBOL SIMULATION; 71050000
BEGIN 71051000
FILE DK DISK SERIAL "SIM" "INPUT" (2,30,150); 71052000
ARRAY J[0:29]; 71053000
REAL SZ; 71054000
INTEGER I,K; 71055000
STREAM PROCEDURE MV(F,T); 71056000
BEGIN 71057000
SI ~ F; DI ~ T; DS ~2 WDS; 71058000
END MV; 71059000
READ(DK,30,J[*]); 71060000
D0 ~ J[0]; 71061000
D1 ~ J[2]; 71062000
D2 ~ J[4]; 71063000
S ~ (D3 ~F ~ J[6]) + 2; 71064000
LOSR ~ J[8]; 71065000
BOSR ~ 0; 71066000
PBR ~ J[10].[28:20]; 71067000
LL ~ 3; 71068000
SZ ~ J[10].[8:20]; 71069000
I ~ -1; WHILE I ~1 +1 { SZ DO 71070000
BEGIN 71071000
K ~-2; WHILE K <30 DO 71072000
MV(J[K ~ K + 2],M[I]); 71073000
READ(DK,30,J[*]); 71074000
END; 71075000
END COBOLSIM; 71076000
INTEGER PROCEDURE PROTECT (IOAREA, IOCW, RESULT); 71077000
VALUE IOAREA, IOCW; 71078000
REAL IOAREA, IOCW, RESULT; 71079000
BEGIN COMMENT CHECK AN INPUT AREA FOR THE PRESENCE 0F PROTECTED 71080000
WORDS AND RETURN THE MAXIMUM NUMBER OF WORDS THAT CAN BE 71081000
WRITTEN T0 MEMORY. PLACE THE ENDING ADDRESS IN THE RESULT71082000
DESCRIPTOR.; 71083000
INTEGER WORDS; 71084000
REAL R, S; 71085000
LABEL FINISH; 71086000
IF BOOLEAN (IOCW.IOPBIT) AND BOOLEAN (IOCW.IOWBIT) 71087000
THEN BEGIN 71088000
S ~ IOAREA.ADDR +IOAREA.LENGTH; 71089000
FOR R ~ IOAREA.ADDR + 1.5 STEP 1 UNTIL S DO 71090000
IF BOOLEAN (M [R].TAG) 71091000
THEN BEGIN 71092000
WORDS ~ R - 1.5 -IOAREA.ADDR; 71093000
RESULT.RSLTPRO ~ 1; 71094000
GO FINISH; 71095000
END; 71096000
END 71097000
ELSE WORDS ~ IOAREA.LENGTH - 1; 71098000
FINISH: 71099000
RESULT.RSLTADRS ~ IOAREA.ADDR + WORDS + 1; 71100000
PROTECT ~ WORDS; 71101000
END PROTECT AND ENDING ADDRESS PROCESSING; 71102000
REAL PROCEDURE GETRESULT (MPXAB); 71103000
VALUE MPXAB; 71104000
REAL MPXAB; 71105000
BEGIN COMMENT GET THE NEXT RESULT DESCRIPTOR FOR MPXAB AND UPDATE 71106000
FIRSTEVENT, FIRSTEVENTI, CURRENT TIME AND MPX. THE 71107000
RESULT DESCRIPTOR THAT IS GOTTEN, IS FORGOTTEN.; 71108000
REAL R; 71109000
REAL E, L; 71109100
INTEGER I, J, F; 71110000
R ~ MPX [I ~ MPXAB + DELTAMPX, J ~ FIRSTEVENTI [MPXAB]]; 71111000
IF R.RSLTERR ! 0 THEN R.RSLTEXC ~ 1; 71112000
F ~ FIRSTEVENTI [MPXAB] ~ EVENTS [J].EVLINK; 71113000
L ~ J; 71113100
DO L ~ (E ~ EVENTS[L]).EVLINK UNTIL E =0 OR E.EVMPX =MPXAB; 71113200
IF E !0 AND MPX[MPXAB, L].MPXINT =0 71113300
THEN MPX[MPXAB, L].MPXINT ~ MPX[MPXAB, J].MPXINT; 71113400
MPX [I, J] ~ EVENTS [J] ~ 0; 71114000
FIRSTEVENT [MPXAB] ~ EVENTS [F].EVTIME; 71115000
CURRENTT ~ FIRSTEVENT [CURRENTMPX ~ IF J ~ FIRSTEVENT [2] = 0 71116000
OR (I ~ FIRSTEVENT [1] { J AND I ! 0) THEN 1 ELSE 2];71117000
IF CURRENTT ! 0 AND(CURRENTT < IDLETIME OR IDLETIME = 0) 71118000
THEN IDLETIME ~ CURRENTT ELSE IDLETIME ~ INTTIMER; 71119000
MPXOPS [MPXAB] ~ MPXOPS [MPXAB] + 1; 71120000
IF CURRENTT = 0 THEN LASTEVENT [MPXAB] ~ 0; 71121000
GETRESULT ~ R; 71122000
END GETTING RESULT DESCRIPTOR; 71123000
PROCEDURE PUTRESULT (LUNIT, MPXAB, IOTIME, RESULT); 71124000
VALUE LUNIT, MPXAB, IOTIME; 71125000
REAL RESULT; 71126000
INTEGER LUNIT, MPXAB, IOTIME; 71127000
BEGIN COMMENT DO THE LINKED LIST UPDATING BASED ON IOTIME (THE TIME71128000
INCREMENT FOR AN I/O) AND UPDATE CURRENTT AND 71129000
CURRENTMPX AS REQUIRED. PUT THE RESULT DESCRIPTOR IN71130000
MPX BASED ON LUNIT AND MPXAB.; 71131000
INTEGER T, I, J, K; 71132000
DEFINE EVERYTHING =MPXAB [1:46:2] 71133000
&1 [6:47:1] % BUSY 71134000
&I [7:43:5] % EVENT LINK 71135000
#; 71136000
IF T~IOTIME}LASTEVENT [MPXAB] % COMMON CASE 71137000
THEN BEGIN 71138000
EVENTS [LASTEVENTI[MPXAB]].EVLINK ~ LUNIT; 71139000
LASTEVENT [MPXAB] ~ T; 71140000
LASTEVENTI[MPXAB] ~ LUNIT; 71141000
IF FIRSTEVENT [MPXAB] = 0 71142000
THEN BEGIN 71143000
FIRSTEVENT [MPXAB] ~ T; 71144000
FIRSTEVENTI[MPXAB] ~ LUNIT; 71145000
END; 71146000
END 71147000
ELSE BEGIN 71148000
I ~ K ~ FIRSTEVENTI [MPXAB]; 71149000
WHILE EVENTS [I].EVTIME { T 71150000
DO I ~ EVENTS [J ~ I].EVLINK; 71151000
IF I = K % T IS EARLIER THAN EARLIEST 71152000
THEN BEGIN 71153000
FIRSTEVENTI [MPXAB] ~ LUNIT; 71154000
FIRSTEVENT [MPXAB] ~ T; 71155000
J ~ I; 71156000
END; 71157000
EVENTS [J].EVLINK ~ LUNIT 71158000
END; 71159000
EVENTS [LUNIT] ~ T & EVERYTHING; 71160000
RESULT.RSLTUNIT ~ LUNIT; 71161000
MPX [MPXAB + DELTAMPX, LUNIT] ~ RESULT; 71162000
MPX[MPXAB, LUNIT].MPXINT ~ MPXAB ~ 240; % INTERRUPT LITERAL 71163000
IF T < CURRENTT OR CURRENTT = 0 71164000
THEN BEGIN CURRENTT ~ T; CURRENTMPX ~ MPXAB END; 71165000
IF T < IDLETIME OR IDLETIME =0 THEN IDLETIME ~ T; 71166000
MPXOPS [MPXAB] ~ MPXOPS [MPXAB] - 1; 71167000
END SORTING TIME AND RESULT DESCRIPTOR FOR AN IO; 71168000
PROCEDURE FLAGHANDLE (MESS, MINDEX, WORDS, IOCW); 71169000
VALUE MINDEX, WORDS, IOCW; 71170000
INTEGER MINDEX, WORDS; 71171000
ARRAY MESS [0]; 71172000
REAL IOCW; 71173000
BEGIN COMMENT MOVE INPUT FROM WORK AREA (MESS) TO M ARRAY START-71174000
ING AT MINDEX + 1 AND MOVE THE FLAG BIT TO THE EXTENSION 71175000
WORD.; 71176000
INTEGER I, J, K, MI, R, W; 71177000
INTEGER JDIV, JMOD, TAG, BCD; 71178000
DEFINE FLAGGER = 71179000
DI ~ B; DI ~ DI + 15; SKIP 2 DB; 71180000
SI ~ LOC TAG; SKIP 45 SB; 71181000
3 BITS; SI ~ A; 71182000
IF SB THEN DS ~ 1 SET ELSE DS ~ 1 RESET; 71183000
DI ~ A; DS ~ 1 RESET; SI ~ A; DI ~ B; 71184000
DS ~ WDS; A ~ SI; DI ~ DI + 8; B ~ DI; #; 71185000
STREAM PROCEDURE FLAGIN (S, D, JDIV, JMOD, TAG); 71186000
VALUE JDIV, JMOD, TAG; 71187000
BEGIN 71188000
LOCAL A, B; 71189000
SI ~ S; A ~ SI; DI ~ D; B ~ DI; 71190000
JMOD (FLAGGER); 71191000
JDIV (32(FLAGGER)); 71192000
END; 71193000
DEFINE TAGGERIN = 71194000
SKIP BCD SB; 71195000
DI ~ B; DI ~ DI + 15; SKIP 2 DB; 71196000
4 BITS; DI ~ B; SKIP DB; 47 BITS; %>RETRO71197000
DI ~ DI + 8; B ~ DI; #; %>RETRO71198000
STREAM PROCEDURE TAGIN (M, MESS, JDIV, JMOD, BCD); %>RETRO71199000
VALUE JDIV, JMOD, BCD; %>RETRO71200000
BEGIN 71201000
LOCAL B; 71202000
SI ~ MESS; DI ~ M; B ~ DI; 71203000
JMOD (TAGGERIN); 71204000
JDIV (32(TAGGERIN)); 71205000
END; 71206000
DEFINE FLAGGEROUT = 71207000
SI ~ A; SI ~ SI + 15; SKIP 5 SB; 71208000
DI ~ A; IF SB THEN DS ~ 1 SET ELSE DS ~ 1 RESET; 71209000
DI ~ B; SI ~ A; DS ~ WDS; B ~ DI; 71210000
DI ~ A; DS ~ 1 RESET; 71211000
SI ~ A; SI ~ SI + 16; A ~ SI;#; 71212000
STREAM PROCEDURE FLAGOUT (S, D, JDIV, JMOD); 71213000
VALUE JDIV, JMOD; 71214000
BEGIN 71215000
LOCAL A, B; 71216000
SI ~ S; A ~ SI; DI ~ D; B ~ DI; 71217000
JMOD (FLAGGEROUT); 71218000
JDIV (32(FLAGGEROUT)); 71219000
END; 71220000
DEFINE TAGGER = 71221000
SI ~ A; SI ~ SI + 15; SKIP 2 SB; 71222000
DI ~ B; DS ~ 3 LIT "0"; DI ~ B; SKIP BCD DB;4 BITS;71223000
SI ~ A; SKIP SB; 47 BITS; SI ~ SI + 8; 71224000
A ~ SI; B ~ DI;#; 71225000
STREAM PROCEDURE TAGOUT (M, MESS, JDIV, JMOD, BCD); 71226000
VALUE JDIV, JMOD, BCD; 71227000
BEGIN 71228000
LOCAL A, B; 71229000
SI ~ M; A ~ SI; DI ~ MESS; B ~ DI; 71230000
JMOD (TAGGER); 71231000
JDIV (32(TAGGER)); 71232000
END; 71233000
MI ~ MINDEX + 1; 71234000
W ~ WORDS; 71235000
TAG ~ IF I ~ IOCW.IOTAGS = 0 THEN SINGL ELSE 71236000
IF I = 1 THEN CODE ELSE IF I = 3 THEN DOUBL ELSE 4; 71237000
BCD ~ IF IOCW.IOSBIT = 1 THEN 13 ELSE 9; 71238000
DO BEGIN 71239000
I ~ MI MOD ROWLENGTH; 71240000
J ~ IF (R ~ ROWLENGTH- I) > W THEN W ELSE R; 71241000
JDIV ~ J DIV 32; 71242000
JMOD ~ J MOD 32; 71243000
IF IOCW.IOWBIT = 1 71244000
THEN BEGIN 71245000
IF TAG < 4 71246000
THEN FLAGIN (MESS[K],M[MI],JDIV,JMOD,TAG) 71247000
ELSE TAGIN (MESS[K],M[MI],JDIV,JMOD,BCD); 71248000
END 71249000
ELSE BEGIN 71250000
IF TAG < 4 71251000
THEN FLAGOUT (M[MI], MESS[K], JDIV, JMOD) 71252000
ELSE TAGOUT (M[MI],MESS[K],JDIV,JMOD, BCD);71253000
END; 71254000
K ~ K + J; 71255000
MI ~ MI + J; 71256000
END UNTIL W ~ W - J { 0; 71257000
END INPUT FLAG BIT MANIPULATI0NS; 71258000
INTEGER PROCEDURE MPXTIME(ELTIME,METIME,LUNIT); 71259000
VALUE ELTIME,METIME,LUNIT; 71260000
INTEGER ELTIME,METIME,LUNIT; 71261000
BEGIN 71262000
IF(EVENTS[LUNIT].EVTIME)<UNITAVAILTIME[LUNIT] 71263000
AND UNITAVAILTIME[LUNIT]>REALTIME 71264000
THEN MPXTIME~UNITAVAILTIME[LUNIT]+ELTIME 71265000
ELSE MPXTIME~REALTIME+ELTIME; 71266000
IF (EVENTS[LUNIT].EVTIME)=0 71267000
THEN UNITAVAILTIME[LUNIT]~REALTIME+METIME 71268000
ELSE UNITAVAILTIME[LUNIT]~EVENTS[LUNIT].EVTIME+METIME; 71269000
END EVALUATION OF MPXTIME FOR AN IO; 71270000
PROCEDURE CARDLOAD; 71271000
BEGIN 71272000
FILE EDOC DISK SERIAL (2,3,30); 71273000
DEFINE CODE = EDOC#; 71273100
FORMAT ERROR ("EQUATED FILE IS NOT ON DISK. ", 32("X"),//); 71274000
LABEL EOF; 71275000
SEARCH (CODE, TBUF[*]); 71276000
IF TBUF[0] > 0 THEN 71277000
BEGIN 71278000
READ (CODE, *, PBR, S, D[0]); 71279000
DO BEGIN 71280000
READ (CODE, *, MM, A, AX) [EOF]; 71281000
MOVE (A, M[MM]); 71282000
END 71283000
UNTIL FALSE; 71284000
EOF: 71285000
END 71286000
ELSE 71287000
BEGIN 71288000
WRITE (LP, ERROR); GO EOF END 71289000
END; 71290000
PROCEDURE MULTIPLEXOR; 72000000
BEGIN COMMENT MULTIPLEXOR IS CALLED WHEN THE PROCESSOR HAS INITIATED72001000
AN I/O. A SWITCH BASED ON HARDWARE UNIT TYPE IS INVOKED 72002000
AND THE SIMULATED I/O IS PERFORMED. TIMING CALCULATIONS 72003000
ARE COMPLETED AND EXCEPTION CONDITIONS ARE NOTED AND THE 72004000
RESULT DESCRIPTOR IS LINKED INTO THE EVENTS AND MPX ARRAYS72005000
BASED ON MPX AND TIME. THE A & B REGISTERS ARE ASSUMED T072006000
BE FULL.; 72007000
REAL MPXINFO, RESULT, WORDS, EVENTIME; 72008000
INTEGER LDIV,LMOD,DESC,SKIP,SWFI, ELTIME,METIME; 72009000
BOOLEAN SPACLP; 72010000
REAL FUNCD, FUNCDX, IOAD , IOAREAX, IOCW, IOCWX; 72011000
LABEL AROUND, PUT, CEOF, OC; 72012000
DEFINE EBCDIC = 6(DI ~ LOC J; SKIP 43 DB; 5 BITS ; 72013000
DI ~ LOC K; SKIP 45 DB; 3 BITS ; 72014000
A ~ SI; 72015000
SI ~ TABLE; 72016000
J (SI ~ SI + 8); SI ~ SI + K; 72017000
DI ~ B; DS ~ CHR; B ~ DI; 72018000
SI ~ A;)#, 72019000
WORDIV = WORDS.[38:5], WORDS.[43:5]#; 72020000
STREAM PROCEDURE EBCOUT (MESS, TABLE, WMOD, WDIV); 72021000
VALUE WMOD, WDIV; 72022000
BEGIN 72023000
LOCAL A, B, J, K; 72024000
SI ~ MESS; A ~ SI; 72025000
WMOD (EBCDIC); 72026000
WDIV (32(EBCDIC)); 72027000
END CONVERSION OF EBCDIC INTERNAL TO BCL GRAPHIC; 72028000
DEFINE ERROR201 = 72029000
IF IOAD.LENGTH - 1 > MPXINFO.MPXBUFF 72030000
THEN BEGIN ERROR (201); GO EOJ END;#, 72031000
BADUNIT = 72032000
BEGIN ERROR (200); MEMDUMP; GO EOJ END#; 72033000
STREAM PROCEDURE BLANK (M, LMOD, LDIV); VALUE LMOD, LDIV; 72034000
BEGIN DI ~ M; DS ~ 8 LIT " "; SI ~ M; DS~LMOD WDS; 72035000
LDIV (DS ~ 32 WDS) END; 72036000
REAL STREAM PROCEDURE NFLAG(WORD); 72037000
BEGIN SI ~ WORD; DI~ LOC NFLAG; DS ~ 1 WDS; 72038000
DI ~ DI - 8; DS ~ 1 RESET; 72039000
END; 72040000
DEFINE 72041000
T=PERIPHERALT#, 72042000
TSKIP=5|MPXINFO.MPXHDWE#; 72043000
LABEL EOF,PAR; 72044000
DEFINE READS = IF BOOLEAN(IOCW.IOBBIT) THEN 72045000
BEGIN 72046000
READ REVERSE(TAPES[SWFI], 72047000
MPXINFO.MPXBUFF,MESS[*]) 72048000
[EOF:PAR]; 72049000
IF NFLAG(MESS)=TMK THEN GO EOF; 72050000
MPX[0,FUNCD.LUNIT] ~ 72051000
MPX[0,FUNCD.LUNIT] - 1; 72052000
END ELSE 72053000
BEGIN 72054000
READ(TAPES[SWFI],MPXINFO. 72055000
MPXBUFF,MESS[*])[EOF:PAR]; 72056000
IF NFLAG(MESS)=TMK THEN GO EOF; 72057000
BUMPIT; 72058000
END#, 72059000
TRANSLATE = IF BOOLEAN(IOCW.IOXBIT) THEN 72060000
BEGIN 72061000
FLAGHANDLE(MESS,IOAD.ADDR, 72062000
WORDS,IOCW); 72063000
IF BOOLEAN(IOCW.IOSBIT)THEN 72064000
BEGIN 72065000
EBCOUT(MESS, 72066000
EBCTOBCL,WORDIV); 72067000
WORDS ~ ENTIER 72068000
(WORDS/.75); 72069000
END; 72070000
END #, 72071000
TIMEIT = ELTIME ~ ELTIME + T[TSKIP]; 72072000
METIME ~ METIME + T[TSKIP + 1] #, 72073000
BUMPIT = MPX[0,FUNCD.LUNIT] ~ 72074000
MPX[0,FUNCD.LUNIT] + 1 #, 72075000
TMK = "}}}}}}}"&"}"[1:43:5] # , 72076000
TM = [13:1] #; 72077000
ALPHA STREAM PROCEDURE EXAMIN (NCR); VALUE NCR; 72078000
BEGIN SI~NCR; DI~LOC EXAMIN; DI~DI+7; DS~CHR; END EXAMIN; 72079000
INTEGER STREAM PROCEDURE OUTPCVT(ADDR); VALUE ADDR; 72080000
BEGIN 72081000
SI ~ LOC ADDR; DI ~ LOC OUTPCVT; DS ~ 8 OCT; 72082000
END; 72083000
REAL SAVIOAD, RECNT; 72084000
LABEL PRINTERS; 72084100
MOVE (SCANBUSA, FUNCD); 72085000
MOVE (DATABUSA, IOAD); 72086000
MOVE (M[IOAD .ADDR ], IOCW); 72087000
MEMCYCLE; 72087100
RESULT.RSLTATT ~ IOCW.IOABIT; 72088000
MPXINFO ~ MPX [FUNCD.MPXFC, FUNCD.LUNIT]; 72089000
MULTIPLEX ~ FALSE; 72090000
IF BOOLEAN (IOCW.IOTBIT) % TEST 72091000
THEN BEGIN 72092000
A ~ MPX [FUNCD.MPXFC + DELTAMPX, FUNCD.LUNIT]; 72093000
A.RSLTBSY ~ EVENTS [FUNCD.LUNIT].EVBUSY; 72094000
AX ~ 0; 72095000
AROF ~ TRUE; 72096000
GO OC; 72097000
END; 72098000
CASE MPXINFO.MPXHDWE OF 72099000
BEGIN % INTERNAL NAME CASE72100000
BADUNIT;% NONE 0 72101000
BEGIN% DISK 1 72102000
IF(JUNK~OUTPCVT(IOCW.[20:28])) < 9999 AND JUNK } 0 THEN 72103000
BEGIN 72104000
SAVIOAD ~ IOAD; 72105000
IOAD.LENGTH ~ 60; 72106000
RECNT ~ 0 ; 72107000
ERROR201; 72108000
IF BOOLEAN (IOCW.IOWBIT) 72109000
THEN DO BEGIN 72110000
READ (DISKA[JUNK], 60, MESS[*]); 72111000
WORDS ~ PROTECT (IOAD, IOCW, RESULT); 72112000
FLAGHANDLE (MESS, IOAD.ADDR, WORDS, 72113000
IOCW); 72114000
RECNT ~ RECNT + 1; 72115000
JUNK ~ JUNK + WORDS; 72116000
TIMEIT; 72117000
END UNTIL SAVIOAD.LENGTH { RECNT 72118000
OR RESULT.[31:17] ! 0 72119000
ELSE DO BEGIN 72120000
FLAGHANDLE (MESS, IOAD.ADDR, 60, 72121000
IOCW); 72122000
WRITE (DISKA[JUNK], 60, MESS[*]); 72123000
RECNT ~ RECNT + 1; 72124000
JUNK ~ JUNK + WORDS; 72125000
TIMEIT; 72126000
END UNTIL SAVIOAD.LENGTH { RECNT 72127000
OR RESULT.[31:17] ! 0 72128000
END ELSE 72129000
BEGIN 72130000
RESULT.RSLTNRY ~ 1; 72131000
TIMEIT; 72132000
END; 72133000
EVENTIME ~ MPXTIME (ELTIME, METIME, FUNCD.LUNIT); 72134000
END; 72135000
BEGIN% SPO 2 72136000
IF TUBA.[9:9]= 0 THEN RESULT.RSLTNRY ~ 1 ELSE 72137000
BEGIN 72138000
ERROR201; 72139000
WORDS ~ PROTECT(IOAD,IOCW,RESULT); 72140000
IF BOOLEAN(IOCW.IOWBIT) THEN 72141000
BEGIN % READ 72142000
IF SPOED THEN 72143000
BEGIN 72144000
FLAGHANDLE(CUP,IOAD. 72145000
ADDR,WORDS,IOCW); 72146000
SPOED ~ FALSE; 72147000
END ELSE 72148000
BEGIN 72149000
READ(SPO(TUBA) 72150000
,10,MESS[*]); 72151000
FLAGHANDLE(MESS,IOAD. 72152000
ADDR,WORDS,IOCW); 72153000
END 72154000
END ELSE 72155000
BEGIN % WRITE 72156000
FLAGHANDLE(MESS,IOAD.ADDR, 72157000
WORDS,IOCW); 72158000
EBCOUT(MESS,EBCTOBCL,WORDIV); 72159000
WORDS ~ ENTIER(WORDS / .75); 72160000
WRITE(SPO(TUBA), 72161000
10,MESS[*]); 72162000
END; 72163000
ELTIME ~ T[TSKIP]; 72164000
METIME ~ T[TSKIP + 1]; 72165000
END; 72166000
END; 72167000
BEGIN% BIDS 3 72168000
END; 72169000
BADUNIT;% 4 72170000
BADUNIT;% 5 72171000
BEGIN% LP OR PRINT 6 72172000
PRINTERS: 72172100
ERROR201; 72173000
WORDS ~ PROTECT (IOAD , IOCW, RESULT); 72174000
IF BOOLEAN (IOCW.IOXBIT) % TRANSLATE 72175000
THEN BEGIN 72176000
FLAGHANDLE (MESS, IOAD.ADDR, WORDS, 72177000
IOCW); 72178000
IF BOOLEAN (IOCW.IOSBIT) % 8 BIT 72179000
THEN BEGIN 72180000
EBCOUT (MESS, EBCTOBCL, WORDIV); 72181000
WORDS ~ ENTIER (WORDS/.75); 72182000
END; 72183000
END 72184000
ELSE IF NOT BOOLEAN (IOCW.IOIBIT) %MEMORY INHIBIT 72185000
THEN BEGIN 72186000
RESULT.RSLTDSC ~ DESC ~ 1; 72187000
ELTIME~200; METIME~0; GO AROUND; 72188000
END 72189000
ELSE BEGIN 72190000
LDIV ~ (LMOD ~ WORDS ) DIV 32; 72191000
LMOD ~ LMOD MOD 32 - 1; 72192000
BLANK (MESS, LMOD, LDIV); 72193000
END; 72194000
SWFI ~ MPXINFO.MPXSWFI; 72195000
IF SKIP ~ IOCW.IOSKIP = 0 72196000
THEN BEGIN 72197000
WRITE (LINES[SWFI][NO], WORDS 72198000
, MESS [*]); 72199000
SKIP ~ IOCW.IOSPAC; SPACLP ~ TRUE; 72200000
METIME~METIME+(T[TSKIP+2]+T[TSKIP+3]| 72201000
(SKIP-1)); 72202000
WHILE SKIP > 0 72203000
DO BEGIN 72204000
WRITE (LINES [SWFI]); 72205000
SKIP ~ SKIP - 1; 72206000
END; 72207000
END 72208000
ELSE BEGIN 72209000
WRITE (LINES[SWFI][SKIP], WORDS, 72210000
MESS [*]); 72211000
METIME~METIME+T[TSKIP+4]; 72212000
END; 72213000
ELTIME~T[TSKIP]; 72214000
METIME~METIME+T[TSKIP+1]; 72215000
AROUND: EVENTIME~MPXTIME(ELTIME,METIME,FUNCD.LUNIT); 72216000
END; 72217000
BEGIN% LP 7 72218000
GO PRINTERS; 72218100
END; 72219000
BADUNIT;% 8 72220000
BEGIN% CR 9 72221000
ERROR201; 72222000
IF IOCW.IOWBIT = 1 AND (IOCW.IOXBIT = 1 OR 72223000
IOCW.IOSBIT = 1) 72224000
THEN BEGIN 72225000
READ (CARD, MPXINFO.MPXBUFF,MESS[*])[CEOF];72226000
RESULT.RSLTVY ~ REAL (EXAMIN(NCR)= "~"); 72227000
RESULT.RSLTCC ~ RESULT.RSLTVY; 72228000
WORDS ~ PROTECT (IOAD , IOCW, RESULT); 72229000
FLAGHANDLE (MESS, IOAD.ADDR, WORDS, IOCW); 72230000
ELTIME~T[TSKIP]; 72231000
METIME~T[TSKIP+1]; 72232000
GO PUT; 72233000
END 72234000
ELSE BEGIN 72235000
RESULT.RSLTDSC ~ 1; 72236000
ELTIME~200; METIME~0; 72237000
GO PUT; 72238000
END; 72239000
CEOF:RESULT.RSLTNRY ~ 1; 72240000
ELTIME~200; METIME~0; 72241000
PUT: EVENTIME~MPXTIME(ELTIME,METIME,FUNCD.LUNIT); 72242000
END; 72243000
BEGIN% CP 1072244000
END; 72245000
BADUNIT;% 1172246000
BADUNIT;% 1272247000
BEGIN% MT 1372248000
ELTIME ~ METIME ~ 0; 72249000
SWFI ~ MPXINFO.MPXSWFI; 72250000
CASE 0&IOCW[46:3:2] OF 72251000
BEGIN 72252000
% % % % WRITES % % % % 72253000
IF BOOLEAN(IOCW.TM) THEN 72254000
BEGIN 72255000
WRITE(TAPES[SWFI],*,TMK); 72256000
TIMEIT; 72257000
BUMPIT; 72258000
END ELSE 72259000
BEGIN 72260000
ERROR201; 72261000
WORDS ~ PROTECT(IOAD,IOCW,RESULT)72262000
;TRANSLATE; 72263000
WRITE(TAPES[SWFI],WORDS,MESS[*]);72264000
TIMEIT; 72265000
BUMPIT; 72266000
END; 72267000
% % REWIND OR ERASE % % 72268000
IF BOOLEAN(IOCW.IOBBIT) THEN 72269000
BEGIN 72270000
INTG ~ MPX[0,FUNCD.LUNIT]; 72271000
ELTIME ~ T[TSKIP]; 72272000
FOR JUNK~1 STEP 1 UNTIL INTG DO 72273000
BEGIN 72274000
READ REVERSE(TAPES 72275000
[SWFI],1,MESS[*]) 72276000
[EOF:PAR]; 72277000
IF NFLAG(MESS)=TMK THEN GO EOF; 72278000
GO TO EOF; 72279000
MPX[0,FUNCD.LUNIT] ~ 72280000
MPX[0,FUNCD.LUNIT] -1; 72281000
METIME ~ METIME + 72282000
T[TSKIP + 1]; 72283000
END; 72284000
RESULT.RSLTRW ~ 1; 72285000
END ELSE 72286000
BEGIN TIMEIT END; 72287000
% % % % READS % % % % 72288000
BEGIN 72289000
ERROR201; 72290000
READS; 72291000
IF FALSE THEN 72292000
PAR: 72293000
BEGIN 72294000
RESULT.RSLTMA ~ 1; 72295000
RESULT.RSLTCC ~ 1; 72296000
RESULT.RSLTOF ~ 1; 72297000
END; 72298000
WORDS ~ PROTECT(IOAD,IOCW,RESULT); 72299000
FLAGHANDLE(MESS,IOAD.ADDR,WORDS,IOCW);72300000
TIMEIT; 72301000
END; 72302000
% % % % SPACE % % % % 72303000
BEGIN 72304000
IF (INTG~IOCW.RECS) =0 THEN INTG~100; 72305000
FOR JUNK~1 STEP 1 UNTIL INTG DO 72306000
BEGIN 72307000
READS; 72308000
TIMEIT; 72309000
END; 72310000
END; 72311000
END; 72312000
IF FALSE THEN 72313000
EOF: BEGIN 72314000
RESULT.RSLTVY ~ 1; 72315000
RESULT.RSLTNRY~ 1; 72316000
TIMEIT; 72317000
END; 72318000
EVENTIME ~ MPXTIME(ELTIME,METIME,FUNCD.LUNIT); 72319000
END; 72320000
END; 72321000
PUTRESULT (FUNCD.LUNIT, FUNCD.MPXFC, EVENTIME , RESULT); 72322000
OC: 72323000
END MULTIPLEXOR; 72324000
PROCEDURE NEXTEVENT; 72325000
BEGIN COMMENT NEXTEVENT WORRIES ABOUT INTERRUPT PRIORITIES AND SETS72326000
APPROPRIATE INTERRUPTS. PRIORITY (HIGH TO LOW) IS 72327000
ALARM, SYLLABLE-DEPENDENT, CONTROL AND EXTERNAL. 72328000
SOME FUNCTIONS OF INTERRUPT CONTROL ARE HANDLED. 72329000
; 72330000
IF ABORTTIME { REALTIME 72331000
THEN BEGIN 72332000
END 72333000
ELSE IF IDLETIME { REALTIME AND SDIS + GCIF = 0 72334000
72335000
THEN BEGIN 72336000
IF INTTIMER { REALTIME 72337000
THEN BEGIN 72338000
SETINTERRUPT (INTTIMI); 72338500
INTTIMER ~ 2*36; 72339000
IDLETIME ~ CURRENTT; 72339050
END 72339500
ELSE IF NOT IIHF 72340000
AND CURRENTT { REALTIME 72340100
AND CURRENTT ! 0 72340200
THEN BEGIN 72341000
SETINTERRUPT (EXTINTI + CURRENTMPX); 72342000
CURRENTT ~ 0; 72342500
IDLETIME ~ INTTIMER; 72342600
END; 72343000
END; 72344000
END OF NEXT EVENT; 72345000
PROCEDURE SIMULATOR; 73000000
BEGIN COMMENT THIS IS THE PRINCIPAL DRIVER FOR THE SIMULATOR. ;73001000
LABEL NDIN; 73002000
CASE DISKLOAD OF 73003000
BEGIN 73004000
INITIALIZE; % ESPOL 73005000
CARDLOAD; % ALGOL 73006000
COBOLSIM; % COBOL 73007000
END; 73008000
73009000
73010000
TBUF[16]:=MKABS(TBUF); 73010100
ABORTTIME ~ INTTIMER ~ 2*36; 73010200
IF DISKLOAD = 0 THEN INTTIMER ~ 2*36 73010300
ELSE IDLETIME ~ 2*36; 73010400
NCR ~ MKABS (MESS); 73010500
D31 ~ MONITORVALUE & MONITORMASK[28:38:10]; 73010600
DO BEGIN 73011000
IF INT ! 0 73012000
THEN INTERRUPTCONTROLLER 73013000
ELSE BEGIN 73014000
CONTROLSECTION; 73015000
TRACE; 73016000
END; 73017000
IF MONITORVALUE! MONITORMASKOLD 73017100
THEN D31 ~ MONITORMASKOLD ~ MONITORVALUE; 73017200
IF MULTIPLEX THEN MULTIPLEXOR; 73018000
NEXTEVENT; 73019000
IF TUBA.[9:9]=0 THEN ELSE 73020000
IF SPOED THEN ELSE 73021000
BEGIN 73022000
READ(SPO(TUBA,1),10,CUP[*])[NDIN]; 73023000
SPOED ~ TRUE; 73024000
NDIN: 73025000
END; 73026000
END UNTIL FALSE; 73027000
END SIMULATOR CONTROL; 73028000
PROCEDURE TRACE; 74000000
BEGIN 74001000
LABEL EXIT; 74002000
STREAM PROCEDURE PBIS(SYLL,PBR,PIR,PSR,TANK); 74003000
VALUE SYLL,PBR,PIR,PSR,TANK; 74004000
BEGIN 74005000
DI:=TANK; SI:=LOC SYLL;SI:=SI+4; DS:=4 CHR; DS:=4 LIT" "; 74006000
DS:=12 LIT ""PBR:PIR:PSR"; DS:=3 LIT ""= "; 74007000
2(SI:=SI+4; 8(DS:=3 RESET; 3 BITS); DS:= LIT ":"); 74008000
SI:=SI+7; DS:=CHR; 2(DS:=39 LIT " "); 74009000
END OF PBIS; 74010000
REAL STREAM PROCEDURE OCTIZE(TAG1,WD1,TAG2,WD2,DBLE,TANK); 74011000
VALUE TAG1,WD1,TAG2,WD2,DBLE,TANK; 74012000
BEGIN 74013000
DI:=TANK; SI:=LOC TAG1; 74014000
DBLE(SKIP 44 SB; DS:=3 RESET; 3 BITS; DS:=LIT " "; 74015000
DS:=3 RESET; 1 BITS; SKIP SB; 2 BITS; 74016000
7(DS:=3 RESET; 3 BITS); DS:=LIT " "; 74017000
8(DS:=3 RESET; 3 BITS); DS:=2 LIT " "); 74018000
OCTIZE:= DI; 74019000
END OF OCTIZE; 74020000
STREAM PROCEDURE BLANK(TANK); 74021000
VALUE TANK; 74022000
BEGIN LOCAL T; 74023000
DI:=TANK; T:=DI; DS:=8 LIT " "; SI:=T; DS:=14 WDS; 74024000
END OF BLANK; 74025000
PROCEDURE TOS; 74026000
BEGIN 74027000
FORMAT TOSREG(X8,"AREG",X17,"XREG",X17,"BREG",X17,"YRE6"); 74028000
BLANK(TANK); 74029000
WRITE(LP,TOSREG); 74030000
IF AROF THEN 74031000
TANK:=OCTIZE(AX,A,XX,X,2,TANK); 74032000
IF BROF THEN 74033000
TANK:=OCTIZE(BX,B,YX,Y,2,TANK+65541|(REAL(NOT AROF)).[47:1]); 74034000
PRINT; 74035000
END OF TOS; 74036000
PROCEDURE REGISTER(TAGE,WORDE,FMTE); 74037000
VALUE TAGE,WORDE,FMTE; 74038000
REAL TAGE,WORDE,FMTE; 74039000
BEGIN 74040000
SWITCH FORMAT REGS:= 74041000
("C = "), 74042000
("P = "); 74043000
REAL STREAM PROCEDURE SYLLABLIZE(PX,P,TANK); VALUE PX,P,TANK; 74044000
BEGIN 74045000
DI~ TANK; SI~ LOC PX; 74046000
SKIP 44 SB; DS~ 3 RESET; 3 BITS; DS~ LIT " "; 74047000
DS~ 4 RESET; 1 BITS; SKIP SB; 1 BITS; 74048000
2(DS~ 3 RESET; 3 BITS); DS~ LIT " "; 74049000
5(DS~4 RESET; 2 BITS; 2(DS~3RESET; 3 BITS);DS~LIT" "); 74050000
END; 74051000
TANK:=TBUF[16]; 74052000
WRITE(LP[NO],REGS[FMTE]); 74053000
BLANK(TANK); 74054000
IF FMTE=0 THEN TANK~OCTIZE(TAGE,WORDE,0,0,1,TANK+1) ELSE 74055000
IF FMTE=1 AND PROF THEN TANK~SYLLABLIZE(TAGE,WORDE,TANK+1); 74056000
PRINT; 74057000
END OF REGISTER; 74058000
STREAM PROCEDURE OCTAL(TANK,DPLAY,WRDS); 74059000
VALUE TANK,WRDS; 74060000
BEGIN 74061000
DI~TANK; SI~DPLAY; 74062000
WRDS(SI:=SI+5; 6(DS:= 3 RESET; 3 BITS); DS:=2 LIT " "; ); 74063000
END OF OCTAL; 74064000
PROCEDURE DISPLAY; 74065000
BEGIN 74066000
FORMAT DREGS("DISPLAY REGISTERS 0 THROUGH ",I2," LL= ",I2); 74067000
DEFINE N=NDISPLAY#; 74068000
INTEGER I,LINES,NMOD15; 74069000
INTEGER DPLAID; 74070000
TANK:=TBUF[16]; 74071000
IF N=0 THEN N:=DPLAID:=31; 74072000
WRITE(LP,DREGS,N-1,LL); 74073000
LINES:= N DIV 15; 74074000
FOR I:=1 STEP 1 UNTIL LINES DO 74075000
BEGIN 74076000
BLANK(TANK); 74077000
OCTAL(TANK,D[(I-1)|15],15); 74078000
PRINT; 74079000
END; 74080000
IF (NMOD15:=N MOD 15)!0 THEN 74081000
BEGIN 74082000
BLANK(TANK); 74083000
OCTAL(TANK,D[LINES|15], NMOD15 ); 74084000
PRINT; 74085000
END; 74086000
IF DPLAID!0 THEN N:=0; 74087000
END OF DISPLAY; 74088000
OWN BOOLEAN ASTERICKS; 74089000
PROCEDURE STACK; 74090000
BEGIN 74091000
BOOLEAN STREAM PROCEDURE NOTZERO(ADDR); VALUE ADDR; 74092000
BEGIN LOCAL L1,L2,L3; 74093000
DI:=LOC L3; DS:=21 LIT"0 OOOOOOOO 00000000 "; SI:=ADDR; 74094000
4(DI:=LOC L3;SI:=SI+1; DI:=DI+1; 74095000
IF 20 SC!DC THEN BEGIN TALLY:=1; JUMP OUT END); 74095100
NOTZERO:=TALLY; 74096000
END OF NOTZERO; 74097000
STREAM PROCEDURE STARS(ADDR); VALUE ADDR; 74098000
BEGIN LOCAL T; 74099000
DI:=ADDR; DS:=21 LIT "* ******** ******** "; 74100000
SI:=ADDR; 3(DS:=21 CHR); 74101000
END OF STARS; 74102000
FORMAT STACKS("STACK CONTENTS WORD F TO F+",I6,X4,"S= ",O, 74103000
" F= ",O," BOSR= ",O," LOSR= ",O); 74104000
DEFINE N=NSTACK#; 74105000
REAL T,T1; INTEGER I,LINES,J; 74106000
INTEGER ISTACK; 74107000
STREAM PROCEDURE OCTL(A,B,C,D,E); VALUE A,B,C,D,E; 74108000
BEGIN DI~A; SI~LOC B; 4(SI~SI+4; 8(DS~3RESET; 3 BITS))END; 74109000
TANK:=TBUF[16]; 74110000
IF N=0 THEN N:=ISTACK:= S-F+1; 74111000
OCTL(TANK,S,F,BOSR,LOSR); 74112000
WRITE(LP,STACKS,N-1,TBUF[0],TBUF[1],TBUF[2],TBUF[3]); 74113000
LINES:=N DIV 4; 74114000
FOR I:=1 STEP 1 UNTIL LINES DO 74115000
BEGIN 74116000
TANK:= TBUF[16]; 74117000
BLANK(TANK); 74118000
FOR J:=0 STEP 1 UNTIL 3 DO 74119000
BEGIN 74120000
MOVE(M[(F+J)+(I-1)|4],T); 74121000
TANK:=OCTIZE(T1,T,0,0,1,TANK); 74122000
END; 74123000
IF NOTZERO(TBUF[16]) THEN 74124000
BEGIN ASTERICKS:=FALSE; PRINT END ELSE 74125000
IF NOT ASTERICKS THEN 74126000
BEGIN STARS(TBUF[16]); PRINT; 74127000
ASTERICKS:=TRUE; WRITE(LP); 74128000
END; 74129000
END; 74130000
IF (I:=N MOD 4)!0 THEN 74131000
BEGIN 74132000
TANK:= TBUF[16]; 74133000
BLANK(TANK); 74134000
FOR J:=1 STEP 1 UNTIL I DO 74135000
BEGIN 74136000
MOVE(M[(F+(J-1))+ LINES|4],T); 74137000
TANK:=OCTIZE(T1,T,0,0,1,TANK); 74138000
END; 74139000
PRINT; 74140000
END; 74141000
IF ISTACK!0 THEN N:=0; 74142000
END OF STACK; 74143000
LABEL NONE; 74144000
FORMAT TOGS ( X43,"VARF = ",I1," , LEEF = ",I1," , TEEF = ",I1, 74145000
" , SEEE = ",I1," , NCSE = ",I1," UPDF s ",I1 74146000
); 74147000
INTEGER REALTI; 74148000
MONITOR LP (REALTI); 74149000
NONE: 74150000
ASTERICKS:=FALSE; 74151000
TANK:=TBUF[16]; 74152000
IF TRACEWORD = 0 OR ( TRACEWORD > 100 AND TRACTER=0) THEN 74153000
GO TO EXIT; 74154000
HEADING; 74155000
IF TS1=0 THEN JUNK:=MNEMONIC[0,T] 74156000
ELSE IF VARF THEN JUNK:=MNEMONIC[1,T] 74157000
ELSE JUNK~ MNEMONIC[2,T]; 74158000
WRITE(LP[NO],TOGS,REAL(VARF),REAL(LEEF),REAL(TEEF),REAL(SEEF), 74159000
REAL(NCSF),REAL(UPDF)); 74160000
PBIS(JUNK,PBR,PIR,PSR,TANK); 74161000
PRINT; 74162000
REALTI ~ REALTIME; 74163000
TANK:= TBUF[16]; 74164000
IF (JUNK~TRACEWORD) } 100 THEN 74165000
JUNK ~ TRACTER; 74166000
CASE JUNK OF 74167000
BEGIN 74168000
; 74169000
TOS; % TRACE OF A,X,B,Y REGISTERS 74170000
REGISTER(CX,C,0); % TRACE OF C REGISTER 74171000
REGISTER(PX,P,1); % TRACE OF P REGISTER 74172000
DISPLAY; % TRACE 0F N DISPLAY REGISTERS 74173000
STACK; % TRACE 0F N WORDS IN THE STACK 74174000
BEGIN TOS; REGISTER(CX,C,0) END; % 6 74175000
BEGIN TOS; REGISTER(PX,P,1) END; % 7 74176000
BEGIN TOS; DISPLAY END; % 8 74177000
BEGIN TOS; STACK END; % 9 74178000
BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1) END; % 10 74179000
BEGIN TOS; REGISTER(CX,C,0); DISPLAY END; % 11 74180000
BEGIN TOS; REGISTER(CX,C,0); STACK END; % 12 74181000
BEGIN TOS; REGISTER(PX,P,1); DISPLAY END; % 13 74182000
BEGIN TOS; REGISTER(PX,P,1); STACK END; % 14 74183000
BEGIN TOS; DISPLAY; STACK END; % 15 74184000
BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1); DISPLAY END;%16 74185000
BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1); STACK END; % 17 74186000
BEGIN TOS; REGISTER(CX,C,0); REGISTER(PX,P,1); 74187000
DISPLAY;STACK; 74188000
END; % 18 74189000
MEMDUMP; % 19 74190000
BEGIN LABEL DUMPER; %%%%%%%%%%%%%%% 74191000
DUMP LP (MPX, FIRSTEVENT, LASTEVENT, FIRSTEVENTI, LASTEVENTI, 74192000
CURRENTT,UNITAVAILTIME,EVENTS,CURRENTMPX,MPXOPS, 74193000
BUFRMAX)DUMPER:1; 74194000
DUMPER: END; 74195000
END; 74196000
WRITE(LP); 74197000
EXIT: 74198000
END OF TRACE; 74199000
PROCEDURE MEMDUMP; 75000000
BEGIN 75001000
INTEGER ADDRESS,I,ROW,J,WRDS,TANK; 75002000
INTEGER SAVETRACEWORD,SAVEN,SAVENN; 75003000
BOOLEAN ASTERICKS; 75004000
ARRAY MD[0:9]; 75005000
ARRAY XMD[0:9]; 75005100
DEFINE N= NDISPLAY#, NN=NSTACK#; 75006000
STREAM PROCEDURE OCTIZE(LOCM,ADDR,WRDS,BLK,TANK); 75007000
VALUE LOCM,WRDS,BLK,TANK; 75008000
BEGIN 75009000
DI:=TANK; DS:=4 LIT " "; SI:=LOC LOCM; SI:=SI+4; 75010000
8(DS:=3 RESET; 3 BITS); DS:=3 LIT " "; 75011000
SI:=ADDR; 75012000
WRDS(SKIP 44 SB; DS:=3 RESET; 3 BITS; DS:=LIT " "; 75013000
DS:=3 RESET; 1 BITS; SKIP SB; 2 BITS; 75014000
7(DS:=3 RESET; 3 BITS); DS:=LIT " "; 75015000
8(DS:=3 RESET; 3 BITS); DS:=2 LIT " "); 75016000
BLK(2(DS:=42 LIT " " )); 75017000
END OF OCTIZE; 75018000
BOOLEAN STREAM PROCEDURE NOTSAME(XMD,MD,WRDS); 75019000
VALUE WRDS; 75020000
BEGIN LOCAL RPF; 75021000
SI ~ XMD; DI ~ MD; 75022000
WRDS(IF 8 SC!DC THEN BEGIN TALLY~1; JUMP OUT END); 75022100
NOTSAME~ TALLY; RPF ~ TALLY; 75023000
RPF(SI~MD; DI~XMD; DS~WRDS WDS); 75024000
END; 75027000
STREAM PROCEDURE STARS(LOCM,TANK); 75028000
VALUE LOCM,TANK; 75029000
BEGIN 75030000
LOCAL T; 75031000
DI:=TANK; DS:=4 LIT " "; SI:=LOC LOCM; SI:=SI+4; 75032000
8(DS:=3 RESET; 3 BITS); DS:=3 LIT " "; 75033000
T:=DI; DS:=21 LIT "* ******** ******** "; 75034000
SI:=T; 4(DS:=21 CHR); 75035000
END OF STARS; 75036000
STREAM PROCEDURE MOVIT(HERE,THERE,WORDS); 75037000
VALUE WORDS; 75038000
BEGIN 75039000
SI:=HERE; DI:=THERE; SI:=SI+8; 75040000
WORDS(DS:=WDS; SI:=SI+8; DI:=DI+8); 75041000
SI:=HERE; DI:=THERE; DI:=DI+8; 75042000
WORDS(DS:=WDS; SI:=SI+8; DI:=DI+8;); 75043000
END OF MOVIT; 75044000
SAVETRACEWORD:=TRACEWORD; SAVEN:=N; SAVENN:=NN; 75045000
TRACEWORD:=18; N:=32; NN:=99; 75046000
TRACE; 75047000
ADDRESS:=0; ASTERICKS:=FALSE; 75048000
TANK:=TBUF[16]; 75049000
FOR I ~ 0 STEP 256 UNTIL (MEMMODS + 1) DIV 2 - 1 DO 75050000
BEGIN 75051000
FOR J:=0 STEP 5 UNTIL 255 DO 75052000
BEGIN 75053000
WRDS:= IF J=255 THEN 1 ELSE 5; 75054000
MOVIT(M[I+J],MD, WRDS); 75055000
IF NOTSAME(XMD,MD,2|WRDS)THEN 75056000
BEGIN 75057000
OCTIZE(ADDRESS, MD ,WRDS,WRDS!5,TANK); 75058000
PRINT; 75059000
ASTERICKS:=FALSE; 75060000
END ELSE 75061000
IF NOT ASTERICKS THEN 75062000
BEGIN 75063000
STARS(ADDRESS,TANK); 75064000
PRINT; 75065000
ASTERICKS:=TRUE; 75066000
WRITE(LP); 75067000
END; 75068000
ADDRESS:=ADDRESS+WRDS; 75069000
END; 75070000
IF NOT ASTERICKS THEN 75071000
WRITE(LP); 75072000
END; 75073000
TRACEWORD:=SAVETRACEWORD; N:=SAVEN; NN:=SAVENN; 75074000
END OF MEMDUMP; 75075000
PROCEDURE ERROR(ERRNUM); VALUE ERRNUM; REAL ERRNUM; 76000000
BEGIN 76001000
FORMAT ERR("ERROR # ",I3,X2,107("X")); 76002000
TRACE; 76003000
WRITE(LP,ERR,ERRNUM); 76004000
END ERROR; 76005000
PROCEDURE HEADINGLINE (LP); FILE LP; 77000000
BEGIN 77001000
ARRAY DAYS[0:6], MONTHS[0:23]; 77002000
INTEGER I,Q,P,DAY,MONTH,DATE,YEAR,HOURS,MINUTES; 77003000
FORMAT CONF (X14, 77004000
" CLOCK RATE NUMBER OF OPERATIONS/MPX ", 77005000
" MEMORY SPEED MEMORY SIZE",/, X14, 77006000
" (MEGACYCLES) MULTIPLEXORS A B ", 77007000
"(MICROSECONDS) (16K MODULES)", 77008000
/, X14, I9, X3, I10, I11, I7, X11, 77009000
F3.1, X9 , I3,/), 77010000
CABH (X14, 77011000
" LOGICAL UNIT HARDWARE TYPE MULTIPLEXOR", 77012000
" BUFFER LENGTH WRITE LOCK-OUT INTERNAL NAME", /), 77013000
CABF (X14, I9, I11," = ", A4, X7, A6, X3, 77014000
I10, X10, A5, X12, A6), 77015000
FILF (/, X14, "SOURCE FILE IS: ", A1, A6, "/", A1, A6, "."), 77015100
CABT (//////); 77016000
LIST CONL 77017000
(PROCCLOCK, MPXQUAN, MPXAOPS, IF MPXQUAN=1 THEN 0 ELSE MPXBOPS,77018000
MEMTIME/10,(MEMMODS+1)DIV 2*15 ); 77019000
LIST FILEL (MULFILID.[6:6], MULFILID.[12:36], FILID.[6:6], 77019100
FILID.[12:36]); 77019200
ARRAY HT [0:133], NAMES [0:3, 0:13]; 77020000
ALPHA ALF; 77021000
REAL MPXI; 77022000
LABEL OWT; 77023000
FORMAT HEADFMT(X25,"BURROUGHS B-6500 SIMULATOR " 77024000
X05,A6,"DAY, ",A3,A6,I3,", ",I4, 77025000
", ",I2,":",I2,X1,"M."//); 77026000
PRINTERNOTYETOPENED~FALSE; 77027000
FILL DAYS[*] WITH 77028000
" SUN"," MON"," TUES","WEDNES"," THURS"," FRI", 77029000
" SATUR"; 77030000
FILL MONTHS[*] WITH 77031000
" J","ANUARY"," FE","BRUARY"," "," MARCH", 77032000
" "," APRIL"," "," MAY"," "," JUNE", 77033000
" "," JULY"," ","AUGUST"," SEP","TEMBER", 77034000
" O","CTOBER"," NO","VEMBER"," DE","CEMBER"; 77035000
I~STARTDATE; 77036000
DATE~I.[30:6]|100+I.[36:6]|10+I.[42:6]; 77037000
YEAR~1900+I.[18:6]|10+I.[24:6]; 77038000
FOR I~31,IF YEAR MOD 4 = 0 THEN 29 ELSE 28,31,30,31,30, 77039000
31,31,30,31,30 DO 77040000
IF DATE{I THEN GO OWT 77041000
ELSE BEGIN DATE~DATE-I; MONTH~MONTH+1; END; 77042000
OWT: I~ETIME; 77043000
HOURS~I DIV (60|60|60); 77044000
MINUTES~(I DIV (60|60)) MOD 60; 77045000
IF MONTH<2 THEN BEGIN Q~MONTH+11; P~YEAR-1900-1; END 77046000
ELSE BEGIN Q~MONTH- 1; P~YEAR-1900 ; END; 77047000
DAY~((Q|26-2) DIV 10+DATE+P+P.[36:10]+1) MOD 7; 77048000
WRITE(LP,HEADFMT,DAYS[DAY], 77049000
MONTHS[MONTH|2],MONTHS[MONTH|2+1],DATE,YEAR, 77050000
I~HOURS MOD 12, MINUTES, 77051000
IF HOURS>12 THEN "P" ELSE "A"); 77052000
FILL HT [*] WITH "NONE", "DISK", "SPO ", "AIDS", "NONE","NONE",77053000
"LP ","LP ", "NONE", "CR ", "CP ", 0,0,"TAPE"; 77054000
WRITE (LP, CONF, CONL); 77055000
WRITE (LP, CABH); 77056000
FILL NAMES [0, *] WITH 77057000
"NONE ","DISKA ","SPO ","AIDS ","NONE ","NONE " , 77058000
"LP ","LP ","NONE ","CARD ","PUNCH ",0,0,"TAPEA ";77059000
FILL NAMES [1, *] WITH 77060000
0,"DISKB ",0,0,0,0,"SIMLP ","SIMLP ",0,0,0,0,0,"TAPEB "; 77061000
FILL NAMES [2, *] WITH 0,"DISKC ",0,0,0,0,0,0,0,0,0, 77062000
0,0,"TAPEC "; 77063000
FILL NAMES [3, *] WITH 0,"DISKD ",0,0,0,0,0,0,0,0,0, 77064000
0,0,"TAPED "; 77065000
FOR I ~ 1, 2 77066000
DO BEGIN 77067000
ALF ~ IF I = 1 THEN "1 = A" ELSE "2 = B"; 77068000
FOR Q ~ 0 STEP 1 UNTIL 31 77069000
DO IF MPXI ~ MPX [I, Q] ! 0 77070000
THEN BEGIN 77071000
P ~ MPXI.MPXHDWE; 77072000
WRITE (LP, CABF, Q, P, HT [P], ALF, 77073000
MPXI.MPXBUFF, 77074000
IF P ! 13 THEN " N/A " 77075000
ELSE IF MPXI.MPXWLO = 1 77076000
THEN "TRUE " ELSE "FALSE", 77077000
NAMES [MPXI.MPXSWFI, P]); 77078000
END; 77079000
END; 77080000
WRITE (LP, FILF, FILEL); 77080100
WRITE (LP, CABT); 77081000
END HEADINGLINE; 77082000
FILL MNEMONIC[0,*] WITH 78000000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78001000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78002000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78003000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78004000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78005000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78006000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78007000
"VALC","VALC","VALC","VALC","VALC","VALC","VALC","VALC", 78008000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78009000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78010000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78011000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78012000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78013000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78014000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78015000
"NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC","NAMC", 78016000
"ADD ","SUBT","MULT","DIVD","IDIV","RDIV","NTIA","NTGR", 78017000
"LESS","GREQ","GRTR","LSEQ","EQUL","NEQL","CHSN","MULX", 78018000
"LAND","LOR ","LNOT","LEQV","SAME","VARI","BSET","DBST", 78019000
"FLTR","DFTR","ISOL","DISO","INSR","DINS","BRST","DBRS", 78020000
"BRFL","BRTR","BRUN","EXIT","STBR","NXLN","INDX","RETN", 78021000
"DBFL","DBTR","DBUN","ENTR","EVAL","NXLV","MKST","STFF", 78022000
"ZERO","ONE ","LT8 ","LT16","PUSH","DLET","EXCH","DUPL", 78023000
"STOD","STON","OVRD","OVRN","XXXX","LOAD","LT48","MPCW", 78024000
"SCLF","DSLF","SCRT","DSRT","SCRS","DSRS","SCRF","DSRF", 78025000
"SCRR","DSRR","ICVD","ICVU","SNGT","SNGL","XTND","IMKS", 78026000
"TEED","PACD","EXSD","TWSD","TWOD","SISO","SXSN","ROFF", 78027000
"TEEU","PACU","EXSU","TWSU","TWOU","EXPU","RTFF","HALT", 78028000
"TLSD","TGED","TGTD","TLED","TEQD","TNED","TUND","XXXX", 78029000
"TLSU","TGEU","TGTU","TLEU","TEQU","TNEU","TUNU","XXXX", 78030000
"CLSD","CGED","CGTD","CLED","CEQD","CNED","XXXX","XXXX", 78031000
"CLSU","CGEU","CGTU","CLEU","CEQU","CNEU","NOOP","NVLD"; 78032000
FILL MNEMONIC[1,*] WITH 78033000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78034000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78035000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78036000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78037000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78038000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78039000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78040000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78041000
"XXXX","XXXX","JOIN","SPLT","IDLE","SINT","EEXI","DEXI", 78042000
"XXXX","XXXX","SCNI","SCNO","XXXX","XXXX","WHOI","HEYU", 78043000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78044000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78045000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78046000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78047000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78048000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78049000
"XXXX","XXXX","XXXX","XXXX","XXXX","OCRX","XXXX","XXXX", 78050000
"XXXX","XXXX","XXXX","LOG2","XXXX","XXXX","XXXX","XXXX", 78051000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78052000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78053000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78054000
"XXXX","XXXX","XXXX","XXXX","XXXX","IRWL","PCWL","MVST", 78055000
"XXXX","XXXX","XXXX","XXXX","STAG","RTAG","RSUP","RSON", 78056000
"RPRR","SPRR","RDLK","CBON","LODT","LLLU","SRCH","XXXX", 78057000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78058000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78059000
"USND","UABD","TWFD","TWTD","SWFD","SWTD","XXXX","TRNS", 78060000
"USNU","UABU","TWFU","TWTU","SWFU","SWTU","XXXX","HALT", 78061000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78062000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78063000
"SLSD","SGED","SGTD","SLED","SEQD","SNED","XXXX","XXXX", 78064000
"SLSU","SGEU","SGTU","SLEU","SEQU","SNEU","NOOP","NVLD"; 78065000
FILL MNEMONIC[2,*] WITH 78066000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78067000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78068000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78069000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78070000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78071000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78072000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78073000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78074000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78075000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78076000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78077000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78078000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78079000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78080000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78081000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78082000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78083000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78084000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78085000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78086000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78087000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78088000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78089000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78090000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78091000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78092000
"MINS","MFLT","SFSC","SRSC","RSTF","ENDF","MVNU","MCHR", 78093000
"INOP","INSG","SFDC","SRDC","INSU","INSC","ENDE","HALT", 78094000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78095000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78096000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","XXXX", 78097000
"XXXX","XXXX","XXXX","XXXX","XXXX","XXXX","NOOP","NVLD"; 78098000
FILL DELTAMASK[*] WITH 78099000
8191,8191, % 0 AND 178100000
4095,4095, % 2 AND 378101000
2047,2047,2047,2047, % 4 THRU 778102000
1023,1023,1023,1023,1023,1023,1023,1023, % 8 THRU 1578103000
511, 511, 511, 511, 511, 511, 511, 511, % 16 THRU 3178104000
511, 511, 511, 511, 511, 511, 511, 511; 78105000
FILL REFLECTION[*] WITH 78106000
0, 16, 8, 24, 4, 20, 12, 28, 78107000
2, 18, 10, 26, 6, 22, 14, 30, 78108000
1, 17, 9, 25, 5, 21, 13, 29, 78109000
3, 19, 11, 27, 7, 23, 15, 31; 78110000
F:=D[2];%%%%%%%%%%%%%%%%%%%%% 78111000
PDR ~ 8; 78112000
SIMULATOR; 78113000
EOJ:END; 78114000
END. 78115000
Reference in New Issue View Git Blame Copy Permalink