;
; MICROFLOATMC.MU
; S. MARSHALL
; November 19, 1980 ###
;
#AltoConsts23.MU;DEFINITIONS AND CONSTANTS FOR ALTOS
;
;/* REGISTERS
;///RED ALERT....RED ALERT ///
;/// BEFORE CHANGING ANY REGISTER ASSIGNMENTS CONSULT
;/// THE SACRED TEXTS (SMALL.OPS) SO THAT YE MAY
;/// CONTINUE TO SPEAK THE TRUTH AND LIVE IN HARMONY
;/// WITH THE VIRTUAL MACHINE (I.E. THE NOVACODE KNOWS
;/// THE NUMBERS OF CERTAIN OF THE REGISTERS ALL DULY
;/// NOTED IN AN APPROPRIATELY TITLED SECTION OF SMALL.OPS
;/// AND CHANGES SHOULD BE REFLECTED THERE)
;/// RED ALERT....RED ALRET ///
$AC3$R0;
$NAMES$R0;<LITMSGS,SUBS>
$AC2$R1;
$CYCOUT2$R1;<SUBS,ALLOC>
$AC1$R2;
$AC0$R3;
$ARG1$R3;<ALLOC(LITMSGS,INTN)>**ARGUMENT TO OOZE ROUTINES
$NWW$R4;
$TEMP1$R5;<SUBS,LITMSGS,ALLOC(LITMSGS,INTN)>
$CYRET$R5;
$PC$R6;
$XREG$R7; <PMAP>
$RETN0$R10;<PMAP,
; HASH(IVL,ILNG,REF,SUBS,ALLOC(LITMSGS,INTN),LITMSGS)>
$COREBASE$R14;FIRST CORE LOCATION (MUST BE CLASS CONTEXT)
$PCB$R15;**BYTE PC IN CODE
$MODE$R16;MODE MUST BE A R REG BECAUSE OF BUS=0 TIMING PROBLEM
;AT REFX10:
;MODE=0 IN NORMAL EXECUTION
;MODE=1 WHILE DOING SMASH OPERATION
$AOOP$R17;<LITMSGS,SUBS>OOP OF BASE REGISTER A
$CYCOUT$R35;
;<NEXTBYTE,JMPS,SUBS,LITMSGS,MAPCODE(RETURN),GCLASS(IVAL)>
$RHO$R35;
;<HASH(IVAL,ILONG,REF,SUBS,ALLOC(LITMSGS,INTN),LITMSGS)>
$RESIDUE$R36;
;<HASH(IVAL,ILONG,REF,SUBS,ALLOC(LITMSGS,INTN),LITMSGS)>
;---------------REGS ABOVE ARE VOLATILE W/RESPECT TO NOVA EMULATOR
;
;--------------- BANK 0 REGISTER ASSIGNMENTS
;
$LREG$R40;RAM’S COPY OF LREG
$TEMP2$R41; <REF,ALLOC(LITMSGS,INTN),LITMSGS,ARITHOPS,SUBS>
$TEMP4$R42;<SUBS>
$TEMP3$R43;<ALLOC(LITMSGS,INTN),LITMSGS,ARITHOPS,SUBS,REF>
$NAME$R44; **DOUBLE NAME* <LITMSGS,SUBS>
$CNT$R44; **DOUBLE NAME* <SUBS>
$ROTA$R45;<HASH(IVAL,ILONG,REF,SUBS,LITMSGS,ALLOC(...,INTN))>
$ROT0$R46;<HASH(IVAL,ILONG,REF,SUBS,LITMSGS,ALLOC(...,INTN))>
$ROT1$R47;<HASH(IVAL,ILONG,REF,SUBS,LITMSGS,ALLOC(...,INTN))>
$RPC$R50;<HASH(IVAL,ILONG,REF,SUBS,LITMSGS,ALLOC(...,INTN))>
$RETN1$R51;<GCLASS(IVAL(LITMSGS),SUBS),ILONG(SUBS),REF,ALLOC(...,INTN),REGMAP>
;---------------REGS ABOVE ARE VOLATILE W/RESPECT TO BITBLT
$ACORE$R52;CORE ADDRESS OF BASE REGISTER A
$FATHER$R53;RAM STATE - FATHER (NIL WHEN NOT IN RECUF)
$MINAT$R54;RAM STATE - ATOM BOUND
$PMBASE$R55;RAM STATE - PMAP CORE ADDR
$ROTBASE $R56;RAM STATE - ROT CORE ADDR
;---------------REGS BELOW SAVE STATE ACROSS NOVACALL
$SAVR1$R57;**DOUBLE NAME* <REF,INTN>
$WRAPFL$R57;**DOUBLE NAME* <LITMSGS>
$AREC$R60;ACTIVATION CORE ADDRESS
$SAVPC$R61;
$SAVDISP$R62;
$BCORE$R63;CORE ADDRESS OF BASE REGISTER B
$SAVR0$R64;<HASH(IVAL,ILONG,REF,SUBS,ALLOC(LITMSGS,INTN),LITMSGS)>
;SAVE RETN0 ACROSS FAULTS
$BOOP$R65;OOP OF BASE REGISTER B
$LOCFRAME$R66;**LITERAL VECTOR CORE ADDRESS
$STACKP$R67;**INDEX OF TOP OF STACK
$TOP$R70;OOP ON TOP OF STACK
$CADDR$R71;
$TFRAME$R72;TEMPORARY FRAME CORE ADDRESS
$SELF$R73;ACTIVE INSTANCE CORE ADDRESS
$SUPMOD$R74;-1 EXCEPT WHEN ACCESSING SUPERCLASS
$RETN2$R75;<IVAL(SUBS,LITMSGS),LITMSGS,INTN>
$CTXT$R76;OOP OF CURRENT CONTEXT
$SAVSP$R77;STACK POINTER SAVER
$RAMRETURN$R77;RETURN ADDRESS FOR OTHER RAM BANK CALLS ###
;
;/* CONSTANTS
$RCT1BIT$20;REFCT 1-BIT
$RCT8BIT$200;REFCT 8-BIT
$RCTM1BIT$177760;MINUS REFCT 1-BIT
$ROTMSK$7777;ROT SIZE MASK ###
$ROT0EM$360;ROT EMPTY PATTERN
$ROT0ND$L0,12000,100;CONSTANT 0 IS SUPER-SPECIAL
;ROT0 FOR NEW, NOT CLEAN, REF=1, NOT IMMED (I.E. NO BITS ON)
$CLNMSK$177775;DIRTY MASK - TURNS OFF CLEAN (=2) BIT
$RCTMSK$360;REFCT MASK - MORE IMBEDDED IN REFI/REFD
$HKRMSK$174000;ROT HKR BIT MASK
$RPCBIT$400;LOW BIT OF ROT RPC FIELD FOR INC-IN-PLACE
$IMMBIT$4;IMMEDIATE BIT MASK FOR ROT0
$MSINT$174000;
$OOP00$176000;
$M2001$175777;
$12$12;
$500$500;
$RESRPC$177400;ROT HKR-RPC BIT MASK
$ROTABASEM1$177777;RAM BASE FOR BASEREG ROTA
$OOPBASEM1$1777;RAM BASE FOR BASEREG OOP
$CPTMSK$100;MASK FOR IS-POINTER IN PMAP
$ISCMSK$37;MASK FOR INSTANCE SIZE IN PMAP
$RCIMSK$177600;REAL CLASS PART OF PMAP
$SENDERF$L0,12000,100;CONSTANT 0 IS SUPER-SPECIAL;
$INSTF$1;
$CODEF$3;
$TFRAMEF$4;***WARNING BEFORE CHANGING SEE PUTX4 IN LITMSGS
$PCF$5;***WARNING PCF AND STACKPF MUST BE TOGETHER
$STACKPF$6;***WARNING PCF AND STACKPF MUST BE TOGETHER
$PMRETI$L0,12000,100;CONSTANT 0 IS SUPER-SPECIAL;
$HFRETI$1;
$EIRETI$2;
$IJRETI$3;
$CASCME$177774;
;(CoreAddressofSmalltalkConstantsMinusEight = 4-8 =-4)
$OCTV$24;ISC OF FIRST OCTAVE
$VARCLS$600;OOP WHERE VAR-LEN CLASSES START
$NUMCLS$4;NUMBER CLASS OOP
$OBJCLS$27;NIL CLASS OOP
$FLOATCLS$5;FLOATING-POINT CLASS
$TYPEF$7;INDEX OF TYPE FIELD
$SPRCLSF$5;INDEX OF SUPERCLASS FIELD
$MDICTF$3;INDEX OF MESSAGE DICTIONARY
$SIZEF$2;INDEX OF INSTANCE SIZE
$CLFREE$10;OFFSET OF FREELISTHEAD IN CLASSES
$CLFREE2$21;CLFREE OF SECOND CLASS
$CLFREE3MT$31;CLFREE OF THIRD CLASS MINUS TWO
$STMCLS$10;
$CNTXCLS$2;OOP OF CLASS CONTEXT (NOTE: SEE "BYTE:")
$INTCLS$12;
$VECCLS$600;
$STRCLS$601;
$FALSEOOP$2000;
$TRUEOOP$2001;
$ERRPRG$3;ADDRESS OF OOP OF ERROR METHOD
$PRIMTABLOC$100;
$SELFLOC$101;
;
$EXPMSK$177776;
$RAMXEVEN$177776;
$RAMXODD$177777;
$177770$177770;
;
;/* GLOBAL LABEL ALLIGNMENTS */
;********BASE ADDRESS FOR BANK SWITCHING********
!200,1,X200;
;
;********RETURNS FROM NOVA********
;!1767,10,OVRET,FIRET,FLTRET,ALLOCRET,PRIMFAIL,SNDMSG,SUPRET,PRIMRET; ###
!1767,10,,,,,PRIMFAIL,,,PRIMRET; ###
; AT TOP OF MEMORY SO RAM1, RAM2 CAN GET TO PRIMFAIL AND PRIMRET ###
;
;********FIX USEFUL ENTRY POINTS SO RAM1, RAM2 CAN JUMP TO THEM ###
;********HASH AND REFLAST MUST BE ODD ###
;!1757,10,REFCK,REFCKL,REF,REFLAST,NOVAALLOC,,HASHL,HASH; ###
!1757,10,,,REF,,NOVAALLOC,,HASHL,HASH; ###
;
;********LABELS AND CONSTANTS FOR RAM SWITCHING SUBROUTINE CALLS
!607,10,RAMX0,RAMX1,RAMX2,RAMX3,RAMX4,RAMX5,RAMX6,RAMX7;
!617,10,RAMX10,RAMX11,RAMX12,,,,,;
;
$RAMRET0$600;
$RAMRET1$601;
$RAMRET2$602;
$RAMRET3$603;
$RAMRET4$604;
$RAMRET5$605;
$RAMRET6$606;
$RAMRET7$607;
$RAMRET10$610;
$RAMRET12$612;
;
;********ENTRY POINTS FOR RAM1 IMPLEMENTED SMALLTALK PRIMITIVES********
;********THESE ARE PRIMITIVES -01400 TO -01367********
;********WATCH THE X200 DISPATCH IN BYTERP********
!717,20,PLUS,MINUS,TIMES,OVER,LT,EQ,GT,LE,NE,GE,NEW,VNEW,,,,;
;
;********RETURNS FOR PMAP********
!1,2,PMAPX0,PMAPX1;
;
;********RETURNS FOR GCLASS********
!1,2,GCLASSX0,GCLASSX1;
;
;********RETURNS FOR SETUP********
!7,10,SETUPX0,SETUPX1,SETUPX2,SETUPX3,SETUPX4,,,;
;
; Copyright Xerox Corporation 1979

