Trailing-Edge
-
PDP-10 Archives
-
BB-JF16A-SB_1986
-
simple.mic
There is 1 other file named simple.mic in the archive. Click here to see a list.
.BIN
.TOC "POWER UP SEQUENCE"
.UCODE
;HERE IS WHERE WE FIRE THE MACHINE UP DURING POWER ON
0: [MASK]_#, #/377777 ;BUILD A MASK WITH
[MASK]_[MASK]*2 ; A ONE IN 36-BITS AND 0
[MASK]_[MASK].OR.#,#/1 ; IN BITS -2,-1,36,37
[MAG]_[MASK]*.5 ;MAKE CONSTANT
[XWD1]_#, #/1 ;CONSTANT WITH 1 IN EACH
; HALF WORD
[ONE]_0 XWD [1], ;THE CONSTANT 1
CALL/1 ;RESET STACK (CAN NEVER RETURN
; TO WHERE MR LEFT US)
3: [AR]_0 XWD [376000] ;ADDRESS OF HALT STATUS
; BLOCK
WORK[HSBADR]_[AR] ;SAVE FOR HALT LOOP
[UBR]_0, ABORT MEM CYCLE ;CLEAR THE UBR AND RESET
; MEMORY CONTROL LOGIC
[EBR]_0, LOAD AC BLOCKS ;CLEAR THE EBR AND FORCE
; PREVIOUS AND CURRENT AC
; BLOCKS TO ZERO
[FLG]_0, SET APR ENABLES ;CLEAR THE STATUS FLAGS AND
; DISABLE ALL APR CONDITIONS
WORK[APR]_[FLG] ;ZERO REMEMBERED ENABLES
WORK[TIME0]_[FLG] ;CLEAR TIME BASE
WORK[TIME1]_[FLG] ; ..
.IF/FULL
AC[BIN0]_0 ;COMPUTE A TABLE OF POWERS OF
AC[BIN1]_1 ; TEN
[AR]_0, SC_19. ;WE WANT TO GET 22 NUMBERS
WORK[DECLO]_1 ;STARTING WITH 1
WORK[DECHI]_0 ; ..
[HR]_#, WORK/DECLO ;ADDRESS OF LOW WORD
[BRX]_#, WORK/DECHI ;ADDRESS OF HIGH WORD
TENLP: [BRX]_[BRX]+1, LOAD VMA ;ADDRESS THE HIGH WORD
=0* [ARX]_AC[BIN1], ;LOW WORD TO ARX
CALL [DBSLOW] ;MULTIPLY BY TEN
RAM_[BR] ;SAVE HIGH WORD
[HR]_[HR]+1, LOAD VMA ;WHERE TO STORE LOW WORD
RAM_[ARX], STEP SC ;STORE LOW WORD AND SEE IF
; WE ARE DONE
=0 J/TENLP ;NOT YET--KEEP GOING
[BR].XOR.#, 3T, SKIP ADL.EQ.0, #/330656
;DID WE GET THE RIGHT ANSWER
; IN THE TOP 18 BITS?
=0**0 HALT [MULERR] ;NO--CPU IS BROKEN
.ENDIF/FULL
=0**1 [PI]_0, CALL [LOADPI] ;CLEAR PI STATE
=1**1 ;CLEAR REGISTERS SO NO
;PARITY ERROR HAPPEN
.IFNOT/FULL
[ARX]_0 ;WRITTEN WHILE COMPUTING POWERS
[BR]_0 ;OF 10
[BRX]_0
.ENDIF/FULL
[T1]_0 XWD [120] ;RH OF 120 CONTAINS START ADDRESS
; FOR SIMULATOR. FOR THE REAL
; MACHINE IT IS JUST DATA WITH
; GOOD PARITY.
=
;THE CODE UNDER .IF/SIM MUST USE THE SAME ADDRESS AS THE CODE
; UNDER .IFNOT/SIM SO THAT MICROCODE ADDRESSES DO NOT CHANGE BETWEEN
; VERSIONS
.IF/SIM
VMA_[T1], START READ ;READ THE WORD
MEM READ, [PC]_MEM, HOLD LEFT, J/START
;GO FIRE UP SIMULATOR AT THE
; PROGRAMS STARTING ADDRESS
.IFNOT/SIM
[PC]_0, ;CLEAR LH OF PC
LEAVE USER, ;ENTER EXEC MODE
LOAD FLAGS ;CLEAR TRAP FLAGS
[T1]_#, HALT/POWER, ;LOAD T1 WITH POWER UP CODE
J/PWRON ;ENTER HALT LOOP. DO NOT STORE
; HALT STATUS BLOCK
.ENDIF/SIM
.TOC "THE INSTRUCTION LOOP -- START NEXT INSTRUCTION"
;ALL INSTRUCTIONS EXCEPT JUMP'S AND UUO'S END UP HERE
1400:
DONE: DONE
1401: VMA_[PC]+1, NEXT INST FETCH, FETCH
=0
SKIP: VMA_[PC]+1, NEXT INST FETCH, FETCH
DONE
;16-WAY DISPATCH BASED ON NEXT INSTRUCTION
=0000
NICOND:
=0001 [AR]_0 XWD [423], ;TRAP TYPE 3
; GET ADDRESS OF TRAP INST
TURN OFF PXCT, ;CLEAR PXCT
J/TRAP ;PROCESS TRAP (INOUT.MIC)
=0010 [AR]_0 XWD [422], ;TRAP TYPE 2
TURN OFF PXCT, ;CLEAR PXCT
J/TRAP ;GO TRAP
=0011 [AR]_0 XWD [421], ;TRAP TYPE 1
TURN OFF PXCT, ;TURN OF PXCT
J/TRAP ;GO TRAP
=0101 HALT [CSL] ;"HA" COMMAND TO 8080
=0111
VMA_[PC], ;LOAD VMA
FETCH, ;INDICATE INSTRUCTION FETCH
J/XCTGO ;GO GET INSTRUCTION
;THE NEXT SET OF CASES ARE USED WHEN THERE IS A FETCH
; IN PROGESS
=1000
NICOND-FETCH:
=1001 [AR]_0 XWD [423], ;TRAP TYPE 3
TURN OFF PXCT,
J/TRAP
=1010 [AR]_0 XWD [422], ;TRAP TYPE 2
TURN OFF PXCT,
J/TRAP
=1011 [AR]_0 XWD [421], ;TRAP TYPE 1
TURN OFF PXCT,
J/TRAP
=1101 HALT [CSL] ;"HA" COMMAND TO 8080
=1111
XCTGO: MEM READ, ;WAIT FOR MEMORY
[HR]_MEM, ;PUT DATA IN HR
LOAD INST, ;LOAD IR & AC #
J/INCPC ;GO BUMP PC
=
;HERE WE POINT PC TO NEXT INSTRUCTION WHILE WE WAIT FOR
; EFFECTIVE ADDRESS LOGIC TO SETTLE
INCPC: VMA_[PC]+1, ;ADDRESS OF NEXT INSTRUCTION
FETCH/1, ;INSTRUCTION FETCH
TURN OFF PXCT, ;CLEAR EFFECT OF PXCT
EA MODE DISP ;DISPACTH OF INDEXING AND @
;MAIN EFFECTIVE ADDRESS CALCULATION
=0001
EACALC:
;
; THE FIRST 4 CASES ARE USED ONLY FOR JRST
;
;CASE 0 -- JRST 0,FOO(XR)
[PC]_[HR]+XR, ;UPDATE PC
HOLD LEFT, ;ONLY RH
LOAD VMA, FETCH, ;START GETTING IT
NEXT INST FETCH ;START NEXT INST
;CASE 2 -- JRST 0,FOO
[PC]_[HR], ;NEW PC
HOLD LEFT, ;ONLY RH
LOAD VMA, FETCH, ;START GETTING IT
NEXT INST FETCH ;START NEXT INST
;CASE 4 -- JRST 0,@FOO(XR)
[HR]_[HR]+XR, ;ADD IN INDEX
START READ, ;START TO FETCH @ WORD
LOAD VMA, ;PUT ADDRESS IN VMA
J/FETIND ;GO DO MEM WAIT (FORGET ABOUT JRST)
;CASE 6 -- JRST 0,@FOO
VMA_[HR], ;LOAD UP ADDRESS
START READ, ;START TO FETCH @ WORD
J/FETIND ;GO DO MEM WAIT (FORGET ABOUT JRST)
;
;THESE 4 ARE FOR THE NON-JRST CASE
;
;CASE 10 -- JUST INDEXING
INDEX: [HR]_[HR]+XR, ;ADD IN INDEX REGISTER
HOLD LEFT ;JUST DO RIGHT HALF
;CASE 12 -- NO INDEXING OR INDIRECT
NOMOD: [AR]_EA, ;PUT 0,,E IN AR
PXCT DATA, AREAD ;DO ONE OR MORE OF THE FOLLWING
; ACCORDING TO THE DROM:
;1. LOAD VMA
;2. START READ OR WRITE
;3. DISPATCH TO 40-57
; OR DIRECTLY TO EXECUTE CODE
;CASE 14 -- BOTH INDEXING AND INDIRECT
BOTH: [HR]_[HR]+XR, ;ADD IN INDEX REGISTER
LOAD VMA, PXCT EA, ;PUT ADDRESS IN VMA
START READ, J/FETIND ;START CYCLE AND GO WAIT FOR DATA
;CASE 16 -- JUST INDIRECT
INDRCT: VMA_[HR], ;LOAD ADDRESS OF @ WORD
START READ, PXCT EA ;START CYCLE
;HERE TO FETCH INDIRECT WORD
FETIND: MEM READ, [HR]_MEM, ;GET DATA WORD
HOLD LEFT, ;JUST RIGHT HALF
LOAD IND EA ;RELOAD @ AND INDEX FLOPS
XCT2: VMA_[PC], ;PUT PC BACK IN VMA
FETCH/1, ;TURN ON FETCH FLAG
EA MODE DISP, ;REDO CALCULATION FOR
J/EACALC ; NEW WORD
.TOC "THE INSTRUCTION LOOP -- FETCH ARGUMENTS"
;HERE ON AREAD DISP TO HANDLE VARIOUS CASES OF ARGUMENT FETCH
;CASE 0 -- READ (E)
40: MEM READ, ;WAIT FOR DATA
[AR]_MEM, ;PUT WORD IN AR
INST DISP ;GO TO EXECUTE CODE
;CASE 1 -- WRITE (E)
41: [AR]_AC, ;PUT AC IN AR
INST DISP ;GO TO EXECUTE CODE
;CASE 2 -- DOUBLE READ
42: MEM READ, ;WAIT FOR DATA
[AR]_MEM ;PUT HI WORD IN AR
VMA_[HR]+1, PXCT DATA, ;POINT TO E+1
START READ ;START MEMORY CYCLE
MEM READ, ;WAIT FOR DATA
[ARX]_MEM, ;LOW WORD IN ARX
INST DISP ;GO TO EXECUTE CODE
;CASE 3 -- DOUBLE AC
43: [AR]_AC ;GET HIGH AC
[ARX]_AC[1], ;PUT C(AC+1) IN ARX
INST DISP ;GO TO EXECUTE CODE
;CASE 4 -- SHIFT
44:
SHIFT: READ [AR], ;LOOK AT EFFECTIVE ADDRESS
SKIP DP18, ;SEE IF LEFT OR RIGHT
SC_SHIFT-1, ;PUT NUMBER OF PLACES TO SHIFT IN
LOAD FE, ; SC AND FE
INST DISP ;GO DO THE SHIFT
;CASE 5 -- SHIFT COMBINED
45: Q_AC[1] ;PUT LOW WORD IN Q
[BR]_AC*.5 LONG ;PUT AC IN BR & SHIFT BR!Q RIGHT
[BR]_[BR]*.5 LONG, ;SHIFT BR!Q 1 MORE PLACE RIGHT
J/SHIFT ;GO DO SHIFT SETUP
;CASE 6 -- FLOATING POINT IMMEDIATE
46: [AR]_[AR] SWAP, ;FLIP BITS TO LEFT HALF
J/FPR0 ;JOIN COMMON F.P. CODE
;CASE 7 -- FLOATING POINT
47: MEM READ, ;WAIT FOR MEMORY (SPEC/MEM WAIT)
[AR]_MEM ;DATA INTO AR
=0
FPR0: READ [AR], ;LOOK AT NUMBER
SC_EXP, FE_EXP, ;PUT EXPONENT IN SC & FE
SKIP DP0, ;SEE IF NEGATIVE
CALL [ARSIGN] ;EXTEND AR SIGN
FPR1: [ARX]_0, ;ZERO ARX
INST DISP ;GO TO EXECUTE CODE
;CASE 10 -- READ THEN PREFETCH
50: MEM READ, ;WAIT FOR DATA
[AR]_MEM THEN FETCH, ;PUT DATA IN AR AND START A READ
; VMA HAS PC+1.
INST DISP ;GO DO IT
;CASE 11 -- DOUBLE FLOATING READ
51: SPEC MEM READ, ;WAIT FOR DATA
[BR]_MEM, ;HOLD IN BR
SC_EXP, FE_EXP, ;SAVE EXPONENT
SKIP DP0, 3T ;SEE IF MINUS
=0 [AR]_[AR]+1, ;POINT TO E+1
LOAD VMA, PXCT DATA, ;PUT IN VMA
START READ, J/DFPR1 ;GO GET POSITIVE DATA
[AR]_[AR]+1, ;POINT TO E+1
LOAD VMA, PXCT DATA, ;PUT IN VMA
START READ ;GO GET NEGATIVE DATA
[BR]_-SIGN, ;SMEAR MINUS SIGN
J/DFPR2 ;CONTINUE BELOW
DFPR1: [BR]_+SIGN ;SMEAR PLUS SIGN
DFPR2: MEM READ, 3T, ;WAIT FOR MEMORY
[ARX]_(MEM.AND.[MAG])*.5,
ASH ;SET SHIFT PATHS
[AR]_[BR]*.5 ;SHIFT AR
[AR]_[AR]*.5, ;COMPLETE SHIFTING
SC_FE ;PAGE FAIL MAY HAVE ZAPPED
; THE SC.
VMA_[PC], FETCH, ;GET NEXT INST
INST DISP ;DO THIS ONE
;CASE 12 -- TEST FOR IO LEGAL
52: SKIP IO LEGAL ;IS IO LEGAL?
=0 UUO ;NO
INST DISP ;YES--DO THE INSTRUCTION
;CASE 13 -- RESERVED
;53:
;CASE 14 -- RESERVED
;54:
;CASE 15 -- RESERVED
;55:
;CASE 16 -- RESERVED
;56:
;CASE 17 -- RESERVED
;57:
;EXTEND AR SIGN.
;CALL WITH SKIP ON AR0, RETURNS 1 ALWAYS
=0
ARSIGN: [AR]_+SIGN, RETURN [1] ;EXTEND + SIGN
[AR]_-SIGN, RETURN [1] ;EXTEND - SIGN
.TOC "THE INSTRUCTION LOOP -- STORE ANSWERS"
;NOTE: INSTRUCTIONS WHICH STORE IN BOTH AC AND MEMORY
; (E.G. ADDB, AOS) MUST STORE IN MEMORY FIRST
; SO THAT IF A PAGE FAIL HAPPENS THE AC IS
; STILL INTACT.
1500:
BWRITE: ;BASE ADDRESS OF BWRITE DISPATCH
;CASE 0 -- RESERVED
;1500:
;CASE 1 -- RESERVED
;1501:
;CASE 2 -- RESERVED
;1502:
;CASE 3 -- RESERVED
;1503:
;CASE 4 -- STORE SELF
1504:
STSELF: SKIP IF AC0, ;IS AC # ZERO?
J/STBTH1 ;GO TO STORE BOTH CASE
;CASE 5 -- STORE DOUBLE AC
1505:
DAC: AC[1]_[ARX], ;STORE AC 1
J/STAC ;GO STORE AC
;CASE 6 -- STORE DOUBLE BOTH (KA10 STYLE MEM_AR ONLY)
1506:
STDBTH: MEM WRITE, ;WAIT FOR MEMORY
MEM_[AR], ;STORE AR
J/DAC ;NOW STORE AC & AC+1
;CASE 7 -- RESERVED
;1507:
;CASE 10 -- RESERVED
;1510:
;CASE 11 -- RESERVED
;1511:
;CASE 12 -- RESERVED
;1512:
;CASE 13 -- RESERVED
;1513:
;CASE 14 -- RESERVED
1514:
FL-BWRITE: ;THE NEXT 4 CASES ARE ALSO
;USED IN FLOATING POINT
HALT [BW14]
;CASE 15 -- STORE AC
1515:
STAC: AC_[AR], ;STORE AC
NEXT INST ;DO NEXT INSTRUCTION
;CASE 16 -- STORE IN MEMORY
1516:
STMEM: MEM WRITE, ;WAIT FOR MEMORY
MEM_[AR], ;STORE AR
J/DONE ;START FETCH OF NEXT
;CASE 17 -- STORE BOTH
1517:
STBOTH: MEM WRITE, ;WAIT FOR MEMORY
MEM_[AR], ;STORE AR
J/STAC ;NOW STORE AC
=0
STBTH1: MEM WRITE, ;WAIT FOR MEMORY
MEM_[AR], ;STORE AR
J/STAC ;NOW STORE AC
STORE: MEM WRITE, ;WAIT FOR MEMORY
MEM_[AR], ;STORE AC
J/DONE ;START NEXT INST
.TOC "MOVE GROUP"
.DCODE
200: R-PF, AC, J/STAC ;MOVE
I-PF, AC, J/STAC ;MOVEI
W, M, J/MOVE ;MOVEM
RW, S, J/STSELF ;MOVES
204: R-PF, AC, J/MOVS ;MOVS
I-PF, AC, J/MOVS ;MOVSI
W, M, J/MOVS ;MOVSM
RW, S, J/MOVS ;MOVSS
210: R-PF, AC, J/MOVN ;MOVN
I-PF, AC, J/MOVN ;MOVNI
W, M, J/MOVN ;MOVNM
RW, S, J/MOVN ;MOVNS
214: R-PF, AC, J/MOVM ;MOVM
I-PF, AC, J/STAC ;MOVMI
W, M, J/MOVM ;MOVMM
RW, S, J/MOVM ;MOVNS
.UCODE
1402:
MOVS: [AR]_[AR] SWAP,EXIT
1403:
MOVM: READ [AR], SKIP DP0, J/MOVE
1404:
MOVE: EXIT
1405:
MOVN: [AR]_-[AR], ;NEGATE NUMBER
AD FLAGS, 3T, ;UPDATE FLAGS
J/MOVE ;STORE ANSWER
.TOC "EXCH"
.DCODE
250: R,W TEST, AC, J/EXCH
.UCODE
1406:
EXCH: [BR]_AC, ;COPY AC TO THE BR
START WRITE ;START A WRITE CYCLE
MEM WRITE, ;COMPLETE WRITE CYCLE
MEM_[BR], ;STORE BR (AC) IN MEMORY
J/STAC ;STORE THE AR IN AC. NOTE: AR
; WAS LOADED WITH MEMORY OPERAND
; AS PART OF INSTRUCTION DISPATCH
.TOC "HALFWORD GROUP"
; DESTINATION LEFT HALF
.DCODE
500: R-PF, AC, J/HLL
I-PF, AC, J/HLL
RW, M, J/HRR ;HLLM = HRR EXCEPT FOR STORE
RW, S, J/MOVE ;HLLS = MOVES
R-PF, AC, J/HRL
I-PF, AC, J/HRL
RW, M, J/HRLM
RW, S, J/HRLS
510: R-PF, AC, J/HLLZ
I-PF, AC, J/HLLZ
W, M, J/HLLZ
RW, S, J/HLLZ
R-PF, AC, J/HRLZ
I-PF, AC, J/HRLZ
W, M, J/HRLZ
RW, S, J/HRLZ
520: R-PF, AC, J/HLLO
I-PF, AC, J/HLLO
W, M, J/HLLO
RW, S, J/HLLO
R-PF, AC, J/HRLO
I-PF, AC, J/HRLO
W, M, J/HRLO
RW, S, J/HRLO
530: R-PF, AC, J/HLLE
I-PF, AC, J/HLLE
W, M, J/HLLE
RW, S, J/HLLE
R-PF, AC, J/HRLE
I-PF, AC, J/HRLE
W, M, J/HRLE
RW, S, J/HRLE
; DESTINATION RIGHT HALF
540: R-PF, AC, J/HRR
I-PF, AC, J/HRR
RW, M, J/HLL ;HRRM = HLL EXCEPT FOR STORE
RW, S, J/MOVE ;HRRS = MOVES
R-PF, AC, J/HLR
I-PF, AC, J/HLR
RW, M, J/HLRM
RW, S, J/HLRS
550: R-PF, AC, J/HRRZ
I-PF, AC, J/HRRZ
W, M, J/HRRZ
RW, S, J/HRRZ
R-PF, AC, J/HLRZ
I-PF, AC, J/HLRZ
W, M, J/HLRZ
RW, S, J/HLRZ
560: R-PF, AC, J/HRRO
I-PF, AC, J/HRRO
W, M, J/HRRO
RW, S, J/HRRO
R-PF, AC, J/HLRO
I-PF, AC, J/HLRO
W, M, J/HLRO
RW, S, J/HLRO
570: R-PF, AC, J/HRRE
I-PF, AC, J/HRRE
W, M, J/HRRE
RW, S, J/HRRE
R-PF, AC, J/HLRE
I-PF, AC, J/HLRE
W, M, J/HLRE
RW, S, J/HLRE
.UCODE
;FIRST THE GUYS THAT LEAVE THE OTHER HALF ALONE
;THE AR CONTAINS THE MEMORY OPERAND. SO WE WANT TO PUT THE LH OF
; AC INTO AR TO DO A HRR. OBVIOUS THING FOR HLL.
1407:
HRR: [AR]_AC,HOLD RIGHT,EXIT
1410:
HLL: [AR]_AC,HOLD LEFT,EXIT
;HRL FLOW:
;AT HRL AR CONTAINS:
;
; !------------------!------------------!
; ! LH OF (E) ! RH OF (E) !
; !------------------!------------------!
;
;AR_AR SWAP GIVES:
;
; !------------------!------------------!
; ! RH OF (E) ! LH OF (E) !
; !------------------!------------------!
;
;AT HLL, AR_AC,HOLD LEFT GIVES:
;
; !------------------!------------------!
; ! RH OF (E) ! RH OF AC !
; !------------------!------------------!
;
;THE EXIT MACRO CAUSES THE AR TO BE STORED IN AC (AT STAC).
; THE REST OF THE HALF WORD IN THIS GROUP ARE VERY SIMILAR.
1411:
HRL: [AR]_[AR] SWAP,J/HLL
1412:
HLR: [AR]_[AR] SWAP,J/HRR
1413:
HRLM: [AR]_[AR] SWAP
[AR]_AC,HOLD LEFT,J/MOVS
1414:
HRLS: [AR]_[AR] SWAP,HOLD RIGHT,EXIT
1415:
HLRM: [AR]_[AR] SWAP
[AR]_AC,HOLD RIGHT,J/MOVS
1416:
HLRS: [AR]_[AR] SWAP,HOLD LEFT,EXIT
;NOW THE HALFWORD OPS WHICH CONTROL THE "OTHER" HALF.
; ENTER WITH 0,,E (E) OR (AC) IN AR
1417:
HRRE: READ [AR],SKIP DP18
1420:
HRRZ: [AR] LEFT_0, EXIT
1421:
HRRO: [AR] LEFT_-1, EXIT
1422:
HRLE: READ [AR],SKIP DP18
1424:
HRLZ: [AR]_#,#/0,HOLD RIGHT,J/MOVS
1425:
HRLO: [AR]_#,#/777777,HOLD RIGHT,J/MOVS
1423:
HLRE: READ [AR],SKIP DP0
1426:
HLRZ: [AR]_#,#/0,HOLD LEFT,J/MOVS
1427:
HLRO: [AR]_#,#/777777,HOLD LEFT,J/MOVS
1430:
HLLE: READ [AR],SKIP DP0
1432:
HLLZ: [AR] RIGHT_0, EXIT
1433:
HLLO: [AR] RIGHT_-1, EXIT
.TOC "DMOVE, DMOVN, DMOVEM, DMOVNM"
.DCODE
120: DBL R, DAC, J/DAC
DBL R, AC, J/DMOVN
.UCODE
1434:
DMOVN: CLEAR ARX0, CALL [DBLNGA]
1436: AC[1]_[ARX], J/STAC
.DCODE
124: DBL AC, J/DMOVN1
W, J/DMOVNM
.UCODE
1565:
DMOVNM: [ARX]_AC[1],CALL [DBLNEG]
1567:
DMOVN1: [HR]+[ONE], ;GET E+1
LOAD VMA, ;PUT THAT IN VMA
START WRITE, ;STORE IN E+1
PXCT DATA ;DATA CYCLE
MEM WRITE, MEM_[ARX] ;STORE LOW WORD
VMA_[HR], ;GET E
LOAD VMA, ;SAVE IN VMA
PXCT DATA, ;OPERAND STORE
START WRITE, ;START MEM CYCLE
J/STORE ;GO STORE AR
.TOC "BOOLEAN GROUP"
.DCODE
400: I-PF, AC, J/SETZ
I-PF, AC, J/SETZ
IW, M, J/SETZ
IW, B, J/SETZ
.UCODE
1441:
SETZ: [AR]_0, EXIT
.DCODE
404: R-PF, AC, J/AND
I-PF, AC, J/AND
RW, M, J/AND
RW, B, J/AND
.UCODE
1442:
AND: [AR]_[AR].AND.AC,EXIT
.DCODE
410: R-PF, AC, J/ANDCA
I-PF, AC, J/ANDCA
RW, M, J/ANDCA
RW, B, J/ANDCA
.UCODE
1443:
ANDCA: [AR]_[AR].AND.NOT.AC,EXIT
.DCODE
414: R-PF, AC, J/MOVE ;SETM = MOVE
I-PF, AC, J/MOVE
RW, M, J/MOVE ;SETMM = NOP THAT WRITES MEMORY
RW, B, J/MOVE ;SETMB = MOVE THAT WRITES MEMORY
420: R-PF, AC, J/ANDCM
I-PF, AC, J/ANDCM
RW, M, J/ANDCM
RW, B, J/ANDCM
.UCODE
1444:
ANDCM: [AR]_.NOT.[AR],J/AND
.DCODE
424: R, J/DONE
I, J/DONE
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
RW, M, J/XOR
RW, B, J/XOR
.UCODE
1445:
XOR: [AR]_[AR].XOR.AC,EXIT
.DCODE
434: R-PF, AC, J/IOR
I-PF, AC, J/IOR
RW, M, J/IOR
RW, B, J/IOR
.UCODE
1446:
IOR: [AR]_[AR].OR.AC,EXIT
.DCODE
440: R-PF, AC, J/ANDCB
I-PF, AC, J/ANDCB
RW, M, J/ANDCB
RW, B, J/ANDCB
.UCODE
1447:
ANDCB: [AR]_.NOT.[AR],J/ANDCA
.DCODE
444: R-PF, AC, J/EQV
I-PF, AC, J/EQV
RW, M, J/EQV
RW, B, J/EQV
.UCODE
1450:
EQV: [AR]_[AR].EQV.AC,EXIT
.DCODE
450: I-PF, AC, J/SETCA
I-PF, AC, J/SETCA
IW, M, J/SETCA
IW, B, J/SETCA
.UCODE
1451:
SETCA: [AR]_.NOT.AC,EXIT
.DCODE
454: R-PF, AC, J/ORCA
I-PF, AC, J/ORCA
RW, M, J/ORCA
RW, B, J/ORCA
.UCODE
1452:
ORCA: [BR]_.NOT.AC
[AR]_[AR].OR.[BR],EXIT
.DCODE
460: R-PF, AC, J/SETCM
I-PF, AC, J/SETCM
RW, M, J/SETCM
RW, B, J/SETCM
.UCODE
1453:
SETCM: [AR]_.NOT.[AR],EXIT
.DCODE
464: R-PF, AC, J/ORCM
I-PF, AC, J/ORCM
RW, M, J/ORCM
RW, B, J/ORCM
.UCODE
1454:
ORCM: [AR]_.NOT.[AR],J/IOR
.DCODE
470: R-PF, AC, J/ORCB
I-PF, AC, J/ORCB
RW, M, J/ORCB
RW, B, J/ORCB
.UCODE
1455:
ORCB: [AR]_[AR].AND.AC,J/SETCM
.DCODE
474: I-PF, AC, J/SETO
I-PF, AC, J/SETO
IW, M, J/SETO
IW, B, J/SETO
.UCODE
1456:
SETO: [AR]_-[ONE], EXIT
.TOC "ROTATES AND LOGICAL SHIFTS -- ROT, LSH, JFFO"
.DCODE
240: SH, J/ASH
SH, J/ROT
SH, J/LSH
I, J/JFFO
I-PF, J/ASHC
245: SHC, J/ROTC
SHC, J/LSHC
.UCODE
;HERE IS THE CODE FOR LOGICAL SHIFT. THE EFFECTIVE ADDRESS IS
; IN AR.
1612:
LSH: [AR]_AC, ;PICK UP AC
FE_-FE-1, ;NEGATIVE SHIFT
J/LSHL ;SHIFT LEFT
1613: [AR]_AC.AND.MASK, ;MAKE IT LOOK POSITIVE
FE_FE+1, ;UNDO -1 AT SHIFT
J/ASHR ;GO SHIFT RIGHT
LSHL: [AR]_[AR]*2, ;SHIFT LEFT
SHIFT, J/STAC ;FAST SHIFT & GO STORE AC
;HERE IS THE CODE FOR ARITHMETIC SHIFT. THE EFFECTIVE ADDRESS IS
; IN AR.
ASH36 LEFT "[AR]_[AR]*2 LONG, ASHC, STEP SC, ASH AROV"
1622:
ASH: Q_0, J/ASHL0 ;HARDWARE ONLY DOES ASHC
1623: [AR]_AC, ;GET THE ARGUMENT
FE_FE+1 ;FE HAS NEGATIVE SHIFT COUNT
ASHR: [AR]_[AR]*.5, ;SHIFT RIGHT
ASH, SHIFT, ;FAST SHIFT
J/STAC ;STORE AC WHEN DONE
ASHL0: [AR]_AC*.5, ;GET INTO 9 CHIPS
STEP SC ;SEE IF NULL SHIFT
=0
ASHL: ASH36 LEFT, J/ASHL ;SHIFT LEFT
;SLOW BECAUSE WE HAVE TO
; TEST FOR OVERFLOW
ASHX: [AR]_[AR]*2, J/STAC ;SHIFT BACK INTO 10 CHIPS
;HERE IS THE CODE FOR ROTATE. THE EFFECTIVE ADDRESS IS
; IN AR.
1632:
ROT: [AR]_AC*.5, ;PICK UP THE AC (& SHIFT)
FE_-FE-1, ;NEGATIVE SHIFT COUNT
J/ROTL ;ROTATE LEFT
1633: [AR]_AC*.5, ;PICK UP THE AC (& SHIFT)
FE_FE+1 ;NEGATIVE SHIFT COUNT
[AR]_[AR]*.5 ;PUT IN 9 DIPS
[AR]_[AR]*.5, ;SHIFT RIGHT
ROT, SHIFT ;FAST SHIFT
ASHXX: [AR]_[AR]*2,J/ASHX ;SHIFT TO STD PLACE
ROTL: [AR]_[AR]*.5 ;PUT IN RIGHT 36-BITS
[AR]_[AR]*2, ;ROTATE LEFT
ROT, SHIFT, ;FAST SHIFT
J/ASHXX ;ALL DONE--SHIFT BACK
1462:
JFFO: [BR]_AC.AND.MASK, 4T, ;GET AC WITH NO SIGN
SKIP AD.EQ.0 ; EXTENSION. SKIP IF
; ZERO.
=0 [PC]_[AR], ;NOT ZERO--JUMP
LOAD VMA, FETCH, ;GET NEXT INST
J/JFFO1 ;ENTER LOOP
AC[1]_0, J/DONE ;ZERO--DONE
JFFO1: FE_-12. ;WHY -12.? WELL THE
; HARDWARE LOOKS AT
; BIT -2 SO THE FIRST
; 2 STEPS MOVE THE BR
; OVER. WE ALSO LOOK AT
; THE DATA BEFORE THE SHIFT
; SO WE END UP GOING 1 PLACE
; TOO MANY. THAT MEANS THE
; FE SHOULD START AT -3.
; HOWEVER, WE COUNT THE FE BY
; 4 (BECAUSE THE 2 LOW ORDER
; BITS DO NOT COME BACK) SO
; FE_-12.
=0
JFFOL: [BR]_[BR]*2, ;SHIFT LEFT
FE_FE+4, ;COUNT UP BIT NUMBER
SKIP DP0, J/JFFOL ;LOOP TILL WE FIND THE BIT
[AR]_FE ;GET ANSWER BACK
[AR]_[AR].AND.# CLR LH,#/77 ;MASK TO 1 COPY
AC[1]_[AR], NEXT INST ;STORE AND EXIT
.TOC "ROTATES AND LOGICAL SHIFTS -- LSHC"
;SHIFT CONNECTIONS WHEN THE SPECIAL FUNCTION "LSHC" IS DONE:
;
; !-! !----!------------------------------------!
; !0!-->!0000! HIGH ORDER 36 BITS ! RAM FILE
; !-! !----!------------------------------------!
; ^
; :
; ....................................
; :
; !----!------------------------------------!
; !0000! LOW ORDER 36 BITS ! Q-REGISTER
; !----!------------------------------------!
; ^
; :
; !-!
; !0!
; !-!
;
1464:
LSHC: STEP SC, J/LSHCL
1465: READ [AR], SC_-SHIFT-1
STEP SC
=0
LSHCR: [BR]_[BR]*.5 LONG,STEP SC,LSHC,J/LSHCR
[BR]_[BR]*2 LONG,J/LSHCX
=0
LSHCL: [BR]_[BR]*2 LONG,LSHC,STEP SC,J/LSHCL
[BR]_[BR]*2 LONG
LSHCX: [BR]_[BR]*2 LONG
AC_[BR], J/ASHCQ1
.TOC "ROTATES AND LOGICAL SHIFTS -- ASHC"
1466:
ASHC: READ [AR], ;PUT AR ON DP
SC_SHIFT, LOAD FE, ;PUT SHIFT IN BOTH SC AND FE
SKIP ADR.EQ.0 ;SEE IF NULL SHIFT
=0 Q_AC[1], ;NOT NULL--GET LOW WORD
J/ASHC1 ;CONTINUE BELOW
NIDISP: NEXT INST ;NULL--ALL DONE
ASHC1: [BR]_AC*.5 LONG, ;GET HIGH WORD
;AND SHIFT Q
SKIP/SC ;SEE WHICH DIRECTION
=0 [BR]_[BR]*.5, ;ADJUST POSITION
SC_FE+S#, S#/1776, ;SUBRTACT 2 FROM FE
J/ASHCL ;GO LEFT
[BR]_[BR]*.5, ;ADJUST POSITION
SC_S#-FE, S#/1776 ;SC_-2-FE, SC_+# OF STEPS
=0 ;HERE TO GO RIGHT
ASHCR: [BR]_[BR]*.5 LONG, ;GO RIGHT
ASHC, ;SET DATA PATHS FOR ASHC (SEE DPE1)
STEP SC, J/ASHCR ;COUNT THE STEP AND KEEP LOOPING
[BR]_[BR]*2 LONG, ;PUT BACK WHERE IT GOES
ASHC, J/ASHCX ;COMPLETE INSTRUCTION
=0
ASHCL: [BR]_[BR]*2 LONG, ;GO LEFT
ASHC, ASH AROV, ;SEE IF OVERFLOW
STEP SC, J/ASHCL ;LOOP OVER ALL PLACES
[BR]_[BR]*2 LONG, ;SHIFT BACK WHERE IT GOES
ASHC, ASH AROV ;CAN STILL OVERFLOW
ASHCX: AC_[BR]+[BR], 3T, ;PUT BACK HIGH WORD
SKIP DP0 ;SEE HOW TO FIX LOW SIGN
=0 Q_Q.AND.#, #/377777, ;POSITIVE, CLEAR LOW SIGN
HOLD RIGHT, J/ASHCQ1 ;GO STORE ANSWER
Q_Q.OR.#, #/400000, ;NEGATIVE, SET LOW SIGN
HOLD RIGHT ;IN LEFT HALF
ASHCQ1: AC[1]_Q, NEXT INST ;PUT BACK Q AND EXIT
.TOC "ROTATES AND LOGICAL SHIFTS -- ROTC"
;SHIFT CONNECTIONS WHEN THE SPECIAL FUNCTION "ROTC" IS DONE:
;
; !----!------------------------------------!
; .....>!0000! HIGH ORDER 36 BITS ! RAM FILE
; : !----!------------------------------------!
; : ^
; : :
; : ............................................
; : :
; : : !----!------------------------------------!
; : ..!0000! LOW ORDER 36 BITS ! Q-REGISTER
; : !----!------------------------------------!
; : ^
; : :
; :..............................................:
;
1470:
ROTC: STEP SC, J/ROTCL
1471: READ [AR], SC_-SHIFT-1
STEP SC
=0
ROTCR: [BR]_[BR]*.5 LONG,STEP SC,ROTC,J/ROTCR
[BR]_[BR]*2 LONG,J/LSHCX
=0
ROTCL: [BR]_[BR]*2 LONG,ROTC,STEP SC,J/ROTCL
[BR]_[BR]*2 LONG,
J/LSHCX
.TOC "TEST GROUP"
.DCODE
;SPECIAL MACROS USED ONLY IN B-FIELD OF TEST INSTRUCTIONS
TN- "B/4"
TNE "B/0"
WORD-TNE "B/10" ;USED IN TIOE
TNA "B/0"
TNN "B/4"
WORD-TNN "B/14" ;USED IN TION
TZ- "B/5"
TZE "B/1"
TZA "B/1"
TZN "B/5"
TC- "B/6"
TCE "B/2"
TCA "B/2"
TCN "B/6"
TO- "B/7"
TOE "B/3"
TOA "B/3"
TON "B/7"
600: I, J/DONE ;TRN- IS NOP
I, J/DONE ;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, J/DONE ;TDN- IS A NOP
I, J/DONE ;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 2 AND 3 AS FOLLOWS:
; 0 0 NO MODIFICATION
; 0 1 0S
; 1 0 COMPLEMENT
; 1 1 ONES
; THIS ORDER HAS NO SIGNIFICANCE EXCEPT THAT IT CORRESPONDS TO THE
; ORDER OF INSTRUCTIONS AT TGROUP.
;THE BIT 1 OF THE B FIELD IS USED TO DETERMINE THE SENSE
; OF THE SKIP
; 1 SKIP IF AC.AND.MASK .NE. 0 (TXX- AND TXXN)
; 0 SKIP IF AC.AND.MASK .EQ. 0 (TXXA AND TXXE)
;BIT 0 IS UNUSED AND MUST BE ZERO
1472:
TSX: [AR]_[AR] SWAP ;TSXX AND TLXX
1473:
TDX: [BR]_0,TEST DISP ; ALWAYS AND NEVER SKIP CASES
1474:
TSXX: [AR]_[AR] SWAP ;TSXE, TSXN, TLXE, TLXN
1475:
TDXX: [BR]_[AR].AND.AC, ;TDXE, TDXN, TRXE, TRXN
TEST DISP
;TEST DISP DOES AN 8 WAY BRANCH BASED ON THE B-FIELD OF DROM
=1100
TEST-TABLE:
;CASE 0 & 4 -- TXNX
TXXX: READ [BR], TXXX TEST, 3T, J/DONE
;CASE 1 & 5 -- TXZ AND TXZX
[AR]_.NOT.[AR],J/TXZX
;CASE 2 & 6 -- TXC AND TXCX
[AR]_[AR].XOR.AC,J/TDONE
;CASE 3 & 7 -- TXO AND TXOX
[AR]_[AR].OR.AC,J/TDONE
;THE SPECIAL FUNCTION TXXX TEST CAUSES A MICROCODE SKIP IF
; AD.EQ.0 AND DROM B IS 0-3 OR AD.NE.0 AND DROM B IS 4-7.
TXZX: [AR]_[AR].AND.AC
TDONE: AC_[AR],J/TXXX
; READ BR,TXXX TEST,J/DONE
.TOC "COMPARE -- CAI, CAM"
.DCODE
;SPECIAL B-FIELD ENCODING USED BY SKIP-JUMP-COMPARE CLASS
; INSTRUCTIONS:
SJC- "B/0" ;NEVER
SJCL "B/1" ;LESS
SJCE "B/2" ;EQUAL
SJCLE "B/3" ;LESS EQUAL
SJCA "B/4" ;ALWAYS
SJCGE "B/5" ;GREATER THAN OR EQUAL
SJCN "B/6" ;NOT EQUAL
SJCG "B/7" ;GREATER
.UCODE
;COMPARE TABLE
=1000
SKIP-COMP-TABLE:
;CASE 0 -- NEVER
DONE
;CASE 1 -- LESS
READ [AR], SKIP DP0,J/DONE
;CASE 2 -- EQUAL
SKIPE: READ [AR], SKIP AD.EQ.0,J/DONE
;CASE 3 -- LESS OR EQUAL
READ [AR], SKIP AD.LE.0,J/DONE
;CASE 4 -- ALWAYS
VMA_[PC]+1, NEXT INST FETCH, FETCH
;CASE 5 -- GREATER THAN OR EQUAL
READ [AR], SKIP DP0,J/SKIP
;CASE 6 -- NOT EQUAL
READ [AR], SKIP AD.EQ.0,J/SKIP
;CASE 7 -- GREATER
READ [AR], SKIP AD.LE.0,J/SKIP
.DCODE
300: I, SJC-, J/DONE ;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
1476:
CAIM: [AR]_AC-[AR], 3T, SKIP-COMP DISP
.TOC "ARITHMETIC SKIPS -- AOS, SOS, SKIP"
;ENTER WITH (E) IN AR
.DCODE
330: R, SJC-, J/SKIPS ;NOT A NOP IF AC .NE. 0
R, SJCL, J/SKIPS
R, SJCE, J/SKIPS
R, SJCLE, J/SKIPS
R, SJCA, J/SKIPS
R, SJCGE, J/SKIPS
R, SJCN, J/SKIPS
R, SJCG, J/SKIPS
.UCODE
1477:
SKIPS: FIX [AR] SIGN,
SKIP IF AC0
=0 AC_[AR],SKIP-COMP DISP
SKIP-COMP DISP
.DCODE
350: RW, SJC-, J/AOS
RW, SJCL, J/AOS
RW, SJCE, J/AOS
RW, SJCLE, J/AOS
RW, SJCA, J/AOS
RW, SJCGE, J/AOS
RW, SJCN, J/AOS
RW, SJCG, J/AOS
.UCODE
1431:
AOS: [AR]_[AR]+1, 3T, AD FLAGS
XOS: START WRITE
MEM WRITE,MEM_[AR],J/SKIPS
.DCODE
370: RW, SJC-, J/SOS
RW, SJCL, J/SOS
RW, SJCE, J/SOS
RW, SJCLE, J/SOS
RW, SJCA, J/SOS
RW, SJCGE, J/SOS
RW, SJCN, J/SOS
RW, SJCG, J/SOS
.UCODE
1437:
SOS: [AR]_[AR]-1, 3T, AD FLAGS, J/XOS
.TOC "CONDITIONAL JUMPS -- JUMP, AOJ, SOJ, AOBJ"
; ENTER WITH E IN AR
=1000
JUMP-TABLE:
;CASE 0 -- NEVER
AC_[BR], NEXT INST
;CASE 1 -- LESS
AC_[BR] TEST, SKIP DP0, J/JUMP-
;CASE 2 -- EQUAL
AC_[BR] TEST, SKIP AD.EQ.0, J/JUMP-
;CASE 3 -- LESS THAN OR EQUAL
AC_[BR] TEST, SKIP AD.LE.0, J/JUMP-
;CASE 4 -- ALWAYS
JMPA: AC_[BR], J/JUMPA
;CASE 5 -- GREATER THAN OR EQUAL TO
AC_[BR] TEST, SKIP DP0, J/JUMPA
;CASE 6 -- NOT EQUAL
AC_[BR] TEST, SKIP AD.EQ.0, J/JUMPA
;CASE 7 -- GREATER
AC_[BR] TEST, SKIP AD.LE.0, J/JUMPA
=0
JUMP-: DONE
JUMPA
=0
JUMPA: JUMPA
DONE
.DCODE
320: I, SJC-, J/DONE
I, SJCL, J/JUMP
I, SJCE, J/JUMP
I, SJCLE, J/JUMP
I, SJCA, J/JRST
I, SJCGE, J/JUMP
I, SJCN, J/JUMP
I, SJCG, J/JUMP
.UCODE
1440:
JUMP: [BR]_AC,JUMP DISP
.DCODE
340: I-PF, 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
1611:
AOJ: [BR]_AC+1, AD FLAGS, 4T, JUMP DISP
.DCODE
360: I-PF, 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
1542:
SOJ: [BR]_AC-1, AD FLAGS, 4T, JUMP DISP
.DCODE
252: I, SJCGE, J/AOBJ
I, SJCL, J/AOBJ
.UCODE
1547:
AOBJ: [BR]_AC+1000001, ;ADD 1 TO BOTH HALF WORDS
INH CRY18, 3T, ;NO CARRY INTO LEFT HALF
JUMP DISP ;HANDLE EITHER AOBJP OR AOBJN
.TOC "AC DECODE JUMPS -- JRST, JFCL"
.DCODE
254: I,VMA/0, AC DISP, J/JRST ;DISPATCHES TO 1 OF 16
; PLACES ON AC BITS
I, J/JFCL
.UCODE
;JRST DISPATCHES TO ONE OF 16 LOC'NS ON AC BITS
=0000
1520:
JRST: JUMPA ;(0) JRST 0,
1521: JUMPA ;(1) PORTAL IS SAME AS JRST
1522: VMA_[PC]-1, START READ, ;(2) JRSTF
J/JRSTF
1523: UUO ;(3)
1524: SKIP KERNEL, J/HALT ;(4) HALT
1525:
XJRSTF0: VMA_[AR], START READ, ;(5) XJRSTF
J/XJRSTF
1526: SKIP KERNEL, J/XJEN ;(6) XJEN
1527: SKIP KERNEL, J/XPCW ;(7) XPCW
1530: VMA_[PC]-1, START READ, ;(10)
SKIP IO LEGAL, J/JRST10
1531: UUO ;(11)
1532: VMA_[PC]-1, START READ, ;(12) JEN
SKIP IO LEGAL, J/JEN
1533: UUO ;(13)
1534: SKIP KERNEL, J/SFM ;(14) SFM
1535: UUO ;(15)
1536: UUO ;(16)
1537: UUO ;(17)
=0*
JRSTF: MEM READ, ;WAIT FOR DATA
[HR]_MEM, ;STICK IN HR
LOAD INST EA, ;LOAD @ AND XR
CALL [JRST0] ;COMPUTE EA AGAIN
JUMPA ;JUMP
JRST0: EA MODE DISP ;WHAT TYPE OF EA?
=100*
READ XR, ;INDEXED
LOAD FLAGS, ;GET FLAGS FROM XR
UPDATE USER, ;ALLOW USER TO SET
RETURN [2] ;ALL DONE
READ [HR], ;PLAIN
LOAD FLAGS, ;LOAD FLAGS FROM INST
UPDATE USER, ;ALLOW USER TO SET
RETURN [2] ;RETURN
[HR]_[HR]+XR, ;BOTH
LOAD VMA, ;FETCH IND WORD
START READ, ;START MEM CYCLE
J/JRST1 ;CONTINUE BELOW
VMA_[HR], ;INDIRECT
START READ, ;FETCH IND WORD
PXCT EA, ;SETUP PXCT STUFF
J/JRST1 ;CONTINUE BELOW
JRST1: MEM READ, ;WAIT FOR DATA
[HR]_MEM, ;LOAD THE HR
LOAD INST EA, ;LOAD @ AND XR
J/JRST0 ;LOOP BACK
=0
HALT: UUO ;USER MODE
[PC]_[AR] ;EXEC MODE--CHANGE PC
HALT [HALT] ;HALT INSTRUCTION
=0
JRST10: UUO
J/JEN2 ;DISMISS INTERRUPT
=0000
JEN: UUO ; FLAGS
MEM READ,
[HR]_MEM, ;GET INST
LOAD INST EA, ;LOAD XR & @
CALL [JRST0] ;COMPUTE FLAGS
=0011
JEN2: DISMISS ;DISMISS INTERRUPT
=0111 CALL LOAD PI ;RELOAD PI HARDWARE
=1111 JUMPA ;GO JUMP
=
1540:
JFCL: JFCL FLAGS, ;ALL DONE IN HARDWARE
SKIP JFCL, ;SEE IF SKIPS
3T, ;ALLOW TIME
J/JUMP- ;JUMP IF WE SHOULD
.TOC "EXTENDED ADDRESSING INSTRUCTIONS"
=0000
XJEN: UUO ;HERE IF USER MODE
DISMISS ;CLEAR HIGHEST INTERRUPT
=0101 READ [MASK], LOAD PI ;NO MORE INTERRUPTS
=1101 ABORT MEM CYCLE, ;AVOID INTERRUPT PAGE FAIL
J/XJRSTF0 ;START READING FLAG WORD
=
XJRSTF: MEM READ, [BR]_MEM ;PUT FLAGS IN BR
[AR]_[AR]+1, ;INCREMENT ADDRESS
LOAD VMA, ;PUT RESULT IN VMA
START READ ;START MEMORY
MEM READ, [PC]_MEM, ;PUT DATA IN PC
HOLD LEFT ;IGNORE SECTION NUMBER
READ [BR], LOAD FLAGS, ;LOAD NEW FLAGS
UPDATE USER ;BUT HOLD USER FLAG
PISET: [FLG]_[FLG].AND.NOT.#, ;CLEAR PI CYCLE
FLG.PI/1, J/PIEXIT ;RELOAD PI HARDWARE
; INCASE THIS IS AN
; INTERRUPT INSTRUCTION
=0
XPCW: UUO ;USER MODE
[BR]_FLAGS ;PUT FLAGS IN BR
=0*0
PIXPCW: VMA_[AR], START WRITE, ;STORE FLAGS
CALL [STOBR] ;PUT BR IN MEMORY
=1*0 VMA_[AR]+1, LOAD VMA,
START WRITE, ;PREPEARE TO STORE PC
CALL [STOPC] ;PUT PC IN MEMORY
=1*1 [AR]_[AR]+1, ;DO NEW PC PART
START READ, J/XJRSTF
=
=0
SFM: UUO
VMA_[AR], START WRITE ;STORE FLAGS
[AR]_FLAGS, J/STORE ;STORE AND EXIT
.TOC "XCT"
.DCODE
256: R, J/XCT ;OPERAND FETCHED AS DATA
.UCODE
1541:
XCT: SKIP KERNEL ;SEE IF MAY BE PXCT
=0
XCT1A: [HR]_[AR], ;STUFF INTO HR
DBUS/DP, ;PLACE ON DBUS FOR IR
LOAD INST, ;LOAD IR, AC, XR, ETC.
PXCT/E1, ;ALLOW XR TO BE PREVIOUS
J/XCT1 ;CONTINUE BELOW
READ [HR], ;LOAD PXCT FLAGS
LOAD PXCT, ; ..
J/XCT1A ;CONTINUE WITH NORMAL FLOW
XCT1: WORK[YSAVE]_[HR] CLR LH,;SAVE FOR IO INSTRUCTIONS
J/XCT2 ;GO EXECUTE IT
.TOC "STACK INSTRUCTIONS -- PUSHJ, PUSH, POP, POPJ"
.DCODE
260: I, B/0, J/PUSHJ
IR, B/2, J/PUSH
I, B/2, J/POP
I, J/POPJ
.UCODE
;ALL START WITH E IN AR
1543:
PUSH: MEM READ, ;PUT MEMOP IN BR
[BR]_MEM ; ..
PUSH1: [ARX]_AC+1000001, ;BUMP BOTH HALVES OF AC
INH CRY18, ;NO CARRY
LOAD VMA, ;START TO STORE ITEM
START WRITE, ;START MEM CYCLE
PXCT STACK WORD, ;THIS IS THE STACK DATA WORD
3T, ;ALLOW TIME
SKIP CRY0, ;GO TO STMAC, SKIP IF PDL OV
J/STMAC ; ..
1544:
PUSHJ: [BR]_PC WITH FLAGS, ;COMPUTE UPDATED FLAGS
CLR FPD, ;CLEAR FIRST-PART-DONE
J/PUSH1 ; AND JOIN PUSH CODE
=0
STMAC: MEM WRITE, ;WAIT FOR MEMORY
MEM_[BR], ;STORE BR ON STACK
B DISP, ;SEE IF PUSH OR PUSHJ
J/JSTAC ;BELOW
;WE MUST STORE THE STACK WORD PRIOR TO SETTING PDL OV IN CASE OF
; PAGE FAIL.
MEM WRITE, ;WAIT FOR MEMORY
MEM_[BR] ;STORE BR
SETPDL: SET PDL OV, ;OVERFLOW
B DISP, ;SEE IF PUSH OR PUSHJ
J/JSTAC ;BELOW
=00
JSTAC: [PC]_[AR], ;PUSHJ--LOAD PC
LOAD VMA, ;LOAD ADDRESS
FETCH ;GET NEXT INST
JSTAC1: AC_[ARX], ;STORE BACK STACK PTR
NEXT INST ;DO NEXT INST
AC_[ARX], ;UPDATE STACK POINTER
J/DONE ;DO NEXT INST
=
1545:
POP: [ARX]_AC, ;GET POINTER
LOAD VMA, ;ADDRESS OF STACK WORD
START READ, 3T, ;START CYCLE
PXCT STACK WORD ;FOR PXCT
MEM READ, ;LOAD BR (QUIT IF PAGE FAIL)
[BR]_MEM ;STACK WORD TO BR
[ARX]_[ARX]+#, ;UPDATE POINTER
#/777777, ;-1 IN EACH HALF
INH CRY18, 3T, ;BUT NO CARRY
SKIP CRY0 ;SEE IF OVERFLOW
=0 VMA_[AR], ;EFFECTIVE ADDRESS
PXCT DATA, ;FOR PXCT
START WRITE, ;WHERE TO STORE RESULT
J/POPX1 ;OVERFLOW
VMA_[AR], ;EFFECTIVE ADDRESS
PXCT DATA, ;FOR PXCT
START WRITE ;WHERE TO STORE RESULT
MEM WRITE, ;WAIT FOR MEM
MEM_[BR], ;STORE BR
B DISP, ;POP OR POPJ?
J/JSTAC ;STORE POINTER
POPX1: MEM WRITE, ;WAIT FOR MEMORY
MEM_[BR], ;STORE BR
J/SETPDL ;GO SET PDL OV
1546:
POPJ: [ARX]_AC, ;GET POINTER
LOAD VMA, ;POINT TO STACK WORD
PXCT STACK WORD, 3T, ;FOR PXCT
START READ ;START READ
[ARX]_[ARX]+#, ;UPDATE POINTER
#/777777, ;-1 IN BOTH HALFS
INH CRY18, 3T, ;INHIBIT CARRY 18
SKIP CRY0 ;SEE IF OVERFLOW
=0 SET PDL OV ;SET OVERFLOW
MEM READ, [PC]_MEM, ;STICK DATA IN PC
HOLD LEFT, ;NO FLAGS
J/JSTAC1 ;STORE POINTER
.TOC "STACK INSTRUCTIONS -- ADJSP"
.DCODE
105: I-PF, B/0, J/ADJSP
.UCODE
1551:
ADJSP: [AR]_[AR] SWAP, ;MAKE 2 COPIES OF RH
HOLD RIGHT
[BR]_AC, ;READ AC, SEE IF MINUS
3T,
SKIP DP0
=0 AC_[BR]+[AR], ;UPDATE AC
INH CRY18, ;NO CARRY
SKIP DP0, ;SEE IF STILL OK
3T, ;ALLOW TIME
J/ADJSP1 ;TEST FOR OFLO
AC_[BR]+[AR], ;UPDATE AC
INH CRY18, ;NO CARRY
SKIP DP0, ;SEE IF STILL MINUS
3T, ;ALLOW TIME FOR SKIP
J/ADJSP2 ;CONTINUE BELOW
=0
ADJSP1: NEXT INST ;NO OVERFLOW
SET PDL OV, ;SET PDL OV
J/NIDISP ;GO DO NICOND DISP
=0
ADJSP2: SET PDL OV, ;SET PDL OV
J/NIDISP ;GO DO NICOND DISP
NEXT INST ;NO OVERFLOW
.TOC "SUBROUTINE CALL/RETURN -- JSR, JSP, JSA, JRA"
.DCODE
264: I, J/JSR
I, J/JSP
I, J/JSA
I, J/JRA
.UCODE
1550:
JSP: [BR]_PC WITH FLAGS ;GET PC WITH FLAGS
CLR FPD, ;CLEAR FIRST-PART-DONE
AC_[BR], ;STORE FLAGS
J/JUMPA ;GO JUMP
1552:
JSR: [BR]_PC WITH FLAGS, ;GET PC WITH FLAGS
CLR FPD ;CLEAR FIRST-PART-DONE
VMA_[AR], ;EFFECTIVE ADDRESS
START WRITE ;STORE OLD PC WORD
MEM WRITE, ;WAIT FOR MEMORY
MEM_[BR] ;STORE
[PC]_[AR]+1000001, ;PC _ E+1
HOLD LEFT, ;NO JUNK IN LEFT
3T, ;ALLOW TIME FOR DBM
J/DONE ;[127] START AT E+1
;[127] MUST NICOND TO CLEAR TRAP CYCLE
1554:
JSA: [BR]_[AR], ;SAVE E
START WRITE ;START TO STORE
[ARX]_[AR] SWAP ;ARX LEFT _ E
=0*0 [AR]_AC, ;GET OLD AC
CALL [IBPX] ;SAVE AR IN MEMORY
=1*0 [ARX]_[PC], ;ARX NOW HAS E,,PC
HOLD LEFT, ; ..
CALL [AC_ARX] ;GO PUT ARX IN AC
=1*1 [PC]_[BR]+1000001, ;NEW PC
3T, ;ALLOW TIME
HOLD LEFT, ;NO JUNK IN PC LEFT
J/DONE ;[127] START AT E+1
;[127] NICOND MUST CLEAR TRAP CYCLE
=
1555:
JRA: [BR]_AC ;GET AC
[BR]_[BR] SWAP ;OLD E IN BR RIGHT
VMA_[BR], ;LOAD VMA
START READ ;FETCH SAVED AC
MEM READ, ;WAIT FOR MEMORY
[BR]_MEM, ;LOAD BR WITH SAVE AC
J/JMPA ;GO JUMP
.TOC "ILLEGAL INSTRUCTIONS AND UUO'S"
;LUUO'S TRAP TO CURRENT CONTEXT
.DCODE
030: I, B/0, J/LUUO
I, B/1, J/LUUO
I, B/2, J/LUUO
I, B/3, J/LUUO
I, B/4, J/LUUO
I, B/5, J/LUUO
I, B/6, J/LUUO
I, B/7, 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
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
I, J/MUUO ;CLOSE
I, J/MUUO ;RELEAS
I, J/MUUO ;MTAPE
I, J/MUUO ;UGETF
I, J/MUUO ;USETI
I, J/MUUO ;USETO
I, J/MUUO ;LOOKUP
I, J/MUUO ;ENTER
;EXPANSION OPCODES
100: I, J/UUO ;UJEN
I, J/UUO101
I, J/UUO102 ;GFAD
I, J/UUO103 ;GFSB
;RESERVED OPCODES
000: I, J/UUO
104: I, J/JSYS ;JSYS
106: I, J/UUO106 ;GFMP
I, J/UUO107 ;GFDV
130: I, B/0, J/FP-LONG ;UFA
I, B/1, J/FP-LONG ;DFN
141: I, B/2, J/FP-LONG ;FADL
151: I, B/3, J/FP-LONG ;FSBL
161: I, B/4, J/FP-LONG ;FMPL
171: I, B/5, J/FP-LONG ;FDVL
247: I, J/UUO247 ;RESERVED
.UCODE
1661:
UUO101: UUO
1662:
UUO102: UUO
1663:
UUO103: UUO
1664:
JSYS: UUO
1666:
UUO106: UUO
1667:
UUO107: UUO
1660:
FP-LONG:UUO
1665:
UUO247: UUO
;HERE FOR UUO'S WHICH TRAP TO EXEC
1556:
UUO: ;THIS TAG IS USED FOR ILLEGAL THINGS WHICH DO UUO TRAPS
MUUO: ;THIS TAG IS USED FOR MONITOR CALL INSTRUCTIONS
[HR]_[HR].AND.#, ;MASK OUT @ AND XR
#/777740, ;MASK
HOLD RIGHT ;KEEP RIGHT
;THE UUO MACRO DOES THE ABOVE INSTRUCTION AND GOES TO UUOGO
UUOGO: [ARX]_0 XWD [424] ;HERE FROM UUO MACRO
;GET OFFSET TO UPT
=0 [ARX]_[ARX]+[UBR], ;ADDRESS OF MUUO WORD
CALL [ABORT] ;STOP MEMORY
.IF/KIPAGE
.IF/KLPAGE
READ [EBR], ;IF BOTH POSSIBLE, SEE WHICH IS ENABLED
SKIP DP0 ;KL PAGING ??
=0
.ENDIF/KLPAGE
READ [ARX], ;GET THE ADDRESS
LOAD VMA, ;START WRITE
VMA PHYSICAL WRITE, ;ABSOLUTE ADDRESS
J/KIMUUO ;GO STORE KI STYLE
.ENDIF/KIPAGE
.IF/KLPAGE
[AR]_[HR] SWAP ;PUT IN RIGHT HALF
=0 [AR]_FLAGS, ;FLAGS IN LEFT HALF
HOLD RIGHT, ;JUST WANT FLAGS
CALL [UUOFLG] ;CLEAR TRAP FLAGS
READ [ARX], ;LOOK AT ADDRESS
LOAD VMA, ;LOAD THE VMA
VMA PHYSICAL WRITE ;STORE FLAG WORD
=0* MEM WRITE, ;WAIT FOR MEMORY
MEM_[AR], CALL [NEXT] ;STORE
MEM WRITE, ;WAIT FOR MEMORY
MEM_[PC] ;STORE FULL WORD PC
=000 [HR]_0, ;SAVE E
HOLD RIGHT, CALL [NEXT] ;BUT CLEAR OPCODE
.ENDIF/KLPAGE
=010
UUOPCW: MEM WRITE, ;WAIT FOR MEMORY
MEM_[HR], ;STORE INSTRUCTION IN KI
; OR FULL WORD E IN KL
CALL [GETPCW] ;GET PROCESS-CONTEXT-WORD
=011 NEXT [ARX] PHYSICAL WRITE, ;POINT TO NEXT WORD
CALL [STOBR] ;STORE PROCESS CONTEXT WORD
;NOW WE MUST PICK ONE OF 8 NEW PC WORDS BASED ON PC FLAGS
=111 [BR]_0 XWD [430] ;OFFSET INTO UPT
=
[BR]_[BR]+[UBR] ;ADDRESS OF WORD
[AR]_FLAGS ;GET FLAGS
TL [AR], ;LOOK AT FLAGS
#/600 ;TRAP SET?
=0 [BR]_[BR].OR.#, ;YES--POINT TO TRAP CASE
#/1, ; ..
HOLD LEFT ;LEAVE LEFT ALONE
TL [AR], ;USER OR EXEC
#/10000 ; ..
=0 [BR]_[BR].OR.#, ;USER
#/4, ;POINT TO USER WORDS
HOLD LEFT
READ [BR], ;LOOK AT ADDRESS
LOAD VMA, ;PLACE IN VMA
VMA PHYSICAL, ;PHYSICAL ADDRESS
START READ ;GET NEW PC WORD
GOEXEC: MEM READ, ;WAIT FOR DATA
[AR]_MEM ;STICK IN AR
READ [AR], ;LOOK AT DATA
LOAD FLAGS, ;LOAD NEW FLAGS
LEAVE USER, ;ALLOW USER TO LOAD
LOAD PCU, ;SET PCU FROM USER
J/JUMPA ;JUMP
.IF/KIPAGE
;HERE FOR TOPS-10 STYLE PAGING
=00
KIMUUO: MEM WRITE, ;STORE INSTRUCTION
MEM_[HR], CALL [NEXT] ;IN MEMORY
=10 [AR]_PC WITH FLAGS, ;GET PC WORD
CALL [UUOFLG] ;CLEAR TRAP FLAGS
=11 MEM WRITE, ;STORE PC WORD
MEM_[AR], ; ..
J/UUOPCW ;GO STORE PROCESS CONTEXT
.ENDIF/KIPAGE
UUOFLG: [AR]_[AR].AND.NOT.#, ;CLEAR TRAP FLAGS
#/600, HOLD RIGHT, ; IN WORD TO SAVE
RETURN [1] ; BACK TO CALLER
NEXT: NEXT [ARX] PHYSICAL WRITE, ;POINT TO NEXT WORD
RETURN [2]
;HERE FOR LUUO'S
1557:
LUUO: [AR]_0 XWD [40] ;AR GET CONSTANT 40
;THE LUUO MACRO DOES THE ABOVE INSTRUCTION AND GOES TO LUUO1
400: ;FOR SIMULATOR
LUUO1: READ [AR], ;LOAD 40 INTO
LOAD VMA, ; THE VMA AND
START WRITE ; PREPARE TO STORE
[HR]_[HR].AND.#, ;CLEAR OUT INDEX AND @
#/777740, ; ..
HOLD RIGHT
MEM WRITE, ;STORE LUUO IN 40
MEM_[HR]
VMA_[AR]+1, ;POINT TO 41
LOAD VMA, ;PUT 41 IN VMA
START READ, ;START FETCH
J/CONT1 ;GO EXECUTE THE INSTRUCTION
.TOC "ARITHMETIC -- ADD, SUB"
.DCODE
270: R-PF, AC, J/ADD
I-PF, AC, J/ADD
RW, M, J/ADD
RW, B, J/ADD
.UCODE
1560:
ADD: [AR]_[AR]+AC, ;DO THE ADD
AD FLAGS EXIT, 3T ;UPDATE CARRY FLAGS
;STORE ANSWER
;MISSES 3-TICKS BY 3 NS.
.DCODE
274: R-PF, AC, J/SUB
I-PF, AC, J/SUB
RW, M, J/SUB
RW, B, J/SUB
.UCODE
1561:
SUB: [AR]_AC-[AR], ;DO THE SUBTRACT
AD FLAGS EXIT, 3T ;UPDATE PC CARRY FLAGS
;ALL DONE
;MISSES 3-TICKS BY 3 NS.
.TOC "ARITHMETIC -- DADD, DSUB"
.DCODE
114: DBL R, DAC, J/DADD
DBL R, DAC, J/DSUB
.UCODE
1457:
DADD: [ARX]_[ARX]+AC[1], 4T, ;ADD LOW WORDS
SKIP CRY1 ;SEE IF CARRY TO HIGH WORD
=0
DADD1: [AR]_[AR]+AC, ;ADD HIGH WORDS
ADD .25, ;ADD IN ANY CARRY FROM LOW WORD
AD FLAGS, 4T, ;UPDATE PC FLAGS
J/CPYSGN ;COPY SIGN TO LOW WORD
[BR]_.NOT.[MASK] ;SET BITS 35 AND 36 IN
[AR]_[AR].OR.[BR], ; AR SO THAT ADD .25 WILL
HOLD LEFT, J/DADD1 ; ADD 1.
1615:
DSUB: [ARX]_AC[1]-[ARX], 4T, ;SUBTRACT LOW WORD
SKIP CRY1 ;SEE IF CARRY
=0 [AR]_AC-[AR]-.25, ;NO CARRY
AD FLAGS, 4T, ;UPDATE PC FLAGS
J/CPYSGN ;GO COPY SIGN
[AR]_AC-[AR], 4T, ;THERE WAS A CARRY
AD FLAGS ;UPDATE CARRY FLAGS
CPYSGN: FIX [AR] SIGN, SKIP DP0
=0 [ARX]_[ARX].AND.#, #/377777, HOLD RIGHT, J/MOVE
[ARX]_[ARX].OR.#, #/400000, HOLD RIGHT, J/MOVE
.TOC "ARITHMETIC -- MUL, IMUL"
.DCODE
220: R-PF, AC, J/IMUL
I-PF, AC, J/IMUL
RW, M, J/IMUL
RW, B, J/IMUL
.UCODE
1641:
IMUL: [BRX]_[AR], AC ;COPY C(E)
Q_AC, SC_35. ;GET THE AC
=0** [BRX]_[BRX]*.5 LONG, ;SHIFT RIGHT
CALL [MULSUB] ;MULTIPLY
READ [ARX], SKIP AD.EQ.0 ;SEE IF FITS
=0 [ARX]_[ARX]*2, J/IMUL2 ;NOT ZERO--SHIFT LEFT
IMUL1: [AR]_Q, EXIT ;POSITIVE
IMUL2: [MASK].AND.NOT.[ARX], ;SEE IF ALL SIGN BITS
SKIP AD.EQ.0 ; ..
=0 FIX [ARX] SIGN, ;NOT ALL SIGN BITS
SKIP DP0, J/IMUL3 ;GIVE + OR - OVERFLOW
[AR]_[MAG].EQV.Q, EXIT ;NEGATIVE
=0
IMUL3: [AR]_Q, SET AROV, J/MOVE
[AR]_[MAG].EQV.Q, SET AROV, J/MOVE
.DCODE
224: R-PF, DAC, J/MUL
I-PF, DAC, J/MUL
RW, M, J/MUL
RW, DBL B, J/MUL
.UCODE
1571:
MUL: Q_[AR], AC ;COPY C(E)
[T0]_[AR] ;SAVE FOR OVERFLOW TEST
[BRX]_AC, SC_35. ;GET THE AC
=0** [BRX]_[BRX]*.5 LONG, ;SHIFT OVER
CALL [MULSUB] ;MULTIPLY
[AR]_[ARX]*2 ;SHIFT OVER
FIX [AR] SIGN, SKIP DP0 ;SEE IF NEGATIVE
=0 [ARX]_[MAG].AND.Q, ;POSITIVE
EXIT
[T0].AND.[BRX], SKIP DP0 ;TRIED TO SQUARE 1B0?
=0 [ARX]_[MAG].EQV.Q, EXIT ;NO
[ARX]_[MAG].EQV.Q, ;YES
SET AROV, J/MOVE
.TOC "ARITHMETIC -- DMUL"
.DCODE
116: DBL R, DAC, J/DMUL
.UCODE
.IF/FULL
1566:
DMUL: [AR]_[AR]*.5 ;SHIFT MEM OPERAND RIGHT
[ARX]_([ARX].AND.[MAG])*.5
[BR]_[ARX], ;COPY LOW WORD
SKIP FPD ;SEE IF FIRST PART DONE
;
; BRX * BR ==> C(E+1) * C(AC+1)
;
=000 [BRX]_(AC[1].AND.[MAG])*.5, 3T, ;GET LOW AC
CALL [DMULGO] ;START MULTIPLY
[ARX]_(AC[2].AND.[MAG])*.5, 3T, ;FIRST PART DONE
J/DMUL1 ;GO DO SECOND PART
=100 AC[3]_Q ;SALT AWAY 1 WORD OF PRODUCT
=
;
; BRX * Q ==> C(E) * C(AC+1)
;
=0** Q_[AR], SC_35., ;GO MULT NEXT HUNK
CALL [QMULT] ; ..
[T0]_[ARX] ;SAVE PRODUCT
AC[2]_Q, [ARX]_Q*.5, ;SAVE PRODUCT
J/DMUL2 ;GO DO HIGH HALF
DMUL1: [T0]_AC[1]*.5 ;RESTORE T0
=0*0
;
; BRX * BR ==> C(AC) * C(E+1)
;
DMUL2: [BRX]_AC*.5, ;PREPARE TO DO HIGH HALF
CALL [DBLMUL] ; GO DO IT
AC[1]_[T0]*2, 3T, ;INTERRUPT, SAVE T0
J/DMLINT ;SET FPD AND INTERRUPT
AC[2]_Q ;SAVE PRODUCT
=
[ARX]_[ARX]+[T0] ;PREPARE FOR LAST MUL
;
; BRX * Q ==> C(AC) * C(E)
;
=0** Q_[AR], SC_35., ;DO THE LAST MULTIPLY
CALL [QMULT] ; GO DO IT
[ARX]_[ARX]*2, ;SHIFT BACK
CLR FPD ;CLEAR FPD
AC_[ARX] TEST, SKIP DP0 ;PUT BACK INTO AC
=0 AC[1]_Q, J/DMTRAP ;POSITIVE
AC[1]_[MAG].EQV.Q ;NEGATIVE
Q_AC[2]
AC[2]_[MAG].EQV.Q
Q_AC[3]
AC[3]_[MAG].EQV.Q
DMTRAP: [AR]_PC WITH FLAGS, ;LOOK AT FLAGS
SKIP DP0 ;SEE IF AROV SET?
=0 DONE ;NO--ALL DONE
SET AROV, J/DONE ;YES--FORCE TRAP 1 ALSO
;WAYS TO CALL MULTIPLY
DMULGO: [ARX]_0 ;CLEAR ARX
DBLMUL: Q_[BR], SC_35.
[BRX]_[BRX]*.5
=0**
QMULT: Q_Q*.5,
CALL [MULTIPLY]
[ARX]+[ARX], AD FLAGS, ;TEST FOR OVERFLOW
3T, RETURN [4] ;AND RETURN
DMLINT: SET FPD, J/FIXPC ;SET FPD, BACKUP PC
; INTERRUPT
.IFNOT/FULL
1566:
DMUL: UUO
.ENDIF/FULL
;MULTIPLY SUBROUTINE
;ENTERED WITH:
; MULTIPLIER IN Q
; MULTIPLICAND IN BRX
;RETURNS 4 WITH PRODUCT IN ARX!Q
MUL STEP "A/BRX,B/ARX,DEST/Q_Q*.5,ASHC,STEP SC,MUL DISP"
MUL FINAL "A/BRX,B/ARX,DEST/Q_Q*2"
MULSUB: [BRX]_[BRX]*.5 LONG
MULSB1: [ARX]_0*.5 LONG, ;CLEAR ARX AND SHIFT Q
STEP SC, ;COUNT FIRST STEP
J/MUL+ ;ENTER LOOP
;MULTIPLY SUBROUTINE
;ENTERED WITH:
; MULTIPLIER IN Q
; MULTIPLICAND IN BRX
; PARTIAL PRODUCT IN ARX
;RETURNS 4 WITH Q*BRX+ARX IN ARX!Q
MULTIPLY:
Q_Q*.5, ;SHIFT Q
STEP SC, ;COUNT FIRST STEP
J/MUL+ ;ENTER LOOP
;HERE FOR POSITIVE STEPS
=010 ;0 IN A POSITIVE STEP
MUL+: AD/B, ;DON'T ADD
MUL STEP, ;SHIFT
J/MUL+ ;KEEP POSITIVE
=011 ;DONE
AD/B, ;DON'T ADD
MUL FINAL, ;SHIFT
RETURN [4] ;SHIFT Q AND RETURN
=110 ;1 IN A POSITIVE STEP
AD/B-A-.25, ADD .25, ;SUBTRACT
MUL STEP, ;SHIFT AND COUNT
J/MUL- ;NEGATIVE NOW
=111 ;DONE
AD/B-A-.25, ADD .25, ;SUBTRACT
MUL FINAL, ;SHIFT
RETURN [4] ; AND RETURN
;HERE FOR NEGATIVE STEPS
=010 ;0 IN NEGATIVE STEP
MUL-: AD/A+B, ;ADD
MUL STEP, ;SHIFT AND COUNT
J/MUL+ ;POSITIVE NOW
=011 ;DONE
AD/A+B, ;ADD
MUL FINAL, ;SHIFT
RETURN [4] ;FIX Q AND RETURN
=110 ;1 IN NEGATIVE STEP
AD/B, ;DON'T ADD
MUL STEP, ;SHIFT AND COUNT
J/MUL- ;STILL NEGATIVE
=111 ;DONE
AD/B, ;DON'T ADD
MUL FINAL, ;SHIFT
RETURN [4] ;FIX Q AND RETURN
.TOC "ARITHMETIC -- DIV, IDIV"
.DCODE
230: R-PF, DAC, J/IDIV
I-PF, DAC, J/IDIV
RW, M, J/IDIV
RW, DBL B, J/IDIV
234: R-PF, DAC, J/DIV
I-PF, DAC, J/DIV
RW, M, J/DIV
RW, DBL B, J/DIV
.UCODE
1600:
IDIV: [BR]_[AR], AC ;COPY MEMORY OPERAND
Q_AC, ;LOAD Q
SKIP DP0 ;SEE IF MINUS
=0 [AR]_0, ;EXTEND + SIGN
J/DIV1 ;NOW SAME AS DIV
[AR]_-1, ;EXTEND - SIGN
J/DIV1 ;SAME AS DIV
1601:
DIV: [BR]_[AR] ;COPY MEM OPERAND
[AR]_AC ;GET AC
Q_AC[1] ;AND AC+1
READ [AR], ;TEST FOR NO DIVIDE
SKIP AD.EQ.0
=000 .NOT.[AR], ;SEE IF ALL SIGN BITS IN AR
SKIP AD.EQ.0, ; ..
J/DIVA ;CONTINUE BELOW
=001
DIV1: READ [BR], ;SEE IF DIVIDE BY
SKIP AD.EQ.0 ; ZERO
=100
DIV2: SC_34., ;NOT ZERO--LOAD STEP COUNT
CALL [DIVSUB] ;DIVIDE
=101 NO DIVIDE ;DIVIDE BY ZERO
=110 [ARX]_[AR], ;COPY REMAINDER
J/IMUL1 ;STORE ANSWER
=
=0
DIVA: [BRX]_[AR], ;HIGH WORD IS NOT SIGNS
J/DIVB ;GO TEST FOR NO DIVIDE
READ [BR], ;ALL SIGN BITS
SKIP AD.EQ.0, ;SEE IF ZERO DIVIDE
J/DIV2 ;BACK TO MAIN FLOW
DIVB: [ARX]_Q ;MAKE ABS VALUES
READ [AR], ;SEE IF +
SKIP DP0
=00 READ [BR], ;SEE IF +
SKIP DP0,
J/DIVC ;CONTINUE BELOW
CLEAR [ARX]0, ;FLUSH DUPLICATE SIGN
CALL [DBLNG1] ;NEGATE AR!ARX
=11 READ [BR], ;SEE IF TOO BIG
SKIP DP0,
J/DIVC
=
=0
DIVC: [AR]-[BR], ;COMPUTE DIFFERENCE
SKIP DP0, ;SEE IF IT GOES
3T, ;ALLOW TIME
J/NODIV ;TEST
[AR]+[BR],
SKIP DP0, ;SAME TEST FOR -VE BR
3T,
J/NODIV
=0
NODIV: NO DIVIDE ;TOO BIG
[AR]_[BRX], ;FITS
J/DIV1 ;GO BACK AND DIVIDE
.TOC "ARITHMETIC -- DDIV"
.DCODE
117: DBL R, DAC, J/DDIV
.UCODE
.IF/FULL
1627:
DDIV: Q_[ARX].AND.[MAG] ;COPY LOW WORD
[BR]_[AR]*.5, ;COPY MEMORY OPERAND
SKIP AD.LE.0 ;SEE IF POSITIVE
=0 [BR]_[BR]*.5 LONG, ;POSITIVE
J/DDIV1 ;CONTINUE BELOW
[BR]_[BR]*.5 LONG, ;NEGATIVE OR ZERO
SKIP DP0 ;SEE WHICH?
=0 [MAG].AND.Q, ;SEE IF ALL ZERO
SKIP AD.EQ.0, J/DDIV1 ;CONTINUE BELOW
[T1]_0 XWD [5] ;NEGATE MEM OP
Q_Q.OR.#, #/600000, ;SIGN EXTEND THE LOW
HOLD RIGHT ; WORD
Q_-Q ;MAKE Q POSITIVE
[BR]_(-[BR]-.25)*.5 LONG, ;NEGATE HIGH WORD
ASHC, MULTI PREC/1, ;USE CARRY FROM LOW WORD
J/DDIV3 ;CONTINUE BELOW
=0
DDIV1: [BR]_[BR]*.5 LONG, ;SHIFT OVER 1 PLACE
ASHC, J/DDIV2 ;CONTINUE BELOW
NO DIVIDE ;DIVIDE BY ZERO
DDIV2: [T1]_0 XWD [4] ;MEM OPERAND IS POSITIVE
DDIV3: [BRX]_Q, AC ;COPY Q
[AR]_AC*.5, 2T, SKIP DP0 ;GET AC--SEE IF NEGATIVE
=0*1*0
DDIV3A: Q_AC[1].AND.[MAG], ;POSITIVE (OR ZERO)
J/DDIV4 ;CONTINUE BELOW
[T1]_[T1].XOR.#, ;NEGATIVE
#/7, CALL [QDNEG] ;UPDATE SAVED FLAGS
=1*1*1 [AR]_[AR]*.5, ;SHIFT AR OVER
J/DDIV3A ;GO BACK AND LOAD Q
=
=0
DDIV4: [AR]_[AR]*.5 LONG, ;SHIFT AR OVER
CALL [DDIVS] ;SHIFT 1 MORE PLACE
[AR]-[BR], 3T, SKIP DP0 ;TEST MAGNITUDE
=0 [AR]-[BR], 2T,
SKIP AD.EQ.0, J/DDIV5
[ARX]_Q, J/DDIV5A ;ANSWER FITS
=0
DDIV5: READ [T1], 3T, DISP/DP, J/NODDIV
Q-[BRX], 3T, SKIP DP0
=0 READ [T1], 3T, DISP/DP, J/NODDIV
[ARX]_Q ;COPY LOW WORD
;HERE WITH EVERYTHING SETUP AND READY TO GO
DDIV5A: Q_AC[2].AND.[MAG]
=0* Q_Q*.5, SC_34., CALL [DBLDIV]
[T0]_Q*2 LONG
Q_Q+[T0]
AC[0]_Q.AND.[MAG] ;STORE ANSWER
=0 Q_[ARX], CALL [DDIVS] ;SHIFT OUT EXTRA ZERO BIT
[ARX]_Q ; ..
Q_AC[3].AND.[MAG]
=0* [T0]_[AR]*.5 LONG, ;SHIFT Q, PUT AR ON DP
SC_34., ;LOAD SHIFT COUNT
SKIP DP0, ;LOOK AT AR SIGN
CALL [DBLDIV] ;GO DIVIDE
[T0]_Q*2 LONG
READ [T1], 3T, DISP/DP ;WHAT SIGN IS QUO
=1110 [T0]_[T0]+Q, ;POSITIVE QUO
J/DDIV5B ;CONTINUE BELOW
[T0]_-Q*2 ;NEGATIVE QUO
AD/-D-.25, DBUS/RAM, 3T,
RAMADR/AC#, DEST/Q_AD,
MULTI PREC/1
AC_Q, SKIP AD.EQ.0
=0 AC[1]_[T0], J/DDIV5C
AC[1]_0, J/DDIV6
DDIV5B: AC[1]_[T0].AND.[MAG], J/DDIV6 ;STORE LOW WORD IN + CASE
DDIV5C: [T0]_[T0].OR.#, #/400000, HOLD RIGHT
AC[1]_[T0]
DDIV6: READ [AR], SKIP DP0 ;LOOK AT AR SIGN
=0
DDIV7: Q_[ARX], J/DDIV8
Q_[ARX]+[BRX]
[AR]_[AR]+[BR],
MULTI PREC/1
Q_Q+[BRX]
[AR]_[AR]+[BR],
MULTI PREC/1
DDIV8: READ [T1], 3T, DISP/DP
=1101
DDIV8A: [AR]_[AR]*2 LONG, ASHC, ;POSITIVE REMAINDER
J/DDIV9 ;CONTINUE BELOW
Q_-Q ;NEGATE REMAINDER IN AR!Q
[AR]_(-[AR]-.25)*2 LONG,
MULTI PREC/1, ASHC
DDIV9: AC[2]_[AR]+[AR], 3T,
SKIP DP0
=0 AC[3]_Q.AND.[MAG],
NEXT INST
Q_Q.AND.[MAG], AC[3]
AC[3]_[MAG].EQV.Q,
NEXT INST
;HERE IF WE WANT TO SET NO DIVIDE
=11011
NODDIV: CALL [QDNEG] ;FIXUP AC TO AC+3
NO DIVIDE ;ABORT DIVIDE
DDIVS: [AR]_[AR]*.5 LONG, ASHC, RETURN [1]
.IFNOT/FULL
1627:
DDIV: UUO
.ENDIF/FULL
.TOC "ARITHMETIC -- DIVIDE SUBROUTINE"
;HERE IS THE SUBROUTINE TO DO DIVIDE
;ENTER WITH:
; AR!Q = D'END
; BR = D'SOR
;RETURN 2 WITH:
; AR = REMAINDER
; Q = QUOTIENT
;CALLER MUST CHECK FOR ZERO DIVIDE PRIOR TO CALL
;
=1000
DIVSUB: Q_Q.AND.#, ;CLEAR SIGN BIT IN
#/377777, ;MASK
HOLD RIGHT, ;JUST CLEAR BIT 0
CALL [DIVSGN] ;DO REAL DIVIDE
=1100 RETURN [2] ;ALL POSITIVE
=1101 Q_-Q, RETURN [2] ;-QUO +REM
=1110 Q_-Q ;ALL NEGATIVE
=1111 [AR]_-[AR], RETURN [2] ;NEGATIVE REMAINDER
;HERE IS THE INNER DIVIDE SUBROUTINE
;SAME SETUP AS DIVSUB
;RETURNS WITH AR AND Q POSITIVE AND
; 14 IF ALL POSITIVE
; 15 IF -QUO
; 16 IF ALL NEGATIVE
; 17 IF NEGATIVE REMAINDER
BASIC DIV STEP "DEST/Q_Q*2, DIV, A/BR, B/AR, STEP SC"
DIV STEP "BASIC DIV STEP, AD/A+B, DIVIDE/1"
FIRST DIV STEP "BASIC DIV STEP, AD/B-A-.25, ADD .25"
DIVSGN: READ [AR], SKIP DP0
=0 [ARX]_0, J/DVSUB2 ;REMAINDER IS POSITIVE
Q_-Q, SKIP AD.EQ.0 ;COMPLEMENT LOW WORD
=0 [AR]_.NOT.[AR], J/DVSUB1 ;COMPLEMENT HI WORD
[AR]_-[AR] ;TWO'S COMPLEMENT HI WORD SINCE
; LOW WORD WAS ZERO
DVSUB1: [ARX]_#, #/100000 ;REMAINDER IS NEGATIVE
DVSUB2: READ [BR], SKIP DP0 ;IS THE DIVISOR NEGATIVE
=0
DVSUB3: [AR]_[AR]*.5 LONG, ;START TO PUT IN 9-CHIPS
J/DIVSET ;JOIN MAIN STREAM
[BR]_-[BR] ;COMPLEMENT DIVISOR
[ARX]_[ARX].OR.#, ;ADJUST SIGN OF QUOTIENT
#/40000, J/DVSUB3 ;USE 9 CHIPS
DIVSET: [AR]_[AR]*.5
[BR]_[BR]*.5
[BR]_[BR]*.5
FIRST DIV STEP
;HERE IS THE MAIN DIVIDE LOOP
=0
DIVIDE: DIV STEP, J/DIVIDE
[T1]_[T1]*2 LONG, DIVIDE/1, DIV
[AR]_[AR]*.5, SKIP DP0
=0
FIX++: [AR]_[AR]*2 LONG, J/FIX1++
[AR]_[AR]+[BR], J/FIX++
FIX1++: [AR]_[AR]*2 LONG
Q_[MASK].AND.Q
READ [ARX], 3T, ;RETURN TO 1 OF 4 PLACES
DISP/1, ;BASED ON SIGN OF RESULT
J/14 ;RETURN
.TOC "ARITHMETIC -- DOUBLE DIVIDE SUBROUTINE"
.IF/FULL
;CALL WITH:
; AR!ARX!Q = 3 WORD DV'END
; BR!BRX = 2 WORD DV'SOR
;RETURN 2 WITH:
; AR!ARX = 2 WORD REMAINDER
; CORRECT IF POSITIVE (Q IS ODD)
; WRONG (BY BR!BRX) IF NEGATIVE (Q IS EVEN)
; Q = 1 WORD QUOTIENT
;CALLER MUST CHECK FOR ZERO DIVIDE PRIOR TO CALL
;
;NOTE: THIS SUBROUTINE ONLY WORKS FOR POSITIVE NUMBERS
;
=0
;HERE FOR NORMAL STARTUP
DBLDIV: [ARX]_([ARX]-[BRX])*2 LONG, ;SUBTRACT LOW WORD
LSHC, J/DIVHI ;GO ENTER LOOP
;SKIP ENTRY POINT IF FINAL STEP IN PREVIOUS ENTRY WAS IN ERROR
[ARX]_([ARX]+[BRX])*2 LONG, ;CORRECTION STEP
LSHC, J/DIVHI ;GO ENTER LOOP
;HERE IS DOUBLE DIVIDE LOOP
DIVHI: AD/A+B, ;ADD (HARDWARE MAY OVERRIDE)
A/BR, B/AR, ;OPERANDS ARE AR AND BR
DEST/AD*2, ;SHIFT LEFT
SHSTYLE/NORM, ;SET SHIFT PATHS (SEE DPE1)
MULTI PREC/1, ;INJECT SAVED BITS
STEP SC ;COUNT DOWN LOOP
=0 AD/A+B, ;ADD (HARDWARE MAY OVERRIDE)
A/BRX, B/ARX, ;LOW WORDS
DEST/Q_Q*2, ;SHIFT WHOLE MESS LEFT
SHSTYLE/DIV, ;SET SHIFT PATHS (SEE DPE1)
DIVIDE/1, ;SAVE BITS
J/DIVHI ;KEEP LOOPING
;HERE WHEN ALL DONE
DEST/Q_Q*2, DIV, ;SHIFT IN LAST Q BIT
DIVIDE/1, ;GENERATE BIT
B/HR, RETURN [2] ;ZERO HR AND RETURN
.TOC "ARITHMETIC -- SUBROUTINES FOR ARITHMETIC"
;QUAD WORD NEGATE
;ARGUMENT IN AC!AC1!AC2!AC3
;LEAVES COPY OF AC!AC1 IN AR!Q
;RETURNS TO CALL!24
QDNEG: Q_-AC[3]
AC[3]_Q.AND.[MAG], ;PUT BACK LOW WORD
SKIP AD.EQ.0 ;SEE IF ANY CARRY
=0
COM2A: Q_.NOT.AC[2], J/COM2 ;CARRY--DO 1'S COMPLEMENT
Q_-AC[2] ;NEXT WORD
AC[2]_Q.AND.[MAG], ;PUT BACK WORD
SKIP AD.EQ.0
=0
COM1A: Q_.NOT.AC[1], J/COM1
Q_-AC[1]
AC[1]_Q.AND.[MAG],
SKIP AD.EQ.0
=0
COM0A: [AR]_.NOT.AC, J/COM0
[AR]_-AC, 3T, J/COM0
COM2: AC[2]_Q.AND.[MAG], J/COM1A
COM1: AC[1]_Q.AND.[MAG], J/COM0A
COM0: AC_[AR], RETURN [24]
.ENDIF/FULL
;DOUBLE WORD NEGATE
;ARGUMENT IN AR AND ARX
;RETURNS TO CALL!2
DBLNEG: CLEAR ARX0 ;FLUSH DUPLICATE SIGN
DBLNGA: [ARX]_-[ARX], ;FLIP LOW WORD
SKIP AD.EQ.0 ;SEE IF CARRY
=0 [AR]_.NOT.[AR], ;NO CARRY-- 1 COMP
AD FLAGS, J/CLARX0 ;CLEAR LOW SIGN
[AR]_-[AR], ;CARRY
AD FLAGS, 3T, J/CLARX0
;SAME THING BUT DOES NOT SET PC FLAGS
DBLNG1: [ARX]_-[ARX], SKIP AD.EQ.0
=0 [AR]_.NOT.[AR], J/CLARX0
[AR]_-[AR], J/CLARX0
.NOBIN
.TOC "BYTE GROUP -- IBP, ILDB, LDB, IDPB, DPB"
;ALL FIVE INSTRUCTIONS OF THIS GROUP ARE CALLED WITH THE BYTE POINTER
;IN THE AR. ALL INSTRUCTIONS SHARE COMMON SUBROUTINES.
;IBP OR ADJBP
;IBP IF AC#0, ADJBP OTHERWISE
; HERE WITH THE BASE POINTER IN AR
;HERE IS A MACRO TO DO IBP. WHAT HAPPENS IS:
; THE AR IS PUT ON THE DP.
; THE BR IS LOADED FROM THE DP WITH BITS 0-5 FROM SCAD
; THE SCAD COMPUTES P-S
; IBPS IS CALLED WITH A 4-WAY DISPATCH ON SCAD0 AND FIRST-PART-DONE
;THE MACRO IS WRITTEN WITH SEVERAL SUB-MACROS BECAUSE OF RESTRICTIONS
; IN THE MICRO ASSEMBLER
IBP DP "AD/D, DEST/A, A/AR, B/BR, DBUS/DBM, DBM/DP, BYTE/BYTE1"
IBP SCAD "SCAD/A-B, SCADA/BYTE1, SCADB/SIZE"
IBP SPEC "SCAD DISP, SKIP FPD"
CALL IBP "IBP DP, IBP SCAD, IBP SPEC, CALL [IBPS], DT/3T"
SET P TO 36-S "AD/D,DEST/A,A/BR,B/AR,DBUS/DBM,DBM/DP,SCAD/A-B,SCADB/SIZE,BYTE/BYTE1,SCADA/PTR44"
;THE FOLLOWING MACRO IS USED FOR COUNTING SHIFTS IN THE BYTE ROUTINES. IT
; USES THE FE AND COUNTS BY 8. NOTE: BYTE STEP IS A 2S WEIGHT SKIP NOT 1S.
BYTE STEP "SCAD/A+B,SCADA/S#,S#/1770,SCADB/FE,LOAD FE, 3T,SCAD DISP"
.BIN
.DCODE
133: R, AC, J/IBP ;OR ADJBP
134: R,W TEST, J/ILDB ;CAN'T USE RPW BECAUSE OF FPD
R, J/LDB
R,W TEST, J/IDPB
R, J/DPB
.UCODE
1610:
IBP: SKIP IF AC0 ;SEE IF ADJBP
=000 WORK[ADJPTR]_[AR], ;SAVE POINTER
J/ADJBP ;GO ADJUST BYTE POINTER
=001 CALL IBP ;BUMP BYTE POINTER
=101 DONE ;POINTER STORED
=
1620:
ILDB: CALL IBP ;BUMP BYTE POINTER
1624:
LDB: READ [AR], ;LOOK AT POINTER
LOAD BYTE EA, FE_P, 3T, ;GET STUFF OUT OF POINTER
CALL [BYTEA] ;COMPUTE EFFECTIVE ADDRESS
1625: VMA_[PC], FETCH ;START FETCH OF NEXT INST
=0* READ [AR], ;LOOK AT POINTER
FE_FE.AND.S#, S#/0770, ;MASK OUT JUNK IN FE
BYTE DISP, ;DISPATCH ON BYTE SIZE
CALL [LDB1] ;GET BYTE
AC_[AR], CLR FPD, ;STORE AC
J/NIDISP ;GO DO NEXT INST
1630:
IDPB: CALL IBP ;BUMP BYTE POINTER
1634:
DPB: [ARX]_AC*2 ;PUT 7 BIT BYTE IN 28-34
AD/A, A/ARX, SCAD/A, ;PUT THE BYTE INTO
SCADA/BYTE5, 3T, ; INTO THE FE REGISTER
LOAD FE ; FE REGISTER
[ARX]_AC ;PUT BYTE IN ARX
=100 READ [AR], ;LOOK AT BYTE POINTER
LOAD BYTE EA, ;LOAD UP EFFECTIVE ADDRESS
CALL [BYTEA] ;COMPUTE EFFECTIVE ADDRESS
READ [AR], ;LOOK AT POINTER AGAIN
BYTE DISP, ;DISPATCH ON SIZE
CALL [DPB1] ;GO STORE BYTE
=111 CLR FPD, J/DONE ;ALL DONE
=
.TOC "BYTE GROUP -- INCREMENT BYTE POINTER SUBROUTINE"
=00
IBPS: [AR]_[BR], START WRITE, J/IBPX ;NO OVERFLOW, BR HAS ANSWER
RETURN [4] ;FIRST PART DONE SET
SET P TO 36-S, J/NXTWRD ;WORD OVERFLOW
RETURN [4] ;FPD WAS SET IGNORE OVERFLOW
; AND RETURN
NXTWRD: [AR]_[AR]+1, HOLD LEFT, START WRITE ;BUMP Y AND RETURN
IBPX: MEM WRITE, MEM_[AR], RETURN [4]
.TOC "BYTE GROUP -- BYTE EFFECTIVE ADDRESS EVALUATOR"
;ENTER WITH POINTER IN AR
;RETURN1 WITH (EA) IN VMA AND WORD IN BR
BYTEAS: EA MODE DISP, ;HERE TO AVOID FPD
J/BYTEA0 ;GO COMPUTE EA
BYTEA: SET FPD, ;SET FIRST-PART-DONE
EA MODE DISP ;DISPATCH
=100*
BYTEA0: VMA_[AR]+XR, ;INDEXING
START READ, ;FETCH DATA WORD
PXCT BYTE DATA, ;FOR PXCT
J/BYTFET ;GO WAIT
VMA_[AR], ;PLAIN
START READ, ;START CYCLE
PXCT BYTE DATA, ;FOR PXCT
J/BYTFET ;GO WAIT
VMA_[AR]+XR, ;BOTH
START READ, ;START CYCLE
PXCT BYTE PTR EA, ;FOR PXCT
J/BYTIND ;GO DO INDIRECT
VMA_[AR], ;JUST @
START READ, ;START READ
PXCT BYTE PTR EA ;FOR PXCT
BYTIND: MEM READ, ;WAIT FOR @ WORD
[AR]_MEM, ;PUT IN AR
HOLD LEFT, ;JUST IN RH (SAVE P & S)
LOAD BYTE EA, ;LOOP BACK
J/BYTEAS ; ..
BYTFET: MEM READ, ;WAIT FOR BYTE DATA
[BR]_MEM.AND.MASK, ; WORD. UNSIGNED
RETURN [1] ;RETURN TO CALLER
.TOC "BYTE GROUP -- LOAD BYTE SUBROUTINE"
;CALL WITH:
; WORD IN BR
; POINTER IN AR
; P IN FE
; BYTE DISPATCH
;RETURN2 WITH BYTE IN AR
LDB SCAD "SCAD/A,BYTE/BYTE5"
7-BIT LDB "AD/D,DBUS/DBM,DBM/DP,DEST/A,A/BR,B/BR, LDB SCAD"
=000
LDB1: GEN 17-FE, 3T, ;GO SEE IF ALL THE BITS
SCAD DISP, ; ARE IN THE LEFT HALF
J/LDBSWP ;GO TO LDBSWP & SKIP IF LH
;HERE ARE THE 7-BIT BYTES
=001 7-BIT LDB, SCADA/BYTE1, J/LDB7
=010 7-BIT LDB, SCADA/BYTE2, J/LDB7
=100 7-BIT LDB, SCADA/BYTE3, J/LDB7
=101 7-BIT LDB, SCADA/BYTE4, J/LDB7
=111 7-BIT LDB, SCADA/BYTE5, J/LDB7
=
;FOR 7-BIT BYTES WE HAVE BYTE IN BR 28-35 AND JUNK IN REST OF BR.
; WE JUST MASK THE SELECTED BYTE AND SHIFT ONE PLACE RIGHT.
LDB7: AD/ZERO,RSRC/DA, ;LH_ZERO, RH_D.AND.A
DBUS/DBM,DBM/#,#/376, ;D INPUT IS 376
A/BR, ;A IS BR
B/AR, ;PUT RESULT IN AR
DEST/AD*.5, 3T, ;SHIFT RESULT 1 PLACE
RETURN [2] ;RETURN TO CALLER
;HERE FOR NORMAL BYTES
=00
LDBSWP: FE_-FE, ;MAKE P NEGATIVE
J/LDBSH ;JOIN MAIN LDB LOOP
=10 [BR]_[BR] SWAP ;SHIFT 18 STEPS
=
[BR]_0, HOLD RIGHT, ;PUT ZERO IN LH
FE_-FE+S#, S#/220 ;UPDATE FE
LDBSH: [BR]_[BR]*.5, ;SHIFT RIGHT
FE_FE+10, ;UPDATE THE FE
MULTI SHIFT/1 ;FAST SHIFT
READ [AR], FE_-S-10 ;GET SIZE
Q_0 ;CLEAR Q
GEN MSK [AR], ;PUT MASK IN Q (WIPEOUT AR)
FE_FE+10, ;COUNT UP ALL STEPS
MULTI SHIFT/1 ;FAST SHIFT
GEN MSK [AR] ;ONE MORE BIT
[AR]_[BR].AND.Q, RETURN [2]
.NOBIN
.TOC "BYTE GROUP -- DEPOSIT BYTE IN MEMORY"
;FLOW FOR DPB (NOT 7-BIT BYTE)
;
;FIRST SET ARX TO -1 AND Q TO ZERO AND ROTATE LEFT
; S PLACES GIVING:
; ARX Q
; +------------------!------------------+
; !111111111111000000!000000000000111111!
; +------------------!------------------+
; !<--->!
; S BITS
;
;NOW THE AC IS LOAD INTO THE ARX AND BOTH THE ARX AND Q
; ARE SHIFTED LEFT P BITS GIVING:
; +------------------!------------------+
; !??????BBBBBB000000!000000111111000000!
; +------------------!------------------+
; <----><----> <----><---->
; JUNK BYTE MASK P BITS
;
;AT THIS POINT WE ARE ALMOST DONE. WE NEED TO AND
; THE BR WITH .NOT. Q TO ZERO THE BITS FOR THE BYTE
; AND AND ARX WITH Q TO MASK OUT THE JUNK THIS GIVES:
;
; ARX
; +------------------+
; !000000BBBBBB000000!
; +------------------!
;
; AR
; +------------------+
; !DDDDDD000000DDDDDD!
; +------------------+
;
;WE NOW OR THE AR WITH ARX TO GENERATE THE ANSWER.
.BIN
;DEPOSIT BYTE SUBROUTINE
;CALL WITH:
; BYTE POINTER IN AR
; BYTE TO STORE IN ARX
; WORD TO MERGE WITH IN BR
; (E) OF BYTE POINTER IN VMA
; 7-BIT BYTE IN FE
; BYTE DISPATCH
;RETURN2 WITH BYTE IN MEMORY
;
DPB SCAD "SCAD/A+B,SCADA/S#,SCADB/FE,S#/0"
7-BIT DPB "AD/D,DEST/A,A/BR,DBUS/DBM,DBM/DP,B/AR, DPB SCAD"
=000
DPB1: READ [AR], FE_-S-10, J/DPBSLO ;NOT SPECIAL
=001 7-BIT DPB, BYTE/BYTE1, J/DPB7
=010 7-BIT DPB, BYTE/BYTE2, J/DPB7
=100 7-BIT DPB, BYTE/BYTE3, J/DPB7
=101 7-BIT DPB, BYTE/BYTE4, J/DPB7
=111 7-BIT DPB, BYTE/BYTE5, J/DPB7
=
DPB7: [MAG]_[MASK]*.5, START WRITE
MEM WRITE, MEM_[AR], RETURN [2]
DPBSLO: Q_0 ;CLEAR Q
GEN MSK [MAG], ;GENERATE MASK IN Q (ZAP MAG)
FE_FE+10, ;COUNT STEPS
MULTI SHIFT/1 ;FAST SHIFT
GEN MSK [MAG] ;ONE MORE BITS
READ [AR], 3T, FE_P ;AMOUNT TO SHIFT
FE_FE.AND.S#, S#/0770 ;MASK OUT JUNK
Q_Q.AND.[MASK], ;CLEAR BITS 36 AND 37
FE_-FE ;MINUS NUMBER OF STEPS
[ARX]_[ARX]*2 LONG, ;SHIFT BYTE AND MASK
FE_FE+10, ;COUNT OUT STEPS
MULTI SHIFT/1 ;FAST SHIFT
;AT THIS POINT WE HAVE DONE ALL THE SHIFTING WE NEED. THE BYTE IS
; IN ARX AND THE MASK IS IN Q.
[AR]_.NOT.Q
[AR]_[AR].AND.[BR]
[ARX]_[ARX].AND.Q
[AR]_[AR].OR.[ARX],
J/DPB7
.TOC "BYTE GROUP -- ADJUST BYTE POINTER"
.IF/FULL
;FIRST THE NUMBER OF BYTES PER WORD IS COMPUTED FROM THE
; FOLLOWING FORMULA:
;
; ( P ) ( 36-P )
; BYTES PER WORD = INT( --- ) + INT( ---- )
; ( S ) ( S )
;
;THIS GIVES 2 BYTES PER WORD FOR THE FOLLOWING 12 BIT BYTE:
; !=====================================!
; ! 6 !////////////! 12 ! 6 !
; !=====================================!
; P=18 AND S=12
;
;WE GET 3 BYTES/WORD IF THE BYTES FALL IN THE NATURAL PLACE:
; !=====================================!
; ! 12 !\\\\\\\\\\\\! 12 !
; !=====================================!
; P=12 AND S=12
;WE COME HERE WITH THE BYTE POINTER IN AR, AND ADJPTR
ADJBP: [ARX]_[AR] SWAP, ;MOVE SIZE OVER
SC_9. ;READY TO SHIFT
=0
ADJBP0: [ARX]_[ARX]*.5, ;SHIFT P OVER
STEP SC, ; ..
J/ADJBP0 ; ..
[ARX]_([ARX].AND.#)*.5, ;SHIFT AND MASK
3T, ;WAIT
#/176 ;6 BIT MASK
[ARX]_#, ;CLEAR LH
#/0, ; ..
HOLD RIGHT ; ..
WORK[ADJP]_[ARX] ;SAVE P
[BR]_([AR].AND.#)*.5, ;START ON S
3T, ;EXTRACT S
#/007700 ; ..
[BR]_[BR] SWAP, ;SHIFT 18 PLACES
SC_3 ; ..
[BR]_0, ;CLEAR LH
HOLD RIGHT ; ..
=0
ADJBP1: [BR]_[BR]*.5, ;SHIFT S OVER
STEP SC, ; ..
J/ADJBP1 ; ..
WORK[ADJS]_[BR], ;SALT S AWAY
SKIP AD.EQ.0 ;SEE IF ZERO
=0 Q_[ARX], ;DIVIDE P BY S
SC_34., ;STEP COUNT
J/ADJBP2 ;SKIP NEXT WORD
[AR]_WORK[ADJPTR], J/MOVE ;S=0 -- SAME AS MOVE
=0*
ADJBP2: [AR]_#, ;FILL AR WITH SIGN BITS
#/0, ;POSITIVE
CALL [DIVSUB] ;GO DIVIDE
WORK[ADJQ1]_Q ;SAVE QUOTIENT
Q_#, ;COMPUTE (36-P)/S
#/36., ; ..
HOLD LEFT ;SMALL ANSWER
Q_Q-WORK[ADJP] ;SUBTRACT P
[BR]_WORK[ADJS] ;DIVIDE BY S
SC_34. ;STEP COUNT
=0* [AR]_#, ;MORE SIGN BITS
#/0, ; ..
CALL [DIVSUB] ;GO DIVIDE
WORK[ADJR2]_[AR] ;SAVE REMAINDER
[AR]_#, ;ASSUME NEGATIVE ADJ
#/777777 ;EXTEND SIGN
AD/D+Q, ;BR_(P/S)+((36-P)/S)
DEST/AD, ; ..
B/BR, ; ..
RAMADR/#, ; ..
DBUS/RAM, ; ..
WORK/ADJQ1, ; ..
4T, ; ..
SKIP AD.EQ.0 ;SEE IF ZERO
=0 Q_Q+AC, ;GET ADJUSTMENT
SC_34., ;STEP COUNT
SKIP DP0, ;GO DO DIVIDE
4T, ;WAIT FOR DP
J/ADJBP3 ;BELOW
NO DIVIDE ;0 BYTES/WORD
;WE NOW DIVIDE THE ADJUSTMENT BY THE BYTES PER WORD AND FORCE THE
; REMAINDER (R) TO BE A POSITIVE NUMBER (MUST NOT BE ZERO). THE
; QUOTIENT IS ADDED TO THE Y FIELD IN THE BYTE POINTER AND THE NEW
; P FIELD IS COMPUTED BY:
;
; ( ( 36-P ))
; NEW P = 36-((R * S) + RMDR( ---- ))
; ( ( S ))
;
;WE NOW HAVE BYTES/WORD IN BR AND ADJUSTMENT IN Q. DIVIDE TO GET
; WORDS TO ADJUST BY.
=00
ADJBP3: [AR]_#, ;POSITIVE ADJUSTMENT
#/0.
WORK[ADJBPW]_[BR], ;SAVE BYTES/WORD & COMPUTE
CALL [DIVSUB] ; ADJ/(BYTES/WORD)
;WE NOW WANT TO ADJUST THE REMAINDER SO THAT IT IS POSITIVE
=11 Q_#, ;ONLY RIGHT HALF
#/0, ; ..
HOLD RIGHT ; ..
=
READ [AR], ;ALREADY +
SKIP AD.LE.0 ; ..
=0
ADJBP4: AD/D+Q, ;ADD Q TO POINTER AND STORE
DEST/AD, ; ..
B/BR, ;RESULT TO BR
RAMADR/#, ;PTR IS IN RAM
DBUS/RAM, ; ..
WORK/ADJPTR, ; ..
INH CRY18, ;JUST RH
3T, ;WAIT FOR RAM
J/ADJBP5 ;CONTINUE BELOW
Q_Q-1, ;NO--MAKE Q SMALLER
HOLD LEFT ; ..
[AR]_[AR]+WORK[ADJBPW], ;MAKE REM BIGGER
J/ADJBP4 ;NOW HAVE + REMAINDER
ADJBP5: [BRX]_[AR], ;COMPUTE R*S
SC_35. ;STEP COUNT
Q_WORK[ADJS] ;GET S
=01* [BRX]_[BRX]*.5 LONG, ;SHIFT OVER
CALL [MULSUB] ; ..
AD/D+Q, ;AR_(R*S)+RMDR(36-P)/S
DEST/AD, ; ..
B/AR, ; ..
RAMADR/#, ; ..
3T, ; ..
DBUS/RAM, ; ..
WORK/ADJR2 ; ..
[AR]_(#-[AR])*2, ;COMPUTE 36-AR
3T, ;AND START LEFT
#/36. ; ..
[AR]_[AR] SWAP, ;PUT THE POSITION BACK
SC_9. ; ..
[AR]_#, ;CLEAR JUNK FROM RH
#/0, ; ..
HOLD LEFT ; ..
=0
ADJBP6: [AR]_[AR]*2, ;LOOP OVER ALL BITS
STEP SC, ; ..
J/ADJBP6 ; ..
[BR]_[BR].AND.#, ; ..
#/007777, ; ..
HOLD RIGHT ; ..
AC_[AR].OR.[BR], ;ALL DONE
J/DONE
.IFNOT/FULL
ADJBP: UUO ;NO ADJBP IN SMALL
; MICROCODE
.ENDIF/FULL
.NOBIN
.TOC "BLT"
;THIS CODE 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.
.BIN
;HERE TO SETUP FOR A BLT/UBABLT
SETBLT: [ARX]_[BRX] SWAP ;COPY TO ARX (SRC IN RH)
=0 VMA_[ARX], ;ADDRESS OF FIRST WORD
START READ,
PXCT BLT SRC,
CALL [CLARXL] ;CLEAR THE LEFT HALF OF
[BRX]_0, ; BOTH SRC AND DEST
HOLD RIGHT
Q_[AR]-[BRX] ;NUMBER OF WORDS TO MOVE
[BR]_Q+1 ;LENGTH +1
[BR]_[BR] SWAP, ;COPY TO BOTH HALFS
HOLD RIGHT
[BR]_AC+[BR], ;FINAL AC
INH CRY18 ;KEEP AC CORRECT IF DEST IS 777777
STATE_[BLT],RETURN [2] ;SET PAGE FAIL FLAGS
.DCODE
251: I, J/BLT
.UCODE
1640:
BLT: [BRX]_AC,CALL [SETBLT] ;FETCH THE AC (DEST IN RH)
1642: AC_[BR], ;STORE BACK IN AC
CALL [LOADQ] ;LOAD FIRST WORD INTO Q
1643: [BR]_[ARX]+1000001, ;SRC+1
3T,
HOLD LEFT
[BR]-[BRX], 3T, ;IS THIS THE CORE CLEAR CASE
SKIP ADR.EQ.0
=0
BLTLP1: VMA_[BRX], ;NO, GET DEST ADR
START WRITE, ;START TO STORE NEXT WORD
PXCT BLT DEST, ;WHERE TO STORE
J/BLTGO
;SKIP TO NEXT PAGE IF CLEARING CORE
;CLEAR CORE CASE
VMA_[BRX],
START WRITE,
PXCT BLT DEST
BLTCLR: MEM WRITE, ;STORE WORD
MEM_Q,
SKIP/-1 MS ;1 MS TIMER UP
=0 J/BLTGOT ;GO TAKE INTERRUPT
[BRX]-[AR], ;BELOW E?
3T,
SKIP DP0
=0 END BLT, ;NO--STOP BLT
J/DONE
[ARX]_[ARX]+1, ;FOR PAGE FAIL LOGIC
SKIP IRPT
=0 VMA_[BRX]+1,
LOAD VMA,
PXCT BLT DEST,
START WRITE, ;YES--KEEP STORING
J/BLTCLR
VMA_[BRX]+1, ;INTERRUPT
LOAD VMA,
PXCT BLT DEST,
START WRITE,
J/BLTGO
;HERE FOR NORMAL BLT
BLTLP: MEM READ, ;FETCH
Q_MEM,
J/BLTLP1
BLTGO: MEM WRITE, ;STORE
MEM_Q
BLTGOT: [BRX]-[AR], ;BELOW E?
3T,
SKIP DP0
=0 END BLT, ;NO--STOP BLT
J/DONE
[BRX]_[BRX]+1 ;UPDATE DEST ADDRESS
VMA_[ARX]+1,
LOAD VMA,
PXCT BLT SRC,
START READ, ;YES--MOVE 1 MORE WORD
J/BLTLP
;HERE TO CLEAN UP AFTER BLT PAGE FAILS
BLT-CLEANUP:
[AR]_[AR] SWAP ;PUT SRC IN LEFT HALF
[AR]_WORK[SV.BRX],
HOLD LEFT
AC_[AR], ;STORE THE AC AND RETURN
J/CLEANED
.IF/UBABLT
.TOC "UBABLT - BLT BYTES TO/FROM UNIBUS FORMAT"
;THESE INSTRUCTION MOVE WORDS FROM BYTE TO UNIBUS AND UNIBUS TO BYTE
;FORMAT. FORMATS ARE:
;
;BYTE FORMAT:
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;; BYTE 0 ;; BYTE 1 ;; BYTE 2 ;; BYTE 3 ;; 4 BITS ;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;UNIBUS FORMAT:
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;; 2 BITS ;; BYTE 1 ;; BYTE 0 ;; 2 BITS ;; BYTE 3 ;; BYTE 2 ;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
=0*
BLTX: [BRX]_AC, ;FETCH THE AC (DEST IN RH)
CALL [SETBLT] ;DO THE REST OF THE SETUP
AC_[BR] ;STORE THE FINAL AC IN AC
BLTXLP: MEM READ, ;READ THE SOURCE WORD
Q_MEM, ;FROM MEMORY
B DISP ;SKIP IF BLTUB (OPCODE 717)
=110 Q_Q*.5, ;BLTBU (OPCODE 716) - SHIFT RIGHT 1 BIT
J/BLTBU1 ;CONTINUE INSTRUCTION
AD/D.AND.Q,DBUS/DBM, ;BLTUB - MASK LOW BYTES, SHIFT LEFT
DBM/#,#/377,DEST/AD*2,B/T1 ;AND STORE RESULT
=00 FE_S#,S#/1767, ;-9 MORE BITS TO PUT LOW BYTE OF LH
CALL [T1LSH] ; IN TOP OF LH SHIFT LEFT
=01 FE_S#,S#/1772, ;-6 BITS TO PUT HI BYTE TO RIGHT
CALL [Q_RSH] ; OF LOW BYTE.
=11 Q_Q.AND.#,#/001774 ;KEEP ONLY HI BYTES
=
AD/A.OR.Q,A/T1,DEST/AD, ;MERGE PAIRS OF BYTES. NOW SWAPPED,
B/T1 ;BUT STILL IN HALF-WORDS
AD/57,RSRC/0A,A/T1, ;CLEAR LH OF Q WHILE LOADING
DEST/Q_AD ;RH WITH LOW WORD
Q_Q*2 ;SHIFT LOW WORD ACROSS 1/2 WORD
Q_Q*2 ;AND INTO FINAL POSITION
[T1]_[T1].AND.# CLR RH, ;CLEAR ALL BUT HIGH 16-BIT WORD
#/777774,J/BLTXV ;FROM T1 AND CONTINUE
BLTBU1: Q_Q*.5 ;NOW IN 1/2 WORDS
Q_Q*.5,HOLD LEFT ;INSERT A NULL BIT IN RH
Q_Q*.5,HOLD LEFT ;ONE MORE - NOW IN HALF WORDS
AD/D.AND.Q,DBUS/DBM, ;BUT NOT SWAPPED. COPY RIGHT BYTE
DBM/#,#/377,DEST/AD*2,B/T1 ;TO T1 AND SHIFT LEFT 1 POSITION
=00 FE_S#,S#/1771, ;-7 BITS MORE
CALL [T1LSH] ;TO FINAL RESTING PLACE
=01 FE_S#,S#/1770, ;-8. LEFT BYTES MOVE RIGHT
CALL [Q_RSH] ;TO FINAL RESTING PLACE
=11 Q_Q.AND.#,#/377 ;WANT ONLY THE NEW BYTES
=
BLTXV: Q_[T1].OR.Q, ;MERGE RESULTS
J/BLTXW ;AND STUFF IN MEMORY
T1LSH: [T1]_[T1]*2,SHIFT,RETURN [1]
Q_RSH: Q_Q*.5,SHIFT,RETURN [2]
BLTXW: VMA_[BRX],START WRITE, ;DEST TO VMA
PXCT BLT DEST
MEM WRITE,MEM_Q ;STORE
[BRX]-[AR],3T,SKIP DP0 ;DONE?
=0 END BLT,J/DONE ;YES
[BRX]_[BRX]+1 ;NO, INC DEST
VMA_[ARX]+1,LOAD VMA, ; AND SOURCE (LOADING VMA)
PXCT BLT SRC,START READ,;START UP MEMORY
J/BLTXLP ;AND CONTINUE WITH NEXT WORD
.ENDIF/UBABLT