github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-27 01:09:49 +00:00
Code Issues Releases Wiki Activity

KL10 microcode.

Browse Source 
Plus assorted KL10-related documents.
This commit is contained in:
Lars Brinkhoff
2018-06-11 10:12:23 +02:00
parent d5ad381a90
commit 6d577568a2
30 changed files with 8840 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@@ -10,10 +10,10 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \
spcwar rwg libmax rat z emaxim rz maxtul aljabr cffk das ell ellen \
jim jm jpg macrak maxdoc maxsrc mrg munfas paulw reh rlb rlb% share \
tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \
draw wl taa tj6 budd sharem
draw wl taa tj6 budd sharem ucode
DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
xfont maxout
xfont maxout ucode moon
BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys moon \
graphs draw datdrw fonts fonts1 fonts2 games macsym maxer1

8
build/misc.tcl
View File

@@ -819,6 +819,14 @@ respond "*" ":link sys1;ts acnvrt,sysbin;cnvrt bin\r"
respond "*" ":midas kshack;ts micro_micro\r"
expect ":KILL"
# KL10 microcode.
respond "*" ":micro ucode;u1=ucode;its,define,macro,basic,skpjmp,shift,arith,fp,byte,io,eis,blt\r"
expect ":KILL"
respond "*" ":ucnvrt ucode; u1\r"
expect ":KILL"
# Write the RAM file to the front end filesystem:
# :klfedr write ucode;u1 ram
# XXFILE
respond "*" ":midas sysbin;xxfile bin_sysen1;xxfile\r"
expect ":KILL"

144
doc/moon/klproc.11 Normal file
View File

