Title[BCPLRuntime.mc...January 27, 1980 11:45 AM...Taft];
TopLevel;
KnowRBase[AEmRegs];
* JSR code dispatches here for JSR 300 - 377.
* This code interprets JSR 300 - 332, which are the right-shift
* and left-shift-and-masked-store operations.
* Entry conditions: ETemp = ID-300, MemBase = CODE, StkP = unknown
JSRz300:
PD← (ETemp)-(33C);
StkP← spAC1, Branch[.+2, ALU<0];
J300x:Q← PCX’, Branch[JSRx];* Not one of ours, do normal JSR
* After the dispatch, StkP addresses AC0 and T has the contents of AC1.
* ETemp saves the value of ID, required if a particular routine decides to
* exit to the software routine rather than doing the work itself.
ETemp← T, BigBDispatch← ETemp, T← MD; * Force memory op to finish
T← Stack&-1, Branch[LQ0.6z];* Leave FF free for placement
* LQa.b right-shifts accumulator a by b positions.
LQ0.6z:Stack← RSH[Stack, 6], IFUJump[0],At[BcplZ300X, 00]; * 300
LQ1.6z:StkP+1, Branch[LQ0.6z],At[BcplZ300X, 01];
LQ0.5z:Stack← RSH[Stack, 5], IFUJump[0],At[BcplZ300X, 02];
LQ1.5z:StkP+1, Branch[LQ0.5z],At[BcplZ300X, 03];
LQ0.4z:Stack← RSH[Stack, 4], IFUJump[0],At[BcplZ300X, 04];
LQ1.4z:StkP+1, Branch[LQ0.4z],At[BcplZ300X, 05];
LQ0.3z:Stack← RSH[Stack, 3], IFUJump[0],At[BcplZ300X, 06];
LQ1.3z:StkP+1, Branch[LQ0.3z],At[BcplZ300X, 07];
LQ0.2z:Stack← RSH[Stack, 2], IFUJump[0],At[BcplZ300X, 10]; * 310
LQ1.2z:StkP+1, Branch[LQ0.2z],At[BcplZ300X, 11];
LQ0.1z:Stack← RSH[Stack, 1], IFUJump[0],At[BcplZ300X, 12];
LQ1.1z:StkP+1, Branch[LQ0.1z],At[BcplZ300X, 13];
T← ETemp, Branch[J300x],At[BcplZ300X, 14];
* SQa.b left-shifts accumulator a by b positions and then performs SNQa.
SQ0.7z:Stack← LSH[Stack, 7], Branch[SQ0.x],At[BcplZ300X, 15];
SQ1.7z:T← LSH[T, 7], StkP+1, Branch[SQ1.x],At[BcplZ300X, 16];
SQ0.6z:Stack← LSH[Stack, 6], Branch[SQ0.x],At[BcplZ300X, 17];
SQ1.6z:T← LSH[T, 6], StkP+1, Branch[SQ1.x],At[BcplZ300X, 20]; * 320
SQ0.5z:Stack← LSH[Stack, 5], Branch[SQ0.x],At[BcplZ300X, 21];
SQ1.5z:T← LSH[T, 5], StkP+1, Branch[SQ1.x],At[BcplZ300X, 22];
SQ0.4z:Stack← LSH[Stack, 4], Branch[SQ0.x],At[BcplZ300X, 23];
SQ1.4z:T← LSH[T, 4], StkP+1, Branch[SQ1.x],At[BcplZ300X, 24];
SQ0.3z:Stack← LSH[Stack, 3], Branch[SQ0.x],At[BcplZ300X, 25];
SQ1.3z:T← LSH[T, 3], StkP+1, Branch[SQ1.x],At[BcplZ300X, 26];
SQ0.2z:Stack← LSH[Stack, 2], Branch[SQ0.x],At[BcplZ300X, 27];
SQ1.2z:T← LSH[T, 2], StkP+1, Branch[SQ1.x],At[BcplZ300X, 30]; * 330
SQ0.1z:Stack← LSH[Stack, 1], Branch[SQ0.x],At[BcplZ300X, 31];
SQ1.1z:T← LSH[T, 1], StkP+1, Branch[SQ1.x],At[BcplZ300X, 32];
SQ0.x:FlipMemBase;* MemBase← MDS
Branch[SNQ0z];* Nop for placement
SQ1.x:Stack&-1← T, FlipMemBase;* MemBase← MDS
Branch[SNQ1z];* Nop for placement
* JSR code dispatches here for JSR @340 - 377.
* This code interprets JSR @340 - 370.
* Entry conditions: ETemp = ID-340, MemBase = MDS, StkP = unknown
JSRiz340:
PD← (ETemp)-(31C);
StkP← spAC1, Branch[.+2, ALU<0];
J340x:Fetch← T, FlipMemBase, Branch[JSRix]; * Not one of ours, do normal JSR
* After the dispatch, StkP addresses AC0, and T has the contents of AC1,
* which has just been sent through the ALU.
* ETemp saves the value of ID, required if a particular routine decides to
* exit to the software routine rather than doing the work itself.
ETemp← T, BigBDispatch← ETemp, T← MD; * Force memory op to finish
T← Stack&-1, Branch[IORz];* Leave FF free for placement
* Logical operations IOR, XOR, EQV: perform AC0 ← AC0 op AC1
IORz:Stack← (Stack) OR T, IFUJump[0],At[BcplZ340X, 00]; * 340
XORz:Stack← (Stack) XOR T, IFUJump[0],At[BcplZ340X, 01];
EQVz:T← NOT T, Branch[XORz],At[BcplZ340X, 02];
* Multiply and divide: let the standard runtime do these, as they
* are complicated and relatively infrequent.
T← ETemp, Branch[J340x],At[BcplZ340X, 03]; * Mult
T← ETemp, Branch[J340x],At[BcplZ340X, 04]; * DivRem
T← ETemp, Branch[J340x],At[BcplZ340X, 05]; * DivRem
* AC0← AC0 lshift AC1 (note that AC1 can be negative)
LSHz:PD← (17S)-T, Branch[LSHneg, ALU<0],At[BcplZ340X, 06];
LSH1:T← T OR (40C), DblBranch[SHge20, SHls20, ALU<0]; * T..R
* AC0← AC0 rshift AC1 (note that AC1 can be negative)
RSHz:T← (0S)-T,At[BcplZ340X, 07];
PD← (17S)+T, Branch[RSHneg, ALU>=0];
RSH1:T← T AND (37C), DblBranch[SHge20, SHls20, ALU<0]; * R..T
SHge20:Stack← A0, IFUJump[0];
SHls20:T← LSH[T, 10];
T← A0, ShC← T;
Stack← ShiftNoMask[Stack], IFUJump[0];
* Negative shift count, use other shift routine
LSHneg:PD← (17S)+T, Branch[RSH1];
RSHneg:PD← (17S)-T, Branch[LSH1];
* Branch: "switchon" implemented by dispatch.
* Calling sequence:
*JSR @350;with switchon value in AC0
* value of last case
* number of cases
* lastTarget-.
* ...
* firstTarget-.
*return here if out of range, AC0 unchanged
Brnchz:Q← PCX’,At[BcplZ340X, 10]; * 350
T← (NOT Q) RSH 1;
T← (RCODE)+T+1;* T← PC+1
ETemp← (Fetch← T)+1;* Fetch last case value
ETemp← (Fetch← ETemp)+1, T← MD;* Fetch number of cases
T← T-(Stack);* T← last case value - switchon value
PD← T-MD, Branch[Brnch1, Carry’]; * Test (lastCase-value) ge numCases
T← (ETemp)+T, Branch[Brnch2, Carry];
Brnchx:ETemp← Fetch← T;* In range, fetch self-relative ptr
Brnch1:T← (ETemp)+MD, FlipMemBase, Branch[JMPx];
Brnch2:T← (ETemp)+MD, FlipMemBase, Branch[JMPx];
* Lookup: "switchon" implemented by table lookup.
* Calling sequence:
*JSR @351;with switchon value in AC0
* number of cases
* case value 1
* target1-.
* ...
* case value n
* targetn-.
*return here if not found, AC0 unchanged
Lookz:Q← PCX’,At[BcplZ340X, 11];
T← (NOT Q) RSH 1;
T← (RCODE)+T+1;* T← PC+1
ETemp← (Fetch← T)+1;* Fetch number of cases
ETemp← (Fetch← ETemp)+(2C), T← MD; * Fetch first case value
PD← T-(Cnt← T)-1;* Force ALU#0 on first iteration
* Inner loop: have fetched one case value ahead, and ETemp is advanced by 2.
* Note that the ALU=0 branch tests the result of the previous iteration.
ETemp← (Fetch← ETemp)+(2C), T← MD, Branch[Lookm, ALU=0];
PD← (Stack)-T, Branch[.-1, Cnt#0&-1];
* Ran out of cases, return at table end.
T← (ETemp)-(5C), Branch[GFDon2]; * GFDon2 will add 1 and go to JMPx
* Found matching case, do self-relative jump to corresponding target.
Lookm:T← (ETemp)-(5C), Branch[Brnchx];
* Operations that we let the software do
T← ETemp, Branch[J340x],At[BcplZ340X, 12]; * Util
T← ETemp, Branch[J340x],At[BcplZ340X, 13]; * Finish
T← ETemp, Branch[J340x],At[BcplZ340X, 14]; * Abort
* LongJump
* Calling sequence:
*JSR @355
* target-.
LongJz:Q← PCX’,At[BcplZ340X, 15];
T← (NOT Q) RSH 1;
T← (RCODE)+T+1, Branch[Brnchx];* T← PC+1, go jump to T+@T
* Operations that we let the software do
T← ETemp, Branch[J340x],At[BcplZ340X, 16]; * GetLV
T← ETemp, Branch[J340x],At[BcplZ340X, 17]; * MulPlus
* Store partial-word field into a structure.
* Calling sequence:
*JSR @360 or 361
* mask
*returns here
* SNQ0 executes @AC1 ← (@AC1 & not mask) % (AC0 & mask)
* SNQ1 executes @AC0 ← (@AC0 & not mask) % (AC1 & mask)
SNQ0z:Q← PCX’, StkP+1,At[BcplZ340X, 20]; * 360
ETemp← Fetch← Stack&-1, Branch[SNQx]; * Fetch @AC1
SNQ1z:Q← PCX’,At[BcplZ340X, 21];
ETemp← Fetch← Stack&+1;* Fetch @AC0
SNQx:T← (NOT Q) RSH 1;
T← (RCODE)+T+1;* T← PC+1
Fetch← T, T← MD;* Fetch mask
T← T AND NOT MD;
Stack← (Stack) AND MD;
T← T OR (Stack);
Store← ETemp, DBuf← T, Branch[DoSkip];
* Load byte from array.
* LY01 loads the AC1th byte from the array pointed to by AC0
* and returns it right-justified in AC0 (note that AC1 may be negative).
* LY10 does the same, but with the roles of AC0 and AC1 interchanged.
LY01z:ETemp← T, Branch[.+2],At[BcplZ340X, 22];
LY10z:ETemp← Stack&+1,At[BcplZ340X, 23];
T← (ETemp) ARSH 1;* T← array word offset
T← (Stack)+T;* T← address of word
Fetch← T;
T← MD, ETemp, Branch[.+2, R odd];
Stack← RSH[T, 10], IFUJump[0];* Left (even) byte
Stack← T AND (377C), IFUJump[0]; * Right (odd) byte
* Store byte into array.
* SY01 stores the byte now contained in frame temp 3 (AC2!3) into
* the AC1th byte of the array pointed to by AC0.
* SY10 does the same, but with the roles of AC0 and AC1 interchanged.
SY01z:ETemp← T, StkP+2,At[BcplZ340X, 24];
T← (Stack&-2)+(3C), Branch[SYxx];
SY10z:ETemp← Stack&+2,At[BcplZ340X, 25];
T← (Stack&-1)+(3C);
SYxx:Fetch← T;* Fetch AC2!3
T← (ETemp) ARSH 1;* T← array word offset
T← (Stack)+T;* T← address of word
Fetch← T, ETemp← MD, Branch[.+2, R odd];
ETemp← DPF[ETemp, 10, 10, MD], Branch[.+2]; * Left (even) byte
ETemp← DPF[ETemp, 10, 0, MD];* Right (odd) byte
Store← T, DBuf← ETemp, Branch[NoSkip]; * Wait 1 cycle due to HW bug
* Return
* Executes AC2← AC2!0; PC← (AC2!1)+1
Returnz:
StkP+2,At[BcplZ340X, 26];
Fetch← Stack;
Stack← MD, T← MD+1;
Fetch← T, FlipMemBase;
T← MD+1, Branch[JMPx];
* StoreArgs: should never be executed, as GetFrame always skips over it.
T← ETemp, Branch[J340x],At[BcplZ340X, 27];
* GetFrame
* Calling sequence is:
*STA 3 1 2
*JSR @370
* frame size
* JSR @367; Call to StoreArgs, never executed now
*first instruction of procedure
* If a stack overflow occurs, control goes to @370, the procedure that
* would have been called if this microcode hadn’t gotten into the act.
* Entry conditions: MemBase=AEMBR0, StkP = spAC0
GetFramez:
Q← PCX’, StkP+2,At[BcplZ340X, 30]; * 370
T← (NOT Q) RSH 1;
T← (RCODE)+T+1;* T← PC+1
Fetch← T, ETemp3← 335C;* Fetch frame size
Fetch← ETemp3, ETemp3← T, T← MD; * Fetch stack min, save PC+1 of JSR
T← T+(2C);* T← Frame size +2
T← (Stack)-T;* T← new frame base
PD← T-MD;* Test for stack overflow
ETemp← (Stack)+1, Branch[BStkOv, Carry’];
* No stack overflow. Proceed to plant return link and store args.
ETemp← (Fetch← ETemp)+(2C);* Fetch saved PC from caller’s frame
Stack← Store← T, DBuf← Stack, T← MD; * Store return frame link
Fetch← T;* Fetch number of args
T← (Stack&-2)+(4C);* Point to word 4 of new frame
T← (Store← T)+1, DBuf← Stack&+1, Stack&+1← MD; * Store AC0 in word 4,
* AC0← number of args
ETemp1← (Store← T)+1, DBuf← Stack&-1; * Store AC1 in word 5
* See whether there are 3 or more args.
* If exactly 3 args, store old frame +3 in new frame +6.
T← (Stack)-(3C);
Fetch← ETemp, Branch[GFDone, ALU<0]; * Fetch old frame +3
T← MD, PD← Cnt← T;* Cnt← number of args -3
Store← ETemp1, DBuf← T, Branch[GFDon1, ALU=0]; * Branch if 3 args
* More than 3 args, store the 3rd and succeeding args.
ETemp← (ETemp)+T;* Old frame + 3 + extra args offset
ETemp← (Fetch← ETemp)+1;* Store args starting at new frame +6
ETemp1← (Store← ETemp1)+1, DBuf← MD, Branch[.-1, Cnt#0&-1];
* Done, set PC to first instruction of called procedure and resume execution.
T← (ETemp3)+1, Branch[.+3];
GFDone:T← (ETemp3)+1, Branch[.+2];
GFDon1:T← (ETemp3)+1;
GFDon2:T← T+1, FlipMemBase, Branch[JMPx]; * MemBase← CODE, go perform jump
* Stack overflow, execute JSR @370 and let normal runtime handle it.
BStkOv:T← 370C, Branch[JSRixf];