;Last bug fix by Lyle Ramshaw, changed low order mantissa compare
; in FCM from signed to unsigned -- November 26, 1979


;REGISTERS USED BY NOVA EMULATOR

$M1$R10;
$N1$R16;
$M2$R35;
$N2$R36;


$Temp$R42;
$CRY$R43;

$ShiftCount$R45;
$ANSADDR$R46;
$ANSOOP$R41;
$SubRet$R47;
$E1X$R3;
$E2X$R2;

$M1A$R60;
$N1A$R61;
$M2A$R62;
$N2A$R63;
$E1$R64;
$E2$R65;
$COMPREG$R66;

;REGISTERS USED IN BANK 0

$RTMP1$R57;

;
;
;
;IVAL- ARG1:OOP L:RETN
;L←VALUE OF NUMBER
;PRESERVES ARG1
;
!1,2,NOTSI,MBSI;
!1,2,ISSI,NONINT;
!1,2,NOTNMBR,ISNMBR;
IVALL:ARG1← L, L← T, TASK;
IVAL:RETN2← L;(TASK HAPPENS HERE)
T← MSINT;
L← ARG1-T;
L← ARG1+1, ALUCY;TEST >= MIN SMALL INTEGER
T← OOP00, SH=0, :NOTSI;TEST FOR NIL IF SO
MBSI:L← ARG1-T, :ISSI;
ISSI:NOP;
SINK← RETN2, BUS;
L← T← LREG, :IVALX0;
NONINT:L← ONE, TASK, :GCLASS;
NOTSI:L← ONE, TASK, :GCLASS;
GCLASSX1:L← NUMCLS-T;TEST FOR CLASS = NUMBER
T← 11, SH=0;
L← RETN2-T, :NOTNMBR;
ISNMBR:L← RAMRET10 + 1;HASH INTO ROT
RAMRETURN ← L, SWMODE, :HASH;
;// HASH LARGE INTEGER. NO DIRTY //
RAMX11:L← ROT1, TASK, :ISSI;
NOTNMBR:SWMODE, :PRIMFAIL;
;
;
;
;GCLASS- ARG1:OOP L:RETN
;L←OOP’S CLASS
;PRESERVES ARG1
!1,2,PMAP,GCNIL;
GCLASSL:ARG1← L, L← T, TASK;
GCLASS:RETN1← L;(TASK HAPPENS HERE)
DOGC:L← ARG1+1;
T← ARG1, SH=0;TEST FOR NIL
L← ONE, :PMAP;
PMAPX1:T← RCIMSK;
L← T← MD.T;EXTRACT RCI
CYCOUT← L MLSH 1;
L← CYCOUT, TASK;
CYCOUT← L LCY 8;
FIN:SINK← RETN1, BUS;
L← T← CYCOUT, :GCLASSX0;
GCNIL:L← OBJCLS, TASK;
CYCOUT← L, :FIN;
;
;
;PMAP- T:OOP L:RETN
;RETURNS AFTER MAR← PMAP ENTRY ADDRESS
;
PMAP:RETN0← L, L← T;
XREG← L LCY 8;
L← T← XREG, TASK;
XREG← L MLSH 1;
L← T← XREG, TASK;
XREG← L MLSH 1;
T← 1777-1;1776
T← XREG.T, TASK;
L← PMBASE+T;
SINK← RETN0, BUS;
PMAPX0:MAR← LREG, :PMAPX0;INDEX THE PCLASS MAP (DUMMY LABEL)
;
;
;NOVA ALLOCATE - NEEDS OOP OF CLASS IN AC0 AND LENGTH IN AC1
;L ← NEW OOP
;T ← CORE ADDRESS OF NEW OOP
;
;
;ALLOCL:RAMRETURN ← L; SAVE RETURN ADDRESS
;L ← 3, SWMODE; 3 IS RAM RETURN ADDRESS FOR ALLOCATE
;NOVAALLOC:RETN1 ← L, L ← T, :NOVAALLOC; SET RETURN ADDRESS, L ← OOP OF CLASS TO ALLOCATE IN
;