@@ -0,0 +1,144 @@
.device xgp
.font 1 "lspman;30vr1"
.font 2 "fonts;36vbee"
.font 3 "lspman;30vri1"
.select 1
.!xgpcommands_";topmar 0;botmar 0;ffcut 1"
.paper size 50000,8500;
.page!height_2000; page!width_70;
.evenleftborder_1400; oddleftborder_1400
.page frame page!height high page!width wide;
.area text lines 4 to page!height
.place text
. << 1-1/2" margins all around >> << well... >>
.turn on "" for "%", "", "{", "" for "\", ""
. <<  font,  move over,  tab,  flush right,  fill chr >>
{date}
.break skip 2
.once center select 2
I.T.S. CRASH PROCEDURE
.skip 500 mills
Find the CRASH LOG book and record the particulars, including
the date, the time, your name, the message that was printed
on the system console, and anything else that seems relevant.
If the message on the system console is anything other than "KL10 HALTED..."
don't do anything; get a system hacker. If you don't understand the
rest of these directions, don't do anything. Get a system hacker
or leave it down.
If the message was "KL10 HALTED...",
type DDT <return>. The console should type out
a greater than, period, carriage return. You are now in exec DDT.
Type <letter A> <equals> to get the symbol table. Type the PC number that was
in the KL10 HALTED message and an underscore to get the symbolic location
of the crash. Determine the cause of the crash. If you don't know
how to do this, then don't worry about it.
If you think the crashed system needs to be saved so a system hacker
can look at it, type <altmode> Y and wait for a space to echo.
Then type CRASH <space> 3name1 <return>, where 3name1 is a suitable
name based on where it halted. You can use CTRL/F to list the directory
and find what names have already been used.
Now execute the 3Warm Boot1 procedure. If it fails, try a 3Cold Boot1.
.break skip 1500 mills
.once center select 2
PROCEDURE FOR BRINGING DOWN I.T.S.
.skip 500 mills
Find a console and type control-Z. ITS responds with its greeting.
Type :LOGIN DEC <return> (if you are from DEC); otherwise login with your normal
user name. Note that this command begins with a colon.
Alternatively, borrow the console of a user who is already
logged in.
Type :LOCK <return>. Type 5DOWN. No carriage return is necessary.
Answer the questions. (The "5" is the number of minutes before shutdown.)
ITS will now type a "going down" message on all consoles. If
all users, including you, log out (by typing control-Z and :LOGOUT) the system will go down right away.
After it types "ITS NOT IN OPERATION" the lights on the memories will
blink for a while, then the system console will type a carriage return.
You are now in exec DDT. Hitting break then control-C will get you to KLDCP.
.break skip 1500 mills
.once center select 2
COLD BOOT PROCEDURE
.skip 500 mills
This procedure is to be used to restart ITS after running
diagnostics or the DEC system, after a power failure,
or after the warm boot procedure has been tried and found wanting.
Make plenty damn sure the right disks are mounted. Currently
"ITS PK0 #0 + KLDCP" should be on unit 0, not write-protected,
"ITS PK1 #1" should be on unit 1, not write-protected, and
"ITS SECONDARY PACK #13" should be on unit 2, not write-protected.
If there was a power failure, some circuit breakers may need to be reset.
Push stop on disk unit 0, wait until it stops spinning, then
open the back and turn "CB1" (lower right corner) off and on.
Then push start. If there are no lights lit on the disk DF10C
(second box from the left on the right-hand side), open its rear door
and reset the white circuit breaker near the bottom of the inside
of the door. Check the
3fault1 light on the KL10. If it is on, open the rear door
of the right-hand KL10 cabinet and check the fault lights on
the power control. (Column of LED's near the bottom of the cabinet.)
Push the DISK button on the KL10, to reload KLDCP.
If it doesn't work, check the top of the ENABLE switch is pushed in.
If this fails, try doing the preceding paragraph.
If it wins, "DECSYSTEM10 DIAGNOSTIC CONSOLE" will be typed out on
the system console.
Type RP0 <return>.
Type J <space> KLINIT <return>.
Wait for a <greater than> <period> prompt. (Several lines will be typed
out first.) If a "2-way interleave" note is on the console, use KLINI2
instead of KLINIT.
If, while running KLINIT you get a message such as ?10 ERR ADR=nn COR=nn ACT=nn
there is probably a failing memory. Get help.
Type J <space> NTSDDT <return>. If this responds with
I NTSDDT <return> <return>, then
you are winning and exec ddt is now running. Otherwise, get a system
hacker.
Reload the I/O pdp11 by typing <altmode> L BOOT11 <return>, wait for
blank line, type <altmode> G, wait for blank line. If you get file not
found (FNF), try <altmode> L <period> <semicolon> BOOT11 <return>.
Continue with the warm boot procedure.
.break skip 1500 mills
.once center select 2
WARM BOOT PROCEDURE
.break skip 500 mills
Type <altmode> L 3sys1 <return>, where 3sys1 is the name
of the current system, which will be found on a punch card on the LA36.
Type <altmode> G. It should reply "SALVAGER.nnn", then
after a half minute it should say "ITS IN OPERATION".
If it says "*** ERROR SYSTEM MAY NOT BE BROUGHT UP ***",
or any other ominous error message, do not attempt
to do anything further. Get a system hacker.
If it types "ITS IN OPERATION" but then doesn't seem to do anything
further, you may need to reload the I/O pdp11. See the Cold Boot procedure.
Usually it types out "IT IS NOW ..." and the date and time. If the
.<<fuck you PUB, you eat shit>>
machine has been powered off, it will ask you to enter the date and time.
If this happens, or the date or time it prints is way off (shouldn't happen),
you can set the time by going to the Data Point and hitting control Z.
When you get the greeting, type :LOGIN <space> PDSET <return>.
Type the date in the form "3yymmdd1D". Type the time in the form
"3hhmmss1T". Type <exclamation point> <period>. Type Q <period>.
Note that the system console will type out the date, time, and day of
the week. Be sure to check this to verify that you got it right.
.break skip 300 mills
.comment


30
doc/sysdoc/kl.hung Executable file
View File

@@ -0,0 +1,30 @@
Copyright (c) 1999 Massachusetts Institute of Technology
See the COPYING file at the top-level directory of this project.
------------------------------
Date: Sat, 14 Jul 84 02:43 EDT
From: David A. Moon <Moon at SCRC-STONY-BROOK.ARPA>
To: alan at MIT-MC.ARPA
cc: bug-its at MIT-MC.ARPA
Re: ITS seemed to be looping
Things to try:
Raise switch 0 (the switch 0 on the left). If this goes to DDT, it's
taking clock interrupts.
Hit Break and type PC <return>. If I remember correctly, you can read
the PC this way without halting the machine. There are some other status-type
commands; PCF is the PC flags, PI is the interrupt status.
Hit Break and type SP <return>. This stops the machine cleanly (between
instructions). If this works, the microcode isn't looping. Now you can
get the PC then type DDT (or ST 774000) to get into DDT and decode that PC.
If the microcode is looping the SM command will restart it. This also does
nasty things like resetting the I/O bus. I think it preserves the PC though.
There is a command file, J KLHUNG, which prints out everything in sight. 90%
of what it prints is worthless, but it includes micro and macro PCs.
I believe there is a piece of paper taped to the machine that tells you to
do J KLHUNG. Of course there are a lot of pieces of paper taped to the machine!

55
doc/sysdoc/kl10.flklor Executable file
View File

@@ -0,0 +1,55 @@
Copyright (c) 1999 Massachusetts Institute of Technology
See the COPYING file at the top-level directory of this project.
------------------------------
KL10 Folklore
Sometimes an MF10 memory gets hung. Often the INC RQ light will be
on. Sometimes raising the RESET switch inside the memory's front door
will help; sometimes a module in the port control is fried. (Any of
several modules.)
TU41 blower belt has to correct belt, has to not be worn out, and has
to have pulleys aligned. Otherwise it drops off or breaks and tape
rotates backwards.
RP04 oscillating seeks & Maytag mode when loading => tachometer output
needs to be adjusted.
When powering machine back on, circuit breaker in disk DF10 may trip.
When powering machine back on, sometimes disk #0 needs to be stopped,
powered off and on, and started again, to reset the two-massbus
switch.
If DECtape motor doesn't win, may be G848 seating problem.
If kicking the LA36 causes power fail, "power warn" lead to top left
edge of CPU backplane needs to be disconnected. (Apparently the other
end is unconnected.) [Missing ECO in 863.]
Bad door-open switches (?) in MF10. Memories have to be operated with
over-ride turned on.
Apparently power supplies in CPU and IO box can drift voltages.
Apparently air-flow sensors can fail sporadically. I am told that
disconnecting one => indication of good airflow.
RP04 attention/error conditions are super-random.
Often mysterious marginality is caused by bad seating of modules.
CONO'ing a PI channel off doesn't necessarily prevent it from
interrupting. It works to have each interrupt routine do CONSO to make
sure the channel is enabled, and dismiss if not.
Before running a memory diagnostic, do PE0, because the memory
diagnostics don't know how to handle parity faults.
MF10's always fail solidly.
Obscure cases in the microcode tend to have bugs. E.g. you could
interrupt out of a PI cycle, hence BLKI/BLKO as interrupt instructions
tended to be flakey.

15
doc/sysdoc/kl10.info Executable file
View File

@@ -0,0 +1,15 @@
Copyright (c) 1999 Massachusetts Institute of Technology
See the COPYING file at the top-level directory of this project.
------------------------------
MOON@MIT-MC 11/17/75 17:30:16 Re: HANDY THINGS TO KNOW ABOUT KL10
To: [.INFO.;KL10 INFO] at MIT-MC, MOON at MIT-MC
[1] WHEN RUNNING MEMORY DIAGNOSTICS, USE 'PE' COMMAND
TO TURN OFF PARITY CHECKING.
[2] WHEN RUNNING ANY DIAGNOSTIC, EVEN THE 'DG' SERIES,
YOU HAVE TO 'P U.RAM'.
[3] WHEN RUNNING DDDFA THE CHANNEL HAS TO BE IN KA
MODE. THIS IS A BUG IN THE PROGRAM.
[4] WHEN POWERING THE SYSTEM ON, THE LAST THING TO BE
TURNED ON HAS TO BE RP04 #0. OTHERWISE THE PDP11 CAN'T
ACCESS THAT DISK FOR SOME REASON.


BIN
doc/ucode/1proc.plan Executable file
View File

Binary file not shown.

104
doc/ucode/u126.doc Executable file
View File

@@ -0,0 +1,104 @@
U.DOC -- Third release, edit 126
January 16, 1976
Copyright 1976, Digital Equipment Corp., Maynard, Mass.
1.0 SUMMARY
1.1 Edit version 126 is the third release of U, the KL10
microcode.
1.2 U is not dependent on any monitor, but because of
hardware differences between the various -10
processors, a monitor must be built specifically for
the KL10. It has been tested with the 6.02 monitor
and the TOPS-20 version 1 monitor. U has no DATE75
dependencies.
The following are known deficiencies in U 126:
U 126 will not work correctly with processor
revision levels less than 6. This will not
ordinarily be a problem, because this release is part
of rev 7a and rev 8, and should therefore be applied
to machines already at rev 6; if there is any doubt
whether a machine has been kept up to ECO level,
however, customers should check before installing U
126. The symptom of this failure is that the PC
doesn't get loaded if a page failure occurs on an
instruction fetch, and therefore the instruction
which preceeded the page failure gets performed again
on return from the page fault handler.
If rev 8 is installed U 126 is necessary.
KLpaging does not work with the cache on, because
there is too much time from "REQ SV.VMA" till
"RETURN0". the fix (as yet untested or installed):
=0
PGRST2: BR/AR,AR_ARX,
ARX_SV.ARX,J/PGRST3
BR/AR,AR_ARX,SC_-SC-1,
ARX_SV.ARX
PGRST3: REQ SV.VMA
SET ACCOUNT EN,RETURN0
This bug does not matter for 2040 machines (they have
no cache) and thus there is no need to fix it in this
release. It will be fixed in the next release.
The code which performs START and CONTINUE
functions on leaving the HALT loop is incorrectly
coded, in that it sets the interrupt inhibit flag for
one instruction. This results in a processor hang at
WGRANT if there is an interrupt request up when the
processor is continued, and the first instruction
after the continue is an i/o instruction. This
should be fixed in DEFINE.MIC by setting SPEC
INSTR/CONT=0. This fix has received only minimal
testing. It will be fixed in the next release.
U.DOC -- Third release, edit 126 Page 2
The following problems have been fixed:
Race if page fail occurs while writing FM.
microcode patch eliminates most probable cause, which
is page fail at nicond time while writing ac other
than 0. it does not take care of the possibility
that cond/fm write will glitch at instr 1777 time.
Fixes in several places to set and clear account
enable so as to get repeatable accounting measures of
useful work done. the enable is now cleared for
meter update cycles and KL page refill cycles. the
hardware already takes care of PI cycles.
Spec change to exit from halt loop, so that
AR0-8=0 with AR9-35 non-zero loads AR into PC to
start processor. this is different from executing
JRST because PC flags are cleared.
Fix EIS to tolerate page fail on read of fill byte
in MOVSRJ or binary to decimal conversion.
Integrate opcode counting/timing code under
conditionals.
Fix parity error code to writeback AR on read
pause write error.
Rewrite of DDIV, so that the no-divide test is on
the most significant half of the magnitude of the
dividend, rather than the magnitude of the most
significant half. in the process, save time and
space. Also put in conditional assembly variable
"WRTST" to inhibit write test cycle for instructions
which appear not to need it, and thus to speed them
up.
Fix the S-bus diag instruction. (It was page
faulting on the register function.)
Recode string compare to save space and time.
change defaults for KLpaging to include EIS, exclude
tracks feature. change KLpaging (new spec) to keep
"logically writable" in software bit. recode
KLpaging to eliminate problem of writing hardware
page table before checking for age trap, and
therefore leaving the page accessible after the trap.
The recoding also improves the algorithm in that the
hardware entry includes the W bit set if the core
tables allowed write and the CST indicates written,
even if the current reference was not a write.
Also fix code which writes page table directory,

336
doc/ucode/ucode.bugs Executable file
View File

@@ -0,0 +1,336 @@
ED@MIT-MC 10/24/79 00:42:03
To: (BUG ITS) at MIT-MC, (FILE [UCODE;UCODE BUGS]) at MIT-MC
On MC, single-instruction proceed still loses if the
instruction page faults on fetch. Doing
100/ jrst 2000
2000/ jrst 4000
...
30000/ jrst 0
1000G
100>> JRST 2000  results in:
0>> 0 note that 0, being swapped IN, doesn't execute.

MOON@MIT-MC 05/23/78 22:05:31
In case you were wondering, the very sporadic lossage where
XCT @(P) executes a random illegal instruction still happens.
Probably XCT FDTB(CH) still loses also. Sigh.

MOON@MIT-MC 05/08/78 14:56:33
REVISION 10 FCO SUMMARY
M8530-3 MAKE 'PHYS REF' ENABLE LOADING OF VMA<13-17> (HOORAY!)
M8524-4 MAKE 'COND/INSTR ABORT' IOR 'TRAP CYC N' INTO 'TRAP REQ N' (HOORAY!)
M8513-7 FIX CACHE PARITY ERRORS IN TOPS20 RELEASE 2 (HO HUM)
M8560-2 SBUS TERMINATION PROBLEMS (ZZZ)
M8558-3 DITTO (ZZZ)

MOON5@MIT-MC 03/10/77 20:26:58 Re: REVISION 9A CONTINUED
ALSO, THE M8563 DMC BOARD IS MODIFIED. DMC5 LOC D5
CHANGES LOGIC FOR 1 BUS MODE READ-PAUSE-WRITE (I THINK).

MOON5@MIT-MC 03/10/77 13:51:34 Re: REVISION 9A
(1) ON M8517 MB BOARD, BUFFER CCL CCW BUF WR (BIG DEAL)
(2) ON M8552 DTE20 DPS5 LOC B5 PUT DPS5 TO10 I BIT
DIRECTLY INTO 7432 INSTEAD OF THROUGH FLIP FLOP.
(3) ON M8553 DTE20 CNT CHANGE AROUND TO11 BYTE COUNT
LOGIC IN OBSCURE WAYS, ALSO DELETING SOME UNIBUS
PARITY CRAP.
(4) ON M8554 DTE20 INT2 LOC B4, CLEAR CLK RUN ON TIMEOUT.
ALSO REPLACES THIS 74H74 WITH ANOTHER ONE.
INT1 TOP CENTER AND RIGHT GENERATE MST CLR FROM
PWR FAIL FROM UBUS AC LO.
ALSO CHANGE SIGN OF INPUT TO 9601 AT B3 ON INT2.
NO MICROCODE IMPLICATIONS. DOES THIS MAKE BYTE
TRANSFER MODE WORK OR SOMETHING?

MOON5@MIT-MC 02/24/77 01:51:11
REVISION 9 (PUT IN TODAY) FIXES WRITING OF BAD PARITY INTO
FAST MEMORY BY GLITCH AT PAGE FAIL (CLK SBR CALL).

MOON5@MIT-MC (Sent by ___002@MIT-MC) 02/24/77 01:15:22
INSTR AT PIBYTE+2 SHOULD HAVE MQ*4 NOT MQ*2
DOESN'T APPLY TO ONE-DTE20 MACHINE PROBABLY

MOON 1/28/77
tried the jpc code again. jumpn tt,(f) caused a page fault
with code of 0 when it shouldn't have (page jumped to was
set up rd only in map in core). theory is that this
is caused by more than 6 ticks between jump fetch and nicond.
can't see right now how to bum jpc code to be faster.

MOON 9/28/76
[1] One/proceed page-fault problem will be fixed in Revision 10,
by changing the SCD board to IOR the trap cyc flags back into the
trap req flags instead of jamming them. This is a kludge, but it looks
like it will work.
[2] Tonight teco has been bombing out in various ways.
Once it looked like P was clobbered to 0, another time to a PC
that had problem been POPJed back to.
-- SEE NEXT, MAY BE FIXED

RMS@MIT-MC 09/17/76 22:16:12 Re: MC hardware lossage.
To: MOON at MIT-MC
An XCT FDTB(CH) with CH/ 123 executed something equivalent to
64240,,507665 instead of what was located at FDTB+123/ JRST FSET.
There were about 60 words in the job that would address-compute to
that value. FDTB 123= 27751. None of those words containing
the suitable garbage were at addresses = 751 mod 1000, but
104751 was off by only 10 .
-- THIS WAS AN I.T.S. BUG, FIXED. (PFA6++)
 MOON@MIT-MC 08/19/76 04:51:44 Re: One proceed lossage on KL
To: KLH at MIT-MC
CC: [UCODE;UCODE BUGS] at MIT-MC, GLS at MIT-MC
I've tracked this down. It happens whenever you one-proceed an instruction
that jumps into (or drops into) a page that's not swapped in. There is this
horrible design error in the machine where in this case the PC gets advanced
to point to the instruction that lost, but the flags in LH(PC) [including
one proceed] don't get advanced. So then the flags are one instruction
behind, and you get "two proceed". You can probably get N-proceed by making
a chain of jumps into successive swapped-out pages.
I don't see any easy (or even moderately hard) way to fix this in the
microcode without breaking something else. (A few months ago I put in
a change which it turns out was only fixing one symptom of this problem.)
We have some hardware changes due to be put in in a week or two that
supposedly fix all outstanding problems; I'm going to try and find out
if they fix this one or if not what can be done about it.
-- SEE ABOVE, TO BE FIXED REV. 10.

MOON@MIT-MC 07/07/76 16:06:48 Re: HANGING AT PG4++ GETTING EBUS
SET PI CYCLE SETS CON INT DISABLE. CON CLR PI CYCLE, WHICH
IS HOW PI CYCLES THAT DO BLKO AND PNTR DOSN'T OVERFLOW GET
CLEARED, FAILS TO CLEAR CON INT DISABLE. NORMALLY THE NICOND
ON THE FETCH OF THE INTERRUPTED INSTRUCTION CLEARS IT, BUT
IF THERE IS A PAGE FAIL ON THAT INSTRUCTION, IT DOESN'T GET
CLOCKED. HOWEVER, PAGE FAILS MUSTN'T CLEAR CON INT DISABLE,
ONLY PAGE FAULTS. IDEALLY, IT SHOULD BE CLEARED AT PFT,
BUT # ISN'T AVAILABLE. I'LL ADD AN ADDITIONAL INSTRUCTION
AT PFT.
-- FIXED UCODE

7/1/76 UPDATED TO DEC VERSION 126 (RELEASE 3, REV 8)
TRIED HACKING JPC TO AVOID FM PARITY ERRORS,
BUT I CAN'T WIN. LOSES ON AN AOBJP THAT JUMPS AND
PAGE FAILS. SIGH. JUST GOTTA GET THE HARDWARE FIXED.

6/9/76
JRST 12, CHOOSES WHETHER TO SET THE USER OR THE EXEC
JPC BY THE RESTORED USER-MODE FLAG RATHER THAN BY THE
ONE AT THE BEGINNING OF THE INSTRUCTION. SEE BRJMP.
[FIXED 6/9/76]
^_
MOON@MIT-MC 06/09/76 03:48:51
TRIED FIXING THE ABORT INSTR LOSSAGE BY MAKING
JRST 12, DO ARX_MEM BEFORE THE NICOND SO AS TO HAVE
CONTROL OVER WHERE THE INSTR HAS TO GET ABORTED FROM.
BUT SINCE THE FLAGS HAVE BEEN SET ALREADY WE BETTER
SET THE PC TOO, BUT THAT BRINGS US RIGHT BACK TO
THE SAME OLD LOSSAGE WITH ABORT INSTR. GRUMBLE!
NEED SOME HACK HERE TO TOUCH THE FROB BEFORE SETTING
THE FLAGS OR SOMETHING...
[WILL TRY DOING IT WITH THE SR INSTEAD. 6/9/76]
[COMPLETE WINNER, 6/10/76]

Date: 8 JUN 1976 0310-PDT
From: Jeff Rubin (JBR @ SU-AI)
Subject: FM Parity Mod
To: moon @ MIT-MC
In our machine there is an OR gate on the CON5 page producing CON FM WRITE PAR L.
The input to this gate is on pin 9 and comes from E62(14) (CON FM WRITE 18-35 H).
This is changed so that pin 9 comes from -CLK SBR CALL L on pin FN1, pin 10 comes
from E62(15) (CON FM WRITE 18-35 L) and pin 11 comes from -CON CLK B L. The output
is changed to E57(7). The gate is now drawn as an active low AND. In order to
free up connector pin FN1, CON MBOX WAIT H is deleted from FN1 (was not used).
The terminator that was on E57(9) remains there and terminates -CLK SBR CALL L.
The terminator on the CTL1 page on -CLK SBR CALL L is deleted. Finally, a twisted
pair is added from CTL1 4A36F1 (-CLK SBR CALL L) to CON5 4F35N1.
I don't exactly see why they bothered to gate the signal with the clock since
in our machine at least, it is already gated with the clock on the APR page
at the input to the RAM. The real fix, I think, is that when the CLK page causes
a CLK INSTR 1777, it causes the CRAM to thrash while the clock is low (i.e. CON
FM WRITE PAR is enabled) and a glitch on the write parity signal gets through to
the RAM.
-------

Date: 5 JUN 1976 2236-PDT
From: Jeff Rubin (JBR @ SU-AI)
Subject: FM parity errors
To: moon @ MIT-MC
I installed a mod that Eggers told me over the phone and it seems to
have cleared up our FM parity error problem. We have only run for about
1 1/2 hours since installing the mod but no parity error in that time.
If you want I can send you a description of the mod, although I'm not
sure what differences there are between our machines in the same area.
-------

Date: 1 JUN 1976 2330-PDT
From: Jeff Rubin (JBR @ SU-AI)
Subject: KL10 ARX parity errors
To: moon @ MIT-MC
I noticed that your microcode ignores ARX parity errors. I recently discovered
one cause of them and was wondering if you had discovered the same thing. Ours
was caused by executing an instruction in the last location of a page when the
mapping information for the next page is not yet in the page table ram and the
A field of the D ram for the instruction is I-PF. It starts the prefetch and
gets a page fault due to no PT DIR match. But the EBOX continues to execute
microcode and doesn't do an MB WAIT right away. When the MBOX gets the page fault
it sets CLK MBOX RESP which loads the ARX with a bad parity zero and also sets
CON ARX LOADED. There is a term called CLK INSTR 1777 which attempts to hold
off CON ARX LOADED, but it isn't set until the EBOX does an MB WAIT which causes
CLK PAGE FAIL which eventually sets CLK INSTR 1777. I called Eggers and he
said he hadn't heard of this bug before.
Yes, indeed, we have made quite a bit of progress running the system on the
KL. We are currently being hacked by some (prbably software) bug having to do
with turning on cacheing for a job and by FM parity errors. Eggers told me
of one way that he heard FM parity errors can be caused, but I haven't checked
it out yet.
-------
KLH@MIT-AI (___022) 06/04/76 03:00:16
PUSHJ P,FOO AND ^N PROCEEDED FOR TWO INSTRUICTIONS!!

MOON5@MIT-MC 06/04/76 00:01:29
ONE PROCEED DOES INFINITE
PROCEED IF PAGE FAULT ON THE INSTRUCTION.
THIS IS A HARDWARE BUG - PGF4+20 OR SO DOES "ABORT INSTR",
WHICH RESETS THE TRAP FLAGS IN THE PC FROM THE TRAP CYCLE
FLAGS. HOWEVER, IF THE PAGE FAULT WAS ON THE INSTRUCTION
BEING FETCHED, THE DISP/NICOND FAILED TO CLOCK THE TRAP
CYCLE FLAGS FROM THE PC FLAGS. THE TRAP REQUEST BITS IN
THE PC FLAGS WERE STILL SET, BUT THE ABORT INSTR CLEARED
THEM. ABORT INSTR SHOULD NOT BE DONE IF THE PAGE FAULT
CAME FROM NICOND. I'M NOT SURE HOW ONE DETECTS THAT.
ONE DETECTS THAT BY LOOKING AT THE "FETCH" BIT IN VMA.
SKIPPING THE ABORT INSTR IS HARD TO DO BECAUSE PFT MIGHT
DECIDE TO TAKE AN INTERRUPT INSTEAD. I TRIED TO UNABORT
THE INSTR BY DOING A DISP/NICOND WITH 1111 IN LOW J,
BUT THAT CLOBBERED THE PC TO THE ADDRESS OF THE PTW.
THIS MAY REQUIRE A HARDWARE MOD TO FIX.
[FIXED 6/9/76]

MOON@MIT-MC 05/30/76 16:10:30 Re: HANGING WAITING FOR EBUS
THIS APPEARS TO BE DUE TO ATTEMPTING TO GRAB THE EBUS
TO TURN OFF THE PI TO TAKE A PAGE FAULT WHILE CON INT DISABLE
IS SET, BUT CON PI CYCLE IS NOT SET. THE PI BOARD THINKS IT'S
OK TO INTERRUPT, BUT THE CON BOARD THINKS IT ISN'T, SO THE
PI BOARD GRABS THE EBUS TO GIVE AN INTERRUPT, BUT THE CON
BOARD WON'T ADMIT TO THE MICROCODE THAT THERE IS AN INTERRUPT,
SO UCODE HANGS WAITING FOR THE EBUS TO BECOME AVAILABLE.
AN EXTRA INSTRUCTION "CLR INTRPT INH" AT "PIFET" IN "IO"
HAS BEEN PUT IN AND WILL PROBABLY FIX THIS. (I THINK IF
YOU TAKE A DTE OR METER INTERRUPT, GO TO PIFET, PAGE
FAULT ON THE FETCH OF THE INSTRUCTION INTERRUPTED OUT OF,
AND TAKE ANOTHER INTERRUPT JUST THEN, WAS WHEN IT LOST.)
[FIXED 5/30/76]

MOON@MIT-MC 05/30/76 16:06:56 Re: POP AC,AC LOSES
FIXED 5/30/76.

MOON@MIT-MC 05/16/76 00:03:50 Re: MOVN CAUSES BAD PAGE FAILS
FIXED BY KLUDGING MOVN, MOVNI TO BE DIFFERENT FROM MOVNM
AND MOVNS AND SAVE A CYCLE (SIMILARLY FOR MOVM, MOVMI)

moon@MIT-MC 02/17/76 17:04:24
To: [UCODE;UCODE BUGS] at MIT-MC
CC: MOON at MIT-MC
When get no valid match on page fail, try clearing 8P instead
of 4P so as to get both valid bits set. Jud thinks this may
neutralize the paging bug.
[Done, 5/9/76]

MOON5@MIT-MC 02/13/76 23:19:33
OCCASIONAL LOSS OF TRAPS
[One proceed not setting %PSINH, lose if page fault, fixed 5/9/76]

MOON@MC 02/12/76 02:22:43
THE JPC FEATURE CAUSES FM PAR TO BE WRITTEN WRONG AT "AOJJPC:".
PUTTING IN A TIME/3T MAKES IT HAPPEN GROSSLY OFTEN.
I SUSPECT THE LOSS INVOLVES A PAGE FAIL ON THE ALREADY-STARTED
FETCH OF THE NEXT INSTRUCTION. SEE (CON4) CON AR 36, WHICH
SHOULD BE ZERO DURING WRITING INTO FAST MEMORY. WE'LL SEE WHAT
HAPPENS IN REV 7.
[Still loses, I think, 5/7/76]

MOON@MC 02/11/76 18:30:35
To: [UCODE;UCODE BUGS] at MC
CC: BUG-ITS at MC
CURRENTLY INSTALLED UCODE IS MISSING JPC FEATURE FOR SOME REASON.
ALSO, CAN'T ONE-PROCEED THROUGH A UUO THAT SYSTEM RETURNS TO USER.
HOWEVER, ONE PROCEEDING THROUGH AN LUUO WORKS. [Fixed]

MOON@MC 02/03/76 17:02:25 Re: PAGE LOSSAGE
1000-3000 LOSES
1000-3000-5000-7000 WINS
1000-3000-15000-17000 LOSES
THE PROBLEM IS THAT PAGE FAIL HOLD COMES ON AND GENERATES
PT DIR CLR, WHICH ENABLES BOTH VALID BIT RAMS (PAG3).
ABOUT 10-20 NANOSEC LATER, - PT MATCH COMES UP AND PF CODE
01 IN H COMES ON. THIS GETS STROBED INTO THE EBUS REGISTER
BY LOAD EBUS REG (CSH3), WHICH LASTS 40 NANOSEC STARTING
ABOUT 10 NANOSECONDS AFTER PF CODE 01 IN H COMES UP.
THIS DERIVES FROM PAGE FAIL T2, WHICH IS TOO LATE.
AS FAR AS I CAN SEE, THE ONLY WAY TO FIX THIS IS THE ORIGINALLY-
PROPOSED MOD TO THE PAG BOARD TO "AND" PAGE FAIL HOLD WITH
CON KI10 PAGING MODE IN THE GENERATION OF PT DIR CLR. REV.7
DOESN'T CHANGE THE TIMING SUFFICIENTLY.
DEC HAS BEEN INFORMED.

KNOWN BUGS/MISSING FEATURES IN ITS KL10 MICROCODE
FAST MEMORY PARITY LOSSAGE IN JPC MICROCODE.
I PUT A TIME/3T AT AOJJPC WHICH APPEARS TO HAVE FIXED IT
(WILL HAVE TO WAIT AND SEE IF ANY MORE FM PAR LOSSAGE
HAPPENS.) IF SO, A TIME/3T MAY HELP WITH THE NXT INSTR
LOSSAGE, TOO.
SEE MOON;CACHE LOSSAG. -- FIXED
PAGE LOSSAGE - 1000/ JRST 2000 2000/JRST 1000 DOES PAGE
REFILL EVERY 5 MICROSEC. CAN'T HAVE EVEN/ODD
PAIR IN PT AT SAME TIME. - PT MATCH IS COMING UP.
AS FAR AS I CAN TELL ALL THE RIGHT THINGS ARE GOING
INTO THE PT DIR; UNFORTUNATELY NOT EVERYTHING
COMES OUT TO THE BACKPLANE. FAILS ON BOTH
OF OUR COPIES OF M8520.
M.A.R. DOESN'T WORK
REV.7 SHOULD FIX THIS BY MAKING 'PF EBOX HANDLE' WORK.
ONE PROCEED
WORKS BUT STILL UNSOLVED IS THE PROBLEM OF LOSING
PDL OR ARITH OVERFLOW TRAP WHEN ONE-PROCEEDING.
J.P.C. -- WHEN TURNED ON, SYS WON'T RUN
APPARENTLY IT SCREWS UP WHEN IN USER MODE?
6 FEB 76 - SINGLE-JPC MODE WORKS! RING MODE
HAS NOT BEEN TESTED.
VECTOR INTERRUPTS OF THE BLKO VARIETY PICK
UP THE JSR FROM 40+2*N INSTEAD OF LOC+1.
THIS HAS TO BE FIXED TO MAKE THE IMPTERFACE WORK.
--> THIS HAS BEEN FIXED BUT NOT TESTED.
TURN ON UCODE STATE 01 AND UCODE STATE 03 DURING PAGE FAIL
TROUBLE WITH IMULI ? HAS THIS BEEN FIXED?

BIN
doc/ucode/ucode.info Executable file
View File

Binary file not shown.

367
src/ucode/arith.6 Executable file
View File

@@ -0,0 +1,367 @@
.TOC "ADD, SUB"
.DCODE
270: R-PF, AC, J/ADD
I-PFõ‚`ÃYñ2—Á‰D
RPW, M, J/ADD
RPW, B, J/ADD
.UCODE
=00****
ADD: AR_ARõPa°YAD/A+B,AD øÓ Ç§õ‘lI©
=
.DCODE
274: R-PF, AC, J/SUB
I-PF, AC,ñ2—Ó«B
RPW, M, J/SUB
RPW, B, J/SUB
.UCODE
=00****
SUB: AR_ACö !R_AR
= AR_AR-BR,AD FLAGS,EXIT
.TOC "MUL, IMUL"
.DCODE
220: R, ACõ‚e/“MUL
I, AC, J/ù3jÌ“
RW, M, J/IMUL
RW, B, J/IMUL
.UCODE
.IFNOT/IMUù’WO¡T
=00*01*
IMULI:
.IF/IMULI.ùô*
=00*000
IMULI: SKP AR18,GEN AC0,SIGNS DISP, ;OPTIMIZE SPECIAL CASE
TIME/3T,SC_#,#/17.
=010 MQ_AR,AR_AC0, ;HERE FOR IMULI OF + BY +
CLR ARX,FE_#,#/-9., ; 9 STEPS WILL DO
CALL,J/Mú³)Õ…
.ENDIF/IMULI.OPT
IMUL: MQ_AúK Ò¿AC0, ;M'IER Tùè&ÑY M'CAND TO AR
CLR ARX,øÑo£Y#/-18.,
CALL,J/MULSUB ;CALL MULTIPLY SUBROUTINE
.IF/IMULI.OPT
=110 AR_SHIFT,SKP AR NE,INH CRY18, ;HERE FROM IMULI
I FETCH,J/MUL1 ; AFTER SHORT MULTIPLY
.ENDIF/IMULI.OPT
SC_#,#/35.,SKP AR SIG ;CHECK OVERFLOW AND STORE
=
=1****0
IMUL2: AR_SHIFT,B WRITE,J/ST6 ;STORE LOW WORD OF PRODUCT
SET AROV,AR_SIGN,J/IMUL2 ;NOTE OVERFLOW...
.DCODE
224: R, DBL AC, J/MUL
I, DBL AC, J/MUL
RW, M, J/MUL
RW, DBL B, J/MUL
.UCODE
=00*000
MUL: MQ_AR,CLR ARX, ;MULTIPLIER TO MQ
AR_AC0,FE_#,#/-18., ;SETUP MULTIPLICAND AND STEP CNT
CALL,J/MULSUB ;AND GO TO SUBROUTINE
=100 GEN AR*BR,AD/AND,SKP AD0 ;M'IER NEG, CHECK M'CAND & PROD TOO
=110
MUL1: SC_#,#/35.,EXIT ;STORE DOUBLE RESULT
SET AROV,J/MUL1 ;MUST HAVE SQUARED 400000,,0
=
.TOC "MULTIPLY SUBROUTINE"
; ENTER WITH MULTIPLIER IN MQ,
; MULTIPLICAND IN AR!ARX, MINUS STEP COUNT IN FE
; RETURNS PRODUCT IN AR!ARX!MQ.
; RETURN 4, 6 TELLS SIGN OF MULTIPLIER
; 4 AND 6 ARE USED SO CALLER CAN IGNORE
; DIFFERENCE BY ALIGNMENT OF CALL LOC'N
;[TIME=4+2(-FE)+(# OF ARITH STEPS)] ... IF FE=-18, 40-58.
MUL "FE_FE+1,DISP/MUL,MQ/MQ*.25"
MULSUB: BR_AR LONG,AR_0S,ARX_0S, ;M'CAND TO BR LONG, CLEAR PROD
MUL,J/MULP ;START THE MULTIPLICATION
=000 ;GRAB AN 8-WORD BLOCK
MULP:
=011 (AR+ARX+MQ)*2,FE_SC,RETURN6 ;DISCARD REDUNDANT SIGN BIT
=100 AR_AR*.25 LONG,MUL,J/MULP ;M'IER BITS 00 AFTER POS STEP
AR_(AR+BR)*.25,ARX/ADX*.25, ;01 AFTER +
MUL,J/MULP
AR_(AR-2BR)*.25,ARX/ADX*.25, ;10 AFTER +
MUL,J/MULM
AR_(AR-BR)*.25,ARX/ADX*.25,
MUL,J/MULM ;11 AFTER +
=000 ;ANOTHER 8-WORD BLOCK FOR
MULM: ; AFTER SUBTRACTION STEPS
=011 (AR+ARX+MQ)*2,FE_SC,RETURN4 ;M'IER WAS NEGATIVE
=100 AR_(AR+BR)*.25,ARX/ADX*.25, ;M'IER BITS 00 AFTER NEG STEP
MUL,J/MULP
AR_(AR+2BR)*.25,ARX/ADX*.25, ;01 AFTER -
MUL,J/MULP
AR_(AR-BR)*.25,ARX/ADX*.25, ;10 AFTER -
MUL,J/MULM
AR_AR*.25 LONG,MUL,J/MULM ;11 AFTER -
;HERE TO CONTINUE A LONG MULTIPLICATION
; WITH PARTIAL PRODUCT IN AR LONG
MULREE: AD/0S,MUL,J/MULP ;DIVE IN WITHOUT CLOBBERING AR
.TOC "DIV, IDIV"
.DCODE
230: R, DBL AC, J/IDIV
I, DBL AC, J/IDIV
RW, M, J/IDIV
RW, DBL B, J/IDIV
234: R, DBL AC, J/DIV
I, DBL AC, J/DIV
RW, M, J/DIV
RW, DBL B, J/DIV
.UCODE
=00*000
DIV: BR/AR,ARX+MQ_0.M, ;DIVISOR TO BR
AR_AC1*2,ARL/AD*2, ;LOW DIVIDEND TO AR
CALL.M,J/DIV1 ;GET HIGH DIVIDEND
=10
IDIV: BR/AR,ARX+MQ_0.M,SC_1, ;DIVISOR TO BR
AR_AC0,ARL/AD,CALL.M, ;DIVIDEND TO AR
SKP AR0,J/DIV2 ;TEST DIVISOR SIGN
=011
NODIVD: SET NO DIVIDE,J/NOP ;HERE IF DIVIDE IMPOSSIBLE
=110 ARX_AR,AR_-BRX, ;REMAIN TO ARX, GET CORRECT QUOTIENT
SC_#,#/36.,EXIT
ARX_AR,AR_BRX, ;HERE FOR POS QUOTIENT
SC_#,#/36.,EXIT
=
;HERE ON Dù5¤Ä‹ TO SET UP DIVIDEND
DIV1: BRX/ARX,ARX_AR,AR_AC0, ;CLR BRX, DIVIDEND IN AR LONG
FE_#,#/33.,TIME/3T, ;SETUP ITERATION COUNT
SIGNS DIútJ_DIVS1 ;ENTER SUBR
;HERE ON IDIV TO SET UP DIVIDEND. SKIP IF DIVISOR NEG
; ALSO CALLED BY ADJBP
=1****0
DIV2: BRX/ARX,ARX_SHIFT,AR_SIGùË»‡LR BRX, DIVIDEND TO AR LONG
FE_#,#/33., ;SETUP LOOP COUNT
SKP AR0,J/DIVS1 ;ENTER SUBR ACCORDING TO SIGNS
BRX/ARX,ARX_SHIFT,AR_SIGN, ;CLR BRX, DIVIDEND TO AR LONG
FE_#,#/33., ;SETUP LOOP COUNT
SKP AR0,J/DIVS2 ;ENTER SUBR ACCORDING TO SIGNS
.TOC "INTEGER DIVIDE SUBROUTINE"
; ENTER WITH SIGNS DISPATCH OF DIVISOR AND DIVIDEND,
; DIVISOR IN BR, BRX CLR; DIVIDEND IN AR!ARX
; STEP COUNT IN FE (# OF QUOTIENT BITS -2)
; IF NO DIVIDE, RETURN 3 WITH IFETCH STARTED
; OTHERWISE, RETURN WITH SIGNED REMAINDER IN AR,
; POSITIVE QUOTIENT IN BRX AND MQ.
; RETURN 6 IF QUOTIENT SHOULD BE NEGATIVE,
; RETURN 7 IF QUOTIENT SHOULD BE POSITIVE.
;[TIME=14+3(FE)+3(D'END NEG)+3(RESTORE REQ'D)+1(REMAINDER NEG)]
; ... IF FE=33, 113-120
DIVIDE "FE_FE-1,DISP/DIV,MQ/MQ*2"
=1**100
DIVS1: DIVIDE,AR_2(AR-BR),
ARX/ADX*2,J/DIVS3 ;BOTH D'END AND D'SOR POS
AR_-AR LONG,J/DIVS1 ;MAKE POúh"I­IDEND, THEN CHK
DIVS2: DIVIDE,AR_2(AR+BR),
ARX/ADX*2,J/DIVS4 ;D'END POS, D'Sùô<C3B9>N‹G
AR_-AR LONG,J/DIVS2
=1*010
DIVS3÷BbI­ù1"¬ƒúWÙ(ƒR+BR),ARX/ADX*2,
ARL/AD*2,CALL.M,J/DIVLP ;START DIVIDING
I FETCH,RETURN3 ;RETURN TO CALLER WITH NO DIVIDE
AR_-BR,BRX/ARX,RETURN6 ;D'END NEG, SO NEGATE QUO & REM
BRX/ARX,RETURN7 ;EVERYTHING POSITIVE
=1**010
DIVS4: DIVIDE,AR_2(AR-BR),ARX/ADX*2,
ARL/AD*2,CALL.M,J/DIVLP ;BEGIN DIVISION FOR REAL BITS
I FETCH,RETURN3 ;ABORT FOR IMPOSSIBLE DIVISION
BRX/ARX,RETURN6 ;NEGATE QUO
AR_-BR,BRX/ARX,RETURN7 ;NEGATE REM
.TOC "BASIC DIVIDE LOOP"
; THE LOOP ITSELF IS AN INNER SUBROUTINE, TO MAKE IT SUITABLE
; FOR USE IN DOUBLE-LENGTH DIVISION.
; THE DOUBLE LENGTH REMAINDER IS RETURNED IN BR!BRX (RESTORED)
; THE SINGLE LENGTH QUOTIENT (LOW PART IF DBL-LEN DIVISION) IN ARX
; RETURN 6 IF QUOTIENT (REALLY AC0.XOR.BR) NEGATIVE, OR 7 IF POSITIVE
;[TIME=12+3(FE)+3(RESTORE REQ'D)] ... IF FE=33, 111-114.
=1*000
ø’kL¡÷BbI­IDE,AR_2(AR+BR),ARX/ADX*2õ’—Ä“VLP
DIVIDE,ARûì”A¥õ°©)YARX/Aø–2YùKâI­LP
DIV-: DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/DIVLP
DIV+: DIVIDE,AR_2(AR+BR),ARX/ADX*2,J/DIVLP
DIVIDE,AR_AR+BR,ARX/ADX,J/DIVX
ñ1$Ö“ø‘VA¥_AR-BR,ARX/ADX,J/DIVX
DIVIDE,AR_AR-BR,ARX/ADX,J/DIVX ;NO SHIFT ON FINAL STEP
DIVIDE,AR_AR+BR,ARX/ADX,J/DIVX
;HERE AFTER FINAL DIVIDE STEP
; MQ HAS POSITIVE FORM QUOTIENT
; AR!ø4¬ ‘AS REMAINDER, EXCEPT THATôj ›UST BE RESTORED IF Iúˆ$Ó
; NEGATIVE (IT'S NEGATIVE IF THERE WAS NO CARRY ON FINAL STEP)
; THEôéI<C3A9>INAL DIVIDEND IS STILL INôa°Y SO WE CHECK ITS SIGN
; TO DETERMINE WHETHER TO NEGATE THE (RESTORED) REMAINDER.
=1**100
DIVX: AR_AR+BR LONG ;RESTORE REMAIN WITH POS D'SOR
BR_AR LONG,ARX/MQ,FE_SC, ;LONG REMAIN TO BR, QUO TO ARX
SKP AC0+,RETURN6 ;RETURN TESTING D'END SIGN
AR_AR-BR LONG ;RESTORE REMAIN WITH NEG D'SOR
BR_AR LONG,ARX/MQ,FE_SC,
SKP AC0-,RETURN6
;SUBROUTINE FOR FIRST PART OF LONG DIVISIONS
; ENTER AT DDVSUB WITH SKP BR0
; RETURN3 IF SHOULD RESUME WITH ADD STEP
; RETURN5 IF SHOULD RESUME WITH SUBTRACT
=000
DDVLP: AR_2(AR+BR),ARX/ADX*2,DIVIDE,J/DDVLP
AR_2(AR-BR),ARX/ADX*2,DIVIDE,J/DDVLP
DDVSUB: AR_2(AR-BR),ARX/ADX*2,DIVIDE,J/DDVLP
AR_2(AR+BR),ARX/ADX*2,DIVIDE,J/DDVLP
AR_MQ,MQ_AR,FE_#,#/32.,RETURN3
AR_MQ,MQ_AR,FE_#,#/32.,RETURN5
AR_MQ,MQ_AR,FE_#,#/32.,RETURN5
AR_MQ,MQ_AR,FE_#,#/32.,RETURN3
.TOC "DOUBLE INú‘cÅ¥ ARITHMETIC -- DADD, DSUBõˆ"M«ù‹D‰ù5‘

.DCODE
.IFNOT/DBL.INT
114: I, J/UUO
I, J/UUO
I, J/UUO
I, J/UUO
.IF/DBL.INT
114: R, B/0, J/DASMD ;DADD
R, B/2, J/DASMD ;DSUB
R, B/4, J/DASMD ;DMUL
R, J/DDIV
.UCODE
;HERE FOR DOUBLE WORD ADD, SUBTRACT, MULTIPLY, OR DIVIDE
;ENTER WITH (E) IN AR, E IN VMA
=00**00
DDIV: ARX_AC3,CLR MQ,J/DDIV0 ;GET LOWEST PART OF D'END
DASMD: BR/AR,AR_AC1*2,ARL/AD*2, ;HIGH MEM WORD TO BR
VMA_VMA+1,LOAD ARX, ;ASK FOR LOW WORD
MQ_0.S,CALL.S,J/XFERW ;AND WAIT FOR IT
=11 ARX_ARX*2 ;SHIFT LOW MEM WORD LEFT
= BRX/ARX,ARX_AR,AR_AC0, ;ALL DATA IN PLACE
SC_#,#/35.,B DISP ;DO THE OPERATION
;HERE WITH (E) IN BR, (E+1)*2 IN BRX
; (AC) IN AR, (AC+1)*2 IN ARX
=00* AR_AR+BR LONG,AD FLAGS,EXIT DBL ;DADD
AR_AR-BR LONG,ø1F™AGS,Eûj ‰BL ;DSUB
MQ_SHIFT,AR_0S,ARX_0S, ;DMUL, USE AC1 AS INITIAL M'IER
FE_#,#/-18.,J/DMULT ;SETUP STEP COUNT
=
;HEREô§ÒADOUBLE WORD MULTIPLY
=1*00*
DMULT: AD/0S,MUL,CALL.M,J/MULP ;BEGIN MULTIPLY
=10* AR_AR+BR LONG ;CANCEL EFFECTS OF LOW BIT 0
MQ_AR,AR_MQ ;EXCH HI AND LOW PRODUCT WORDS
;HERE AFTER 1ST CALL ON MPY SUBR. SAVE LOW WORD OF PROD, GET HIGH M'IER
AC3_AR ;LOW WORD OF PRODUCT
AR_AC0 ;GET HIGH M'IER WORD
=1**000 MQ_AR,AR_MQ,CALL, ;DIVE IN AGAIN
FE_#,#/-18.,J/MULREE ;CONTINUE THE MULTIPLY
=100 GEN AR*BR,AD/AND,SKP AD0 ;SKP IF M'IER, M'CAND, & PROD NEG
=110
DMUL1: AC0_AR,AR_SIGN,
SC_#,#/35.,J/DMUL2 ;STORE HIGH WORD OF PRODUCT
SET AROV,J/DMUL1
;MULTIPLY NOW COMPLETE, STORE RESULTS WITH PROPER SIGN IN BIT 0
DMUL2: BR/AR,AR_SHIFT ;GET 2ND WITH SIGN, SAVE SIGN
AC1_AR,AR_ARX,ARX/MQ ;READY TO BUILD 3RD WORD
ARX_SHIFT,AR_BR,MQ_MQ*2 ;SIGNIFICANT Bù5) ©O ARX, SIGN TO AR
AR_SHIFT,ARX_AC3, ;3RD WORD IN AR, GET LOW
MQ_MQ*.25 ;EXTRA PROD BIT TO MQ 35
AC2_AR,AR_MQ ;,I FETCH WHEN TIMING FIXED
=0* ARX_SHIFT,AR_BR,I FETCH, ;LOW WORD AND SIGN READY
CALL,J/SHIFT ; GET LOW WORD TO AR
STRAC3: AC3_AR,FINISH ;GANZ GETAN
÷r"Ò‹ FOR DOUBLø¨$ΩEGER DIVISION
÷pi ‘ø4Ð(‹), ARX HAS (AC3õ+A<>D MQ IS CLEAR
DDIV0: T0_AR,AR_ARX,ARX_ARX*8,SC_1 ;SAVE (E) IN T0
BRX/ARX,ARX_SHIFT, ;AC3 3-35 TO BRX, 1-2 TO ARX
AR_AC2,SC_#,#/2 ;øñj ƒC2 READY
AR_SHIFT,BR/ARõ‚D‰wAC2 BITS 2-35 WITH AC3 1-2
ARX_AC1,VMA_VMA+1 ;READY TO GET (E+1)
BR/AR,AR_ARX,ARX_BR*2, ;LOW DOUBLE WORD NOW IN BR LONG
SC_1,FE_1
ARX_SHIFT,AR_AC0,SKP AD0 ;HIGH DOUBLEWORD IN AR LONG
=0
DDIV1: BR_AR LONG,AR_BRX,ARX_BR, ;HI POS D'END TO BR
LOAD AR,J/DDIV2 ;GET LOW D'SOR READY
BR_AR LONG,AR_-BR LONG, ;NEGATE LOW D'END
FE_-1,SKP CRY0 ;TEST FOR CARRY PROPAGATION
=0 BR_AR LONG,AR_BR COMP LONG,J/DDIV1
BR_AR LONG,AR_-BR LONG,J/DDIV1 ;FINISH NEGATION OF D'END
=0*
DDIV2: T1_AR,MQ_ARX,ARX_0S, ;LOWEST D'END TO T1, NEXT TO MQ
CALL,J/XFERW ; WAIT FOR (E+1)
ARX_SHIFT,AR_T0,SKP FE0 ;DIVISOR NOW IN AR LONG
=0 AR_BR LONG,BR_AR LONG, ;PUT OPERANDS IN PLACE FOR DIV
SIGNS DISP,J/DDIV3 ;TEST D'SOR SIGN
AR_BR LONG,BR_AR LONG,SET SR2, ;NOTE D'END NEGATIVE
SIGNS DISP,J/DDIV3
;HERE WITH THE DIVISOR IN BR LONG,
; THE HIGH PART OF THE MAGNITUDE OF THE DIVIDEND IN AR LONG,
; AND THE LOW PART OF THE MAGNITUDE OF THE DIVIDEND IN MQ AND T1
; SKIP IF DIVISOR NEGATIVE, & CHECK FOR NO-DIVIDE.
=011
DDIV3: AR_2(AR-BR),ARX/ADX*2,MQ_MQ*2, ;SEE IF FIRST DIVIDE STEP
SKP CRY0,J/DDIV4 ; GENERATES A 1
AR_2(AR+BR),ARX/ADX*2,MQ_MQ*2,SKP CRY0
=000
DDIV4: FE_#,#/33.,SKP BR0,CALL,J/DDVLP ;GO DO FIRST HALF OF DIVIDE
I FETCH,J/NODIVD ;TOO MANY QUOTIENT BITS
=011 AC1_AR,CLR SC,J/DDIV6 ;SAVE HI QUOTIENT IN AC1
=101 AC1_AR,SC_1S ;SET FLAG FOR RESUMPTION
=
DDIV6: AR_T1 ;GET LOWEST DIVIDEND BITS
=100 MQ_AR,AR_MQ,CALL, ;FINISH DIVISION, GENERATING
SKP SC0,J/DIVLP ; 35 MORE QUOTIENT BITS
=110 AR_AC1,SR DISP,SET SR3,J/DDVX1 ;QUOTIENT NEGATIVE. NOTE
AR_AC1,SR DISP ;HERE'S HIGH PART OF QUOTIENT
=1101
DDVX1: BR_AR LONG,AR_BR LONG,J/DDVX2 ;POS REMAINDER. GO STORE
BR_AR LONG,AR_-BR LONG,J/DDVX2 ;NEGATE REMAINDER
DDVX2: AC2_AR,AR_SIGN,SC_#,#/35.
AR_SHIFT,SR DISP ;GET LOW WORD OF REM. TEST QUO SIGN
=1110 AC3_AR,AR_BR,ARX/ADX*2, ;GET QUOTIENT, SQUEEZE OUT HOLE
EXIT DBL

690
src/ucode/basic.23 Executable file
View File

@@ -0,0 +1,690 @@
.TOC "THE INSTRUCTION LOOP"
;INSTRUCTION DECODE, EA COMPUTATION, AND OPERAND FETCH
; IN GENERAL, AN INSTRUCTION IS STARTED AT XCTGO.
; AT THIS TIME THE INSTRUCTION IS IN ARX AND IR, AND PC HAS ITS ADDRESS.
; THE DRAM OUTPUTS AND "AC" BITS WILL SETTLE DURING THIS
; MICROINSTRUCTION, AND WILL BE LATCHED BY THE CLOCK WHICH ENDS
; THE CYCLE. XCTGO DISPATCHES ON THE STATE OF THE
; INDIRECT AND INDEX BITS OF THE ARX (EA MOD DISP) TO COMPEA OR
; ONE OF THE THREE LOCATIONS FOLLOWING IT.
; IF INDIRECT IS SPECIFIED, THE INDIRECT POINTER IS FETCHED (AT
; COMPEA+2 OR +3 DEPENDING ON WHETHER INDEXING IS ALSO SPECIFIED).
; WE WAIT FOR IT AT INDRCT, AND THEN LOOP BACK TO COMPEA. WHEN NO
; INDIRECT IS CALLED FOR, WE COMPUTE THE INSTRUCTION'S EFFECTIVE ADDRESS
; (EA) AT COMPEA OR COMPEA+1 (DEPENDING ON WHETHER INDEXING IS CALLED
; FOR), AND PERFORM THE FUNCTION "A READ", WHOSE OPERATION DEPENDS
; ON THE DRAM A FIELD, AS FOLLOWS:
;
; MACRO A-FLD MEM FUNCTION VMA DISPATCH
; I 0 NONE AD(=EA) DRAM J
; I-PF 1 FETCH PC+1 DRAM J
; 2 NONE AD 42
; W 3 WR TST AD 43
; R 4 READ AD 44
; R-PF 5 READ AD 45
; RW 6 READ/WR TST AD 46
; RPW 7 RD-PSE/WR TST AD 47
;
; A FIELD VALUES 0 AND 1 ARE USED FOR INSTRUCTIONS WHICH NEITHER
; READ NOR WRITE THE CONTENTS OF EA (IMMEDIATE-MODE INSTRUCTIONS,
; JUMPS, ETC). THESE DISPATCH FROM "A READ" DIRECTLY TO THE MICROCODE
; WHICH HANDLES THE INSTRUCTION. IF THE A FIELD CONTAINS 1, "A READ"
; CAUSES A PREFETCH (FROM PC+1), SO THAT THE MBOX CAN WORK ON GETTING
; THE NEXT INSTRUCTION INTO ARX WHILE THE EBOX PERFORMS THIS ONE.
; IF THE A FIELD CONTAINS 3, THE MBOX PERFORMS A PAGING CHECK ON
; EA, AND CAUSES A PAGE FAIL IF THAT LOCATION IS NOT WRITABLE.
; THE MICROCODE GOES TO 43 TO WAIT FOR COMPLETION OF THE PAGE CHECK,
; AND AT THAT LOCATION LOADS AC INTO AR. THE WRITABILITY OF EA IS
; VERIFIED AT THIS TIME TO PREVENT INCORRECTLY SETTING FLAGS OR
; THE PROCESSOR STATE IF THE INSTRUCTION WILL BE ABORTED BY PAGE
; FAILURE. LOCATION 43 THEN DISPATCHES TO THE HANDLER FOR THE
; CURRENT INSTRUCTION.
; A FIELD VALUES 4 TO 7 PERFORM READS FROM EA. 6 AND 7 ALSO TEST
; THE WRITABILITY OF THE LOCATION, AND 7 PERFORMS THE FIRST HALF OF
; A READ-PAUSE-WRITE CYCLE IF EA IS AN UN-CACHED ADDRESS. THE DISPATCH
; IS TO 40+A, WHERE WE WAIT FOR MEMORY DATA TO ARRIVE IN AR. IF THE A
; FIELD WAS 5, WE PREFETCH FROM PC+1 AS SOON AS THE DATA ARRIVES.
; IN ANY CASE, WE DISPATCH ACCORDING TO THE DRAM J FIELD TO THE
; HANDLER FOR THE INSTRUCTION.
; IF A PAGE FAIL OCCURS AT ANY TIME (EITHER IN THIS CODE OR DURING
; INSTRUCTION EXECUTION) THE MICROPROCESSOR TRAPS TO CRAM LOCATION
; 1777, WHERE IT CAUSES A PAGE FAIL TRAP.
; MOST INSTRUCTIONS (THE MOVE, HALFWORD, AND BOOLEAN GROUPS,
; PLUS ADD AND SUB) ARE PERFORMED BY HANDLERS CONSISTING OF ONE OR
; TWO MICROINSTRUCTIONS WHICH LEAVE THE RESULT IN AR, AND COMPLETE
; BY INVOKING THE "EXIT" MACRO. EXIT USES THE MEM/B WRITE FUNCTION
; TO BEGIN A STORE TO MEMORY FOR THOSE MODES IN WHICH THE RESULT
; GOES TO MEMORY, AND DISP/DRAM B TO GET TO ONE OF THE MICROINSTRUCTIONS
; FOLLOWING ST0. THIS CODE DEPENDS ON A CERTAIN AMOUNT OF CORRELATION
; BETWEEN THE DRAM A AND B FIELDS. IN PARTICULAR, STAC (STORE AC)
; ASSUMES THAT A PREFETCH HAS OCCURRED, WHILE THE OTHERS ASSUME THAT
; NO PREFETCH HAS OCCURED. THUS NORMAL AND IMMEDIATE MODES, WHOSE
; RESULTS GO ONLY TO AC, MUST PREFETCH IN THE DRAM A FIELD, WHILE
; MEM, BOTH, AND SELF MODES, WHOSE RESULTS GO TO MEMORY, MUST NOT.
; (THIS RESTRICTION IS AVOIDED FOR THOSE INSTRUCTIONS WHICH NEVER
; PREFETCH -- IN MUL, DIV, AND IDIV BY USE OF THE EXIT TO ST2AC,
; AND IN IMUL AND THE SINGLE PRECISION FLOATING POINT
; INSTRUCTIONS BY A RESTRICTED EXIT TO ST6.)
; ANOTHER LARGE SET OF INSTRUCTIONS (SKIP, AOS, SOS, JUMP, AOJ,
; SOJ, AOBJ, CAI, CAM, AND THE TEST GROUP) KNOWS WHERE TO PUT THE
; RESULTS WITHOUT MODE INFORMATION, AND THEY USE THE DRAM B FIELD TO
; DETERMINE WHETHER TO SKIP OR JUMP, AS A FUNCTION OF THEIR OPERANDS.
; SKIP, AOS, AND SOS ARE CONSIDERED SELF-MODE INSTRUCTIONS,
; AND AFTER MAKING THE FETCH DECISION (AND RE-WRITING MEMORY, IN
; THE CASE OF AOS OR SOS), JUMP TO STSELF TO DECIDE WHETHER OR NOT
; TO PUT THE RESULT ALSO IN AC. THE OTHER INSTRUCTIONS OF THIS SET
; JUMP TO STORAC OR NOP AFTER MAKING THE FETCH DECISION, DEPENDING
; ON WHETHER OR NOT THE OPCODE DEFINITION REQUIRES MODIFICATION OF AC.
; (NOTE THE DIFFERENCE BETWEEN STAC AND FINI ON THE ONE HAND,
; AND STORAC AND NOP ON THE OTHER -- STORAC AND NOP MUST BE USED WHEN
; THE NEXT INSTRUCTION FETCH OCCURS ON THE PRECEDING EBOX CYCLE, BECAUSE
; NICOND MUST NOT IMMEDIATELY FOLLOW A FETCH (ONE CYCLE REQUIRED FOR
; VMA AC REF TO MAKE IT THROUGH THE NICOND LOGIC), STAC AND FINI ARE
; USED WHEN THERE HAS BEEN AN INTERVENING CYCLE.)
.TOC "NEXT INSTRUCTION DISPATCH"
;START BY PUTTING PC WORD IN AR, JUMP HERE
0:
START: SET FLAGS_AR,BR/AR,J/BRJMP ;LOAD UP FLAGS
CONT: VMA/PC,FETCH,J/XCTW ;HERE TO CONTINUE FROM PC
; DISP/NICOND (THE "NXT INSTR" MACRO) BRINGS US TO ONE OF THE
; LOCATIONS FOLLOWING "NEXT". PC HAS BEEN UPDATED TO ADDRESS THE NEXT
; INSTRUCTION IN THE NORMAL FLOW, AND IF IT IS FROM MEMORY
; (AS OPPOSED TO AC'S), THE INSTRUCTION IS IN ARX AND IR.
; THE NICOND DISPATCH IS PRIORITY ENCODED, AS FOLLOWS:
; [FOR FULL DETAILS, SEE PRINT CON2]
;(1) IF PI CYCLE IS TRUE, GO TO NEXT FOR SECOND HALF
; OF STANDARD OR VECTOR INTERRUPT.
;(2) IF THE RUN FLOP (CON RUN) IS OFF, GO TO NEXT+2, FROM WHICH THE
; MICROCODE WILL ENTER THE HALT LOOP TO WAIT FOR THE CONSOLE TO RESTART
; INSTRUCTION PROCESSING.
;(3) IF THE METER HAS A REQUEST, GO TO NEXT+4 (MTRINT) TO SERVE IT.
;(4) IF THE PI SYSTEM HAS A REQUEST READY, GO TO NEXT+6 (INTRPT)
; TO START A PI CYCLE.
;(5) IF CON UCODE STATE 05 (TRACK EN) IS SET, GO TO NEXT+10 OR 11.
; THIS FLOP IS ENTIRELY UNDER CONTROL OF THE MICROCODE, AND IS ONLY
; USED FOR THE SPECIAL STATISTICS-GATHERING MICROCODE.
;(6) IF THE LAST INSTRUCTION SET A TRAP FLAG, GO TO NEXT+13 OR +17,
; IT DOESN'T MATTER WHICH.
;(7) IF VMA CONTAINS AN AC ADDRESS, IMPLYING THAT THE NEXT
; INSTRUCTION IS TO COME OUT OF FAST MEMORY, GO TO NEXT+16 TO GET IT.
;(10) --NORMAL CASE-- THE INSTRUCTION IS IN ARX, READY TO GO, GO
; TO NEXT+12 (XCTGO).
=11*0000 ;USE LOC'NS INACCESSIBLE TO DRAM
NEXT: SET PI CYCLE,GEN FE, ;2ND PART OF INTERRUPT
BYTE DISP,J/PICYC2 ;SKIP IF VECTOR INT
=0010 AR_0S,SET HALTED,J/HALT1 ;HERE IF RUN FLOP OFF
=0100
MTRINT: CLR ACCOUNT EN,J/MTRREQ ;HERE IF METER REQUEST UP
AR_EBUS,SC_#,#/2,J/PICYC1 ;HERE IF TAKE INTRPT DOESNT FIND
=0110 ; A METER REQUEST
INTRPT: AR_EBUS,SC_#,#/2,J/PICYC1 ;HERE IF INTERRUPT PENDING
.IF/TRACKS
=1000 AR_TRX+1,GEN CRY18,SKP CRY0,J/TRK1 ;HERE TO STORE PC BEFORE
AR_TRX+1,GEN CRY18,SKP CRY0,J/TRK1 ; EXECUTING NEXT INSTR
.ENDIF/TRACKS
.IF/OP.CNT
=1000 SC_#,#/9.,SKP USER,J/OPCT1 ;COUNT THIS INSTR
SC_#,#/9.,SKP USER,J/OPCT1
.ENDIF/OP.CNT
.IF/OP.TIME
=1000 AR_2,CLR TRK+PA EN,J/OPTM1 ;TIME OUT THIS INSTR
AR_2,CLR TRK+PA EN,J/OPTM1
.ENDIF/OP.TIME
;-- THE NICOND DISPATCH BLOCK CONTINUES ON THE NEXT PAGE --
;-- NICOND DISPATCH CONTINUED --
=1010
XCTGO: BRX/ARX,SET ACCOUNT EN, ;SAVE INSTR, ENABLE ACCOUNTING,
EA MOD DISP,J/COMPEA,AR_1S ;GO CALCULATE EA, -1 FOR SOJ HACK
.IFNOT/ONE PROCEED
TRAP: VMA_420+TRAP,J/TRAPX ;HERE IF TRAP BITS SET
.IF/ONE PROCEED
TRAP: GET ECL EBUS,SC_1,J/TR3CHK ;TRAP, CHECK FOR ONE PROCEED
.ENDIF/ONE PROCEED
=1110 ARX_FM(VMA),TIME/3T,LOAD IR,J/XCTGO ;HERE IF INSTR IS IN FM
.IFNOT/ONE PROCEED
VMA_420+TRAP,J/TRAPX ;HERE IF TRAP BITS SET
.IF/ONE PROCEED
ARX_FM(VMA),TIME/3T,LOAD IR, ;HERE IF TRAP AND VMA->ACS
J/TRAP ;FETCH THE INSTR THEN TRAP
.ENDIF/ONE PROCEED
.IF/ONE PROCEED
;HERE ON TRAPS, WITH INSTRUCTION IN ARX AND IR, 1 IN SC,
;AND ECL EBUS GRABBED. UNFORTUNATELY THE HARDWARE CAREFULLY
;CLEARS THE TRAP BITS IN THE PC WORD ON A NICOND, BUT
;WE CAN USE A DIAGNOSTIC FUNCTION TO READ THE TRAP CYC BITS (SCD4).
;THE "ADDRESS BREAK INHIBIT" HAIR (SCD5) IS USED TO
;DETECT WHEN AN INSTRUCTION IS COMPLETED.
;IF THIS IS A TRAP 3, AND SCD ADDR BRK CYC IS TRUE, WE ARE
;IN THE MIDDLE OF A ONE-PROCEED, SO SUPPRESS THE TRAP.
;SCD ADDR BRK CYC IS ON WHEN NICOND IS DONE WITH
;ADR BRK INH SET IN THE PC FLAGS (I.E. JUST STARTING
;OR RE-STARTING THE INSTRUCTION BEING ONE-PROCEEDED.)
TR3CHK: AR03-04_SCD TRAP CYC
VMA_420+TRAP,SH DISP,J/TR3DSP ;VMA -> TRAP INST, CHECK TRAP NUMBER
=11100
TR3DSP:
=01
REL ECL EBUS,J/TRAPX ;TRAP 1 - TAKE TRAP
REL ECL EBUS,J/TRAPX ;TRAP 2 - TAKE TRAP
AR05_SCD ADDR BRK CYC ;TRAP 3 - CHECK FOR ONE PROCEED
GEN P AND SC,SKP SCAD NE ;SKIP IF ONE-PROCEEDING
=1***0
REL ECL EBUS,J/TRAPX ;NO, TAKE THE TRAP
REL ECL EBUS ;YES, DO THE INSTR THEN
TRAP3,J/XCTGO ;ARRANGE FOR ANOTHER TRAP
;WHEN THE INSTRUCTION COMPLETES
.ENDIF/ONE PROCEED
;HERE ON TRAPS, VMA SETUP WITH 420+TRAP CODE
TRAPX: LOAD ARX,PT REF ;GET AND XCT TRAP INSTR
SET PC+1 INH ;DON'T INCREMENT PC FOR THIS INSTR
;HERE AFTER FETCHING INSTR TO BE EXECUTED
XCTW: ARX_MEM,LOAD IR,J/XCTGO ;GET INSTR TO XCT
.TOC "EFFECTIVE ADDRESS COMPUTATION AND OPERAND FETCH"
;COME HERE WITH -1 IN AR IF YOU EXPECT SOJ TO WORK!
=11***00 ;HERE WITH XR CALC IN PROG
COMPEA: AR_ARX (AD),A READ, ;NO MOD, GET OPERAND IF ANY
MQ_AR ;SOJ SERIES EXPECTS -1 IN MQ
AR_ARX+XR,A READ, ;INDEXED, NO @
MQ_AR ;SOJ SERIES EXPECTS -1 IN MQ
GEN ARX,A INDRCT, ;DO INDIRECT, NO INDEX
SKP INTRPT,J/INDRCT
GEN ARX+XR,A INDRCT, ;BOTH @ AND XR
SKP INTRPT,J/INDRCT
=11****0
INDRCT: ARX_MEM,J/INDLP ;GET INDIRECT POINTER, EVAL
TAKINT: ARX_MEM,TAKE INTRPT ;INTERRUPT DURING INDIRECT
;APPARENTLY A INDRCT AT COMPEA+2/+3 CAN
; CAUSE AR AS WELL AS ARX TO BE CLOBBERED BY ARX_MEM.
;HENCE WE MUST RESTORE THE -1 THAT THE SOJ SERIES DEPENDS ON.
INDLP: EA MOD DISP,AR_1S,J/COMPEA ;EVALUATE POINTER
.TOC "WAIT FOR (E)"
;THE EXECUTE CODE FOR EACH INSTRUCTION IS ENTERED WITH
; THE OPCODE AND AC # IN BRX AND IR, THE LAST INDIRECT WORD
; IN ARX, AND AR AND VMA SETUP AS A FUNCTION OF THE A
; FIELD OF THE DISPATCH RAM. A PREFETCH IS IN PROGRESS IF THE
; DRAM A FIELD WAS 1 OR 5 (OR IF IR CONTAINS "JRST 0,").
;ON "A READ", THE HARDWARE DISPATCHES TO THE EXECUTE CODE FOR
; THE INSTRUCTION IF THE DRAM A FIELD IS 0 OR 1. IF THE A FIELD
; CONTAINS 2-7, THE HARDWARE DISPATCHES TO 40+A, BELOW:
;COME HERE ON "A READ" FUNCTION IF DRAM A FIELD IS 3
; A "WRITE TST" IS IN PROGRESS
43: BR/AR,AR_AC0,MB WAIT, ;WAIT FOR PERMISSION TO WRITE
TIME/3T,IR DISP,J/0 ;AND GO TO EXECUTE CODE
;HERE ON "A READ" FUNCTION IF DRAM A FIELD IS 4
; A "LOAD AR" IS IN PROGRESS
44: BR/AR,AR_MEM,TIME/3T, ;GET OPERAND
IR DISP,J/0 ; START EXECUTE
;HERE ON "A READ" IF A FIELD IS 5
; A "LOAD AR" IS IN PROGRESS, AND WE MUST PREFETCH WHEN IT COMPLETES
45: BR/AR,FIN XFER,I FETCH, ;GET OPERAND, PREFETCH,
TIME/3T,IR DISP,J/0 ; & START EXECUTE
;HERE ON "A READ" IF A FIELD IS 6
; A "LOAD AR" IS IN PROGRESS, BUT PAGING IS TESTING WRITABILITY
46: BR/AR,AR_MEM,TIME/3T, ;GET OPERAND
IR DISP,J/0 ; START EXECUTE
;HERE ON "A READ" IF A FIELD IS 7
; A "READ-PAUSE-WRITE" IS IN PROGRESS
47: BR/AR,AR_MEM,TIME/3T, ;GET OPERAND
IR DISP,J/0 ; START EXECUTE
.TOC "TERMINATION"
;DISPATCH HERE WITH THE "EXIT" MACRO,
; OR JUMP DIRECTLY TO ONE OF THESE LOCATIONS.
=11*000
ST0: ;BASE FOR B DISP IN EXIT MACRO
=001
ST2AC: AC0_AR,AR_SIGN,I FETCH,J/STD1 ;HERE TO STORE AC0 & AC1
FIN STORE,EXIT DBL ;MULB, DIVB, ETC ...
FIN STORE,I FETCH, ;SELF MODE
SKP AC#0,J/STSELF ; RESULT TO AC TOO?
=101
STAC: AC0_AR,NXT INSTR ;NORMAL AND IMMEDIATE MODES
ST6:
IFNOP:
STMEM: FIN STORE,I FETCH,J/NOP ;MEM MODE
IFSTAC:
STBOTH: FIN STORE,I FETCH,J/STORAC ;BOTH MODE
=
;HERE TO FINISH, AFTER FETCHING NEXT INSTRUCTION.
; WE MUST GUARANTEE AT LEAST ONE EBOX CYCLE BETWEEN FETCH AND NICOND,
; TO ALLOW VMA AC REF TO MAKE IT THROUGH THE NICOND LOGIC.
=11***0
STSELF: ;SKIP, AOS, SOS COME HERE
STORAC: SR_0,J/STAC ;STORE AC, TOO
NOP: J/FINI ;DELAY THEN NXT INSTR
.IF/JPC SUPPORT
=11*110
NJPCP: AR_PC,SKP USER,J/JPCEX ;FOR JPC HACK - SKIP IF NOT JUMPING
.ENDIF/JPC SUPPORT
FINI: SR_0,NXT INSTR ;GET NEXT INSTR IN ARX & IR,
; LOAD PC, TEST PI CYCLE, RUN,
; PI READY, TRAPS
;HERE TO STORE ARITHMETIC DOUBLE RESULTS
DSTAC: AC0_AR,AR_SIGN ;HERE WITH FETCH STARTED
STD1: AR_SHIFT,SR_0 ;BRING IN LOW PART
STAC1: AC1_AR,NXT INSTR AFTER AC1 ;STORE AC1
;HERE TO GET MICRO-CODE VERSION #. FIXED LOC'N SO SOFTWARE CAN FIND IT
137:
UVERS: BR/AR,AR0-8_#,#/VERS,J/GTAR08 ;COPY VERSION TO AR
.TOC "MOVE GROUP, EXCH, BLT"
.DCODE
200: R-PF, AC, J/MOVE ;BASIC MOVE
I-PF, AC, J/MOVE
.IF/WRTST
W, M, J/MOVE
.IFNOT/WRTST
I, B/1, J/MOVEM
.ENDIF/WRTST
RPW, S, J/MOVE
204: R-PF, AC, J/MOVS
I-PF, AC, J/MOVS
W, M, J/MOVS
RPW, S, J/MOVS
210: R-PF, AC, J/MOVN
I-PF, AC, J/MOVN
W, M, J/MOVN
RPW, S, J/MOVN
214: R-PF, AC, J/MOVM
I-PF, AC, J/MOVM
W, M, J/MOVM
RPW, S, J/MOVM
.UCODE
; ENTER WITH 0,E, (E), OR (AC) IN AR
=00****
MOVS: AR_AR SWAP,EXIT ;ALSO USED BY HALFWORD GROUP
=
=00****
MOVM: BR/AR,SKP AR0,J/MOVE ;FORCE POSITIVE
=
=00****
MOVN: BR/AR,J/MOVNEG ;GET NEGATIVE
=
=00*000
MOVE: EXIT ;STORE AS IS FROM AR
MOVNEG: AR_-BR,AD FLAGS,FETCH WAIT,J/MOVE
;EXCH, BLT
.DCODE
250: RPW, B/0, J/EXCH
I, J/BLT
.UCODE
=00***0
MOVEM: ;LIKE EXCH, EXCEPT NO STORE AC
EXCH: ARX_AR,AR_AC0,STORE,J/STMAC ;PUT AC AT E, THEN STORE AC
BLT: MQ_AR,ARX_AR, ;END ADDR TO MQ & ARX
ARR_AC0,ARL_ARL,J/BLT1 ;FIRST DEST ADDR TO AR
.TOC "HALFWORD GROUP"
; DESTINATION LEFT HALF
.DCODE
500: R-PF, AC, J/HLL
I-PF, AC, J/HLL
RPW, M, J/HRR ;HLLM = HRR EXCEPT FOR STORE
RPW, S, J/MOVE ;HLLS = MOVES
R-PF, AC, J/HRL
I-PF, AC, J/HRL
RPW, M, J/HRLM
RPW, S, J/HRLS
510: R-PF, AC, J/HLLZ
I-PF, AC, J/HLLZ
W, M, J/HLLZ
RPW, S, J/HLLZ
R-PF, AC, J/HRLZ
I-PF, AC, J/HRLZ
W, M, J/HRLZ
RPW, S, J/HRLZ
520: R-PF, AC, J/HLLO
I-PF, AC, J/HLLO
W, M, J/HLLO
RPW, S, J/HLLO
R-PF, AC, J/HRLO
I-PF, AC, J/HRLO
W, M, J/HRLO
RPW, S, J/HRLO
530: R-PF, AC, J/HLLE
I-PF, AC, J/HLLE
W, M, J/HLLE
RPW, S, J/HLLE
R-PF, AC, J/HRLE
I-PF, AC, J/HRLE
W, M, J/HRLE
RPW, S, J/HRLE
; DESTINATION RIGHT HALF
540: R-PF, AC, J/HRR
I-PF, AC, J/HRR
RPW, M, J/HLL ;HRRM = HLL EXCEPT FOR STORE
RPW, S, J/MOVE ;HRRS = MOVES
R-PF, AC, J/HLR
I-PF, AC, J/HLR
RPW, M, J/HLRM
RPW, S, J/HLRS
550: R-PF, AC, J/HRRZ
I-PF, AC, J/HRRZ
W, M, J/HRRZ
RPW, S, J/HRRZ
R-PF, AC, J/HLRZ
I-PF, AC, J/HLRZ
W, M, J/HLRZ
RPW, S, J/HLRZ
560: R-PF, AC, J/HRRO
I-PF, AC, J/HRRO
W, M, J/HRRO
RPW, S, J/HRRO
R-PF, AC, J/HLRO
I-PF, AC, J/HLRO
W, M, J/HLRO
RPW, S, J/HLRO
570: R-PF, AC, J/HRRE
I-PF, AC, J/HRRE
W, M, J/HRRE
RPW, S, J/HRRE
R-PF, AC, J/HLRE
I-PF, AC, J/HLRE
W, M, J/HLRE
RPW, S, J/HLRE
.UCODE
;FIRST, THE 16 OPS WHICH DO NOT AFFECT THE "OTHER" HALF.
;THESE MUST BE TREATED SEPARATELY, BECAUSE THEY COMBINE MEMORY DATA
;IN AR WITH DATA FROM THE FM. ENTER WITH 0,E OR (E) IN AR.
=00***0
HRR: ARL_AC0,ARR_ARR,EXIT ;HRR, HRRI, HLLM
=00****
HLL: ARR_AC0,ARL_ARL,EXIT ;HLL, HLLI, HRRM
= ;HRRS, HLLS ARE BOTH EQUIVALENT TO MOVES
=00****
HRL: ARL_ARR,ARR_AC0,EXIT ;HRL, HRLI
=
=00****
HLR: ARR_ARL,ARL_AC0,EXIT ;HLR, HLRI
=
=00***0
HRLM: ARL_ARR,ARR_AC0,J/MOVS ;HRLM
HRLS: ARL_ARR,ARR_ARR,EXIT ;HRLS
=
=00***0
HLRM: ARR_ARL,ARL_AC0,J/MOVS ;HLRM
HLRS: ARR_ARL,ARL_ARL,EXIT ;HLRS
=
;NOW THE HALFWORD OPS WHICH CONTROL THE "OTHER" HALF
; ENTER WITH 0,E, (E), OR (AC) IN AR
=00****
HRRE: SKP AR18 ;SELECT HRRZ OR HRRO ON SIGN
=
=00***0
HRRZ: ARL_0S,ARR_ARR,EXIT
HRRO: ARL_1S,ARR_ARR,EXIT
=
=00****
HRLE: SKP AR18
=
=00***0
HRLZ: ARL_ARR,ARR_0S,EXIT
HRLO: ARL_ARR,ARR_1S,EXIT
=
=00****
HLRE: SKP AR0
=
=00***0
HLRZ: ARR_ARL,ARL_0S,EXIT
HLRO: ARR_ARL,ARL_1S,EXIT
=
=00****
HLLE: SKP AR0
=
=00***0
HLLZ: ARR_0S,ARL_ARL,EXIT
HLLO: ARR_1S,ARL_ARL,EXIT
=
.TOC "DMOVE, DMOVN, DMOVEM, DMOVNM"
;DOUBLE-WORD MOVES
.DCODE
120: R, B/0, J/DMOVE
R, B/1, J/DMOVN
.UCODE
; ENTER WITH (E) IN AR
=00****
DMOVN:
DMOVE: VMA_VMA+1,LOAD ARX,B DISP ;PICK UP (E+1)
=
=1**00
ARX_MEM,J/STDAC ;GO STORE DOUBLE AC
ARX_MEM,MQ_0.S,CALL.S,J/GTDBR ;LOAD BR WITH DOUBLE OPERAND
=11 AR_-BR LONG,AD FLAGS, ;NEGATE DOUBLE OPERAND
SC_#,#/35. ;& STORE RESULT
DBLST: AC0_AR,AR_0S,I FETCH,J/STD1 ;STORE HIGH WORD, READY LOW
;DOUBLE MOVES TO MEMORY
.DCODE
124: W, J/DMOVEM
W, J/DMOVNM
.UCODE
;ENTER WITH (AC) IN AR
=00**00
DMOVEM: ARX_AC1,STORE,SC_#,#/36.,J/DMVM1
DMOVNM: ARX_AC1,MQ_0.S,CALL.S,J/GTDBR ;HIGH WORD IS ALREADY IN AR
=11 AR_-BR LONG,AD FLAGS, ;NEGATE
STORE,SC_#,#/35. ; & STORE
=
DMVM1: MEM_AR,VMA_VMA+1,AR_0S
AR_SHIFT,STORE,J/STMEM
GTDBR: ARX_ARX*2 ;SHIFT OUT LOW SIGN
LDBRL: BR_AR LONG,RETURN3 ;COPY TO BR LONG
.TOC "BOOLEAN GROUP"
.DCODE
400: I-PF, AC, J/SETZ
I-PF, AC, J/SETZ
IW, M, J/SETZ
IW, B, J/SETZ
.UCODE
=00****
SETZ: AR_0S,EXIT
=
.DCODE
404: R-PF, AC, J/AND
I-PF, AC, J/AND
RPW, M, J/AND
RPW, B, J/AND
.UCODE
=00****
AND: AR_AR*AC0,AD/AND,EXIT
=
.DCODE
410: R-PF, AC, J/ANDCA
I-PF, AC, J/ANDCA
RPW, M, J/ANDCA
RPW, B, J/ANDCA
.UCODE
=00****
ANDCA: AR_AR*AC0,AD/ANDCB,EXIT
=
.DCODE
414: R-PF, AC, J/MOVE ;SETM = MOVE
I-PF, AC, J/MOVE
RPW, M, J/MOVE ;SETMM = NOP THAT WRITES MEMORY
RPW, B, J/MOVE ;SETMB = MOVE THAT WRITES MEMORY
420: R-PF, AC, J/ANDCM
I-PF, AC, J/ANDCM
RPW, M, J/ANDCM
RPW, B, J/ANDCM
.UCODE
=00****
ANDCM: AR_AR*AC0,AD/ANDCA,EXIT
=
.DCODE
424: R-PF, J/TDN
I-PF, J/TDN
W, M, J/MOVE ;SETAM = MOVEM
W, M, J/MOVE ;SETAB, TOO
.UCODE
.DCODE
430: R-PF, AC, J/XOR
I-PF, AC, J/XOR
RPW, M, J/XOR
RPW, B, J/XOR
.UCODE
=00****
XOR: AR_AR*AC0,AD/XOR,EXIT
=
.DCODE
434: R-PF, AC, J/IOR
I-PF, AC, J/IOR
RPW, M, J/IOR
RPW, B, J/IOR
.UCODE
=00****
IOR: AR_AR*AC0,AD/OR,EXIT
=
.DCODE
440: R-PF, AC, J/ANDCB
I-PF, AC, J/ANDCB
RPW, M, J/ANDCB
RPW, B, J/ANDCB
.UCODE
=00****
ANDCB: AR_AR*AC0,AD/ANDC,EXIT
=
.DCODE
444: R-PF, AC, J/EQV
I-PF, AC, J/EQV
RPW, M, J/EQV
RPW, B, J/EQV
.UCODE
=00****
EQV: AR_AR*AC0,AD/EQV,EXIT
=
.DCODE
450: I-PF, AC, J/SETCA
I-PF, AC, J/SETCA
IW, M, J/SETCA
IW, B, J/SETCA
.UCODE
=00****
SETCA: AR_AR*AC0,AD/SETCB,EXIT
=
.DCODE
454: R-PF, AC, J/ORCA
I-PF, AC, J/ORCA
RPW, M, J/ORCA
RPW, B, J/ORCA
.UCODE
=00****
ORCA: AR_AR*AC0,AD/ORCB,EXIT
=
.DCODE
460: R-PF, AC, J/SETCM
I-PF, AC, J/SETCM
RPW, M, J/SETCM
RPW, B, J/SETCM
.UCODE
=00****
SETCM: ADA/AR,AD/SETCA,AR/AD,EXIT
=
.DCODE
464: R-PF, AC, J/ORCM
I-PF, AC, J/ORCM
RPW, M, J/ORCM
RPW, B, J/ORCM
.UCODE
=00****
ORCM: AR_AR*AC0,AD/ORCA,EXIT
=
.DCODE
470: R-PF, AC, J/ORCB
I-PF, AC, J/ORCB
RPW, M, J/ORCB
RPW, B, J/ORCB
.UCODE
=00****
ORCB: AR_AR*AC0,AD/ORC,EXIT
=
.DCODE
474: I-PF, AC, J/SETO
I-PF, AC, J/SETO
IW, M, J/SETO
IW, B, J/SETO
.UCODE
=00****
SETO: AR_1S,EXIT
=

4
src/ucode/bcirc.3 Executable file
View File

@@ -0,0 +1,4 @@
.SET/CIRC.BIG.OPT=1
.SET/CIRC=1

157
src/ucode/blt.9 Executable file
View File

@@ -0,0 +1,157 @@
.TOC "BLT"
; ENTER WITH 0,E IN AR
;IN THE LOOP, ARX CONTAINS THE CURRENT DESTINATION ADDRESS,
; BRX CONTAINS THE TERMINAL ADDRESS, AND BR CONTAINS THE DIFFERENCE
; BETWEEN THE SOURCE AND DESTINATION ADDRESSES.
;UNLIKE EARLIER -10 PROCESSORS, THIS CODE CHECKS FOR THE CASE IN WHICH
; THE DESTINATION ADDRESS IN RH(AC) IS GREATER THAN E, AND RATHER THAN
; STOPPING AFTER ONE WORD, COPIES DOWNWARD (EFFECTIVELY DECREMENTING
; AC BY 1,,1 ON EACH STEP, RATHER THAN INCREMENTING).
;THIS CODE ALSO PROVIDES A GUARANTEED RESULT IN AC ON COMPLETION OF
; THE TRANSFER (EXCEPT IN THE CASE AC IS PART OF BUT NOT THE LAST WORD
; OF THE DESTINATION BLOCK). WHEN AC IS NOT PART OF THE DESTINATION
; BLOCK, IT IS LEFT CONTAINING THE ADDRESSES OF THE FIRST WORD FOLLOWING
; THE SOURCE BLOCK (IN THE LH), AND THE FIRST WORD FOLLOWING THE DEST-
; INATION BLOCK (IN THE RH). IF AC IS THE LAST WORD OF THE DESTINATION
; BLOCK, IT WILL BE A COPY OF THE LAST WORD OF THE SOURCE BLOCK.
;IN ADDITION, A SPECIAL-CASE CHECK IS MADE FOR THE CASE IN WHICH EACH
; WORD STORED IS USED AS THE SOURCE OF THE NEXT TRANSFER. IN THIS CASE,
; ONLY ONE READ NEED BE PERFORMED, AND THAT DATA MAY BE STORED FOR EACH
; TRANSFER. THUS THE COMMON USE OF BLT TO CLEAR CORE IS SPEEDED UP.
;BLT: ARX_AR,MQ_AR,ARR_AC0,ARL_ARL ;END TO ARX & MQ, DEST TO AR
BLT1: BR/AR,ARX_AR,BRX/ARX, ;DST TO BR & ARX, END TO BRX
AR_AC0 ;SRC TO ARL
ARR_ARL,ARL_0.M ;SRC TO ARR
AR_AR-BR ;SRC-DST TO ARR
.IF/BACK.BLT
BR/AR,SKP ARX LE BRX ;SRC-DST TO BR. UP OR DOWN?
=00 AR_MQ-1,CALL,J/BLTAC ;DOWN, READY WITH E-1
AR_MQ+1,CALL,J/BLTAC ;UP, PUT E+1 IN AR FOR AC
DOWN: VMA_ARX+BR,LOAD AR,J/DN1 ;DOWN, START THE LOOP
.IFNOT/BACK.BLT
=0* BR/AR,AR_MQ+1,CALL,J/BLTAC ;SRC-DST TO BR, E+1 IN AR
.ENDIF/BACK.BLT
SKP BR EQ -1,J/UP ;IS THIS CORE CLEARING CASE?
;HERE TO SETUP FINAL AC
BLTAC: ARL_ARR,AR_AR+BR ;FINAL DEST TO LH, SRC TO RH
AR_AR SWAP,SR_BLT(SRC) ;REARRANGE
AC0_AR,RETURN2
;HERE FOR UPWARD BLT (AC RH .LE. E)
=0
UP: VMA_ARX+BR,LOAD AR,J/UP1 ;NOT CLEAR CORE
SKP P!S XCT,VMA_ARX+BR,LOAD AR ;DO NOT OPTIMIZE UNDER EXT ADDR
;USE EVEN LOC'NS OF THIS BLOCK OF 4 IN SPECIAL "CLEAR CORE" CASE
=00 AR_MEM,CALL,SR_BLT(DST),J/UP2 ;GET THE WORD TO STORE IN ALL
UP1: AR_MEM,CALL,SR_BLT(DST),J/UP2 ;GET SOURCE WORD
CALL,SR_BLT(DST),J/UP2 ;HERE TO STORE SAME SRC AGAIN
VMA_ARX+BR,LOAD AR,J/UP1 ;HERE TO GET NEXT SRC
UP2: VMA_ARX,STORE,SKP INTRPT ;OK, GET DST ADDRESS
=0
UP3: SKP ARX LT BRX,J/UP4 ;CHECK FOR LAST TRANSFER
MEM_AR,J/BLTPF ;FINISH THIS, GO SERVE INTRPT
=0
UP4: FIN STORE,I FETCH,J/NOP ;THAT'S ALL, FOLKS
MEM_AR,ARX_ARX+1, ;STORE DST,
SR_BLT(SRC),RETURN2 ; CONTINUE
;BLT CONTINUED - HERE FOR DOWNWARD BLT (AC RH .GT. E)
.IF/BACK.BLT
DN1: AR_MEM,SR_BLT(DST) ;WAIT FOR SOURCE DATA
VMA_ARX,STORE,SKP INTRPT ;OK, START DST REF
=0 SKP ARX LE BRX,J/DN3 ;CHECK FOR END CONDITION
MEM_AR,J/BLTPF ;FINISH STORE, TAKE INTRPT
=0
DN3: MEM_AR,ARX_ARX-1, ;NOT END, LOOP
SR_BLT(SRC),J/DOWN
FIN STORE,I FETCH,J/NOP ;END
.ENDIF/BACK.BLT
.TOC "STORING OF JPC"
.IF/JPC SUPPORT
AOBJPC: ;HERE TO STORE JPC FOR AOBJN/AOBJP
SOJJPC: ;HERE FOR SOJ SERIES
AOJJPC: ;HERE FOR AOJ SERIES
AC0_AR,B DISP
=*1*000 ;HERE FOR JUMP SERIES
JMPJPC: GEN AR-1,SKP AR0,SIGNS DISP,J/JPCP ;LE
SKP AR NE,J/NJPCP ;E
SKP AR0,J/JPCP ;L
J/FINI ;-
GEN AR-1,SKP AR0,SIGNS DISP,J/NJPCP ;G
SKP AR NE,J/JPCP ;N
SKP AR0,J/NJPCP ;GE
AR_PC,SC_#,#/32.,SKP USER,J/JPCEX ;A
=*1*110
JPCP: NXT INSTR ;NOT JUMPING
JPCIFY: AR_PC,SC_#,#/32.,SKP USER,J/JPCEX ;JUMPING
;THIS IS LIKE STORAC, EXCEPT IT STORES THE JPC ALSO.
;CALLED WITH SKP USER, BECAUSE WRITING IN FM USES THE COND
;FIELD, WHICH MEANS JPCSTO CAN'T DO THE SKP USER ITSELF.
=0
JPCSTO: AC0_AR,AR_PC,SC_#,#/32.,J/JPCEX
AC0_AR,AR_PC,SC_#,#/32.,J/JPCUSR
.IFNOT/JPC.RING
=*1***0
JPCEX: XJPC_AR,NXT INSTR AFTER JPC
JPCUSR: JPC_AR,NXT INSTR AFTER JPC
.IF/JPC.RING
;COME HERE WITH: SKP USER,SC_#,#/32.
=*1***0
JPCEX: AR_XJPC+1,J/JPCEX1
JPCUSR: AR_JPC+1
JPC_AR,SH DISP,AR_PC
=*10000
JPC0_AR,NXT INSTR AFTER JPC
JPC1_AR,NXT INSTR AFTER JPC
JPC2_AR,NXT INSTR AFTER JPC
JPC3_AR,NXT INSTR AFTER JPC
JPC4_AR,NXT INSTR AFTER JPC
JPC5_AR,NXT INSTR AFTER JPC
JPC6_AR,NXT INSTR AFTER JPC
JPC7_AR,NXT INSTR AFTER JPC
JPC10_AR,NXT INSTR AFTER JPC
JPC11_AR,NXT INSTR AFTER JPC
JPC12_AR,NXT INSTR AFTER JPC
JPC13_AR,NXT INSTR AFTER JPC
JPC14_AR,NXT INSTR AFTER JPC
JPC15_AR,NXT INSTR AFTER JPC
JPC16_AR,NXT INSTR AFTER JPC
JPC17_AR,NXT INSTR AFTER JPC
JPCEX1: XJPC_AR,SH DISP,AR_PC
=*10000
XJPC0_AR,NXT INSTR AFTER JPC
XJPC1_AR,NXT INSTR AFTER JPC
XJPC2_AR,NXT INSTR AFTER JPC
XJPC3_AR,NXT INSTR AFTER JPC
XJPC4_AR,NXT INSTR AFTER JPC
XJPC5_AR,NXT INSTR AFTER JPC
XJPC6_AR,NXT INSTR AFTER JPC
XJPC7_AR,NXT INSTR AFTER JPC
XJPC10_AR,NXT INSTR AFTER JPC
XJPC11_AR,NXT INSTR AFTER JPC
XJPC12_AR,NXT INSTR AFTER JPC
XJPC13_AR,NXT INSTR AFTER JPC
XJPC14_AR,NXT INSTR AFTER JPC
XJPC15_AR,NXT INSTR AFTER JPC
XJPC16_AR,NXT INSTR AFTER JPC
XJPC17_AR,NXT INSTR AFTER JPC
.ENDIF/JPC.RING
.ENDIF/JPC SUPPORT

226
src/ucode/byte.7 Executable file
View File

@@ -0,0 +1,226 @@
.TOC "BYTE GROUP -- IBP, ILDB, LDB, IDPB, DPB"
.DCODE
;133: R, J/IBP ;OR ADJBP
134: RW, J/ILDB ;CAN'T USE RPW BECAUSE OF FPD
R, J/LDB
RW, J/IDPB
R, J/DPB
.UCODE
;ALL FIVE INSTRUCTIONS OF THIS GROUP ARE CALLED WITH THE BYTE POINTER
;IN THE AR. ALL INSTRUCTIONS SHARE COMMON SUBROUTINES, SO THAT
;THE 10/11 INTERFACE AND STRING MAY ALSO USE THESE SUBROUTINES
;IBP OR ADJBP
;IBP IF AC#0, ADJBP OTHERWISE
; HERE WITH THE BASE POINTER IN AR
;IBP: SKP AC#0 ;IS THIS IBP OR ADJBP?
.IF/ADJBP
=1**000
IBP1: T0_AR,BR/AR, ;SAVE POINTER FOR ADJBP
SC_S,AR_0S,CALL,J/GETSC ; GET BYTE SIZE
.ENDIF/ADJBP
=001
IBP2: BR/AR,P_P-S,CALL.M, ;NEW P UNLESS OVERFLOW
SKP SCAD0,J/IBPS
.IF/ADJBP
BR/AR,AR_BR,J/ADJBP ;HOLD S IN BR AND MQ
.ENDIF/ADJBP
=101 FIN STORE,I FETCH,J/NOP ;IBP DONE
=
=00*000
ILDB: BR/AR,P_P-S,BYTE DISP, ;START IBP
CALL.M,J/IBPS ;AND CALL SUBR
=100
LDB: ARX_AR,SC_P,CALL,J/BYTEA ;BEGIN EA COMPUTATION
SC_FE+SC,CALL,J/LDB1 ;SC_P+S WHILE LOADING AR
=111 AC0_AR,CLR FPD,I FETCH,J/NOP ;DONE
=
=00*000
IDPB: BR/AR,P_P-S,BYTE DISP, ;START IBP
CALL.M,J/IBPS
=100
DPB: ARX_AR,SC_P,CALL,J/BYTEA ;COMPUTE EFFECTIVE BYTE ADDR
AR_AC0,TIME/3T,SC_#-SC,#/36., ;COMPUTE 36-P
CALL,SKP SCAD0,J/DPB1 ;CALL DEPOSITOR
=111
BFIN: FIN STORE,I FETCH ;DONE
=
=*1***0
CLRFPD: CLR FPD,J/FINI ;CAN'T DO THIS UNTIL STORE COMPLETE
J/FINI ;HERE FROM BLKO/BLKI PI
=
.TOC "INCREMENT BYTE POINTER SUBROUTINE"
;THIS SUBROUTINE IS CALLED BY THE INSTRUCTIONS ILDB, IDPB AS
;WELL AS THE MICROCODED 10/11 INTERFACE HANDLER.
;CALL WITH BYTE DISP TESTING FPD AND SIGN OF P-S
;[TIME=2+2(BP OVFLO)]
=1**010 ;BR12 IRELEVANT
IBPS: STORE,RETURN4 ;SIMPLE, NO OVERFLOW
FE_#,#/36.,GEN AR+1,TIME/2T, ;HERE IF OVRFLO OF WORD
ARX_AR,J/NXTWRD
AR_BR,RETURN4 ;FPD WAS SET, RESTORE AR
AR_BR,RETURN4 ; AND CONVERT TO LDB OR DPB
= ;TEST BR12 ONLY
NXTWRD: AR_AR+1,P_FE-S,STORE,
TIME/2T,RETURN4
.TOC "BYTE EFFECTIVE ADDRESS EVALUATOR"
;ENTER WITH POINTER IN AR, ARX, AND BR
;RETURN1 WITH (EA) LOADING INTO AR AND ARX,
;FPD SET, P IN SC, AND S IN FE
;[TIME=4+1(INDEXED)+?(INDIRECT)]
BYTEA: MEM_AR,FE_S,SET FPD, ;PUT AWAY UPDATED POINTER
EA MOD DISP ;EVAL BP ADDR
=11**00
BFETCH: VMA_ARX,BYTE READ,RETURN1 ;START DATA FETCH
VMA_ARX+XR,BYTE READ,RETURN1 ;ADDRESS IS INDEXED
GEN ARX,BYTE INDRCT,J/BYTEI ;DO INDIRECT
GEN ARX+XR,BYTE INDRCT,J/BYTEI ;INDIRECT INDEXED!!!
BYTEI: ARX_MEM,SKP INTRPT ;WAIT FOR INDIRECT WORD
=0 EA MOD DISP,J/BFETCH ;PROCEED IN ADDR EVAL
SR DISP,J/CLEAN ;INTERRUPTED, CLEAN UP AS REQ'D
.TOC "LOAD BYTE SUBROUTINE"
;ENTER WITH S IN FE, P+S IN SC, AND AR LOAD IN PROGRESS
;SKP INTERRUPT AT ENTRY IS OPTIONAL
;RETURN2 WITH BYTE RIGHT JUSTIFIED IN AR
;[TIME=7]
=1****0
LDB1: AR_MEM,SC_#-SC,#/36.,SKP SCAD0, ;36-(P+S)
TIME/3T,J/LDB2
AR_MEM,SR DISP,J/CLEAN ;HERE IF INTERRUPT PENDING
=
=*1***0
LDB2: ARX_SHIFT,AR_0S,SC_FE,J/SHIFT ;BYTE IN ARX HI, READY TO SHIFT
ARX_AR,AR_0S, ;P+S > 36, PUT BYTE IN ARX HI
SC_FE+SC,SKP SCAD0 ;ADJUST S AND SHIFT BYTE
;PUT BYTE INTO AR RIGHT-JUSTIFIED
; THIS INSTRUCTION ALSO CALLED ALONE AS A SUBROUTINE
=1****0
SHIFT: AR_SHIFT,RETURN2 ;RETURN WITH BYTE IN AR
RETURN2 ;BYTE WAS OFF THE END, RETURN AR=0
.TOC "DEPOSIT BYTE SUBROUTINE"
;ENTER WITH BYTE RIGHT JUSTIFIED IN AR, POINTER IN BR,
; S IN FE, 36-P IN SC, AND LOAD AR-ARX STARTED
; SKP IF P>36
;RETURN3 WITH FINAL STORE IN PROGRESS
;[TIME=11]
=1****0
DPB1: MQ_AR,AR_MEM,ARX_MEM, ;GET WORD TO ROTATE 36-P
GEN FE-SC,TIME/3T, ;COMPUTE S-(36-P)
SKP SCAD0,J/DPB2 ;CHECK THAT P+S<36
MB WAIT,RETURN3 ;P>36, STORE NOTHING
=*1***0
DPB2: FE_SC ;P+S>36, S_36-P
ARX_SHIFT,AR_MQ,SC_FE, ;ARX HAS P,X,S
FE_#-SC,#/72. ;SC_S, FE_72-(36-P)=36+P
SC_#-SC,#/36. ;SC_36-S (KNOWN .LE. P)
AR_SHIFT,ARX_SHIFT, ;S,P,X
SC_FE-SC ;SC_(36+P)-(36-S)=P+S
AR_SHIFT,STORE,RETURN3 ;DONE, STORE IT BACK
.TOC "ADJBP"
;HERE FOR ADJUST BYTE POINTER (IBP WITH NON-ZERO AC)
; BYTE SIZE (S) IS RIGHT ADJUSTED IN BR AND MQ
; FULL POINTER IS IN AR, AND SAVED IN T0
.IF/ADJBP
ADJBP: SC_P,AR+ARX+MQ_0.M, ;GET P
SKP BR EQ ;CHECK SIZE IS NON-ZERO
=1***00
BRX/ARX,P_SC,CALL.M,J/SIXDIV ;DIVIDE P BY S
AR_T0,J/IFSTAC ;OOPS, S=0, RETURN UNALTERED POINTER
T1_AR,AR_0S,ARX_0S, ;SAVE P/S
SC_FE-SC ;36-P IN SC
=
=*1**0*
P_SC,MQ_0.M,CALL.M,J/SIXDIV ;36-P IN AR0-5
AR_AR+T1,SKP AD NE ;(P/S)+(36-P/S)=BYTES/WORD
=*1***0
I FETCH,J/NODIVD ;ABORT, BYTES/WORD=0
T1_AR,BR/AR,AR_ARX ;SAVE BYTES/WORD, READY TO
; DIVIDE BY IT
T2_AR,AR_MQ ;SAVE REMAIN(36-P/S), GET (36-P)/S
AR_AR*AC0,AD/A+B,ARL/AD, ;ADJUSTMENT IN AR
ARX+MQ_0.M
;COMPUTE QUOTIENT Q AND REMAINDER R OF ADJUSTMENT/(BYTES/WORD)
; SUCH THAT ADJUSTMENT=Q*(BYTES/WORD)+R, 1 .LE. R .LE. (BYTES/WORD)
; SINCE ADJUSTMENT IS CALCULATED RELATIVE TO LEFT-MOST BYTE OF
; A WORD, THIS GIVES Q AS THE NUMBER OF WORDS BY WHICH TO INDEX THE
; BYTE POINTER, AND R AS THE NUMBER OF BYTES FROM THE LEFT OF THE
; WORD. MULTIPLYING R BY THE BYTE SIZE WILL GIVE THE NUMBER OF BITS
; FROM THE LEFTMOST BYTE, AND ADDING REMAIN(36-P/S) WILL GIVE NUMBER
; OF BITS FROM BIT 0. FINALLY, WE MUST SUBTRACT THIS FROM 36 TO GET
; THE CORRECT P FIELD, WHICH IS ALWAYS RELATIVE TO THE RIGHT EDGE OF
; THE WORD.
=*1*100
AC0_AR,SC_1,CALL,J/DIV2 ;DO THE BASIC DIVIDE
=110 ARX_-BRX,FE_#,#/-4,J/ADJD1 ;NEG QUO ==> NEG REMAIN
ARX/MQ,SKP AR NE,FE_#,#/-4 ;POS QUO. IS REMAIN .GT. 0?
=1****0
ADJD1: AR_AR+T1,J/ADJD2 ;INCREASE REMAIN TO MEET CONSTRAINT
BR/AR,AR_ARX (ADX), ;REMAIN IN RANGE,
ARL+ARX_0.M,J/ADJD3 ; QUOTIENT TO ARR
ADJD2: BR/AR,AR_ARX-1, ;HOLD UPDATED REMAINDER,
ARL+ARX_0.M ; GET CORRESPONDING QUOTIENT
ADJD3: AR_AR+T0,INH CRY18, ;ADD Q TO Y OF POINTER,
BRX/ARX ;CLR BRX
=1**00*
AC0_AR,AR_0S,SC_S,CALL,J/GETSC ;SAVE UPDATED Y, GET SIZE
MQ_AR,AR_T2,CLR ARX, ;M'IER IS S, GET REMAIN(36-P/S)
CALL,J/MULREE ;COMPUTE (R*S)+REMAIN(36-P/S)
=11* AR_ARX*2,I FETCH ;PUT THAT IN AR0-5
SC_P-#,#/36.,AR_AC0
P_-SC,J/STAC ;THAT'S NEW P, DONE
.ENDIF/ADJBP
;SUBROUTINE TO GET CONTENTS OF SC RIGHT ALIGNED IN AR
;[TIME=6]
GETSC: AR0-8_SC ;PUT SC INTO AR
GETEXP: ARX_AR,SC_#,#/9.,J/SHIFT ;HERE WITH DATA IN AR0-8
;SUBROUTINE FOR SHORT DIVISION, BR KNOWN POSITIVE
; CALL WITH MQ CLEAR, DIVISOR RIGHT-ALIGNED IN BR, AND DIVIDEND
; IN AR0-5 (OR LEFT-ALIGNED IN ARX IF ENTERING AT SDIV)
; RETURN QUOTIENT IN AR AND MQ, REMAIN IN ARX
;[TIME=22+3(RESTORE REQ'D)]
;TO IMPROVE ADJBP PERFORMANCE, INSERT THE INSTRUCTION SHOWN BELOW
; (SIXDZ), AND CHANGE THE CALLS TO SIXDIV TO "SKP SCAD NE,J/SIXDZ"
;=0
;SIXDZ: AR_0S,ARX_0S,FE_#,#/36.,RETURN2 ;HERE IF DIVIDEND IS ZERO
SIXDIV: ARX_AR,AR_0S,FE_#,#/4,J/SDIV-
=*1*0*0
SDIV: DIVIDE,AR_2(AR+BR),ARX/ADX*2,J/SDIV
SDIV-: DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/SDIV
DIVIDE,AR_AR+BR,J/SDIVR ;NO SHIFT ON FINAL STEP
DIVIDE,AR_AR-BR
=1**1*0
SDIVR: AR_AR+BR ;NO CRY0 MEANS RESTORE REQ'D
ARX_AR,AR_MQ, ;RETURN QUO IN AR, REMAIN IN ARX
FE_#,#/36.,RETURN2

1463
src/ucode/define.32 Executable file
View File

File diff suppressed because it is too large Load Diff

642
src/ucode/eis.6 Executable file
View File

@@ -0,0 +1,642 @@
.IF/EIS
îñKªO‡ "EXTø³¢E‰ INSTúUaÔ“ùó<C3B9>S‹úˆ"E‡ODING"
;GET HERE WITH E0 IN BR, (E0) IN AR
; (ø¬ “S THEôèE¥ATION WORD, AND HAS THE NORMAL -10 ù3©Ô¥UCTION
; FORMAúˆ­ABITS 0-8 ARE OPCODE, 9-12 IGNOúQb,A13 @, 14-17 XR,ñ¢<C3B1>‰ƒND 18-35 Y. THE AC USED øsæŧ FROM THE ø¶*E<>D INSú”ªÃ©ION.îñNÐCŸù´*Ô‹ôX <58>úSæ cökYµ
;Eû"Ή:FE_#õpi0[÷ ¯[20,SKP SCAD0, ;ør"× LEGAL OPERATION
; ARX_AR,AR_BRX ;OPRô' ƒRX, GøµA‡ FROMô©XñOX
EXT1: AR_BR,J/UUO ;OPCODE > 17
AR0-8_FE+#,#/20 ;PLUG OPR INú“ÐE±ú‘gDAAC
øñg ƒR,LOAøˆ$ÒYAR_ARX,ARL_0.M,
EA MOD DISP
=00
EXTöN„Åc_AR,AR_BR,ùKâØ©5 ;SAVE E1, REø1, ©O SAVE E0
ARLûìMYAR_ARX+XR,J/EXTöCE <09>EN ARû  “NDRCT,SKP INTRPT,J/EXT3
GEN ARX+XR,A INDRCT,
SKP INTRPT,J/EXT3
=0
EXT3: AR_MEM,ARX_ù±f¬•õñlTiñ¢„Á¥_MEM,TAKE INTRPúƒEE±T4: ARL_0.M,EA MOD Dù4è,•/EXT2
EXT5: ø¬/Á¥,VMA_AR+1,IR DIútJ_2000 ;ENTER EXTENDED INSTúH$A<>DLER
;THE EXú‘gD‹D INSTRUCTù3ç §øµI§ "HIDø‘g"AUNDER THE LUUO'S BY THIS
; USE OF ôRi ‰ù4è,•/2000" TO ø’iЃTCH Tùè*H‹M. TùPL«UO'S úò$Ñ
; Hø5¢ ©HE SAME OPCODESôi ‹XTENDED OPERATIONS AúQPA§úrc΋D UNIQUE
; CRAù¨&O‡ATIONS IN ú’" ¥ø3£ÅAö,0Aú“Ð1a17. WHEN WE SPECIFY J/2000,
; THEôéA› ADDRESS Bø°çÍ‹úh°aö*OAöl·Y WHICH ACCESSES CRAM LOCATIONS
; 2ö  ©ùè0cöè!E‡AUSE ADDRESS BITS 01 AND 02 ARE IGNùô¢ÄAWHEN BIT 00
; ù4ÐT¥UE (CRA, CRM).
2005: AR_AC3,J/CMúĉ;HIDDø³<C3B8>B‹HIND ù‹aͧ
200ö΄ÙR AR,ARX_1S,SC_ôk¯c5.,J/EDIT ;HIDDø³<C3B8>B‹ùgDAL-EDIT
.IF/DECIMAL
2010: AR_AC0 COMP,J/DBIN ;HIDDEN BEHIND L-DBIN
2011: AR_AC1,ARL/AD,SC_1,ARX+MQ_0.M,
BYTE DISP,J/BDEC ;HIDDEN BEHIND L-BDEC
.ENDIF/DECIMAL
2012: AR_AC3,LOAD AR,J/MVST ;HIDDEN BEHIND L-MVS
.TOC "EIS -- STRING MOVE"
; HERE WITH AC3 (DEST LEN) IN AR
;SLEN IS THE COMPLEMENT OF THE SHORTER STRING LENGTH
;DLEN IS <SRC LEN>-<DST LEN>
MVST: BR/AR,AR_MEM, ;HOLD AC3, WAIT FOR FILLER
FE_AR0-8,SKP SCAD NE ;CHECK FOR FLAGS IN DEST LEN
=0 ARX_AC0,J/MVST1 ;GET SRC LEN, FLAGS
AR_E0,J/UUO ;NO FLAGS ALLOWED IN DST LEN
MVST1: FILL_AR,AR_ARX ;SAVE FILL CHAR
FE_AR0-8,AR0-8_#,#/0 ;SEPARATE FLAGS OFF
ARX_AR,AR_AR-BR,SKP AD0 ;COMPUTE SRC-DST LEN
=0 DLEN_AR,AR_BR COMP,J/MVST2 ;SRC LONGER
DLEN_AR,AR_ARX COMP ;DST LONGER
MVST2: SLEN_AR,ARX_AR,MQ_AR,AR_0S ;-SHORT LEN -1 TO MQ
AR0-8_FE,BRX/ARX ; AND BRX
SFLGS_AR,B DISP
=100 CLR AR,ARX_1S,SC_#,#/15.,J/MOVS2;TRANSLATE, BUILD MASK
AR_E1,J/MVSO1 ;OFFSET, SIGN EXTEND E1
ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1 ;LEFT JUSTIFY
AR_DLEN,SKP AD0,J/MOVRJ ;RIGHT JUSTIFY
MVSO1: ARX_DSTP,SKP AR18,ARL_0.M ;CHECK SIGN FOR EXTENDING
=0
MVSO2: E1_AR,AR_ARX,J/MVSO3 ;SAVE AGAIN, GET POINTER
ARL_1S,J/MVSO2 ;NEG, MAKE MINUS
MVSO3: SC_S,CLR ARX,AR_1S ;PREPARE TO BUILD MASK
MOVS2: AR_SHIFT,SR_SRC
MSK_AR
=000
MOVELP: AR_SLEN+1,CALL,J/SRCMOD ;PICK UP SOURCE BYTE
AR_DLEN,J/MOVSTX ;(1) LENGTH EXHAUSTED
=100
MOVPUT: SR_SRC+DST,CALL,J/PUTDST ;(4) NORMAL, STORE DST BYTE
I FETCH,AR_DLEN,J/MVABT ;(5) ABORT
=110 SR_SRC,J/MOVELP ;(6) DPB DONE
=
;HERE TO ABORT A STRING MOVE DUE TO TRANSLATE OR OFFSET FAILURE
MVABT: BR/AR,AR_-SLEN,SKP AR0 ;WHICH STRING LONGER?
=0
MVABT1: AC3_AR,FETCH WAIT,J/MVABT2 ;PUT AWAY DEST LEN
AR_AR-BR,J/MVABT1 ;DEST LEN WAS GREATER
MVABT2: AR_SLEN COMP,SKP BR0 ;GET UNDECREMENTED SLEN
=0 AR_AR+BR ;SRC LONGER BY (DLEN)
MVEND: AR_AR*SFLGS,AD/OR,SR_0,J/STAC ;PUT BACK REMAINING LENGTH
;HERE TO BEGIN RIGHT-JUSTIFIED MOVE
=00
MOVRJ: ARX_AR,AR_SRCP,SR_SRC,J/MVSKP ;SRC LONGER, SKIP OVER SOME
SR_DSTF,CALL,J/MOVF1 ;DST LONGER, FILL IT
=11 ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1 ;DONE FILLING
=0
MVSKP: ARX_ARX-1 (AD),FE_#,#/36.,
SIGNS DISP,SKP INTRPT,J/MVSK1
P_FE-S,AR_AR+1,J/MVSKP
=110
MVSK1: P_P-S,SKP SCAD0,J/MVSKP ;BUMP POINTER
SRCP_AR,GEN ARX,SIGNS DISP,AR_0.M
=110 BRX/ARX,AR_SLEN COMP,ARX/AD,J/MVSK3 ;INTERRUPTED
DLEN_AR,J/MVSK4 ;DONE FILLING
MVSK3: AC3_AR,AR_ARX*BRX,AD/A+B+1 ;DEST HAS SHORT LEN
SR_0,J/STRPF2 ;FIX UP AC0, SERVE INTRPT
;HERE FOR NO-MODIFICATION STRING MOVES
=000
MOVST1: SLEN_AR,BRX/ARX, ;PUT UPDATED LEN AWAY
AR+ARX+MQ_0.M,CALL.M,
SIGNS DISP,J/GSRC
MOVSTX: SKP AR0,ARX_AR,AR_0S,J/MOVST2 ;SHORT LEN EXHAUSTED
=010 SR_SRC+DST,CALL,J/PUTDST
=110
MVSK4: ARX_BRX+1,AR/ADX,SR_SRC,J/MOVST1
=
=00
MOVST2: TEST ARX,TEST FETCH, ;SKIP IF BOTH LENGTHS =0
AC3_AR,AR_ARX,J/MVEND ;CLEAR DEST LEN, REBUILD SRC
SR_DST,CALL,J/MOVF1 ;SOURCE GONE, FILL OUT DST
=11 AR_SFLGS,VMA_PC+1,J/SFET1 ;DONE FILLING
;NOTE -- IT AIN'T AS EASY AS IT LOOKS TO BUM A CYCLE OUT OF THIS
; ROUTINE, BECAUSE AN INTERRUPT, IF ANY, HAS TO BE TAKEN AFTER THE
; POINTER UPDATE AND BEFORE THE LENGTH UPDATE. GOOD HUNTING!
=01*
MOVF1: AR_FILL,CALL,J/PUTDST
AR_DLEN+1,SKP INTRPT,J/MOVF2
=0
MOVF2: DLEN_AR,SIGNS DISP,J/MOVF3 ;DONE?
SR DISP,J/CLEAN ;BREAK OUT FOR INTERRUPT
=011
MOVF3: RETURN2 ;YES, DONE
J/MOVF1 ;NO, DO ANOTHER
.TOC "EIS -- STRING COMPARE"
;HERE WITH AC3 (DEST LENGTH) IN AR
CMPS: BR/AR,ARX_AR,FE_AR0-8,AR_AC0 ;DEST LEN TO BR, GET SRC LEN
FE_FE OR AR0-8, ;GATHER HIGH BITS OF LEN'S
SKP AR GT BR ;WHICH STRING LONGER?
=0
CMPS1: LOAD AR,AR_ARX-1,ARX_AR-1, ;SRC SHORTER
GEN FE,SKP SCAD NE,J/CMPS2 ;CHECK LEN'S PURE
VMA_VMA+1,J/CMPS1 ;SRC LONGER, GET DST FILLER
=0
CMPS2: AR_MEM,BR/AR,BRX/ARX,J/CMPS4 ;DECREMENTED LEN'S TO BR'S
MB WAIT,AR_E0,J/UUO ;OOPS, ILLEGAL BITS IN LEN'S
;HERE IS THE COMPARE LOOP.
; MQ CONTAINS THE FILL CHARACTER FOR THE SHORTER STRING,
; BR CONTAINS THE REMAINING DESTINATION LENGTH,
; BRX CONTAINS THE REMAINING SOURCE LENGTH
=0
CMPS3: ARX0_MQ35,J/CMPSX ;WE GOT INEQUALITY. GET SIGN
CMPS4: MQ_AR,ARX_AR,FE_#,#/36., ;FILL TO MQ & ARX
AR_BR,SKP ARX0 ;MORE CHARS IN SRC STRING?
=000 AR_SRCP,ARX_SRCP, ;READY WITH SRC POINTER
SR_ED(S),CALL,J/GSRC1 ;GO GET SRC BYTE
AR_ARX,ARX_0S,SR_0,SIGNS DISP ;SRC DONE. TEST DEST LEN
=010 T0_AR,AR_MQ,SIGNS DISP,J/CMPS5 ;SRC (OR SRC FILL) TO T0,
=110 ;TEST FOR END OF DEST STRING
CMPSX: GEN ARX,CMS FETCH,J/NOP ;QUIT WITH COMPARE COND IN ARX
=
;HERE TO GET DESTINATION BYTE. SRC IS IN T0, FILL CHAR IN AR
;HERE WITH SIGNS DISP, TO AVOID CALL ON CMPDST IF DST LEN EXHAUSTED
=101
CMPS5: SR_ED(+D),CALL,J/CMPDST ;GO FOR DESTINATION BYTE
AR_AR*T0,AD/XOR, ;AR ZERO IF EQUAL
ARX/MQ,MQ_MQ*2 ;FILL TO ARX, CRY TO MQ35
BR/AR,BRX/ARX, ;EQUALITY TO BR, FILL TO BRX
AR_BR,ARX_BRX,SKP BR0 ;LENGTHS TO AR, ARX
=0 AC3_AR,ARX_AR,AR_ARX (AD), ;UPDATE DEST LEN IN AC3
SIGNS DISP,J/CMPS6 ;TEST SRC LEN
ARX_AR,AR_ARX (AD) ;DEST LEN EXHAUSTED
=110
CMPS6: AC0_AR,AR_ARX-1,ARX_AR-1,J/CMPS7 ;UPDATE SRC LEN IN AC0
AR_ARX-1,ARX_AR-1 ;SRC EXHAUSTED PREVIOUSLY
CMPS7: BR/AR,BRX/ARX, ;LENGTHS TO BR'S
SKP BR EQ,AR/ADX,J/CMPS3 ;CHECK FOR EQUALITY
=0
CMPDST: AR_DSTP,ARX_DSTP,FE_#,#/36., ;GET DEST BYTE FOR COMPARE
CALL,J/IDST ;UPDATE DEST POINTER
SC_FE+SC,SKP INTRPT,J/LDB1 ;GET DEST BYTE
.TOC "EIS -- DECIMAL TO BINARY CONVERSION"
; HERE WITH AC0 (SRC LEN) IN AR COMPLEMENTED
; IN THE LOOP, AC3 CONTAINS 10 (DECIMAL), BR'BRX HAS ACCUMULATED BINARY
.IF/DECIMAL
DBIN: BR/AR,FE_AR0-8 COMP,AR0-8_#,#/-1 ;FORCE OUT FLAGS
SLEN_AR,AR_0S,SIGNS DISP
=101 AR0-8_FE,MQ_0.S,ARX_AC4,J/DBS1 ;BUILD SFLGS
B DISP ;OFFSET OR TRANSLATE?
=110 AR0-8_FE,J/DBST ;TRANSLATE, LET S FLAG SET LATER
AR0-8_FE OR #,#/400 ;OFFSET, SET S FLAG
DBST: SFLGS_AR,AR_0S,ARX_0S,J/DBS2 ;CLEAR BINARY
DBS1: SFLGS_AR,ARX_ARX*2 ;HERE WHEN SIG ALREADY ON
AR_AC3 ;ACCUMULATED BINARY IN AR
DBS2: BR_AR LONG,AR_1,CLR ARX
AR_AR*10,B DISP,SC_#,#/4 ;GET CONSTANT 10 FOR COMPARE
=110 AC3_AR,AR_ARX,ARX_1S,J/DBS3 ;PREPARE TO BUILD MASK
AC3_AR ;OFFSET
AR_E1 ;GET OFFSET
ARL_1S.M,SKP AR18 ;SIGN EXTEND IT
=0 ARL_0S ;OOPS, TWAS POS
E1_AR,AR_1S ;NOW READY TO BUILD MASK
DBS3: AR_SHIFT,SR_DB
MSK_AR,AR_BR LONG ;SAVE MASK, GET INITIAL INPUT
=0*0
DBINLP: BR_AR LONG,AR_SLEN+1, ;BINARY BACK TO BR, COUNT LENGTH
CALL,J/SRCMOD ;PICK UP A DIGIT
SKP AR2,VMA_PC+1,J/DBXIT ;(1) DONE, TEST M FLAG
ARX_AR,AR+MQ_0.M,GEN AR-AC3, ;(4) NORMAL, ADD IN DIGIT
SKP CRY0,J/DBIN2 ;TEST FOR DIGIT >9
AR_SLEN COMP,J/DBABT ;(5) ABORT
;HERE TO ADD IN A DIGIT
=0
DBIN2: BR_AR LONG,AR_BR LONG,J/DBIN3 ;DIGIT TO BR LONG, BINARY TO AR LONG
AR_SLEN COMP,J/DBABT ;DIGIT >9, ABORT
DBIN3: AR_AR*5 LONG ;ALREADY HAVE BINARY *2
AR_2(AR+BR) LONG,J/DBINLP ;ADD IN DIGIT, SHIFT LEFT
;HERE ON ABORT
DBABT: AR_AR*SFLGS,AD/OR ;COMBINE FLAGS WITH +LEN REMAINING
AC0_AR,AR_BR LONG,SC_#,#/35., ;PUT BACK UNUSED LENGTH
VMA_PC+1,J/STOR34 ;END WITH NO SKIP
;HERE AT END
=0
DBXIT: AR_BR LONG,VMA_VMA+1, ; M FLAG=0
SC_#,#/35.,J/STOR34 ;GO FOR NEXT INSTR
AR_-BR LONG,VMA_VMA+1, ;NEGATE
SC_#,#/35.
STOR34: AC3_AR,AR_SIGN,FETCH ;STORE HIGH PART
AR_SHIFT,SR_0 ;GET LOW READY
STAC4: AC4_AR,FINISH
.TOC "EIS -- BINARY TO DECIMAL CONVERSION"
; AC0,AC1 = BINARY INTEGER INPUT
; AC3 = FLAGS, MAX LENGTH OF DECIMAL STRING
; AC4 = DESTINATION STRING POINTER
; TEMPS ARE USED AS FOLLOWS:
; SLEN= # OF SIGNIFICANT DIGITS
; T1,2= 10.**(SLEN) THE LOWEST POWER OF TEN LARGER THAN BINARY
;FPD IS SET IF THE INSTRUCTION WAS INTERRUPTED AFTER
; CONVERSION OF THE BINARY INTEGER TO FRACTION FORM.
; (AND THUS BY IMPLICATION, AFTER STORING FILLERS)
=011
BDEC: ARX_SHIFT,AR_AC0,SKP AD0, ;BINARY INTEGER NOW IN AR LONG
SC_#,#/20,J/BD1 ;IS IT NEGATIVE?
ARX_AR,AR_E1,B DISP ;CONT FROM INTRPT OR PGF
=0
BDDR1: AR_AC3,SR_BDT,J/BDDR3 ;RESUME WITH FRACTION IN AR LONG
SKP AR18,ARL_0.M ;OFFSET MODE. EXTEND E1
=0
BDDR2: E1_AR,J/BDDR1 ;GET REST OF FRACTION
ARL_1S,J/BDDR2 ;E1 NEGATIVE
BDDR3: BR/AR,CLR EXP, ;SEPARATE FLAGS & LENGTH
BRX/ARX,ARX_AC0 ;LOW FRAC TO BRX, HI TO ARX
AR_AR*BR,AD/ANDCA,BR/AR ;JUST FLAGS TO AR, JUST LEN TO BR
AC3_AR,AR_ARX ;GET HI FRAC TO AR
BR/AR,VMA_PC+1, ;FRAC TO BR LONG, GET VMA READY
AR_-BR,SKP CRY0,J/BDDR4 ;CHECK FOR MORE TO GO
=0
BD1: SKP AR NE,AD LONG,J/BD2 ;TEST FOR ZERO LONG
AR_-AR LONG,SC_#,#/30,J/BD3 ;MAKE POSITIVE, SET N&M FLAGS
=00
BD2: BR_AR LONG,AR_1 LONG, ;BINARY RIGHT-ALIGNED IN BR,
SC_#,FE_#,#/20.,J/BD4 ;LOOK FOR LARGER POWER OF TEN
BD3: BR_AR LONG,AR_AC3, ;SAVE POS BINARY, GET AC FLAGS
CALL,J/SETFLG ; SET FLAGS AS NEEDED
=11 AC3_AR,AR_BR*.5 LONG,J/BD2 ;SAVE NEW FLAGS, SHIFT BINARY RIGHT
;HERE TO FIND THE SMALLEST POWER OF TEN LARGER THAN THE BINARY INTEGER.
;BINARY IS IN BR LONG, AND POSITIVE UNLESS IT WAS 1B0. IN THIS CASE THE
;COMPARISON WILL NEVER FIND A LARGER POWER OF TEN, BUT THE COUNT IN FE
;WILL RUN OUT, AND WE WILL CORRECTLY COMPUTE 22 DIGITS REQUIRED.
=010 ;IGNORE BR SIGN
BD4: AR_AR*10 LONG,FE_FE-1,J/BD6 ;THIS POWER IS TOO SMALL
SC_FE-SC-1,T1_AR,AR_ARX,J/BD7 ;THIS POWER IS BIG ENOUGH
FE_FE-1 ;10.**21 IS TOO SMALL, USE 22
SC_FE-SC-1,T1_AR,AR_ARX,J/BD7 ;10.**21 IS BIG ENOUGH
BD6: GEN AR-BR-1,DISP/DIV,J/BD4 ;COMPARE BINARY TO 10**N
;HERE HAVING FOUND THE NUMBER OF DIGITS REQUIRED TO REPRESENT THE
; GIVEN INTEGER. THE ONE'S COMPLEMENT OF THE NUMBER OF DIGITS IS NOW
; IN SC, AND T1/T2 IS GETTING A POWER OF TEN LARGER THAN THE INPUT.
=0*
BD7: T2_AR,AR_1S,CALL,J/GETSC ;SAVE (10**N), GET -# OF DIGITS
SLEN_AR,ARX_AR*4 COMP ;-# OF SIGNIFICANT DIGITS-1
AR_AC3 ;GET FLAGS, LENGTH
FE_AR0-8,AR0-8_#,#/0 ;LEN IN AR, FLAGS IN FE
AR_ARX*.25-AR-1,SKP CRY0, ;-# OF FILL CHARS -1
SC_FE-#,#/400 ;SC0 SET IF S FLAG =0
=0 ARX_AR+1,AR_0.M,J/BD8 ;ENOUGH SPACE. -FILL CNT TO ARX
I FETCH,J/NOP ;OVERFLOW
BD8: AR0-8_FE.M,SKP SC0, ;FLAGS TO AR. S FLAG =0?
GEN ARX COMP,SIGNS DISP ; OR EXACT LENGTH?
=110 T0_AR,LOAD AR,J/BDF1 ;FLAGS TO T0, GET FILLER
BD9: AC3_AR,J/BDDV1 ;NO FILL. FLAGS TO AC3
=00
BDF1: AR_MEM,SR_BDF,CALL,J/RET1 ;GET FILLER, GO WAIT FOR PARITY
FILL_AR,AR_ARX,CALL,J/MOVF2 ;FILL AS REQUIRED
=11 AR_T0,J/BD9 ;GET FLAGS BACK
;SETUP FOR LONG DIVISION OF BINARY BY 10**N
;BR STILL HAS BINARY RIGHT ALIGNED (IE, LOW SIGN SQUEEZED OUT BY
; SHIFTING HIGH WORD RIGHT). BR IS POSITIVE UNLESS INPUT INTEGER WAS
; 1B0, IN WHICH CASE BR IS -1B1. T1,T2 HAS LARGER POWER OF TEN, UNLESS
; BINARY EXCEEDS 10**21, IN WHICH CASE T1,T2 CONTAINS 10**21. SINCE
; BINARY CANNOT BE AS LARGE AS 2 * 10**21, THE FIRST DIVIDE STEP
; IS GUARANTEED TO GENERATE A 1 IN THIS CASE ONLY, AND TO REDUCE THE
; BINARY TO LESS THAN 10**21.
BDDV1: ARX_T2,CLR AR ;FILL DONE. GET 10**N
=110 AR_T1,MQ_AR, ;D'SOR SET IN AR, MQ CLR
SKP BR0,CALL,J/BDDV2 ; CHK D'END SIGN
ARX_AR,AR_AC0,SET FPD,B DISP ;DONE, GET FULL QUO IN AR LONG
=0 AR_AR+1 LONG,SR_BDT,J/BDD1 ;PREVENT 9'S DISEASE
BR_AR LONG,AR_E1 ;OFFSET MODE, MUST SIGN EXT E1
ARL_0.M,SKP AR18
=0
BDE2: E1_AR,AR_BR+1 LONG,J/BDD1 ;UPDATE E1
ARL_1S,J/BDE2 ;MAKE FULL E1 NEG
=000
BDDV2: AR_BR LONG,BR_AR LONG, ;BEGIN LONG DIVISION
SC_#,FE_#,#/34., ;STEP COUNTS FOR BOTH PARTS
CALL,J/DDVSUB
AR_-BR,ARX/ADX,BR_AR LONG, ;HERE IF BINARY WAS 1B0
SC_#,FE_#,#/34., ; IT'S NOW 1B1
CALL,J/DDVSUB
=011 AC0_AR,AR_MQ,ARL/AD,MQ_0.M, ;HALF DONE WITH DIVISION
FE_SC,J/DDVLP ;RESUME WITH ADD STEP
=101 AC0_AR,AR_MQ,ARL/AD,MQ_0.M,
FE_SC,J/DDVSUB ;RESUME WITH SUBTRACT STEP
=
;HERE WITH QUOTIENT OF <INPUT INTEGER>/<10**N> IN AR LONG, WITH THE
; BINARY POINT BETWEEN BITS 0 AND 1 OF AR. THUS, BIT 0 WILL BE SET
; IFF THE INPUT INTEGER WAS GREATER THAN OR EQUAL TO 10**21.
; SINCE THIS IS A TRUNCATED FRACTION, IT IS NOT GREATER THAN THE TRUE
; QUOTIENT, AND THE ERROR IS LESS THAN 2**-71. WE ADD 2**-71, TO
; GUARANTEE THAT OUR FRACTION IS GREATER THAN THE TRUE QUOTIENT,
; WITH AN ERROR NO GREATER THAN 2**-71. WE WILL THEN MULTIPLY THIS
; FRACTION BY 10 N TIMES, REMOVING THE INTEGER PART AT EACH STEP
; TO EXTRACT THE N DIGITS. SINCE N IS AT MOST 21, THIS IS A MULTIPLI-
; CATION BY AT MOST 10**21, SO THE ERROR IS AT MOST (2**-71)*(10**21).
; SINCE THIS IS LESS THAN ONE, THE ERROR DOES NOT INTRUDE INTO THE
; OUTPUT DIGIT STRING.
;HERE IS LOOP TO EXTRACT DIGITS FROM FRACTION IN AC0,AC1
BDD1: BR_AR LONG,VMA_PC+1, ;START NEXT LOOP ITERATION
AR_SLEN+1,SKP CRY0 ;ANY MORE DIGITS?
=0 ;HERE TO RESUME AFTER INTERRUPT
BDDR4: SLEN_AR,MQ_AR,SC_1, ;YES, SAVE LENGTH REMAINING
AR_BR LONG, ; AND GET FRACTION
SIGNS DISP,J/BDD2 ;CHECK FOR 1ST DIGIT OF 10**21
AR_0S,ARX_0S,CLR FPD, ;NO, DONE. CLEAR AC0 & AC1
VMA_VMA+1
AC0_AR,FETCH,J/STRAC1 ;MOVE FETCH WHEN TIMING FIXED
=101 ;LOOK AT BR0 ONLY
BDD2: AR_AR*1.25 LONG,SC_#,#/4 ;NEXT DIGIT TO AR0-3
ARX_AR,AR_0S,SKP INTRPT ;READY TO SHIFT IN DIGIT
=0 AR_SHIFT,B DISP,J/BDD3 ;STORE IT
AR_BR LONG,SR_0,J/B2DPF ;UPDATE REGS & QUIT
;HERE TO STORE DIGIT IN AR FOR BDEC
=0
BDD3: VMA_AR+E1,LOAD AR,J/BDD4 ;TRANSLATE: GET TABLE ENTRY
AR_AR+E1,J/BDD7 ;OFFSET AR AND STORE IT
BDD4: SKP MQ EQ -1,TIME/3T,ARX_0.M ;LAST DIGIT?
=0
BDD5: AR_MEM,J/BDD6 ;NO, STORE RH (POS DIGIT)
ARX_AC3,J/BDD5 ;YES, LOOK AT M FLAG
BDD6: SKP ARX2,ARX_AR SWAP,ARL_0.M
=100
BDD7: SR_BDD,CALL,J/PUTDST
AR_ARX,ARL_0.M,J/BDD7 ;M SET ON LAST DIGIT, USE LH
AR_BR LONG,SR_BDT, ;GET FRACTION BACK
SIGNS DISP ;CHECK BR0 FOR INTEGER PART
=
=101 AR_AR*10 LONG ;DISCARD PREVIOUS DIGIT
P_P AND #,#/37,J/BDD1 ;CLEAR AR0, GO FOR NEXT
.ENDIF/DECIMAL
.TOC "EIS -- SRCMOD SUBROUTINE TO GET MODIFIED SOURCE BYTE"
;SLEN = COMPLEMENT OF LENGTH
;MSK = MASK
;E1 = EFFECTIVE ADDRESS OF OPERATION WORD (SIGN EXTENDED IF OFFSET)
;CALL WITH: AR_SLEN+1,CALL,J/SRCMOD
;RETURNS: 1 LENGTH EXHAUSTED: FLAGS IN AR
; 2 (EDIT ONLY) NO SIGNIFICANCE: FLAGS IN FE
; 3 (EDIT ONLY) SIGNIFICANCE START: BYTE IN AR, FLAGS IN FE
; 4 NORMAL: BYTE IN AR
; 5 ABORT: OUT OF RANGE OR TRANSLATE FAILURE
; BR, BRX, PRESERVED.
; B=0 IF TRANSLATE, =1 IF OFFSET MODE, =2 IF EDIT, =4 IF CVTDBT
=00
SRCMOD: SLEN_AR,AR+ARX+MQ_0.M,CALL.M, ;PUT LENGTH AWAY, GET BYTE
SIGNS DISP,J/GSRC ;CHECK FOR LENGTH EXHAUSTION
AR_SFLGS,SR_0,RETURN1 ;LEN =0, DONE
E1,TIME/2T,B DISP ;BYTE IN AR
=110 AR_AR*.5 LONG,E1,J/XLATE ;LOW BIT TO ARX0, BYTE/2 TO AR LOW
AR_AR+E1,TIME/3T ;OFFSET, ADD OFFSET, TEST MASK
TEST AR.MSK,SKP CRY0,RETURN4 ;RETURN 4 IF OK, 5 OUT OF RANGE
;HERE ON TRANSLATE-MODE OPERATIONS, WITH THE BYTE/2 IN AR, AND
; THE LEAST SIGNIFICANT BIT OF THE BYTE IN ARX0. PERFORM THE
; TABLE LOOKUP, AND OPERATE AS CONTROLLED BY THE HIGH THREE BITS
; OF THE TABLE ENTRY.
XLATE: VMA_AR+E1,LOAD AR ;GET FUNCTION FROM TABLE
TRNAR: AR_MEM,SKP ARX0,SC_#,#/18. ;WHICH HALF?
=0 ARX_AR,AR0-3 DISP, ;LH, MOVE TO ARX LEFT
AR_SFLGS,J/TRNFNC
ARX_AR SWAP,AR18-21 DISP, ;RH, MOVE THAT TO ARX LEFT
AR_SFLGS,J/TRNFNC
;HERE ON TRANSLATE OPERATION TO PERFORM FUNCTIONS REQUIRED BY
; THE 3 HIGH ORDER BITS OF THE TRANSLATE FUNCTION HALFWORD.
; WE HAVE DISPATCHED ON THOSE THREE BITS, WITH THE FUNCTION
; HALFWORD IN LH(ARX), AND THE FLAGS FROM AC0 IN AR.
=0001
TRNFNC: SFLGS_AR,FE_P,AR_SHIFT, ;SAVE FLAGS, GET FCN IN AR RIGHT
SIGNS DISP,J/TRNRET ;WAS S FLAG ALREADY SET?
TRNABT: SFLGS_AR,FE_P AND #,#/3,RETURN5 ;ABORT
P_P AND #,#/67,J/TRNFNC ;CLEAR M FLAG
P_P OR #,#/10,J/TRNFNC ;SET M FLAG
TRNSIG: P_P OR #,#/20,J/TRNFNC ;SET N FLAG
P_P OR #,#/20,J/TRNABT ;SET N AND ABORT
P_P AND #,#/67,J/TRNSIG ;CLEAR M, THEN SET N
P_P OR #,#/30,J/TRNFNC ;SET N AND M
=011
TRNRET: ARX_AR*MSK,AD/AND, ;S FLAG IS 0, GET BYTE IN AR
SKP AR18,B DISP,J/TRNSS ;IS THIS EDIT?
AR_AR*MSK,AD/AND,RETURN4 ;RETURN NORMAL SINCE S FLAG SET
=100
TRNSS: AR_DLEN,B DISP,J/TRNNS1 ;NO SIG ON MOVE OR D2B
AR_SFLGS,SC_#,#/40,J/TRNSS1 ;SIG START, SET FLAG
VMA_E0+1,LOAD AR,RETURN2 ;EDIT NO SIG. GET FILL
AR_DSTP,FE_#,#/36.,RETURN3 ;EDIT SIG START
=0**
TRNNS1: AR_AR-1,J/TRNNS2 ;COMPENSATE FOR IGNORING SRC
AR_SLEN+1,J/SRCMOD ;D2B HAS NO DEST LENGTH
TRNNS2: DLEN_AR,SIGNS DISP
=011 AR_SLEN,J/SRCMOD ;SLEN = DST LEN, DON'T CHANGE IT
AR_SLEN+1,J/SRCMOD ;SLEN REFLECTS SRC LENGTH
; COUNT DOWN FOR BYTE SKIPPED
TRNSS1: P_P OR SC
SFLGS_AR,AR_ARX,RETURN4 ;RETURN WITH SIG SET
;SUBROUTINE TO GET BYTE FROM SOURCE STRING
; CALL GSRC WITH SIGNS DISP TO CHECK FOR LENGTH EXHAUSTION
; [TIME = 17 + 3(BP OVERFLOW)]
=011
GSRC: AR_DLEN,RETURN1 ;LEN RAN OUT
GETSRC: AR_SRCP,ARX_SRCP,FE_#,#/36.
=0
GSRC1: P_P-S,SC/SCAD,CALL.M, ;UPDATE POINTER
SKP SCAD0,J/GSRC2 ;TEST FOR WORD OVERFLOW
SC_FE+SC,SKP INTRPT,J/LDB1 ;GET BYTE & RETURN TO CALLER
=0
GSRC2: SRCP_AR,ARX_AR,FE_S, ;STORE POINTER,
EA MOD DISP,J/BFETCH ; GO EVALUATE THE ADDRESS
AR_AR+1,P_FE-S,SC/SCAD,J/GSRC2
;SUBR TO STORE AR IN DEST STRING
; [TIME = 24 + 3(BP OVERFLOW)]
=00
PUTDST: MQ_AR,AR_DSTP,ARX_DSTP,
FE_#,#/36.,CALL,J/IDST
AR_MQ,SC_#-SC,#/36.,SKP SCAD0,
CALL,J/DPB1
=11 MEM_AR,RETURN6
;SUBROUTINES TO UPDATE STRING POINTERS
IDST: P_P-S,SC/SCAD,SKP SCAD0 ;TEST FOR WORD OVERFLOW
=0
IDST1: DSTP_AR,ARX_AR,FE_S, ;STORE POINTER,
EA MOD DISP,J/BFETCH ; GO GET THE WORD ADDRESSED
AR_AR+1,P_FE-S,SC/SCAD,J/IDST1
.ENDIF/EIS
XFERW: FIN XFER,MB WAIT,RETURN2 ;FINISH TRANSFER, RETURN
.IF/EIS
.TOC "EIS -- EDIT FUNCTION"
; HERE WITH E0, E1 SETUP, 0 IN AR, -1 IN ARX, AND 15 IN SC
EDIT: AR_SHIFT,ARX_AC0 ;MASK TO AR, FLAGS ETC TO ARX
=1*0 MSK_AR,AR_ARX (AD), ;SAVE MASK, GET FLAGS IN AR
VMA_ARX,LOAD AR, ;GET FIRST PATTERN OPERATOR
CALL,J/TRNABT ;GET PBN INTO FE
EDITLP: SC_# AND AR0-8,#/30, ;PBN*8 IN SC
SFLGS_AR,ARX_AR ;UPDATED AC NOW IN AC AND ARX
=0* SC_FE+SC,SR_0,CALL,J/XFERW ;PATTERN IN AR, PBN*9 IN SC
AR_SHIFT,SH DISP,SC_#,#/5 ;PATTERN BYTE TO AR0-8,
=0001 ; DISP ON HIGH 3 BITS
EDDISP: GEN #+AR0-8,#/-5,
SKP SCAD0,J/EDOPR ;(0XX) OPERATE GROUP
AR_AR*8,SKP ARX0,J/EDMSG ;(1XX) MESSAGE
J/EDNOP ;(2XX) UNDEFINED
J/EDNOP ;(3XX) UNDEFINED
J/EDNOP ;(4XX) UNDEFINED
MQ_ARX,ARX_ARX*4,
SC_FE+1,J/EDSKPT ;(5XX) SKIP IF MINUS
MQ_ARX,ARX_ARX*2,
SC_FE+1,J/EDSKPT ;(6XX) SKIP IF NON-ZERO
AR_AR*8,SC_FE+1,J/EDSKP ;(7XX) SKIP ALWAYS
;HERE TO DECODE OPERATE GROUP
=0
EDOPR: J/EDNOP ;OPR .GE. 005 UNDEFINED
SH DISP,J/OPDISP ;(00X), DISP ON LOW 3 BITS
=000
OPDISP: AR_ARX,SC_#,#/-4, ;(000) STOP
VMA_PC+1,J/EDSTOP
SR_ED(S),J/EDSEL ;(001) SELECT
AR_DSTP,SKP ARX0,J/EDSSIG ;(002) START SIGNIFICANCE
AR_ARX,J/EDFLDS ;(003) FIELD SEPARATOR
VMA_AC3,LOAD ARX, ;(004) EXCH MARK AND DEST
MQ_ARX,J/EDEXMD
=
;HERE TO TERMINATE EDIT INSTRUCTION
; SC HAS -4, FE HAS CURRENT PBN, VMA HAS PC IF ABORT, PC+1 IF DONE
EDSTOP: FE_FE-#,#/3,SKP SCAD0
=0 AR_AR+1,INH CRY18,
P_P AND SC,J/SFET1
P_P+1
SFET1: FETCH+1,J/STORAC
;HERE FOR SKPM & SKPN, WITH APPROPRIATE BIT IN ARX0
EDSKPT: AR_AR*8,SKP ARX0,ARX/MQ ;SKIP DISTANCE TO AR0-5
;HERE AT END OF OPERATION TO UPDATE PBN
=0
EDNOP: FE_FE-#,#/3,SKP SCAD0, ;END OF PATTERN WORD?
AR_ARX,J/EDNXT1
EDSKP: FE_P+SC,J/EDNOP ;ADD SKIP DISTANCE
=0
EDNXT1: AR_AR+1,INH CRY18, ;BUMP TO NEXT WORD
FE_FE-#,#/4, ;REDUCE PBN
SKP SCAD0,J/EDNXT1
FE_FE+#,#/4 ;RESTORE PBN POS, INCR IT
SC_P AND #,#/74,VMA_AR,LOAD AR ;FLAGS & EDIT BIT TO SC, GET PATTERN
P_FE OR SC,J/EDITLP ;SET NEW PBN, GO DO NEXT PATTERN
;HERE TO EXCHANGE MARK AND DESTINATION POINTERS
EDEXMD: AR_DSTP ;READY TO STORE DEST PTR
FIN XFER,STORE ;WAIT FOR MARK, STORE DSTP
MEM_AR,AR_ARX ;READY TO UPDATE DSTP
DSTP_AR,ARX/MQ,J/EDNOP ;DONE, GET NEXT OPR
;HERE FOR FIELD SEPARATOR (CLEAR FLAGS IN AC 0-2)
EDFLDS: P_P AND #,#/7,J/EDSEND ;EASY ENOUGH
;HERE FOR SIG START
=00
EDSSIG: VMA_AC3,STORE,CALL,J/EDFLT ;SAVE MARK, GET FLOAT
FE_FE-#,#/3,SKP SCAD0, ;S FLAG ALREADY SET, NOP
AR_ARX,J/EDNXT1
=11
EDSEND: FE_P AND #,#/3,ARX_AR,J/EDNOP ;READY TO DO NEXT OP
;HERE FOR MESSAGE CHAR
=00
EDMSG: VMA_E0+1,LOAD AR,J/EDSFIL ;NO SIG, PUT FILLER
SC_P,AR_0S,CALL,J/GETSC ;GET MESSAGE SELECT IN AR
=11 VMA_AR+E0+1,LOAD AR,J/EDMPUT ;STORE MESSAGE
;HERE FOR SELECT
=0*
EDSEL: AR_SRCP,ARX_SRCP,FE_#,#/36.,
CALL,J/GSRC1 ;GO GET SRC BYTE
AR_AR*.5 LONG,E1 ;GOT IT, DIVIDE BY 2
=000 VMA_AR+E1,LOAD AR,CALL,J/TRNAR ;GO TRANSLATE BY HALFWORDS
=010
EDSFIL: AR_MEM,J/EDSF1 ;(2) NO SIGNIFICANCE, STORE FILL
GEN P-S,SKP SCAD0,BRX/ARX,J/EDSFLT ;(3) SIG START, DO FLOAT CHAR
EDSPUT: SR_ED(+D),CALL,J/PUTDST ;(4) NORMAL, STORE AT DST
VMA/PC,SC_#,#/-4,J/EDSTOP ;(5) ABORT
EDFPUT: AR_SFLGS,J/EDSEND ;(6) BUMP PBN AND GO TO NEXT
EDMPUT: AR_MEM,J/EDSPUT ;FILL OR MSG IN AR, STORE IT
;HERE WHEN TIME TO STORE FILL CHAR
EDSF1: SKP AR NE,J/EDFPUT ;IS THERE ONE?
;HERE WHEN SELECT STARTS SIGNIFICANCE
=00
EDSFLT: VMA_AC3,STORE,CALL,J/EDFLT ;STORE DEST AT MARK ADDR
P_FE,AR_AR+1,J/EDSFLT ;FORCE STANDARD POINTER FORM
=11 SFLGS_AR,AR_BRX,J/EDSPUT ;SET S FLAG, GET BYTE, STORE IT
;HERE IS SUBROUTINE TO STORE FLOAT CHAR
EDFLT: MEM_AR,AR_2 ;GET FLOAT FROM E0+2
=0* VMA_AR+E0,LOAD AR,CALL,J/XFERW
SKP AR NE
=100 AR_SFLGS,SC_#,#/40,J/SETFLG ;NO FLOAT CHR, SET S FLAG
SR_ED(+D),CALL,J/PUTDST ;STORE FLOAT CHR IN DST
=111 AR_SFLGS,SC_#,#/40 ;SET S FLAG AND RETURN
SETFLG: P_P OR SC,RETURN3 ;NO FLOAT CHR, SET S FLAG
.ENDIF/EIS

552
src/ucode/fp.5 Executable file
View File

@@ -0,0 +1,552 @@
.TOC "SINGLE FLOATING ADD & SUB -- FAD, FADR, FSB, FSBRôCE
 .DCODE
.ù1§O©/UFA.ø‘§
130: I, J/UUO ;UFA
I, J/UUO ;DFN
.ENDIF/UFA.DFN
140: R, FL-AC, B0/0, J/FAD
R, B0/0, J/FADL
RW, FL-MEM, B0/0, J/FAD
RW, FL-BOTH,B0/0, J/FAD
R, FL-AC, J/FADR
I, FL-AC, B0/0, J/FADRI
RW, FL-MEM, J/FADR
RW, øÓŸTH, J/FADR
150: R, FL-AC, B0/1, J/FSB
R, B0/1, J/FSBL
RW, FL-MEM, B0/1, J/FSB
RW, FL-BOTH,B0/1, J/FSB
R, Fù‹`ÃY J/FSBR
I, Fù‹`ÃY B0/1, J/FSBRI
RW, FL-MEM, J/FSBR
RW, FL-BOTH, J/FSBR
.UCODE
.IFNOT/FPLONG
=00**00
FAD:
FSB: SR_#,#/1,B DISP,J/FADR ;FLAG NO ROUND, GO FAD/FSB
FMP: SR_#,#/1,J/FMPR
FDV: SR_#,#/1,J/FDVR
FADL:
FSBL:
FMPL:
FDVL: AR_BR,J/UUO ;LONG MODE BECOMES UUO
=
.IF/FPLONG
=00***0
FAD:
FSB: SR_#,#/1,B DISP,J/FADR ;FLAG TRUNCATE MODE, GO FAD
FADL:
FSBL: SR_#,#/2,B DISP,J/FADR ;FLAG LONG MODE
.ENDIF/FPLONG
=
=00*010
FADRI:
FSBRI: AR_AR SWAP,B DISP
FADR: FE_EXP,EXP_SIGN,SC/SCAD,
ARX_0S,J/FAS
=111
FSBR: FE_EXP,SC/SCAD,EXP_SIGN,ARX_0S
= AR_-AR,J/FAS ;NEGATE SUBTRAHEND
;FIND OPERAND WITH LARGER EXP, LEAVING IT IN BR,
; AND ITS EXP-1 IN FE. THE SMALLER OPERAND IS LEFT IN AR,
; SHIFTED RIGHT BY THE DIFFERENCE BETWEEN THE EXPONENTS -1
FAS: BR/AR,BRX/ARX,AR_AC0 ;SAVE MEM OP IN BR, GET AC
SC_EXP-SC,EXP_SIGN,SKP SCAD0 ;FIND LARGER OPERAND
=0 FE_FE+SC,BR/AR,AR_BR*2,J/FAS1 ;AC EXP .GE. MEM
MQ_AR,SC_#+SC,#/37., ;MEM OP LARGER, SHIFT AC OP
SKP SCAD0,J/FAS2 ;COMPUTE SHIFT AMOUNT
FAS1: MQ_AR,SC_#-SC,#/36.,SKP SCAD0 ;CHECK SHIFT AMOUNT
=0
FAS2: MQ_SHIFT,ARX/MQ,AR_SIGN,J/FAS3 ;LOW TO MQ, READY TO GET HI
AR_SIGN,ARX_AR, ;HERE IF EXP DIFF .GT. 36
SC_#+SC,#/36.,SKP SCAD0 ; .GT. 72?
=0 ARX_SHIFT,MQ_0.M,FE_FE+1,J/FAS5
ARX_AR,MQ_0.M,FE_FE+1,J/FAS5 ;SHIFTED CLEAR OUT
FAS3: AR_SHIFT,ARL/SH,ARX/MQ,
MQ_0.M,FE_FE+1 ;READY TO ADD
FAS5: AR_(AR+2BR)*.25,ARX/ADX*.25, ;HERE FOR ADD OR SUB
NORM,J/SNORM
.TOC "SINGLE FLOATING MULTIPLY -- FMP, FMPR"
.DCODE
160: R, FL-AC, J/FMP
R, J/FMPL
RW, FL-MEM, J/FMP
RW, FL-BOTH,J/FMP
R, FL-AC, J/FMPR
I, FL-AC, J/FMPRI
RW, FL-MEM, J/FMPR
RW, FL-BOTH,J/FMPR
.UCODE
.IF/FPLONG
=00***0
FMP: SR_#,#/1,J/FMPR ;FLAG TRUNCATE MODE
FMPL: SR_#,#/2,J/FMPR ;LONG MODE
=
.ENDIF/FPLONG
=00***0
FMPRI: AR_AR SWAP
FMPR: SC_EXP,EXP_SIGN,ARX_0S ;PREPARE M'IER FRACTION
= MQ_AR,AR_AC0,FE_#,#/-14. ;M'IER TO MQ, GET M'CAND
=01* SC_EXP+SC,EXP_SIGN, ;SEPARATE M'CAND FRACTION FROM EXP
CALL.S,J/MULSUB ;AND BEGIN MULTIPLY
=11* FE_#+SC,#/-200,NORM AR,J/SNORM
=
.TOC "úrgG™E FLOø5$Î<> DIVIDE --ô¢VY FDVR"
.DCODE
170: Rõ‚cL[ø0Ö •/FDV
R, FL-AC, J/Fø•¦
 RW, FL-MEM, J/FDV
RW, FL-BOTH,J/FDV
R, FL-AC, J/FDVR
I, FL-AC, J/FDVRI
RW, FL-MEM, J/FDVR
RW, FL-BOTH,J/FDVR
.UCODE
.IF/FPLONG
=00***0
FDVL: Fø·âØ¡-1,EXP_SIGN,ARX+MQ_0.S,J/øÑ+Lcñ¢£D­: SR_#,#/1,J/FDVR ;FLAG TRUNøpjEAMODE
=
.ø³¢I<EFBFBD>/FPLOùÑÆŠ{00***öEF‰VRI: ø4¯Á¥ SWAP
FDVúN„Ó‡ûñlPW1,EXP_SIGN,ARX+MQ_0.S ;SETUP DIVISOR
=îñOX0a BR/AúK!R±/ARX,ñ"D»‰IVISOúH*OABR, Cù”<C3B9>B¥X
ø4¯Á‡0,FE_ôk¯e7., ;øñj ‰IVIDEùÑ §TEP CùõgT
SKú Äa,CALLõ’—ƉVCHKîñCE=c0 SKPô©0YCALL,ùKâI­- ;OùkB‹GIN Dù5¤Ó“ON
úqj <20>L NO ø’k,•/IFNOúD»<44>O DIVù1"¬ASORRYñ¢†ŠwRETURùÈ$E¥E WITù(ÕŸTIENTôg ƒRX. úñPTŸOK 29ô$Ö“DE STø´)¬ATO
;ôêÁ¥ANTEEô Ö“NG A úSêΉING Bù5E­EN IFô$EAFIRSTôêE¡ GENEúPjE§
; AôjÏ©IENT øRj ŸF ZERùë<C3B9> ©HEREFùô¢¬ATHE Múp<C3BA>O<EFBFBD> QUOTù1gTAIS EIú’"Ò
; INô¤ÔA7 OR ÷ A<>D NORù¨+É™L FINøˆ$ÔAIN ONø¨)Ô‹P.
îñOX±a AR_AúVF‹_FE+#õˆ×²Y ;NEøðjI­E QUOú’bΩ
SùtB¥ EQ,Jõñ¢V<C2A2>EG ;CùaËAFOR Mùô¢ £UO TOôçÍ‹
ARûðiXU.25,AúV/Á¥X*.25õ“§Ò›, ;JUùÒÐI§ 36 Bù5) ƒWAY FúSæ ›SB
ñ1¢ß<C2A2>E+#,#õì–J_SNORMñ.èO§ QUOTù1gTY NORMø3$Ú‹
=
;HERE IF QUOTIENT SHOULD BE NEGATIVE, WITH POSITIVE FORM INîñNÐA¥ AND ø4¬.A SKIPôc ¥EMAINø‘i QIN BRõ($ÓAZERO.ô$ÎATHIS øpiÅY
; Wø¨!Ì‹AR ARû B‹CAUSEôi ‡ONTAIùÔÐT‘E ENTù4¢ £UOTIEùÕ
; IF, HOWEVER, THE REMAINDER IS NOT ZERO, WE INFER
; Tùj ƒN INFù3¤Ô‹ PRECù4äÏ<C3A4> DIVIúrgÎAWOULDôâ΋RATE ù³éEAONESîñNÐI<C390> THE ú5gÔ“ENT. ôc ©HAT Iúh*H‹ CASEõˆ+ÅALEAVEôiXAWITH ú’"<22>; QUOTIENT, SO THE NEGATION PROCESS WILL WORK CORRECTLY TO RETURNñ¢<C3B1> ©HE HIøòO¥DER Pø4ª ŸF THEôgF“NITE-ú¢Ã“SION ùÑcÁ©IVE Qú³êI‹NT.
÷¬Š<>DVNEG÷BiÅ© SR1,ø4¯Á¥*.25 ù“çGYNORM,ùKéΟRM
ø4¬_aS,J/Fø•§E<C2A7> ;Rø³`É<>DER Wø³ª ©O ZERùãE wHERE øÓé <20>DVL
ñ¢—I<EFBFBD>/FPLOùÑÆŠ
;FDVùŽ„Æ‹_EXP-ö+"Ø¡_SIGNõ<4E>æRAARX+Mú#E=a00
Fø•¦1u AR_AølVB¥_AR Lùó£¬ ;SAVø¨"I­ISOR ù3<C3B9>B¥ LONGñ¢„‰§C_#,#õîW,‡ALL ÷t¢Á‰Y TO úr$Æ© LOW ø’kI‰END
ARX_SHIFT,AR_AC0, ;DIVIDEND IN PLACE
SC_FE,FE_#,#/24., ;EXP TO SC, STEP COUNT TO FE
SKP AD0,J/FDVCHK ;GO CHECK FOR NO DIVIø‘FŠ{010 Cø3&,§KP BRö %/<2F>DVL2 ñ.ãÏABEGINô$Ö“DE
úqj <20>L NO ø’k,•/IFNOúD»‡AN'T ø’kI‰E, ABùôª

=11ö`Ò¿AC0,SúWѬG/5, ÷s¢ÇAQUO, øÓ ÇATRUNCø5" ›ODE
SR DISP,J/FDVL4 ; WAS IT 26 OR 27 STEPS?
AR_AC0,SR_#,#/1, ;POS Qú³ÆŠ SR Dù4è,•/FDVLöƒE=
;COME HERE TO START THE DIVISION. ON THE FIRST STEP, WE CHEørÆŠw TO Sø±PW‘ETHERôP1AHAS Bø±g <20>ENERAú‘b “N THEôjÏ©IENT.ô$ÆASO,
; 26 ADDITIONAL STEPS WILL GENERATE THE FULL 27 SIGNIFICANT BITS
; OFô$EAQUOTIø³ª.A IF Nùõ e7 STEúÐA¥E REQú²iE‰.
÷¬Š<>DVL2:ñ1$Ö“DE,ARûì”A¥-BR),ø4¬/ƒDX*2,ùKãD­L3 ;Fù4©ÔADIVIDø¨)Ô‹P
Dù5¤Ä‹,AR_2(AR+BúJVA¥X/ADX*2 ; DOESôj <20>ø³¢Òƒú‘PAA1?
=ö Š<>ø•¦3u DISP/DIV,MQ/MQ*2, ÷s§¬Aú<41>eÅAAN EXú”  ‰IVIDE STEPñ¢„‰ƒR_2(AR+BR),ARX/ø1,*e,J/DIVLP ; WITHùõj ‡OUNTING FE
SRûìVS‡_#+SCõˆ×±YJ/DIV- ;Yø´Ö e7 STEPS WIù“NŸRMALIûQPQ«ùãE ‰ù4è/‰IV,MQõóhªeõ<65>i_eõi-…R),ARX/ADX*2,J/ø’kL¡
SRûìVS‡_#+SCõˆ×±YùKâI­õcE wWE COù±PH‹RE AFTER DùògGATHE DIVISION, EITHERô › ŸúH7ASTEPSñ¢<C3B1> ƒúh)E£ú²iE‰ TO GENERAú‘PAAùÓéMƒù’mE‰ QUOTù1gTAFROM ùÓéMƒù’mE‰
; OPERANDS. ùÓë <C3AB>ù1êÒ‹ôêÔAWHAT EXPONø³ª ©ùPR‹MAINDER SHOULD HAVE.ñ¢†Š{öEF‰VL4: SC_EXP-#,#õì›®Yñ"D»‰IVIDEND EXP-27îñBDÁ¥_BR,SùtA¥ö %/<2F>DVL6 ÷qâÔAREMAIùÑ"ÒYô"Ó© D'ENøˆ)É<>N
SøwâØ¡-#,#/öM—, ;D'END Eû²mñ¢„‰ƒúWáRYSKP AR0
îñNäE¥E WITH REMAINDEúH$ÎAAR, Iú”ÐE±P IN úpÆŠwôåÉ¡ôc ‰'END (AND THEREøÓéEAREM) NEGATIVE.îñCE=a
FDVL6: Eû/Ó‡õ<E280A1>¬Ô‹ DISP, ;TEST FOR UNDERFLùõÆŠ SKP AR EQõ’—ƉVL7 ;ôé ¥EM =0
AR_-BR,SKP CRY0, ñ.çE<C3A7>ATE REM, CHECK =0
GEN úpÖB³ú‘PD“SP ; AND Lùóå <C3A5>OR EXú*Æ™ùãE=c10 EXP_-SC-1,J/øÑ+Lo ;ONE'S COMPLEù±gTAø¶(
 AR_0S ;REM =0 OR EXP UFLOîñOX±a
FDVL7: AøloÁ¥õ<C2A5>iXWMQ_0.ù«‰wúpkEAúQfÁ“ùÑ"Ò
AR_MQ,AúSÁ‰õ’—Ó<E28094>R2 ;Gùè'O¥MALIZE QUOTIENT
ARûì)¬•/FDVL7
.ENDIF/FPLONøãE

;SUBR TOôäE‡ùh#O¥ô¦OƒTING NO DIVIDE
; ENTER WITH SKP ON DIVIø‘gDASIGN, IN AR LONG, WITH
;ô$Ö“SOR EXP IN SC, ø’kI§OR IN BR
=0îñQ¢V‡HK: SC_EXP-SC,Eû/Ó“øó–S—P BR0õ’—ƉVCK1
AR_-AR LONG,J/FDVCHK ;øñj ¡OSITIúÑPD“úÒbE<62>øƒE=añ¢£D­ørغGEN AR-2BR,SKP øt¬°Y ;TEúuFŸúH'OADIVIDø£E úpï£WSC,#/ö-Û¬¥ETURN2 ;AND CORRECT EXP
GEN AR+2BR,SKP CRY0, ;SAME TEST, NEG DIVISOR
úpï£WSC,#/ö-Û¬¥øµ*Ò<>2 ;ANøˆ)Á›E EXPôçÒ¥ø°êIŸùÃE ]TOC "ú± ¬Aø‘§,AFSC, IBP"
;ENTø´<C3B8>W“TH (Eõ($ÎAø4†Š]IF/UFø+¢F<C2A2>ñ¢„®‰øsâE
130: R, J/UFAñ¢„Ò¡W, J/DFN
.UCODE
=00**õLŠ‰øÓ<C3B8> <09>ø·àÒa-8,AR0-8_#õˆ×°Yñ"]ÓƒúÑPLŸúè"Ø¡õˆ!Ì¥ SO Cø3<C3B8>
 ARX_0S,J/DFN1 ; DETECT FRACú’gÎA÷¨
UFA: FE_EXP,SC/SCAD,EXP_SIGN,AúV/°§
=
=000 BR_AR LONG,AR_AC0,CALL,J/ø¶(D
=100ñ0iX¿ø4–A¥_SIGNõ<4E>iL_AD, ;READû(*OAUNNORMALIZø¨)̓ù“"ÒAOP
ñ0àÌ™õÓVJ_úr$Æ©ñ¢„Á¥_SIGNõ<4E>iX_AD ;LOSTôæÁ™LER Oú U§E ITSôäÇ<C3A4>ñ¢„Á¥_AR+BúK)Ë¡ôb <20>ø«‰wIS REúufTAúrcΓøÒaÁ<61>T?
SC_Fø«$ <>øµ!È
=
=ö`Ãc_AR,J/FINIñ"D»<44>ùëC™ø°i ¥ESULT AC
SKP EXP NE,BR/AR ;IS RIGHT SHIFT REQ'D?
=0ñ4åÐAø4˜,<2C>ETCH WAIT,ùKêƃ4 ;NOõˆ$ÓARESULT NEG÷ãE ƒúWáRU.5,GEN FE-ôk¯göíÖS—P SCAøˆ'EYFETCH WAIT
=0 øÑo­c,SET FLOV
FE_øÑU±YSC/SCAD,SKP AR0
=0
UFA4÷B`Òa-8_SCõ’—Ó©ø0؉÷t'ÓY PUT IN EXP STRø2cÈ©ñ¢„Á¥ö \_[SC-1,J/STAC1 ;NEG, ú´â ‡ùóhL‹MENT OF EXúE

DFNö.„Á¥ûë`ÒYSKP CRY0 ; LOW FRACTION =0?
=0 AúL¸¿FE,STùô¢¬ñ"]Ó©ORE LOW WORD BAørÐTŸ MEM
ARX_AC0 COMP,J/STMAC ;ôâÔAøsæЙEMENTø±H“GH WORD
AR0-8_FE,STORE, ;LOW WORD WAS ZERO, INSTALLôlP
ARX_-AC0,J/STMAC ÷h#Å© NEGATED HIGH WORD
.ENDIF/UFA.DFNîñCŠ.DCODE
132: I, FL-AC, J/FSC
R, J/IBP ;ADJBP IF AC .NE. 0
.UCODE
=00***0
.IF/ADJBP
IBP: SKP AC#0,J/IBP1 ;IS IT IBP, OR ADJBP?
.IFNOT/ADJBP
IBP: J/IBP2
.ENDIF/ADJBP
;FSC
;ENTER WITH E IN AR
=00****
FSC: SC_EA,ARX+MQ_0.M,
AR_AC0,ARL/AD
= FE_EXP+SC,EXP_SIGN,J/SNR2 ;NORMALIZE SCALED RESULT
.TOC "FIX, FIXR, FLTR, EXTEND"
.DCODE
122: R, J/FIX ;UNROUNDED
.IF/EIS
R, J/EXTEND ;EXTENDED INSTRUCTION SET
.IFNOT/EIS
I, J/UUO
.ENDIF/EIS
126: R, J/FIXR ;ROUNDED
R, FL-AC, J/FLTR
.UCODE
;FLTR
;ENTER WITH (E) IN AR
=00***0
FLTR: FE_#,#/277,ARX_AR,SKP AR0, ;BINARY POINT TO RIGHT OF ARX
AR_SIGN,J/SNORM ; SIGN EXTENDED. GO NORMALIZE
;FIX AND FIXR
;ENTER WITH (E) IN AR
; FIX AND FIXR DIFFER ONLY IN THE ROUNDING CRITERION:
;FIXR ADDS 1 TO THE INTEGER PART IF THE FRACTION PART IS ONE-HALF
;OR GREATER. FIX DROPS THE FRACTION PART OF POSITIVE NUMBERS, BUT ADDS
;1 TO THE INTEGER PART OF NEGATIVE NUMBERS IF THE FRACTION PART IS NOT
;ALL ZERO.
; THIS IS IMPLEMENTED BY CHOOSING A FRACTION (THE ROUNDING
;CONSTANT) TO ADD TO THE INPUT, SUCH THAT A CARRY WILL OCCUR INTO THE
;INTEGER PART UNDER THE APPROPRIATE CONDITIONS. FOR FIXR, THE ROUNDING
;CONSTANT IS EXACTLY ONE-HALF. FOR FIX, IT IS ZERO ON POSITIVE INPUT,
;OR THE LARGEST POSSIBLE FRACTION (ALL 1S) ON NEGATIVE INPUT.
=00****
FIXR: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION
ARX_1B1,J/FIX1 ;GET ROUNDING CONSTANT
=
.IFNOT/EIS
;1005: ;REALLY IN SKPJMP FILE TO PREVENT 1005 BEING USED TWICE
;FIX: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION
; ARX_AR SIGN,J/FIX1 ;SET ROUNDING CONSTANT, GO FIX
.IF/EIS
=00***0
FIX: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION
ARX_AR SIGN,J/FIX1 ;SET ROUNDING CONSTANT, GO FIX
EXTEND: FE_#+AR0-8,#/-20,SKP SCAD0, ;VALID EXTENDED OPERATION?
ARX_AR,AR_BRX,J/EXT1 ; OPR TO ARX, AC TO AR
=
.ENDIF/EIS
=0
FIX1: SET AROV,J/IFNOP ;CAN'T DO IT, GIVE UP
BR/AR,CLR AR,ARX_ARX*2 ;ROUNDING CONSTANT READY IN ARX
BR_AR LONG,AR_BR,CLR ARX, ;MANTISSA TO AR LONG
SC_#,#/9. ;READY TO SHIFT OFF EXPONENT
ARX_SHIFT,AR_SIGN, ;MANTISSA LEFT ALIGNED IN ARX
SC_FE+#,#/36.,SKP SCAD0 ;ANY INTEGER BITS?
=0 MQ_SHIFT, ;YES, PUT THEM IN MQ
AR_ARX (ADX),CLR ARX, ;SHIFT MANTISSA LEFT 36 PLACES
I FETCH,J/FIX2 ;AND PREFETCH NEXT
AR_0S,I FETCH,J/STORAC ;ALL SIGNIFICANCE LOST
FIX2: ARX_SHIFT,AR_MQ ;INTEGER IN AR, FRACTION IN ARX
AR_AR+BR,AD LONG,J/STAC ;ROUND AND STORE
.TOC "SINGLE PRECISION FLOATING NORMALIZATION"
;HERE TO NORMALIZE SINGLE PRECISION RESULTS
;SR2-3 TELL HOW TO STORE RESULTS:
;XX00 ... ROUND, SINGLE PRECISION
;XX01 ... TRUNCATE, SINGLE PRECISION
;XX10 ... LONG MODE (IMPLIES TRUNCATION)
;IN ADDITION, THIS CODE SETS SR 1 IF ANSWER IS NEGATIVE, SO X1YZ
; CORRESPONDS TO X0YZ EXCEPT THAT THE RESULT MUST BE NEGATED.
;DISPATCH TO SNORM WITH "DISP/NORM,AR/AD*.25"
; THUS THE 8 POSSIBILITIES ARE:
;SNORM AD=0 AR=0 EITHER ANSWER IS ZERO, OR MSB IS IN ARX
;SNORM+1 AD0 AR NEG RESULT IS NEG. MAKE POS, TRY AGAIN
;SNORM+2 AD1-6 AR3-8 MSB TOO FAR LEFT, SHIFT RIGHT & RETRY
;SNORM+3 AD7 AR9 RESULT IS CORRECTLY NORMALIZED
;SNORM+4 AD8 AR10 SHIFT LEFT ONCE FOR NORMALIZATION
;SNORM+5 AD9 AR11 SHIFT LEFT 2 PLACES
;SNORM+6 AD10 AR12 SHIFT LEFT THRICE
;SNORM+7 AD11-35 AR13-35 SHIFT LEFT A LOT, TRY AGAIN
=000
SNORM: AR_ARX,ARL/SH,SKP ARX NE, ;AR IS ZERO, GET ARX
ARX_0.M,J/SNZERO
NORM -AR,SET SR1,J/SNORM ;REMEMBER NEGATIVE, GO POSITIVE
SNR2: AR_AR*.25 LONG,FE_FE+#,#/2, ;SHIFT RIGHT,
NORM,J/SNORM ;TRY AGAIN
SR DISP,J/SROUND ;AD7 -> AR9, IS ROUND REQ'D?
AR_AR*2 LONG,FE_FE-1, ;AD8 -> AR10, ONCE LEFT AND DONE
SR DISP,J/SROUND
AR_AR*4 LONG,FE_FE-#,#/2, ;AD9 -> AR11
SR DISP,J/SROUND
AR_AR*8 LONG,FE_FE-#,#/3, ;AD10 -> AR12
SR DISP,J/SROUND
ADA EN/0S,ADB/AR*4,AD/ANDCA, ;GENERATE AR*4
AR/AD*2,ARX/ADX*2, ; AR_AR*8 LONG
SC_#,#/12., ;READY TO SHIFT FARTHER
GEN CRY18,SKP CRY0 ; TEST AR0-19 FOR ZERO
=0 AR_AR*8 LONG,BR_AR LONG, ;IT WAS IN AR13-19
FE_FE-#,#/6,NORM,J/SN1 ; NOW IN AR10-16, AD8-14
MQ_SHIFT,AR_ARX (ADX), ;13-19=0, SHIFT TO TRY 20-35
CLR ARX,SC_#,#/10.
ARX_SHIFT,AR_MQ*.25, ;REPOSITION FRACTION IN AR LONG
FE_FE-#,#/13., ;COMPENSATE EXPONENT
NORM,J/SNORM
=100
SN1: AR_BR*2 LONG,FE_FE+#,#/2, ;MSB IN AD8, SO IN BR10
SR DISP,J/SROUND
AR_BR*4 LONG,FE_FE+1, ;MSB IN AD9, THUS IN BR11
SR DISP,J/SROUND
SR DISP,J/SROUND ;AD10 -> AR9, A LUCKY GUESS
AR_AR*8 LONG,BR_AR LONG, ;TRY SHIFTING 3 MORE
FE_FE-#,#/3,NORM,J/SN1
;HERE WHEN AD ENTIRELY ZERO ON NORMALIZE ATTEMPT. SKIP IF ARX
; IS NOT ZERO, HAVING COPIED IT TO AR (IE, LEFT SHIFT 36 PLACES).
; OTHERWISE, THE ENTIRE RESULT IS ZERO, SO WE STORE THAT.
=0
SNZERO: CLR FE,AR+ARX+MQ_0.M, ;RESULT = 0
SR DISP,J/SRND5
AR_AR*.25 LONG,FE_FE-#,#/34., ;HAVE MOVED LEFT 36, GO RIGHT 2
NORM,J/SNORM ;AND TRY THAT
;WE GET HERE WITH A NORMALIZED POSITIVE FRACTION IN AR'ARX,
; THE CORRECTED EXPONENT IN FE, AND SR INDICATES THE PROPER SIGN
; FOR THE RESULT AND WHETHER THE ANSWER SHOULD BE ROUNDED,
; TRUNCATED, OR LONG.
.IF/FPLONG
=100
.IFNOT/FPLONG
=1*0
.ENDIF/FPLONG
SROUND: BR_AR LONG,AR_0S,J/SRND2 ;PREPARE TO ROUND BY ADDING THE
; PART OF THE FRACTION WE WILL
; DISCARD (CARRY IF ARX0)
BR_AR LONG,CLR AR,ARX_1S, ;TRUNCATE MODE
SR DISP,J/STRNC ; HANDLING DEPENDS ON SIGN
.IF/FPLONG
BR_AR LONG,CLR AR,ARX_1S, ;LONG MODE
SC_#,#/9.
= ARX_SHIFT,SR DISP ;MASK = 0,,000777 TO ARX
=01*
BR_AR LONG,AR_BR LONG,J/SRND4 ;POS, TRUNCATE BY ANDING
AR_AR+BR,ARX/ADX,BR_AR LONG, ;NEG, MUST DIDDLE
NORM,J/SRND3 ; NORM FORCES LONG ARITH
.ENDIF/FPLONG
;HERE TO PERFORM ROUNDING OR TRUNCATION OF SINGLE-PRECISION RESULTS,
; AND CHECK FOR CARRY INTO EXPONENT FIELD REQUIRING RENORMALIZATION
=0*1
STRNC: AR_BR,CLR ARX,J/SRND4 ;POS TRUNCATE, GO STUFF IN EXP
SRND2: AR_AR+BR,NORM,CLR ARX ;NORM FORCES LONG ARITH
; SO THIS ADDS ARX TO BR'BRX
=1*0
SRND3: AR_AR*.5,FE_FE+1 ;RENORMALIZE
SRND4: EXP_FE TST,SR DISP, ;STUFF EXP, CHECK NEG OR LONG
ARX_ARX*BRX,AD/ANDCB ;CLEAR TRUNCATED FRACTION
;HERE TO STORE RESULT AS A FUNCTION OF SINGLE OR LONG PRECISION
; AND POSITIVE OR NEGATIVE...
.IF/FPLONG
=001
.IFNOT/FPLONG
=0*1
.ENDIF/FPLONG
SRND5: SR_0,B WRITE,J/ST6 ;POS & NOT LONG
.IF/FPLONG
SLNG3: AC0_AR,AR_0S,SC_#,#/27.,J/SLNG4 ;STORE HIGH PART OF LONG ANS
.ENDIF/FPLONG
AR_-AR,SR_0,B WRITE,J/ST6 ;NEG & NOT LONG
.IF/FPLONG
AR_-AR LONG,J/SLNG3 ;LONG NEG, MAKE IT SO
SLNG4: AR_SHIFT,I FETCH
AR0-8_FE-SC,BYTE DISP, ;TEST FOR EXP UNDERFLOW
SKP AR EQ ; OR LOW WORD ZERO
=110
.ENDIF/FPLONG
STRAC1: SR_0,J/STAC1 ;PUT AWAY LOW WORD OF LONG RESULT
.IF/FPLONG
AR_0S,SR_0,J/STAC1 ;CLEAR LOW WORD IN AC1
.ENDIF/FPLONG
.TOC "DOUBLE FLOATING ARITHMETIC -- DFAD, DFSB, DFMP, DFDV"
.DCODE
110: R, B/0, J/DFLOAT ;DFAD
R, B/2, J/DFLOAT ;DFSB
R, B/4, J/DFLOAT ;DFMP
R, B/6, J/DFLOAT ;DFDV
.UCODE
=00**0*
DFLOAT: FE_EXP,EXP_SIGN,SC/SCAD,MQ_0.S,
VMA_VMA+1,LOAD ARX,
CALL.S,J/XFERW ;GET LOW WORD
ARX_ARX*2,B DISP ;LOW BIT 0 IGNORED
=
=00*
DFAS: BR_AR LONG,AR_AC1*2,J/DFAS1 ;MEM OP READY, GET AC OP
AR_-AR LONG,J/DFAS ;DFSB, NEGATE AND ADD
AR_AC1,BR_AR LONG, ;HERE FOR DOUBLE FLOATING MUL
FE_#,#/-18.,J/DFMP
GEN AR*AC0,AD/XOR,SKP AD0, ;DFDV. WILL QUO BE NEG?
BR_AR LONG, ;SAVE D'SOR IN BR, BRX
SC_FE-1,J/DFDV
;HERE FOR DFAD AND DFSB
; MEM OPERAND IS IN BR (NEGATED IF DFSB)
; FE AND SC HAVE ITS EXPONENT
=0*0
DFAS1: ARX_AR,AR_AC0,CALL,J/EXPD ;AC OPERAND IN PLACE
=1*0
DFAS2: ARX_AR,AR_SIGN, ;GET SHIFTED HIGH WORD
GEN #+SC,#/-36., ;IS ANY SHIFT REQUIRED?
SKP SCAD0,J/DFAS3
ARX_AR,AR_SIGN, ;DIFF IS > 36
SC_#+SC,#/36.,SKP SCAD0 ;CHECK FOR >72
=0 AC0_AR,MQ_SHIFT,AR_ARX (ADX),
ARX/MQ,J/DFAS4 ;36 < DIFF < 72
AR_BR,ARL/AD,ARX_BRX, ;DIFF >72
MQ_0.M,J/DNTRY ;NORMALIZE LARGER OP
=0
DFAS3: AR_ARX,ARL/SH,ARX/MQ, ;NO SHIFT REQUIRED
MQ_0.M,J/DFAS5
AR_SHIFT ;BEGIN SHIFTING SMALLER OP
AC0_AR,AR_ARX,ARX/MQ ;HI PART TO AC
MQ_SHIFT,AR_ARX (ADX), ;MID PART TO MQ
CLR ARX ;SHIFT ZEROS IN FROM RIGHT
DFAS4: MQ_SHIFT,ARX/MQ,AR_AC0 ;ALL PIECES NOW IN PLACE
DFAS5: AR_AR+BR,ARX/ADX,SC_#,#/4, ;HERE WHEN OPERANDS ALIGNED
NORM,J/DNORM ;ADD, AND NORMALIZE RESULT
;SUBROUTINE TO CHOOSE OPERAND WITH SMALLER EXPONENT, AND
; PREPARE FOR SHIFTING IT.
; ENTER WITH ONE OPERAND FRACTION IN BR, ITS EXPONENT IN FE & SC,
; THE OTHER OP IN AR WITH ITS EXPONENT IN AR0-8
; RETURN THE LARGER EXPONENT IN FE, AND 36-(MAGNITUDE OF DIFFERENCE)
; IN SC. RETURN 4 IF SC POSITIVE, 5 IF NEGATIVE.
EXPD: SC_EXP-SC,EXP_SIGN,SKP SCAD0 ;COMPARE MAGNITUDES
=0 AR_BR,ARX_BRX,BR/AR,BRX/ARX, ;AC OP IS LARGER MAGNITUDE
FE_FE+SC,J/EXPD1 ;ITS EXP TO FE
MQ_ARX,SC_#+SC,#/36., ;CHECK FOR EXP DIFF > 36
SKP SCAD0,RETURN4
EXPD1: MQ_ARX,SC_#-SC,#/36., ;AC EXP .GE. MEM
SKP SCAD0,RETURN4 ;SHIFT MEM OP
;DFMP
; GET HERE WITH MEM OPERAND (M'CAND) IN BR!BRX
; AR HAS (AC1), LOW HALF OF M'IER
=00*
DFMP: MQ_AR,AR_0S,ARX_0S, ;SETUP LOW M'IER
SC_#+SC,#/-200, ;CORRECT EXPONENT
CALL,J/MULREE ;MULTIPLY BY THE LOW PART
=10* AR_AR+BR LONG ;OOPS, LOW SIGN WAS SET
MQ_AR,AR_AC0,FE_#,#/-14. ;READY TO CONTINUE WITH HIGH PART
;HERE TO USE HIGH MULTIPLIER
SC_EXP+SC,EXP_SIGN.M, ;EXTRACT EXP FROM HIGH WORD
SKP AR0 ;CHECK FOR NEG M'IER
=010
DFMP2: MQ_AR,AR_MQ,CALL,J/MULREE ;GO BACK IN FOR HIGH PART
EXP_1,J/DFMP2 ;OOPS, NEG, MOVE SIGN TO BIT 8
=110
DNTRY: SC_#,#/4,GEN AR,NORM,J/DNORM ;NORMALIZE THE ANSWER
=
;DFDV
; GET HERE WITH DIVISOR IN BR!BRX, ITS EXP-1 IN SC
; SKIP IF D'SOR AND D'END SIGNS DIFFER
=000
DFDV: AR_AC1*2,CALL,J/DFDV1 ;GET LOW D'END, GO START DIVIDE
SR_1,AR_AC1*2,CALL,J/DFDV1 ;NOTE NEG QUO
=011 AC1_AR,AR_MQ,ARL/AD,FE_FE+1, ;HERE FROM DDVSUB. NEW STEP CNT
MQ_0.M,CALL.M,J/DIV+ ; SAVE HIGH QUO, RESUME
=101 AC1_AR,AR_MQ,ARL/AD,FE_FE+1,
MQ_0.M,CALL.M,J/DIV-
=111 AR_AC1,ARX/MQ,SC_#,#/4, ;POSITIVE QUOTIENT TO AR LONG
NORM,J/DNORM ;NORMALIZE AND ROUND
=00
DFDV1: ARX_AR,AR_AC0,SKP AD0, ;TEST DIVIDEND SIGN
FE_#,#/26., ;SETUP COUNT FOR HIGH QUO
CALL,J/FDVCHK ;GO CHECK DIVIDABILITY
=10 SKP BR0,J/DDVSUB ;BEGIN DIVISION (RETURN ABOVE)
SET FL NO DIV,J/IFNOP ;ABORT THE DIVISION
.TOC "DOUBLE PRECISION NORMALIZATION"
=000
DNORM: SKP ARX+MQ NE,SC_#,#/35.,J/DNZERO ;AR=0
BR/AR,BRX/ARX,AR_MQ COMP, ;RESULT NEG, MAKE POS
SR_1,J/DNNEG ;FLAG NEGATIVE
AR_AR*.25 LONG,MQ_MQ*.25,
FE_FE+#,#/4,J/DNHI ;MSB IN AR 1-6
AR_AR*.25 LONG,
FE_FE+#,#/2,J/DROUND ;MSB IN AR7
AR_AR*.5 LONG,FE_FE+1 ;MSB IN AR8
DROUND: AR_AR+1,ARX/ADX,NORM, ;MSB IS AR9, RIGHT ON
SC_#,#/35.,J/DRND1
(AR+ARX+MQ)*2,FE_FE-1,J/DROUND ;MSB IN AR10
AR_SHIFT,FE_FE-SC ;SOMEWHERE IN AR 11-35
DNSHFT: BR/AR,AR_ARX,ARX/MQ ;SHIFT THE WHOLE THING
MQ_SHIFT,AR_ARX (ADX),CLR ARX
MQ_SHIFT,ARX/MQ,AR_BR,SC_#,#/10.,
NORM,J/DNORM ;GIVE IT ANOTHER GO
DNNEG: AR_AR+1,SKP CRY0 ;COMPLETE NEGATION OF MQ
=0 MQ_AR,AR_BR COMP,ARX_BRX COMP,
NORM,J/DNORM ;NORMALIZE THE POS FORM

1219
src/ucode/io.51 Executable file
View File

File diff suppressed because it is too large Load Diff

14
src/ucode/its.9 Executable file
View File

@@ -0,0 +1,14 @@
.TOC "MICROCODE CONDITIONAL ASSEMBLY PARAMETERS FOR ITS"
.SET/ITSPAGE=1 ;ITS-STYLE PAGING
.SET/MAP=0 ;NO MAP INSTRUCTION
.SET/PFAIL.PIHACK=1 ;PI OFF ON PAGE FAILURE
.SET/JRSTON=1 ;JRST 17, TURNS ON PI THEN DOES JRST 2,
.SET/LPM.SPM=1 ;LPMR AND SPM INSTRUCTIONS
.SET/XCTR=1 ;XCTR INSTRUCTIONS (PXCT AND PXCTI)
.SET/EIS=0 ;NO STRING STUFF FOR NOW
.SET/DECIMAL=0 ;NO DECIMAL STUFF FOR NOW
.SET/CIRC=1 ;WINNING CIRC INSTRUCTION
.SET/MVSQZ=0 ;RANDOM MVSQZ INSTRUCTION
.SET/KLPAGE=1 ;U CODE CONTROLS PAGE REFILLS
.SET/NXT.INSTR.BITES=0 ;FIXED IN REV 9?

6
src/ucode/jpc.4 Executable file
View File

@@ -0,0 +1,6 @@
.TOC "PARAMETER FILE FOR SINGLE JPC FEATURE"
.SET/JPC.RING=0
.SET/JPC=1
;.SET/NXT.INSTR.BITES=0 ;CAN'T RUN WITH THIS=1, HAS PF GTR 6 TICKS LOSSAGE
;ABOVE COMMENTED OUT SINCE IT IS NOW THE DEFAULT AND PROVOKES A CRUFTY WARNING

5
src/ucode/jpcr.3 Executable file
View File

@@ -0,0 +1,5 @@
.TOC "PARAMETER FILE FOR RING OF 16 JPC'S FEATURE"
.SET/JPC.RING=1
.SET/JPC=1

4
src/ucode/jpctst.2 Executable file
View File

@@ -0,0 +1,4 @@
.TOC "PARAMETER FILE FOR TESTING SINGLE JPC FEATURE"
.SET/JPC TEST=1

126
src/ucode/lisp.18 Executable file
View File

@@ -0,0 +1,126 @@
.TOC "LISP INSTRUCTIONS"
.IF/LISP
;;; MARK: LSPGCM A,FOO
;;; LISP GARBAGE COLLECTION MARK INSTRUCTION.
;;; IF THE GCSTBR IS NOT SET UP, BEHAVES AS A UUO (OPCODE 070).
;;; OTHERWISE, MARKS THE ITEM IN A IF POSSIBLE, THEN RETURNS
;;; TO ONE OF SEVERAL PLACES:
;;; MARK-1 BOTH CAR AND CDR NEED MARKING (CAR IN A, CDR IN A+1)
;;; MARK ONE OF CAR OR CDR NEED MARKING (ITEM IN A)
;;; MARK+1 ITEM ALREADY MARKED, OR NOT MARKABLE
;;; FOO+N BIT 4.8 WAS SET IN GCST TABLE (N=BITS 4.3-4.1),
;;; INDICATING SOMETHING FUNNY LIKE A SYMBOL OR A SAR.
;TO HELP SEE WHAT'S GOING ON, ;AR ARX BR BRX MQ
; REGISTER CONTENTS AFTER EACH STEP ARE SHOWN ;------ ------- ------- ------- -------
;LSPGCM: BR/AR,MQ_AR,AR_GCSTBR,SKP AD NE,J/LGCM0 ;START OF GC MARK INSTR
=0
LGCM0: AR_BR,J/UUO ;GCSTBR NOT SET UP => UUO
SC_#,#/44-SEGLOG,BR/AR,ARX_AC0,AR_0.C ;0 ITEM GCSTBR EFFADR
ARX_SHIFT,AR_ARX (AD) ;ITEM SEG# GCSTBR EFFADR
VMA_ARX+BR,LOAD ARX,AR_SHIFT ;WD#_33 -LOAD- EFFADR
SC_AR0-8 AND #,#/37,BR/AR,AR_0.C ;0 -LOAD- WD#_33 EFFADR
ARX_MEM,AR0-8_#,#/400 ;SETZ TBLENT WD#_33 EFFADR
SKP ARX0,SC_#-SC,#/44,BRX/ARX ;SETZ TBLENT WD#_33 TBLENT EFFADR
=0 I FETCH,J/NOP ;NOT MARKABLE => NEXT INSTRUCTION
AR_ARX (AD),ARX_AR ;TBLENT SETZ WD#_33 TBLENT EFFADR
AR_0S,FE_AR0-8 AND #,
#/207,SKP SCAD NE ;0 SETZ WD#_33 TBLENT EFFADR
;HERE FOR MARKABLE NON-FUNNY THINGS
=0 MQ_SHIFT,AR_BRX,ARX_BR,
SC_#,#/SEGLOG-5,J/LGCM1 ;TBLENT WD#_33 TBLENT MARKBIT
;HERE FOR MARKABLE FUNNY THINGS (SYMBOLS, ETC.)
VMA_MQ,FE_FE-#,#/201,BYTE DISP
=110
LGCM3: VMA_VMA+1,FE_FE-1,BYTE DISP,J/LGCM3 ;LOOP TO GENERATE EFFADR+N
FETCH,J/NOP
LGCM1: ARX_SHIFT,AR_MQ ;MARKBIT BITSADR TBLENT
BR/AR,VMA_ARX,LOAD AR ;-LOAD- MARKBIT TBLENT
AR_MEM ;BITS MARKBIT TBLENT
AD/AND,ADA/AR,ADB/BR,SKP AD NE
=0 I FETCH,J/NOP ;ALREADY MARKED
AR_AR*BR,AD/ANDCB,STORE ;BITS\MARKBIT TBLENT
MEM_AR,AR_BRX ;TBLENT
GEN # AND AR0-8,#/GCBCDR,SKP SCAD NE
=0 I FETCH,J/NOP ;DON'T MARK THROUGH
VMA_AC0,LOAD ARX ;TBLENT -LOAD-
ARX_MEM,VMA/PC,GEN # AND AR0-8,
#/GCBCAR,SKP SCAD NE ; CARCDR
=0 ARL_0.S,ARR_ARXR,J/LGCM2 ;ONLY MARK CDR
ARL_0.S,ARR_ARXR,VMA_VMA-1 ;0,,CDR CARCDR
ARX_AR (AD),SKP AD NE,ARR_0.S,ARL_ARXL ;0,,CAR 0,,CDR
=0 REFETCH,AR_AR SWAP,J/STAC ;CDR IS NIL => MARK ONLY CAR
ARX_AR (AD),SKP AD NE,AR_ARX ;0,,CDR 0,,CAR
=0
LGCM2: REFETCH,J/STAC ;CAR IS NIL => MARK ONLY CDR
AC1_AR,AR_ARX
AR_AR SWAP,FETCH,J/STAC ;CDR IN AC1, CAR IN AC0, RET TO INST-1
;;; SWEEP: LSPGCS A,N
;;; LISP GARBAGE COLLECTION SWEEP INSTRUCTION.
;;; IF THE GCSTBR IS NOT SET UP, BEHAVES AS A UUO (OPCODE 071).
;;; OTHERWISE, SWEEPS UP A SECTION OF MEMORY.
;;; A/ AOBJN POINTER TO REGION OF MEMORY TO SWEEP: <# CELLS>,,<START ADR>
;;; THE CELLS ARE N WORDS LONG.
;;; A+1/ POINTER TO NEXT WORD OF MARK BITS TO USE. A BIT=0 => MARKED.
;;; A+2/ FREELIST (TO BE ADDED TO THE FRONT OF).
;;; A+3/ COUNT OF RECLAIMED CELLS, TO BE INCREMENTED.
;;; THE INSTRUCTION OPERATES IN GROUPS OF 40 WORDS (ONE WORD OF MARK BITS).
;;; IT CHECKS FOR INTERRUPTS ONLY THAT OFTEN, AFTER CHECKPOINTING ITSELF
;;; BACK INTO THE FOUR AC'S. IF A PAGE FAULT OR OTHER MEMORY ERROR OCCURS,
;;; IT WILL RESTART CORRECTLY AT THE BEGINNING OF THE GROUP OF 40 WORDS.
;LSPGCS: BR/AR,SC_EA,AR_GCSTBR,SKP AD NE,J/LGCS0 ;START OF GC SWEEP INSTR
=0
LGCS0: AR_BR,J/UUO ;MAYBE CRAP OUT AS UUO
AR_BR+1000000 ;BR GETS 1,,N (FOR BUMPING AOBJN PTR)
ARX_AC2,BR/AR ;WE STANDARDLY KEEP THE FREELIST IN BRX,
BRX/ARX,VMA_AC1,LOAD ARX ; THE AOBJN PTR IN ARX, THE COUNT IN MQ,
AR_AC3,FE_SC ; AND THE MARK BITS POINTED TO BY AC1
MQ_AR,CLR AR,SC_#,#/40,J/LGCS1 ; IN AR (CONSTANTLY SHIFTED OVER).
=010
LGCS7: NXT INSTR ;DONE, NO INTERRUPT
NXT INSTR ;DONE, INTERRUPT PENDING
LGCS1: ARX_MEM,J/LGCS6 ;NOT DONE, NO INTERRUPT
FIN XFER,REFETCH,J/NOP ;NOT DONE, INTERRUPT PENDING
=
LGCS6: AR_SHIFT,ARX_AR (AD),SC_#,#/4
ARX_AC0,AR_SHIFT,SH DISP,SC_#,#/-40,J/LGCS3
=0**0
LGCS2: AR_AC1+1,VMA/AD,SKP ARX0,J/LGCS4
LGCS3: AR_SHIFT,SH DISP,SC_FE+SC,SKP SCAD0,ARX_ARX+BR,J/LGCS2
AR_AC1+1,VMA/AD,SKP ARX0,J/LGCS4
AR_ARX (AD),ARX_AR
= AR_BR,BR/AR
AR_BRX,ARX_BR,VMA_BR,BR/AR,BRX/ARX,STORE
MEM_AR,AR_MQ+1
MQ_AR,AR_BRX,BRX/ARX,J/LGCS3
=0
LGCS4: I FETCH,AC1_AR,AR_MQ,MQ_ARX,J/LGCS5
LOAD ARX,AC1_AR,AR_MQ,MQ_ARX
LGCS5: AC3_AR,AR_BRX
AC2_AR,AR_MQ
AC0_AR
AD/0S,SIGNS DISP,SKP INTRPT,J/LGCS7
.ENDIF/LISP
.TOC "LISP DEBUGGING INSTRUCTION"
;;; LSPDBG A,
;;; PUTS STBR IN A, GCSTBR IN A+1
;LSPDBG: AR_GCSTBR,J/LSPDB1
LSPDB1: AC1_AR,I FETCH
AR_STBR,J/STAC

4
src/ucode/lithp.2 Executable file
View File

@@ -0,0 +1,4 @@
.TOC "PARAMETER FILE FOR LISP MICROCODE"
.SET/LISP=1

1264
src/ucode/macro.43 Executable file
View File

File diff suppressed because it is too large Load Diff

233
src/ucode/music.16 Executable file
View File

@@ -0,0 +1,233 @@
.TOC "MUSIC MICROCODE"
.IF/MUSIC
;;; MUSIC MICROCODE FOR KL-10
;;;
;;; BASIC SETUP:
;;; THERE ARE SIX VOICES.
;;; MUSIC IS PLAYED BY PUTTING BITS IN A REGISTER
;;; WHICH LIVES IN THE NETWORK IMP INTERFACE. THIS
;;; REGISTER IS LOADED BY A DATAO. THE BITS ARE LOADED
;;; AT SUCH A RATE THAT THE LOW SIX BITS PRODUCE SQUARE
;;; WAVES OF THE CORRECT FREQUENCIES. TO ACCOMPLISH THIS,
;;; THE KL-10'S 10.-USEC INTERVAL TIMER IS USURPED.
;;;
;;; FOR EACH VOICE THERE IS A BASE REGISTER (VNBR),
;;; A TIME (VNTIM, THE INVERSE OF THE FREQUENCY),
;;; AND A COUNTER (VNCTR).
;;; THERE ARE ALSO SEVERAL OTHER REGISTERS:
;;; MUSDEV CONTAINS A DATAO INSTRUCTION TO THE REGISTER.
;;; MUSMIN THE MINIMUM INTERVAL BETWEEN CHANGES TO THE
;;; REGISTER. USED TO PREVENT GOBBLING TOO MUCH
;;; MACHINE TIME. MEASURED IN 10.-USEC UNITS,
;;; WITH THE BINARY POINT BETWEEN THE HALVES
;;; OF THE WORD.
;;; CN7777 CONTAINS 7777, WHICH IS THE MAXIMUM INTERVAL
;;; THE TIMER'S 12.-BIT COUNTER CAN HANDLE.
;;; MUSBT1 THE BITS TO LOAD INTO THE REGISTER WHEN THE
;;; TIMER NEXT GOES OFF.
;;; MUSBT2 THE BITS TO TOGGLE AFTER THE REGISTER IS LOADED.
;;; MUSAOB AN AOBJN POINTER TO THE MUSIC DATA.
;;; MUSTIM THE QUANTITY FOR THE INTERVAL TIMER'S LIMIT
;;; REGISTER AFTER IT NEXT GOES OFF. THIS IS IN
;;; THE LEFT HALF, WITH THE CONTROL BITS FOR THE TIMER.
;;; CHDTIM THE TIME REMAINING FOR THE CURRENT CHORD,
;;; IN 10.-USEC UNITS.
;;; EACH BASE REGISTER POINTS TO A 64.-WORD TABLE. EACH
;;; ENTRY IS THE INVERSE FREQUENCY OF A TONE FOR THAT VOICE,
;;; MEASURED IN 10.-USEC UNITS, WITH THE BINARY POINT
;;; BETWEEN THE HALVES OF THE WORD.
;;; THE AOBJN POINTER POINTS TO A TABLE OF 2-WORD ENTRIES.
;;; THE FIRST WORD OF EACH ENTRY HAS SIX 6-BIT BYTES, ONE
;;; FOR EACH VOICE, THE FIRST VOICE BEING LEFTMOST.
;;; EACH BYTE IS USED AS AN INDEX INTO A VOICE TABLE TO
;;; FETCH AN INVERSE FREQUENCY. THE SECOND WORD IS THE
;;; LENGTH OF THE CHORD IN 10.-USEC TICKS (BINARY POINT
;;; AT THE RIGHT END OF THE WORD). WHEN THIS WORD IS
;;; FETCHED, IT IS WRITTEN BACK WITH THE SIGN BIT SET SO
;;; THAT THE MACRO-CODE CAN CHECK THE PROGRESS OF THE
;;; MUSIC PLAYER.
;;;
;;; THE MUSIC ALGORITHM:
;;; THE INSTRUCTION PLAY=DATAO TIM, IS PUT IN THE FIRST
;;; LOCATION OF THE INTERVAL TIMER'S INTERRUPT VECTOR.
;;; WHEN EXECUTED AS A PI INSTRUCTION, PLAY DOES:
;;;
;;; CONO TIM,<460000+C(MUSTIM)> ;RESET TIMER, RESTART
;;; DATAO MUSREG,MUSBT1
;;; XOR MUSBT2 INTO MUSBT1
;;; SET MUSBT2 TO 0
;;; COMPUTE MUSTIM=LOGAND(<-1,,0>,
;;; MAX(MUSMIN,
;;; MIN(V1CTR, V2CTR, ...,
;;; V6CTR, 7777)))
;;; FOR N FROM 1 TO 6 DO
;;; BEGIN
;;; SUBTRACT MUSTIM FROM V<N>CTR
;;; IF RESULT NEGATIVE, SET BIT IN MUSBT2
;;; FOR VOICE <N>, AND KEEP ADDING
;;; V<N>TIM INTO V<N>CTR UNTIL POSITIVE
;;; END
;;; SUBTRACT MUSTIM FROM CHDTIM
;;; IF RESULT NEGATIVE THEN
;;; IF MUSAOB HAS RUN OUT THEN
;;; TAKE PI CYCLE 2 (SECOND INT INSTR)
;;; ELSE BEGIN
;;; FETCH VOICES WORD (SIX 6-BIT BYTES)
;;; FETCH DURATION WORD, PUT IN CHDTIM
;;; BUMP MUSAOB BY <2,,2>
;;; FOR N FROM 1 TO 6 DO
;;; BEGIN
;;; CLEAR V<N>CTR
;;; FETCH V<N>TIM TO THE WORD
;;; ADDRESSED BY C(V<N>BR)
;;; PLUS A 6-BIT BYTE
;;; END
;;; DISMISS INTERRUPT
;;; END
=0
PLAY0: AR_BR,J/UUO ;IF NOT PI CYCLE, BE A UUO
GET ECL EBUS,AR_AR SWAP
CONO TIM ;START THE TIMER FOR NEXT TICK
REL ECL EBUS
GEN MUSDEV,LOAD IR ;SET UP FOR DATAO TO REGISTER
=10 AR_MUSBT1,CALL,SKP IO LEGAL,J/GTEBUS ;DO THE DATAO
AR_MUSBT2 ;XOR MUSBT2 INTO MUSBT1
AR_AR*MUSBT1,AD/XOR
MUSBT1_AR
AR_CN7777,BRX/ARX ;FIND MIN OF 7777 AND ALL VNCTRS
BR/AR,SKP AR GT FM,V1CTR,ARX/AD ;"SKP GT" IS AN XOR OPERATION
=0
PLAY01: BR/AR,SKP AR GT FM,V2CTR,ARX/AD,J/PLAY23
AR_ARX*BR,AD/XOR,J/PLAY01 ;XOR'ING IN XOR'D QUANTITY
=0
PLAY12: BR/AR,SKP AR GT FM,V3CTR,ARX/AD,J/PLAY23
AR_ARX*BR,AD/XOR,J/PLAY12
=0
PLAY23: BR/AR,SKP AR GT FM,V4CTR,ARX/AD,J/PLAY34
AR_ARX*BR,AD/XOR,J/PLAY23
=0
PLAY34: BR/AR,SKP AR GT FM,V5CTR,ARX/AD,J/PLAY45
AR_ARX*BR,AD/XOR,J/PLAY34
=0
PLAY45: BR/AR,SKP AR GT FM,V6CTR,ARX/AD,J/PLAY56
AR_ARX*BR,AD/XOR,J/PLAY45
=0
PLAY56: BR/AR,SKP AR GT FM,MUSMIN,ARX/AD,J/PLAY6M
AR_ARX*BR,AD/XOR,J/PLAY56
=0
PLAY6M: AR_ARX*BR,AD/XOR ;MAX RESULT WITH MUSMIN
ARL_ARL,CLR/ARR
ARX_-AR-1,P_#,#/6 ;CONTROL BITS FOR TIMER
MUSTIM_AR
;THE THEORY BEHIND USING "ARX_-AR-1" INSTEAD OF "ARX_-AR" IS TO
;AVOID UNFORTUNATE COINCIDENCES WHERE WE REACH ZERO EXACTLY,
;SINCE WE ARE REALLY DOING A SIGN BIT CHECK. THE EXTRA 1 ONLY
;THROWS IT OFF BY (10. USEC)*(2^-18) = .38 PICOSEC.
PLAYV1: AR_ARX+V1CTR,SKP AD0
=0 V1CTR_AR,BRX/ARX,ARX_BRX*2,J/PLAYQ1
BRX/ARX,ARX_BRX*2+1
BRX/ARX,ARX_BRX,J/PLAYZ1
=0
PLAYX1: V1CTR_AR,J/PLAYV2
PLAYZ1: AR_AR+V1TIM,SKP AD0,J/PLAYX1
PLAYQ1: BRX/ARX,ARX_BRX
PLAYV2: AR_ARX+V2CTR,SKP AD0
=0 V2CTR_AR,BRX/ARX,ARX_BRX*2,J/PLAYQ2
BRX/ARX,ARX_BRX*2+1
BRX/ARX,ARX_BRX,J/PLAYZ2
=0
PLAYX2: V2CTR_AR,J/PLAYV3
PLAYZ2: AR_AR+V2TIM,SKP AD0,J/PLAYX2
PLAYQ2: BRX/ARX,ARX_BRX
PLAYV3: AR_ARX+V3CTR,SKP AD0
=0 V3CTR_AR,BRX/ARX,ARX_BRX*2,J/PLAYQ3
BRX/ARX,ARX_BRX*2+1
BRX/ARX,ARX_BRX,J/PLAYZ3
=0
PLAYX3: V3CTR_AR,J/PLAYV4
PLAYZ3: AR_AR+V3TIM,SKP AD0,J/PLAYX3
PLAYQ3: BRX/ARX,ARX_BRX
PLAYV4: AR_ARX+V4CTR,SKP AD0
=0 V4CTR_AR,BRX/ARX,ARX_BRX*2,J/PLAYQ4
BRX/ARX,ARX_BRX*2+1
BRX/ARX,ARX_BRX,J/PLAYZ4
=0
PLAYX4: V4CTR_AR,J/PLAYV5
PLAYZ4: AR_AR+V4TIM,SKP AD0,J/PLAYX4
PLAYQ4: BRX/ARX,ARX_BRX
PLAYV5: AR_ARX+V5CTR,SKP AD0
=0 V5CTR_AR,BRX/ARX,ARX_BRX*2,J/PLAYQ5
BRX/ARX,ARX_BRX*2+1
BRX/ARX,ARX_BRX,J/PLAYZ5
=0
PLAYX5: V5CTR_AR,J/PLAYV6
PLAYZ5: AR_AR+V5TIM,SKP AD0,J/PLAYX5
PLAYQ5: BRX/ARX,ARX_BRX
PLAYV6: AR_ARX+V6CTR,SKP AD0
=0 V6CTR_AR,BRX/ARX,ARX_BRX*2,AR_ARX,J/PLAYQ6
BRX/ARX,ARX_BRX*2+1
BRX/ARX,ARX_BRX,J/PLAYZ6
=0
PLAYX6: V6CTR_AR,J/PLAY40
PLAYZ6: AR_AR+V6TIM,SKP AD0,J/PLAYX6
PLAYQ6: BRX/ARX,ARX_BRX
PLAY40: AR_BRX,ARX_AR SWAP
MUSBT2_AR
AR_ARX+CHDTIM,SKP AD0
=0 CHDTIM_AR,J/PIDONE
AR_MUSAOB+1,GEN CRY18,SKP AD0
=0 J/PICY2V
VMA_AR,LOAD ARX
AR_AR+1,GEN CRY18
MUSAOB_AR
ARX_MEM
VMA_VMA+1,LOAD AR
AR_MEM
CHDTIM_AR
P_P OR #,#/40,STORE
MEM_AR,AR_0S,SC_#,#/6
V1CTR_AR,ARX_SHIFT,AR_ARX (AD)
VMA_ARX+FM,V1BR,ARX_SHIFT,LOAD AR
AR_MEM
V1TIM_AR,AR_0S
V2CTR_AR,ARX_SHIFT,AR_ARX (AD)
VMA_ARX+FM,V2BR,ARX_SHIFT,LOAD AR
AR_MEM
V2TIM_AR,AR_0S
V3CTR_AR,ARX_SHIFT,AR_ARX (AD)
VMA_ARX+FM,V3BR,ARX_SHIFT,LOAD AR
AR_MEM
V3TIM_AR,AR_0S
V4CTR_AR,ARX_SHIFT,AR_ARX (AD)
VMA_ARX+FM,V4BR,ARX_SHIFT,LOAD AR
AR_MEM
V1TIM_AR,AR_0S
V5CTR_AR,ARX_SHIFT,AR_ARX (AD)
VMA_ARX+FM,V5BR,ARX_SHIFT,LOAD AR
AR_MEM
V1TIM_AR,AR_0S
V6CTR_AR,ARX_SHIFT,AR_ARX (AD)
VMA_ARX+FM,V6BR,ARX_SHIFT,LOAD AR
AR_MEM
V6TIM_AR,J/PIDONE
.ENDIF/MUSIC

4
src/ucode/muzak.2 Executable file
View File

@@ -0,0 +1,4 @@
.TOC "PARAMETER FILE FOR MUSIC MICROCODE"
.SET/MUSIC=1

209
src/ucode/shift.6 Executable file
View File

@@ -0,0 +1,209 @@
.TOC "ROTATES AND LOGICAL SHIFTS -- ROT, LSH, JFFO"
.DCODE
240: I, B/0, J/ASH
I, B/0, J/ROT
I, B/2, J/LSH
I, J/JFFO
I, B/1, J/ASHC
I, J/ROTC
I, J/LSHC
.IFNOT/CIRC
I, J/UUO
.IF/CIRC
I, J/CIRC
.ENDIF/CIRC
.UCODE
;ENTER WITH 0,E IN AR
; NOTE THAT VALUES OF SC GREATER THAN 36
; CAUSE THE SHIFTER TO SELECT ARX.
=00***0
LSH: AR_AC0,ARL/AD,ARX_0.M,SC_EA,
SKP AR18,J/SHR1
JFFO: AR_AC0,SKP AD NE,SC_#,#/6
=
=0 AC1_AR,I FETCH,J/NOP ;AC WAS ZERO, NO JUMP
ARX+MQ_0.M,FE_P,SKP SCAD NE, ;TEST FIRST 6 BITS
AR_SHIFT,ARL/SH ;DISCARD THEM
=1****0
JFFO1: AR_SHIFT,FE_P,SKP SCAD NE, ;TEST NEXT 6 BITS
ARX_ARX-1,J/JFFO1 ;LOOP, COUNTING, TILL NE
P_FE,ARR_0.S, ;RESTORE 6 NON-ZERO BITS
ARX_ARX*-6 ;GET POS GROUP COUNT*6
=*1***0
JFFO2: SKP AR0,AR_2(AR+1), ;LOOP TO FIND A 1
ARX_ARX+1,J/JFFO2 ;COUNTING AS WE GO
.IFNOT/JPC
AR_ARX-1,FETCH,J/STRAC1
.IF/JPC
AR_ARX-1,FETCH,SKP USER
=0 AC1_AR,AR_PC,SC_#,#/32.,J/JPCEX
AC1_AR,AR_PC,SC_#,#/32.,J/JPCUSR
.ENDIF/JPC
=00***0
ASH: SC_EA,SKP AR18, ;GET SHIFT AMOUNT
AR_0S,J/ASHL ;SET LOW PART = 0
ROT: AR_AC0,ARX_AC0,SC_EA,SKP AR18
=
;SINGLE-WORD LSH/ROT
; FOR ROT, B=0, AR AND ARX BOTH CONTAIN AC
; FOR LSH, B=2, AR HAS AC, ARX IS ZERO
=00
SHR1: AR_SHIFT,SC_#+SC,#/-36., ;DO POS (LEFT) SHIFT, CHK RANGE
SKP SCAD0,J/SHR2
ARX_AR (AD),AR_ARX (ADX),
SC_#+SC,#/36.,
B DISP,SKP SCAD0,J/SHR1 ;MAKE NEG SHIFT TO EQUIV POS
SHR2: AR_SHIFT,SC_#+SC,#/-36.,
SKP SCAD0,J/SHR2 ;BRING SC INTO RANGE
AC0_AR,I FETCH,J/NOP ;DONE
.TOC "ROTATE AND LOGICAL SHIFT COMBINED -- ROTC, LSHC"
=00***0
ASHC: SC_EA,SKP AR18, ;SETUP SHIFT COUNT
AR_AC1*2,J/ASHL ;GET LOW WORD
ROTC: ARX_AC1
= AR_AC0,SC_EA,SKP AR18 ;SETUP BOTH AC'S
=1****0
ROT3: MQ_SHIFT,ARX_AR (AD),
AR_ARX (ADX),J/ROT4
ARX_AR (AD),AR_ARX (ADX),
SC_#+SC,#/36.,SKP SCAD0,J/ROT3
ROT4: AR_MQ,ARX_SHIFT,
SC_#+SC,#/-36.,SKP SCAD0
=0 MQ_SHIFT,ARX_AR (AD),
AR_ARX (ADX),J/ROT4
STDAC: AC0_AR,AR_ARX,I FETCH,J/STRAC1
.IFNOT/CIRC
1004: ;NEXT TO UUO
.IF/CIRC
=00**00
.ENDIF/CIRC
LSHC: ARX_AC1,MQ_0.M,J/LSHC1
.IF/CIRC
=01
CIRC: MQ_AR,AR_AC1,FE_#,SC_#,#/35.,CLR ARX,CALL,J/WDREV
=11 SC_EA,AR_AC0,SKP AR18,J/CIRC3
.ENDIF/CIRC
=
LSHC1: AR_AC0,SC_EA,FE_#,#/36.,SKP AR18
=*1***0
LSH2: MQ_SHIFT,AR_ARX (ADX),
ARX/MQ,FE_#,#/-36.,J/LSH3
ARX_AR (AD),AR_0.M,MQ_ARX,
SC_FE+SC,SKP SCAD0,J/LSH2
LSH3: AR_MQ,ARL/AD,ARX_SHIFT,MQ_0.M,
SC_FE+SC,SKP SCAD0
=0 MQ_SHIFT,AR_ARX (ADX),ARX/MQ,J/LSH3
AC0_AR,AR_ARX,I FETCH,J/STRAC1
.TOC "CIRC INSTRUCTION"
.IF/CIRC
=1****0
CIRC3: MQ_SHIFT,ARX_AR (AD),AR_ARX (ADX),J/CIRC4
ARX_AR (AD),AR_ARX (ADX),SC_#+SC,#/36.,SKP SCAD0,J/CIRC3
CIRC4: AR_MQ,ARX_SHIFT,SC_#+SC,#/-36.,SKP SCAD0
=1***00
MQ_SHIFT,ARX_AR (AD),AR_ARX (ADX),J/CIRC4
AC0_AR,AR_ARX,FE_#,SC_#,#/35.,ARX_0S,CALL,J/WDREV
=11 AR_ARX,CLR SC,I FETCH,J/STD1
;SUBROUTINE TO REVERSE A WORD IN AR, RETURNING IT IN ARX.
;ON ENTRY, ARX MUST BE CLEAR, AND SC AND FE MUST BOTH CONTAIN 35.
;ON EXIT, MQ IS COPIED INTO AR.
.IFNOT/CIRC.BIG.OPT
=*1***0
WDREV: BRX/ARX,SH DISP,J/WDREV1
AR_MQ,RETURN2
=1*0111
WDREV1: FE_FE-1,SC/SCAD,SKP SCAD0,ARX_BRX*2,J/WDREV
FE_FE-1,SC/SCAD,SKP SCAD0,ARX_BRX*2+1,J/WDREV
.IF/CIRC.BIG.OPT
=1****0
WDREV: SH DISP,BR/AR,AR_ARX (ADX),SC_#,#/32.,J/WDREV1
AR_MQ,RETURN2
=1*0000
WDREV1: AR_BR,ARX_SHIFT,FE_FE-#,#/4,SC/SCAD,SKP SCAD0,J/WDREV
AR_SHIFT,SC_#,#/10,J/WDREV2
AR_SHIFT,SC_#,#/4,J/WDREV2
AR_SHIFT,SC_#,#/14,J/WDREV2
AR_SHIFT,SC_#,#/2,J/WDREV2
AR_SHIFT,SC_#,#/12,J/WDREV2
AR_SHIFT,SC_#,#/6,J/WDREV2
AR_SHIFT,SC_#,#/16,J/WDREV2
AR_SHIFT,SC_#,#/1,J/WDREV2
AR_SHIFT,SC_#,#/11,J/WDREV2
AR_SHIFT,SC_#,#/5,J/WDREV2
AR_SHIFT,SC_#,#/15,J/WDREV2
AR_SHIFT,SC_#,#/3,J/WDREV2
AR_SHIFT,SC_#,#/13,J/WDREV2
AR_SHIFT,SC_#,#/7,J/WDREV2
AR_SHIFT,SC_#,#/17,J/WDREV2
WDREV2: AR0-5_AR0-5 OR SC
AR_BR,ARX_AR,FE_FE-#,#/4,SC/SCAD,SKP SCAD0,J/WDREV
.ENDIF/CIRC.BIG.OPT
.ENDIF/CIRC
.TOC "ARITHMETIC SHIFTS -- ASH, ASHC"
;COMMON CODE FOR ARITHMETIC SHIFTS
=*1***0
ASHL: ARX_AR,AR_AC0, ;INPUT NOW IN AR LONG
SKP SC NE,J/ASHL1 ;CHECK FOR NULL SHIFT
ARX_AR,AR_AC0, ;HERE IF RIGHT SHIFT
SC_#+SC,#/36.,SKP SCAD0 ;CHECK FOR LONG ONE
=1****0
ASHR1: BR/AR,ARX_SHIFT,AR_SIGN,J/ASHR2 ;LOW OUTPUT TO ARX
ARX_AR,AR_SIGN, ;HERE IF SHIFT COUNT .GT. 36
SC_#+SC,#/36., ;BRING COUNT UP BY 36
SKP SCAD0,J/ASHR1 ;LOOP TILL COUNT REASONABLE
ASHR2: BRX/ARX,ARX_BR, ;HIGH INPUT TO ARX
B DISP,J/ASHX
;HERE FOR LEFT ARITHMETIC SHIFT
=*1***0
ASHL1: I FETCH,J/NOP ;SHIFT 0 IS A NOP
BR_AR LONG,AR_SIGN ;SAVE INPUT, GEN SIGN WORD
BR/AR,AR_BR*2 LONG ;SAVE SIGN, GET MAGNITUDE BITS
=0*
ASHL2: BRX/ARX,ARX_AR,AR_BR, ;HI IN TO ARX, LOW TO BRX
CALL,J/SHIFT ;CALL SHIFTER TO GET BITS LOST
SKP AR SIG ;ANY SIGNIFICANT BITS?
=1****0
ASHL3: AR_ARX,ARX_BRX, ;RESTORE HI TO AR, LOW TO ARX
GEN #+SC,#/-36.,SKP SCAD0,J/ASHL4
SET AROV,J/ASHL3 ;BITS SHIFTED OUT NE SIGN
=*1***0
ASHL4: AR_ARX,ARX_0S, ;HERE IF E .GT. 36
SC_#+SC,#/-36.,J/ASHL2 ;SHIFT 36 PLACES, TRY AGAIN
MQ_SHIFT,AR_BRX,CLR ARX, ;HIGH OUTPUT TO MQ,
SC_#+SC,#/-1,B DISP ;COMPENSATE FOR EXTRA SHIFT
=1****0
ASHL5: AR_BR,BRX/ARX,ARX/MQ, ;SIGN TO AR, HIGH OUT TO ARX
SC_#,#/35., ;READY TO COMBINE THEM
B DISP,J/ASHX ;STORE AS APPROPRIATE
ARX_SHIFT,J/ASHL5 ;LOW OUTPUT TO ARX
;HERE TO GET FINAL RESULTS.
=*1***0
ASHX: AR_SHIFT,I FETCH,J/STORAC ;HERE AFTER ASH
AR_SHIFT,ARX_BRX, ;HERE AFTER ASHC
SC_#,#/35.,J/ST2AC

957
src/ucode/skpjmp.32 Executable file
View File

@@ -0,0 +1,957 @@
.TOC "TEST GROUP"
.DCODE
600: I-PF, J/TDN ;TRN- IS NOP
I-PF, J/TDN ;SO IS TLN-
I, TNE, J/TDXX
I, TNE, J/TSXX
I, TNA, J/TDX
I, TNA, J/TSX
I, TNN, J/TDXX
I, TNN, J/TSXX
610: I-PF, J/TDN ;TDN- IS A NOP
I-PF, J/TDN ;TSN- ALSO
R, TNE, J/TDXX
R, TNE, J/TSXX
R, TNA, J/TDX
R, TNA, J/TSX
R, TNN, J/TDXX
R, TNN, J/TSXX
620: I, TZ-, J/TDX
I, TZ-, J/TSX
I, TZE, J/TDXX
I, TZE, J/TSXX
I, TZA, J/TDX
I, TZA, J/TSX
I, TZN, J/TDXX
I, TZN, J/TSXX
630: R, TZ-, J/TDX
R, TZ-, J/TSX
R, TZE, J/TDXX
R, TZE, J/TSXX
R, TZA, J/TDX
R, TZA, J/TSX
R, TZN, J/TDXX
R, TZN, J/TSXX
640: I, TC-, J/TDX
I, TC-, J/TSX
I, TCE, J/TDXX
I, TCE, J/TSXX
I, TCA, J/TDX
I, TCA, J/TSX
I, TCN, J/TDXX
I, TCN, J/TSXX
650: R, TC-, J/TDX
R, TC-, J/TSX
R, TCE, J/TDXX
R, TCE, J/TSXX
R, TCA, J/TDX
R, TCA, J/TSX
R, TCN, J/TDXX
R, TCN, J/TSXX
660: I, TO-, J/TDX
I, TO-, J/TSX
I, TOE, J/TDXX
I, TOE, J/TSXX
I, TOA, J/TDX
I, TOA, J/TSX
I, TON, J/TDXX
I, TON, J/TSXX
670: R, TO-, J/TDX
R, TO-, J/TSX
R, TOE, J/TDXX
R, TOE, J/TSXX
R, TOA, J/TDX
R, TOA, J/TSX
R, TON, J/TDXX
R, TON, J/TSXX
.UCODE
;THESE 64 INSTRUCTIONS ARE DECODED BY MASK MODE (IMMEDIATE OR MEMORY)
; IN THE A FIELD, DISPATCH TO HERE ON THE J FIELD, AND RE-DISPATCH
; FOR THE MODIFICATION ON THE B FIELD.
; ENTER WITH 0,E OR (E) IN AR, B FIELD BITS 1 AND 2 AS FOLLOWS:
; 0 0 NO MODIFICATION
; 0 1 ZEROS
; 1 0 COMPLEMENT
; 1 1 ONES
; THIS ORDER HAS NO SIGNIFICANCE EXCEPT THAT IT CORRESPONDS TO THE
; ORDER OF INSTRUCTIONS AT TGROUP.
;THE HIGH ORDER BIT OF THE B FIELD (B0) IS XOR'D WITH AD CRY0 TO
; DETERMINE THE SENSE OF THE SKIP:
; 0 SKIP IF CRY0=1 (TXX- AND TXXN)
; 1 SKIP IF CRY0=0 (TXXA AND TXXE)
=00*000
TDX: TEST FETCH,NO CRY, ;TDXA AND TRXA
B DISP,J/TDN
TSX: AR_AR SWAP,TEST FETCH,NO CRY, ;TSX, TSXA, TLX, AND TLXA
B DISP,J/TDN
TSXX: AR_AR SWAP ;TSXE, TSXN, TLXE, AND TLXN
TDXX: TEST AR.AC0,TEST FETCH,B DISP ;TDXE, TDXN, TRXE, AND TRXN
TDN: J/FINI ;NO MODIFICATION
TDZ: AR_AR*AC0,AD/ANDCA,TIME/2T,J/STAC ;ZEROS
TDC: AR_AR*AC0,AD/XOR,TIME/2T,J/STAC ;COMP
TDO: AR_AR*AC0,AD/OR,TIME/2T,J/STAC ;ONES
=
.TOC "COMPARE -- CAI, CAM"
.DCODE
300: I, SJC-, J/CAIM ;CAI
I, SJCL, J/CAIM
I, SJCE, J/CAIM
I, SJCLE, J/CAIM
I, SJCA, J/CAIM
I, SJCGE, J/CAIM
I, SJCN, J/CAIM
I, SJCG, J/CAIM
310: R, SJC-, J/CAIM ;CAM
R, SJCL, J/CAIM
R, SJCE, J/CAIM
R, SJCLE, J/CAIM
R, SJCA, J/CAIM
R, SJCGE, J/CAIM
R, SJCN, J/CAIM
R, SJCG, J/CAIM
.UCODE
=00****
CAIM: GEN AR*AC0,COMP FETCH,J/NOP
=
.TOC "ARITHMETIC SKIPS -- AOS, SOS, SKIP"
;ENTER WITH (E) IN AR
.DCODE
330: R, SJC-, J/SKIP ;NOT A NOP IF AC .NE. 0
R, SJCL, J/SKIP
R, SJCE, J/SKIP
R, SJCLE, J/SKIP
R, SJCA, J/SKIP
R, SJCGE, J/SKIP
R, SJCN, J/SKIP
R, SJCG, J/SKIP
.UCODE
=00****
SKIP: FIN STORE,SKIP FETCH,
SKP AC#0,J/STSELF ;STORE IN SELF MODE
=
.DCODE
350: RPW, SJC-, J/AOS
RPW, SJCL, J/AOS
RPW, SJCE, J/AOS
RPW, SJCLE, J/AOS
RPW, SJCA, J/AOS
RPW, SJCGE, J/AOS
RPW, SJCN, J/AOS
RPW, SJCG, J/AOS
.UCODE
=00****
AOS: AR_AR+1,AD FLAGS,STORE,J/SKIP
=
.DCODE
370: RPW, SJC-, J/SOS
RPW, SJCL, J/SOS
RPW, SJCE, J/SOS
RPW, SJCLE, J/SOS
RPW, SJCA, J/SOS
RPW, SJCGE, J/SOS
RPW, SJCN, J/SOS
RPW, SJCG, J/SOS
.UCODE
=00****
SOS: AR_AR-1,AD FLAGS,STORE,J/SKIP
=
.TOC "CONDITIONAL JUMPS -- JUMP, AOJ, SOJ, AOBJ"
; ENTER WITH E IN VMA
.DCODE
320: I, SJC-, J/JUMP
I, SJCL, J/JUMP
I, SJCE, J/JUMP
I, SJCLE, J/JUMP
I, SJCA, J/JUMP
I, SJCGE, J/JUMP
I, SJCN, J/JUMP
I, SJCG, J/JUMP
.UCODE
=00****
.IFNOT/JPC
JUMP: AR_AC0,JUMP FETCH,J/NOP
.IF/JPC
JUMP: AR_AC0,JUMP FETCH,B DISP,J/JMPJPC
.ENDIF/JPC
=
.DCODE
340: I, SJC-, J/AOJ
I, SJCL, J/AOJ
I, SJCE, J/AOJ
I, SJCLE, J/AOJ
I, SJCA, J/AOJ
I, SJCGE, J/AOJ
I, SJCN, J/AOJ
I, SJCG, J/AOJ
.UCODE
=00****
.IFNOT/JPC
AOJ: AR_AC0+1,AD FLAGS,JUMP FETCH,J/STORAC
.IF/JPC
AOJ: AR_AC0+1,AD FLAGS,JUMP FETCH,J/AOJJPC
.ENDIF/JPC
=
.DCODE
360: I, SJC-, J/SOJ
I, SJCL, J/SOJ
I, SJCE, J/SOJ
I, SJCLE, J/SOJ
I, SJCA, J/SOJ
I, SJCGE, J/SOJ
I, SJCN, J/SOJ
I, SJCG, J/SOJ
.UCODE
;THE BASIC INSTRUCTION DISPATCH LOADS MQ WITH -1
;SO THAT WHEN WE GET HERE WE CAN ADD -1 TO THE AC IN
;A SINGLE MICRO-INSTRUCTION.
=00****
.IFNOT/JPC
SOJ: AR_MQ+AC0,AD FLAGS,JUMP FETCH,J/STORAC
.IF/JPC
SOJ: AR_MQ+AC0,AD FLAGS,JUMP FETCH,J/SOJJPC
.ENDIF/JPC
=
.DCODE
252: I, SJCGE, J/AOBJ
I, SJCL, J/AOBJ
.UCODE
=00****
.IFNOT/JPC
AOBJ: AR_AC0+1,GEN CRY18,JUMP FETCH,J/STORAC
.IF/JPC
AOBJ: AR_AC0+1,GEN CRY18,JUMP FETCH,J/AOBJPC
.ENDIF/JPC
=
.TOC "AC DECODE JUMPS -- JRST, JFCL"
.DCODE
254: I, J/JRST ;DISPATCHES TO 1 OF 16 ON AC BITS
I,TNN, J/JFCL
.UCODE
;A READ DETECTS JRST, AND DISPATCHES TO ONE OF 16 LOC'NS ON AC BITS
600: ;DRAM REQUIRES JRST AT MULTIPLE OF 200
.IFNOT/JPC
JRST: J/FINI ;(0) A READ PREFETCHES ON JRST 0,
.IF/JPC
JRST: AR_PC,SKP USER, ;(0) A READ PREFETCHES - GO STORE JPC
SC_#,#/32.,J/JPCEX
.ENDIF/JPC
601:
.IFNOT/ITSPAGE
PORTAL,BR/AR,J/BRJMP ;(1) PORTAL
.IF/ITSPAGE
BR/AR,J/BRJMP ;(1) NO PUBLIC PAGES => NO PORTAL
.ENDIF/ITSPAGE
602:
JRST2: EA MOD DISP,BR/AR,AR_ARX, ;(2) JRSTF
SC_#,#/9,J/JRSTF
603: J/UUO ;(3)
604: HALT,SKP IO LEGAL,J/IHALT ;(4) HALT
605: J/UUO ;(5)
606: J/UUO ;(6)
607: J/UUO ;(7)
610: DISMISS,BR/AR,J/BRJMP ;(10)
611: J/UUO ;(11)
612: DISMISS,J/JRST2 ;(12) JEN
613: J/UUO ;(13)
614: J/UUO ;(14)
615: J/UUO ;(15)
616: J/UUO ;(16)
617:
.IFNOT/JRSTON
J/UUO ;(17)
.IF/JRSTON
JRST17: BR/AR,BRX/ARX,AR_1,GEN CRY18, ;(17) JRSTON
ARX/AD,SC_#,#/7,J/JRSTON
.ENDIF/JRSTON
;JRST AND RESTORE FLAGS HAIR
=11***0
JRSTF: AR_PC,RSTR FLAGS_AR,J/JRSTF1 ;RESTORE FROM INDIRECT WORD
AR_XR,J/JRSTF ;INDEXED, RESTORE FROM REGISTER
;JRST AND RESTORE FLAGS HAIR - ONE-PROCEED VERSION.
;WE HAVE TO PREVENT JRSTF FROM TURNING OFF THE TRAP FLAGS.
;THIS MAKES ONE-PROCEED THROUGH JRST 2, WORK.
;IT DOESN'T HURT ANYTHING BECAUSE THE TRAP FLAGS NEVER NORMALLY
;STAY ON DURING EXECUTION OF AN INSTRUCTION.
;MUST COME TO JRSTF WITH 9 IN SC DUE TO DISP/SPEC & # CONFLICT.
;
;EVEN GROSSER HAIR- IF WE TOOK A PAGE FAULT ON THE INSTRUCTION
;FETCH AT THE NICOND, COULD DO AN ABORT INSTR AND LOSE THE
;TRAP FLAGS. MOSTLY THIS SCREWS ONE-PROCEED, BUT IT COULD
;SCREW OVERFLOW TRAPS IF INTERRUPTED OUT OF THEN THE PAGE
;SWAPPED OUT BEFORE PROGRAM RESUMED.
;TO FIX THIS WE DO 'SR_JRSTF' AND LET THE INSTRUCTION
;CLEAN-UP HANDLER TAKE CARE OF THE FLAGS.
;YET GROSSER HAIR! IN ORDER TO STORE THE RIGHT JPC,
;JRSTF DOES AR_PC AND THEN THE USER MODE FLAG IN THERE
;IS CHECKED, SINCE THE ONE IN THE HARDWARE HAS BEEN
;CLOBBERED BY THIS TIME. TO AVOID USING # TO DO THIS,
;JRSTF1 HAS TO PUT 1 INTO SC (USER = PC BIT 05 = LOW P BIT)
.IFNOT/ONE PROCEED
JRSTF1: SR_JRSTF,SC_1,J/BRJRF
.IF/ONE PROCEED
JRSTF1: SR_JRSTF,SC_1,SH DISP,J/BRJRF ;DISPATCH ON OLD TRAP BITS
=1*0011
.ENDIF/ONE PROCEED
.IFNOT/JPC
BRJRF:
BRJMP: VMA_BR,FETCH,J/NOP
.IF/JPC
BRJRF: VMA_BR,FETCH,GEN P AND SC,SKP SCAD NE,J/JPCEX
.ENDIF/JPC
.IF/ONE PROCEED ;DISP TABLE AFTER BRJRF
TRAP1,J/BRJRF ;TURN TRAP 1 BACK ON
TRAP2,J/BRJRF ;TURN TRAP 2 BACK ON
TRAP3,J/BRJRF ;TURN TRAP 3 BACK ON
.ENDIF/ONE PROCEED
.IF/JPC
BRJMP: VMA_BR,FETCH,J/JPCIFY
.ENDIF/JPC
.IF/JRSTON
;OKAY TO DO THIS INSTR IN USER MODE, SINCE WHEN IN
; USER MODE THE PI SYSTEM SHOULD BE ON ANYWAY.
;THIS INSTRUCTION IS USEFUL IN CONJUNCTION WITH THE
; PFAIL.PIHACK BUSINESS.
=*1**00
JRSTON: AR_SHIFT,ARX_BRX,REQ EBUS,CALL,J/WGRANT ;GOBBLE EBUS
=11 CONO PI ;TURN ON PI SYSTEM
.IF/ONE PROCEED
SC_#,#/9 ;SET UP SC FOR JRSTF
.ENDIF/ONE PROCEED
REL EBUS,AR_ARX, ;RELEASE EBUS, THEN
EA MOD DISP,J/JRSTF ; GO DO A JRSTF
.ENDIF/JRSTON
700: ;JFCL MUST BE AT JRST+100
JFCL: ARX_BRX,SC_#,#/13. ;GET BACK AC FIELD
=1***0*
AR_SHIFT,ARX_0S, ;MOVE AC TO AR32-35
SC_#,#/32.,CALL,J/SHIFT ;SHIFTER WILL MOVE TO 0-3
BR/AR,AR_PC,JFCL T ;GET PC FLAGS INTO AR
.IFNOT/JPC
TEST AR.BR,JFCL FETCH ;JUMP IF TEST SATISFIED
AR_AR*BR,AD/ANDCB ;CLEAR TESTED FLAGS IN AR
JFCL S,J/FINI ;SET PC FROM THEM
.IF/JPC
ARX_AR*BR,AD/ANDCB,SC_#,#/32. ;SET UP SC FOR JPC RING
TEST AR.BR,JFCL FETCH,AR_ARX,SKP CRY0
=*1***0
JFCL S,J/FINI ;NO JUMP, ALL DONE
JFCL S,AR_PC,SKP USER,J/JPCEX ;JUMP, GO RECORD JPC
.ENDIF/JPC
.TOC "HALT LOOP"
;HERE WHILE PROCESSOR IS "HALTED"
1016:
UUO107: ;OP 107 COMES HERE
IHALT: J/UUO ;HERE IF HALT IN USER/SUPER MODE
1017:
DHALT: AR_0S,SET HALTED, ;KERNEL OR CONSOLE HALT
VMA/PC,PC_VMA ; IF JRST 4, COPY EA TO PC
=1****0
HALT1: SKP -START,TIME/3T, ;CHECK FOR CONTINUE BUTTON
FE_AR0-8,ARX_AR,J/HALT2 ;PICK UP OPCODE IN CASE XCT
TAKE INTRPT ;HERE IF EXAMINE/DEPOSIT UP
=1****0
HALT2: GEN FE-1,BYTE DISP,CONTINUE,J/UNHALT ;INSTR FROM SWITCHES?
SKP INTRPT,J/HALT1
=110
UNHALT: SET CONS XCT,J/UXCT ;XCT ONE FROM "SWITCHES"
SKP AR EQ,J/START ;NOT AN INSTR. START, OR CONT?
.TOC "MAP, XCT"
.DCODE
256: R, J/XCT ;OPERAND FETCHED AS DATA
.IF/MAP
I, AC, J/MAP
.IFNOT/MAP
J/UUO
.ENDIF/MAP
.UCODE
.IF/MAP
=00***0
.IFNOT/MAP
1001: ;GET XCT NEAR UUO
.ENDIF/MAP
.IFNOT/XCTR
XCT: SKP INTRPT,J/XCT1 ;CHECK FOR XCT . LOOP
.IF/XCTR
XCT: SKP INTRPT,J/UXCT ;CHECK FOR XCT LOOP
.ENDIF/XCTR
.IF/MAP
MAP: MAP,BR/AR ;MAP E, GO READ BACK EBRG
=
.IF/KLPAGE ;IN KL PAGING MODE,
SR_MAP ;MAP CAN PAGE FAIL
.ENDIF/KLPAGE
.IFNOT/MAP
.IFNOT/XCTR
=
.ENDIF/XCTR
.ENDIF/MAP
=11***0
RDEBRG: AR_0S,SKP IO LEGAL,MB WAIT, ;FINISH READ REG FUNC
CALL,J/GETEEB ;AND GET EBUS
AR_EBUS REG ;READ DATA
REL ECL EBUS,B WRITE,J/ST6 ;GIVE IT TO USER
.TOC "ITS PAGE MAP INSTRUCTIONS -- LPM, SPM"
;THE WORDS LOADED OR STORED BY LPM AND SPM ARE AS FOLLOWS:
; (E) JPC (OR JPC RING POINTER)
; (E+1) ADDRESS BREAK WORD
; (E+2) PFW AS OF MOST RECENT PAGE FAIL
; (E+3) DBR1
; (E+4) DBR2
.IF/LPM.SPM
=00**00
LPM: ARX_AR,VMA_VMA+1,LOAD AR,J/LPM1 ;ARX_JPC,FETCH MAR
=10
SPM: CALL,SKP KERNEL,J/IOCHK ;SPM OKAY ONLY IN KERNEL MODE
.IFNOT/JPC SUPPORT
VMA_VMA+1
=
.IF/JPC SUPPORT
AR_JPC,STORE
= MEM_AR,VMA_VMA+1
.ENDIF/JPC SUPPORT
AR_UPFW,STORE,VMA_VMA+1
MEM_AR,VMA_VMA+1
AR_DBR1,STORE
MEM_AR,VMA_VMA+1
AR_DBR2,STORE,J/STMEM
=11***0
LPM1: AR_MEM,CALL,SKP KERNEL,J/GETEEB ;LPM LEGAL ONLY IN KERNEL MODE
DATAO APR
REL ECL EBUS,AR_ARX
.IF/JPC SUPPORT
JPC_AR
.ENDIF/JPC SUPPORT
VMA_VMA+1,LOAD AR
AR_MEM,VMA_VMA+1
BAG-BITING NO-OP
UPFW_AR,LOAD AR
AR_MEM,VMA_VMA+1
BAG-BITING NO-OP
DBR1_AR,LOAD AR
AR_MEM
BAG-BITING NO-OP
DBR2_AR,J/CLRPT1 ;REALLY LPMR - CLEAR PAGE TABLE
.ENDIF/LPM.SPM
.TOC "STACK INSTRUCTIONS -- PUSHJ, PUSH, POP, POPJ"
.DCODE
260: I, J/PUSHJ
R, B/0, J/PUSH
W, J/POP
I, J/POPJ
.UCODE
;PUSHJ
; ENTER WITH E IN AR
;PUSH
; ENTER WITH (E) IN AR
=00***0
PUSH: ARX_AC0+1,GEN CRY18,SKP CRY0, ;BUMP BOTH HALVES OF AC,
VMA/AD,STORE,J/STMAC ;PUT AR ONTO LIST
PUSHJ: BR/AR,AR_PC+1 ;SAVE JUMP ADDR, GET PC
= ARX_AC0+1,GEN CRY18,SKP CRY0, ;COMPUTE STACK ADDRESS
VMA/AD,STORE,J/JSTAC ;AND PREPARE TO STORE PC
=*1**00
JRA1: VMA_AR,LOAD ARX,CALL,J/XFERW ;GET SAVED AC
=10
.IFNOT/JPC
JSTAC: FIN STORE,VMA_BR,FETCH, ;STORE PC, JUMP ADDR TO VMA
AR_ARX,J/STORAC ;PREPARE TO STORE AC VALUE
.IF/JPC
JSTAC: FIN STORE,VMA_BR,FETCH, ;STORE AC, THEN RECORD JPC
AR_ARX,SKP USER,J/JPCSTO
.ENDIF/JPC
MEM_AR,TRAP2,J/JSTAC ;CAUSE PDL OVRFLO
=1****0
STMAC: FIN STORE,I FETCH, ;STORE RESULT, GET NEXT INSTR
AR_ARX,B DISP,J/STSELF ;STORE AC IF B=0
MEM_AR,TRAP2, ;PDL OVFLO, CAUSE TRAP
AR_ARX,J/IFSTAC ;UPDATE AC BEFORE TRAPPING
;POP, POPJ
=00***0
;ENTER WITH C(AC) IN AR, E IN BR, OK TO WRITE IN E
POP: VMA_AR,LOAD ARX,J/POP1 ;BEGIN DATA FETCH FROM STACK
;ENTER WITH E IN AR
POPJ: AR_AC0,VMA/AD,LOAD ARX ;START FETCH FROM STACK
= AR_AR-1,INH CRY18,SKP CRY0 ;DECR STACK POINTER, CHECK UNDERFLOW
.IFNOT/JPC.RING
=*1***0
ARX_MEM,TRAP2,J/POPJ1 ;UNDERFLOW OCCURRED
ARX_MEM ;GET STACK WORD
.IFNOT/JPC
POPJ1: AC0_AR,VMA_ARX,FETCH,J/NOP ;SET NEW AC VALUE, JUMP
.IF/JPC
POPJ1: AC0_AR,VMA_ARX,FETCH,J/JPCIFY
.ENDIF/JPC
.IF/JPC.RING
=*1***0
ARX_MEM,TRAP2 ;TWO TICKS SLOWER ON OVERFLOW, BUT WHO CARES?
ARX_MEM,SKP USER,SC_#,#/32. ;JPC.RING NEEDS 32. IN SC
AC0_AR,VMA_ARX,FETCH,J/JPCEX
AC0_AR,VMA_ARX,FETCH,J/JPCUSR
.ENDIF/JPC.RING
POP1: AR_AR-1,INH CRY18,SKP CRY0 ;ADJUST POINTER, CHECK TRAP
=*1***0
ARX_MEM,TRAP2 ;PDL OVFLO, CAUSE TRAP
ARX_MEM,SR_#,#/100 ;SET DEST CONTEXT FLAG
AR_ARX,AC0_AR, ;FIRST STORE AC
VMA_BR,STORE,J/STMEM ;THEN MEMORY
;PUT RESULT AWAY, THEN AC
.TOC "SUBROUTINE CALL/RETURN -- JSR, JSP, JSA, JRA"
.DCODE
264: I, J/JSR
I, J/JSP
I, J/JSA
I, J/JRA
.UCODE
=00***0
.IFNOT/JPC
JSP: AR_PC+1,FETCH,J/STORAC
.IF/JPC
JSP: AR_PC+1,FETCH,SKP USER,J/JPCSTO
.ENDIF/JPC
JSR: AR_PC+1,STORE
=
.IFNOT/JPC
FIN STORE,VMA_VMA+1,FETCH,J/NOP
.IF/JPC
FIN STORE,VMA_VMA+1,FETCH,J/JPCIFY
.ENDIF/JPC
=00***0
JSA: ARX_AR SWAP,AR_AC0,STORE,J/JSA1 ;SAVE E IN ARX LEFT, GET AC
JRA: BR/AR,AR_AC0 ;GET AC, SAVE JUMP ADDR
= ARR_ARL,ARL_0.M,J/JRA1 ;GET AC LEFT
JSA1: FIN STORE,VMA_VMA+1,FETCH ;JUMP TO E+1
.IFNOT/JPC
ARR_PC+1,ARL_ARXL,J/STAC ;PC+1,,E GOES TO AC
.IF/JPC
ARR_PC+1,ARL_ARXL,SKP USER,J/JPCSTO
.ENDIF/JPC
.TOC "UUO'S"
;LUUO'S TRAP TO CURRENT CONTEXT
; EXTENDED INSTRUCTION SET IS "HIDDEN" BENEATH LUUO OPCODES
.DCODE
000: I, J/UUO
.IF/EIS
I, SJCL, J/L-CMS ;CMSL HIDDEN BENEATH LUUO
I, SJCE, J/L-CMS
I, SJCLE, J/L-CMS
I, B/2, J/L-EDIT ;EDIT HIDDEN UNDER 004
I, SJCGE, J/L-CMS
I, SJCN, J/L-CMS
I, SJCG, J/L-CMS
.IF/DECIMAL
010: I, B/1, J/L-DBIN ;CVTDBO
I, B/4, J/L-DBIN ;CVTDBT
I, B/1, J/L-BDEC ;CVTBDO
I, B/0, J/L-BDEC ;CVTBDT
.IFNOT/DECIMAL
010: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
.ENDIF/DECIMAL
014: I, B/1, J/L-MVS ;MOVSO
I, B/0, J/L-MVS ;MOVST
I, B/2, J/L-MVS ;MOVSLJ
I, B/3, J/L-MVS ;MOVSRJ
.IFNOT/EIS
I, J/LUUO
I, J/LUUO
I, J/LUUO
004: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
010: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
014: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
.ENDIF/EIS
;USER UUO'S 20-37
020: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
024: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
030: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
034: I, J/LUUO
I, J/LUUO
I, J/LUUO
I, J/LUUO
;MONITOR UUO'S -- TRAP TO EXEC
040: I, J/MUUO ;CALL
I, J/MUUO ;INIT
I, J/MUUO
I, J/MUUO
I, J/MUUO
I, J/MUUO
I, J/MUUO
I, J/MUUO ;CALLI
I, J/MUUO ;OPEN
I, J/MUUO ;TTCALL
I, J/MUUO
I, J/MUUO
I, J/MUUO
I, J/MUUO ;RENAME
I, J/MUUO ;IN
I, J/MUUO ;OUT
.IFNOT/JPC TEST
I, J/MUUO ;SETSTS
I, J/MUUO ;STATO
I, J/MUUO ;GETSTS
I, J/MUUO ;STATZ
I, J/MUUO ;INBUF
I, J/MUUO ;OUTBUF
I, J/MUUO ;INPUT
I, J/MUUO ;OUTPUT
.IF/JPC TEST
I, SJC-, J/TJMP
I, SJCL, J/TJMP
I, SJCE, J/TJMP
I, SJCLE, J/TJMP
I, SJCA, J/TJMP
I, SJCGE, J/TJMP
I, SJCN, J/TJMP
I, SJCG, J/TJMP
.ENDIF/JPC TEST
.IFNOT/LISP
I, J/MUUO ;CLOSE
I, J/MUUO ;RELEAS
.IF/LISP
I, J/LSPGCM ;LSPGCM (OPCODE 070)
I, J/LSPGCS ;LSPGCS (OPCODE 071)
.ENDIF/LISP
I, J/MUUO ;MTAPE
I, J/MUUO ;UGETF
.IFNOT/XCTR
I, J/MUUO ;USETI
I, J/MUUO ;USETO
.IF/XCTR
R, J/PXCT ;PXCT FOR ITS (OPCODE 074)
R, J/PXCT ;PXCTI FOR ITS (OPCODE 075)
.ENDIF/XCTR
.IFNOT/LPM.SPM
I, J/MUUO ;LOOKUP
I, J/MUUO ;ENTER
.IF/LPM.SPM
R, J/LPM ;LOAD PAGE MAP (OPCODE 076)
W, J/SPM ;STORE PAGE MAP (OPCODE 077)
.ENDIF/LPM.SPM
;EXPANSION OPCODES
100:
.IFNOT/LISP
I, J/UUO ;UJEN
I, J/UUO
.IF/LISP
I, J/LSPDBG ;LSPDBG (OPCODE 100, TEMP)
I, J/LSP101
.ENDIF/LISP
I, J/UUO
I, J/UUO
.UCODE
;HERE FOR UNDEFINED OPS (UUO'S) AND ILLEGAL INSTRUCTIONS
;E IS IN AR, OPCODE AND AC IN BRX
1002: ;FIXED ADDRESS TO COOPERATE
;WITH EXTEND AND OTHER OPS
UUO: ;UNDEFINED OP'S .GE. 100
MUUO: ARX_BRX,SC_#,#/13.,
SKP INTRPT,CALL,J/ROTS
1003: AR_SHIFT,VMA_#,#/424,J/MUUO1
;HERE ON LUUO'S
; E IN AR, INSTR IN BRX
1005:
.IFNOT/EIS
FIX: FE_EXP-#,#/244,SKP SCAD0, ;GET BINARY POINT POSITION
ARX_AR SIGN,J/FIX1 ;SET ROUNDING CONSTANT, GO FIX
.IF/EIS
L-CMS: J/LUUO ;LOC FOR HIDING STRING COMPARE
.ENDIF/EIS
1006:
.IF/EIS
L-EDIT: ;HIDE EDIT HERE
.ENDIF/EIS
LUUO: ARX_BRX,SC_#,#/13.,
CALL,SKP INTRPT,J/ROTS ;COMBINE E WITH UUO
1007: AR_SHIFT,VMA_40,STORE ;STORE OPCODE ETC AT 40
FIN STORE,VMA_41,
LOAD ARX,J/XCTW ;GO PERFORM 41
.IF/EIS
.IF/DECIMAL
1010:
L-DBIN: J/LUUO ;DBIN AT 2010
1011:
L-BDEC: J/LUUO ;BDEC AT 2011
.ENDIF/DECIMAL
1012:
L-MVS: J/LUUO ;MOVE STRING AT 2012
.ENDIF/EIS
.IF/JPC TEST
=00****
TJMP: AR_AC0,JUMP FETCH,B DISP,J/JMPJPC
.ENDIF/JPC TEST
.IF/LISP
=00***0
LSPGCM: BR/AR,MQ_AR,AR_GCSTBR,SKP AD NE,J/LGCM0 ;START OF GC MARK INSTR
LSPGCS: BR/AR,SC_EA,AR_GCSTBR,SKP AD NE,J/LGCS0 ;START OF GC SWEEP INSTR
=
=00***0
LSPDBG: AR_GCSTBR,J/LSPDB1
LSP101: J/UUO
=
.ENDIF/LISP
;HERE ON MUUO'S
; E IN AR, OP AND AC IN BRX
;MUUO: ARX_BRX,SC_#,#/13.,CALL,J/ROTS
; AR_SHIFT,VMA_#,#/424
MUUO1: STORE,UPT REF ;FIRST, STORE INSTRUCTION
FIN STORE,AR_PC+1,VMA_VMA+1,STORE ;NEXT, PC
=11**00
MEM_AR,VMA_VMA+1,SC_#,#/70,
CALL,J/GTEEB1
DATAI PAG(L),CALL,J/PCTXT ;GET PROCESS CONTEXT VARIABLES
=11 LD PREV CTXT ;PCS FROM PC, CWSX FROM SXCT
AR_SHIFT,ARL_BRL.S, ;COMBINE UBR WITH AC BLKS, CWSX
STORE, ; STORE THAT AT 426
COND/EBUS CTL,EBUS CTL/2; & RELEASE ECL EBUS
MEM_AR,VMA_430+MODE ;NOW READY TO GET NEW PC
LOAD AR,UPT REF ;FETCH NEW PC
NEWPC: AR_MEM,SR_0,J/START ;USE IT
;ROTATE SUBROUTINE
=11***0
ROTS: AR_SHIFT,ARX_SHIFT,SC_#-SC,#/36.,RETURN3
TAKE INTRPT ;FIXES LUUO IN USER 41 LOOP BUG
.TOC "JSYS, ADJSP"
.DCODE
104:
.IFNOT/MVSQZ
I, J/UUO ;JSYS
.IF/MVSQZ
R, J/MVSQZ
.ENDIF/MVSQZ
I, B/0, J/ADJSP
.UCODE
;HERE FOR ADJSP INSTRUCTION
; ENTER WITH E IN AR, PREFETCH IN PROGRESS
.IFNOT/MVSQZ
1000: ;PUT ADJSP NEXT TO UUO
.IF/MVSQZ
=00***0
MVSQZ: FE_#,#/5,ARX_0S,MQ_MQ*.25, ;FE COUNTS LOOP, CLEAR MQ00,
J/MVSQZ0 ;ARX ACCUMULATES SQUOZE
.ENDIF/MVSQZ
ADJSP: ARL_ARR,ARR_ARR ;PUT E IN BOTH HALVES
= AR_AR*AC0,AD/A+B,INH CRY18, ;ADJUST POINTER,
ARX/AD,SKP AR0 ;SKIP IF NEGATIVE
=0 GEN AR*AC0,AD/ANDCA, ;TEST FOR - TO + CHANGE
SKP AD0,J/STMAC
GEN AR*AC0,AD/ANDCB, ;TEST FOR + TO - CHANGE
SKP AD0,J/STMAC
.IF/MVSQZ
=1****0
MVSQZ0: ARX_ARX*8,GEN P-#,#/41,
SKP SCAD0,J/MVSQZ1
AR_ARX,I FETCH,J/STORAC
=1****0
MVSQZ1: P_P-#,#/26,ARX_ARX*5,J/MVSQZ5
GEN P-#,#/20,ARX_ARX*5,
SKP SCAD0
=1****0
P_P-#,#/17,J/MVSQZ5
GEN P-#,#/16,SKP SCAD NE
=1****0
P_#,#/45,J/MVSQZ5
GEN P-#,#/1,SKP SCAD0
=1****0
P_P+#,#/42
MVSQZ5: BR/AR,BRX/ARX,ARX_AR,AR_0S,SC_#,#/6
ARX_SHIFT,AR_BR
ARX_ARX+BRX,AR_SHIFT,
FE_FE-1,SKP SCAD0,J/MVSQZ0
.ENDIF/MVSQZ
.TOC "XCT, PXCT, SXCT"
;HERE FOR EXTENDED ADDRESSING INSTRUCTIONS
.IFNOT/XCTR
=1****0
XCT1: SKP USER,J/PXCT ;HERE ON XCT, NO INTERRUPT
TAKE INTRPT ;GET OUT OF LONG XCT CHAIN
=1****0
.IFNOT/XADDR
PXCT: BR/AR,ARX_AR,SET PXCT,J/PXCTEA ;SETUP CONTROL FLOPS
.IF/XADDR
PXCT: SET PXCT
.ENDIF/XADDR
UXCT: ARX_AR (AD),LOAD IR,J/XCTGO, ;COPY INSTR TO ARX, IR
TIME/3T ;MAYBE THIS WILL FIX SUSPECTED LOSSAGE?
.IF/XCTR
=00***0
PXCT: CALL,SKP KERNEL,J/IOCHK ;XCTR OKAY ONLY IN KERNEL MODE
SKP INTRPT,J/XCTR ;XCTR AND XCTRI
=*1***0
XCTR: BR/AR,ARX_AR,SET PXCT,J/PXCTEA
TAKE INTRPT
=*1***0
UXCT: ARX_AR (AD),LOAD IR,J/XCTGO
TAKE INTRPT
.ENDIF/XCTR
.DCODE
.IFNOT/SXCT
106: I, J/UUO
I, J/UUO
.IF/SXCT ;NOTE: THE SXCT INSTRUCTION IS A TEMPORARY MECHANISM
106: R, J/SXCT ;INTENDED FOR DIAGNOSTICS ONLY
I, J/UUO107
.ENDIF/SXCT
.UCODE
.IF/SXCT
1014: ;PUT NEXT TO UUO107
SXCT: SKP KERNEL,CALL,J/IOCHK ;LEGAL IN KERNEL MODE ONLY
1015: BR/AR,ARX_AR,AR_AC0, ;SHUFFLE INSTR TO GET BASE REG
SET SXCT ;SETUP HARDWARE FLAGS
SKP AC#0 ;CHOOSE LOOP FOR EA CALC
=0 BR/AR,AR_BR,LOAD IR, ;AC0 IS BASE INDEX
BRX/ARX,ARL_0.M,
EA MOD DISP,J/SXCTB
.ENDIF/SXCT
;EXTENDED ADDRESSING CONTINUED
.IFNOT/XADDR
PXCTEA: AR_BR,LOAD IR,ARL_0.M, ;GET EXT ADDR FROM XR OR INDRCT
BRX/ARX,J/XIND2
=00
PXLOOP: GEN AR,A READ ;GO DO INSTR
AR_AR+XR,A READ
GEN AR,A INDRCT,SKP INTRPT,J/XIND1
GEN AR+XR,A INDRCT,SKP INTRPT
=1****0
XIND1: AR_MEM,ARX_MEM,EA TYPE DISP,J/XIND2
MB WAIT,TAKE INTRPT
=1***00
XIND2: EA MOD DISP,J/PXLOOP ;CURRENT OR PREV WITHOUT CWSX
AR_ARX (AD),A READ ;PREV AND CWSX
.IF/SXCT
AR_ARX (AD),A READ ;SXCT 0,
EA MOD DISP,J/SXCTB ;SXCT B,
=1***00
SXCTB: AR_AR+BR,A READ ;GO
AR_AR+XR,ARL_0.C,J/SXCTB ;NO MORE INDIRECTS
GEN AR,A INDRCT, ;FOLLOW INDRCT POINTER
SKP INTRPT,J/XIND1
GEN AR+XR,A INDRCT,
SKP INTRPT,J/XIND1
.ENDIF/SXCT
.ENDIF/XADDR