Trailing-Edge
-
PDP-10 Archives
-
ALGOL-20_1-29-82
-
algol-sources/algser.mac
There are 8 other files named algser.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;SUBTTL TEMPCODE SERVICE
; WRITTEN BY A. N. HABERMANN, C.M.U.
; EDITED BY R. M. DE MORGAN.
HISEG
SEARCH ALGPRM,ALGMAC ; SEARCH PARAMETER FILES
MODULE MSER;
$PLEVEL=1;
BEGIN
EXTERN PRASE;
EXTERN PRLIB;
EXTERN SYMHT;
EXTERN KIOPS,OPMOVE;
EXPROC ERRLEX;
EXPROC CON1;
EXPROC CON2;
EXPROC COMBLEX;
EXPROC CONVERT;
EXPROC FAIL;
EXPROC MABS;
EXPROC MREL;
EXPROC MREL0; [E144]
EXPROC RAFIX;
EXPROC ADRFIX;
EXPROC ABSFIX;
EXPROC ADDFIX;
EXPROC TOFIX;
EXPROC EXTFIX;
EXPROC TYPE0,BHDR
SUBTTL TEMPCODE SERVICE * EVAL *
;EVAL TRANSFORMS A PROCEDURE IDENTIFIER USED IN A FUNCTION DESIGNATOR
;OR A FORMAL IDENTIFIER FROM AN OBJECT IN THE SYMBOL TABLE INTO A
;AN EXPRESSION IN AN ACCUMULATOR AND GENERATES THE APPROPRIATE
;INSTRUCTIONS .THE ONLY EXCEPTION IS THE FORMAL ARRAY IDENTIFIER
;SINCE ITS FORMAL LOCATIONS CONTAIN A COPY OF THE ARRAY DESCRIPTOR
;OF THE ACTUAL ARRAY IDENTIFIER,WHICH CAN NOT BE CHANGED ANYWAY.
;"SWITCH" IS CODED AS "LABEL PROCEDURE";A SWITCH IDENTIFIER CANNOT
;EVALUATE IN ITS OWN RIGHT INTO AN EXPRESSION.
;THE RESULT OF A FORMAL LABEL IS IN A2,OF EXPRESSIONS IN A0.
PROCEDURE EVAL;
BEGIN
IF KIND =PROCEDURE
T.PRO
THEN
BEGIN
IF STATUS = FORMAL BY NAME
T.FON
THEN
;T_'XCT 0,0'
HRLZI T,(XCT 0,0)
ELSE
;T_'PUSHJ SP,0'
HRLZI T,(PUSHJ SP,0)
FI;
;TC[IN+]_T,SYM<TAD>;..TAD IN SYM;
PLUNKI(SYM);
;..BOOK ALL ACCS USED;
HRROI T,0
HLLM T,HANDLE
IF TYPE NEQ LABEL
TN.L
THEN
BEGIN
;TC[IN+]_'TCTYDES 0,0';
HRLZI T,(TCTYDES 0,0)
PLUNKI
;TC[IN+]_TYPE,1;
HLLZ T,SYM
TLZ T,$AM
ADDI T,1
PLUNKI
CLOSE;
IF DEL NEQ PAROPEN
CAMN DEL,ZLPAR
GOTO FALSE
THEN
IF # OF FORMALS NEQ 0 NOR ARBITRARY
MOVE T3,STW1
TLNN T3,$AM-1
GOTO FALSE
THEN
FAIL(61,FRIED,SYM,WRONG NUMBER OF PARAMETERS)
FI;
FI
;SYM<LHS>_'EXP,SAME,SIMPLE,ACC';
TLZ SYM,$KIND!$STATUS!$AM
TLO SYM,$EXP!$STMT!$ACC
;SYM<RHS>_A0
HRRI SYM,0
ENDD
ELSE
FAIL(82,FRIED,SYM,SWITCH IDENTIFIER NOT PERMITTED HERE)
FI
ENDD
ELSE
IF STATUS = FORMAL
T.FORM
THEN
IF TYPE = LABEL OR SWITCH
T.L
THEN
BEGIN
;TC[IN+]_'XCT 0,SYM';
HRLZI T,(XCT 0,0)
PLUNKI(SYM);
CLOSE;
;SYM<RHS>_A2;
HRRI SYM,2
;SYM<LHS>_SIMPLE,PTR
TLZ SYM,$AM!$STATUS
TLO SYM,$PTR
ENDD
ELSE
IF KIND=VAR AND STATUS = FORMAL BY NAME
TLNE SYM,$STATUS-$FOV
T.VAR
THEN
IF DEL = ASSIGN
CAME DEL,ZASS
GOTO FALSE
THEN
BEGIN
;TC[IN+]_'XCT 1,SYM';
MOVSI T,(XCT 1,0)
PLUNKI(SYM);
;..BOOK ALL REGS USED
HRROI T,0
HLLM T,HANDLE
CLOSE
ENDD
ELSE
BEGIN
;TC[IN+]_'XCT 0,SYM';
HRLZI T,(XCT 0,0)
PLUNKI(SYM);
;..BOOK ALL ACCS USED;
HRROI T,0
HLLM T,HANDLE
;SYM<LHS>_'EXPR,SAME,SIMPLE,ACC';
TLZ SYM,$KIND!$STATUS!$AM
TLO SYM,$EXP!$SIM!$ACC
;SYM<RHS>_'A0';
HRRI SYM,0
CLOSE
ENDD
FI
FI
FI
FI
FI
ENDD
SUBTTL TEMPCODE SERVICE * REOPEN *
;A PORTION ENDS WITH A PORTION POINTER WHICH CAN BE RECOGNIZED BY 77
;IN THE MOST SIGNIFICANT BITS.THE ADDRESS PART OF A POTION POINTER
;POINTS TO THE FIRST INSTRUCTION OF THE PORTION AND SO A PORTION IS
;IMPLEMENTED AS A CIRCULAR LIST.
;BITS 29 THROUGH 18 REPRESENT THE USED REGISTERS OF THIS PORTION.
;REOPEN PLACES THE PORTION POINTER BACK IN HANDLE AND RESETS
;INDEX TO POINT TO THE FIRST FREE LOCATION IN TEMPCODE WHERE
;THE PORTION CAN BE EXTENDED.
PROCEDURE REOPEN;
BEGIN
;T_ABS(T);
ANDI T,3
;T3_HANDLE(U);
HRRZ T3,LEXEX(T)
IF PORTION IN TEMPCODE AND PORTION POINTER
JUMPE T3,FALSE
SETCM T1,(T3)
TLNE T1,770000
GOTO FALSE
THEN
BEGIN
;HANDLE_PORTION POINTER;
SETCAM T1,HANDLE
;INDEX_INDEX-1
SOS T1,INDEX
IF HANDLE NOT EQL INDEX
CAIN T3,(T1)
GOTO FALSE
THEN
BEGIN
;INDEX_INDEX+1;
AOS T1,INDEX
;PORTION PTR<RHS>_INDEX;
HRRM T1,(T3)
ENDD
FI
ENDD
FI
ENDD
SUBTTL TEMPCODE SERVICE * CLOSE *
;WHILE A PORTION IS OPEN, THE CURRENT PORTION POINTER IS BEING BUILD
;UP IN HANDLE, AND INDEX POINTS TO THE FIRST FREE LOCATION IN TEMPCODE.
;TO CLOSE A PORTION , THE CONTENTS OF HANDLE ARE ADDED TO THE CURRENTLY
;OPEN PORTION, AND HANDLE AND INDEX ARE SET TO REPRESENT A NEW OPEN, BUT
;ENTIRELY EMPTY, PORTION.
PROCEDURE CLOSE;
;ASSUMES OFFSET IN T
BEGIN
;T_ABS(T);
ANDI T,3
;T3_INDEX;
MOVE T3,INDEX
;HANDLE(U)_INDEX;
HRRM T3,LEXEX(T)
;T2_HANDLE;
MOVE T2,HANDLE
;TC[IN+]_T2;
MOVEM T2,(T3)
AOS T3,INDEX
IF INDEX=TCMAX
CAME T3,TCMAX
GOTO FALSE
THEN
FAIL(83,FATAL,DEL,TEMPCODEOVERFLOW)
FI;
;HANDLE<LHS>_0;
;HANDLE<RHS>_INDEX;..TO OPEN NEW PORTION;
HRLI T3,770000;$
MOVEM T3,HANDLE;$
ENDD
SUBTTL TEMPCODE SERVICE * EMITCODE *
;EMITCODE ADDS AN INSTRUCTION TO THE CURRENTLY OPEN PORTION. IT BOOKS
;IN HANDLE THE USED REGISTERS ACCORDING TO THE LENGTH OF THE OPERAND
;(ONE WORD FOR INTEGER,BOOLEAN AND REAL,TWO WORDS FOR STRING AND
;THREE WORDS FOR LONG REAL).
;EMITCODE TAKES CARE OF THE OPCODE MODIFICATION FOR IMMEDIATE CON-
;STANTS.
;A LONG REAL IS TREATED AS A THREE WORD OPERAND IN ORDER TO AVOID
;PROBLEMS WITH ARITHMETIC WHICH USES THREE ACCUMULATORS.HENCE, THERE
;ARE FOUR "FLOATING" ACCUMULATORS:
; F0: A0,A1,A2
; F1: A3,A4,A5
; F3: A6,A7,A10
; F4: A11,A12,A13
;THE OTHER REGISTERS ARE USED FOR SPECIAL PURPOSES (STACKPOINTER ETC).
;..T CONTAINS THE OPCODE LEFT ADJUSTED
;..T1 CONTAINS THE PAIR #,ACC ,BOTH RIGHT ADJUSTED
;..T2 CONTAINS TAD (TEMPADDRESS)
PROCEDURE EMITCODE;
BEGIN
IF #=2 OR #=3
TLNE T1,2
TLOE T1,5
;T1_6 OR 7
GOTO FALSE
THEN
;T1_3
HRLI T1,3
FI;
;T3<LHS>_T1<LHS>;
HLLZ T3,T1
;T3^(T1);..SHIFT OVER 'ACC' BIT POSITIONS;
ANDI T1,SP
LSH T3,(T1)
;..BOOK USED REGS;
IORM T3,HANDLE
IF ADRMODE = IMMEDIATE
TLNN T2,36
TLNN T2,$IMM
GOTO FALSE
THEN
IF OPCODE BEGINS WITH 1 OR 2 OR 4 OR 5
TLNN T,500000
GOTO TRUE
TLNE T,200000
GOTO FALSE
THEN
;T_T+1;..IMMEDIATE MODIFICATION;
TLO T,1000
ELSE
;IF OPCODE = CAM THEN OPCODE_CAI;
TLNN T,460000
TLZ T,10000
FI
FI;
XPLU: ;T1^23;..SHIFT ACC IN ACCFIELD;
ANDI T1,SP
ROT T1,-15
;T_T OR T1;..COMBINE OPCODE AND ACC;
IOR T,T1
XIPL: ;T2_T2<TAD>;
TLZ T2,777777-$AM
;T_T OR T2;..PLACE TEMPADDRESS;
IOR T,T2
;T1_INDEX;
;T[T1]_T;..PLACE INSTR. IN TEMPCODE;
MOVE T1,INDEX
MOVEM T,(T1)
;T1_INDEX_INDEX+1;
AOS T1,INDEX
IF T1=TCMAX
CAME T1,TCMAX
GOTO FALSE
THEN
FAIL(83,FATAL,DEL, TEMPCODE OVERFLOW)
FI
ENDD
SUBTTL TEMPCODE SERVICE * PLUNK * * IPLUNK *
;PLUNK IS A SIMPLIFIED VERSION OF EMITCODE. IT IS USED WHEN IT IS
;NOT NECESSARY TO BOOK THE USED ACCUMULATORS NOR TO MODIFY THE OPCODE
;FOR AN IMMEDIATE INSTRUCTION.
PROCEDURE PLUNK;
BEGIN
GOTO XPLU
ENDD
;IPLUNK IS USED WHEN THE INSTRUCTION IS READY IN T TO BE
;PLACED IN TEMPCODE.IF T2#0 , THE TEMPORARY ADDRESS OF THE SOURCE IS
;TAKEN FROM THERE.
PROCEDURE IPLUNK;
BEGIN
GOTO XIPL
ENDD
SUBTTL TEMPCODE SERVICE * LOAD *
;LOAD TRANSFORMS ITS INPUT OBJECT INTO A CLOSED PORTION IN TEMPCODE
;REPRESENTING AN EXPRESSION IN AN ACCUMULATOR.IT USUALLY WILL GENERATE
;A MOVE (OR DMOVE) INSTRUCTION TO ACHIEVE THIS, BUT WHEN THE INPUT IS
;ALREADY AN EXPRESSION IN AN ACCUMULATOR IT WILL AVOID UNNECESSARY MOVE
;INSTRUCTIONS.AS A SIDE EFFECT LOAD KEEPS TRACK OF THE USE OF ACCUMU-
;LATORS.LAC POINTS TO THE LAST ALLOCATED ACCUMULATOR. ACCS ARE ALLOCATED
;TO START WITH A13 DOWN TO A1.
PROCEDURE LOAD; ;..T1 CONTAINS (KEY,ACC) PLACED BY MACRO;
BEGIN
IF KEY = BLANK
TLZN T1,1
GOTO FALSE
THEN
;REV_-ADR(SYM)
MOVNI REV,SYM
FI;
;KA_T1;..SAVE (KEY,ACC)
MOVEM T1,KA
;T_2*(KEY+REV);
HLRZ T,T1
ANDI T,SYM
ADD T,REV
;REOPEN;
PUSHJ SP,.REOPEN
;T<LHS>_KA<LHS>;..OPCODE AND ADR(LEXEME) IN T;
HLLZ T,KA
;T1<RHS>_KA<RHS>;..ACC IN T1;
HRRZ T1,KA
XLOAD: ;T2_LEXEME;
HLRZ T2,T
ANDI T2,SYM
MOVE T2,(T2)
IF T2=ERROR LEXEME
JUMPG T2,FALSE
THEN
ERRLEX
ELSE
BEGIN
IF TWO WORD OPERAND OR T2<TYPE>=INTDIV
TLNN T2,$TYPE-$IDI
GOTO TRUE
T.TWO(T2)
THEN
;T3_2
MOVEI T3,2 ;T3 CONTAINS #
ELSE
IF ONE WORD OPERAND
T.ONE(T2)
THEN
;T3_1
MOVEI T3,1
FI
FI;
IF LONG REAL OPERAND
T.LR(T2)
THEN
;T3_3
MOVEI T3,3
FI;..T3 CONTAINS #;
IF T2<AM>=PTR OR ACC AND ACC=13 0R T2<RHS>
CAIE T1,(T2)
CAIN T1,15
T.ACC(T2)
THEN
IF T3=1 OR T2<AM>=ACC AND T3#2
TLNN T2,$AM-$ACC
CAIE T3,2
CAIE T3,1
GOTO FALSE
THEN
;T1<RHS>_T2<RHS>
HRRZ T1,T2
ELSE
BEGIN
IF T2<RHS>=LAC
MOVE T4,LAC
CAIE T4,(T2)
GOTO FALSE
THEN
;IF #=3 THEN LAC+3 ELSE LAC+1;
CAIE T3,3
AOSA LAC
ADDM T3,LAC
FI;
IF ACC GEQ 2
TRNN T1,16
GOTO FALSE
THEN
;T1<RHS>_13
HRRZI T1,15
ELSE
;T1<RHS>_0
HRRZI T1,0
FI
ENDD
FI
FI;
IF ACC=13
CAIE T1,15 ;T1 CONTAINS ACC
GOTO FALSE
THEN
BEGIN
;T1_(IF #GEQ LAC THEN 12 ELSE LAC)-#;
MOVE T1,LAC
CAML T3,LAC ;LAST ALLOC.ACC
MOVEI T1,14
SUB T1,T3
IF #=3
CAIE T3,3
GOTO FALSE
THEN
BEGIN
;T4<RHS>_T1<RHS>
HRRZ T4,T1
WHILE T4GEQ 3
CAIGE T4,3
GOTO FALSE
DO
;T4_T4-3
SUBI T4,3
OD;
;T1_T1-T4
SUB T1,T4
ENDD
FI;
;LAC_T1
MOVEM T1,LAC
ENDD
FI;
;T1<LHS>_#;
HRL T1,T3
;T4<RHS>_ADR(LEXEME);
HLRZ T4,T
ANDI T4,SYM
;T<ADR(LEXME)>_0;
TLZ T,SYM
;LEXEME<RHS>_RESULTACC;
HRRZM T1,(T4)
;T4<TYPE>_T2<TYPE>;
HLL T4,T2
;T4<LHS>_EPR,SAME,SIMPLE,ACC;
TLZ T4,$KIND!$STATUS!$AM
TLO T4,$EXP!$SIM!$ACC
;LEXEME<LHS>_T4<LHS>;
HLLM T4,(T4)
IF T2<TYPE>=REAL AND T2<AM>=IMM
TLNN T2,$TYPE+$AM-$R-$IMM
TLNN T2,10000
GOTO FALSE
THEN
BEGIN
IF OPCODE = MOVM AND CONSTANT IS NEGATIVE
HLRZ T4,T
ANDI T4,777000
CAIN T4,(MOVM 0,0)
TRNN T2,400000
GOTO FALSE
THEN
; TAKE MAGNITUDE & CONVERT CONSTANT
MOVNI T4,(T2)
HRRI T2,(T4)
FI
;OPCODE_HRLZI'
TLZ T,$KIND!$TYPE
TLO T,(HRLZI 0,0)
ENDD
ELSE
IF # GTR 1 AND T2<TYPE> NEQ INTDIV
TLNE T2,$TYPE-$IDI
CAIG T3,1
GOTO FALSE
THEN
;DOUBLE THE OPCODE
TLO T,700000
ELSE
IF T2=ONEWORD CONST IN CT WITH LEFTHANDSIDE=-1 AND OPCODE=MOVE
TLNN T2,$VAR!$CONST
TLNN T2,$CT-$IMM
GOTO FALSE
HLRZ T4,T
ANDI T4,777000
CAIE T4,(MOVE 0,0)
GOTO FALSE
HRRZ T4,T2
ADD T4,CONTAB
SETCM T4,1(T4)
TLNE T4,777777
GOTO FALSE
THEN
BEGIN
;T2<AM>_IMM;
TLZ T2,$CT-$IMM
;T2<RHS>_CONSTANT<RHS>;
SETCA T4,T4
HRR T2,T4
;OPCODE_'HRROI';
TLZ T,777000
TLO T,(HRROI 0,0)
ENDD
FI
FI
FI;
IF T2<AM> NEQ ACC OR T2<RHS> NEQ T1<RHS>
HRRZ T3,T2
XORI T3,(T1)
TLNN T2,$AM-$ACC
JUMPE T3,FALSE
THEN
;EMITCODE
PUSHJ SP,.EMITCODE
FI;
IF NOT GLOAD
HRRO T,KA
AOJE T,FALSE
THEN
BEGIN
;T_2*(KEY+REV);
HLRZ T,KA
ANDI T,SYM
ADD T,REV
;CLOSE
PUSHJ SP,.CLOSE
ENDD
FI
ENDD
FI;
ZERO(KA)
ENDD
;GLOAD IS A KLUDGE TO PLEASE FILE ALGCOD
PROCEDURE GLOAD;
BEGIN
;KA_T<LHS>,777777;..TO INDICATE GLOAD;
HLLOM T,KA
GOTO XLOAD
ENDD
SUBTTL TEMPCODE SERVICE * TOCT1/2 *
;TOCT1 AND 2 TRANSFORM AN IMMEDIATE CONSTANT INTO A CONSTANT TABLE
;CONSTANT.
;..TOCT1 ASSUMES ONE WORD CONSTANT IN T3
;..TOCT2 ASSUMES TWO WORD CONSTANT IN (T3;T4)
;..RESULT 23-BIT TAD IN T2;REGISTERS T;T1;T5 ARE NOT AFFECTED
PROCEDURE TOCT1;
BEGIN
;SAVE(T,T5);
PUSH SP,T
PUSH SP,T5
CON1;(T3);
;T2<AM>_$CT;
HRRZI T2,(T2)
TLO T2,$CT
;RESTORE(T,T5);..CONS1 DOES NOT AFFECT T1;
POP SP,T5
POP SP,T
ENDD
PROCEDURE TOCT2;
BEGIN
;SAVE(T,T5);
PUSH SP,T
PUSH SP,T5
CON2;(T3,T4);
;T2<AM>_$CT;
HRRZI T2,(T2)
TLO T2,$CT
;RESTORE(T5,T);..T1 IS UNAFFECTED BY CONS2;
POP SP,T5
POP SP,T
ENDD
SUBTTL TEMPCODE SERVICE * UNSTACK *
;THE PURPOSE OF UNSTACK IS TO AVOID A SEQUENCE OF POP INSTRUCTIONS
;CORRESPONDING TO PUSH INSTRUCTIONS GENERATED TO SAVE INTERMEDIATE
;RESULTS.INSTEAD, THE STACK OPERANDS ARE USED AS STORAGE OPERANDS
;INDEXED BY THE STACK POINTER AND WHEN NECESSARY THE STACK POINTER IS
;UPDATED WITH A SUB INSTRUCTION WHICH IS GENERATED BY UNSTACK.
PROCEDURE UNSTACK;
BEGIN
;T3<SA>_LEXEX<SA>;
HLRZ T3,LEXEX
TRZ T3,777000
IF SOMETHING SAVED IN STACK
JUMPL SYM,FALSE
JUMPE T3,FALSE
THEN
BEGIN
REOPEN;
;T3<SA>_LEXEX<SA>;
HLRZ T3,LEXEX
TRZ T3,777000
;LEXEX<SA>_0;
HRLOI T2,777000
ANDM T2,LEXEX
;T3<LHS_T3<RHS>
HRL T3,T3
TOCT(1);
;TC[IN+]_'SUB SP,T2';
HRLZI T,(SUB SP,0)
PUSHJ SP,.IPLUNK
CLOSE
ENDD
FI
ENDD
SUBTTL TEMPCODE SERVICE * FETCH *
;FETCH IS A VARIATION ON LOAD. IT IS USED TO LOAD AN OPERAND OF A
;BINARY OPERATION OF WHICH THE OTHER OPERAND IS PRESENT IN THE FORM OF
; A SUB EXPRESSION IN TEMPCODE.OTHER THAN LOAD, FETCH WILL FOR INSTANCE
;PUSH THE OPERAND IF IT FINDS THAT THE OTHER OPERAND USES ALL REGS.
;IT ALSO TRIES TO OPTIMIZE THE USE OF ACCUMULATORS BY LOOKING AT
;ACCUMULATOR CONFLICTS IN THE OPERANDS.
PROCEDURE FETCH;
BEGIN
REOPEN(LOP);
IF ONE WORD OPERAND AND LOP<TYPE> NEQ INTDIV
TLNE LOP,$TYPE-$IDI
T.ONE(LOP)
THEN
;T3_1
MOVEI T3,1
ELSE
IF LONG REAL
T.LR(LOP)
THEN
;T3_3
MOVEI T3,3
ELSE
;T3_2
MOVEI T3,2
FI
FI;..T3 CONTAINS NOW #;
;T1_(IF # GEQ LAC THEN 12 ELSE LAC)-#;..T1<RHS> CONTAINS NOW ACC;
MOVE T1,LAC
CAML T3,LAC
MOVEI T1,14
SUB T1,T3
IF #=3
CAIE T3,3
GOTO FALSE
THEN
BEGIN
;T4<RHS>_T1<RHS>;
HRRZ T4,T1
WHILE T4 GEQ 3
CAIGE T4,3
GOTO FALSE
DO
;T4_T4-3
SUBI T4,3
OD;
;T1_T1-T4
SUB T1,T4
ENDD
FI
;T1<LHS>_#;
HRL T1,T3
IF #=2 OR #=3
TRNE T3,2
;T3_6 OR 7
TROE T3,5
GOTO FALSE
THEN
;CHANGE 2 INTO 3
HRRI T3,3
FI;..T3 CONTAINS NOW PATTERN;
;T3_IF LOP<TYPE>=INTDIV THEN 1 ELSE T3;
TLNN LOP,$TYPE-$IDI
MOVEI T3,1
;T3^(T1);..SHIFT PATTERN OVER 'ACC' BIT POSITIONS;
LSH T3,(T1)
;T4<RHS>_HANDLE(SYM);
HRRZ T4,LEXEX+SYM(REV)
;T4<RHS>_TC[HANDLE(SYM)]<LHS>;..USEDACCS(SYM);
HLRZ T4,(T4)
MOVE T2,LOP
;LOP<LHS>_LOP<TYPE>;
TLZ LOP,$KIND!$STATUS!$AM ;CLEAR
;..BOOK USED REGISTERS; ;
HRLZ T3,T3;$ ;
IORM T3,HANDLE;$
;LAC_T1<RHS>;..LAC _ ACC;
HRRM T1,LAC;$;
IF NO ACC CONFLICT
TLNE T3,(T4) ;
GOTO FALSE
THEN
BEGIN
;LOP<RHS>_T1<RHS>;..PUT RESULT ACC IN RESULT LEXEME;
HRR LOP,T1
;T_'MOVE ACC,0';
LSH T1,5
HRLZI T,<MOVE 0,0>_-22(T1)
IF # GTR 1 AND LOP<TYPE> NEQ INTDIV
TLNE LOP,$TYPE-$IDI
TLNN T1,100
GOTO FALSE
THEN
;DOUBLE THE OPCODE
TLO T,700000
FI;
;LOP<LHS>_EXP,SAME,SIMPLE,ACC
TLO LOP,$EXP!$SIM!$ACC
ENDD
ELSE
BEGIN
;LOP<LHS>_EXP,SAME,SIMPLE,SP;
TLO LOP,$EXP!$SIM!$SP
;T3_SA(SYM);
HLRZ T3,LEXEX+SYM(REV)
TRZ T3,777000
;T3_T3-(# LEQ 1 OR LOP<TYPE>=INTDIV);
TLNE LOP,$TYPE-$IDI
TLNN T1,2
SUBI T3,1
;LOP<RHS>_2^18-(T3+1);..OFFSET FROM STACKTOP IS RESULT ADDRESS;
MOVNI T3,(T3)
ADDI T3,777777
HRR LOP,T3
;T3<RHS>_SA(LOP);
MOVNI T,LOP(REV)
HLRZ T3,LEXEX(T)
EDIT(024); IF TYPE IS INTDIV, ONLY ALLOCATE ONE WORD !
;T3_T3+1+(# GEQ 2 AND LOP<TYPE> NEQ INTDIV); [E024]
TLNE LOP,$TYPE-$IDI ; [E024]
TLNN T1,2
AOJA T3,.+2
ADDI T3,2
;SA(LOP)_T3;
HRLM T3,LEXEX(T)
;T_'PUSH SP,0';
HRLZI T,(PUSH SP,0)
IF # GTR 1 AND LOP<TYPE> NEQ INTDIV
TLNE LOP,$TYPE-$IDI
TLNN T1,2
GOTO FALSE
THEN
;DOUBLE OPCODE
TLO T,700000
TLZ T,060000
FI;
ENDD
FI;
IF LAST INSTR OF LOP PORTION=MOVE OR DMOVE
MOVNI T1,LOP(REV)
HRRZ T1,LEXEX(T1)
HLRZ T4,-1(T1)
TRNE T4,577000
SUBI T4,500000
TRNE T4,577000
GOTO FALSE
THEN
;LAST INSTR<OPCODE,ACC>_T<LHS>
ANDI T4,$AM
TLO T,(T4)
HLLM T,-1(T1)
ELSE
;PLUNKI(LOP)
PUSHJ SP,.IPLUNK
FI;
CLOSE(LOP)
ENDD
SUBTTL TEMPCODE SERVICE * MERGEPORTIONS *
;MERGE PORTIONS GETS AS INPUT TWO PORTIONS IN TEMPCODE AND CONCATENATES
; THOSE INTO ONE AS IS DONE WITH TWO CIRCULAR LISTS.
;WHICH OF THE PORTIONS IS HEAD AND WHICH IS TAIL DEPENDS ON THE RESULT
;OF REVORDER WHICH RESULT IS REFLECTED IN THE VALUE OF REV.
;REV=SYM MEANS ORDER NOT REVERSED,REV=LOP MEANS ORDER REVERSED.
;IF THE RESULT REG OF THE HEAD IS USED IN THE TAIL, AN APPROPRIATE
;SAVE INSTRUCTION IS INSERTED.THE RESULT OF MERGEPORTIONS IS ONE OPEN
;PORTION WHICH CAN BE EXTENDED WITH THE BINARY OPERATION.
;THE MEMOS EXPLAIN THIS IN MORE DETAIL.
PROCEDURE MERGEPORTIONS; ;..DEPENDS ON THE VALUE OF REV;
BEGIN
IF ERROR LEXEME
SKIPL SYM
JUMPG LOP,FALSE
THEN
ERRLEX
ELSE
BEGIN
IF ONE WORD OPERAND OR POINTER
TLNN LOP,20000
GOTO TRUE
T.PTR(LOP)
THEN
;T3_1;..PATTERN OF USED ACCS(LOP);
HRLZI T3,1
ELSE
IF LONGREAL OPERAND
T.LR(LOP)
THEN
;T3_7;..3ACCS USED(LOP);
HRLZI T3,7
ELSE
;T3_3;..2 ACCS USED(LOP);
HRLZI T3,3
FI
FI;
IF ADMODE(LOP)=ACC OR PTR
T.ACC(LOP)
THEN
BEGIN
;T3^(LOP);..SHIFT OVER 'ACC' BIT POSITIONS;
LSH T3,(LOP)
TLZ T3,770000
;T1_HANDLE(SYM);
HRRZ T1,LEXEX+SYM(REV)
IF ACC CONFLICT
AND T3,(T1)
JUMPE T3,FALSE
THEN
BEGIN
IF ADMODE=PTR
T.PTR(LOP)
THEN
BEGIN
;..SAVE LOP<KIND,TYPE,STATUS>;
TLZ LOP,$AM
HLLZM LOP,KA
;LOP<LHS>_EXPR,INT,SIM,ACC;
HRLI LOP,$EXP!$I!$SIM!$DECL!$ACC
;FETCH;..PLACES RESULT LEXEME IN LOP;
PUSHJ SP,.FETCH
; LOP<AM>_IF ACC THEN PTR ELSE ISP;
TLO LOP,30
;..RESTORE LOP<KIND,TYPE,STATUS>;
TLZ LOP,777777-$AM
IOR LOP,KA
ZERO(KA)
ENDD
ELSE
;FETCH
PUSHJ SP,.FETCH
FI;
ENDD
FI
ENDD
FI;
MOVNI T,LOP(REV)
INTERCHANGE: ;T1_HANDLE(LOP);
HRRZ T1,LEXEX(T)
;T2_HANDLE(SYM);
HRRZ T2,LEXEX+SYM(REV)
;T3_PORTION POINTER(LOP);
MOVE T3,(T1)
;T3#PORTION POINTER(SYM);
EXCH T3,(T2)
;T3#PORTION POINTER(LOP);
EXCH T3,(T1)
;T3<LHS>_USEDACCS(LOP) OR USEDACCS(SYM);
IOR T3,(T1)
HRRI T3,0
;PORTION POINTER(SYM)<LHS>_T3;
HLLM T3,(T2)
REOPEN(SYM)
ENDD
FI
ENDD
SUBTTL TEMPCODE SERVICE * CGELSE *
;CGELSE COMBINES THE THEN AND ELSE EXPRESSIONS INTO ONE AND INSERTS
;THE NECESSRAY TYPE CONVERSIONS.IT ALSO TAKES CARE OF UNEQUAL STACK
;LENGTHS AND DIFFERENT RESULT ACCUMULATORS. FURTHERMORE IT MODIFIES
;ONE OF THE EXPRESSIONS IF NECESSARY SUCH THAT BOTH HAVE THE SAME
;ADDRESSMODE.FOR INSTANCE IF BE THEN A ELSE A+1 WILL RESULT
;IN AN EXPRESSION IN AN ACCUMULATOR BECAUSE OF A+1 AND SO CGELSE
;WILL INSERT A LOAD(A) INTO THE SAME REG AS IS USED BY A+1.
PROCEDURE CGELSE;
BEGIN
IF LOP=ERRLEX OR SYM=ERRLEX
CAIL LOP,0
JUMPG SYM,FALSE
THEN
ERRLEX
ELSE
BEGIN
;REV_-SYM;
MOVNI REV,SYM
;T3_LOP<TYPE>;
HLRZ T3,LOP
ANDI T3,$TYPE
;T4_SYM<TYPE>;
HLRZ T4,SYM
ANDI T4,$TYPE
IF LOP<TYPE> NEQ SYM<TYPE>
CAIN T3,(T4)
GOTO FALSE
THEN
BEGIN
IF LOP<TYPE> GTR SYM<TYPE>
CAIG T3,(T4)
GOTO FALSE
THEN
;REVERSE;
MOVNI REV,SYM+LOP(REV)
EXCH LOP,SYM
EXCH T3,T4
FI;
IF SYM<TYPE> OR LOP<TYPE> NOT ARITHMETIC
TRNE T3,$ARC
GOTO TRUE
TRNN T4,$ARC
GOTO FALSE
THEN
FAIL(65,HARD,DEL,TYPES DO NOT MATCH) ;
FI;
;LOAD(LOP,A0);
HRLZI T1,(<MOVE 0,(LOP)>)
PUSHJ SP,.LOAD
REOPEN(LOP);
;T_JSP AX,0($ST)';
HRLZI T,(<JSP AX,($ST)>)
KILLAX;
IF SYM<TYPE>=REAL
TLNE SYM,$TYPE-$R
GOTO FALSE
THEN
BEGIN
;T<RHS>_PRLIB+15;
HRRI T,PRLIB+17
;LOP<LHS>_'EXP,REAL,SIMPLE,ACC';
;LOP<RHS>_0;
HRLZI LOP,$EXP!$R!$SIM!$DECL!$ACC
ENDD
ELSE
IF SYM<TYPE>=LONGREAL
TLNE SYM,$TYPE-$LR
GOTO FALSE
THEN
IF LOP<TYPE>=INTEGER
TLNE LOP,$TYPE-$I
GOTO FALSE
THEN
BEGIN
;T<RHS>_PRLIB+18;
HRRI T,PRLIB+22
;LOP_'EXP,LR,SIM,ACC;
HRLZI LOP,$EXP!$LR!$SIM!$DECL!$ACC
ENDD
ELSE
BEGIN
;T<RHS>_PRLIB+24;
HRRI T,PRLIB+30
;LOP_'EXP,LONGREAL,SIMPLE,ACC
HRLZI LOP,$EXP!$LR!$SIM!$DECL!$ACC
ENDD
FI
FI
FI;
PLUNKI;
CLOSE(LOP)
ENDD
FI;
;T3_LOP<AM>;
HLRZ T3,LOP
ANDI T3,$AM
;T4_SYM<AM>;
HLRZ T4,SYM
ANDI T4,$AM
IF T3 NEQ ACC
CAIN T3,$ACC
GOTO FALSE
THEN
BEGIN
IF T4=ACC OR T3 LESS T4
CAIN T4,$ACC
GOTO TRUE
CAIL T3,(T4)
GOTO FALSE
THEN
;REVERSE
MOVNI REV,SYM+LOP(REV)
EXCH LOP,SYM
EXCH T3,T4
FI;
IF T4 NEQ PTR
CAIN T4,$PTR
GOTO FALSE
THEN
LOAD(LOP,15)
FI
ENDD
FI;
IF LOP<AM>=SYM<AM>
HLLZ T3,LOP
XOR T3,SYM
TLNE T3,$AM
GOTO FALSE
THEN
IF LOP<RHS> NEQ SYM<RHS>
HRRZ T3,LOP
CAIN T3,(SYM)
GOTO FALSE
THEN
BEGIN
IF LOP<RHS>=0
JUMPN T3,FALSE
THEN
;REVERSE
MOVNI REV,LOP+SYM(REV)
EXCH LOP,SYM
FI;
;SYM<AM>_ACC;
TLZ SYM,$AM
TLO SYM,$ACC
;T1_LOP<RHS>;
HRRZ T1,LOP
LOAD(SYM, );
;SYM_LOP;
MOVE SYM,LOP
ENDD
FI
ELSE
BEGIN
;T1_LOP<RHS>;
HRRZ T1,LOP
LOAD(SYM, );
;SYM_LOP;
MOVE SYM,LOP
ENDD
FI;
IF REV=-LOP
TRNE REV,2
GOTO FALSE
THEN
;REVERSE
MOVNI REV,LOP+SYM(REV)
EXCH LOP,SYM
FI;
REOPEN(LOP);
IF LEXEX<SA> NEQ LLEXEX<SA>
HLRZ T3,LEXEX+2
ANDI T3,777
HLRZ T4,LEXEX
ANDI T4,777
CAIN T4,(T3)
GOTO FALSE
THEN
;UNSTACK(LOP)
HRLOI T2,777000
ANDM T2,LEXEX+2
JUMPE T3,.+5
HRLI T3,(T3)
TOCT(1)
HRLZI T,(SUB SP,0)
PUSHJ SP,.IPLUNK
FI;
;TC[IN+]_'JRST 0,0';
HRLZI T,(JRST 0,0)
PLUNKI
;TC[IN+]_'TCELSE 0,0';
HRLZI T,(TCELSE 0,0)
PLUNKI
;TC[IN+]_'TCOT;
HRLZI T,(TCOT 0,0)
PLUNKI
CLOSE(LOP);
IF LEXEX<SA> NEQ LLEXEX<SA>
HLRZ T3,LEXEX+2
ANDI T3,777
HRLOI T4,777000
ANDM T4,LEXEX+2
HLRZ T4,LEXEX
ANDI T4,777
CAIN T4,(T3)
GOTO FALSE
THEN
UNSTACK
FI;
;LOP<AM>_SP;
TLZ LOP,$AM
TLO LOP,$SP
MERGEPORTIONS;
;LOP_SYM;
TLO SYM,$EXP!$DECL
MOVE LOP,SYM
;TC[IN+]_'TCFI 0,0';
HRLZI T,(TCFI 0,0)
PLUNKI
CLOSE(SYM);
COMBLEX
ENDD
FI
ENDD
SUBTTL TEMPCODE SERVICE * REVORDER *
;THE GENERAL RULE FOR OPTIMIZATION IS: EVALUATE THE MORE COMPLI-
;CATED EXPRESSION FIRST. BUT THAT IS NOT ALWAYS ALLOWED BECAUSE OF THE
;LEFT TO RIGHT EVALUATION RULE.REVORDER INVESTIGATES IF IT IS DESIRABLE
;TO REVERSE, AND IF SO IT CHECKS THAT IT IS ALLOWED.
;IT IS DESIRABLE TO REVERSE IF LOP REPRESENTS A VARIABLE OR CONSTANT
;AND SYM A V-EXPR(I.E. AN EXPR WITHOUT ANY PROCIDENTIFIERS OR FORMALS)
;OR IF LOP IS A VARIABLE OR V-EXPR AND SYM IS A P-EXPR (I.E. AN EXPR
;WHICH CONTAINS A PROC IDENTIFIER OR FORMAL.
;THE ROUTINE IS BASED ON SOME CAREFULLY ANALYZED DESIGN, WHICH IS
;DESCRIBED COMPLETELY IN THE MEMOS
PROCEDURE REVORDER;
BEGIN
;T3_0;..T3 INDICATES WHETHER OR NOT REVERSE WAS ALLOWED;
SETZ T3,
IF SYM=ERRORLEX. OR LOP=ERRORLEX.
CAIL LOP,0
JUMPG SYM,FALSE
THEN
ERRLEX
ELSE
IF LOP<KIND>=ARRAY AND SYM<AM> NEQ SINGLE
T.ARR(LOP)
TN.SINGLE(SYM)
THEN
;REVERSE ORDER
MOVNI REV,SYM+LOP(REV)
EXCH LOP,SYM
ELSE
IF LOP<LEX>GEQ 0 AND SYM<AM> NEQ SINGLE
MOVEI T,LOP(REV)
ANDI T,2
SKIPL T1,LEXEX(T)
T.COGE(SYM)
THEN
IF SYM<LEXEX> GEQ 0 OR LOP<AM>=CONST
TLNN LOP,$AM-$CT
GOTO TRUE
SKIPGE T2,LEXEX+SYM(REV)
GOTO FALSE
THEN
IF LOP<AM> = SINGLE
T.SINGLE(LOP)
THEN
;REVERSEORDER
MOVNI REV,SYM+LOP(REV)
EXCH LOP,SYM
ELSE
BEGIN
IF LOP<AM>=ACC AND LOP<TYPE>TWO WORD OPERAND
HLRZ T,LOP
ANDI T,$AM
CAIN T,$ACC
T.TWO(LOP)
THEN
;T_3
MOVEI T,3
ELSE
;T_1
MOVEI T,1
FI;
;T^LOP<ACC>;..SHIFT OVER 'ACC' BIT POSITIONS;
LSH T,(LOP)
IF LOP<ACC> AND SYM<USED ACCS> NEQ 0 OR OP=ASSIGN
MOVE T2,(T2) ;..GET SYM<PORTION PTR>
TLNE T2,(T)
GOTO TRUE
MOVE T,OP
CAME T,ZASS
GOTO FALSE
THEN
;REVERSEORDER;
MOVNI REV,SYM+LOP(REV)
EXCH LOP,SYM
FI
ENDD
FI
ELSE
IF LOP<BL>+SYM<BL> GEQ 0 AND (LOP<COMPNAME>AND SYM<COMPNAME>)=0
TLZ T1,777
ADD T1,T2
JUMPL T1,FALSE
MOVE T2,COMPNAME(T)
XORI T,2
AND T2,COMPNAME(T)
JUMPN T2,FALSE
THEN
;REVERSEORDER
MOVNI REV,SYM+LOP(REV)
EXCH LOP,SYM
ELSE
;T3_1;..INDICATE REVERSE WAS NOT ALLOWED;
MOVEI T3,1
FI
FI
ELSE
;T3_SYM<LEXEX> LESS ZERO;
SKIPGE LEXEX+SYM(REV)
MOVEI T3,1
FI
FI
FI
ENDD
SUBTTL TEMPCODE SERVICE * CGINT *
;CGINT HANDLES THE INTEGRATION OF SUBSCRIPT EXPRESSIONS
PROCEDURE CGINT; ;..LEXEME IS IN SYM;
BEGIN
;REV_SYM;
MOVEI REV,SYM
IF SYM<TYPE> NEQ INTEGER
TLNN SYM,$TYPE-$I
GOTO FALSE
THEN
BEGIN
;T_'INTEGER';
HRRZI T,$I
CONVERT
ENDD
FI
ENDD;
SUBTTL OBCODE SERVICE * MOB *
;MOB (MOVE TO OBCODE) TRANSFERS A PORTION TO THE OUTPUT BUFFER
;BY CALLING MPS (MOVE PSEUDO).SUCH A PORTION IS USUALLY THE RESULTING
;INSTRUCTION SEQUENCE OF A COMPLETE STATEMENT.
PROCEDURE MOB;
BEGIN
REGISTER TX;
OWN TCSTART,TCMIN,TOLINK;
FORMAL ISTHUNK;
IF NOT ERROR FOUND
TNGB(ERRF)
THEN
BEGIN
IF THIS IS FIRST EXPR. PORTION SINCE THUNKS WERE PUT OUT
HRRZ T,ISTHUNK
JUMPN T,FALSE
SKIPN T,THUNK
GOTO FALSE
THEN
BEGIN
;RESTORE NON LOCAL REGISTER AX TO WHAT IT WAS BEFORE JRST;
;CAX_THUNK<LHS>;
HLRZM T,CAX
;..FIX UP THE JRST OVER THE THUNKS;
FIXREL;
ZERO(THUNK);
ENDD
FI;
;TCSTART_TX_SYM<HANDLE>;
HRRZ TX,LEXEX;$
MOVEM TX,TCSTART;$
;TCMIN_TC[TX]<RHS>;
HRRZ T,(TX);$
MOVEM T,TCMIN;$
;..LOOP IS ENTERED WITH TX POINTING TO THE PORTION POINTER;
LOOP
BEGIN
;..SET TX TO POINT TO TOP OF NEXT PORTION;
;INDEX_TX_TC[TX]<RHS>;
HRRZ TX,(TX);$
HRRZM TX,INDEX
IF TX LSS TCMIN
CAML TX,TCMIN;$
GOTO FALSE;$
THEN
;TCMIN_TX;
MOVEM TX,TCMIN;$
FI;
;..WHILE IS ENTERED POINTING AT THE TOP OF A PORTION AND WILL
;..PROCESS ONE ENTIRE PORTION;
WHILE PORTION POINTER NE (T_TC[TX])
MOVE T,(TX);$
SETCM T1,T;$
TLNN T1,770000;$
GOTO FALSE;$
DO
BEGIN
MPS;
;TX_INDEX_TX+1;
AOS TX,INDEX;$
ENDD
OD;
ENDD;
AS TCSTART NE TX
CAME TX,TCSTART;$
GOTO TRUE;$
SA;
;INDEX_TCMIN;
;HANDLE_770000,TCMIN;
MOVE T,TCMIN;$
MOVEM T,INDEX;$
HRLI T,770000;$
MOVEM T,HANDLE;$
ENDD
FI;
LACINIT
ENDD
SUBTTL OBCODE SERVICE * MPS *
;MPS HANDLES AN INSTRUCTION IN TWO STEPS.
;STEP 1: IF THE OPCODE IS A PSEUDO OPCODE, IT IS DECODE BY CALLING
;THE APPROPRIATE ROUTINE (FOR INSTANCE QDMOVE FOR A DOUBLE MOVE)
;STEP2: DEPENDING ON ADDRESS MODE $AM,MPS CALLS A ROUTINE TO DECODE THE
;SYMBOLIC ADDRESS PART.
;THE TABLES FOLLOWING MPS REFLECT THE VARIOUS ADDRESS MODES AND
;PSEUDO OPCODES
PROCEDURE MPS;..INSTRUCTION IS IN T;
BEGIN
IF PSEUDOOPCODE
SETCM T1,T
TLNE T1,700000
GOTO FALSE
THEN
BEGIN
; T1<RHS>_T<OPCODE>;
HLRZ T1,T
LSH T1,-11
TRZ T1,700
CAIL T1,22
GOTO @PSTABLE(T1)
MOVE T1,KIOPS(T1)
DPB T,[
POINT 27,T1,35]
MOVE T,T1
SETCM T1,T
TLNE T1,700000
GOTO .+5
HLRZ T1,T
LSH T1,-11
TRZ T1,700
GOTO @PSTABLE(T1)
ENDD
FI;
.MTAD: ;T4_0;..NO OFFSET;
SETZ T4,
.MOFF: ;T4_T4+KA;
ADD T4,KA
; T1<RHS>_T<AM>;
HLRZ T1,T
ANDI T1,$AM
;..CLEAR INDIRECT BIT AND INDEX FIELD OF T;
TLZ T,$AM
; IF T<AM>=FIX OR IMM OR CT DO AMCT;
CAIG T1,$CT
GOTO .AMCT
; IF ADMODE GEQ 16 THEN COMPLEMENT;..THIS IS A PREPARATION FOR THE JUMPTABLE;
CAIL T1,20
TRC T1,$AM
GOTO @AMSEL(T1)
ENDD
; AM HAS BEEN CLEARED;T4=OFFSET;
AMSEL: XWD 0,.AMAX
XWD 0,.AMRA
XWD 0,.MREL
XWD 0,.AMPTR
XWD 0,.AMNEXT
XWD 0,.AMISP
XWD 0,.AMPVAL
XWD 0,.AMST
XWD 0,.AMSELF
XWD 0,.AMPRV
XWD 0,.AMOF2
XWD 0,.AMOF3
XWD 0,.AMACC
XWD 0,.AMSP
PSTABLE:XWD 0,.QDMOVE ;700
XWD 0,.QDPUSH ;701
XWD 0,.QDMOVEM ;702
XWD 0,.QTCTHEN ;703
XWD 0,.QTCELSE ;704
XWD 0,.QTCFI ;705
XWD 0,0 ;706
XWD 0,0 ;707
XWD 0,.DMVN ;710
XWD 0,.QTCTYDES ;711
XWD 0,.DMVNM ;712
XWD 0,.QTCSF ;713
XWD 0,.QDMOVE ;714
XWD 0,0 ;715
XWD 0,.QLF ;716
XWD 0,.QLF ;717
XWD 0,.QLF ;720
XWD 0,.QLF ;721
XWD 0,.QLF ;722
XWD 0,.QLF ;723
XWD 0,.POWCONV ;724
XWD 0,.POWCONV ;725
XWD 0,.POWCONV ;726
XWD 0,.POWCONV ;727
XWD 0,.POWCONV ;730
XWD 0,.POWCONV ;731
XWD 0,.POWCONV ;732
XWD 0,.POWCONV ;733
XWD 0,.POWCONV ;734
XWD 0,.POWCONV ;735
XWD 0,.POWCONV ;736
XWD 0,.POWCONV ;737
XWD 0,.QTCAD ;740
SUBTTL OBCODE SERVICE * QDPUSH *
;TO PUSH A DOUBLE WORD OPERAND. A LONG REAL IS HERE TREATED AS A
;TWO WORD OPERAND.SPECIAL CARE MUST BE TAKEN FOR THE CASE OF A
;POINTER IN A0 SINCE THIS REGISTER CANNOT BE USED AS AN INDEX REG.
PROCEDURE QDPUSH;
BEGIN
OWN INSTR;
; T<OPCODE>_PUSH;
TLZ T,777000
TLO T,(PUSH 0,0)
; INSTR_T;
MOVEM T,INSTR
; MTAD;
PUSHJ SP,.MTAD
;
Edit(154); Don't increase offset if source already in the stack.
;
; T4_1 ... OFFSET_1 ;[E154]
MOVEI T4,1 ;[E154]
IF T<AM>=PTR AND T<RHS>=0 ;[E154]
HLRZ T1,T ;[E154]
ANDI T1,$AM ;[E154]
CAIN T1,$PTR ;[E154]
TRNE T,777777 ;[E154]
GOTO FALSE ;[E154]
THEN ;[E154]
BEGIN ;[E154]
;T_ADDI A0,1; ;[E154]
HRLZI T,(ADDI 0,0) ;[E154]
ADDI T,1 ;[E154]
MABS ;[E154]
;T4_0..NO OFFSET ;[E154]
MOVEI T4,0 ;[E154]
ENDD ;[E154]
ELSE ;[E154]
;IF T<AM>=SP ;[E154]
CAIN T1,SP ;[E154]
;THEN T4_0..NO OFFSET ;[E154]
MOVEI T4,0 ;[E154]
FI ;[E154]
;T_INSTR;
MOVE T,INSTR
;MOFF
PUSHJ SP,.MOFF
ENDD
SUBTTL OBCODE SERVICE * QDMOVE *
;DOUBLE MOVE MUST ALSO HANDLE A POINTER IN A0 IN A SPECIAL WAY
;BECAUSE A0 CANNOT BE USED AS INDEX REG.
;IF THE ADDRESS MODE IS SELF , THE NEXT REG MUST BE LOADED BEFORE
;THE REG ITSELF IN ORDER NOT TO OVERWRITE THE POINTER.
PROCEDURE QDMOVE;
BEGIN
OWN INSTR;
IF T<AM> NEQ ACC OR T<ACC> NEQ T<RHS>
HLRZ T1,T
ANDI T1,777-$AM
LSH T1,-5
SUBI T1,(T)
TLNN T,$AM-$ACC
JUMPE T1,FALSE
THEN
BEGIN
; T<OPCODE>_'MOVE';
TLZ T,500000
IF T<AM>=PTR AND T<ACC>=T<RHS>
HRLZI T3,(T)
LSH T3,5
XOR T3,T
HLRZ T1,T
ANDI T1,$AM
CAIN T1,$PTR
TLNE T3,777-$AM
GOTO FALSE
THEN
BEGIN
;T<RHS>_0;
HLLZ T,T
;T<AM>_SELF;
MOVEI T1,$SELF
TLZ T,$AM
TLO T,(T1)
ENDD
FI;
; INSTR_T;..SAVE INSTRUCTION;
MOVEM T,INSTR
IF T<AM> = SELF AND T<ACC> = 0
CAIN T1,$SELF
TLNE T,777-$AM
GOTO FALSE
THEN
BEGIN
;T<AM>_NEXT
TLZ T,$AM
MOVEI T1,$NEXT
TLO T,(T1)
;INSTR_T
MOVEM T,INSTR
;T<LHS>_'MOVE A1,A0'
HRLI T,(MOVE A1,A0)
MABS;
;T_INSTR;..POINTER NOW IN A1;
MOVE T,INSTR
ENDD
FI;
IF T<AM> NEQ SELF
CAIN T1,$SELF
GOTO FALSE
THEN
BEGIN
;MTAD;
PUSHJ SP,.MTAD
;T_INSTR;
MOVE T,INSTR
ENDD
FI;
; T<ACC>_ACC+1;
HRLZI T4,40
ADD T,T4
; OFFSET_1;
HRRZI T4,1
IF T<AM>=NEXT
HLRZ T1,T
ANDI T1,$AM
CAIE T1,$NEXT
GOTO FALSE
THEN
;T<AM>_SELF
HRRZI T1,$SELF
TLZ T,$AM
TLO T,(T1)
ELSE
IF T<AM>=SELF
CAIE T1,$SELF
GOTO FALSE
THEN
;T<AM>_PRV
HRRZI T1,$PRV
TLZ T,$AM
TLO T,(T1)
FI
FI;
; MOFF;
PUSHJ SP,.MOFF
;T_INSTR;
MOVE T,INSTR
IF T<AM>=SELF
HLRZ T1,T
ANDI T1,$AM
CAIE T1,$SELF
GOTO FALSE
THEN
;MTAD
PUSHJ SP,.MTAD
FI
ENDD
FI
ENDD
SUBTTL OBCODE SERVICE * QTCTHEN *
;THEN MUST PRESERVE THE LOCATION IN OBCODE (POINTED AT BY RA)
;WHICH CONTAINS THE JUMP INSTRUCTION OVER THE THEN PART.
PROCEDURE QTCTHEN;
BEGIN
;TC[INDEX]<RHS>_TOLINK;
HRRZ T,TOLINK
HRRM T,(TX)
;TOLINK_INDEX;
HRRM TX,TOLINK
;TX_INDEX_INDEX+1;
AOS TX,INDEX
;TC[INDEX]<LHS>_CAX;..SAVE CURRENT AX OF IFEXPR;
HRLZ T,CAX
HLLM T,(TX)
; TC[INDEX]<RHS>_RA-1;..THE LOC TO BE FIXED UP AT ELSE;
HRRZ T,RA
SUBI T,1
HRRM T,(TX)
ENDD
SUBTTL OBCODE SERVICE * QTCELSE *
;ELSE FIXES UP THE JUMP OVER THE THEN PART AND PRESERVES THE
;LOCATION IN OBCODE THAT CONTAINS THE JUMP OVER THE ELSE PART
PROCEDURE QTCELSE;
BEGIN
; T3_TOLINK;
HRRZ T3,TOLINK
; TOLINK_INDEX;
HRRZM TX,TOLINK
;TC[INDEX]<RHS>_TC[T3]<RHS>;..TRANSFER OLD TOLINK;
HRRZ T2,(T3)
HRRM T2,(TX)
; INDEX_TX_INDEX+1;
AOS TX,INDEX
; TC[INDEX]<LHS>_CAX;..SAVE CURRENT AX OF THEN EXPR;
HRLZ T,CAX
HLLM T,(TX)
; CAX_TC[T3+1]<LHS>;..RESTORE CURRENT AX OF IF EXPR;
HLRZ T,1(T3)
HRRZM T,CAX
; TC[INDEX]<RHS>_RA-1;..THE LOC TO BE FIXED UP AT FI;
HRRZ T,RA
SUBI T,1
HRRM T,(TX)
; T_TC[T3+1]<RHS>;..THE LOC TO BE FIXED UP NOW;
HRRZ T,1(T3)
RAFIX
ENDD
SUBTTL OBCODE SERVICE * QTCFI *
;FI FIXES UP THE JUMP OVER THE ELSE PART
PROCEDURE QTCFI;
BEGIN
; T3_TOLINK;
HRRZ T3,TOLINK
; TOLINK_TC[T3]<RHS>;..RESTORE OLD TOLINK;
HRRZ T2,(T3)
HRRM T2,TOLINK
; T2_TC[T3+1]<LHS>;..GET CURRENT AX OF THEN EXPR;
HRRZ T2,1(T3)
IF T2 NEQ CAX
CAMN T2,CAX
GOTO FALSE
THEN
; CAX_0;
SETZM CAX
FI;
; T_TC[T3+1]<RHS>;..THE LOC TO BE FIXED UP NOW;
HRRZ T,1(T3)
RAFIX
ENDD
SUBTTL OBCODE SERVICE * QTCTYDES *
;TYDES PROCESSES THE ACTUAL PARAMETER DESCRIPTORS THAT FOLLOW A
;PROCEDURE CALL. IT FILLS IN THE SYMBOLIC (P,Q)-ADDRESS FOR PARAM,
;MORE EXTENSIVELY DESCRIBED IN THE MEMOS
PROCEDURE QTCTYDES;
BEGIN
REGISTER TX;
OWN STOP;
;TX_INDEX;
HRRZ TX,INDEX;$
;STOP_T<RHS>+TX<RHS>;
HRRZ T2,1(TX)
ADD T2,TX
HRRZM T2,STOP
WHILE TX LESS STOP
CAML TX,STOP
GOTO FALSE
DO
BEGIN
;TX_ADDRESS(NEXT INSTR);
;T_TC[TX];
MOVEI T,1(TX)
HRRZI TX,(T)
MOVE T,(TX)
TLC T,770000
TLCN T,770000
JRST .-4
MOVEM TX,INDEX
;CLEAR DECL.BIT;
TLZ T,$DECL
;T<STATUS>_T<STATUS>*(T<STATUS> NEQ STMT);
TLC T,$STATUS
TLNE T,$STMT
TLC T,$STATUS
IF T<$X>=DYNAMIC
TLNN T,$X
GOTO FALSE
THEN
;T<AM>_0;
TLZ T,$AM
MREL
ELSE
IF T<AM> NEQ ST
TLC T,$ST
TLNN T,$AM
GOTO FALSE
TLC T,$ST
THEN
BEGIN
IF T<AM>=CT
TLNE T,2
T.CONST(T)
THEN
;T<STATUS>_REGULAR;
TLO T,100
FI;
;MTAD
PUSHJ SP,.MTAD
ENDD
ELSE
BEGIN
;T<DECL,AM>_PROCLEV;
HLRZ T4,(T)
ANDI T4,$DECL!$AM
CAIE T4,0
TLO T,-1(T4)
IF PROCLEV=1 AND T<KIND>=VAR OR ARRAY AND T<STATUS>=SIMPLE AND T<TYPE> NEQ LABEL
SOJN T4,FALSE
TN.L(T)
TLNE T,$EXP!$STATUS
GOTO FALSE
THEN
;T<STATUS>_OWN;
TLO T,$OWN
FI;
IF PRASE LEQ T<RHS> AND T<RHS> LESS PRLIB
HRRZ T1,T
CAIL T1,PRASE
CAIL T1,PRLIB
GOTO FALSE
THEN
AMOF2
ELSE
BEGIN
INCR(THUNK);
;T4_0;..NO OFFSET;..ALLREADY DONE;
SETZ T4,
SETT(KA);
AMST;
ZERO(KA);
DECR(THUNK)
ENDD
FI
ENDD
FI
FI
ENDD
OD
ENDD
SUBTTL OBCODE SERVICE * QTCADDFIX *
;TO PUT OUT A FIXUP FOR JUMPS OVER THEN OR ELSE PART
PROCEDURE QTCADDFIX;
BEGIN
;T<LHS>_'JSP AX,0'; [303]
HRLI T,(JSP AX,0) ;[303]
MABS;
MOVE T,RA;$
SUBI T,1;$
FIXADD;
KILLAX
ENDD
SUBTTL OBCODE SERVICE * DMVNM *
PROCEDURE DMVNM;..DOUBLE STORE NEGATIVE
BEGIN
OWN DINSTR;
; DINSTR_T;..INCLUDING RIGHTHAND!!!;
MOVEM T,DINSTR
; T_'DMOVN ACC,ACC'
TLZ T,777000!$AM
HLRZ T4,T
LSH T4,-5
HRRI T,(T4)
TLO T,(DMOVN 0,0)
MABS;
; T_DINSTR;..KILL NEGATION;
MOVE T,DINSTR
TLZ T,010000
QDMOVEM
ENDD
SUBTTL OBCODE SERVICE * DMVN *
PROCEDURE DMVN;..DOUBLE LOAD NEGATIVE
BEGIN
OWN DINSTR;
; DINSTR<LHS>_T<LHS>;..SAVE DESTINATION ACC;
HLLZM T,DINSTR
;..KILL NEGATION;
TLZ T,010000
QDMOVE
; T_DINSTR;
HLLZ T,DINSTR
; T_'DFN ACC,ACC+1'; KA10
; T_'DMOVN ACC,ACC'; KI10
TLZ T,777000!$AM
HLRZ T4,T
LSH T4,-5
HRRI T,(T4)
TLO T,(DMOVN 0,0) ;
MABS;
ENDD
SUBTTL OBCODE SERVICE * AMPTR *
;SOURCE IS A POINTER (F.I. A SUBSCRIPTED VARIABLE).
;SPECIAL CASE OF A POINTER IN A0
PROCEDURE AMPTR;
BEGIN
OWN INSTR;
IF PTR=A0 AND OFFSET NEQ 0
TRNN T,SP
CAIN T4,0
GOTO FALSE
THEN
BEGIN
;INSTR_T;
MOVEM T,INSTR
;T_'ADDI A0,OFFSET';
HRLZI T,(ADDI 0,0)
ADDI T,(T4)
MABS;
;T_INSTR;
MOVE T,INSTR
;OFFSET_0;
SETZ T4,
ENDD
FI;
;T<AM>_T<RHS>;
;T<RHS>_0;
TLO T,(T)
HRRI T,0
;IF T<INDEX>=A0 THEN SET INDIRECT BIT;
TLNN T,SP
TLO T,20
;T_T+T4;..ADD OFFSET;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
SUBTTL OBCODE SERVICE * AMACC * * AMRA *
PROCEDURE AMACC;..SOURCE IS AN ACC; GENERATION OF MOVE A,A IS AVOIDED
BEGIN
IF T<ACC> NEQ T<RHS> OR T<OPCODE> NEQ MOVE OR OFFSET NEQ 0
HLRZ T1,T
SUBI T1,(MOVE 0,0)
LSH T1,-5
SUBI T1,(T)
ADDI T1,(T4)
JUMPE T1,FALSE
THEN
BEGIN
;T_T+T4;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
FI
ENDD
PROCEDURE AMRA;..ADDRESS OF SOURCE RELATIVE TO PROGRAM COUNTER RA
BEGIN
;T<RHS>_T<RHS>+RA;
ADD T,RA
MREL
ENDD
SUBTTL OBCODE SERVICE * AMNEXT * * AMPRV * * AMSELF *
PROCEDURE AMNEXT;..SOURCE INDEXED BY ACC +1
BEGIN
;T1<ACC>_T<ACC>+1;
HLRZ T1,T
ADDI T1,40
SAMEN: ANDI T1,$STATUS!$DECL
;T1^-5;..BRING ACC IN INDEX FIELD;
LSH T1,-5
;T<AM>_T1;
TLO T,(T1)
;T_T+T4;..ADD OFFSET;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
PROCEDURE AMPRV;..SOURCE INDEXED BY ACC-1
BEGIN
;T1<ACC>_T<ACC>-1;
HLRZ T1,T
SUBI T1,40
GOTO SAMEN
ENDD
PROCEDURE AMSELF;..SOURCE INDEXED BY ACC
BEGIN
;T<AM>_T<ACCFIELD>;
HLRZ T1,T
LSH T1,-5
ANDI T1,17
TLO T,(T1)
; T_T+T4;..ADD OFFSET;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
SUBTTL OBCODE SERVICE * AMISP *
PROCEDURE AMISP;..SOURCE IS POINTER SAVED IN STACK
BEGIN
OWN INSTR;
IF OFFSET=0
JUMPN T4,FALSE
THEN
; T<AM>_@SP;
TLO T,SP!20
MABS
ELSE
BEGIN
; INSTR<RHS>_T<LHS>;
HLLM T,INSTR
; T<OPCODE,INDEX>_'MOVE,SP';
TLZ T,777000
TLO T,(<MOVE 0,(SP)>)
MABS;
MOVEI T4,1
MOVE T,INSTR
AMSELF
ENDD
FI;
ENDD
SUBTTL OBCODE SERVICE * AMDL * * AMSP * * AMAX *
PROCEDURE AMDL;..SOURCE IS LOCAL OF PROC,I.E. INDEXED BY DL
BEGIN
;IF KA=0 THEN T<AM>_DL;
SKIPN KA
TLO T,DL
; T_T+T4;..ADD OFFSET;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
PROCEDURE AMSP;..SOURCE IS EXPR SAVED IN STACK
BEGIN
;T<AM>_SP;
TLO T,SP
; T_T+T4;..ADD OFFSET;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
PROCEDURE AMAX;..SOURCE IS NON-LOCAL OF PROC,THUS INDEXED BY AX
BEGIN
;IF KA=0 THEN T<AM>_AX;
SKIPN KA
TLO T,AX
;T_T+T4;..ADD OFFSET;
ADDI T4,(T)
HRRI T,(T4)
MABS
ENDD
SUBTTL OBCODE SERVICE * AMPVAL *
PROCEDURE AMPVAL;..SOURCE IS PROCEDURE VALUE
BEGIN
LOCAL INSTR,OFS;
IF PROCLEV NEQ FNLEVEL AND PROCLEVEL NEQ CAX AND THUNK=0
HLRZ T2,(T)
ANDI T2,77
ADDI T2,1
SKIPN KA
CAMN T2,FNLEVEL
GOTO FALSE
HRRO T4,T4
CAMN T2,CAX
GOTO FALSE
THEN
BEGIN
;INSTR_T
MOVEM T,INSTR
;OFS_T4
MOVEM T4,OFS
;CAX_T2
MOVEM T2,CAX
;T_'MOVEI AX,@PROCLEV(DL)';
HRLZI T,(<MOVEI AX,@(DL)>)
ADDI T,-1(T2)
MABS;
;T_INSTR
MOVE T,INSTR
;T4_OFS
MOVE T4,OFS
;T2_CAX
MOVE T2,CAX
ENDD;
FI;
;T<RH>_OFFSET
HRRI T,1(T2)
IF NONLOCAL
JUMPGE T4,FALSE
HRRZ T4,T4
THEN
AMAX
ELSE
AMDL
FI
ENDD;
SUBTTL OBCODE SERVICE * AMCT *
;SOURCE IS A CONSTANT
;AMCT OPTIMIZES SEQUENCES SUCH AS
; ADDI AC,N
; OPC REG,(AC)
;INTO OPC REG,N(AC)
;WHICH IS LIKELY TO OCCUR IN CODE FOR SUBSCRIPTED VARIABLES:
;A[3] OR A[I+3]. EVEN SUBSCRIPTED VARIABLES OF TYPE LONG REAL
;ARE OPTIMIZED IN THIS SENSE
PROCEDURE AMCT;
BEGIN
IF T<AM>=IMM OR FIX
CAIL T1,$CT
GOTO FALSE
THEN
IF T<OPCODE>='ADDI' OR 'SUBI'
HLRZ T2,T
SUBI T2,(ADDI 0,0)
TRNE T2,773000
GOTO FALSE
THEN
BEGIN
;TX_ADR<NET INSTR>;
;T2_NEXT INSTR;
MOVEI T2,1(TX)
HRRZ TX,T2
MOVE T2,(TX)
TLC T2,770000
TLCN T2,770000
JRST .-4
;T4_
IF T2<AM>=PTR
HLRZ T3,T2
ANDI T3,$AM
CAIE T3,$PTR
GOTO FALSE
THEN
;T2<RHS>
HRLZI T4,(T2)
LSH T4,5
ELSE
IF T2<AM>=SELF
CAIE T3,$SELF
GOTO FALSE
THEN
;T2<ACC>
HLLZ T4,T2
ELSE
IF T2<AM>=NEXT
CAIE T3,$NEXT
GOTO FALSE
THEN
;T2<ACC>+1
HRLZI T4,40
ADD T4,T2
ELSE
;ZERO
MOVEI T4,0
FI
FI
FI;
IF T<ACC> NEQ 0 AND T<ACC>=T4<ACC>
XOR T4,T
TLNE T,$STATUS!$DECL
TLNE T4,$STATUS!$DECL
GOTO FALSE
THEN
BEGIN
;INDEX_TX;
MOVEM TX,INDEX
;KA_T4_ IF ADDI THEN T<RHS> ELSE -T<RHS>;
TLNE T,4000
MOVN T,T
HRRZI T4,(T)
HRRZM T4,KA
;T_T2;..T_NEXT INSTR;
MOVE T,T2
MPS;
ZERO(KA)
ENDD
ELSE
IF T2<OPCODE>=ADD OR SUB AND T2<ACC>=T<ACC> AND T<ACC>#0 AND
; T2<AM>#ACC OR T2<ACC>#T2<RHS>
HLLO T3,T
TLO T3,$AM
SUB T3,T2
TLNE T3,1000
TLNE T3,772740
GOTO FALSE
TLNE T2,$AM-$ACC
GOTO TRUE
HLRZ T3,T2
LSH T3,-5
XORI T3,(T2)
TRNE T3,17
TLNN T,$STATUS!$DECL
GOTO FALSE
THEN
BEGIN
;TC[TX]_T;..POSTPONE IMMEDIATE INSTRUCTION;
MOVEM T,(TX)
;T_T2;..DO NEXT INSTRUCTION FIRST;
MOVE T,T2
;TX_INDEX;
MOVE TX,INDEX
EDIT(051) ; REWRITE ORIGINAL INSTRUCTION INTO TEMPCODE
MOVEM T,(TX) ; [E051]
GOTO .MTAD;
ENDD
ELSE
BEGIN
;TX_INDEX;
MOVE TX,INDEX
MABS
ENDD
FI
FI
ENDD
ELSE
MABS
FI
ELSE
BEGIN
;T_T+CONTAB;
ADD T,CONTAB
;T1_CONSTTABLEADDRESS;
HRRZI T1,(T)
IF T4=1
JUMPE T4,FALSE
THEN
BEGIN
; T1_T1+T4;
ADD T1,T4
GOTO OFALL
ENDD
FI;
;T<RHS>_LINK;
HLR T,(T1)
;LINK_RA;
HRL T1,RA
HLLM T1,(T1)
MREL
ENDD
FI
ENDD
SUBTTL OBCODE SERVICE * AMOF1/2/3 *
PROCEDURE AMOF1;..TO BUILD FIXUP CHAIN IN VALUE FIELD OF ST-ENTRY
BEGIN
;T1_SYMTABLEADDRESS;
HRRZI T1,1(T)
OFALL: ;T<RHS>_LINK;
HRR T,(T1)
;LINK_RA;
HRL T1,RA
HLRM T1,(T1)
MREL
ENDD
PROCEDURE AMOF2;..TO BUILD FIXUP IN FIRST EXTENSION WORD OF ST-ENTRY
BEGIN
;T1_ADDRESS OF EXTENSION;
MOVE T1,2(T)
ANDI T1,77
ADDI T1,1
IDIVI T1,6
ADDI T1,3(T)
GOTO OFAUX
ENDD
PROCEDURE AMOF3;..TO BUILD FIXUP CHAIN IN SECOND EXTENSION WORD
BEGIN
;T1_ADDRESS OF AUX.EXTENSION;
MOVE T1,2(T);..FIRST WORD OF NAME
ANDI T1,77
ADDI T1,1
IDIVI T1,6
ADDI T1,4(T)
;IF AUX=0 THEN AUX<LHS>_RA;
OFAUX: HRLZ T2,RA
SKIPN (T1)
HLLZM T2,(T1)
GOTO OFALL
ENDD
SUBTTL OBCODE SERVICE * NOCHAIN *
;NOCHAIN HANDLES THE ST-SOURCE OF WHICH THE ADDRESS IS KNOWN AT
;COMPILE TIME.FOR INSTANCE THE ADDRESS OF A LOCAL OF A PROC BODY IS
;KNOWN AT COMPILE TIME AS Q(DL),WHERE DL IS THE DYNAMIC LEVEL
;POINTER.FOR A NON-LOCAL IT MAY BE NECESSARY TO INSERT AN INSTRUCTION
;TO LOAD THE AUXILIARY ADDRESS MODIFIER AX WITH THE APPROPRIATE DISPLAY
;ELEMENT. THIS IS DESCRIBED MORE PRECISELY IN THE MEMOS
PROCEDURE NOCHAIN;
BEGIN
OWN INSTR,OFS;
IF PROCLEV NEQ FNLEVEL AND PROCLEVEL NEQ CAX AND THUNK=0
HLRZ T2,(T)
ANDI T2,77
SKIPN KA
CAMN T2,FNLEVEL
GOTO FALSE
HRRO T4,T4
CAMN T2,CAX
GOTO FALSE
THEN
BEGIN
;INSTR_T;
MOVEM T,INSTR
;OFS_T4;
MOVEM T4,OFS
;CAX_T2
MOVEM T2,CAX
;T_'MOVEI AX,@PROCLEV(DL)';
HRLZI T,(<MOVEI AX,@(DL)>)
ADDI T,-1(T2)
MABS;
;T_INSTR;
MOVE T,INSTR
;T4_OFS;
MOVE T4,OFS
ENDD
FI;
;T<RHS>_VALUE;
HRR T,1(T)
IF NONLOCAL
JUMPGE T4,FALSE
HRRZ T4,T4
THEN
AMAX
ELSE
AMDL
FI
ENDD
SUBTTL OBCODE SERVICE * AMST *
;..T CONTAINS THE INSTRUCTION;
;..AMFIELD MAY CONTAIN PROCLEV FOR TYPEDESCRIPTOR;
;..T4 CONTAINS OFFSET;
;AMST DEALS WITH A SOURCE IN THE SYMBOL TABLE.
;THE MEMOS DESCRIBE IN DETAIL HOW LABELS ARE TREATED IN THE ONE PASS
;COMPILER AND HOW THE FIRST AND SECOND EXTENSION WORDS ARE USED TO BUILD
;FIXUP CHAINS FOR CURRENT AND INNER REFERENCES.
;GLOBALS AND OWN VARIABLES CANNOT BE USED RECURSIVELY. THAT ALLOWS A
;PROGRAM TO ADDRESS THESE DIRECTLY, BUT IT IMPLIES THAT THE ADDRESSES
;ARE NOT KNOWN AT COMPILE TIME. HENCE A FIXUP CHAIN FOR EACH OF THOSE
;MUST BE GENERATED
PROCEDURE AMST;
BEGIN
REGISTER TV;
;;TV_T<TYPE,VALUE>;
MOVE TV,1(T)
;T1_PROCLEV;
HLRZ T1,(T)
ANDI T1,77
IF TV<KIND>=VAR OR ARRAY
TLNE TV,$EXP
GOTO FALSE
THEN
IF TV<TYPE>=LABEL
T.L(TV)
THEN
IF TV<DECL>=UNDECL OR TV<STATUS>=FORWARD
TLNN TV,$DECL
GOTO TRUE
T.FOW(TV)
THEN
IF THUNK=0
SKIPE THUNK
GOTO FALSE
THEN
AMOF3
ELSE
AMOF2
FI
ELSE
IF TV<STATUS>=SIMPLE
TLNE TV,$STATUS
GOTO FALSE
THEN
BEGIN
IF THUNK=0
SKIPE THUNK
GOTO FALSE
THEN
;T<RHS>_TV<VALUE>+2;..LOCAL LABEL;
HRRI T,2(TV)
ELSE
;T<RHS>_TV<VALUE>
HRRI T,(TV)
FI;
MREL
ENDD
ELSE
BEGIN
;T4_0;..NO OFFSET;
SETZ T4,
NOCHAIN;..FORMAL LABEL
ENDD
FI
FI
ELSE
IF GLOBAL OR OWN
TLNN TV,$STATUS
SOJE T1,TRUE
T.OWN(TV)
THEN
IF T4=0
JUMPN T4,FALSE
THEN
AMOF1
ELSE
AMOF2
FI
ELSE
NOCHAIN
FI
FI
ELSE ;..REMAIN PROCEDURE IDENTIFIERS;
IF TV<STATUS>=EXTERN
HLRZ T2,TV
ANDI T2,$STATUS
CAIE T2,$EXT
GOTO FALSE
THEN
AMOF1
ELSE
IF TV<STATUS>=SIMPLE OR REGULAR
TLNE TV,$FOV
GOTO FALSE
THEN
BEGIN
;T<RHS>_TV<VALUE>;
HRR T,TV
Edit(144) ; Ensure procedure call is relocated
MREL0 ; [E144]
ENDD
ELSE
IF TV<STATUS>=FORWARD
T.FOW(TV)
THEN
AMOF1
ELSE ;..REMAIN FORMAL PROCEDURES;
BEGIN
;T4_0;..NO OFFSET;
SETZ T4,
NOCHAIN
ENDD
FI
FI
FI
FI;
;IF TV<KIND,STATUS>=PROC OR FORMAL THEN KILLAX;
TLC TV,$PRO!$FON
TLNE TV,$PRO
TLNN TV,$FON
SETOM CAX
ENDD
SUBTTL OBCODE SERVICE * QTCSF * * POWCONV *
PROCEDURE QTCSF;..TO STORE INTO A FORMAL (SEE THE MEMOS)
BEGIN
;T<LHS>_'XCT 0';
HRLI T,(XCT 0,0)
;T4_1;OFFSET
MOVEI T4,1
NOCHAIN
KILLAX
ENDD
;POWCONV GENERATES THE APPROPRIATE ADDRESS OF POWER OR CONVERT
;ROUTINES
PROCEDURE POWCONV; ;..ADR<VALUE>=3*(OPCODE-724)+PRLIB+1;
BEGIN
KILLAX;
;T1_ADDRESS<VALUE FIELD>;
LSH T,-33
SUBI T,724
MOVE T1,T
LSH T,1
ADDI T1,PRLIB+1(T)
;T_INSTR;
HRLZI T,(JSP AX,0)
GOTO OFALL
ENDD;
SUBTTL OBCODE SERVICE * QLF *
;THERE ARE FOUR GROUPS OF SIX DOUBLE FLOATING OPERATIONS.
;THE GROUPS REFLECT THE ACCUMULATOR-DESTINATION OPERAND (IN ACCFIELD)
;A0,A3,A6 OR A11, WHILE EACH GROUP HAS SIX OPERATIONS:
;FAD,FSUB,FMP,FDIV,RFSUB AND RFDIV.
;QLF GENERATES AN INSTRUCTION TO LOAD THE ADDRESS OF THE SOURCE IN
; REGISTER AX AND AN INSTRUCTION THAT CALLS THE APPROPRIATE OPERATION
PROCEDURE QLF;
BEGIN
OWN INSTR;
; INSTR<LHS>_T<LHS>;
HLLZM T,INSTR
;T<0PCODE,ACCFIELD>_'MOVEI AX,0'
TLZ T,777777-$AM
TLO T,(MOVEI AX,0)
; MTAD;
PUSHJ SP,.MTAD
; T<RHS>_INSTR<ACCFIELD>;
HLRZ T,INSTR
ANDI T,777-$AM
; T_T:3 ;
IDIVI T,60
; T1<RHS>_INSTR<OPCODE FIELD>;
HLRZ T1,INSTR
;T<RHS>_STADR<FLROUTINE>;..=3*(OPCODE-720+C+2*ACC)+PRLIB
;WHERE 3*C=DFAD0-PRLIB;
LSH T1,-11
SUBI T1,702
IMULI T1,3
IMULI T,11
ADDI T,PRLIB(T1)
;T_'PUSHJ SP,0';
HRLI T,(PUSHJ SP,0)
AMOF1
KILLAX
ENDD
SUBTTL BACKCHAIN FIXUP AND ST DECREASE AT BLOCKEXIT
;BEXIT DELETES FROM THE SYMBOL TABLE THE SET OF ST-ENTRIES OF THE
;CURRENT BLOCK. IT HAS TO DO SPECIAL THINGS FOR UNDECLARED LABELS
;LABELS ARE HANDLED IN TWO STEPS:
;STEP1: THE CURRENT CHAIN IS LINKED ONTO THE INNER CHAIN
;STEP2: IF THERE IS A LABEL OF THE SAME NAME IN THE OUTER BLOCK,
;THIS ONE IS HOOKED ONTO IT AND THE ST-ENTRY OF THE CURRENT ONE
;IS DELETED;IF NOT,THEN THE ST-ENTRY OF THE CURRENT LABEL IS MOVED
;TO THE OUTER BLOCK.
;ANOTHER OBLIGATION OF BEXIT IS TO PRESENT THE VARIOUS FIXUP CHAINS
;TO THE OUTPUT
PROCEDURE BEXIT;
BEGIN
REGISTER BX,TV,EXT;
OWN NNASTE;
;BX_STBB;..FIRST ENTRY OF THIS BLOCK;
HRRZ BX,STBB
;NNASTE_BX-1;..NEXT NEW AVAILABLE ENTRY;
MOVEM BX,NNASTE
SOS NNASTE
;STBB_OLD STBB;
MOVE T,@NNASTE
MOVEM T,STBB
IF NOT PRODUCTION SWITCH SET;
TNGB(TRPOFF);$
THEN;...OUTPUT THE BLOCK IDENTIFIER
BHDR;$
FI;
WHILE BX LESS NASTE
CAML BX,NASTE
GOTO FALSE
DO
BEGIN
;EXT_ADDRESS OF FIRST EXTENSION WORD;
MOVE EXT,2(BX);..FIRST WORD OF NAME
ANDI EXT,77;..NR. OF CHARACTERS-1;
ADDI EXT,1
IDIVI EXT,6;..LENGTH OF NAME IN WORDS - 1;
ADDI EXT,3(BX)
;TV_ENTRY<TYPE>,<VALUE>;
MOVE TV,1(BX)
IF TV=LABEL AND VAR AND STATUS NEQ FORMAL
TLNN TV,$TYPE
TLO TV,$EXP!$TYPE
HLRZ T,TV
ANDI T,$KIND!$TYPE!$STATUS
CAIL T,$L
CAIL T,$L!$FON
GOTO FALSE
THEN
IF TV<DECL>
T.DECL(TV)
THEN
BEGIN
IF BX<LINC> NEQ 0
SKIPN T,(EXT)
GOTO FALSE
THEN
FIXREL( ,TV)
FI;
IF BX<LCC> NEQ 0
SKIPN T,1(EXT)
GOTO FALSE
THEN
BEGIN
;T1_TV+2;..TO PROCESS THE LOCAL LABEL;
HRRZ T1,TV
ADDI T1,2
;FIXREL
PUSHJ SP,.ADRFIX
ENDD
FI
ENDD;..OF DECLARED LABEL
ELSE
IF STATUS = FORWARD
T.FOW(TV)
THEN
;..SET DECL.BIT IN ORDER TO DELETE LATER ON;
TLO TV,$DECL
MOVEM TV,1(BX)
HRR SYM,BX ; [266]
HLL SYM,1(BX) ; [266]
TLO SYM,$ST ; [266]
FAIL(62,FRIED,DEL,FORWARD HAS NO MATCHING DECL IN SAME BLOCK) ; [266]
SETZ SYM, ; [266]
ELSE
IF BX<LCC> NEQ 0
SKIPN T,1(EXT)
GOTO FALSE
THEN
IF BX<LINC> NEQ 0
SKIPN T1,(EXT)
GOTO FALSE
THEN
BEGIN
;BX<LINC>_BX<LCC>
HRRM T,(EXT)
;T<RHS>_BX<SCC>;
HLRZ T,T
;BX<LCC,SCC>_0;
SETZM 1(EXT)
PUSHJ SP,.ADRFIX
ENDD
ELSE
BEGIN
;INNER CHAIN_CURRENT CHAIN;
MOVE T,1(EXT)
MOVEM T,(EXT)
;BX<SCC,LCC>_0
SETZM 1(EXT)
ENDD
FI
FI
FI
FI
ELSE
IF ENTRY =GLOBAL OR OWN AND ENTRY<KIND>=VAR OR ARRAY
TLNE TV,$EXP
GOTO FALSE
MOVE T,(BX)
TLNN T,76
GOTO TRUE
T.OWN(TV)
THEN
BEGIN
;T1<RHS>_BX<VALUE>;
HRRZ T1,TV
TOFIX;
IF ENTRY<KIND>=VAR AND ENTRY<TYPE>=TWO WORD OPERAND
T.VAR(TV)
T.TWO(TV)
THEN
BEGIN
;T1<RHS>_HEADER OF CHAIN;
HRRZ T1,(EXT)
TOFIX
ENDD
ELSE
IF ENTRY<KIND>=ARRAY
TLNN TV,$ARR
GOTO FALSE
THEN
BEGIN
HRRZI T1,0
TOFIX
ENDD
FI
FI
ENDD
ELSE
IF ENTRY<STATUS>=FORWARD
T.FOW(TV)
THEN
HRR SYM,BX ; [266]
HLL SYM,1(BX) ; [266]
TLO SYM,$ST ; [266]
FAIL(62,FRIED,DEL,FORWARD HAS NO MATCHING DECL IN THE SAME BLOCK) ; [266]
SETZ SYM, ; [266]
ELSE
IF ENTRY<KIND>=PROC AND STATUS=EXT
T.PRO(TV)
HLRZ T,TV
ANDI T,$STATUS
CAIE T,$EXT
GOTO FALSE
THEN
BEGIN
;T<RHS>_TV<RHS>;
HRRZ T,TV
;T4<RHS>_BX;
HRRZI T4,(BX)
EXTFIX
ENDD
FI
FI
FI
FI;
;DELETE OR MOVE ENTRY:
IF ENTRY<TYPE>=UNDECL.LABEL
TLNN TV,$DECL
T.L(TV)
THEN
BEGIN
;ENTRY<BL>_ENTRY<BL>-1;..MOVE LABEL TO OUTER BLOCK;
HLRZ T3,(BX)
SUBI T3,100
HRLM T3,(BX)
IF ENTRY<VALUE> NEQ 0 AND ENTRY<VALUE><BL>=ENTRY<BL>
TRNN TV,777777
GOTO FALSE
HLRZ T,(TV)
XOR T3,T ;..BL.PL OF ENTRY<VALUE>;
ANDI T3,77700
JUMPN T3,FALSE
THEN
BEGIN
;SET DECLARED BIT IN ORDER TO DELETE LATER ON;
TLO TV,$DECL
MOVEM TV,1(BX)
IF ENTRY<VALUE><TYPE>=VAR AND LABEL
MOVE T,1(TV)
T.L(T)
T.VAR(T)
THEN
IF ENTRY<VALUE><LINC> NEQ 0
HRRZI T4,(EXT)
SUBI T4,(BX)
ADDI T4,(TV)
SKIPN T1,(T4)
GOTO FALSE
THEN
BEGIN
;T_ENTRY<SINC>;
HLRZ T,(EXT)
;ENTRY<VALUE><LINC>_ENTRY<LINC>;
HRRZ T3,(EXT)
HRRM T3,(T4)
;FIXREL
PUSHJ SP,.ADRFIX
ENDD
ELSE
;ENTRY<VALUE><SINC,LINC>_ENTRY<SINC,LINC>
MOVE T3,(EXT)
MOVEM T3,(T4)
FI
ELSE
FAIL(64,FRIED,DEL,FORWARD DECL.MISSING)
FI
ENDD
FI
ENDD
FI;..ONLY THE LABEL THAT OUGHT TO BE MOVED IS STILL 'UNDECLARED';
;..COMPUTE THE HASH;..T4=HASH;
MOVE T4,2(BX)
MULI T4,647327 ;..KEN'S RANDOM CONSTANT;
ANDI T4,177
;EXT_RECORDLENGTH;
SKIPGE (BX)
ADDI EXT,2
SUBI EXT,(BX)
IF BX LEQ HASHTABLE[HASH]
CAMLE BX,SYMHT(T4)
GOTO FALSE
THEN
;HASHTABLE[HASH]_ENTRY<LINK>
HRRZ T1,(BX)
HRRM T1,SYMHT(T4)
FI;
IF ENTRY<TYPE>=UNDECL.LABEL
TLNN TV,$DECL
T.L(TV)
THEN
BEGIN
;T1_RECORDLENGTH +NNASTE-1;
MOVE T1,NNASTE
ADDI T1,-1(EXT)
;T<LHS,RHS>_BX,NNASTE;
HRRZ T,NNASTE
HRL T,BX
;MOVE ENTRY;
BLT T,(T1)
;T3_NEW ADDRESS;
HRRZ T3,NNASTE
;NNASTE_NNASTE+RECORDLENGTH;
ADDM EXT,NNASTE
;ENTRY<LINK>_HASHTABLE[HASH]
HRRZ T,SYMHT(T4)
HRRM T,(T3)
;HASHTABLE[HASH]_NEWADDRESS
HRRZM T3,SYMHT(T4)
ENDD
ELSE
BEGIN
;TV<DECL,AM>_PROCLEV;
TLZ TV,$DECL!$AM
HLRZ T,(BX)
ANDI T,$DECL!$AM
TLO TV,(T)
;T<RHS>_ADDRESS ST ENTRY;
HRRZI T,(BX)
IF PRODUCTION SWITCH NOT SET;
TNGB(TRPOFF);$
THEN;..OUTPUT THE ASCII SYMBOL BLOCK;
TYPE0;$
FI;
ENDD
FI;
;BX_NEXT ENTRY;
ADD BX,EXT
ENDD
OD;
;BLOCKLEVEL_BLOCKLEVEL-1;
SOS BLOCKLEVEL
MOVE T,NNASTE
;NASTE_NNASTE;..FIRST SINGLE N,SECOND DOUBLE N;
MOVEM T,NASTE
ENDD
ENDD; OF MODULE MSER
LIT
END