!1,2,AOK1,AFAIL1;
!1,2,AOK2,AFAIL2;

ALLOCL: RTMP1 ← L, L ← T, TASK; SAVE RETURN
ARG1 ← L; SAVE CLASS
L ← RAMRET3;
HASHD:RAMRETURN ← L, SWMODE; HASH - DIRTY
L ← RAMXODD, TASK, :HASH; DIRTY CALL
RAMX3:MAR ← CLFREE + T; ACCESS FREE LIST POINTER
ACORE ← L; SAVE CORE ADDRESS OF CLASS
L ← ARG1; OOP OF CLASS
AOOP ← L; AND PUT CLASS IN BASE REGISTER
L ← MD + 1; CHECK FOR NIL
L ← LREG - 1, SH=0, TASK;
ARG1 ← L, :AOK1; [AOK1, AFAIL1] OOP OF FREE ELEMENT
AFAIL1: L ← RTMP1, TASK, :ALLOCN; HAVE TO CALL THE NOVA
AOK1:L ← RAMRET4, :HASHD; HASH - DIRTY
;// HASH FREE LIST HEAD. DIRTY //
RAMX4:MAR ← T; GET OOP OF NEXT FREE ELEMENT
AC1 ← L; SAVE CORE ADDRESS OF NEW OOP
L ← MD + 1; CHECK FOR NIL
L ← LREG - 1, SH = 0;
T ← ACORE, :AOK2; [AOK2, AFAIL2] CORE ADDRESS OF CLASS
AFAIL2: L ← RTMP1, TASK, :ALLOCN; HAVE TO CALL THE NOVA
AOK2:MAR ← CLFREE + T; FREE LIST POINTER
T← RESRPC;T: MASK FOR RES AND REPROBE COUNT
T← IMMBIT OR T;T: MASK FOR IMM BIT, RES AND RPC
MD ← LREG; NEW FREE LIST POINTER
MAR← ROTA;
T← ROT0.T;T: IMMEDIATE BIT, RES AND RPC
L← ROT0ND OR T, TASK;
MD← LREG;
T ← AC1; CORE ADDRESS OF NEW OOP
SINK ← RTMP1, BUS; RETURN
X200:L ← ARG1, :X200; WITH OOP IN L AND ADDR IN T



ALLOCN:RAMRETURN ← L; SAVE RETURN ADDRESS
T ← AOOP; CLASS TO ALLOCATE IN
L ← RAMXODD, SWMODE; SET RETURN FOR ALLOCATE
NOVAALLOC:RETN1 ← L, L ← T, :NOVAALLOC; SET RETURN ADDRESS, L ← OOP OF CLASS TO ALLOCATE IN

!1,2,AOK3,AFAIL3;
!1,2,AOK4,AFAIL4;
!1,2,TOOBIG,SIZEOK;
!1,2,NILOUT,NILDONE;
!1,2,WORDS,BYTES;

VNEW:L ← TOP, TASK; CLASS OF OBJECT TO ALLOCATE
ARG1 ← L; ARG FOR HASH
L ← RAMRET12, :HASHD;
RAMX12:T ← STACKP - 1; RELATIVE ADDRESS OF ARGUMENT (LENGTH)
MAR ← TFRAME + T; FETCH INSTANCE SIZE REQUESTED
ACORE ← L; SAVE CORE ADDRESS OF CLASS
L ← ARG1; OOP OF CLASS
AOOP ← L; AND PUT CLASS IN BASE REGISTER
L ← MD; OOP OF SIZE REQUESTED
T ← 0, :IVALL; TURN OOP INTO INTEGER
IVALX0:L ← 10 + T, TASK; GET FREE LIST OFFSET
RETN2 ← L; AND SAVE FREE LIST OFFSET
T ← 21; CANT DO OCTIVE SIZES
L ← RETN2 - T, T ← RETN2; SIZE OF NEW OBJECT + 8 IN T
L ← 177770 + T, SH<0; CONVERT TO INTEGER SIZE REQUESTED
TOP ← L, :TOOBIG; [TOOBIG, SIZEOK]

NEW:L ← CLFREE, TASK; OFFSET OF FREE LIST
RETN2 ← L; SAVE FOR ALLOCATING
L ← TOP, TASK; CLASS OF OBJECT TO ALLOCATE
ARG1 ← L; ARG FOR HASH
L ← RAMRET6, :HASHD;
RAMX6:MAR ← SIZEF + T; FETCH INSTANCE SIZE
ACORE ← L; SAVE CORE ADDRESS OF CLASS
L ← ARG1; OOP OF CLASS
AOOP ← L; AND PUT CLASS IN BASE REGISTER
T ← OOP00;
T ← 23+T+1; CANT DO OCTIVE SIZES
L ← MD - T, T ← MD; SIZE OF NEW OBJECT IN T
L ← 2000 + T, SH<0; CONVERT TO INTEGER
TOP ← L, :TOOBIG; [TOOBIG, SIZEOK]
TOOBIG: :AFAIL3;
SIZEOK:T ← ACORE; ADDRESS OF CLASS
MAR ← RETN2 + T; ACCESS FREE LIST POINTER
NOP;
L ← MD + 1; CHECK FOR NIL
L ← LREG - 1, SH=0, TASK;
ARG1 ← L, :AOK3; [AOK3, AFAIL3] OOP OF FREE ELEMENT
AFAIL3: :AFAIL4; HAVE TO CALL THE NOVA
AOK3:L ← RAMRET7, :HASHD; HASH - DIRTY
;// HASH FREE LIST HEAD. DIRTY //
RAMX7:MAR ← T, AC1 ← L; GET OOP OF NEXT FREE ELEMENT AND SAVE CORE ADDRESS
NOP;
L ← MD + 1; CHECK FOR NIL
L ← LREG - 1, SH = 0;
T ← ACORE, :AOK4; [AOK4, AFAIL4] CORE ADDRESS OF CLASS
AFAIL4: T ← 10;
L ← RETN2 - T, TASK; CORRECT LENGTH TO REQUEST
RETN2 ← L;
L ← RAMRET10, TASK, :ALLOCN; HAVE TO CALL THE NOVA
AOK4:MAR ← RETN2 + T; FREE LIST POINTER
T← RESRPC;T: MASK FOR RES AND REPROBE COUNT
T← IMMBIT OR T;T: MASK FOR IMM BIT, RES AND RPC
MD ← LREG; NEW FREE LIST POINTER
MAR← ROTA;
T← ROT0.T;T: IMMEDIATE BIT, RES AND RPC
L← ROT0ND OR T, TASK;
MD← LREG; SET REFCT, DIRTY, NEW
T ← ACORE; ADDRESS OF CLASS
MAR ← TYPEF + T; FETCH TYPE FIELD
T ← 20; WBY (WORD/BYTES) MASK
L ← MD AND T; ZERO IF BYTES ELSE WORDS
L ← TOP + 1, SH=0, TASK; GET WORDS * 2 IF BYTES
AC2 ← L RSH 1, :WORDS; [WORDS,BYTES] WORDS IN AC2 IF BYTES
BYTES:L ← AC2, BUS = 0, TASK; MOVE TO TOP
TOP ← L, :NILOUT;
WORDS:SINK ← TOP, BUS = 0, TASK; CHECK IF LENGTH IS ZERO
:NILOUT;
NILOUT:T ← TOP - 1; DECREMENT LENGTH COUNTER
MAR ← AC1 + T; NEXT WORD OF NEW OBJECT TO STORE INTO
L ← T;
TOP ← L, SH = 0, TASK; END CHECK
MD ← ALLONES, :NILOUT; LOOP IF NOT DONE
NILDONE:SWMODE; RETURN WITH OOP OF NEW OBJECT IN AC0 = ARG1
:PRIMRET; RETURN WITH OOP OF NEW OBJECT IN AC0 = ARG1

RAMX10:SWMODE, :PRIMRET; RETURN WITH OOP OF NEW OBJECT IN L

;
;
;---------------------------------------------------------------
;Floating-point setup routine
;checks class of arg and fails if not FP
;loads arg into registers
;loads self into registers
;allocates a new FP number (only done if return is not zero)
;returns
;---------------------------------------------------------------

!1,2,ARGFAIL,ARGOK;
!1,2,SETUPA,SETUPX;
!7,10,LOADX0,LOADX1,LOADX2,LOADX3,LOADX4,LOADX5,,;

SETUP:RETN2 ← L; SAVE RETURN
T ← STACKP-1; GET POINTER TO SECOND FROM TOP OF STACK (ARG)
MAR ← TFRAME + T; FETCH ARG OOP
T ← 0; SET RETURN
L ← MD, :GCLASSL; GET CLASS OF ARG
GCLASSX0: L ← FLOATCLS XOR T; COMPARE WITH OOP OF FLOAT CLASS
L ← RAMRET0, SH=0;
RAMRETURN ← L, :ARGFAIL;
ARGFAIL: :FAIL;
ARGOK:SWMODE, :HASH; CALL HASH IN RAM0
HASH:L ← RAMXEVEN, TASK, :HASH; HASH - NO DIRTY
RAMX0:AC3 ← L; SAVE CORE ADDRESS
ESRB ← 2; CHANGE S REGISTER BANK
T ← 0, :LOAD; GET EXPONENT
LOADX0:E2 ← L;
T ← ONE, :LOAD; GET HIGH MANTISSA
LOADX1:M2A ← L;
T ← 2, :LOAD; GET LOW MANTISSA
LOADX2: N2A ← L;
ESRB ← 0; SMALLTALK REGISTER BANK
L ← RAMRET1, TASK;
RAMRETURN ← L;
L ← TOP, SWMODE; GET CLASS OF ARG
HASHL:T ← RAMXEVEN, :HASHL; (LABEL USED ONLY IN RAM0)
RAMX1: AC3 ← L; SAVE CORE ADDRESS
ESRB ← 2; CHANGE S REGISTER BANK
T ← 3, :LOAD; GET EXPONENT
LOADX3:E1 ← L;
T ← 4, :LOAD; GET HIGH MANTISSA
LOADX4:M1A ← L;
T ← 5, :LOAD; GET LOW MANTISSA
LOADX5: N1A ← L;
ESRB ← 0; SMALLTALK REGISTER BANK
NOP;WAIT FOR 3K CRAM CARD
SINK ← RETN2,BUS=0, TASK; CHECK IF ALLOCATING FOR RESULT
:SETUPA;
SETUPA:T ← FLOATCLS; ALLOCATE ANSWER FLOATING-POINT NUMBER
L ← RAMRET2, :ALLOCL; DO ALLOCATION
RAMX2:ESRB ← 2; CHANGE TO FP BANK
NOP; WAIT FOR 3K CRAM CARD;
ANSOOP ← L, L ← T; STORE NEW FLOAT OOP
ANSADDR ← L; SAVE ADDRESS TO STORE ANSWER
SETUPX:ESRB ← 2; CHANGE S REGISTER BANK
NOP;WAIT FOR 3K CRAM CARD
L ← M1A, TASK; MOVE TO R REGISTERS
M1 ← L; FOR SHIFTING
L ← N1A, TASK; MOVE TO R REGISTERS
N1 ← L; FOR SHIFTING
L ← M2A, TASK; MOVE TO R REGISTERS
M2 ← L; FOR SHIFTING
L ← N2A, TASK; MOVE TO R REGISTERS
N2 ← L; FOR SHIFTING
ESRB ← 0; WHERE RETURN ADDRESS IS STORED
NOP;WAIT FOR 3K CRAM CARD
L ← RETN2;
ESRB ← 2; CHANGE S REGISTER BANK
SINK ← LREG, BUS, TASK;
:SETUPX0; RETURN TO SPECIFIC ROUTINE


LOAD:MAR ← AC3; FETCH WORD FROM MEMORY
L ← AC3 + 1; INCREMENT MEMORY POINTER FOR NEXT TIME
AC3 ← L, L ← T; MOVE RETURN ADDRESS
SINK ← LREG, BUS; DISPATCH ON RETURN NUMBER
L ← MD, TASK, :LOADX0; FETCH WORD TO L AND RETURN ***TASK PENDING***
;
;---------------------------------------------------------------
;multiply subroutine
;---------------------------------------------------------------


!7,10,MulRet,MulRet1,MulRet2,MulRet3;
!1,2,DOMUL,NOMUL;
!1,2,MPYL,MPYA;
!1,2,NOADDIER,ADDIER;
!1,2,NOSPILL,SPILL;
!1,2,NOADDX,ADDX;
!1,2,NOSPILLX,SPILLX;

MUL:SubRet←L;
L←AC2-1, BUS=0;
MPYX:XREG←L,L←0,:DOMUL;
DOMUL:TASK,L←-10+1;
AC3←L;
MPYL:L←AC1,BUSODD;
T←AC0,:NOADDIER;
NOADDIER:AC1←L MRSH 1,L←T,T←0,:NOSPILL;
ADDIER:L←T←XREG+INCT;
L←AC1,ALUCY,:NOADDIER;
SPILL:T←ONE;
NOSPILL:AC0←L MRSH 1;
L←AC1,BUSODD;
T←AC0,:NOADDX;
NOADDX:AC1←L MRSH 1,L←T,T←0,:NOSPILLX;
ADDX:L←T←XREG+INCT;
L←AC1,ALUCY,:NOADDX;
SPILLX:T←ONE;
NOSPILLX:AC0←L MRSH 1;
L←AC3+1,BUS=0,TASK;
AC3←L,:MPYL;
NOMUL:T←AC0;
AC0←L,L←T,TASK;
AC1←L;
MPYA: SINK←SubRet,BUS;
NOP,:MulRet;

;---------------------------------------------------------------
;divide subroutine
;---------------------------------------------------------------

!7,10,DivRet,DivRet1,DivRet2;
!1,2,DODIV,NODIV;
!1,2,DIVL,ENDDIV;
!1,2,NOOVF,OVF;
!1,2,DX0,DX1;
!1,2,NOSUB,DOSUB;

DIV:SubRet←L;
T←AC2;
DIVX:L←AC0-T;Do the divide only if AC2>AC0
ALUCY,TASK,AC3←L,L←0+1;
:DODIV,AC3←L LSH 1;AC3←2, count the loop by shifting
NODIV:SINK←SubRet,BUS;
DRET:NOP,:DivRet;
DODIV:L←AC0,:DIV1;
DIVL:L←AC0;
DIV1:SH<0,T←AC1;will the left shift of the dividend overflow?
:NOOVF,AC0←L MLSH 1,L←T←0+T;L←AC1,T←0
OVF:AC1←L LSH 1,L←0+INCT,:NOV1;L←1: shift overflowed
NOOVF:AC1←L LSH 1,L←T;L←0: shift ok
NOV1:T←AC2,SH=0;
L←AC0-T,:DX0;
DX1:ALUCY;do the test only if the shift didn’t overflow. If it did, L is still correct
T←AC1,:NOSUB;but the test would go the wrong way
DX0:T←AC1,:DOSUB;
DOSUB:AC0←L,L←0+INCT;do the subtract
AC1←L;and put a 1 in the quotient
NOSUB:L←AC3,BUS=0,TASK;
AC3←L LSH 1,:DIVL;
ENDDIV:SINK←SubRet,BUS,:DRET;

;---------------------------------------------------------------
;FLOATING COMPARE RETURNS TRUE OR FALSE (NEVER RETURNS SELF)
;---------------------------------------------------------------
LT:L ← 4, :COMPARE; <
EQ:L ← 2, :COMPARE; =
GT:L ← ONE, :COMPARE; >
LE:L ← 6, :COMPARE; <=
NE:L ← 5, :COMPARE; #
GE:L ← 3, :COMPARE; >=

COMPARE:ESRB ← 2; SET OUR REGISTER BANK
NOP; WAIT FOR 3K CRAM CARD
COMPREG ← L; SAVE COMPARISON DESIRED
ESRB ← 0, L ← 0; RESET BANK REGISTER AND GO SETUP ARGUMENTS
TASK, :SETUP; WAIT FOR 3K CRAM CARD

!1,2,BOTHNZ,ONEZ;
!1,2,POS1,NEG1;
!1,2,POS1POS2,POS1NEG2;
!1,2,NEG1POS2,NEG1NEG2;
!1,2,POSNE,POSEQ;
!1,2,NEGNE,NEGEQ;
!1,2,POSGE,POSLT;
!1,2,NEGGE,NEGLT;
!1,2,POSMNE,POSMEQ;
!1,2,NEGMNE,NEGMEQ;
!1,2,POSNNE,POSNEQ;
!1,2,NEGNNE,NEGNEQ;
!1,2,M1NZ,M1Z;
!1,2,M1ZM2NZ,M1ZM2Z;
!1,2,TRUERET,FALSERET;
!1,1,POSMCOMP;
!1,1,NEGMCOMP;
!1,1,ENDCOMP;
!1,1,ONEZ1;
!1,1,M1NZM2X;
!1,1,POSMEQ1;
!1,1,NEGMEQ1;

; NOTE - EXPONENT COMPARE FAILS FOR VERY LARGE DIFFERENCES (NOT TRUE SIGNED COMPARE)

SETUPX0:T ← M1; TEST FOR EITHER ARGUMENT ZERO
L ← M2 AND T; NONZERO RESULT IF BOTH NONZERO
SH=0;
T ← E1, BUSODD, :BOTHNZ; CHECK SIGN OF ARG1
BOTHNZ:L←E2 - T,BUSODD, :POS1; CHECK SIGN OF ARG2
POS1:SH=0, :POS1POS2; COMPARE EXPONENTS
NEG1:SH=0, :NEG1POS2; COMPARE EXPONENTS

POS1NEG2:T ← ONE, :ENDCOMP; ARG1 (SELF) > ARG2
NEG1POS2:T ← 4, :ENDCOMP; ARG1 (SELF) < ARG2
POS1POS2:T ← M1, SH<0, :POSNE; SEE IF EXPONENTS EQUAL
NEG1NEG2:T ← M1, SH<0, :NEGNE; SEE IF EXPONENTS EQUAL

POSNE::POSGE; ARG1 (SELF) < ARG2
NEGNE::NEGGE; ARG1 (SELF) > ARG2
POSEQ:L ← M2 - T, :POSMCOMP; COMPARE M
NEGEQ:L ← M2 - T, :NEGMCOMP; COMPARE M

POSMCOMP:SH=0; SEE IF THE SAME
T ← N1, ALUCY, :POSMNE;
POSMNE::NEGGE; M NOT EQUAL SO CHECK IF ARGS + OR -
POSMEQ:L ← N2 - T; COMPARE N’S
POSMEQ1:SH=0; SEE IF THE SAME
ALUCY, :POSNNE;
POSNNE::NEGGE;
POSNEQ:T ← 2, :ENDCOMP; EQUAL!

NEGMCOMP:SH=0; SEE IF THE SAME
T ← N1, ALUCY, :NEGMNE;
NEGMNE::POSGE; M NOT EQUAL SO CHECK IF ARGS + OR -
NEGMEQ:L ← N2 - T; COMPARE N’S
NEGMEQ1:SH=0; SEE IF THE SAME
ALUCY, :NEGNNE;
NEGNNE::POSGE;
NEGNEQ:T ← 2, :ENDCOMP; EQUAL!

ONEZ:SINK ← M1, BUS=0, :ONEZ1; SEE IF FIRST ARG IS ZERO
ONEZ1:SINK ← M2, BUS=0, :M1NZ; SEE IF SECOND ARG IS ZERO

M1Z:SINK ← E2, BUSODD, :M1ZM2NZ; HERE IF ARG1 = 0
M1NZ:SINK ← E1, BUSODD, :M1NZM2X; HERE IF ARG1 NOT 0

M1ZM2Z:T ← 2, :ENDCOMP; HERE IF BOTH ZERO
M1ZM2NZ::POSGE; HERE IF ARG1 = 0, ARG 2 NOT 0

M1NZM2X::NEGGE; HERE IF ARG1 NOT 0, ARG 2 (ASSUMED) = 0

NEGGE:T ← ONE, :ENDCOMP; ARG1 (SELF) > ARG2
NEGLT:T ← 4, :ENDCOMP; ARG1 (SELF) < ARG2
POSGE:T ← 4, :ENDCOMP; ARG1 (SELF) < ARG2
POSLT:T ← ONE, :ENDCOMP; ARG1 (SELF) > ARG2

ENDCOMP: L ← COMPREG AND T; SEE WHAT TO TEST FOR
SH=0, TASK;
:TRUERET;
TRUERET: L ← TRUEOOP, SWMODE, :PRIMRET; RETURN TRUE
FALSERET: L ← FALSEOOP, SWMODE, :PRIMRET; RETURN FALSE

;---------------------------------------------------------------
;FMP floating point multiply
;---------------------------------------------------------------

!1,2,FMPNonZero,FMPZero;
!1,2,FMPNonZero1,FMPZero1;
!1,2,LowNonZero1,LowZero1;
!1,2,MEVEN,MODD;
!1,2,MSOV,MSNOV;

TIMES: L←3, TASK,:SETUP;

;add exponents, like in any multiply
SETUPX3:T←E1;
L←E2+T, BUSODD, TASK;
E1←L, :MEVEN;
MODD:T ← E1, BUSODD; CHECK IF ADDITION OF SIGNS CARRIED OUT TO EXPONENT
L ← -2 + T, TASK, :MSOV; MULTIPLY SIGN OVERFLOW
MSOV:E1 ← L, :MEVEN; CORRECT EXPONENT FOR SIGN CARRY
MSNOV:NOP;

;first multiply: high*low
MEVEN:L←M1;
AC1←L,SH=0;
L←N2,:FMPNonZero;
FMPZero:L←0,:LowZero1;return 0
FMPNonZero:AC2←L,L←0;
AC0←L,:MUL;L must be 0 for SubRet
MulRet: L←AC0,TASK;
Temp←L;

;second multiply: other high*other low
L←M2;
AC1←L,SH=0;
L←N1,:FMPNonZero1;
FMPZero1:L←0,:LowZero1;
FMPNonZero1:AC2←L,L←0;
AC0←L,L←0+1,:MUL;L must have 1 for Subroutine Return
MulRet1: T←AC0;

!1,2,NoCarry,Carry;

;add results, set carry if overflow
L←Temp+T;
AC0←L,ALUCY;
L←0,:NoCarry;
Carry:L←ONE;
NoCarry:CRY←L;

!1,2,Carry1,NoCarry1;

;last multiply: high*high (plus stuff left in AC0)
L←M1,TASK;
AC1←L;
L←M2;
AC2←L;
L←2,:MUL;
MulRet2: SINK←CRY,BUS=0;
L←AC0,:Carry1;!1,2,Carry1,NoCarry1
Carry1:L←AC0+1;low+low resulted in a carry, add it now
NoCarry1:M1←L,SH<0;now, check normalization

!1,2,Normalize,NoNormalize;

T←AC1,:Normalize;7 instructions since last TASK
Normalize:M1←L MLSH 1;8
L←AC1;9
N1←L LSH 1;10
L←E1-1;decrement exponent to account for shift
L ← LREG - 1,TASK; -2 TO LEAVE SIGN UNCHANGED
E1←L,:STORE;

NoNormalize:L←AC1,TASK;
N1←L,:STORE;

;---------------------------------------------------------------
;FDV floating point divide
;---------------------------------------------------------------

OVER: L←4, TASK,:SETUP;

!1,2,DivOK,DivErr;
!1,2,DivOK1,DIV0;
!1,2,DEVEN,DODD;
!1,2,DSNB,DSB;


SETUPX4: SINK←M2,BUS=0;
NOP,:DivOK;

DivErr::DIVFAIL;

;first, subtract exponents
DivOK:T←E2;
L←E1-T, BUSODD, TASK;
E1←L, :DEVEN;

DEVEN:T ← E1, BUSODD; CHECK IF SUBTRACTION OF SIGNS BORROWED FROM EXPONENT
L ← 2 + T, TASK, :DSNB; DIVIDE SIGN BORROW
DSB:E1 ← L, :DODD; CORRECT EXPONENT FOR BORROW
DSNB:NOP;

;first, (M1,N1)/M2
DODD:L←T←M1,BUS=0;check for zero dividend
AC0←L,:DivOK1;
DIV0:E1 ← L,TASK,:STORE;dividend is already 0, just return
DivOK1:L←ALLONES XOR T,TASK;NOT AC0
Temp←L;
L←N1,TASK;
AC1←L;
L←T←M2;
AC2←L;

;unsigned test for AC0<AC2: ADCZ# 0,2,SZC
L←Temp+T;(NOT AC0)+AC2
NOP,ALUCY;

!1,2,DivC,D0;

L←T←AC0,:DivC;
DivC:AC0←L RSH 1;divide dividend by two (rshift)
L←AC1;
AC1←L MRSH 1;
L←E1+1;bump exponent
L ← LREG + 1; +2 TO LEAVE SIGN UNCHANGED
E1←L;
D0:L←0,:DIV;
DivRet:L←AC1;
M1←L,L←0;save high order results
AC1←L,L←0+1,:DIV;now AC0,1 have remainder,0
DivRet1:L←AC1;
N1←L,L←0,TASK;save low order result

;now, answer is "too big" because low order bits of divisor were not included.
;so, we form correction term (N2/M2)*HighAnswer
AC0←L;
L←N2,TASK;
AC1←L;low order divisor
L←M1,TASK;
AC2←L;high order answer so far
L←3,:MUL;(N2*M1)
MulRet3:T←AC0;
L←ALLONES XOR T;NOT AC0;
T←M2;ADCZ# 0,2,SZCcheck for divide overflow
L←LREG+T;JMP D2divide won’t overflow
L←M2,ALUCY;

!1,2,DivC2,D2;
AC2←L,:DivC2;
DivC2:L←M1-1,TASK;decrement high order part of answer (because correction is to low order part)
M1←L;
T←M2;and subtract "one" from dividend
L←AC0-T,TASK;
AC0←L;
D2:L←2,:DIV;(N2*M1)/M2
DivRet2:T←AC1;
L←N1-T;(uncorrected low order result)-(second correction)
AC0←L,ALUCY;5if zero carry, then decrease high order part too

!1,2,Dec,NoDec;
!1,2,Norm,D1;

L←M1,:Dec;6
Dec:L←M1-1;7
M1←L;8
NoDec:NOP,SH<0;9get high order part of answer (could be unnormalized from either DSZ above)
T←AC0,:Norm;10!1,2,Norm,D1;
Norm:M1←L MLSH 1;11
L←E1-1;decrement exponent to account for shift
L ← LREG - 1,TASK; -2 BECAUSE OF SIGN
E1←L;
L←AC0,TASK;
N1←L LSH 1,:STORE;

D1:L←AC0,TASK;
N1←L,:STORE;

;----------------------------------------------------
;floating point add and subtract
;----------------------------------------------------

PLUS:L←ONE, TASK, :SETUP;
MINUS:L←2, TASK, :SETUP;
SETUPX2:T ← ONE; CHANGE SIGN AND ADD
L ← E2 XOR T, TASK;
E2 ← L;
;
SETUPX1:T ← 100000; OFFSET FOR EXPONENTS IN THIS ROUTINE
L ← E1 + T; OFFSET FIRST EXPONENT
E1X ← L RSH 1; GET OFFSET EXPONENT
L ← E2 + T, TASK; OFFSET SECOND EXPONENT
E2X ← L RSH 1; GET OFFSET EXPONENT

;Preshift arguments until they match
T←M1;mantissa zero check
L←M2 AND T;
SINK←LREG,BUS=0;

!1,2,Sh,NoShz;

T←E1X,:Sh;
Sh:L←E2X-T;if exponents are the same, no shift either
SINK←LREG,BUS=0;

!1,2,Sh1,NoSh;
!1,2,E1lsE2,E1grE2;
ShiftCount←L,:Sh1;
Sh1:TASK,SH<0;

NOP,:E1lsE2;

E1lsE2:T ← EXPMSK;E1 ← E2 WITH SIGN PRESERVED
L ← E2 AND T;we’ll shift until exponent matches E2
T ← 0 + 1; GET A ONE
T ← E1.T; GET SIGN
L ← LREG OR T; PUT E1 SIGN WITH E2 VALUE
E1 ← L; AND STORE
T←ShiftCount;
L←37-T;
TASK,SH<0;37 is max number of shifts, if SH ge 0 then fix

!1,2,NoFix,Fix;
!1,2,More,Shifted;

NOP,:NoFix;
NoFix:L←T←M1;
More:M1←L RSH 1;
L←N1,TASK;
N1←L MRSH 1;
NOP;ALU←SReg after TASK;
L←ShiftCount-1;
ShiftCount←L,SH=0;
L←T←M1,:More;

Fix:L←0;set both words of mantissa1 to 0
M1←L,TASK;
N1←L,:EndShift;

Shifted:NOP,:EndShift;
NoSh:NOP,:EndShift;

!1,2,ExpOK,ExpWrite;

NoShz:SINK←M1,BUS=0;if first arg is zero, then E1X←E2X
L←E2X,TASK,:ExpOK;
ExpWrite:E1X←L;
L ← E2;
E1 ← L;
ExpOK:NOP,:EndShift;

E1grE2:T←ShiftCount;actually, negative shift count
L←37+T;
TASK,SH<0;

!1,2,NoFix1,Fix1;
!1,2,More1,Shifted1;

NOP,:NoFix1;
NoFix1:L←T←M2;
More1:M2←L RSH 1;
L←N2,TASK;
N2←L MRSH 1;
NOP;ALU←SReg after TASK;
L←ShiftCount+1;
ShiftCount←L,SH=0;
L←T←M2,:More1;

Fix1:L←0;
M2←L,TASK;
N2←L,:EndShift;

Shifted1:NOP,:EndShift;

;end of PRESHIFT
;now: ADD1 is Add(+ +), Add(- -), Sub(+ -), Sub(- +)
;and ADD2 is Add(+ -), Add(- +), Sub(+ +), Sub(- -)
; so: ADD1 if (S1 XOR S2) EVEN, and ADD2 otherwise

EndShift: T←E1;
L←E2+T;EVEN if ADD1, ODD if ADD2
SINK ← LREG, BUSODD, TASK;

!1,2,ADD1,ADD2;

NOP,:ADD1;

ADD1:T←N2;
L←N1+T;
N1←L,ALUCY;
!1,2,A1NoCarry,A1Carry;
T←M1,:A1NoCarry;
A1Carry:L←M2+T+1,:A1Store;
A1NoCarry:L←M2+T;
A1Store:M1←L,ALUCY,TASK;
!1,2,A1xNoCarry,A1xCarry;
NOP,:A1xNoCarry;
A1xCarry:T←L←M1;post shift
M1←L RSH 1;
L←N1,TASK;
N1←L MRSH 1;
T←100000;
L←M1 OR T;high order bit should have been shifted in
M1←L;
L←E1+1;
L←LREG+1,TASK; BECAUSE EXPONENT SHIFTED LEFT ONE BIT
E1←L,:STORE;
A1xNoCarry:NOP,:STORE;

ADD2:T←N2;
L←N1-T;
N1←L,ALUCY;low order result

!1,2,Add2NoCarry,Add2Carry;

T←M2,:Add2NoCarry;
Add2NoCarry:L←M1-T-1,:Add2C;no carry, do one’s complement subtract
Add2Carry:L←M1-T;carry, do two’s complement subtract
Add2C:M1←L,ALUCY;

!1,2,Add2Sign,Add2NoSign;
!1,2,LowNonZero,LowZero;

L←0,:Add2Sign;if no carry, sign changed!!!!

Add2Sign:T←N1,BUS=0;double length negate starts here
L←0-T,:LowNonZero;
LowNonZero:N1←L,T←0-1;
L←M1 XOR T,:Add2Cx;complement
LowZero:T←M1;
L←0-T;negate (note that N1 is already 0, so no need to update it)
Add2Cx:M1←L,T←0+1;
L←E1 XOR T,TASK;complement sign
E1←L;
L←0;

Add2NoSign:ShiftCount←L;
L←M1,BUS=0;

!1,2,HiNonZero,HiZero;

NOP,:HiNonZero;

HiNonZero:TASK,SH<0;

!1,2,Add2Norm,Add2NoNorm;

NOP,:Add2Norm;
Add2Norm:L←N1;
NOP,SH<0;
!1,2,Add2NoCarryL,Add2CarryL;
N1←L LSH 1,T←0,:Add2NoCarryL;
Add2CarryL:T←ALLONES;
Add2NoCarryL:L←M1;
M1←L MLSH 1;
L←ShiftCount+1,TASK;
ShiftCount←L;
L←M1,:HiNonZero;

Add2NoNorm:T←ShiftCount;
L←E1-T;
E1←L;
L←E1-T,TASK;
E1←L,:STORE;

HiZero:L←N1,BUS=0;

;!1,2,LowNonZero1,LowZero1;defined above

M1←L,L←0,:LowNonZero1;
LowNonZero1:N1←L;zero out low order
L←20,TASK;
ShiftCount←L;16 shifts done like wildfire
L←M1,:HiNonZero;

LowZero1:E1←L;
M1←L,TASK;
N1←L,:STORE;

STORE: MAR ← ANSADDR;
TASK;
MD ← E1;
MAR ← L ← ANSADDR + 1;
ANSADDR ← L, TASK;
MD ← M1;
MAR ← ANSADDR + 1;
TASK;
MD ← N1;
L ← ANSOOP, SWMODE;
PRIMRET:AC0 ← L, ESRB ← 0, :PRIMRET; AND RETURN TO THE INTERPRETER WITH OOP IN AC0 = ARG1

FAIL:ESRB ← 0;
SWMODE, :PRIMFAIL;

DIVFAIL:L ← ANSOOP; GET FLOAT FOR ANSWER
ARG1 ← L, ESRB ← 0; AND SAVE
L ← RAMRET5, TASK;
RAMRETURN ← L, SWMODE; RAM RETURN ADDRESS
REF:L ← RAMXODD, :REF; ODD RETURN FOR REFD - THROW AWAY UNUSED FLOAT
RAMX5:SWMODE;
PRIMFAIL::PRIMFAIL;LET THE SMALLTALK METHOD DO IT (LABEL USED ONLY IN RAM0)

DUMP:T ← OOP00; ********DEBUG********
L ← LREG OR T, SWMODE, :PRIMRET; ********DEBUG********