IMD 1.18: 21/01/2023 18:06:02
PRQ-SFT-JBD-7
3RCC PERQ MICROCODE SOURCE DISTRIBUTION FLOPPY
Copyright (C) Three Rivers Computer Corporation, 1982
single density, double sided   D.6

Group name                 Command file
MICROCODE.SOURCE           SRC.CMD
   	
       ! t0  first data ready

! Routine WordParm.
!------------------------------------------------------------------------the two high order words is left on the R bus.
!
!---------------------------------------------------------------------------------
!
! Abstract:
!       WordParm gets a one word (two byte) parameter from the operand
!       stream for the interprete-

RealCmp:tmp1 := Tos, Pop;
        Tos xor tmp, Pop, Return;




$Title Set routines.

! Routine SetAdj.
!--------r of a Q-code.  The high byte is left on
!       the shifter output, so the normal calling sequence is
!
!            Call(Wo---------------------------------------------------------------------
!
! Abstract:
!       SetAdj adjusts two sets on the tordParm);
!            tmp := tmp + Shift;             ! form word parameter
!
! Environment:
!       Two bytes in the operanp of the stacks so that the lower
!       set has a length that is greater than or equal to the length of the
!       upper sed stream.
!
! Result:
!       tmp = Low byte.
!       tmp1 = High byte.
!       R = High byte shifted up into the high bytet.  It does this by inserting zero words into the lower
!       set if it is shorter.
!
! Environment:
!       (Tos) = L0 = .
!
!-----------------------------------------------------------------------------

WordParm: tmp := NextOp;                Length of Set0.
!       (Tos-1) = L1 = Length of Set1.
!       Top L0 words on the memory stack = Set0.
!       Next L1 words     ! get the low byte
        tmp1 := NextOp;                      ! get the high byte
        tmp1, LeftShift(10), Return;  on the memory stack = Set1.
!
! Result:
!       stack popped.
!       tmp3 = nL0 = New length of Set0.
!       tmp2 = (Tos          ! t3
        UserIntr;                            ! t0
        LoadOp, if Gtr Goto(UserSrv);        ! t1
        No        ! shift the high byte




$Title Real number routines.

! Routine RealCmp.
!-----------------------------------p, if IntrPend Call(VectSrv);      ! t2, data starts here
        Nop;                                 ! t3, 2nd word in opfile------------------------------------------
!
! Abstract:
!       RealCmp does a portion of a comparison of two real numbers (
        Nop;                                 ! t0, 3rd word in opfile
        Goto(Refill1);                       ! t1, 4rd two
!       double words) for exact equality.
!
! Environment:
!       tmp = High order word of first real number.
!       word in opfile


RefillIndivisible: UPC := UPC + 4, Fetch4;   ! t3  advance UPC and fetch
        BPC := 0;                 (Tos) = Low order word of first real number.
!       (Tos-1) = High order word of second real number.
!       (Tos-2) = Low or           ! t0
        LoadOp, if IntrPend Call(VectSrv);   ! t1  fill opcode/operand file
        Nop;                      der word of second real number.
!
! Result:
!       Stack popped twice.
!       tmp = High order word of first real number.           ! t2
!       Where := Where or 4, call(5000);     !!!! use with CheckPC !!!!
        NextInst(0);                  
!       tmp1 = Low order word of first real number.
!       (Tos) = Low order word of second real number.
!       The Xor of    	
                              عd@j«R   J0 عd@j   Jˆ اjغ   J اjبہء4   Jہ اjب ب;   Jˆ اjب@خA   JH اjب€ش1   J¸ اjب ہعC   J اjب ل"   J° o'`	”T   Jہ	 يrv~ہءR   Jً يrv~ بA   J8 عd@jy:   Jh  طr  «R1   Jہ vL@«R	   J ‰ٹ    	
SetAdj: tmp3 := Tos and AllOnes, Pop;        ! L0=nL0
        Tos := tmp1 := Tos and AllOnes;      ! L1  !***** BR
        tmp SetComp if these words are significant.
!
!       For each pair of words in the sets, SetComp gets a word of the upper
!    1 := tmp1 - tmp3, LoadS(SetAdj2); ! difference  !***** BR
        tmp2 := Tos, if Geq Goto(SetAdj1);   ! L1=nL1 if Set1 >= Set0   set (right operand) into tmp, fetches the corresponding word of the
!       lower set (left operand), and jumps to a compari
        tmp := Tos + tmp3;                   ! amount to copy
        Tos := zero - tmp1, Push;            ! make difference son routine which
!       is specified by the 2910 S register.  Thus the normal calling
!       sequence is:
!
!            positive
        tmp1 := Tos, if IntrPend Call(VectSrv);  ! difference
        tmp10 := Tos, Call(ChkStk);          ! be sure     Tos := 1, LoadS(Tag);    ! assume true
!                Call(SetComp);
!                if <remaining non-zero words changthere's enough room
        Tos := TP - tmp;                     ! smallest source address
        TP := TP + tmp1;           e the result> Call(SetZChk);
!
!           Tag: Mdi <op> tmp;            ! compare a pair of words
!                if <cnd>           ! new top of memory stack
        dst := Tos + tmp1, Call(SetMovUp);   ! largest destination address
        tmp2 :=Goto(SetComp);  ! if condition satisfied
!                Tos := 0, Return;        ! set false and quit
!
!    or:
!
!      tmp3, Pop;                   ! nL1=nL0
        Tos := tmp2, Call(SetZero);          ! zero words to adjust set size
SetAdj1:            Tos := 0, LoadS(Tag);    ! assume false
!                Call(SetComp);
!                if <remaining non-zero wortmp4 := TP, if IntrPend Call(VectSrv);
        tmp4 := tmp4 - tmp3;                 ! address of Set1
        tmp3, Return;   ds change the result> Call(SetZChk);
!
!           Tag: Mdi <op> tmp;            ! compare a pair of words
!                i                     ! put nL0 on result

!       There's not enough room on the stack.

SetAdj2: Tos := tmp3;
        tmp1f <cnd> Goto(SetComp);  ! if condition not yet satisfied
!                Tos := 1, Return;        ! set true and quit
!
! En1 := 1, Goto(StkOv);             ! make a stack overflow

! Routine SetComp.
!----------------------------------------------vironment:
!       tmp3 = Length of upper set.
!       tmp2 = Length of lower set.
!       TP = Highest address of upper set.) = nL1 = New length of Set1.
!       nL0 >= nL1.
!       Top nL0 words on the memory stack = Set0.
!       Next nL1 words on-------------------------------
!
! Abstract:
!       SetComp is used to compare two sets in the stack.  The set which
!     the memory stack = Set1.
!       tmp4 = Address of Set1 in memory stack.
!       nL0 is on the R bus.
!
! Calls:
!       V   is deeper in the stack must have a length which is greater than
!       or equal to the length of the upper set.  If the setectSrv, ChkStk, SetMovUp, SetZero, StkOv.
!
!-----------------------------------------------------------------------------

s have different
!       sizes, the unmatched words of the longer set are not compared.
!       SetZChk should be called after   	
      «RQ   jˆ »z€«R/   j(	 ç }«R5   J@ vLہD«R   j “y  ج   J° ‌:@خ«R   j@	 ک:     j ‍G K«R$   j8 ک:   «Re   ت( اjب@ç-   ê ‌:@خ)   ê  ک:     j  ‎    j   1" 	 4  X     زبàر ب        %   ْًئ ù e     *     (   
 
FLOPPY.RUN Œ|63 K)                ¢کز!/ ف      X% V ؛  *floppy°ز   ؛°ز؛/ ~      ´V # ؛ 4A4  
0 
0                      J@6J3        K% س% a%         %   ndز n/ •	        ,=~/ْ †|   Œ|63 ٹ)       ُ  ™œگْ› W      q<   ـ Zœ¦œ  V ؛ œ¦œہ¥# \     ¬f µC D       ے‏ے               ش  %    ؤ
ؤ؟ P
        شقشف E         d  dndزm/ 
     0  W% A …           	

!       tmp4 = Highest address of lower set.
!       S = Address of routine to compare one word of the set.
!       (Tos) = of words to move.
!
! Result:
!       Memory[(Tos)+1..(Tos)+tmp] moved to Memory[dst+1..dst+tmp].
!       tmp = 0.
!       Assumed truth value.
!
! Result:
!       (Tos) = 0 or 1.
!       (Tos) on the R bus.
!       TP = Undefined (trashed).
!  (Tos) unchanged.
!       dst unchanged.
!
! Calls:
!       VectSrv.
!
!---------------------------------------------------     tmp3 = Undefined (trashed).
!       tmp4 = Address of unchecked words in lower (longer) set.
!       tmp2 = Number of unc--------------------------

! Routine SetMovDown.
!--------------------------------------------------------------------------hecked words in lower (longer) set.
!
! Calls:
!       VectSrv.
!
!-----------------------------------------------------------
!
! Abstract:
!       SetMovDown moves a block of words toward a lower address.  The source
!       and destination are ---------------------

SetComp: TP, Fetch;                          ! t3
        tmp3 := tmp3 - 1, if IntrPend Goto(SetComp1)allowed to overlap.
!
! Environment:
!       (Tos) = Largest source address + 1.
!       dst = Largest destination address +;  ! t0
        Tos, if Lss Return;                  ! t1
        tmp := Mdi;                          ! t2
        tmp4, Fet 1.
!       tmp = Negative of the number of words to move.
!
! Result:
!       Memory[(Tos)-1..(Tos)+tmp] moved to Memory[dsch;                         ! t3
        tmp4 := tmp4 - 1;                    ! t0
        TP := TP - 1;                      t-1..dst+tmp].
!       tmp = 0.
!       (Tos) unchanged.
!       dst unchanged.
!
! Calls:
!       VectSrv.
!
!---------  ! t1
        tmp2 := tmp2 - 1, GotoS;             ! t2
!       Mdi <op> tmp;                        ! t3  compare a pair of --------------------------------------------------------------------

SetMovUp:tmp10 := 1, Goto(SetMov1);          ! incrementwords
!       if <cnd> Goto(SetComp);              ! t0  condition not yet satisfied
!       Tos := 1, Return;                 = 1

SetMovDown:tmp10 := not 0;                   ! increment = -11
SetMov1: Tos + tmp, Fetch;                   ! t3
         ! t1  set true and quit

!       Serve an interrupt.

SetComp1: Call(VectSrv);
        tmp3 := tmp3 + 1, Goto(SetComp);   Nop;                                 ! t0
        Nop;                                 ! t1
        dst + tmp, Store;      

! Routine SetMovUp.
!-----------------------------------------------------------------------------
!
! Abstract:
!                   ! t2
        Mdo := Mdi, if IntrPend Goto(SetMov3);  ! t3
SetMov2:tmp := tmp - tmp10;
        if Eql Return; 
  SetMovUp moves a block of words toward a higher address.  The source
!       and destination are allowed to overlap.
!
! En        Goto(SetMov1);

!       Serve an interrupt.

SetMov3: Call(VectSrv);                      ! t0 - makes fetch safe invironment:
!       (Tos) = Smallest source address - 1.
!       dst = Smallest destination address - 1.
!       tmp = Number  VECTSRV
        Goto(SetMov2);

! Routine SetOp.
!------------------------------------------------------------------------   	
) Three Rivers Computer Corporation, 1980.
!
! Abstract:
!
!----------------------------------------------------------------Perq.Routine.2
$Include Perq.Init


$Include RO.Micro
$Include Line.Micro




        end;
                          -------------

! 13 Jan 82   V2.5   WJHansen
! change , to ; in StkOv (in Perq.Routine.1) to help PrqPlace

! 31 Dec 81    V2.4   M. Kristofic
! Added floating point.

!  9 Sep 81   V2.3   J. Strait
! Fix bugs in double precision--see change histo ry in double precision section.

! 14 May 81   V2.2   G. Robertson.
! 1. Moved IO up to 4400, expanded space for Perq to 2.25 K.
! 2. Added double precision arithmetic operations.
! 3. Added Spice kernal operations.
! 4. Added RO and Line as part of i! Perq Definitions.
!-----------------------------------------------------------------------------
!
!       Perq.Dfs - QCodenterpreter.


! 14 Mar 81   V2.1   J. Strait.
! 1. Begin installing exception handling microcode.
! 2. Make sure that the S Interpreter definitions.
!       Horst Mauersberg, Brian Rosen, Miles Barel    ca. 1 Jan 80.
!       J. P. Strait             L and RA from the main program are zero, and that the
!    SL of procedures inside the main program are also zero.  This is nee ded
!    for stack searches for exceptions.
! 3. Minor bug corrections to stack overflow processing.
! 4. Bug correction to e xternal calls.

! 21 Nov 80   V2.0   J. Strait.
! Start file.

$Include Perq.Dfs
$Include IO.Dfs




        Decimal ;




$Include Acb.Dfs
$Include EEB.Dfs
$Include Except.Dfs
$Include Perq.QCodes.Dfs
$Include Rd.Dfs
$Include VRD.Dfs$Title Perq.Micro - Perq Q-Code interpreter microcode.
$NoList
! Perq Microcode.
!-------------------------------------------




        Octal;




        Place(0,4377);
        Place(6000,6777);


$Include Perq.QCode.1
$Include Perq.QCo----------------------------------
!
!       Perq.Micro - Perq Q-code interpreter microcode.
!       Horst Mauersberg, Brian de.2
$Include Perq.QCode.3
$Include Perq.QCode.4
$Include Perq.QCode.5
$Include Perq.QCode.6
$Include Perq.float.mul  ! mulRosen, Miles Barel     ca. 1 Jan 80.
!       J. P. Strait                     rewritten        21 Nov 80.
!       Copyright (ctiplication routines necessary for floating point
$Include Perq.QCode.7    ! floating point
$Include Perq.Routine.1
$Include   	
ghest address of lower set.
!       S = Address of routine to compare one word of the set.
!
! Result:
!       Upper set popn if the presence of non-zero
!       words remaining in the larger set will alter the result of the
!       comparison.
!
!ped from memory stack.
!       tmp3 = -1.
!       tmp4 = Address of unmatched words in lower (longer) set.
!       tmp2 = Num Environment:
!       tmp4 = Address of remaining words in longer set.
!       tmp2 = Number of remaining words in longer set.ber of unmatched words in lower (longer) set.
!
! Calls:
!       VectSrv.
!
!----------------------------------------------
!       (Tos) = Assumed truth value.
!
! Result:
!       (Tos) = Assumed truth value if all words are zero.
!       (Tos) -----
!
! Abstract:
!       SetOp is used to perform an operation on two sets in the stack.
!       The set which is deeper -------------------------------

SetOp:  TP, Fetch;                           ! t3
        tmp3 := tmp3 - 1, if IntrPend Gotoin the stack must have a length which
!       is greater than or equal to the length of the upper set.  The
!       result is (SetOp1);! t0
        tmp := Mdi, if Lss Return;           ! t1
        tmp4, Fetch;                         ! t2
        TP stored back into the lower set, and the upper set is
!       popped from the memory stack.  If the sets have different sizes,
:= TP - 1;                        ! t3
        tmp4 := tmp4 - 1;                    ! t0
        tmp4 + 1, Store, GotoS;      !       the unmatched words of the longer set are not modified.
!
!       For each pair of words in the sets, SetOp gets a wor        ! t1
!       Mdi <op> tmp, Goto(SetOp);           ! t2

!       Serve an interrupt.

SetOp1:Call(VectSrv);
       d of the
!       upper set (right operand) into tmp, fetches the corresponding
!       word of the lower set (left operand), i tmp3 := tmp3 + 1, Goto(SetOp);

! Routine SetSizes.
!----------------------------------------------------------------------ssues a Store command to
!       the memory controller, and jumps to a routine which computes the
!       operation for those -------
!
! Abstract:
!       SetSizes subtracts the sizes of two sets from TP in order to compute
!       the new TP after words.  The routine is specified by the 2910
!       S register.  Thus the normal calling sequence is:
!
!                Loaa set compare instruction.
!
! Environment:
!       tmp3 = Length of one set.
!       tmp2 = Length of the other set.
!
! dS(Tag);
!                Call(SetOp);
!           ! if remaining, unmatched words change the result, set them to
!          Result:
!       tmp6 = TP - tmp3 - tmp2.
!
!-----------------------------------------------------------------------------

 ! an appropriate value.
!
!
!           Tag: Mdi <op> tmp, Goto(SetOp);  ! compute the operation
!
! Environment:
!      SetSizes:  tmp6 := TP;
        tmp6 := tmp6 - tmp3;
        tmp6 := tmp6 - tmp2, Return;

! Routine SetZChk.
!------------ tmp3 = Length of upper set.
!       tmp2 = Length of lower set.
!       TP = Highest address of upper set.
!       tmp4 = Hi-----------------------------------------------------------------
!
! Abstract:
!       SetZChk is used after a set compariso   	
ster definitions for floating point.

! 25 Oct 81  1.4  J. Strait
!                 Define entry point for RasterOp as routin           ]
Define(CB,6);           ! Code Base                             ]
Define(SB,7);           ! Stack Base           e call.

! 21 Apr 81  1.3  George Robertson
!                 Added more registers for double precision arith.

! 10 Apr 81                 ]
Define(RN,10);          ! Routine Number
Define(CS,11);          ! Code Segment
Define(SS,12);          !   1.2  George Robertson
!                 Added registers and constants for double precision arith.

! 16 Mar 81  1.1  John SStack Segment
Define(SL,13);          ! Stack Limit                           ]




!       Distinguished segments and poitrait
! Miscellaneous changes for exceptions.

! 21 Nov 80  1.0  John Strait
! Start file.

!        Entry points into thnters.

Define(ExcCS,14);       ! Code segment of Except
Define(ExcGP,15);       ! Global pointer of Except




!       is piece of microcode.

Constant(Error,2100);   ! entry point for microcode detected errors
Constant(Mult,31);      ! entry pStack limits.

Constant(StackLimit,570);  ! stack-overflow buffer area
Constant(StackLSlop,600);  ! StackLimit + slop factoroint of multiply routine
Constant(RunError,601); ! entry point of run-time error routine
Constant(SetQState,2600);  ! entry po




!       Pascal level interrupts.

Define(UserIntr,20);    ! user interrupt register:
                        !      int of set Q-interpreter state routine
Constant(LongOps,3000); ! start of long operations dispatch table
Constant(RasterOp,400 if bit 15 is zero, interrupts are enabled
                        !       if bit 15 is set, interrupts are disabled
Define(In0);  ! entry point for RasterOp QCode
Constant(DrawByte,4010);  ! entry point for DrawByte RasterOp code
Constant(DrawLine,402tPtr,21);      ! address of interrupt table




!       Temporaries.

Define(tmp,30);
Define(tmp1,31);
Define(tmp2,32);0);  ! entry point for Line drawing microcode
Constant(Rop,4030);     ! entry point for RasterOp routine




!       Entry
Define(tmp3,33);
Define(tmp4,34);
Define(tmp5,35);
Define(tmp6,36);
Define(tmp7,37);
Define(tmp10,40);
Define(tmp11,41);         rewritten       21 Nov 80.
!       Copyright (C) Three Rivers Computer Corporation, 1980.
!
! Abstract:
!       Thi points to other related microcode.

Constant(KrnlOps,7000);   ! start of Spice kernel operations dispatch table




!   s file provides the register and constant definitions provided
!       by the Perq QCode interpreter microcode for other microp    QCode state registers.

Define(UPC,16);         ! User Program Counter, quad word addr  ] absolute
Define(TP,17);        rograms.
!
!-----------------------------------------------------------------------------


! 13 Jan 82  1.6  Brad Myers
  ! Pointer to Top Of Memory Stack        ] 20-bit
Define(AP,3);           ! Activation Pointer                    ] memory
De!                 Increase stackLimit (400 -> 600) for stack overflow.

! 03 Jan 82  1.5  M. Kristofic
!                 Regifine(GP,4);           ! Global Pointer                        ] addresses
Define(LP,5);           ! Local Pointer                	
----------------------------------------

SetZero: tmp1 := tmp1 - 1, if IntrPend Goto(SetZero2);
SetZero1: if Lss Return;    := TP - tmp1;                     ! adjust interesting pointers
        AP := AP - tmp1;
        GP := GP - tmp1;
        LP                  ! if done
        dst - tmp1, Store;                   ! store a zero
        zero, Goto(SetZero);

!      := LP - tmp1;
        SL := SL - tmp1;
SetQS1: tmp and 100;
        if Eql Goto(SetQS2);                 ! if not set SL
    Serve an interrupt.

SetZero2: Call(VectSrv);
        tmp1, Goto(SetZero1);




$Title Miscellaneous.

! Routine Set     src + 1, Fetch;                      ! get segment size
        Mdi and not 17, LeftShift(4);
        SL := Shift + 400; QState.
!-----------------------------------------------------------------------------
!
! Abstract:
!       SetQState is us                  ! size field in SAT is off by one
        SL := SL + SB;
        SL := SL - StackLSlop;               ! new ed to set internal state of the Q-interpreter.
!
! Environment:
!       tmp and 40 <> 0 if setting SB is desired.
!       tmSL
SetQS2: tmp and 200;
        if Eql Return;                       ! if not set ExcCS and ExcGP
        Tos := ExcCS := CS,p and 100 <> 0 if setting SL is desired.
!       tmp and 200 <> 0 if setting ExcCS and ExcGP is desired.
!
! Result:
!       Push;            ! new ExcCS
        ExcGP := GP;
        ExcGP := ExcGP - SB, Return;         ! new ExcGP

! Routine LCA.= Complement of assumed truth value if any words are non-zero.
!       tmp4 decremented by one more than the number of words re One or more of the following:
!         1. SB reloaded from segment table.
!         2. SL reloaded from segment table.
!   maining.
!       tmp2 = -1.
!
!-----------------------------------------------------------------------------

SetZChk: tmp4      3. ExcCS = CS.
!            ExcGP = GP - SB.
!            Stack pushed.
!            (Tos) = ExcCS.
!
! Calls:
!    , Fetch;
        tmp4 := tmp4 - 1;
        tmp2 := tmp2 - 1;
        Mdi, if Lss Return;
        if Eql Goto(SetZChk);
       VectSrv.
!
! Design:
!       It is assumed that the stack segment is resident.
!
!--------------------------------------    Tos := Tos xor 1, Return;            ! complement assumed truth value

! Routine SetZero.
!--------------------------------------------------------------------

Loc(SetQState), src := SS;                   ! stack segment number
        tmp1 := ------------------------------------------------
!
! Abstract:
!       SetZero inserts zero words into a set.
!
! EnvironmeSB;                          ! save old stack base
        tmp and 40;
        src := src + src, if Eql Goto(SetQS1);  ! if nont:
!       tmp1 = N.
!       dst = Largest address to set zero.
!
! Result:
!       Memory[Dst-0] = 0.
!       Memory[Dstt set SB
        src, Fetch2;                         ! get segment table entry
        SB := Mdi and not 377;
        SB := -1] = 0.
!          ...
!       Memory[Dst-N+1] = 0.
!
! Calls:
!       VectSrv.
!
!-------------------------------------Mdx or SB, if IntrPend Call(VectSrv);  ! new SB
        tmp1 := tmp1 - SB;                   ! amount SB has moved
        TP    	
e(ALow,45);
Define(AHigh,46);
Define(ResSign,47);
Define(RemSign,50);


Define(BSign,62);       ! Floating point arithmeti c temps
Define(BExp,26);
Define(ASign,63);
Define(AExp,27);





!       Long constants kept in registers.

Define(Al lOnes,60);     ! 0177777, used for masking
Define(SignXtnd,61);    ! 3700000, used for sign extension
Define(Zero,51);        { QCodes Definitions.
{-----------------------------------------------------------------------------
{
{ QCodes.Dfs - QCode o! 0000000, used for 1 instruction negate
Define(SignBit,53);     ! 0100000, used in double precision arithmetic




!     pcode definitions.
{ M. A. Barel
{ Copyright (C) Three Rivers Computer Corporation.
{
{ Abstract:
{       QCodes.Dfs define  Offsets in stack bottom:

Constant(StkTP,0);      ! top pointer (-SB) for initialization
Constant(StkGP,1);      ! global ps the Perq Q-code opcodes.  It is included
{       into QCodes.Pas, Perq.Micro, and any other programs that need
{       the oointer (-SB) of system segment




!       Temporary save area for E-stack (during Tlate).

Define(tmpstk0,70);
Define(tpcode definitions.
{
{-----------------------------------------------------------------------------}


{   3 Jan 82  Michampstk1,71);
Define(tmpstk2,72);
Define(tmpstk3,73);
Define(tmpstk4,74);
Define(tmpstk5,75);
Define(tmpstk6,76);
Define(tmpel Kristofic
{             Added ROPS and its auxiliary definitions.
{             Deleted pointer (formerly real) =, <> compastk7,77);




!       Byte offset for jumps.

Define(JmpOffset,52);   !# of bytes to add to pc  in jumps etc.




! risons.
{ }
{  10 Apr 81  George Robertson
{             Added LOPS and KOPS and their auxiliary definitions.
{ }
{  14 Mar      For byte array operations.

Define(Src,54);           ! in byte moves, pointer to source word
Define(SrcLsb,55);        81  John Strait.
{  Add ENABLE, QRAISE, LDAP.
{ }

     LDC0      = 0;         { Assignment of Byte/Word opcodes are impor ! bit 0 sez high byte (=1) or low byte (=0)
Define(SrcByte,56);       ! the right byte
Define(SrcWord,57);       ! the whole tant }
     LDC1      = 1;
     LDC2      = 2;
     LDC3      = 3;
     LDC4      = 4;
     LDC5      = 5;
     LDC6      word fetched
Define(Dst,64);           ! pointer to destination word
Define(DstLsb,65);        ! 1 = high byte, 0 = low byte
= 6;
     LDC7      = 7;
     LDC8      = 8;
     LDC9      = 9;
     LDC10     = 10;
     LDC11     = 11;
     LDC12     Define(DstByte,66);
Define(DstWord,67);




!       Krnl's registers.

Define(BrkReg,370);




! Initialization:
= 12;
     LDC13     = 13;
     LDC14     = 14;
     LDC15     = 15;
     LDCMO     = 16;
     LDCB      = 17;
     LDCW  
Define(tmp12,42);
Define(tmp13,43);


Define(BLow,43);       ! Double precision arithmetic temps
Define(BHigh,44);
Defin
Constant(InitBlock,400);! memory address of boot initialization info
Constant(InitProc,0);   ! initial proc #
                 	
 not written because
!       the address portion of the instruction doesn't touch the High order
!       third.
!
!---------      ! use DpyTmp
        Z80OState := 0;
        Z80Status := 0;
        Z80WantOutput := 0;
        dpyTmp := 6000;      --------------------------------------------------------------------

LCA:    tmp := Tos or not 17, LoadS(LCA2);   ! get ready                ! 128 lines of Off in Visloop
        zero := 0, StackReset;
        tmp, Fetch2;
        tmp5 := Mdi;        to write LCA2
        tmp and not 6060;
        Tos or 377, WcsMid, if True GotoS(LCA1);  ! write Mid third
LCA1:   WcsLow,                   ! initial code segment number
        SS := Mdi;                           ! initial stack segment number
  if True GotoS(LCA2);         ! write Low third
LCA2:   LoadS(0);                            ! *** modified ***
        Pop, Re      ExcCS := 0;                          ! no exception module yet
        ExcGP := 0;
        AP := SB;                    turn;
                                                                                                                                 ! main program dynamic link
        RN := 0;                             ! main program return routine
        CS := 0 ;                             ! main program return segment
        CB := 0;                             ! main program return 



$List
$Title Initialization.

! Routine Init.
!--------------------------------------------------------------------code base
        UPC := BPC := 0;                     ! main program return address
        tmp := 160, Call(SetQState);     ---------
!
! Abstract:
!       Init is the entrypoint and initialization of the Perq Q-code
!       interpreter microcode.    ! set SB and SL registers
        tmp10 := SB;                         ! main program static link
        SB + StkTP, Fetc
!
!-----------------------------------------------------------------------------

Loc(2400),

!       Initialize constant h;
        TP := Mdi + SB;                      ! initial top pointer
        SB + StkGP, Fetch;
        GP := Mdi + SB, Load
!-----------------------------------------------------------------------------
!
! Abstract:
!       LCA loads a controlstoregisters.

        tmp := InitBlock;
!       Where := not 0;                      !!!! use with CheckPC !!!!
        AllOnere address into the 2910 S register.
!
! Environment:
!       (Tos) = Address with bytes swapped.
!
! Result:
!       Stacs := 177777;
        SignBit := 100000;
        SignXtnd := not 77777;               ! upper 5 bits set to 1
        C1777 :=k popped.
!       S = Address.
!
! Design:
!       A LoadS(address) instruction is built and written into a location
!      1777;
        C400 := 400;
        
!       Initialize no interrupts and interrupts off.

        UserIntr := 100000;       in this routine.  The LoadS instruction is then executed.  Note that
!       the High order third of the LoadS instruction is             ! interrupts turned off

!       Z80 state registers for IO microcode.

        Z80State := 100000;               	
        { Word i ‏e laûے Yrison and only EQU }
     NEQWord   = 70;             {   and NEQ exist }
     ABI       = 71;STL7      = 136;
     LDOB      = 137;
     LDOW      = 138;
     LDO0      = 139;
     LDO1      = 140;
     LDO2      = 1
     ADI       = 72;
     NGI       = 73;
     SBI       = 74;
     MPI       = 75;
     DVI       = 76;
     MODI      =41;
     LDO3      = 142;
     LDO4      = 143;
     LDO5      = 144;
     LDO6      = 145;
     LDO7      = 146;
     LDO    = 18;
     LSA       = 19;
     ROTSHI    = 20;
     STIND     = 21;
     LDCN      = 22;
     LDB       = 23;
     ST 77;
     CHK       = 78;
     UNDF79    = 79;
     UNDF80    = 80;
     UNDF81    = 81;
     UNDF82    = 82;
     UNDF83 B       = 24;
     LDCH      = 25;
     LDP       = 26;
     STPF      = 27;
     STCH      = 28;
     EXGO      = 29;
      = 83;
     UNDF84    = 84;
     UNDF85    = 85;
     UNDF86    = 86;
     UNDF87    = 87;
     INN       = 88;
     UNI  QAND      = 30;             { *** LAND *** }
     QOR       = 31;             { *** LOR *** }
     QNOT      = 32;                 = 89;
     QINT      = 90;             { *** INT *** }
     DIF       = 91;
     EXITT     = 92;             { *** EXI   { *** BNOT *** }
     EQUBool   = 33;             { Opcode assignment of all EQU,NEQ,LEQ,LES }
     NEQBool   = 34;        T *** }
     NOOP      = 93;             { *** NOP *** }
     REPL      = 94;
     REPL2     = 95;
     MMS       = 96;
        {    GEQ and GTR qcodes are important      }
     LEQBool   = 35;
     LESBool   = 36;
     GEQBool   = 37;
     GTRBoo  MES       = 97;
     LVRD      = 98;
     LSSN      = 99;
     XJP       = 100;
     PSW       = 101;
     RASTOP    = 10l   = 38;
     EQUI      = 39;
     NEQI      = 40;
     LEQI      = 41;
     LESI      = 42;
     GEQI      = 43;
     GT2;
     STRTIO    = 103;
     PBLK      = 104;
     INTOFF    = 105;
     INTON     = 106;
     LDLB      = 107;
     LDLWRI      = 44;
     UNDF45    = 45;
     UNDF46    = 46;
     UNDF47    = 47;
     UNDF48    = 48;
     UNDF49    = 49;
         = 108;
     LDL0      = 109;
     LDL1      = 110;
     LDL2      = 111;
     LDL3      = 112;
     LDL4      = 113;  UNDF50    = 50;
     EQUStr    = 51;
     NEQStr    = 52;
     LEQStr    = 53;
     LESStr    = 54;
     GEQStr    = 55;
     LDL5      = 114;
     LDL6      = 115;
     LDL7      = 116;
     LDL8      = 117;
     LDL9      = 118;
     LDL10  
     GTRStr    = 56;
     EQUByt    = 57;
     NEQByt    = 58;
     LEQByt    = 59;
     LESByt    = 60;
     GEQByt    =    = 119;
     LDL11     = 120;
     LDL12     = 121;
     LDL13     = 122;
     LDL14     = 123;
     LDL15     = 124;
  61;
     GT)قû    = 62;
     EQUPowr   = 63;
     NEQPowr   = 64;
     LEQPowr   = 65;
     SGS       = 66;             {    LLAB      = 125;
     LLAW      = 126;
     STLB      = 127;
     STLW      = 128;
     STL0      = 129;
     STL1      there is no LESPowr }
     GEQPowr   = 67;
     SRS       = 68;             { there is no GTRPowr }
     EQUWord   = 69;     = 130;
     STL2      = 131;
     STL3      = 132;
     STL4      = 133;
     STL5      = 134;
     STL6      = 135;
       	
w codebase
                            if Odd Goto(Busted);  ! if not resident: BAD!
        Hold, tmp := InitProc, LeftShift(! base address (origin word) of destination
define(SrcQuad,100);    ! memory address of source data (quad aligned)
define(DstQ3);
        Hold, tmp1 := Shift + tmp6;
        Hold, Mdi + tmp1, Fetch4;            ! fetch dictionary entry
        tmp7 :=uad,101);    ! memory address of destination data (quad aligned)
define(SrcLineInc,102); ! # of words between last quad of one  GP, Call(CllV);              ! set up ACB etc.
        Goto(RefillJmp);                     ! enter main program

Busted: Goline and 1st
                        ! quad of next line -> ScanLineLength - width (words)
                        ! with -1, to(Busted);
                                                                                                                   +1 effects taken into account
define(DstLineInc,103); ! same for destination
define(Height,104);     ! height (in bits) of are a to be moved
define(Width,105);      ! width (in Bits) of area to be moved
define(Func,111);       ! RasterOp function (3 bit s)

!        ***Note*** Following register definitions use the SAME register.

define(XtraSrcFetch,106);  ! Bit 7 set if mor e source than dest quads needed
define(XtraSrcWord,106);   ! Bit 0 set if more source than dest words needed
define(OneQuad,10$Title RasterOp Microcode.
!!!      RasterOp Microcode Version 0.1
!
!        Brian Rosen & Stan Kriz & John Strait
!       6);    ! Bit 15 set if only 1 dest quad is needed

define(MidNum,107);     ! number of quads wide - 2 (ie # of mid cycles to d Copyright (C) Three Rivers Computer, 1981.
!
!
!  V0.6  10 Nov 81  JPS  Make Rop an entrypoint.
!
!  V0.5  16 Jul 81  JPS o)
define(MidCnt,110);     ! counter for MidNum

define(SrcX,112);       ! source X value
define(SrcY,113);       ! source Y Change "Company Confidential" notice to "Copyright".
!
!  V0.4  18 May 81  JPS  Change RO to be an include file.
!
!  V0.3  value
define(DstX,114);       ! destination X value
define(DstY,115);       ! destination Y value

define(SrcBinQ,112);     29 Apr 81  JPS  Provide an entrypoint that writes from a packed array
!                        of characters (or from a string! source bit in quad  *** same register as SrcX ***
define(SrcBinW,113);    ! source bit in word  *** same register as SrcY *** for that matter).
!
!  V0.2  22 Oct 80  JPS  Added 'Hold's that were lost in version 0.1.
!
!  V0.1   8 Oct 80   BR  Added 
define(DstBinQ,114);    ! destination bit in quad  *** same register as DstX ***
define(DstBinW,115);    ! destination bit inS(Busted);       ! initial global pointer
        tmp := tmp5, Call(ChkSeg);
        tmp6 := tmp, Fetch,                  ! neNo Power Down bit to SrcRasterOp
!

define(SrcBase,116);    ! base address (origin word) of source
define(DstBase,117);       	
  = 188;
     ATPW      = 189;
     WCS       = 190;
     JCS       = 191;
     LDGB      = 192;
     LDGW      = 193;
   w for 2nd byte }
     KOPS      = 253;            { See below for 2nd byte }
     BREAK     = 254;
     REFILLOP  = 255;

  LGAB      = 194;
     LGAW      = 195;
     STGB      = 196;
     STGW      = 197;
     UNDF198   = 198;
     UNDF199   ={--------------------------------------------------------------------
{
{ Long Operations - Second byte of LOPS opcode
{
{-- 199;
     RET       = 200;             { *** RETURN *** }
     MMS2      = 201;
     MES2      = 202;
     LDTP      = 203;------------------------------------------------------------------}

     CVTLI     = 0;
     CVTIL     = 1;
     ADL       
     JMPB      = 204;
     JMPW      = 205;
     JFB       = 206;
     JFW       = 207;
     JTB       = 208;
     JTW   = 2;
     NGL       = 3;
     SBL       = 4;
     MPL       = 5;
     DVL       = 6;
     MODL      = 7;
     ABL       =     = 209;
     JEQB      = 210;
     JEQW      = 211;
     JNEB      = 212;
     JNEW      = 213;
     IXP       = 214;
 8;
     EQULong   = 9;
     NEQLong   = 10;
     LEQLong   = 11;
     LESLong   = 12;
     GEQLong   = 13;
     GTRLong   8      = 147;
     LDO9      = 148;
     LDO10     = 149;
     LDO11     = 150;
     LDO12     = 151;
     LDO13     = 152;    LDIB      = 215;
     LDIW      = 216;
     LIAB      = 217;
     LIAW      = 218;
     STIB      = 219;
     STIW     
     LDO14     = 153;
     LDO15     = 154;
     LOAB      = 155;
     LOAW      = 156;
     STOB      = 157;
     STOW   = 220;
     IXAB      = 221;
     IXAW      = 222;
     IXA1      = 223;
     IXA2      = 224;
     IXA3      = 225;
        = 158;
     STO0      = 159;
     STO1      = 160;
     STO2      = 161;
     STO3      = 162;
     STO4      = 163;
  IXA4      = 226;
     TLATE0    = 227;             { *** TLATE1 *** }
     TLATE1    = 228;             { *** TLATE2 *** }
     STO5      = 164;
     STO6      = 165;
     STO7      = 166;
     MVBB      = 167;
     MVBW      = 168;
     MOVB         TLATE2    = 229;             { *** TLATE3 *** }
     EXCH      = 230;
     EXCH2     = 231;
     INCB      = 232;
     I = 169;
     MOVW      = 170;
     INDB      = 171;
     INDW      = 172;
     LDIND     = 173;          { Same as IND0 }
 NCW      = 233;
     CALLXB    = 234;
     CALLXW    = 235;
     LDMC      = 236;
     LDDC      = 237;
     LDMW      = 23    IND0      = 173;          { Same as LDIND }
     IND1      = 174;
     IND2      = 175;
     IND3      = 176;
     IND4 8;
     LDDW      = 239;
     STLATE    = 240;
     LINE      = 241;
     ENABLE    = 242;
     QRAISE    = 243;
     LDAP     = 177;
     IND5      = 178;
     IND6      = 179;
     IND7      = 180;
     LGAWW     = 181;
     STMW      = 182;
      = 244;
     UNDF245   = 245;
     UNDF246   = 246;
     UNDF247   = 247;
     UNDF248   = 248;
     UNDF249   = 249;     STDW      = 183;
     SAS       = 184;
     ADJ       = 185;
     CALLL     = 186;
     CALLV     = 187;
     ATPB    
     ROPS      = 250;            { See below for 2nd byte }
     INCDDS    = 251;
     LOPS      = 252;            { See belo  	
stant(Phase7LR,136);     ! Begin/End   - Clear
constant(Phase7XLR,176);    ! Begin/End   - Clear   - XtraSourceWord

constant      ! in preparation for LastDst computation
         Height := Tos - 1, Pop;        ! height-1 of block in bits
         Di(Phase0RL,103);     ! Begin       - NoClear
constant(Phase0XRL,143);    ! Begin       - NoClear - XtraSourceWord
constant(Phasrection := 0, if IntrPend call(IntrIt);  ! assume left to right
         Width := Tos - 1, Pop;         ! width-1 of block in b word  *** same register as DstY ***

define(LeftSrc,120);    ! leftmost source bit in word
define(LeftDst,121);    ! leftmose1RL,107);     ! Mid         - NoClear
constant(Phase2RL,113);     ! End         - NoClear
constant(Phase3RL,117);     ! Begint destination bit in word
define(LastDst,122);    ! last destination word in quad

define(DstRas,121);     ! DstRasterOp valu/End   - NoClear
constant(Phase3XRL,157);    ! Begin/End   - NoClear - XtraSourceWord
constant(Phase4RL,123);     ! XtraSourcee *** same register as LeftDst ***
define(SrcRas,120);     ! srcRasterOp value *** same register as LeftSrc ***

define(Flag,  - NoClear
constant(Phase5RL,127);     ! FirstSource - Clear
constant(Phase6RL,133);     ! End         - Clear
constant(Phas123);       ! bit 7 = 1 SrcQuad, bit 0 = trip flag in SetUp
define(Direction,124);  ! 0 for left to right, not 0 for right to le7RL,137);     ! Begin/End   - Clear
constant(Phase7XRL,177);    ! Begin/End   - Clear   - XtraSourceWord


Loc(RasterOp), eft

define(r370,370);

!!       CntlRasterOp Functions
!        Bit 0 = LtoR
!        Bit 1 = RO/PS  (1 = RasterOp On)
Call(Rop);
         NextInst(0);

Loc(Rop), SrcBase := Tos, Pop;           ! source address, 20-bit offset
         SrcLine!        Bit 2:4 = RasterOp Functions
!        Bit 5 = XtraSrcWord
!        Bit 6 = disable processor shift

constant(Off,20Inc := Tos and AllOnes, Pop;  ! source words per scan line
         SrcY := Tos and AllOnes, Pop;  ! source Y
         SrcX :=0);          ! RasterOp Off
constant(PauseLR,100);      ! RasterOp Pause, processor shift is disabled
constant(PauseRL,101);
 Tos and AllOnes, if IntrPend call(IntrIt);  ! source X
         LeftSrc := Tos and 17;         ! leftmost source bit in word

constant(Phase0LR,102);     ! Begin       - NoClear
constant(Phase0XLR,142);    ! Begin       - NoClear - XtraSourceWord
con         tmp := Tos and 77, Pop;        ! source bit in quad
         DstBase := Tos, Pop;           ! destination address, 20-stant(Phase1LR,106);     ! Mid         - NoClear
constant(Phase2LR,112);     ! End         - NoClear
constant(Phase3LR,116);  bit offset
         DstLineInc := Tos and AllOnes, Pop;  ! destination words per scan line
         DstY := Tos and AllOnes, P   ! Begin/End   - NoClear
constant(Phase3XLR,156);    ! Begin/End   - NoClear - XtraSourceWord
constant(Phase4LR,122);     ! op;  ! destination Y
         DstX := Tos and AllOnes;       ! destination X
         LeftDst := Tos and 17;         ! leftmosXtraSource  - NoClear
constant(Phase5LR,126);     ! FirstSource - Clear
constant(Phase6LR,132);     ! End         - Clear
cont destination bit in word
         tmp1 := Tos and 77, Pop;       ! destination bit in quad
         LastDst := DstX;            	
-----
{
{ Spice Kernel Operations - Second byte of KOPS opcode
{
{---------------------------------------------------------------------------------------------------------
!
! Abstract:
!       Load the constant -1 onto the expression stack.
!
! I----------}

     KBLOCK            = 15;
     KUNBLOCK          = 14;
     KSLEEP            = 13;
     KWAKEUP           nstruction:
!       LDCMO
!
! Result:
!       Stack pushed.
!       (Tos) = -1.
!
!--------------------------------------= 12;
     KREMOVEFROMQUEUE  = 11;
     KADDTOQUEUE       = 10;
     KRESUMEMICROSTATE = 9;
     KCLOCKTICK        = 8;   { ---------------------------------------

! Opcode LDCN.
!--------------------------------------------------------------------temporary, for debugging }
     KINITQUEUES       = 7;
     KINTRSRV          = 6;   { temporary, for debugging }
     KINTRO---------
!
! Abstract:
!       LDCN is a one byte instruction that loads the constant Nil onto
!       the expression stackFF          = 5;
     KINTRON           = 4;
     KSETSOFT          = 3;
     KCLEARSOFT        = 2;
     KCURPROCESS       .  Nil is represented by two zero words.
!
! Instruction:
!       LDCN
!
! Result:
!       Stack pushed twice.
!       (T= 1;
     KUNUSED           = 0;
                                                                                             os) = 0.
!       (Tos-1) = 0.
!
!-----------------------------------------------------------------------------

! Opcode LD CB.
!-----------------------------------------------------------------------------
!
! Abstract:
!       LDCB is a two byte  instruction that loads a constant byte onto
!       the expression stack.
!
! Instruction:
!       LDCB    SignedByte
!
! = 14;
     LUNUSED   = 15;

{--------------------------------------------------------------------
{
{ Real Operations - Se cond byte of ROPS opcode
{
{--------------------------------------------------------------------}

     TNC       = 0;
    $Title LDCx - Constant one word loads.

! Opcode LDC0, LDC1, ..., LDC15.
!-------------------------------------------------- FLT       = 1;
     ADR       = 2;
     NGR       = 3;
     SBR       = 4;
     MPR       = 5;
     DVR       = 6;
     R---------------------------
!
! Abstract:
!       The LDCx opcodes are single byte instructions that load the
!       constaND       = 7;
     ABR       = 8;
     EQUReal   = 9;
     NEQReal   = 10;
     LEQReal   = 11;
     LESReal   = 12;
     nt x onto the expression stack.
!
! Instruction:
!       LDCx
!
! Result:
!       Stack pushed.
!       (Tos) = x.
!
!-GEQReal   = 13;
     GTRReal   = 14;
     RUNUSED   = 15;

{-------------------------------------------------------------------------------------------------------------------------------------------

! Opcode LDCMO.
!------------------------------  	
ith a fetch.  For some obscure reason,
!        memory cycles are numbered differently here:  T1 is the cycle a
!        FetchgQ2T2: if Neq GoTo(BegQ2T3b);                   !   2 away if > 2 quads
BegQ2T3: CntlRasterOp(Phase6LR);                  !   3 starts in.
!
!        Labels on micro-instructions indicate the action being performed:
!
!        Xsr - Extra source fetch else, this is the end
         nop;                                     !Q0 0  End
         DstQuad := DstQuad + 4, Fetch4, C cycle.
!        Beg - Begin cycle.
!        Mid - Middle cycle.
!        End - End cycle.
!        BgE - Begin/End cycle.
all(LREndCom); !   1
         XtraSrcFetch, If Lss GoTo(ExitRO);       !Q2 0
EndQ2T1: XtraSrcWord, IF ByteSign GoTo(XsrQ2T2); !
!        Qn - Quad timing cycle n.
!        Tn - Micro timing cycle n.

         DstQuad := DstQuad - DstLineInc, Fetch, C !   1
         nop;                                     !   2
EndQ2T3: CntlRasterOp(Phase4LR);                  !   3
XsrQ0Tall(Nop1); !synchronize
         CntlRasterOp(Phase5LR);                  !t3  and here we go
         Hold, LoadS(IntrCom);  0: Hold;                                    !Q0 0  Xtra Src
         SrcQuad := SrcQuad + 4, Fetch4, GoTo(XsrQ0T2); !   1

Beits
         Width := Width and AllOnes;
         Func := not Tos;               ! function code
Rop0:    tmp1 + Width, Right                  !Q0 0 First Src is always 1st
         SrcQuad := SrcQuad, Fetch4, call(Nop1);  !   1
         OneQuad;     Shift(6);
         MidNum := Shift - 1;           ! # of middle quads (quad width - 2)
         OneQuad := 200, if Geq goto(Ro                            !   3
         XtraSrcFetch, Hold, if geq GoTo(EndQ2T1);!Q2 0
         XtraSrcWord, If ByteSign Gop1);     ! clear all flags
         OneQuad := OneQuad or 100000;          ! set one quad
Rop1:    Flag := 0, if IntrPend callTo(XsrQ2T2b); !   1
         GoTo(EndQ2T3);                           !   2

XsrQ0T2: nop, call(Nop1);                       (IntrIt);
         tmp + Width, RightShift(6);
         Shift;
         Tos := SrcBase - DstBase, if Neq goto(Rop2);  ! if so  !Q0 2 Xtra Src has only 2
         OneQuad, Hold;                           !Q2 0         quad cycles
         XtraSrcWord, urce > 1 quad
         Flag := 200;                   ! set 1 source quad
Rop2:    Tos - 1;                       ! 20-bit equIf lss Goto(XsrQ2T2b);      !   1
XsrQ2T2: If Odd GoTo(XsrQ2T3b);                   !   2
XsrQ2T3: CntlRasterOp(Phase0LR);    ality test
         SrcY - DstY, if C19 goto(Compare);     ! if Eql, compare X and Y

!!       Perform raster-op left to rig              !   3
BegQ0T0: If IntrPend GoTo(IntrB);                 !Q0 0  Begin
         DstQuad := DstQuad + DstLineInc, Fht if
!               (SrcBase <> DstBase) or
!               ((SrcBase = DstBase) and
!                ((SrcY > DstY) or ((Setch4, call(Nop1); !   1
BegQ0T3: nop, call(Nop1);                         !   3
BegQ1T1: SrcQuad := SrcQuad + 4, Fetch4;     rcY = DstY) and (SrcX >= DstX))))

LtoR:    LastDst := LastDst + Width, call(SetUp);

!        Synchronize memory and code w     !Q1 1
         MA := DstQuad, Store4, call(Nop2);       !   2
         MidCnt := MidNum;                        !Q0 1
Be 	  	
------------------
!
! Abstract:
!       LDCW is a three byte instruction that loads a constant word onto
!       the expresdes are single byte instructions that load local
!       variables with offset x onto the expression stack.
!
! Instruction:sion stack.
!
! Instruction:
!       LDCB    LowByteConstant HighByteConstant
!
! Result:
!       Stack pushed.
!       (
!       LDLx
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[LP + x].
!
!---------------------------------------Tos) = Constant.
!
! Calls:
!       WordParm.
!
!----------------------------------------------------------------------------------------------------------------

! Opcode LDLB.
!------------------------------------------------------------------------

LoadZero:
Opcode(LDC0),  Tos :=  0, Push, NextInst(0);

Opcode(LDC1),  Tos :=  1, Push, NextInst(0);

Opcode(LDC2), --------
!
! Abstract:
!       LDLB is a two byte instruction that loads a local variable with an
!       offset in the rang Tos :=  2, Push, NextInst(0);

Opcode(LDC3),  Tos :=  3, Push, NextInst(0);

Opcode(LDC4),  Tos :=  4, Push, NextInst(0);
e 0..255 onto the expression stack.
!
! Instruction:
!       LDLB    Offset
!
! Result:
!       Stack pushed.
!       (To
Opcode(LDC5),  Tos :=  5, Push, NextInst(0);

Opcode(LDC6),  Tos :=  6, Push, NextInst(0);

Opcode(LDC7),  Tos :=  7, Pushs) = Memory[LP + Offset].
!
!-----------------------------------------------------------------------------

! Opcode LDLW.
, NextInst(0);

Opcode(LDC8),  Tos := 10, Push, NextInst(0);

Opcode(LDC9),  Tos := 11, Push, NextInst(0);

Opcode(LDC10),!-----------------------------------------------------------------------------
!
! Abstract:
!       LDLW is a three byte ins Tos := 12, Push, NextInst(0);

Opcode(LDC11), Tos := 13, Push, NextInst(0);

Opcode(LDC12), Tos := 14, Push, NextInst(0);
truction that loads a local variable with
!       an offset in the range 0..65535 onto the expression stack.
!
! Instruction:
Opcode(LDC13), Tos := 15, Push, NextInst(0);

Opcode(LDC14), Tos := 16, Push, NextInst(0);

Opcode(LDC15), Tos := 17, Push
!       LDLW    LowByteOffset HighByteOffset
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[LP + Offset].
!
! , NextInst(0);

Opcode(LDCMO), Tos := AllOnes, Push, NextInst(0);

Opcode(LDCN), Tos := Zero, Push, Goto(LoadZero);

OpcodCalls:
!       VectSrv, WordParm.
!
!-----------------------------------------------------------------------------

Opcode(e(LDCB), tmp := NextOp;
        Tos := tmp, Push, if ByteSign Goto(ExtendByte);
Nxt:    NextInst(0);

Opcode(LDCW), Call(WorLDL0),  LP +  0, Fetch, Goto(LoadLocal);

Opcode(LDL1),  LP +  1, Fetch, Goto(LoadLocal);

Opcode(LDL2),  LP +  2, Fetch, GoResult:
!       Stack pushed.
!       (Tos) = SignedByte.
!
! Calls:
!       ExtendByte.
!
!-----------------------------dParm);
        Tos := Shift or tmp, Push, NextInst(0);




$Title LDLx - Load local variable.

! Opcode LDL0, LDL1, ..------------------------------------------------

! Opcode LDCW.
!-----------------------------------------------------------., LDL15.
!-----------------------------------------------------------------------------
!
! Abstract:
!       The LDLx opco 	 	
 Begin
         DstQuad := DstQuad + DstLineInc, Fetch4; !   1
         GoTo(BegQ0T3);                           !Q0 2
      trC:   CntlRasterOp(Off), CallS;           !Interrupt in Begin/End
         GoTo(XsrQ2T3c);                     !Happens at t2,  
XsrQ2T2b:If Odd GoTo(XsrQ2T3d);                   !Q2 2  Xtra Src
XsrQ2T3c:CntlRasterOp(Phase7LR);                  !   3
 will return to t3

IntrD:   CntlRasterOp(Off), CallS;           !Interrupt in Begin/End XtraSrc
         GoTo(XsrQ2T3d);    BgEQ0T0: If IntrPend GoTo(IntrC);                 !Q0 0  Begin/End
         DstQuad := DstQuad + DstLineInc, Fetch4, Call(LREnd                 !Happens at t2, will return to t3

IntrE:   CntlRasterOp(Off), CallS;           !Interrupt in Begin XtraSrc
Com); !   1
         XtraSrcFetch, Hold, If Lss GoTo(ExitRO); !Q2 0
         XtraSrcWord, IF ByteSign GoTo(XsrQ2T2b); !   1
          GoTo(XsrQ2T3b);                     !Happens at t2, will return to t3

!!       Compare source start bit with destin        GoTo(EndQ2T3);                           !   2

XsrQ2T3d:CntlRasterOp(Phase7XLR);                 !Q2 3  Xtra Src
   ation start bit.

Compare: SrcY - DstY, if Gtr goto(LtoR);        ! if SrcY > DstY
         SrcX - DstX, if Neq goto(RtoL);        If IntrPend GoTo(IntrD);                 !Q0 0  Begin/End
         DstQuad := DstQuad + DstLineInc, Fetch4, Call(LREndCom      ! if SrcY < DstY
                      if Geq goto(LtoR);        ! if SrcX >= DstX

!!       Perform raster-op right t); !   1
         XtraSrcFetch, If Lss GoTo(ExitRO);       !Q2 0
         XtraSrcWord, Hold, IF ByteSign GoTo(XsrQ2T2b); !   1o left if
!               (SrcBase = DstBase) and
!               ((SrcY < DstY) or ((SrcY = DstY) and (SrcX < DstX)))

RtoL
         GoTo(EndQ2T3);                           !   2
        
LREndCom:nop, call(Nop2);                         !Q0 2 End:    SrcY := SrcY + Height;                 ! start X, Y for RtoL case
         SrcX := SrcX + Width;
         DstY := DstY + gQ2T3b:0, CntlRasterOp(Phase1LR);               !Q2 3  no Video interrupt
MidQ0T0: If Neq GoTo(IntrA);                      !Q0 and Begin/End
         SrcQuad := SrcQuad + SrcLineInc, Fetch4; !Q1 1
         MA := DstQuad, Store4;                   !   2 0  Mid
         DstQuad := DstQuad + 4, Fetch4, call(Nop3);!   1
         SrcQuad := SrcQuad + 4, Fetch4;          !Q1 1
   
         Height := Height - 1, Return;            !   3

IntrA:   CntlRasterOp(PauseLR);              !Video interrupt in Mi      MA := DstQuad, Store4, call(Nop2);       !   2
         IOB(145), MidCnt := MidCnt - 1;          !Q2 1  Video state
    ddle
         Call(VidInt);                       !Video interrupt service
         Call(IntrComA);                     !join      tmp := IOD and 20, if eql goto(BegQ2T3); !   2  Video interrupt bit
         tmp, GoTo(MidQ0T0);                      !   common code in IntrCom
         GoTo(BegQ2T3b);                     !Happens at t2, will return to t3

IntrB:   CntlRasterOp(3

XsrQ2T3b:CntlRasterOp(Phase0XLR);                 !Q2 3  Xtra Src
         if IntrPend GoTo(IntrE);                 !Q0 0 Off), CallS;           !Interrupt in Begin
         GoTo(XsrQ2T3);                      !Happens at t2, will return to t3

In 
  	

!       LLAW is a three byte instruction that loads the address of a local
!       variable with an offset in the range 0..655----------------

! Opcode STLW
!-----------------------------------------------------------------------------
!
! Abstractto(LoadLocal);

Opcode(LDL3),  LP +  3, Fetch, Goto(LoadLocal);

Opcode(LDL4),  LP +  4, Fetch, Goto(LoadLocal);

Opcode(L35 onto the expression
!       stack.
!
! Instruction:
!       LLAW    LowByteOffset HighByteOffset
!
! Result:
!       SDL5),  LP +  5, Fetch, Goto(LoadLocal);

Opcode(LDL6),  LP +  6, Fetch, Goto(LoadLocal);

Opcode(LDL7),  LP +  7, Fetch, Gottack pushed.
!       (Tos) = LP - SB + Offset.
!
! Calls:
!       VectSrv, WordParm.
!
!----------------------------------o(LoadLocal);

Opcode(LDL8),  LP + 10, Fetch, Goto(LoadLocal);

Opcode(LDL9),  LP + 11, Fetch, Goto(LoadLocal);

Opcode(LD-------------------------------------------

Opcode(LLAB), tmp := NextOp + LP;
LoadLAddr: Tos := tmp - SB, Push, NextInst(0);L10), LP + 12, Fetch, Goto(LoadLocal);

Opcode(LDL11), LP + 13, Fetch, Goto(LoadLocal);

Opcode(LDL12), LP + 14, Fetch, Goto

Opcode(LLAW), Call(WordParm);
        tmp := Shift or tmp, if IntrPend Call(VectSrv);
        tmp := tmp + LP, GoTo(LoadLA(LoadLocal);

Opcode(LDL13), LP + 15, Fetch, Goto(LoadLocal);

Opcode(LDL14), LP + 16, Fetch, Goto(LoadLocal);

Opcode(LDLddr);




$Title STLx - Store local variable.

! Opcode STL0, STL1, ..., STL7.
!---------------------------------------15), LP + 17, Fetch, Goto(LoadLocal);

Opcode(LDLB), tmp := NextOp;
        LP + tmp, Fetch;
LoadLocal: Tos := Mdi, Push, Ne--------------------------------------
!
! Abstract:
!       The STLx opcodes are single byte instructions that store local
xtInst(0);

Opcode(LDLW), Call(WordParm);
        tmp := Shift or tmp, if IntrPend Call(VectSrv);
        LP + tmp, Fetch, G!       variable with offset x from the expression stack.
!
! Instruction:
!       STLx
!
! Environment:
!       (Tos) = Voto(LoadLocal);




$Title LLAx - Load local address.

! Opcode LLAB.
!------------------------------------------------alue.
!
! Result:
!       Stack popped.
!       Memory[LP + x] = Value.
!
!----------------------------------------------------------------------------
!
! Abstract:
!       LLAB is a two byte instruction that loads the address of a local
!      ------------------------------

! Opcode STLB.
!----------------------------------------------------------------------------- variable with an offset in the range 0..255 onto the expression stack.
!
! Instruction:
!       LLAB    Offset
!
! Result:
!
! Abstract:
!       STLB is a two byte instruction that stores a local variable with
!       an offset in the range 0..25
!       Stack pushed.
!       (Tos) = LP - SB + Offset.
!
!----------------------------------------------------------------5 from the expression stack.
!
! Instruction:
!       STLB    Offset
!
! Environment:
!       (Tos) = Value.
!
! Result:-------------

! Opcode LLAW.
!-----------------------------------------------------------------------------
!
! Abstract:
!       Stack popped.
!       Memory[LP + Offset] = Value.
!
!------------------------------------------------------------- 
 	
rts in.
!
!        Labels on micro-instructions indicate the action being performed:
!
!        Xsr - Extra source fetch cyc3 else, this is the end
         nop;                                     !Q0 0  End
         DstQuad := DstQuad - 4, Fetch4R,le.
!        Beg - Begin cycle.
!        Mid - Middle cycle.
!        End - End cycle.
!        BgE - Begin/End cycle.
!
! Call(RLEndCom); !   1
         XtraSrcFetch, Hold, If Lss GoTo(ExitRO); !Q2 0
EndK2T1: XtraSrcWord, IF ByteSign GoTo(XsrK2T2)        Kn - Quad timing cycle n (Qn).
!        Tn - Micro timing cycle n.

         DstQuad := DstQuad + DstLineInc, Fetch, ;  !   1
         nop;                                     !   2
EndK2T3: CntlRasterOp(Phase4RL);                  !   3
XsrKCall(Nop1); !synchronize
         CntlRasterOp(Phase5RL);                  !t3  and here we go
         Hold, LoadS(IntrCom); 0T0: Hold;                                    !Q0 0  Xtra Src
         SrcQuad := SrcQuad - 4, Fetch4R, GoTo(XsrK0T2);!   1

                   !Q0 0 First Src is always 1st
         SrcQuad := SrcQuad, Fetch4R, call(Nop1); !   1
         OneQuad;    BegK2T3b:0, CntlRasterOp(Phase1RL);               !Q2 3  no Video interrupt
MidK0T0: If Neq GoTo(IntrF);                      !                             !   3
         XtraSrcFetch, Hold, if geq GoTo(EndK2T1);!Q2 0
         XtraSrcWord, If ByteSign GQ0 0  Mid
         DstQuad := DstQuad - 4, Fetch4R, call(Nop3);!   1
         SrcQuad := SrcQuad - 4, Fetch4R;         !Q1 1
oTo(XsrK2T2b); !   1
         GoTo(EndK2T3);                           !   2

XsrK0T2: nop, call(Nop1);                               MA := DstQuad, Store4R, call(Nop2);      !   2
         IOB(145), MidCnt := MidCnt - 1;          !Q2 1  Video state
    !Q0 2 Xtra Src has only 2
         OneQuad, Hold;                           !Q2 0         quad cycles
         XtraSrcWord,        tmp := IOD and 20, if eql goto(BegK2T3); !   2  Video interrupt bit
         tmp, GoTo(MidK0T0);                      ! If lss Goto(XsrK2T2b);      !   1
XsrK2T2: If Odd GoTo(XsrK2T3b);                   !   2
XsrK2T3: CntlRasterOp(Phase0RL);      3

XsrK2T3b:CntlRasterOp(Phase0XRL);                 !Q2 3  Xtra Src
         If IntrPend GoTo(IntrJ);                 !Q0               !   3
BegK0T0: If IntrPend GoTo(IntrG);                 !Q0 0  Begin
         DstQuad := DstQuad - DstLineInc,  0  Begin
         DstQuad := DstQuad - DstLineInc, Fetch4R;!   1
         GoTo(BegK0T3);                           !Q0 2
   Fetch4R, call(Nop1);!   1
BegK0T3: nop, call(Nop1);                         !   3
BegK1T1: SrcQuad := SrcQuad - 4, Fetch4R;        
XsrK2T2b:If Odd GoTo(XsrK2T3d);                   !Q2 2  Xtra Src
XsrK2T3c:CntlRasterOp(Phase7RL);                  !   Height;
         DstX := DstX + Width;
         Direction := not 0, call(SetUp);

!        Synchronize memory and code with       !Q1 1
         MA := DstQuad, Store4R, call(Nop2);      !   2
         MidCnt := MidNum;                        !Q2 1
Ba fetch.  For some obscure reason,
!        memory cycles are numbered differently here:  T1 is the cycle a
!        Fetch staegK2T2: if Neq GoTo(BegK2T3b);                   !   2 away if > 2 quads
BegK2T3: CntlRasterOp(Phase6RL);                  !      	
, LDO1, ..., LDO15.
!-----------------------------------------------------------------------------
!
! Abstract:
!       The  GP +  5, Fetch, Goto(LoadOwn);

Opcode(LDO6),  GP +  6, Fetch, Goto(LoadOwn);

Opcode(LDO7),  GP +  7, Fetch, Goto(LoadOwn LDOx opcodes are single byte instructions that load own
!       variables with offset x onto the expression stack.
!
! Instr);

Opcode(LDO8),  GP + 10, Fetch, Goto(LoadOwn);

Opcode(LDO9),  GP + 11, Fetch, Goto(LoadOwn);

Opcode(LDO10), GP + 12, uction:
!       LDOx
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[GP + x].
!
!-------------------------------Fetch, Goto(LoadOwn);

Opcode(LDO11), GP + 13, Fetch, Goto(LoadOwn);

Opcode(LDO12), GP + 14, Fetch, Goto(LoadOwn);

Opcod----------------------------------------------

! Opcode LDOB.
!-------------------------------------------------------------e(LDO13), GP + 15, Fetch, Goto(LoadOwn);

Opcode(LDO14), GP + 16, Fetch, Goto(LoadOwn);

Opcode(LDO15), GP + 17, Fetch, Goto:
!       STLW is a three byte instruction that stores a local variable with
!       an offset in the range 0..65535 from the ----------------
!
! Abstract:
!       LDOB is a two byte instruction that loads an own variable with an
!       offset in texpression stack.
!
! Instruction:
!       STLW    LowByteOffset HighByteOffset
!
! Environment:
!       (Tos) = Value.
!he range 0..255 onto the expression stack.
!
! Instruction:
!       LDOB    Offset
!
! Result:
!       Stack pushed.
!   
! Result:
!       Stack popped.
!       Memory[LP + Offset] = Value.
!
! Calls:
!       VectSrc, WordParm.
!
!---------    (Tos) = Memory[GP + Offset].
!
!-----------------------------------------------------------------------------

! Opcode --------------------------------------------------------------------

Opcode(STL0), LP + 0, Store, Goto(StoreLocal);

OpcodeLDOW
!-----------------------------------------------------------------------------
!
! Abstract:
!       LDOW is a three by(STL1), LP + 1, Store, Goto(StoreLocal);

Opcode(STL2), LP + 2, Store, Goto(StoreLocal);

Opcode(STL3), LP + 3, Store, Goto(te instruction that loads an own variable with an
!       offset in the range 0..65535 onto the expression stack.
!
! InstrucStoreLocal);

Opcode(STL4), LP + 4, Store, Goto(StoreLocal);

Opcode(STL5), LP + 5, Store, Goto(StoreLocal);

Opcode(STL6)tion:
!       LDOW    LowByteOffset HighByteOffset
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[GP + Offset].
, LP + 6, Store, Goto(StoreLocal);

Opcode(STL7), LP + 7, Store, Goto(StoreLocal);

StoreLocal: Tos, Pop, NextInst(0);

Op!
! Calls:
!       VectSrv, WordParm.
!
!-----------------------------------------------------------------------------

Opcode(STLB), tmp := NextOp;
STLB1:  LP + tmp, Store;
        Tos, Pop, NextInst(0);

Opcode(STLW), Call(WordParm);
        tcode(LDO0),  GP +  0, Fetch, Goto(LoadOwn);

Opcode(LDO1),  GP +  1, Fetch, Goto(LoadOwn);

Opcode(LDO2),  GP +  2, Fetch, Gmp := Shift or tmp, if IntrPend Call(VectSrv);
        Goto(STLB1);




$Title LDOx - Load own variable.

! Opcode LDO0oto(LoadOwn);

Opcode(LDO3),  GP +  3, Fetch, Goto(LoadOwn);

Opcode(LDO4),  GP +  4, Fetch, Goto(LoadOwn);

Opcode(LDO5),  	
o t3

IntrI:   CntlRasterOp(Off), CallS;           !Interrupt in Begin/End XtraSrc
         GoTo(XsrK2T3d);                        another special case: 40 words/line.  the MoveMem routine depends
!        on raster-op being able to do a 20-bit multipl3
BgEK0T0: If IntrPend GoTo(IntrH);                 !Q0 0  Begin/End
         DstQuad := DstQuad - DstLineInc, Fetch4R, Call(R   !Happens at t2, will return to t3

IntrJ:   CntlRasterOp(Off), CallS;           !Interrupt in Begin XtraSrc
         GoTo(LEndCom);!   1
         XtraSrcFetch, Hold, If Lss GoTo(ExitRO); !Q2 0
         XtraSrcWord, IF ByteSign GoTo(XsrK2T2b); !   1XsrK2T3b);                     !Happens at t2, will return to t3

!!       exit from raster-op.

ExitRO:  CntlRasterOp(Off)
         GoTo(EndK2T3);                           !   2

XsrK2T3d:CntlRasterOp(Phase7XRL);                 !Q2 3  Xtra Src
;
         Pop, Return;

        
!!       common interrupt routine.

IntrCom: Call(IntrIt);
IntrComA:SrcRasterOp := SrcR         If IntrPend GoTo(IntrI);                 !Q0 0  Begin/End
         DstQuad := DstQuad - DstLineInc, Fetch4R, Call(RLEnas;         ! restore SrcRasterOp
         DstRasterOp := DstRas;         ! restore DstRasterOp
         Fetch, Return;       dCom);!   1
         XtraSrcFetch, If Lss GoTo(ExitRO);       !Q2 0
         XtraSrcWord, IF ByteSign GoTo(XsrK2T2b); !   1
           ! Happens at t1

        
!!       SetUp.

SetUp:   Flag := Flag or 1, if IntrPend call(IntrIt);  ! first time t        GoTo(EndK2T3);                           !   2

RLEndCom:nop, call(Nop2);                         !Q0 2 End and Begin/hru
         tmp1 := SrcLineInc;
         DstQuad := SrcX, LeftShift(4);
Set1:    tmp1 - 60;
         SrcY, if Neq goto(Set3End
         SrcQuad := SrcQuad - SrcLineInc, Fetch4R;!Q1 1
         MA := DstQuad, Store4R;                  !   2
         );               ! if not 60

!        special case: 60 words/line.

         tmp := Shift + SrcBase;                ! 20*Y Height := Height - 1, Return;            !   3

IntrF:   CntlRasterOp(PauseRL);              !Video interrupt Middle
        + BaseAddress
         SrcY, LeftShift(5);
         tmp := Shift + tmp;                    ! 40*Y + 20*Y + Base
Set2:    DstQ Call(VidInt);                       !Video interrupt service
         Call(IntrComA);                     !Join common code inuad, RightShift(4);
         DstQuad := Shift + tmp;                ! X div 20 + LineLength*Y + Base
         Flag := Flag xor IntrCom
         GoTo(BegK2T3b);                     !Happens at t2, will return to t3

IntrG:   CntlRasterOp(Off), CallS;   1;
         DstQuad := DstQuad + SB, if Odd goto(Set6);  ! physical address
         SrcQuad := DstQuad;                    !         !Interrupt in Begin
         GoTo(XsrK2T3);                      !Happens at t2, will return to t3

IntrH:   CntlRas roll down
         SrcY := DstY;
         DstQuad := DstX;
         SrcBase := DstBase, LeftShift(4);
         tmp1 := DstLterOp(Off), CallS;           !Interrupt in Begin/End
         GoTo(XsrK2T3c);                     !Happens at t2, will return tineInc, goto(Set1);
         
Set3:    tmp1 - 40;
         tmp := SrcY, if Neq goto(Set4);        ! if not 40
         
!     	
----

! Opcode LOAW.
!-----------------------------------------------------------------------------
!
! Abstract:
!       ack popped.
!       Memory[GP + Offset] = Value.
!
!-------------------------------------------------------------------------LOAW is a three byte instruction that loads the address of an own
!       variable with an offset in the rang 0..65535 onto the----

! Opcode STOW.
!-----------------------------------------------------------------------------
!
! Abstract:
!        expression
!       stack.
!
! Instruction:
!       LOAW    LowByteOffset HighByteOffset
!
! Result:
!       Stack pushedSTOW is a three byte instruction that stores an own variable with
!       an offset in the range 0..65535 from the expression s.
!       (Tos) = GP - SB + Offset.
!
! Calls:
!       VectSrv, WordParm.
!
!---------------------------------------------tack.
!
! Instruction:
!       STOW    LowByteOffset HighByteOffset
!
! Environment:
!       (Tos) = Value.
!
! Result:--------------------------------

Opcode(LOAB), tmp := NextOp + GP;
LoadOAddr: Tos := tmp - SB, Push, NextInst(0);

Opcode(
!       Stack popped.
!       Memory[GP + Offset] = Value.
!
! Calls:
!       VectSrc, WordParm.
!
!---------------------LOAW), Call(WordParm);
        tmp := Shift or tmp, if IntrPend Call(VectSrv);
        tmp := tmp + GP, GoTo(LoadOAddr);


--------------------------------------------------------

Opcode(STO0), GP + 0, Store, Goto(StoreOwn);

Opcode(STO1), GP + 1

$Title STOx - Store own variable.

! Opcode STO0, STO1, ..., STO7.
!----------------------------------------------------, Store, Goto(StoreOwn);

Opcode(STO2), GP + 2, Store, Goto(StoreOwn);

Opcode(STO3), GP + 3, Store, Goto(StoreOwn);

Opco(LoadOwn);

Opcode(LDOB), tmp := NextOp;
        GP + tmp, Fetch, Goto(LoadOwn);

Opcode(LDOW), Call(WordParm);
        tm-------------------------
!
! Abstract:
!       The STOx opcodes are single byte instructions that store own
!       variablp := Shift or tmp, if IntrPend Call(VectSrv);
        GP + tmp, Fetch, Goto(LoadOwn);

LoadOwn: Tos := Mdi, Push, NextInst(0)es with offset x from the expression stack.
!
! Instruction:
!       STOx
!
! Environment:
!       (Tos) = Value.
!
! Re;




$Title LOAx - Load own address.

! Opcode LOAB.
!----------------------------------------------------------------sult:
!       Stack popped.
!       Memory[GP + x] = Value.
!
!
!-----------------------------------------------------------------------
!
! Abstract:
!       LOAB is a two byte instruction that loads the address of an own
!       variable with an-------------------

! Opcode STOB.
!-----------------------------------------------------------------------------
!
! Abst offset in the rang 0..255 onto the expression
!       stack.
!
! Instruction:
!       LOAB    Offset
!
! Result:
!      ract:
!       STOB is a two byte instruction that stores an own variable with
!       an offset in the range 0..255 from the e Stack pushed.
!       (Tos) = GP - SB + Offset.
!
!-------------------------------------------------------------------------xpression stack.
!
! Instruction:
!       STOB    Offset
!
! Environment:
!       (Tos) = Value.
!
! Result:
!       St  	

!        set SrcRasterOp.

         Tos := SrcBinQ and 60;
         tmp := Tos or LeftSrc;
         Func and 14, LeftShift(----------------------------
!
! Abstract:
!       DrawByte puts characters from a byte array onto the screen.  It draws
!  4);             !No Power Down and Function[2]
         SrcRas := SrcRasterOp := Shift or tmp;
         
!        set DstRast     until a character count is exhausted, a screen width is exhausted, or
!       a control character is reached.
!
! EnviroerOp.
 
         Tos := DstBinQ and 60;
         tmp := Tos or LeftDst;
         Func and 3, LeftShift(6);
         DstRas nment:
!       (Tos)   = Maximum X-coordinate + 1.
!       (Tos-1) = Maximum byte offset + 1.
!       (Tos-2) = Byte offset f:= DstRasterOp := Shift or tmp;
         
!        set XtraSrcFetch and XtraSrcWord.
         
         Flag;
         Tos rom the beginning of the byte array.
!       (Tos-3) = Address of the byte array as an offset from the base of the
!          y by 40 words/line.

         tmp := tmp + tmp;                      ! 2 * SrcY
         tmp := tmp + tmp;                   := DstBinQ - SrcBinQ, if ByteSign goto(Set7);
                                                ! if XtraSrcFetch not possible
    ! 4 * SrcY
         tmp := tmp + tmp;                      ! 10 * SrcY
         tmp := tmp + tmp;                      ! 20        Tos xor Direction;
         if Geq goto(Set7);                     ! if no extra source fetch
         XtraSrcFetch := * SrcY
         tmp := tmp + tmp, goto(Set5);          ! 40 * SrcY

Set4:    tmp := SrcY, call(Mult);               ! comput XtraSrcFetch and not 200;  ! set extra source fetch
         SrcLineInc := SrcLineInc - 4;
Set7:    Tos := DstBinW - SrcBinW;e SrcLineInc * SrcY
Set5:    tmp := tmp + SrcBase, goto(Set2);
         
Set6:    Tos := SrcBinQ := SrcX and 77, if IntrPend 
         Tos xor Direction;
         if Geq return;                         ! if no extra source word
         XtraSrcWord :call(IntrIt);
         SrcBinW := Tos and 17;
         Tos := DstBinQ := DstX and 77;
         DstBinW := Tos and 17;
      = XtraSrcWord or 1, return;  ! set extra source word

!!       spending time doing nothing.

Nop3:    Hold;
Nop2:    Hold;   
!        set DstRasterOp.
         
         LastDst := LastDst and 60;
         Tos := Width and 17;
         WidRaste
Nop1:    Hold, return;


!!       vector off to the interrupt handler.

IntrIt:  Vector(IntVec);


        Define(MaxrOp := Tos or LastDst;
         
!        set SrcLineInc and DstLineInc.
         
         Func := Func or 10, LeftShift(2)X, 130);
        Define(MaxByte, 131);
        Define(CSet, 132);
        Define(Screen, 133);
        Define(X, 134);
    ;      !will be No Power Down bit
         MidNum + 1;
         tmp := Shift;                          ! width in words
         Define(Y, 135);
        Define(RFunc, 136);
        
        Define(CharWidth, 137);
        Define(FontHeight, 140);
     SrcLineInc := SrcLineInc - tmp;
         DstLineInc := DstLineInc - tmp,if IntrPend call(IntrIt); ! last chance
                Define(Ch, 141);
        Define(C402, 142);


! Routine DrawByte.
!-------------------------------------------------   	
, Store, Goto(StoreOwn);




$Title LDGx - Load global variable.

! Opcode LDGB.
!-------------------------------------ct:
!       LGAB is a three byte instruction that loads the address of a global
!       variable onto the expression stack.  T----------------------------------------
!
! Abstract:
!       LDGB is a three byte instruction that loads a global variable he segment number must be
!       in the range 0..255, and the offset must be in the range 0..255.
!
! Instruction:
!       onto
!       the expression stack.  The segment number must be in the range
!       0..255 and the offset must be in the rangeLGAB    Segment Offset
!
! Result:
!       Stack pushed.
!       (Tos) = GlobalArea - SB + Offset.
!
! Calls:
!       Get 0..255.
!
! Instruction:
!       LDGB    Segment Offset
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[GlobalAGP.
!
!-----------------------------------------------------------------------------

! Opcode LGAW.
!---------------------rea + Offset].
!
! Calls:
!       GetGP.
!
!-----------------------------------------------------------------------------
--------------------------------------------------------
!
! Abstract:
!       LGAW is a three byte instruction that loads th
! Opcode LDGW.
!-----------------------------------------------------------------------------
!
! Abstract:
!       LDGW ie address of a global
!       variable onto the expression stack.  The segment number must be
!       in the range 0..255, ands a four byte instruction that loads a global variable onto
!       the expression stack.  The segment number must be in the ra the offset must be in the range 0..65535.
!
! Instruction:
!       LGAW    Segment LowByteOffset HighByteOffset
!
! Resultnge
!       0..255 and the offset must be in the range 0..65535.
!
! Instruction:
!       LDGW    Segment LowByteOffset High:
!       Stack pushed.
!       (Tos) = GlobalArea - SB + Offset.
!
! Calls:
!       GetGP, WordParm.
!
!----------------ByteOffset
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[GlobalArea + Offset].
!
! Calls:
!       GetGP, VectS-------------------------------------------------------------

! Opcode LGAWW.
!---------------------------------------------rv, WordParm.
!
!-----------------------------------------------------------------------------

Opcode(LDGB), tmp2 := NextOp--------------------------------
!
! Abstract:
!       LGAWW is a four byte instruction that loads the address of a global
!de(STO4), GP + 4, Store, Goto(StoreOwn);

Opcode(STO5), GP + 5, Store, Goto(StoreOwn);

Opcode(STO6), GP + 6, Store, Goto(St;
        tmp3 := NextOp;
LoadGlobal:  Call(GetGP);
        tmp2 + tmp3, Fetch;
        Tos := Mdi, Push, NextInst(0);

OporeOwn);

Opcode(STO7), GP + 7, Store, Goto(StoreOwn);

Opcode(STOB), tmp := NextOp;
        GP + tmp, Store;
StoreOwn: Tocode(LDGW), tmp2 := NextOp;
        Call(WordParm);
        tmp3 := Shift + tmp, Goto(LoadGlobal);




$Title LGAx - Loads, Pop, NextInst(0);

Opcode(STOW), Call(WordParm);
        tmp := Shift or tmp, if IntrPend Call(VectSrv);
        GP + tmp global address.

! Opcode LGAB.
!-----------------------------------------------------------------------------
!
! Abstra  	
---------

Loc(DrawByte), MaxX := Tos, Pop;
        MaxByte := Tos, Pop;
        SrcByte := Tos, Pop;
        SrcWord := Todth, Goto(DB6);

DB6:    Tos := SrcByte, Push;
        Tos := X, Push, NextInst(0);
                                        s + SB, Pop;
        CSet := Tos + SB, Pop;
        Screen := Tos, Pop;
        Y := Tos, Pop;
        CSet, Fetch2;
         X := Tos, Pop;
        RFunc := Tos, Pop;
        FontHeight := Mdi;
        tmp := Mdi;
        Y := Y - tmp;
        CS et := CSet + 2;
        C402 := 402;
        C402 := C402 - SB;
DB1:    SrcByte - MaxByte, RightShift(1);
        SrcByte, i$Title Line drawing microcode.
!!!     Line - Perq line drawing micro-code.
!
!       J. Strait       10 April 80.
!       Tf Geq Goto(DB3);       ! if character count exhausted
        Shift + SrcWord, Fetch;
        SrcByte xor 1, Rotate(10);
    hree Rivers Computer Corporation.
!
!       See ACM algorithm 162:
!               XYMove Plotting
!               Fred G. S    Ch := Mdi, if Odd Goto(DB2);
        Ch := Shift;
DB2:    Ch := Ch and 177;
        Ch and not 37, LeftShift(1);
       tockton
!
!
!       Calling sequence:
!
!       push Style
!       push X1;
!       push Y1;
!       push X2;
!       p Ch, if Eql Goto(DB4);            ! if control character
        Shift + CSet, Fetch2;
        tmp := FontHeight;
        tmpush Y2;
!       push Origin;
!       call Line;
!
!
!       Style = 1       Erase line.
!               2       Xor line.       memory stack.
!       (Tos-4) = Character set address as an offset from the base of the
!                 memory stack.2 := Mdi;
        CharWidth := Mdi;
        X := X + CharWidth;
        X - MaxX, RightShift(12);
        tmp2, if Gtr Goto(
!       (Tos-5) = Destination base address as an offset from the base of the
!                 memory stack.
!       (Tos-6)DB5);          ! if screen width exhausted
        tmp1 := Shift, Call(Mult);       ! tmp will contain SrcY
        Tos := RFu = Destination Y-coordinate.
!       (Tos-7) = Destination X-coordinate.
!       (Tos-8) = Raster-op function.
!
! Result:
nc, Push;
        Tos := CharWidth, Push;
        Tos := FontHeight, Push;
        Tos := X - CharWidth, Push;
        Tos :!       Stack popped three times.
!       (Tos)   = Current X-Coordinate.
!       (Tos-1) = Next byte offset.
!       (Tos-2)= Y, Push;
        Tos := 60, Push;
        Tos := Screen, Push;
        Tos := tmp2 and C1777, Push;
        Tos := tmp, Pu = Termination condition:
!                   0 - Character count exhausted.
!                   1 - Screen width exhausted.
sh;
        Tos := 60, Push;
        Tos := CSet + C402, Push;
        Call(Rop);
        SrcByte := SrcByte + 1, Goto(DB1);!                   2 - Control character encountered.
!
!--------------------------------------------------------------------

DB3:    Tos := 0, Push, Goto(DB6);

DB4:    Tos := 2, Push, Goto(DB6);

DB5:    Tos := 1, Push;
        X := X - CharWi   	
       variable onto the expression stack.  The segment number must be
!       in the range 0..65535, and the offset must be in---------------------------
!
! Abstract:
!       STGW is a four byte instruction that stores a global variable
!       from the range 0..65535.
!
! Instruction:
!       LGAW    LowByteSegment HighByteSegment
!               LowByteOffset HighByteO the expression stack.  The segment number must be in the
!       range 0..255, and the offset must be in the range 0..65535.
ffset
!
! Result:
!       Stack pushed.
!       (Tos) = GlobalArea - SB + Offset.
!
! Calls:
!       GetGP, WordParm.
!!
! Instruction:
!       STGW    Segment LowByteOffset HighByteOffset
!
! Environment:
!       (Tos) = Value.
!
! Result:
!-----------------------------------------------------------------------------

Opcode(LGAB), tmp2 := NextOp;
        Push, 
!       Stack popped.
!       Memory[GlobalArea + Offset] = Value.
!
! Calls:
!       GetGP, VectSrc, WordParm.
!
!-----Call(GetGp);
        tmp := NextOp + tmp2;                !**** BR
        Tos := tmp - SB, NextInst(0);        !**** BR

Op------------------------------------------------------------------------

Opcode(STGB), tmp2 := NextOp;
        tmp3 := NextOcode(LGAW), tmp2 := NextOp;
LoadGAddr: Call(GetGP);
        tmp2 := tmp2 - SB, Call(WordParm);
        tmp := Shift + tmp;   p;
StoreGlobal: Call(GetGP);
        tmp2 + tmp3, Store;
        Tos, Pop, NextInst(0);

Opcode(STGW), tmp2 := NextOp;
                    !***** BR
        Tos := tmp + tmp2, Push, NextInst(0);  !***** BR

Opcode(LGAWW), Call(WordParm);
             Call(WordParm);
        tmp3 := Shift + tmp, Goto(StoreGlobal);




$Title LDIx - Load intermediate variable.

! Otmp2 := Shift + tmp, Goto(LoadGAddr);




$Title STGx - Store global variable.

! Opcode STGB.
!-----------------------pcode LDIB.
!-----------------------------------------------------------------------------
!
! Abstract:
!       LDIB is a t------------------------------------------------------
!
! Abstract:
!       STGB is a three byte instruction that stores a ghree byte instruction that loads an intermediate variable
!       onto the expression stack.  The lexical level of the variablelobal variable
!       from the expression stack.  The segment number must be in the
!       range 0..255, and the offset must is
!       represented by an offset in static nesting that must be in the
!       range 0..255.  The offset of the variable w be in the range 0..255.
!
! Instruction:
!       STGB    Segment Offset
!
! Environment:
!       (Tos) = Value.
!
! Resithin its activation
!       record must be in the range 0..255.
!
! Instruction:
!       LDIB    OffsetInStaticNesting Offsult:
!       Stack popped.
!       Memory[GlobalArea + Offset] = Value.
!
! Calls:
!       GetGP.
!
!--------------------et
!
! Result:
!       Stack pushed.
!       (Tos) = Memory[IntermediateArea + Offset].
!
! Calls:
!       GetLP.
!
!-----------------------------------------------------------

! Opcode STGW.
!-----------------------------------------------------------------------------------------------------------------------------

! Opcode LDIW.
!--------------------------------  	
    define(Word,106);
        define(Bit,107);
        define(AddY,110);
        define(Last,111);
        define(D,112);
 
        if Eql goto(L3);
        LoadS(Set);

!       Calculate derived values.
        
L3:     T := Tos := dY, if IntrP       define(E,113);
        define(F,114);
        define(T,115);
        define(TplusD,116);
        
        
        end Call(LineInt);
        D := Tos - dX;
        F := Tos + dX, if Lss goto(L4);
        T := Tos := dX;
        D := Tos -
Loc(DrawLine),
        
!       get the Origin.
        
        Origin := Tos, Pop;
        
!       Get X1,Y1 and init dY;
L4:     E := 0;
        TplusD := Tos + D;

!       Main loop.

Top:    Tos := E + E, if IntrPend Call(LineInt);
   ial Word and Bit addresses.
        
        Y1 := Tos and AllOnes, LeftShift(4);
        Word := Shift;                          F := F - 1;
        Tos + TplusD, if Lss goto(ExitLine);
        Tos := D + E, if Lss goto(L5);
        F := F - 1;
        !*****
        Word := Word + Origin;                  !*****
!*****  Word := Shift + Origin;
        Y1, LeftShift(5);     E := Tos;
        Last;
        Word := Word + AddY, Fetch, if Lss goto(Minus);
        
!       X is going positive.

        Word := Shift + Word, Pop;              ! Y1 * 60 + Origin
        X1 := Tos and AllOnes, RightShift(4);
        Word        
Plus:   Bit and not Last, Rotate(1);
PlusA:  Bit := Shift, if eql goto(PlusB);
        Word, Store, GotoS;
PlusB:   := Shift + Word;                   ! Y1 * 60 + X1 div 20 + Origin
        X1 and 17, LeftShift(4);
        not Shift, ShiftOnNop;
        Word := Word + 1, Fetch;
        Last, goto(PlusA);

L5:     dY - dX;
        E := E + T, if Gtr Goto(Same);
R;
        1, Pop;
        Bit := Shift, if IntrPend Call(LineInt); ! X1 bit mask
        
!       Get X2,Y2 and calculate d        Last;
        Word, Fetch, if Gtr goto(Plus);

!       X is going negative.

Minus:  Bit and not Last, Rotate(17);X,dY.
        
        Tos := Tos and AllOnes;
        dY := Tos - Y1, Pop, LeftShift(17);
        AddY := 60, if Geq goto(L
MinusA: Bit := Shift, if eql goto(MinusB);
        Word, Store, GotoS;
MinusB: Word := Word - 1, Fetch;
        Last, goto(M1);
        AddY := not 57;                         ! -60
        dY := Shift - dY;                       ! Shift = 0
L1:    inusA);
        
!       X is not changing.
        
Same:   Word := Word + AddY, Fetch;
        Nop;
        Nop;
      
!               else    Draw line.
!
!
!       X coordinates range from 0 (left) to 1377 (right).
!       Y coordinates ran Tos := Tos and AllOnes;
        dX := Tos - X1, Pop;
        Last := 1, if Geq goto(L2);
        Last := 100000;
        dXge from 0 (top) to 1777 (bottom).


! 18 May 81  V1.1  John Strait
! Change Line to be an include file.


        
      := Shift - dX;                       ! Shift = 0
        
!       Determine line style.

L2:     Tos := Tos and AllOnes;
    define(Origin,100);
        define(X1,101);
        define(Y1,103);
        define(dX,104);
        define(dY,105);
           Tos - 1, LoadS(Clear);
        Word := Word + SB, if Eql goto(L3);     ! physical address
        Tos - 2, LoadS(Flip);   	
n that loads the address of an
!       intermediate variable onto the expression stack.  The lexical
!       level of the vari
!-----------------------------------------------------------------------------
!
! Abstract:
!       STIB is a three byte iable is represented by an offset in static
!       nesting that must be in the range 0..255.  The offset of the
!       variabnstruction that stores an intermediate variable
!       from the expression stack.  The lexical level of the variable is
!    le within its activation record must be in the range 0..255.
!
! Instruction:
!       LIAB    OffsetInStaticNesting Offset
!   represented by an offset in static nesting that must be in the
!       range 0..255.  The offset of the variable within its ---------------------------------------------
!
! Abstract:
!       LDIW is a four byte instruction that loads an intermediat
! Result:
!       Stack pushed.
!       (Tos) = IntermediateArea - SB + Offset.
!
! Calls:
!       GetLP.
!
!----------e variable
!       onto the expression stack.  The lexical level of the variable is
!       represented by an offset in static-------------------------------------------------------------------

! Opcode LIAW.
!---------------------------------------- nesting that must be in the
!       range 0..255.  The offset of the variable within its activation
!       record must be in-------------------------------------
!
! Abstract:
!       LIAW is a four byte instruction that loads the address of an
!   the range 0..65535.
!
! Instruction:
!       LDIW    OffsetInStaticNesting LowByteOffset HighByteOffset
!
! Result:
!         intermediate variable onto the expression stack.  The lexical
!       level of the variable is represented by an offset in   Stack pushed.
!       (Tos) = Memory[IntermediateArea + Offset].
!
! Calls:
!       GetLP, WordParm.
!
!--------------- static
!       nesting that must be in the range 0..255.  The offset of the
!       variable within its activation record mus--------------------------------------------------------------

Opcode(LDIB), tmp3 := NextOp;
        tmp4 := NextOp + SB;
Lt be in the range 0..65535.
!
! Instruction:
!       LIAW    OffsetInStaticNesting LowByteOffset HighByteOffset
!
! Result:oadInter: tmp2 := AP, Call(GetLP);
        tmp4 := Mdi + tmp4;                  ! physical address of variable
        tmp4, F
!       Stack pushed.
!       (Tos) = IntermediateArea - SB + Offset.
!
! Calls:
!       GetLP, WordParm.
!
!-----------etch;
        Tos := Mdi, Push, NextInst(0);

Opcode(LDIW), tmp3 := NextOp;
        Call(WordParm);
        tmp4 := Shift +------------------------------------------------------------------

Opcode(LIAB), tmp3 := NextOp;
        tmp4 := NextOp;
Lo tmp;
        tmp4 := tmp4 + SB, Goto(LoadInter);




$Title LIAx - Load intermediate address.

! Opcode LIAB.
!------adIAddr: tmp2 := AP, Call(GetLP);
        Tos := Mdi + tmp4, Push, NextInst(0);

Opcode(LIAW), tmp3 := NextOp;
        Call(-----------------------------------------------------------------------
!
! Abstract:
!       LIAB is a three byte instructioWordParm);
        tmp4 := Shift + tmp, Goto(LoadIAddr);




$Title STIx - Store intermediate variable.

! Opcode STIB.  	
  Word, Store, GotoS;
        
!       Combine new bit with old word.
        
Set:    MDO := MDI or Bit, Goto(Top);
Clear:
!                               (it works using only the IntrPend after fetch4)
!                     ==>       (it fails with  MDO := MDI and not Bit, Goto(Top);
Flip:   MDO := MDI xor Bit, Goto(Top);
        
LineInt: Vector(IntVec);

!       Exit one IntrPend just before Fetch4)
!
! 19 Jan 82  WJH  V1.7a         clear ParityHit at FPE3
!                               r.

ExitLine: Pop, NextInst(0);
                                                                                              eorder reg decls & assign those now 17-24
!                               call DpyInt & ChkParity before ParityHit:=0
!                                restore extra IntrPend in Sweeps
!                               install LongPause for debugging
!
!  19 Jan 82  WJH  V1.7          Set MaxAdrP1 to any multiple of 2^17
!                               check all memory using only  store4/fetch4
!                               check fetch/store separately
!                               install ChkParity
! VFY - Diagnostic Micro-Code for Perq
! Copyright (C) Three Rivers Computer Corporation, 1981.
! Can be used stand alone, or !                               reorder: Bpc, NextOp, Parity err, Sweep
!                               reinstall subtract-oldcas part of boot sequence
!
! Change Log:
! 
!                               test ShiftOnR
! 27 Jan 82  LFK  V1.8          sarry test
!                               put CR in before the Data-Error-on-stack test
!                               add coubmitted to perq.files
!
! 22 Jan 82  WJH  V1.7d         fix error msg comment 130
!                               use 119 inmment explaining initial LoadOp
!                               change err msg 119, 133, 134. Add 138, 139,140
!              stead of 140 for store/fetch fail
!
! 21 Jan 82  WJH  V1.7c         new inverted sweep
!                               straig                 correct memory cycle comments (t0->t3)
!                               remove extra IntrPend in Sweeps
!
! 1hten out WLoop4
!                               optimize RLoop4
!
! 19 Jan 82  WJH  V1.7b         new uninverted sweep: shift8 Dec 81  WJH  Version 1.6.  Find size of memory and only check that much
!
! 16-Oct-81  JPS  Version 1.5.  Run memory diagnos and check data err
!                               move "IntrPend" in W4Lp to avoid parity errors
!                          tic over all 2^20 possible
!                               memory words.  This is a hack done to make
!                            (it works with one IntrPend in t1 before fetch
!                                   and another in a t2 well before store)        the 1 MByte memory work!  The memory
!                               diagnostic should be modified to really
!           	
ighByteOffset
!
! Environment:
!       (Tos) = Value.
!
! Result:
!       Stack popped.
!       Memory[IntermediateArea +extInst(0);

! Opcode STIND.
!-----------------------------------------------------------------------------
!
! Abstract: Offset] = Value.
!
! Calls:
!       GetLP, VectSrc, WordParm.
!
!---------------------------------------------------------
!       STIND is a one byte instruction that stores a word from the
!       expression stack.
!
! Instruction:
!       STIN--------------------

Opcode(STIB), tmp3 := NextOp;
        tmp4 := NextOp + SB;
StoreInter: tmp2 := AP, Call(GetLP);
     D
!
! Environment:
!       (Tos) = Word.
!       (Tos-1) = Address of the word as an offset from stack base.
!
! Result:
   Mdi + tmp4, Store;
        Tos, Pop, NextInst(0);

Opcode(STIW), tmp3 := NextOp;
        Call(WordParm);
        tmp4 :=!       Memory[Address] = Word.
!       Stack popped twice.
!
!-------------------------------------------------------------- Shift + tmp, if IntrPend Call(VectSrv);
        tmp4 := tmp4 + SB, Goto(StoreInter);
                                        ---------------

Opcode(STIND), tmp := Tos, Pop;
        Nop;                                 !***** MAB
        Tos + SB, S tore;
        tmp, Pop, NextInst(0);




$Title LDDC, LDDW, STDW - Double word loads and stores.

! Opcode LDDC.
!----activation
!       record must be in the range 0..255.
!
! Instruction:
!       STIB    OffsetInStaticNesting Offset
!
! E nvironment:
!       (Tos) = Value.
!
! Result:
!       Stack popped.
!       Memory[IntermediateArea + Offset] = Value.
!$Title LDIND, STIND - Indirect one word loads and stores.
! Change Log:
!     20 Nov 81 WJH    added change log
!            
! Calls:
!       GetLP.
!
!-----------------------------------------------------------------------------

! Opcode STIW.
          fixed LSA for string length 255

! Opcode LDIND.
!----------------------------------------------------------------!-----------------------------------------------------------------------------
!
! Abstract:
!       LDIW is a four byte inst-------------
!
! Abstract:
!       LDIND is a one byte instruction that loads a word onto the
!       expression stack.
!ruction that stores an intermediate variable
!       from the expression stack.  The lexical level of the variable is
!       
! Instruction:
!       LDIND
!
! Environment:
!       (Tos) = Address of the word as an offset from stack base.
!
! Resulrepresented by an offset in static nesting that must be in the
!       range 0..255.  The offset of the variable within its actt:
!       (Tos) = Memory[Address].
!
!-----------------------------------------------------------------------------

Opcodivation
!       record must be in the range 0..65535.
!
! Instruction:
!       STIW    OffsetInStaticNesting LowByteOffset He(LDIND), Nop;                          !***** BR
        Tos + SB, Fetch;                     !***** BR
        Tos := Mdi, N  	
o off
!        5             55        Data error in push
!        6             56        Empty or Full set when that is not umped on 0.
!        40            82        C19 didn't jump when it should have.
!        41            83        BCP[3] didnthe case
!        7             57        Data error in bit 15 of the stack
!        10            58        Stack empty set w't jump when it should have.
!        42            84        C19 jumped when it shouldn't have.
!        43            85    hen the stack is full
!        11            59        Data error on stack
!        12            60        Data error after P    BCP[3] jumped when it shouldn't have.
!        44            86        GTR didn't jump.
!        45            87        G                       test all the memory that is present.
!
! 21-Aug-81  JPS  Version 1.4.  Add copyright notice.
!
!  8-MOP.  Bit 14
!        13            61        Data error after POP.  Bit 13
!        14            62        Data error after Par-81  BR   Version 1.3.  Recreated source code from binary
!
! ??-???-??  ???  Version 1.2.  Moved C19 test past top 4 test
OP.  Bit 12
!        15            63        Data error after POP.  Bit 11
!        16            64        Data error after P!                               Added dispatch test
!                               Made DDS sequence work correctly
!
! 17-SOP.  Bit 10
!        17            65        Data error after POP.  Bit 9
!        20            66        Data error after POep-80  DAS  Version 1.1.  Added the code to allow VFY to
!                  be used at boot time.  BVFY no longer lives.
     P.  Bit 8
!        21            67        Data error after POP.  Bit 7
!        22            68        Data error after POP.             
! 12-Sep-80  DAS  Added version numbers and reformated the file.



!
! Running instructions:
!
!  R0 is u  Bit 6
!        23            69        Data error after POP.  Bit 5
!        24            70        Data error after POP.  sed by VFY as a switch register.  
!  The bits have the following meaning when set:
!
!    Bit0  -  Multiple passes.  When seBit 4
!        25            71        Data error after POP.  Bit 3
!        26            72        Data error after POP.  Bit do more than one pass.
!    Bit1  -  If Set, Ignore parity test.
!    Bit7  -  VFY was started at boot time.  This will effet 2
!        27            73        Empty wrong.
!        30            74        Data error after POP.  Bit 1
!        31  ct
!             error reporting and termination.
!
! After setting R0 simply type "4001G" to ODTPRQ.
!

!
! Error Codes:          75        Data error after POP.  Bit 0
!        32            76        Empty not set after all pops.
!        33   
!
!    ErrorType        DDS
!
!        1             51        Empty stack bit not working
!        2             52               77        Call test falied
!        34            78        Odd didn't jump on a 1.
!        35            79          Could not load TOS
!        3             53        Push did not work
!        4             54        Stack Empty did not gOdd jumped on a 0.
!        36            80        Byte sign didn't jump on 200.
!        37            81        Byte sign j   	
Opcode(LDDC), Call(WordParm);
        Tos := Shift + tmp, Push;
        Call(WordParm);
        Tos := Shift + tmp, Push, Nex  !***** MAB
        tmp2 := Tos + SB, Store;
        tmp, Pop, if IntrPend Goto(STDW2);
STDW1:  tmp2 + 1, Store;
        tmtInst(0);

! Opcode LDDW.
!-----------------------------------------------------------------------------
!
! Abstract:
! p1, NextInst(0);
        
STDW2:  Call(VectSrv);
        Goto(STDW1);




$Title LDMC, LDMW, STMW - Multiple word loads       LDDW is a one byte instruction that loads a double word onto the
!       expression stack.
!
! Instruction:
!       LDand stores.

! Opcode LDMC.
!-----------------------------------------------------------------------------
!
! Abstract:
DW
!
! Environment:
!       (Tos) = Address of the double word as an offset from stack base.
!
! Result:
!       Push stac!       LDMC is a variable length instruction that loads a multiple word
!       constant onto the memory stack.
!
! Instructk once.
!       (Tos-0) = Memory[Address + 0].
!       (Tos-1) = Memory[Address + 1].
!
! Calls:
!       VectSrv.
!
!----ion:
!       LDMC    N
!               LowByteWord0 HighByteWord
!               LowByteWord1 HighByteWord1
!               -------------------------------------------------------------------------

Opcode(LDDW), tmp := Tos;
        tmp := tmp + SB,   ...
!               LowByteWordN-2 HighByteWordN-2
!               LowByteWordN-1 HighByteWordN-1
!
! Result:
!       Pu Fetch;        !***** BR
        tmp1 := Mdi;
        tmp + 1, Fetch;
        Tos := Mdi, if IntrPend Call(VectSrv);
       sh N words onto the memory stack.
!       Memory[TP-N+1] = Word.
!       Memory[TP-N+2] = Word1.
!          ...
!       Memo Tos := tmp1, Push, NextInst(0);

! Opcode STDW.
!--------------------------------------------------------------------------ry[TP-1]   = WordN-2.
!       Memory[TP-0]   = WordN-1.
!
! Calls:
!       ChkStk, WordParm.
!
!-----------------------------
!
! Abstract:
!       STDW is a one byte instruction that stores a double word from the
!       expression stack.
!
! ---------------------------------------------------

Opcode(LDMC), tmp2 := NextOp;               ! number of words
        No-------------------------------------------------------------------------
!
! Abstract:
!       LDDC is a five byte instructiInstruction:
!       STDW
!
! Environment:
!       (Tos-0) = Word0.
!       (Tos-1) = Word1.
!       (Tos-2) = Address of on that loads a double word onto the
!       expression stack.
!
! Instruction:
!       LDDC    HighByteWord0 HighByteWord0the double word as an offset from stack base.
!
! Result:
!       Memory[Address + 0] = Word0.
!       Memory[Address + 1] =
!               HighByteWord1 HighByteWord1
!
! Result:
!       Push stack twice.
!       (Tos-0) = Word1.
!       (Tos-1) Word1.
!       Stack popped three times.
!
! Calls:
!       VectSrv.
!
!------------------------------------------------- = Word0.
!
! Calls:
!       WordParm.
!
!-----------------------------------------------------------------------------

----------------------------

Opcode(STDW), tmp := Tos, Pop;
        tmp1 := Tos, Pop;
        Nop;                           	
     63           101        Or ALU function failed.
!        64           102        Or-Not ALU function failed.
!        65 15          127        NextOp test failed.        
!        116          128        Fetch/Store overlap failed.        
!               103        And ALU function failed.
!        66           104        Or-Not ALU function failed.
!        67           117          129        Bad interrupt Loc 4.        
!        120          130        Bad interrupt Loc 14.        
!         105        Not-A ALU function failed.
!        70           106        Not-B ALU function failed.
!        71           107  121          131        Bad interrupt Loc 20.        
!        122          132        Bad interrupt Loc 30.        
!              Xor ALU function failed.
!        72           108        Xnor ALU function failed.
!        73           109        O  123          133        Data error on Memory Sweep.
!        124          134        Address error on Memory Sweep.
!       ldCarry-Add ALU function failed.
!        74           110        OldCarry-Sub ALU function failed.
!        75           111  125          135        Field didn't work
!        126          136        Dispatch did not jump
!        127          137          OldCarry-Add /w No OldCarry failed.
!        76           112        Fetch error on Force Bad Parity.
!        77           Wrong Dispatch target
!        130          138        Data error on Inverted Memory Sweep.
!        131          139    TR jumped when it shouldn't have.
!        46            88        GEQ didn't jump.
!        47            89        GEQ jumpe     113        Unexpected Parity error.
!        100          114        No parity errors on force bad parity.        
!     d when it shouldn't have.
!        50            90        LSS didn't jump when it should have.
!        51            91        101          115        Wrong address on force bad parity.        
!        102          116        Upper 4 bit test failed.   LSS jumped when it shouldn't have.
!        52            92        LEQ didn't jump.
!        53            93        LEQ j        
!        103          117        MDX test failed.        
!        104          118        Stack upper bits test failumped when it shouldn't have.
!        54            94        GEQ didn't jump on equal.
!        55            95        LEQ ed.        
!        105          119        Store/Fetch test failed.
!        106          120        Unexpected refill.     didn't jump on equal.
!        56            96        Carry didn't jump when it should have.
!        57            97          
!        107          121        BPC test failed.        
!        110          122        Fetch4 test failed.        
!  Carry jumped when it shouldn't have.
!        60            98        Overflow didn't jump when it should have.
!        61         111          123        Fetch4R test failed        
!        112          124        Store4 test failed.        
!               99        Overflow jumped when it shouldn't have.
!        62           100        And-Not ALU function failed.
!      113          125        Fetch2 test failed.        
!        114          126        Store2 test failed.        
!        1   	
ChkStk);        ! make sure there's room
LDMC1:  Call(WordParm);                     ! get next word
        tmp := Shift + tm  memory stack.
!
! Instruction:
!       STMW
!
! Environment:
!       (Tos) = N.
!       (Tos-1) = Address of the words p;
        TP := TP + 1, Store;
        tmp, if IntrPend Call(VectSrv);     ! push it onto memory stack
        tmp2 := tmp2 as an offset from stack base.
!       Memory[TP-0] = Word0.
!       Memory[TP-1] = Word1.
!          ...
!       Memory[TP-N- 1;
        if Gtr Goto(LDMC1);                 ! if not done yet
        NextInst(0);

! Opcode LDMW.
!-----------------+1] = WordN-1.
!
! Result:
!       Memory[Address+0] = Word0.
!       Memory[Address+1] = Word1.
!          ...
!       Me------------------------------------------------------------
!
! Abstract:
!       LDMW is a one byte instruction that loads mory[Address+N-1] = WordN-1.
!       Stack popped twice.
!       Pop N words from the memory stack.
!
! Calls:
!       Vectmultiple words onto the
!       memory stack.
!
! Instruction:
!       LDMW
!
! Environment:
!       (Tos) = N.
!       Srv, MoveMem.
!
!-----------------------------------------------------------------------------

Opcode(STMW), tmp := Tos, Po(Tos-1) = Address of the words as an offset from stack base.
!
! Result:
!       Push N words onto the memory stack.
!      p;
        tmp := tmp - 1;                      !***** BR
        dst := Tos + SB, if Lss Goto(STMW1); ! if no words to store Memory[TP-N+1] = Memory[Address+n-1].
!       Memory[TP-N+2] = Memory[Address+n-2].
!          ...
!       Memory[TP-1]   = 
        dst := dst + tmp;
        Tos := TP := TP - tmp;
        tmp := tmp + 1, Call(MoveMem);
        TP := TP - 1, Pop, NMemory[Address+1].
!       Memory[TP-0]   = Memory[Address+0].
!       Stack popped twice.
!
! Calls:
!       ChkStk, MoveMextInst(0);

STMW1:  Pop, NextInst(0);




$Title LDB, STB, LDCH, STCH - Byte and Char loads and stores.

! Opcode LDBem, StkOv, VectSrv.
!
!-----------------------------------------------------------------------------

Opcode(LDMW), tmp := T.
!-----------------------------------------------------------------------------
!
! Abstract:
!       LDB is a one byte insos, Pop;
        tmp10 := tmp, LoadS(LDMW1);        !***** BR
        Tos := Tos + SB, Call(ChkStk);
        TP := TP + tmp;truction that loads a byte onto the expression
!       stack.
!
! Instruction:
!       LDB
!
! Environment:
!       (Tos)
        dst := TP, Call(MoveMem);
        Pop, NextInst(0);

!       Here on stack overflow.

LDMW1:  Tos := Tos - SB;
   = ByteOffset.
!       (Tos-1) = WordAddress as an offset from stack base.
!
! Result:
!       Push stack.
!       (Tos) =       Tos := tmp, Push;
        tmp11 := 1, Goto(StkOv);

! Opcode STMW.
!-------------------------------------------------Memory[WordAddress].Byte[ByteOffset].
!
! Calls:
!       VectSrv.
!
!------------------------------------------------------p;                                ! let placer do a page escape
        tmp11 := 2, LoadS(StkOv);
        tmp10 := tmp2, Call(----------------------------
!
! Abstract:
!       STMW is a one byte instruction that stores multiple words from the
!       	
fine(dpytmp,300);
define(dpycnt,301);

constant(BreakPoint,7401);
constant(SYSBEntry,7000);
constant(ErrorReturn,101);
con    ! Check empty again
        if eql GoTo(ErrorExit), ErrorType := 4;         ! 054-Stack Empty did not go off

        tmpstant(GoodReturn,100);

!This program enters at DDS = 29 during boot
! The instruction at 4001 increments it to 30
! Error c1 := 4;                                      ! Start data value
        
Pushl:  TOS := tmp1, Push;                           odes lie between 50 and 149
! The Error reporting scheme increments the error register by 10#20
constant(DDSoffset,10#20);
!V   ! Push new value on stack
        tmp := TOS - tmp1;                              ! Make sure it worked
        if neq GoTofy exits with 150 in the DDS, therefore we ask for 150 - 29 - 1 - 20 = 100
! increments before exiting              exit - star(ErrorExit), ErrorType := 5;         ! 055-Data error in push
        
        tmp1 := tmp1 + tmp1;                           t - first - offset = diff
constant(DDSDif,10#100);


place(4000,6377);


!
! Start here on Boot.  Set the Boot bit in Te ! LeftShift data value
        tmp1 - 100000;                                  ! Are we done?
        if neq goto(Pushl);    stContinue.
!                      (LoadOp turns off the boot proms)

BStart: TestContinue := 202, LoadOP, Loc(4000);                                 ! No, do again
        
        tmp := UState AND 1000;                         ! Check no empty
    ! Booting and no parity.
        
!
! Test the E stack. (Start here for VFY from ODTPRQ).
!

StackTest: StackReset, Error     if eql GoTo(ErrorExit), ErrorType := 6;         ! 056-Empty or Full when not so
 
        tmp := 100000;                 Type := 0, Loc(4001);       ! Bump DDS to 30
        dpytmp := 101154;
        dpycnt := 0;
        !TestContinue := 2;
                     ! Push last item on stack
        TOS := tmp, Push;                               ! Check it
        tmp := T    tmp := UState AND 1000;                         ! Check Empty Flag
        if neq GoTo(ErrorExit), ErrorType := 1;         OS - 100000;
        if neq GoTo(ErrorExit), ErrorType := 7;         ! 057-Data error bit 15 on stack

        tmp := UState     Address error on Inverted Memory Sweep.

        

!
! Register definitions.
!

define(R370,370);
define(TestContin! 051-Empty Stack bit not working

        TOS := 1;                                       ! Load a one
        tmp := TOS - ue,0);
define(r1,1);
define(r2,2);
define(r3,3);
define(r4,4);
define(r5,5);
define(r6,6);
define(tmp1,7);
define(R10,101;                                 ! Check it
        if neq GoTo(ErrorExit), ErrorType := 2;         ! 052-Couldn't load TOS
);
define(R11,11);
define(R12,12);
define(R13,13);
define(etmp,14);
define(ecnt,15);
define(MaxAdrP1,16);
define(ParityHi        
        TOS := 2, Push;                                 ! try pushing a value
        tmp := TOS - 2;
        if neqt,17);
define(ParityErr,20);
define(ErrorType,21);
define(tmp,22);
define(adr,23);
define(last,24);
define(TShift,25);
de GoTo(ErrorExit), ErrorType := 3;         ! 053-Push Didn't work
        
        tmp := UState AND 1000;                        	

!       Store the target word back.

STB1:   tmp1, Store;
        tmp or tmp2, NextInst(0);            ! combine bytes and ase.
!
! Result:
!       Stack popped three times.
!       Memory[Address].Byte[CharacterIndex] = Character.
!
! Calls:
!store
        
!       Store the high byte.

STB2:   tmp := Mdi and 377, if IntrPend Call(VectSrv);
        tmp2, LeftShift       GetStringIndex.
!
!-----------------------------------------------------------------------------

Opcode(STCH), tmp2 -----------------------

Opcode(LDB), tmp := Tos and AllOnes, Pop, RightShift(1);
        tmp1 := Shift + SB, if IntrPend Cal(10);
        tmp2 := Shift, Goto(STB1);

! Opcode LDCH.
!-----------------------------------------------------------------l(VectSrv);  ! word offset
        Tos + tmp1, Fetch;
        tmp;
        if Odd Goto(LDB1);                   ! if loading ------------
!
! Abstract:
!       LDCH is a one byte instruction that loads a character from a string
!       onto the exprhigh byte
        Tos := Mdi AND 377,NextInst(0);      ! load low byte

LDB1:   Mdi, Field(10,10);
        Tos := Shift, Nexession stack.
!
! Instruction:
!       LDCH
!
! Environment:
!       (Tos) = CharacterIndex.
!       (Tos-1) = Address oftInst(0);           ! load high byte

! Opcode STB.
!----------------------------------------------------------------------- the string as an offset from stack base.
!
! Result:
!       Stack popped.
!       (Tos) = Memory[Address].Byte[CharacterIn------
!
! Abstract:
!       STB is a one byte instruction that stores a byte from the expression
!       stack.
!
! Instrdex+1].
!
! Calls:
!       GetStringIndex.
!
!-----------------------------------------------------------------------------uction:
!       STB
!
! Environment:
!       (Tos) = Byte.
!       (Tos-1) = ByteOffset.
!       (Tos-2) = WordAddress as 

Opcode(LDCH), Call(GetStringIndex);
        tmp;
        if Odd Goto(LDCH1);                  ! if the character is in higan offset from stack base.
!
! Result:
!       Stack popped three times.
!       Memory[Address].Byte[ByteOffset] = Byte.
!h byte

!       Character is in a low byte.

        Tos := Mdi and 377, NextInst(0);     ! get low byte

!       Characte
! Calls:
!       VectSrv.
!
!-----------------------------------------------------------------------------

Opcode(STB), r is in a high byte.

LDCH1:  Mdi, field(10,10);                   ! get high byte
        Tos := Shift, NextInst(0);

! Otmp2 := Tos and 377, Pop;
        tmp := Tos and AllOnes, Pop, RightShift(1);   ! byte offset
        tmp1 := Shift + SB;
   pcode STCH.
!-----------------------------------------------------------------------------
!
! Abstract:
!       STCH is a o     tmp1 := Tos + tmp1, Fetch;           ! fetch the target word
        tmp, Pop;
        if Odd Goto(STB2);                ne byte instruction that stores a byte from the expression
!       stack.
!
! Instruction:
!       STCH
!
! Environment:
   ! if storing high byte
        
!       Store the low byte.

        tmp := Mdi and not 377, if IntrPend Call(VectSrv);
!       (Tos) = Character.
!       (Tos-1) = CharacterIndex.
!       (Tos-2) = Address of the string as an offset from stack b  	
   if neq GoTo(ErrorExit), ErrorType := 10;        ! 058-Stack Empty set when full

        tmp := TOS xor 100000;            23;        ! 069-Data error after pop bit 5

        Pop;
        tmp := TOS xor 20;
        if neq GoTo(ErrorExit), ErrorTy            ! Check data still there
        if neq GoTo(ErrorExit), ErrorType := 11;      ! 059-Data Error on stack
        Ppe := 24;        ! 070-Data error after pop bit 4

        Pop;
        tmp := TOS xor 10;
        if neq GoTo(ErrorExit), Eop;                                            ! Pop one off
        tmp := TOS xor 40000;                           ! Should brrorType := 25;        ! 071-Data error after pop bit 3

        Pop;
        tmp := TOS xor 4;
        if neq GoTo(ErrorExie 40000
        if neq GoTo(ErrorExit), ErrorType := 12;        ! 060-Data error after pop bit 14

        Pop;
        tmp t), ErrorType := 26;        ! 072-Data error after pop bit 2

        tmp := UState AND 1000;
        if eql GoTo(ErrorExit),:= TOS xor 20000;
        if neq GoTo(ErrorExit), ErrorType := 13;        ! 061-Data error after pop bit 13

        Pop;
   ErrorType := 27;        ! 073-Empty wrong
        
        Pop;
        tmp := TOS xor 2;
        if neq GoTo(ErrorExit), E      tmp := TOS xor 10000;
        if neq GoTo(ErrorExit), ErrorType := 14;        ! 062-Data error after pop bit 12

      rrorType := 30;        ! 074-Data error after pop bit 1

        Pop;
        tmp := TOS xor 1;
        if neq GoTo(ErrorExi  Pop;
        tmp := TOS xor 4000;
        if neq GoTo(ErrorExit), ErrorType := 15;        ! 063-Data error after pop bit 11t), ErrorType := 31;        ! 075-Data error after pop bit 0

        tmp := UState AND 1000;
        if neq GoTo(ErrorExit),

        Pop;
        tmp := TOS xor 2000;
        if neq GoTo(ErrorExit), ErrorType := 16;        ! 064-Data error after po ErrorType := 32;        ! 076-Empty Not set after all pops



!
! Test the 2910 call stack
!

CallTest: tmp := 0, Call(p bit 10

        Pop;
        tmp := TOS xor 1000;
        if neq GoTo(ErrorExit), ErrorType := 17;        ! 065-Data errorAS);                           ! Test 2910 call stack
        tmp - 37;                                       ! 5 levels should after pop bit 9

        Pop;
        tmp := TOS xor 400;
        if neq GoTo(ErrorExit), ErrorType := 20;        ! 066-Dat be 5 bit set
        if eql GoTo(JmpTest);
        
CallErr:ErrorType := 33, GoTo(ErrorExit);               ! 077-Call Test a error after pop bit 8

        Pop;
        tmp := TOS xor 200;
        if neq GoTo(ErrorExit), ErrorType := 21;        ! failed

AS:     Call(BS);                                       ! 1st level call, now call level 2
        tmp := tmp + 1, re067-Data error after pop bit 7

        Pop;
        tmp := TOS xor 100;
        if neq GoTo(ErrorExit), ErrorType := 22;   turn;                         ! 1st level return
BS:     Call(CS);                                       ! 2nd level call, now AND 1000;                         ! Check for full
        tmp - 1000;                                     ! Empty Clear
          ! 068-Data error after pop bit 6

        Pop;
        tmp := TOS xor 40;
        if neq GoTo(ErrorExit), ErrorType :=    	
se.
!       (Tos-2) = DstByte = Destination byte offset.
!       (Tos-3) = DstWord = Destination word address as offset from s

! Opcode SAS.
!-----------------------------------------------------------------------------
!
! Abstract:
!       SAS istack base.
!
! Result:
!       Stack popped four times.
!       Memory[DstWord].Byte[DstByte+0] = Memory[SrcWord].Byte[SrcBy a one byte instruction that assigns one string to another.
!
! Instruction:
!       SAS
!
! Environment:
!       (Tos) = te+0].
!       Memory[DstWord].Byte[DstByte+1] = Memory[SrcWord].Byte[SrcByte+1].
!          ...
!       Memory[DstWord].ByteMaximum length of the destination string.
!       (Tos-1) = SrcByte = Source byte offset.
!       (Tos-2) = SrcWord = Source w[DstByte+N-1] = Memory[SrcWord].Byte[SrcByte+N-1].
!
! Calls:
!       GetSrcDst, GetSrc, GetDst, PutDst.
!
!---------------ord address as offset from stack base.
!       (Tos-3) = DstByte = Destination byte offset.
!       (Tos-4) = DstWord = Destin--------------------------------------------------------------

! Opcode MVBW.
!---------------------------------------------ation word address as offset from stack base.
!       Memory[SrcAddr].Byte[SrcByte] = N.
!
! Result:
!       Stack popped fi:= Tos, Pop, Call(GetStringIndex);
        tmp;
        if Odd Goto(STCH2);                  ! if storing a high byte

!    --------------------------------
!
! Abstract:
!       MVBW is a one byte instruction that moves bytes from one area of
!      Store a low byte.

        tmp3 := Mdi and not 377;
STCH1:  tmp4 + tmp1, Store;
        tmp3 or tmp2, Pop;                   memory to another.  The number of bytes must be in the range
!       1..32767. Specifying a length of zero moves one byte.    ! combine bytes and store
        NextInst(0);

!       Store a high byte.

STCH2:  tmp2, LeftShift(10);
        tmp2 
!
! Instruction:
!       MVBW
!
! Environment:
!       (Tos) = N.
!       (Tos-1) = SrcByte = Source byte offset.
!     := Shift;
        tmp3 := Mdi and 377, Goto(STCH1);    ! go store the byte




$Title MVBB, MVBW, LSA, SAS - Byte array an  (Tos-2) = SrcWord = Source word address as offset from stack base.
!       (Tos-3) = DstByte = Destination byte offset.
!   d string moves.

! Opcode MVBB.
!-----------------------------------------------------------------------------
!
! Abstrac    (Tos-4) = DstWord = Destination word address as offset from stack base.
!
! Result:
!       Stack popped five times.
!  t:
!       MVBB is a two byte instruction that moves bytes from one area of
!       memory to another.  The number of bytes mu     Memory[DstWord].Byte[DstByte+0] = Memory[SrcWord].Byte[SrcByte+0].
!       Memory[DstWord].Byte[DstByte+1] = Memory[SrcWorst be in the range 1..255.
!       Specifying a length of zero moves one byte.
!
! Instruction:
!       MVBB    N
!
! Envid].Byte[SrcByte+1].
!          ...
!       Memory[DstWord].Byte[DstByte+N-1] = Memory[SrcWord].Byte[SrcByte+N-1].
!
! Calls:ronment:
!       (Tos) = SrcByte = Source byte offset.
!       (Tos-1) = SrcWord = Source word address as offset from stack ba
!       GetSrcDst, GetSrc, GetDst, PutDst.
!
!-----------------------------------------------------------------------------  	

        bpc := 10;
        if bpc[3] goto(good7);
        ErrorType := 41, goto(ErrorExit);               ! 083-BPC[3] didn't 40123;
        if leq goto(good13);
        ErrorType := 55, goto(ErrorExit);               ! 095-leq didn't jump when it was jump when it should
bad5:   ErrorType := 43, goto(ErrorExit);               ! 085-BPC[3] jumped when it shouldn't

good7:  r eql

good13:  r2 := 177776;
        r2 := r2 + 1;
        if carry goto(bad10);
        r2 := r2 + 1;
        if carry gocall level 3
        tmp := tmp + 2, return;                         ! 2nd level return
CS:     Call(DS);                     2 := 40123;                                    ! Random data to try gtr/lss/leq/geq
        r2 - 40124;
        if gtr goto(ba                  ! 3rd level call, now call level 4
        tmp := tmp + 4, Return;                         ! 3rd level returnd6);
        r2 - 40122;
        if gtr goto(good8);
        ErrorType := 44, goto(ErrorExit);               ! 086-gtr didn't
DS:     Call(ES);                                       ! 4th level call, now call level 5
        tmp := tmp + 10, return;   jump when it should
bad6:   ErrorType := 45, goto(ErrorExit);               ! 087-gtr jumped when it shouldn't
   
good8:  r                      ! 4th level return
ES:     tmp := tmp + 20, return;                        ! 5th level call, return now
2 - 40124;
        if geq goto(bad7);
        r2 - 40122;
        if geq goto(good9);
        ErrorType := 46, goto(ErrorExi


!
! Jump tests.
!

JmpTest:0;                                              ! Try Even/Odd Jump Condition
        if Ot);               ! 088-geq didn't jump when it should 
bad7:   ErrorType := 47, goto(ErrorExit);               ! 089-geq jumpedd goto(bad1);                              ! Should not jump
        1;
        if Odd goto(good1);                          d when it shouldn't (gtr)
 
good9:  r2 - 40122;
        if lss goto(bad8);
        r2 - 40124;
        if lss goto(good10);   ! Should jump
        ErrorType := 34, goto(ErrorExit);               ! 078-Odd didn't jump on a 1
bad1:   ErrorType := 35,
        ErrorType := 50, goto(ErrorExit);               ! 090-lss didn't jump when it should
bad8:   ErrorType := 51, goto(Er goto(ErrorExit);               ! 079-Odd jumped on a 0

good1:  0;                                              ! Try Byte sirorExit);               ! 091-lss jumped when it shouldn't
 
good10: r2 - 40122;
        if leq goto(bad9);
        r2 - 401gn jump
        if ByteSign goto(bad2);
        200;
        if ByteSign goto(good6);
        ErrorType := 36, goto(ErrorExi24;
        if leq goto(good11);
        ErrorType := 52, goto(ErrorExit);               ! 092-leq didn't jump when it shouldt);               ! 080-Byte Sign didn't jump on a 200
bad2:   ErrorType := 37, goto(ErrorExit);               ! 081-Byte Sign 
bad9:   ErrorType := 53, goto(ErrorExit);               ! 093-leq jumped when it shouldn't
 
good11: r2 - 40123;
        if jumped on a 0

good6:  bpc := 0;                                       ! Try jumping on BPC[3]
        if bpc[3] goto(bad5);geq goto(good12);
        ErrorType := 54, goto(ErrorExit);               ! 094-geq didn't jump when it was eql

good12: r2 -   	
e byte
        Call(GetDst);                        ! get destination byte
        Call(PutDst);                        ! put := tmp - CB;                     ! offset within code segment
        tmp1 := UState and 1;                ! number of noise bydestination byte
        tmp := tmp - 1;
        DstLsb, if Gtr Goto(MoveBytes);          ! if not done
        if Odd Goto(Mtes (0 or 1)
        Mdi, Field(0,10);                    ! set mask to get length byte
        JmpOffset := Shift + tmp1;    VBB1);
        NextInst(0);

!       Here if last byte is a low-order byte.

MVBB1:  Dst, Store;                          !       ! length of string + # noise
        JmpOffset := JmpOffset+1,            ! add 1 to count length byte
              Go store last byte (low order byte)
        DstWord, NextInst(0);

Opcode(MVBW), tmp := Tos, Pop, Goto(AssignBytes);

Opcode(to(AdjustPC);                ! go move PC past string



$Title MOVB, MOVW - Word array moves.

! Opcode MOVB.
!--------SAS), tmp2 := Tos and AllOnes, Pop;
        Call(GetSrcDst);
        SrcByte - tmp2;
        SrcByte := SrcByte + 1, if Gtr G---------------------------------------------------------------------
!
! Abstract:
!       MOVB is a two byte instruction thoto(SASErr);
        tmp := SrcByte, Goto(MoveBytes);

! Opcode LSA.
!-----------------------------------------------------at moves words from one area of
!       memory to another.  The number of words must be in the range 1..255.
!
! Instruction:------------------------
!
! Abstract:
!       LSA is a variable length instruction that loads the virtual address
!       o
!       MOVB    N
!
! Environment:
!       (Tos) = SrcAddr = Source address as an offset from stack base.
!       (Tos-1) f a constant string onto the expression stack.  The string follows
!       the LSA in the code stream, but it must be word alig= DstAddr = Destination address as an offset from stack base.
!
! Result:
!       Stack popped twice.
!       Memory[DstAddrve times.
!       Memory[DstWord].Byte[DstByte+0] = Memory[SrcWord].Byte[SrcByte+0].
!       Memory[DstWord].Byte[DstByte+1] =ned.  A noise
!       byte is added when the LSA opcode is in a low order byte.  The end
!       of the string need not be wor Memory[SrcWord].Byte[SrcByte+1].
!          ...
!       Memory[DstWord].Byte[DstByte+N] = Memory[SrcWord].Byte[SrcByte+N].
!d aligned.
!
! Instruction:
!       LSA     N Char0 Char1 ... CharN-1
!
! Result:
!       Push stack twice.
!       (Tos)
! Calls:
!       GetSrcDst, GetSrc, GetDst, PutDst, SASErr.
!
!------------------------------------------------------------ = Word address within code segment.
!       (Tos-1) = Code segment number.
!
! Calls:
!       AdjustPC.
!
!-------------------------------

Opcode(MVBB), tmp := NextOp;
AssignBytes: Call(GetSrcDst);                ! get addresses from stack
    ---------------------------------------------------------------

Opcode(LSA), Tos := CS, Push;
        UState + 1, Push, Fiel    Nop;                                 ! let placer do a page escape
MoveBytes: Call(GetSrc);                     ! get sourcd(1,3);        ! round byte PC up to next word
        tmp := Shift + UPC, Fetch;           ! fetch string length
        Tos   	
;               ! 102-OR NOT alu function failed

good18: r2 := r2 and 307;
        r2 - 305;
        if eql goto(good19);
               ! 111-OldCarry Add with no OldCarry failed
good27:


! 
! setup to test various memory access operations
!        ErrorType := 65, goto(ErrorExit);               ! 103-AND alu function failed

good19: r2 := r2 or not 12345;
       
        call(DpyInt);             ! start display
        0, Iob(343);              ! off force bad parity
        IOB(147);  r2 - 165737;
        if eql goto(good20);
        ErrorType := 66, goto(ErrorExit);               ! 104-OR NOT alu function f                ! Read Parity error register to clear it 
        call(ChkParity);          ! collect parity error if any
    ailed

good20: r2 := not r2;
        r2 - 12040;
        if eql goto(good21);
        ErrorType := 67, goto(ErrorExit);           ! the above line is needed, otherwise spurious parity error is found
        ParityHit := 0;           ! Should not get            ! 105-NOT A alu function failed

good21: r2 := not 45216;
        r2 - 132561;
        if eql goto(good22);
    Parity Errors hereafter

! test store/fetch
        MA := 100, Store;
        MDO := 1257;
        nop;                    to(good14);
        ErrorType := 56, goto(ErrorExit);               ! 096-Carry didn't jump when it should
bad10:  ErrorType :    ErrorType := 70, goto(ErrorExit);               ! 106-NOT B alu function failed

good22: r2 := r2 xor 152525;
        r2 = 57, goto(ErrorExit);               ! 097-Carry jumped when it shouldn't

good14: r2 := 77776;
        r2 := r2 + 1;
      - 060044;
        if eql goto(good23);
      ErrorType := 71, goto(ErrorExit);                 ! 107-XOR alu function failed
  if overflow goto(bad11);
        r2 := r2 + 1;
        if overflow goto(good15);
        ErrorType := 60, goto(ErrorExit); 
good23: r2 := r2 xnor 275;
        r2 - 117546;
        if eql goto(good24);
        ErrorType := 72, goto(ErrorExit);                   ! 098-Overflow didn't jump when it should
bad11:  ErrorType := 61, goto(ErrorExit);               ! 099-Overflow           ! 108-XOR alu function failed

good24: r2 := 177777;
        r2 := r2 + 1;
        r2 := r2 + 0 + oldcarry;
     jumped when it shouldn't

good15: r2 := 12345;
        r2 := r2 and not 770;
        r2 - 12005;
        if eql goto(good16   r2 - 1;
        if eql goto(good25);
        ErrorType := 73, goto(ErrorExit);               ! 109-OldCarry Add alu functio);
        ErrorType := 62, goto(ErrorExit);               ! 100-And Not ALU function failed

good16: r2 := r2 or 340;
     n failed

good25: r2 := 0;
        r2 := r2 - 1;
        r2 := r2 - 0 - oldcarry;
        r2 - 177776;
        if eql goto   r2 - 12345;
        if eql goto(good17);
        ErrorType := 63, goto(ErrorExit);               ! 101-OR alu function fail(good26);
        ErrorType := 74, goto(ErrorExit);               ! 110-OldCarry subtract function failed

good26: r2 := 0;
ed

good17: r2 := r2 or not 377;
        r2 - 177745;
        if eql goto(good18);
        ErrorType := 64, goto(ErrorExit)        r2 := r2 + 0;
        r2 := r2 + 0 + oldcarry;
        if eql goto(good27);
        ErrorType := 75, goto(ErrorExit);   	


! Opcode MOVW.
!-----------------------------------------------------------------------------
!
! Abstract:
!       MOVW ----------------------------------------------------------------------

! Opcode INDB.
!-------------------------------------is a one byte instruction that moves words from one area of
!       memory to another.  The number of words comes from the expr----------------------------------------
!
! Abstract:
!       INDB is a two byte instruction that loads indirect with an indession
!       stack and must be in the range 1..32767.
!
! Instruction:
!       MOVW
!
! Environment:
!       (Tos) = N.ex
!       in the range 0..255.
!
! Instruction:
!       INDB    Index
!
! Environment:
!       (Tos) = Address as an off
!       (Tos-1) = SrcAddr = Source address as an offset from stack base.
!       (Tos-2) = DstAddr = Destination address as aset from stack base.
!
! Result:
!       (Tos) = Memory[Address + Index].
!
!----------------------------------------------n offset from stack base.
!
! Result:
!       Stack popped three times.
!       Memory[DstAddr+0] = Memory[SrcAddr+0].
!   -------------------------------

! Opcode INDW.
!----------------------------------------------------------------------------    Memory[DstAddr+1] = Memory[SrcAddr+1].
!          ...
!       Memory[DstAddr+N-1] = Memory[SrcAddr+N-1].
!
! Calls:
!  -
!
! Abstract:
!       INDW is a two byte instruction that loads indirect with an index
!       in the range 0..65535.
!
     SetMovUp.
!
!-----------------------------------------------------------------------------

OpCode(MOVB), tmp := NextOp! Instruction:
!       INDW    LowByteIndex HighByteIndex
!
! Environment:
!       (Tos) = Address as an offset from stack b;
MoveWords: src  := Tos, Pop, if Eql Goto(MOV1);
        src := src - 1;                      !***** BR
        dst  := Tos ase.
!
! Result:
!       (Tos) = Memory[Address + Index].
!
!--------------------------------------------------------------- 1, if IntrPend Call(VectSrv);
        dst := dst + SB;
        Tos := src + SB, Call(SetMovUp);
MOV1:   Pop, NextInst(0);
---------------

Opcode(IND1), tmp := 1, Goto(IndexAndLoad);

Opcode(IND2), tmp := 2, Goto(IndexAndLoad);

Opcode(IND3), t
Opcode(MOVW), tmp := Tos, Pop, Goto(MoveWords);




$Title INDx - Index address and load indirect.

! Opcode IND1, INDmp := 3, Goto(IndexAndLoad);

Opcode(IND4), tmp := 4, Goto(IndexAndLoad);

Opcode(IND5), tmp := 5, Goto(IndexAndLoad);

Op2, ..., IND7.
!-----------------------------------------------------------------------------
!
! Abstract:
!       The INDx code(IND6), tmp := 6, Goto(IndexAndLoad);

Opcode(IND7), tmp := 7, Goto(IndexAndLoad);

Opcode(INDB), tmp := NextOp + SB;
I+0] = Memory[SrcAddr+0].
!       Memory[DstAddr+1] = Memory[SrcAddr+1].
!          ...
!       Memory[DstAddr+N-1] = Memory[Sopcodes are single byte instructions that load indirect
!       with an index of x.
!
! Instruction:
!       INDx
!
! EnvircAddr+N-1].
!
! Calls:
!       SetMovUp.
!
!-----------------------------------------------------------------------------ronment:
!       (Tos) = Address as an offset from stack base.
!
! Result:
!       (Tos) = Memory[Address + x].
!
!-------  	
        0;
        MA := 100, Fetch4;                           ! t3
        bpc := 0;                                    ! t0    IF Neq GoTo(Str4RErr);
        R11 - 1402;
        IF Neq GoTo(Str4RErr);
        R12 - 2404;
        IF Neq GoTo(Str4RE
        loadop;                                      ! t1
        R10 := MDI;
        R11 := MDI;
        R12 := MDI;
    rr);
        R13 - 3406;
        IF Neq GoTo(Fet4RErr);
        MA := 100, Store2;
        MDO := 2404;
        MDO := 3406    R13 := MDI;
        IF IntrPend Call(VecInt);
        R10 - 400;
        IF Neq GoTo(Fet4Err);
        R11 - 1402;
    ;
        MA := 100, Fetch2; !t3
        R10 := MDI;
        R11 := MDI;
        IF IntrPend Call(VecInt);
        R10 - 24    IF Neq GoTo(Fet4Err);
        R12 - 2404;
        IF Neq GoTo(Fet4Err);
        R13 - 3406;
        IF Neq GoTo(Fet4Err)04;
        IF Neq GoTo(Fet2Err);
        R11 - 3406;
        IF Neq GoTo(Fet2Err);
        MA := 102, Store2;
        MDO ;
        IF IntrPend Call(VecInt);
        call (ChkParity);  
        if NEQ goto (IsParErr);  

        tmp := 0;
!
! := 1234;
        MDO := 5432;
        MA := 102, Fetch2; !t3
        R10 := MDI;
        R11 := MDI;
        IF IntrPend CaTest NextOp
!
NextOpT:IF IntrPend Call(VecInt);
        tmp1 := NextOp;
        tmp - tmp1;
        IF Neq GoTo(NOerr);
  ll(VecInt);
        R10 - 1234;
        IF Neq GoTo(Fet2AErr);
        R11 - 5432;
        IF Neq GoTo(Fet2AErr);
        M      tmp - 7;
        tmp := tmp + 1, IF Neq GoTo(NextOpT);
        MA := 100, Fetch4R;                         ! t3
       A := 100, Fetch;
        adr;
        MA := 200, Store;
        MDO := MDI;
        MA := 100, Fetch;
        tmp := MDI;
 bpc := 0;                                   ! t0
        loadop;                                     ! t1
        R10 := MDI;        tmp - 2404;
        if neq goto(FSOvlpErr);
        call(ChkParity);
        if NEQ goto (IsParErr);
        
! tes  ! avoid abort for now
        nop;
        MA  := 100, Fetch;
        nop;
        nop;
        tmp := MDI;
        tmp-
        R11 := MDI;
        R12 := MDI;
        R13 := MDI;
        IF IntrPend Call(VecInt);
        R10 - 3406;
       1257;
        if NEQ goto (ErrorExit), ErrorType := 105;  !119-Store/Fetch failed
        call (ChkParity);
        if NEQ go IF Neq GoTo(Fet4RErr);
        R11 - 2404;
        IF Neq GoTo(Fet4RErr);
        R12 - 1402;
        IF Neq GoTo(Fet4RErr)to (IsParErr);

!
! Test the Byte Program Counter
!
        tmp := 17;
        
BpcL:   IF IntrPend Call(VecInt);
      ;
        R13 - 400;
        IF Neq GoTo(Fet4RErr);
        MA := 100, Store4R;
        MDO := 400;
        MDO := 1402;
   BPC := tmp;
        tmp1 := USTATE AND 17;
        tmp - tmp1;
        IF Neq GoTo(BpcErr),tmp := tmp - 1;
        IF Neq        MDO := 2404;
        MDO := 3406;
        0;
        MA := 100, Fetch4R;                         ! t3
        R10 := GoTo(BpcL);
        MA := 100, Store4;
        MDO := 400;
        MDO := 1402;
        MDO := 2404;
        MDO := 3406;
MDI;
        R11 := MDI;
        R12 := MDI;
        R13 := MDI;
        IF IntrPend Call(VecInt);
        R10 - 400;
       	
!       The IXAx opcodes are single byte instructions that index into arrays
!       with x words per element.
!
! Instructiomp := Tos and AllOnes;
        tmp := tmp + tmp, if IntrPend Call(VectSrv);
        tmp := Tos + tmp, Pop, Goto(IXArray2);

ndexedLoad: Tos + tmp, Fetch;
        Tos := Mdi, NextInst(0);

Opcode(INDW), Call(WordParm);
        tmp := Shift + tmp, ifn:
!       IXAx
!
! Environment:
!       (Tos) = Index.
!       (Tos-1) = Address of array.
!
! Result:
!       Stack po IntrPend Call(VectSrv);
IndexAndLoad: tmp := tmp + SB, Goto(IndexedLoad);




$Title INCx - Increment.

! Opcode INCB.pped.
!       (Tos) = Address + x * Index.
!
! Calls:
!       Multiply, VectSrv.
!
!--------------------------------------
!-----------------------------------------------------------------------------
!
! Abstract:
!       INCB is a two byte ins---------------------------------------

! Opcode IXAB.
!--------------------------------------------------------------------truction that increases the value on the top
!       of the stack by a constant amount in the range 0..255.
!
! Instruction:---------
!
! Abstract:
!       IXAB is a two byte instruction that indexes arrays with 0..255 words
!       per element.
!
!       INCB    Amount
!
! Environment:
!       (Tos) = Value.
!
! Result:
!       (Tos) = Value + Amount.
!
!---------
! Instruction:
!       IXAB    Size
!
! Environment:
!       (Tos) = Index.
!       (Tos-1) = Address of array.
!
! Res--------------------------------------------------------------------

! Opcode INCW.
!---------------------------------------ult:
!       Stack popped.
!       (Tos) = Address + Size * Index.
!
! Calls:
!       Multiply, VectSrv.
!
!---------------------------------------------------
!
! Abstract:
!       INCW is a three byte instruction that increases the value on the----------------------------------------------------------------

! Opcode IXAW.
!------------------------------------------- top
!       of the stack by a constant amount in the range 0..65535.
!
! Instruction:
!       INCW    LowByteAmount HighByt----------------------------------
!
! Abstract:
!       IXAW is a three byte instruction that indexes arrays with 0..32767
eAmount
!
! Environment:
!       (Tos) = Value.
!
! Result:
!       (Tos) = Value + Amount.
!
!-------------------------!       words per element.
!
! Instruction:
!       IXAW    LowByteSize HighByteSize
!
! Environment:
!       (Tos) = Inde----------------------------------------------------

Opcode(INCB), tmp := NextOp;
Increment:   Tos := Tos + tmp, NextInst(0)x.
!       (Tos-1) = Address of array.
!
! Result:
!       Stack popped.
!       (Tos) = Address + Size * Index.
!
! Call;

Opcode(INCW), Call(WordParm);
        tmp := Shift + tmp, Goto(Increment);




$Title IXAx, IXP - Index array.

! s:
!       Multiply, VectSrv.
!
!-----------------------------------------------------------------------------

Opcode(IXA1Opcode IXA1, IXA2, IXA3, IXA4.
!-----------------------------------------------------------------------------
!
! Abstract:
), tmp := Tos and AllOnes, Pop, Goto(IXArray2);

Opcode(IXA2), tmp := Tos and AllOnes, Pop, Goto(IXArray5);

Opcode(IXA3), t  	
 fetch;
        nop;
        nop;
        mdi - 12345;
        if eql goto(FPE1);
        ErrorType := 76, GoTo(ErrorExit);ollowing code writes a value in every word of memory.
! The value is a rotated version of the address, so it serves as
! a che             ! 112-Fetch error on Force Bad Parity
 
FPE1:   0, Iob(343);                                  ! turn off force back for shorted address lines.  The value is read back
! immediately to test for data errors.

        TShift := #215, ShiftOnd parity
        call(ChkParity);
        if neq goto(FPE2);
        ErrorType := 100, GoTo(ErrorExit);           ! 114-No paR;                   !rotate right 0
        adr := MaxAdrP1;
WLoop4: 
        adr := adr-4;
        adr+1;
        r11 := rity errors on Force Bad Parity

FPE2:   ParityErr - 100;
        if eql goto(FPE3);
        ErrorType := 101, GoTo(ErrorExiShift, if IntrPend call(VecInt);
        adr+2;                                      !t3
        r12 := Shift;
        adr+3;t);           ! 115-Wrong address on Force Bad Parity

FPE3:   ParityHit := 0;


!
! Memory Sweep test
!
! To find size 
        r13 := Shift;
        adr, Store4;                                !t3
        MDO := Shift, R10 := Shift;
        Mof memory, assume it is a small multiple of 2^17 words.
! Maximum is 2^20 words.

        adr := 100000;
        adr := adr+DO := R11;
        MDO := R12;
        MDO := R13;                                 !t3
        adr, Fetch4;                  adr;
        adr := adr+adr;                                ! adr := 2^17
        MaxAdrP1 := 0;
        MA := 0, Store;                   !t3
        MDI xor R10;
        MDI xor R11,  if NEQ goto (MemErrD4);       !t3
        MDI xor R12,  if NEQ g                    
        MDO := 13;                                     !  non-zero to loc zero
FindSzLp: if IntrPend calloto (MemErrD4);
        MDI xor R13,  if NEQ goto (MemErrD4);
        adr,          if NEQ goto (MemErrD4);
        adr-1, if(VecInt);
        MaxAdrP1 := MaxAdrP1+adr;                      !  next larger size
        MA := MaxAdrP1, Store;
        M NEQ goto (WLoop4);                !t3
      !advance shift amount and check for exit
        if C19 goto (Write4Done);
     DO := 0;                                      !  zero into MaxAdrP1
        MaxAdrP1-1;                                    !  t   TShift := TShift+#20, ShiftOnR;    !rotate right one farther
        TShift-377;
        if Lss goto(WLoop4);
        TShiest for MaxAdrP1=0
        if C19 goto(FoundSz);                          !  if so, size is 2MByte
        MA := 0, Fetch;    ft := #216, ShiftOnR;         !rotate right 8
        goto(WLoop4);
Write4Done:

        TShift := #215, ShiftOnR;          t parity error
        
ForcePE:TestContinue and 2;
        if neq goto(FPE3);
        tmp := 10000;
        tmp, iob(343);                            !  Check location zero
        nop;
        nop;
        MDI;                                                                     ! Write Bad Parity
        ma := 100, store;
        12345;
        nop;
        ma := 100,       !  if loc 0 is still 
        if NEQ goto (FindSzLp);                        !  non-0, loop again
FoundSz:


! The f   	
ironment:
!       (Tos) = Index.
!       (Tos-1) = Address of array.
!
! Result:
!       (Tos) = Field descriptor.
!      s as an offset from stack base.
!
! Result:
!       Stack popped.
!       (Tos) = Memory[Address].Field(FieldDescriptor).
! (Tos-1) = Word address of element.
!
! Calls:
!       Multiply, VectSrv.
!
!----------------------------------------------
! Calls:
!       VectSrv.
!
!-----------------------------------------------------------------------------

Opcode(LDP), -------------------------------

Opcode(IXP), tmp3 := NextOp;                 ! get size information
        tmp3, RightShifttmp := Tos, Pop;                ! field descriptor
        tmp1 := Tos, if IntrPend Call(VectSrv);  ! word address
        tmp(4);
        tmp1 := Shift + 1,                   ! elements per word = EPW
                           if IntrPend Call(VectSr1 + SB, Fetch;                    ! fetch the word
        tmp, ShiftOnR;                       ! set up shifter with field desOpcode(IXA4), tmp := Tos and AllOnes, Pop, Goto(IXArray4);

Opcode(IXAW), tmp := Tos, Pop, Goto(IXArray1);

Opcode(IXAB), tmv);
        tmp := Tos and AllOnes, Pop;
        Call(Divide);                        ! word offset = index div EPW
         p := NextOp;
IXArray1: tmp1 := Tos and AllOnes, Pop, Call(Multiply); !***** Multiply pops
IXArray2: Goto(IXArray3);                                               ! element offset = index mod EPW
        Tos := Tos + tmp;                    ! add word of         !***** burn a cycle after a pop

IXArray3: Tos := Tos + tmp, NextInst(0);

IXArray4: tmp := tmp + tmp, if IntrPend fset to address
        tmp3 := tmp3 and 17;                 ! bits per element - 1
        tmp := tmp3, if IntrPend Call(VectCall(VectSrv);
IXArray5: tmp := tmp + tmp, Goto(IXArray3);

! Opcode IXP.
!------------------------------------------------Srv);
        tmp := tmp + 1,                      ! bits per element = BPE
                        Call(Multiply);      ! bit-----------------------------
!
! Abstract:
!       IXP is a two byte instruction that indexes into packed arrays.
!       T offset=element offset * BPE

        tmp, LeftShift(4), Push;
        Tos := Shift or tmp3, NextInst(0);   ! form field desche inputs are
!          1) information about the size of an element represented as a byte
!             where the upper 4 bitriptor




$Title LDP, STPF - Load and store packed field.

! Opcode LDP.
!--------------------------------------------s contain one less than the number of
!             elements per word and the lower 4 bits contain one less than
!            ---------------------------------
!
! Abstract:
!       LDP is a one byte instruction that loads a packed field.  Its
!      the number of bits per element.
!          2) the index.
!          3) the address of the array.
!       The output is a pac  input is the same as the output of an IXP instruction--a packed
!       field pointer which consists of a word address and a ked field pointer--a word address and
!       a field descriptor.
!
! Instruction:
!       IXP     SizeInformation
!
! Envfield descriptor.
!
! Instruction:
!       LDP
!
! Environment:
!       (Tos) = FieldDescriptor.
!       (Tos-1) = Addres  	
     MDI xor R10;
        MDI xor R11,  if NEQ goto (MemErrD4);       !t3
        MDI xor R12,  if NEQ goto (MemErrD4);
     = 1;
        
Top4lp: r5 := r5 + 100000;                          ! try upper 4 bits, carry propogate a 1 up there
        r6         !rotate right 0
        adr := MaxAdrP1;
Rloop4: 
        adr := adr-1;
        r13 := Shift, IF IntrPend Call(VecI   MDI xor R13,  if NEQ goto (MemErrD4);
        adr,          if NEQ goto (MemErrD4);
        adr-1, if NEQ goto (WLoopI4);  nt);
        adr := adr-1;
        r12 := Shift;                       !t3
        adr := adr-1;
        r11 := Shift;
                 !t3
      !advance shift amount and check for exit
        if C19 goto (WrI4Done);
        TShift := TShift+#20,    adr := adr-1, Fetch4;               !t3
        R10 := Shift;
        nop;
        MDI xor r10;
        MDI xor r11, if  ShiftOnR;    !rotate right one farther
        TShift-377;
        if Lss goto(WLoopI4);
        TShift := #216, ShiftOnR;  Neq GoTo(MemErrA4); !t3
        MDI xor r12, if Neq GoTo(MemErrA4);
        MDI xor r13, if Neq GoTo(MemErrA4);
        adr,        !rotate right 8
        goto(WLoopI4);
WrI4Done:

        TShift := #215, ShiftOnR;                   !rotate right 0        if Neq GoTo(MemErrA4);
        adr-1, if NEQ goto(RLoop4);         !t3
        if C19 goto (MemDone4);
        TShift
        adr := MaxAdrP1;
RLoopI4: 
        adr := adr-1;
        r13 := not Shift, IF IntrPend Call(VecInt);
        adr : := TShift+#20, ShiftOnR;    !rotate right one farther
        TShift-377;
        if Lss goto(RLoop4);
        TShift := #21= adr-1;
        r12 := not Shift;                        !t3
        adr := adr-1;
        r11 := not Shift;
        adr :=6, ShiftOnR, goto(Rloop4); !rotate right 8
         
MemDone4: 

!
! now sweep memory again, inverting all values.  This en adr-1, Fetch4;                    !t3
        R10 := not Shift;
        nop;
        MDI xor r10;
        MDI xor r11, if Nsures that
! no bit is "stuck" as zero or one.
!

        TShift := #215, ShiftOnR;                   !rotate right 0
     eq GoTo(MemErrA4);      !t3
        MDI xor r12, if Neq GoTo(MemErrA4);
        MDI xor r13, if Neq GoTo(MemErrA4);
        a   adr := MaxAdrP1;
WLoopI4: 
        adr := adr-4;
        adr+1;
        r11 := not Shift, if IntrPend call(VecInt);
    dr,         if Neq GoTo(MemErrA4);
        adr-1, if NEQ goto(RLoopI4);             !t3
        if C19 goto (MemDoneI4);
        adr+2;                                      !t3
        r12 := not Shift;
        adr+3;
        r13 := not Shift;
         TShift := TShift+#20, ShiftOnR;          !rotate right one farther
        TShift-377;
        if Lss goto(RLoopI4);
       adr, Store4;                                !t3
        MDO := not Shift, R10 := not Shift;
        MDO := R11;
        MD    TShift := #216, ShiftOnR, goto(RLoopI4); !rotate right 8

MemDoneI4: call(ChkParity);
        if Neq GoTo(IsParErr);

O := R12;
        MDO := R13;                                 !t3
        adr, Fetch4;                                !t3
   
! check top4 bits of CPU memory

Top4:   IF IntrPend Call(VecInt);
        r5 := 100000;
        r2 := 10000;
        r3 :   	
!       VectSrv.
!
!-----------------------------------------------------------------------------

Opcode(STPF), tmp := Tos,   Deleted pointer, floating point comparisons.
!
!--------------------------------------------------------------------------- Pop;                ! value to be stored
        tmp1 := Tos, ShiftOnR;               ! set up shifter with field desc.
     --

$Title ROTSHI, QAND, QOR, QNOT - Logical operators.

! Opcode ROTSHI.
!----------------------------------------------   AllOnes, Pop;
        tmp2 := Shift;                       ! right mask as wide as field
        tmp := tmp and tmp2, if In-------------------------------
!
! Abstract:
!       ROTSHI is a two byte instruction that performs a shift or rotate on
! trPend Call(VectSrv);  ! mask off value
        tmp3 := Tos + SB, Fetch;             ! fetch destination
        tmp1 := tmp1       a word in the expression stack.  The function (shift or rotate) is
!       selected by an operand byte.  0 means shift anor 17, ShiftOnR;        ! LeftShift(FirstBit)
        tmp2, Pop;
        tmp2 := Shift;                       ! position mask d non-zero means
!       rotate.
!
!       A positive shift count means shift left, and a negative shift count
!       meansto make hole
        tmp1 := Mdi and not tmp2;            ! form hole
        tmp;
        tmp := Shift, if IntrPend Call(Vec shift right.  The shift count must be in the range -15..15.
!
!       A positive rotate count means rotate right, and a negattSrv); ! position value
        tmp3, Store;
        tmp1 or tmp, NextInst(0);            ! combine and store
               ive rotate
!       count means rotate right.  The rotate count may be in the range
!       -32768..32767.
!
! Instruction:
c.
        Mdi;                                 ! push Mdi at the shifter
        Tos := Shift, NextInst(0);           ! read  the field

! Opcode STPF.
!-----------------------------------------------------------------------------
!
! Abstract:
!        STPF is a one byte instruction that stores a packed field.  Its
!       input is the same as the output of an IXP instruc tion--a packed
!       field pointer which consists of a word address and a field descriptor.
!
! Instruction:
!       STPF!-----------------------------------------------------------------------------
!
!  File : perq.qcode.3
!
!  Abstract:
!   
!
! Environment:
!       (Tos) = Value.
!       (Tos-1) = FieldDescriptor.
!       (Tos-2) = Address as an offset from stac     More qcode expansions
!
!-----------------------------------------------------------------------------

!-------------k base.
!
! Result:
!       Stack popped three times.
!       Memory[Address].Field(FieldDescriptor) = Value.
!
! Calls:
----------------------------------------------------------------
!
!  Change Log:
!
!   3 Jan 82  Michael R. Kristofic
!     	
                            ! Check that the Stack upper 4 bits works
        r4 := tos,pop;
        r6 := not ustate(r4);
     ! the correct answer is
DspChk: R3 - R2;                                    ! check answer
        ErrorType := 127, if Neq      r6 := r6 and 170000;
        r6 - r2;
        ErrorType := 104, if neq goto(ErrorExit);   ! 118-Stack upper bits test fa Goto(ErrorExit);   ! 137-Wrong Dispatch target
        R3 := R3 + 1;                               ! next target
        R3 -iled

StackOk:r5 := r5 + 100000;                          ! Cause carry, incr top4
        r3 := r3 + 1;                      20;                                    ! do 16 targets
        if Lss Goto(DspLp);

!End of Test Code
        TestContinue           ! Next lower bit
        r2 := r2 + 10000;                           ! Next upper 4 bit
        if neq goto(top4lp);and 1;                         ! shall we loop
        if neq goto(StackTest);
        etmp := DDSdif, Call(SetDDS);           := not USTATE(r5);                       ! Read Y[19:16] on USTATE[15:12]
        r6 := r6 and 170000;
        r6 - r2;
    

        tmp1 := not 0;                              ! Set no carry
        tmp1 := tmp1 + 0;
        if C19 goto(C19Yes);     ErrorType := 102, if neq goto(ErrorExit);   ! 116-Upper 4 Bit Test failed
        Ma := 100, Store2;                                              ! C19 test is backwards
        ErrorType := 40, GoTo(ErrorExit);           ! 082-C19 didn't jump when i   ! now try to pick them up with MDX
        0;
        r3;
        MA := 100, Fetch2;
        R4 := MDI;                  t should have

C19Yes: tmp1 := tmp1 + 1;                           ! -1 + 1 causes carries
        if C19 Goto(C19No);

                   ! Make sure MDX or R4 gets good results
        R4 := MDX or R4;
        IF IntrPend Call(VecInt);
        R6     R3 := 0;                                    ! Prepare for Dispatch test
DspLp:  R3, Field(0,4);                            := not UState(r4);
        r6 := r6 and 170000;
        r6 - r2;
        ErrorType := 103, if neq goto(ErrorExit);   ! 117-M  ! first check Field
        R4 := Shift;                                ! pick up the field
        R4 - R3;                DX test failed


!Hang:   if IntrPend Call(VecInt);
!        Goto(Hang);
        dpytmp := 6000;                                               ! should be the same
        ErrorType := 125, if Neq Goto(ErrorExit);   ! 135-Field didn't work
        R  ! end of memory tests
        dpytmp, Iob(343);
        dpytmp, Iob(340);
!        dpytmp := 6000;                         3, Field(0,4);                             ! do it again
constant(DspTst,5000);
        R4 := Shift, Dispatch(DspTst);            ! end of memory tests
!        dpycnt := 1;                                ! turn off video
!VidOff: IF IntrPend Call(VecI      ! save results, Dispatch

        ErrorType := 126, Goto(ErrorExit);          ! 136-Dispatch did not jump

C19No:  Errnt);                   ! wait video interrupt
!        dpycnt xor 1;
!        if Eql goto(VidOff);

        r5, push;       orType := 42, Goto(ErrorExit);           ! 084-C19 jumped when it shouldn't

Case(DspTst,0), R2 := 0;                            	
to(RotSh1);  ! if shift function

!       Rotate.

        tmp := tmp and 17, LeftShift(4);     ! number of bits to rotate
-------------------------
!
! Abstract:
!       QOR is a one byte instruction that computes a fullword bitwise OR
!       of        tmp1 := Shift + 215;                 ! 8..15,13
        tmp - 10;
        if Lss Goto(RotSh3);                 ! if co two words in the expression stack.
!
! Instruction:
!       QOR
!
! Environment:
!       (Tos) = Word0.
!       (Tos-1) unt < 8, 8..15,13
        tmp1 := tmp1 + 201, Goto(RotSh3);    ! if count >= 8, 8..15,14
        
!       Shift.

RotSh1: t= Word1.
!
! Result:
!       Stack popped.
!       (Tos) = Word0 or Word1.
!
!--------------------------------------------mp1 := 17, if Geq Goto(RotSh2);
        tmp1 := tmp1 + tmp;                  ! shift right, we need 15 - n.
        tmp := not---------------------------------

Opcode(QOR), tmp := Tos, Pop;
        Tos := Tos or tmp, NextInst(0);

! Opcode QNOT.
 tmp;                      ! n is negative so 15 - (-n)=15+n
        tmp := tmp + 1;
RotSh2: tmp, LeftShift(4);
        tmp1 !-----------------------------------------------------------------------------
!
! Abstract:
!       QNOT is a one byte instr:= Shift + tmp1, Goto(RotSh3);  ! 0..15,15 for shift left
                                             ! 0..15,15..0 for shift uction that complements the low order bit
!       of a word in the expression stack.
!
! Instruction:
!       QNOT
!
! Envright

!       Do the shift or rotate.

RotSh3: tmp1, ShiftOnR;                      ! set up the shifter
        Tos;     ironment:
!       (Tos) = Word.
!
! Result:
!       (Tos) = not Word.
!
!-------------------------------------------------                            ! data to be shifted
        Tos := Shift, NextInst(0);           ! put the result on the stack
----------------------------

Opcode(QNOT), Tos := Tos xor 1, NextInst(0);




$Title xxxBool - Boolean comparisons.


! Opcode QAND.
!-----------------------------------------------------------------------------
!
! Abstract:
!       QAND is! Opcode EQUBool, NEQBool, LEQBool, LESBool, GEQBool, GTRBool.
!--------------------------------------------------------------- a one byte instruction that computes a fullword bitwise AND
!       of two words in the expression stack.
!
! Instruction:
--------------
!
! Abstract:
!       The xxxBool opcodes are one byte instructions that compare two boolean
!       values i!       ROTSHI  Function
!
! Environment:
!       (Tos) = Shift or rotate count.
!       (Tos-1) = Word to shift or rotate.!       QAND
!
! Environment:
!       (Tos) = Word0.
!       (Tos-1) = Word1.
!
! Result:
!       Stack popped.
!       
!
! Result:
!       Stack popped.
!       (Tos) = Shifted or rotated word.
!
!--------------------------------------------(Tos) = Word0 and Word1.
!
!-----------------------------------------------------------------------------

Opcode(QAND), tmp---------------------------------

Opcode(ROTSHI), tmp := NextOp;               ! function
        tmp := Tos, Pop, if Eql Go := Tos, Pop;
        Tos := Tos and tmp, NextInst(0);

! Opcode QOR.
!----------------------------------------------------  	
pChk);

Case(DspTst,16), R2 := 16, Goto(DspChk);

Case(DspTst,17), R2 := 17, Goto(DspChk);


! Long Pause to see screen e      ! 113-Unexpected Parity Err
         
Refill:  ErrorType := 106, GoTo(ErrorExit);         ! 120-Unexpected refill

Bpcffects and DDS
LongPause:
       tmp := 100000;
       PauLoop: 
             tmp1 := 400;
             Pinner: 
         Err:  tmp := tmp + 1;
         ErrorType := 107, GoTo(ErrorExit);         ! 121-BPC test failed

Fet4Err: ErrorType := 110, G         if IntrPend call(VecInt);
                  tmp1 := tmp1-1;
                  if NEQ goto(Pinner);
             tmp oTo(ErrorExit);         ! 122-Fetch4 test failed

Fet4RErr:ErrorType := 111, GoTo(ErrorExit);         ! 123-Fetch4R test faile:= tmp-1;
             if EQL return;
             goto(PauLoop);

!
! The error routines.
!

ErrorExit: etmp := ErrorTyd

Str4RErr:ErrorType := 112, GoTo(ErrorExit);         ! 124-Store4 test failed

Fet2Err: ErrorType := 113, GoTo(ErrorExit);pe, Call(SetDDS);         ! save error code
        if ByteSign goto(Busted);                   ! if started via boot
                 ! 125-Fetch2 test failed

Fet2AErr: ErrorType := 114, GoTo(ErrorExit);        ! 126-Store2 test failed

NOerr:   ErR370 := ErrorReturn, GoTo(BreakPoint);      ! if started via ODTPRQ

        
SetDDS: etmp := etmp + DDSoffset;              rorType := 115, GoTo(ErrorExit);         ! 127-NextOp test failed

FSOvlpErr: ErrorType := 116, GoTo(ErrorExit);       ! 128-F     ! DDS starts at 30
ErrLp:  StackReset, ecnt := 10;                     ! increment DDS

ErrWt:  ecnt := ecnt - 1, if neqetch/Store Overlap failed

!
! clear interrupts so we get parity hit if needed
!
ChkParity: 
        if IntrPend call(VecI     ! set DDS to 150
        if ByteSign GoTo(SYSBEntry);                ! if started via boot
        R370 := GoodReturn;    goto(ErrWt);       ! but not to quickly
        etmp := etmp - 1;                           ! how many incrs do we need
                           ! if started via ODTPRQ
        ErrorType := 0, GoTo(BreakPoint);

Case(DspTst,1), R2 := 1, Goto(DspChk   if neq goto(ErrLp);
        TestContinue, return;                       ! return Switch Reg on R
        
Busted: goto(bus);

Case(DspTst,2), R2 := 2, Goto(DspChk);

Case(DspTst,3), R2 := 3, Goto(DspChk);

Case(DspTst,4), R2 := 4, Goto(DspChk);ted);                               ! Loop for a long time.


MemErrD4: ErrorType := 123, GoTo(ErrorExit);        ! 133-Data 

Case(DspTst,5), R2 := 5, Goto(DspChk);

Case(DspTst,6), R2 := 6, Goto(DspChk);

Case(DspTst,7), R2 := 7, Goto(DspChk);
error on sweep

MemErrA4: ErrorType := 124, GoTo(ErrorExit);        ! 134-Addr error on Sweep

MemErrID4: ErrorType := 130, 
Case(DspTst,10), R2 := 10, Goto(DspChk);

Case(DspTst,11), R2 := 11, Goto(DspChk);

Case(DspTst,12), R2 := 12, Goto(DspChkGoTo(ErrorExit);       ! 138-DataErr:InvertSweep

MemErrIA4: ErrorType := 131, GoTo(ErrorExit);       ! 139-AddrErr:InvertSwee);

Case(DspTst,13), R2 := 13, Goto(DspChk);

Case(DspTst,14), R2 := 14, Goto(DspChk);

Case(DspTst,15), R2 := 15, Goto(Dsp

IsParErr: tmp := ParityErr;                         ! we got a parity error
         ErrorType := 77, GoTo(ErrorExit);       	
n the expression stack for equality and/or order.  The
!       following statements define the comparison operations.
!
!           NGI is a one byte instruction that negates an integer in the
!       expression stack.
!
! Instruction:
!       NGI
        Ord(False) = 0.
!            Ord(True) = 1.
!            False < True.
!
! Instruction:
!       xxxBool
!
! Envir!
! Environment:
!       (Tos) = Word.
!
! Result:
!       (Tos) = - Word.
!
! Calls:
!       Nxt.     *** BAD: jumps inonment:
!       (Tos) = Word0.
!       (Tos-1) = Word1.
!
! Result:
!       Stack popped.
!       (Tos) = Word0 xxx Word1.to another Q-code ***
!
!-----------------------------------------------------------------------------

Opcode(ABI), tmp := 
!
! Design:
!       These opcodes should be removed at a later time since the integer
!       comparisons will do the rightTos;
        if Geq Goto(Nxt);                    ! if already positive
NegateInteger: Tos := Zero - tmp, NextInst(0);

Opco thing for single bit inputs.
!
! Calls:
!       Integer comparisons.
!
!--------------------------------------------------de(NGI), tmp := Tos, Goto(NegateInteger);


! Opcode ADI, SBI, MPI, DVI.
!----------------------------------------------------------------------------

Opcode(EQUBool), Goto(EQUInt);

Opcode(NEQBool), tmp := Tos, Pop;             ! this one's also----------------------------
!
! Abstract:
!       ADI, SBI, MPI, DVI are one byte instructions that perform addition,
!     used for
        Tos := Tos xor tmp, NextInst(0);      ! fullword XOR

Opcode(LEQBool), Goto(LEQInt);

Opcode(LESBool), Go   subtraction, multiplication, and division respectively on two
!       integer values in the expression stack.
!
! Instructto(LESInt);

Opcode(GEQBool), Goto(GEQInt);

Opcode(GTRBool), Goto(GTRInt);




$Title - xxI, MODI, CHK - Integer arithion:
!       xxI
!
! Environment:
!       (Tos) = Word0.
!       (Tos-1) = Word1.
!
! Result:
!       Stack popped.
!  metic.

! Opcode ABI.
!-----------------------------------------------------------------------------
!
! Abstract:
!          (Tos) = Word0 function Word1.
!
! Calls:
!       Multiply, Divide.
!
!------------------------------------------------  ABI is a one byte instruction that computes the absolute value of
!       an integer in the expression stack.
!
! Instructi-----------------------------

Opcode(ADI), tmp := Tos, Pop;
        Nop;                                 !***** MAB
       on:
!       ABI
!
! Environment:
!       (Tos) = Word.
!
! Result:
!       (Tos) = Absolute value of Word.
!
! Calls:
 Tos := Tos + tmp, NextInst(0);

Opcode(SBI), tmp := Tos, Pop;
        Nop;                                 !***** MAB
     !       Nxt.     *** BAD: jumps into another Q-code ***
!
!-------------------------------------------------------------------   Tos := Tos - tmp, NextInst(0);

Opcode(MPI), tmp1 := Tos and AllOnes, Pop;
        tmp := Tos and AllOnes, Call(Multiply);----------


! Opcode NGI.
!-----------------------------------------------------------------------------
!
! Abstract:
!
        Tos := tmp, NextInst(0);

Opcode(DVI), tmp1 := Tos and AllOnes, Pop;
        tmp := Tos and AllOnes, Call(Divide);  	
         ! If Z80 Interrupts, read register to dismiss it

BadInt1: ErrorType := 117, GoTo(ErrorExit), Loc(5304);! 129-Bad Int errupt loc 4

DskInt: 0, IOB(301),return, Loc(5310);               ! If Dsk Interrupts, function:=0 to dismiss

BadInt3: Err orType := 120, GoTo(ErrorExit), Loc(5314);! 130-Bad Interrupt loc 14

BadInt4: ErrorType := 121, GoTo(ErrorExit), Loc(5320);! ! SysB - Perq System Loader
!
!  Copyright 1981, Three Rivers Computer Corp.
!
! Change Log:
!
!  22 Jan 81 V2.5  WJHansen131-Bad interrupt loc 20

DpyInt:  dpytmp, Iob(343), Loc(5324);  ! load VidState
         dpytmp, Iob(340);             ! loa  add copyright notice
!                            change error message 156
!                            make change log
!
d line count
Dpy1:    0, Iob(342);                  ! load cursor address
         dpytmp and 200;
         if Eql Goto(Dpy2)!  2 May 81  V2.4  GGR  Change to load 3.75k instead of 3k microcode.

!  6 May 81  V2.3  JPS  At end of hard disk boot, seek ;            ! if we didn't load second retrace
         0, Iob(341);                  ! address of screen bit map div 2
     to cylinder 0.

! 25 Apr 81  V2.2  JPS  Fix bug in hard disk seek code -- it wasn't waiting for
!                       the s    0, Iob(344);                  ! load cursor X value
         dpycnt := 11;
Dpy2:    dpytmp := 102000;             ! next ceek to finish.

! 24 Mar 81  V2.1  JPS  Change DIBDA to 40 for new file system.

!  V2.0  George Robertson - Carnegie-Mellonommand: display normal
         dpycnt := dpycnt - 1;
         if Gtr return;                ! if not end of screen
          University
!  V1.0  Brian Rosen - Three Rivers Computer Corporation
!
! SysB starts by turning off the Z80 (in case a floppydpytmp := 101154;             ! next command: first vertical retrace
         dpycnt;
         if Eql return;                ! boot was in
! progress).
! It then reads the boot id from the keyboard (lower case alphabetics are
! hard disk boots, upper  if end of screen
         dpytmp := 101351, return;     ! next command: second vertical retrace
         
BadInt6: ErrorTypecase alphabetics are floppy boots).
! The default boot is 'a'.
! Start by reading microcode and loading it into the lower 3.75nt);
        if IntrPend call(VecInt);
        if IntrPend call(VecInt);
        if IntrPend call(VecInt);
        ParityHit := 122, GoTo(ErrorExit), Loc(5330);!132-Bad interrupt loc 30
         
ParInt: ParityHit := 1, Loc(5334);                   , return;
        
!
! Set up the interrupt vectors.
!
! The code for memory test assumes the shifter is not used for inter
        IOB(147);                                    ! Read Parity error register
        ParityErr := IOD, Return;
        rupts

VecInt: Vector(Z80Int);                              ! Service interrupts
Z80Int: IOB(106),return, Loc(5300);         
        
END;
                                                                                                                  	
------------------------------

Opcode(CHK), tmp := Tos, Pop;                ! get Minimum
        tmp1 := Tos, Pop;         

LEQInt:
Opcode(LEQI), tmp := Tos, Pop;
        tmp1 := Tos;                         !***** BR
        tmp1 := tmp1 - tmp;           ! get Maximum
        tmp2 := Tos;                         ! get Value  !***** BR
        tmp2 - tmp1;                               !***** BR MAB
        if Leq Goto(SetTrue);                ! if less than or equal
        Tos := 0, NextIns            !***** BR
        tmp2 - tmp, if Lss Goto(ChkOvr);     ! if Value < Minimum  !***** BR
        if Gtr Goto(ChkOvr)t(0);               ! set false

LESInt:
Opcode(LESI), tmp := Tos, Pop;
        tmp1 := Tos;                         !***** 
        Tos := tmp, NextInst(0);

! Opcode MODI.
!-------------------------------------------------------------------------;                 ! if Value > Maximum
        NextInst(0);                         ! if in range




$Title xxxI - Intege----
!
! Abstract:
!       MODI is a one byte instruction that computes the modulus (remainder
!       after integer divisior comparisons.

! Opcode EQUI, NEQI, LEQI, LESI, GEQI, GTRI.
!--------------------------------------------------------------n) of two integer values in the expression stack.
!
! Instruction:
!       MODI
!
! Environment:
!       (Tos) = Word0.
!---------------
!
! Abstract:
!       The xxxI opcodes are one byte instructions that compare two integer
!       values in        (Tos-1) = Word1.
!
! Result:
!       Stack popped.
!       (Tos) = Word0 mod Word1.
!
! Calls:
!       Divide.
!the expression stack for equality and/or order.
!
! Instruction:
!       xxxI
!
! Environment:
!       (Tos) = Word0.
!  
!-----------------------------------------------------------------------------

Opcode(MODI), tmp1 := Tos, Pop;
        tmp      (Tos-1) = Word1.
!
! Result:
!       Stack popped.
!       (Tos) = Word0 xxx Word1.
!
! Calls:
!       SetFalse, Set:= Tos, Call(Divide);
        Tos := tmp1, NextInst(0);

! Opcode CHK.
!---------------------------------------------------True.
!
!-----------------------------------------------------------------------------

EQUInt:
Opcode(EQUI), tmp := Tos, P--------------------------
!
! Abstract:
!       CHK is a one byte instruction that checks an integer value to be sure
!    op;
        tmp1 := Tos;                         !***** BR
        tmp1 := tmp1 xor tmp;                !***** BR MAB
          that it is in a certain range.  If the value is out of range, an
!       ErrInxCase error is caused.
!
! Instruction:
!   if Eql Goto(SetTrue);                ! if equal
        Tos := 0, NextInst(0);               ! set false

NEQInt:
Opcode(NE     CHK
!
! Environment:
!       (Tos) = Minimum.
!       (Tos-1) = Maximum.
!       (Tos-2) = Value
!
! Result:
!     QI), tmp := Tos, Pop;
        tmp1 := Tos;                         !***** BR
        tmp1 := tmp1 xor tmp;                !***  Stack popped twice.
!       (Tos) = Value.
!
! Calls:
!       ChkOvr.
!
!-----------------------------------------------** BR MAB
        if Neq Goto(SetTrue);                ! if not equal
        Tos := 0, NextInst(0);               ! set false  	
k of microstore.
! Then load system qcode.
! Then store disk id (0 or 1) and keystroke into the 4th and 5th words
! of the SInterpCyl,42);
define(InterpSec,11);                     ! Note same as Interp1st
define(IsFloppy,43);
define(LastAdr,44);    T table.
! Then start microcode at QCode entry point, 2400.
!
! This code is loaded by Boot, The Prom Bootstrap Loader
!
!   ! end of system qcode

constant(dstat,100);
constant(dseek,301);
constant(dhead,302);
constant(CylSec,310);
constant(FilThe Diagnostic Display is set to 150 when this code is entered
!  Errors are:
!    150 - Sysb not loaded correctly
!    151 -eL,311);
constant(FileH,312);
constant(Block,313);
constant(CWadrL,331);
constant(CWadrH,321);
constant(DatAdrL,330);
cons Sysb did not complete
!    152 - Illegal Boot Key
!    153 - Hard Disk Restore Failure
!    154 - No such boot
!    155 - Ntant(DatAdrH,320);
constant(DirOut,0);
constant(DirIn,10);
constant(DIBDA,40);                       ! Disk Information Blocko interpreter for that key
!    156 - Interpreter file is empty
!    157 - Disk Error
!    158 - Floppy error
!    159 - Mal disk addr
constant(StTrack,0);
constant(StHead,0);

constant(DIBCyl,5);                       ! Disk Info Block cylinder onformed Boot File
!    160 - CheckSum error in microcode
!    161 - CheckSum error in QCode
!    162 thru 168 - Bad interrupts Floppy
constant(DIBSec,3);                       ! Disk Info Block sector on Floppy
constant(SITInfo,406);

! The SAT/SIT t
! this code sets the DDS to 198 on exit
!


place(7000,7777);        ! Boot Loads into the upper 2k of microstore
define(able is 1st, followed by the cursor,
!   and together, all are 3000 octal long

constant(SatSitCursLen,3000);
constant(EndSar0,0);
define(c400,1);
define(BootID,2);
define(BootKey,3);
define(c1777,4);
define(data,5);
define(Bite,6);
define(BigDltSitCursSec,6);             ! SatSitCursLen / #400

! the screen image is 1024 lines of (768/16) words or 48k
! it starts afty,7);
define(Boot1st,10);
define(Interp1st,11);
define(TryCnt,12);
define(NextDA,13);
define(SaveMA,14);
define(Cyl,15);
er the SAT/SIT table

constant(ScreenLen,140000);
constant(EndScreenP1,143000);             ! end of screen + 1 = SatSitCursLdefine(NewCyl,16);
define(SeekCnt,17);
define(Dir,20);
define(Head,21);
define(tmp,22);
define(Sec,23);
define(SecCnt,24);en + ScreenLen

!
! For Spice boots, the microcode is loaded after the system qcode and
! is 3.75*3 long

constant(UCodeSi
define(Dly,25);
define(KeyTryCnt,26);
define(DskType,27);
define(CylHd,30);
define(MemAdr,31);
define(CkSum,32);
define(ze,26400);
constant(sysbDDSdif,10#47);               ! What to add to DDS on good exit

!
! Offset in Disk Information TableOffset,33);
define(ByteCnt,34);
define(NextCyl,35);
define(NextSec,13);   ! Note Same as NextDA
define(Word,36);
define(Las for BootTable and InterpTable

constant(BootTableOffset,10#10);          ! Must agree with DiskIO.Pas
constant(InterpTableOftHead,37);
define(LastCyl,40);
define(BootCyl,41);
define(BootSec,10);                       ! Note same as Boot1st
define(Ifset,10#62);

SysbStart:
        Data := 0, StackReset,Loc(7000);  ! Increment the Diagnostic Display
        C400 := 400;     	
---------------------------------
!
! Abstract:
!       Sets are represented in two ways--the first is used when a set is
!  same as the declared length.  This is done
!       adding zero words or deleting words from its high end (farthest
!       fr      in memory (in a variable).  The second is used when a set is loaded
!       onto the expression and memory stack.
!
!  om the top of the memory stack).  The length word is popped from
!       the expression stack, and an STMW is used to store the     In memory, a set is stored as a collection of bits.  The set
!
!            S: set of Low..High
!
!       is represente set.
!
!       When a two operand set instruction is to be done, the set that is
!       lower in the memory stack must haved in the same way as
!
!            A: packed array[0..High] of Boolean
!
!       where
!
!            x in S <==> A[x].
 a length that is greater than
!       or equal to the length of the other set.  If the lower set has a
!       smaller length!            
!       That is, bit B of word W is set when W*16 + B is a member of the set.
!       Thus the position of a cer, it is adjusted to be the same length as the longer
!       set.
!
!--------------------------------------------------------tain element does not depend on the declared
!       low bound of the set type.  Sets are implemented as though all sets
!    ---------------------

! Opcode ADJ.
!-----------------------------------------------------------------------------
!
! AbBR
        tmp1 := tmp1 - tmp;                  !***** BR MAB
        if Lss Goto(SetTrue);                ! if less than
      have a low bound of 0.  The number of words in such a set is exactly
!       High div 16 + 1.  No length information is stor     Tos := 0, NextInst(0);               ! set false

GEQInt:
Opcode(GEQI), tmp := Tos, Pop;
        tmp1 := Tos;          ed when a set is in
!       memory.  The length is compiled into the code.
!
!       On the stack (expression and memory stac               !***** BR
        tmp1 := tmp1 - tmp;                  !***** BR MAB
        if Geq Goto(SetTrue);             ks together), a set is
!       represented by a length on the expression stack, and a bit string
!       on the memory stack.    ! if greater than or equal
        Tos := 0, NextInst(0);               ! set false

GTRInt:
Opcode(GTRI), tmp := Tos, Po The length is in words.  The bit string is
!       in reverse order as though it were loaded via a LDMW instruction.
!       p;
        tmp1 := Tos;                         !***** BR
        tmp1 := tmp1 - tmp;                  !***** BR MAB
        Thus bit B of word Memory[TP-W] is set when W*16 + B is a member
!       of the set.
!
!       A set is loaded onto the stackif Gtr Goto(SetTrue);                ! if greater than
        Tos := 0, NextInst(0);               ! set false





$Tit by loading its declared length (in
!       words) onto the expression stack, and loading its bit string onto
!       the memole ADJ, SGS, SRS, INN, UNI, QINT, DIF - Set arithmetic.

! Data structure SET.
!--------------------------------------------ry stack with LDMW.
!
!       A set is stored into memory by adjusting its length on the memory
!       stack until it is the  	
2, if neq goto(FindCh);! preset error code for Illegal boot
        BootKey := Bite;                  ! Boot keystroke
       l return;
        Dly := Dly - 1, goto(WaitLp);

!
! Here when we didn't see a keystroke


NoKeys: KeyTryCnt := KeyTryCnt BootID := Bite;                   ! BootID is index
        BootID := BootID - 101;           ! subtract ASCII for "A"
       - 1;       ! Try it a few times
        if gtr goto(KeyRetry);            ! give the Z80 another chance
        BootKey := 14  BootID - 31, if lss goto(Busted); ! ID out of range
        if leq goto(FlopBoot);            ! Upper case => Floppy Boot
  1;
        BootID := 0, goto(GotID);         ! Default boot is 'a'

!
! Send a keyboard status change message to Z80


Ke                    ! A constant used many times
        C1777 := 1777;
        tmp := 6000;
        tmp, IOB(343);                BootID := BootID - 40;
        BootID - 31, if lss goto(Busted);
        if gtr goto(Busted);
GotID:  bite := 0, Call(K          ! shut off video interrupts
        ThreeWayBranch(0);                ! Make sure 2910 stack is empty
        ThreeWeysOnOff);       ! Turn keyboard off

!
!Position the heads

Restore:tmp := 20;                        ! in WaitABit, the TayBranch(0);

! We turn the Z80 off for 2 reasons
! First, the hardware has a glitch when first starting up the Writable
! Crack 0 bit
        Dir := DirOut, Call(Seek);        ! Go back one step
        TryCnt := TryCnt - 1, if neq goto(ReadDIB); ! ontrol Store ram, the power surge can screw up the Z80.
! Secondly, we want to shut off the floppy boot sequence if it had starKeep trying
        tmp := 10#153, if gtr goto(Restore);
        goto(Busted);                     ! busted if Restore failedted

        KeyTryCnt := 2, Call(Z80Off);     ! Wait a while for key
                                          ! Shut down Z
        
!
! Seek the disk One track in dir direction


Seek:   Dir or 27, iob(dseek);            ! Set the step bit + dir80 to stop boot
        Call(WaitAWhile);                 ! Delay a few milliseconds
KeyRetry: 0, IOB(301);                    bit + reset
        Dly := C1777, Call(WaitLp);       ! Make a pulse
        Dir, iob(dseek);                  ! Clear the st ! turn Z80 on
        Cyl := 0, Call(WaitAWhile);       ! Let it start up
        
!
! Read keyboard

        bite := 1, ep bit
                                          ! Fall into WaitABit
                                          ! Assumes SeekCall(KeysOnOff);       ! Turn Keyboard on
FindCh: Call(RecZ80Byte);                 ! Wait for keyboard char
        Bite - 15 Complete Happens
!
! Wait for a bit to come up


WaitABit: Call(WaitAWhile);               ! Wait some time
        iob(d3, if neq goto(NoKeys);
        IsFloppy := 0, if neq goto(FindCh);
        Call(RecZ80Byte);
        Bite - 1, if neq goto(Fstat);                       ! Get the disk status
        r0 := iod;
        r0 and tmp, return;               ! Test the bitindCh);    ! Keyboard char prefix
        TryCnt := C400, if neq goto(FindCh);
        Call(RecZ80Byte);
        tmp := 10#15 and return

!
! Wait long enough for a sector to transfer, a head to settle, etc

WaitAWhile: Dly := 77777;
WaitLp: if eq   	
        tmp1 := NextOp - tmp;                ! difference in length
        tmp3 := tmp1, if Gtr Goto(Adj1);     ! if set shoul       SGS
!
! Environment:
!       (Tos) = N = Member ordinal.
!
! Result:
!       (Tos) = L = Length of set = N div 16 +d be lengthened
        tmp1;                                ! allow placer to do page escape
        if Lss Goto(Adj3);       1.
!       N words pushed onto memory stack.
!       Memory[TP-0] = 0.
!       Memory[TP-1] = 0.
!          ...
!       Me             ! if set should be shortened
        NextInst(0);                         ! if set is already the right size

! mory[TP-L+2] = 0.
!       Memory[TP-L+1] = 1 LeftShift (N mod 16).
!
! Calls:
!       MakeBit, SetZero, ChkStk, SetOverFlow,      Lengthen the set with zero words.

Adj1:   Tos := TP - tmp, Push;               ! save address of deep end
        TP : VectSrv.
!
!-----------------------------------------------------------------------------

Opcode(SGS), tmp11 := 1, Call(Ma= TP + tmp1, if IntrPend Call(VectSrv);
        SL - TP;
        tmp, if C19 Goto(Adj4);              ! if not enough room
  keBit);      ! make a word with a single bit
        tmp - 10000;
        tmp, if Lss Goto(SGS2);              ! if member <=       dst := Tos + tmp1, if Eql Goto(Adj2);  ! if null set
        Call(SetMovUp);                      ! open up the set
Adj24095

!       Make a null set.

SGS1:   Tos := 0, Push, NextInst(0);         ! null set

SGS2:   dst := TP, if Lss Goto(SG:   tmp1 := tmp3, Call(SetZero);         ! zero out the new words
        Pop, NextInst(0);

!       Shorten set by deleting S1);        ! if member < 0
        tmp, RightShift(4);
        tmp1 := Shift + 1, Push;             ! set size
        tmp10words.

Adj3:   Tos := TP + 1, Push;                 ! end of set + 1
        TP := TP + tmp1, if IntrPend Call(VectSrv);
   := tmp1, LoadS(SetOverFlow);
        dst := dst + tmp1, Call(ChkStk);     ! see if the set will fit
        TP := TP + 1, Sto      dst := Tos + tmp1, Call(SetMovDown); ! delete words
        Pop, NextInst(0);

!       It won't fit, signal an error.
re;                 ! push the bit
        tmp5, if IntrPend Call(VectSrv);
        tmp1 := tmp1 - 1, Call(SetZero);     ! pusstract:
!       ADJ is a two byte instruction that adjusts a set prior to storing
!       it.
!
! Instruction:
!       ADJ 
Adj4:   tmp11 := 2;                          ! PC backup
        TP := TP - tmp1;                     ! TP backup
SetOverFlo    DesiredLength
!
! Environment:
!       (Tos) = Actual length.
!
! Result:
!       Stack popped.
!       Set on the mew: Tos := tmp, Goto(StkOv);        ! restore ESTK

! Opcode SGS.
!----------------------------------------------------------mory stack adjusted to have the desired length.
!
! Calls:
!       SetMovUp, SetMovDown, VectSrv, StkOv.
!
!----------------------------------
!
! Abstract:
!       SGS is a one byte instruction that builds a singleton set--a set
!       that cons--------------------------------------------------------------

Opcode(ADJ), tmp := Tos, pop;                ! actual length
ists of a single member.  If the member ordinal is outside
!       the range 0..4095 a null set is built.
!
! Instruction:
!  	
                 ! Must be 0 when Hard Disk is on
        BootSec + BootCyl;
        tmp := 10#154, if eql goto(Busted);! No bMemAdr = EndScreenP1
        MemAdr := MemAdr + EndScreenP1;
        goto(CkRest);
        
! Load interpreter microcode
! oot for that key
        BootID + InterpTableOffset, Fetch2; ! Get DA of Interpreter
        InterpSec := MDI;                Will load all data from microcode file, but ASSUMES that it is 3.75k
! (or 45 blocks) long.

LdMic:  tmp := 10#161, if neq go ! Interp1st overlaps InterpSec
        InterpCyl := MDI;                 ! Must be 0 when Hard Disk is on
        InterpSec +to(Busted); ! Checksum error in Qcode
        MemAdr := LastAdr;                  ! load 3.75k of Ucode in hi memory
        N InterpCyl;
        tmp := 10#155, if eql goto(Busted);! No interpreter for that key
        
!
! Load system qcode first
 extSec := InterpSec;
        NextCyl := InterpCyl;
        TryCnt := 10, Call(DoOneBlock);     ! Skip over segment hdr blk
         
        MemAdr := 0;
        NextCyl := BootCyl;
        NextSec := BootSec;
        SecCnt := 0;
        TryCnt :=      NextSec + NextCyl;
        tmp := 10#156, if eql goto(Busted); ! Interpreter file is empty
        
DoNextIB: TryCnt := 10, Call(DoOneBlock);   ! Skip over segment hdr blk
        NextCyl + NextSec;
        tmp := 10#159, if eql goto(Busted);! M 10, Call(DoOneBlock);
        NextSec + NextCyl;
        MemAdr := MemAdr + C400, if neq goto(DoNextIB); ! Chain until 00

ysOnOff: tmp := 153, Call(SndZ80Byte);  ! Start of message
        tmp := 007, Call(SndZ80Byte);     ! Set Keyboard Status
   alformed boot file
        
DoNextBlock: SecCnt - EndSatSitCursSec;   ! Are we at end of Sat/Sit table
        if neq goto(No     tmp := 001, Call(SndZ80Byte);     ! One byte
        bite, IOB(307), return;           ! 0 = Off, 1 = On

!
! Read DisktEndSS);
        MemAdr := MemAdr + ScreenLen;     ! Bypass screen area
        
NotEndSS: TryCnt := 10, Call(DoOneBlock);
  Information Block


ReadDIB:
        MemAdr := 0;                      ! Read into memory 0 - 377
        NextCyl := DIBCy       SecCnt := SecCnt + 1;
        NextCyl + NextSec;
        MemAdr := MemAdr + C400, if neq goto(DoNextBlock);
        
l;
        IsFloppy;
        NextSec := DIBSec, if neq goto(RdDib1);
        NextDA := DIBDA;                  ! NextDA overl! Got system boot, checksum it, then load interpreter
        
        LastAdr := MemAdr;                ! save end address
 aps NextSec
        NextCyl := 0;                     ! Must be 0 when Hard Disk is on

RdDib1: TryCnt := 10, Call(DoOneBlock       Cksum := 0, goto(CkRest);
SkpScr: MemAdr := SatSitCursLen;          ! skip over the screen area
CkRest: MemAdr := MemAd);   ! Read the DIB
        BootID := BootID + BootID;        ! Get DA of Boot, 2 words/entry
        BootID + BootTableOffsetr - 1, Fetch;
        Cksum, if C19 goto(LdMic);        ! if MemAdr < 20-bit zero
        MemAdr := MemAdr - EndScreenP1;
   , Fetch2; ! Offset to BootTable
        BootSec := MDI;                   ! Boot1st overlaps BootSec
        BootCyl := MDI;       Cksum := MDI + CkSum;
        MemAdr - 1;                                
        if C19 goto(SkpScr);              ! if    	
--------------
!
! Abstract:
!       SRS is a one byte instruction that builds a subrange set--a set
!       that consists o
        dst := TP, Store, if Neq Goto(SRS1); ! store the right mask
        AllOnes, Goto(SRS2);                 ! zero mask f a contiguous span of members.  If the high bound
!       is greater than 4095, the low bound is less than 0, or the low
!   means all ones

SRS1:   tmp2;                                ! Upper word
SRS2:   tmp := tmp or 17, if IntrPend Call(VectSrv)    bound is greater than the high bound, a null set is built.
!
! Instruction:
!       SRS
!
! Environment:
!       (Tos);
        tmp - tmp1, RightShift(4);
        tmp := Shift;                        ! number of middle words + 1

!       Stor = High bound.
!       (Tos-1) = Low bound.
!
! Result:
!       Stack popped.
!       (Tos) = Length of set = High div 16 +e the contiguous 177777's.

SRS3:   tmp4 := tmp1, if Leq Goto(SRS6);
        dst := dst + 1, Store;
        AllOnes, if Intr 1.
!       N words pushed onto memory stack.
!       Memory[TP-0] = 0.
!       Memory[TP-1] = 0.
!          ...
!       MePend Goto(SRS5);
SRS4:   tmp := tmp - 1, Goto(SRS3);

SRS5:   Call(VectSrv);
        Goto(SRS4);
        
SRS6:   tmp1, Fimory[TP-(Low div 16)+1] = 0.
!       Memory[TP-(Low div 16)] = LeftMask(16 - (Low mod 16)).
!       Memory[TP-(Low div 16)-1] eld(0,4);
        tmp := Shift - 1, Call(MakeMask);    ! RightMask(Low mod 16)
        dst, Fetch;                          ! = 177777.
!       Memory[TP-(Low div 16)-2] = 177777.
!          ...
!       Memory[TP-(High div 16)+1] = 177777.
!       Met3  fetch a 177777 or RightMask
        tmp1, RightShift(4);                 ! t0
        tmp1 := Shift;                      mory[TP-(High div 16)] = RightMask((High mod 16) + 1).
!
! Calls:
!       MakeMask, SetZero, ChkStk, VectSrv.
!
!---------- ! t1  number of zero words
        dst, Store;                          ! t2
        Mdi and not tmp2;                    ! t-------------------------------------------------------------------

Opcode(SRS), tmp := Tos, Pop;                ! high bound3  LeftMask(16-(Low div 16))
        TP := TP + tmp10, if IntrPend Call(VectSrv); 
        dst := TP, Call(SetZero);          
        tmp1 := Tos;                         ! low bound   !***** BR
        tmp1 - tmp, if Lss Goto(SRS7);       ! if low bo  ! make the zero words
        Tos := tmp10 + 1, NextInst(0);       ! push length on stack

!       Make a null set.

SRS7und < 0  !***** BR
        if Gtr Goto(SRS7);                   ! if low bound > high bound
        tmp - 10000;
        if G:   Tos := 0, NextInst(0);

!       There's no room on the stack.

SRS8:   Tos := tmp1, Push;              ! restore ESTK
 eq Goto(SRS7);                   ! if high bound > 4095
        loadS(SRS8);
        tmp, RightShift(4);
        tmp10 := Shi       tmp11 := 1, Goto(StkOv);

! Opcode INN.
!----------------------------------------------------------------------------h the zeros
        TP := dst, NextInst(0);

! Opcode SRS.
!---------------------------------------------------------------ft, Call(ChkStk);        ! length-1 = (High div 16)
        TP := TP + 1, Call(MakeMask);        ! RightMask((High mod 16) + 1)  	
 do checksum
        NextDA := 0, Call(HardSeek);      ! seek to cylinder 0

! Got interpreter, checksum it and put it into wReturn, loc(7441);           ! Data goes on R
        
!
! Here when we have to give up
        
Busted: tmp := tmp - 10#15cs
        
! *** NB:  The rest of sysb (and all that it calls) must be above 7377
DoCSum: MemAdr := LastAdr, goto(CkMic);   1, Call(SetDDS), loc(7450);
Sleep:  GoTo(Sleep), loc(7451);                   ! Loop forever

!
! Set Diagnostic Display

  ! necessary to cross page boundary
CkMic:  MemAdr := MemAdr + UCodeSize, loc(7400);
        CkSum := 0, LoadS(7377), loc(740
SetDDS: Dly := 10, StackReset, loc(7460);        ! Increment display
DDSWt:  if eql goto(DDSWt1), loc(7461);          ! wait 1);
wd0:    Cksum := Cksum + Data, Call(NextData), loc(7402);
        WCShi, if true GotoS(wd1), loc(7403);
wd1:    Cksum := 8 cycles
        Dly := Dly - 1, goto(DDSWt), loc(7462);
DDSWt1: tmp := tmp - 1, loc(7463);
        if neq goto(SetDDS), loc(Cksum + Data, Call(NextData), loc(7404);
        WCSmid, if true GotoS(wd2), loc(7405);
wd2:    Cksum := Cksum + Data, Call(Ne7464);
        return, loc(7465);
        
!
! Turn Z80 Off


Z80Off: 200, IOB(301), loc(7500);         ! shut off disk axtData), loc(7406);
        WCSlow, if true GotoS(wd3), loc(7407);
wd3:    Repeat(wd0), loc(7410);
        Cksum := Cksum + Dnd Z80
        0, IOB(307), loc(7501);           ! shut off Z80 output interrupts
        IOB(106), loc(7502);              ! ata, loc(7411);
        tmp := 10#160, if neq goto(Busted), loc(7412); ! CkSum Err in Microcode!        
CkDone: MemAdr := SITdismiss Z80 input interrupt
        IOB(147), return, loc(7503);      ! dismiss memory parity interrupt

!
! Read one Spice Info, loc(7413);
        MemAdr, Store2, loc(7414);        ! Store harddisk=0 and keystroke
        IsFloppy, loc(7415);
    Segment Block from hard disk into memory

DoOneBlock: IsFloppy;
        if neq goto(FDoOneBlock);
        Call(HardSeek);       BootKey, loc(7416);
        tmp := sysbDDSdif, Call(SetDDS), loc(7417);  ! Good load (we hope)
        Call(Z80Off), loc(7                ! seek to right cylinder
        NextDA, IOB(CylSec);            ! Physical header data
        NextDA, Field(! Clear the rest of the microcode image.

Clear:  tmp := MemAdr;
        tmp := tmp - LastAdr;
        tmp - UCodeSize;
   420);          ! shut off disk and Z80
        ThreeWayBranch(0), loc(7421);     ! Make sure 2910 stack is empty
        Three     if C19 Goto(Cl1);                 ! if (MemAdr - LastAdr) < UCodeSize
        Goto(Seek0);                      ! if (MemAWayBranch(0), loc(7422);
        ThreeWayBranch(0), loc(7423);
        ThreeWayBranch(0), loc(7424);
        ThreeWayBranch(0dr - LastAdr) >= UCodeSize

Cl1:    MemAdr, Store;
        0;
        MemAdr := MemAdr + 1, Goto(Clear);
        
! Seek t), loc(7425);
        goto(2400), loc(7426);            ! Enter QCode ucode
        
!
!Get a word out of memory to load into cylinder 0 (if booted from hard disk).

Seek0:  IsFloppy;
        Cksum := 0, if Neq Goto(DoCSum);  ! if booted from floppyo microstore

        
NextData: MemAdr := MemAdr - 1, Fetch, loc(7440); ! Decr addr and get that word
        Data := MDI,     	

! Opcode UNI.
!-----------------------------------------------------------------------------
!
! Abstract:
!       UNI is     (Tos) = L = The greater of L0 and L1.
!       Top L words of the memory stack = Set0 * Set1.
!
! Calls:
!       SetAdj, a one byte instruction that computes the union of two sets.
!
! Instruction:
!       UNI
!
! Environment:
!       (Tos) = SetOp.
!
!-----------------------------------------------------------------------------

Opcode(QINT), Call(SetAdj);        -
!
! Abstract:
!       INN is a one byte instruction that determines set membership.
!
! Instruction:
!       INN
!
! EL0 = Length of Set0.
!       (Tos-1) = L1 = Length of Set1.
!       Top L0 words on the memory stack = Set0.
!       Next L1 nvironment:
!       (Tos) = L = Length of set.
!       (Tos-1) = Element.
!       Top L words on the memory stack = the Set.words on the memory stack = Set1.
!
! Result:
!       Stack popped.
!       The lesser of L0 and L1 words popped from the me
!
! Result:
!       Stack popped.
!       L words popped from memory stack.
!       (Tos) = Element in Set.
!
! Calls:
!mory stack.
!       (Tos) = L = The greater of L0 and L1.
!       Top L words of memory stack = Set0 + Set1.
!
! Calls:
!         MakeBit.
!
!-----------------------------------------------------------------------------

Opcode(INN), tmp2 := Tos,      SetAdj, SetOp.
!
!-----------------------------------------------------------------------------

Opcode(UNI), Call(SetAPop;               ! get length of the set
        Call(MakeBit);                       ! make a bit
        Nop;             dj);                   ! make L1 >= L0
        if Neq Goto(UNI1);                   ! if Set0 <> []
        NextInst(0);                          ! allow placer to do page escape
        tmp, RightShift(4);                  ! potential element
                           ! result is Set1

UNI1:   LoadS(UNI2);
        Call(SetOp);                         ! compute the union
 tmp := Shift, Push,                  ! word offset
                            if Lss Goto(INN2);  ! if potential member < 0
        NextInst(0);

UNI2:   Mdi or tmp, Goto(SetOp);             ! union of two words

! Opcode QINT.
!------------------       tmp - tmp2;
        if Geq Goto(INN2),                   ! if word offset >= length
                            MA := T-----------------------------------------------------------
!
! Abstract:
!       QINT is a one byte instruction that computeP - tmp, Fetch;  ! get word from stack
        Mdi and tmp5;                        ! test the bit
        Tos := 1,          s the intersection
!        of two sets.
!
! Instruction:
!       QINT
!
! Environment:
!       (Tos) = L0 = Length of Se                  ! assume true
                  if Eql Goto(INN2);         ! if bits don't match
INN1:   TP := TP - tmp2, Net0.
!       (Tos-1) = L1 = Length of Set1.
!       Top L0 words on the memory stack = Set0.
!       Next L1 words on the memoxtInst(0);        ! cut back stack to get rid of set

INN2:   Tos := 0, Goto(INN1);                ! not in set, push false
ry stack = Set1.
!
! Result:
!       Stack popped.
!       The lesser of L0 and L1 words popped from the memory stack.
!      	
             ! Label is at 376000
        not 1, IOB(CWAdrH);
        MemAdr xnor C1777, IOB(DatAdrL);  ! Memory address regis MemAdr := SaveMA, return;

MemHi: not 1, IOB(DatAdrH);               ! Stash data in high memory
        goto(DoRead);


ter
        r0 := UState(MemAdr);
        r0 and 10000;                     ! Check bit 16 of MemAdr
        if eql goto(MemH
!
! Seek to NextDA (if necessary).

HardSeek: NextDA, Field(10,10);           ! pick off upper byte
        NewCyl := Shifi);               ! if bit 16 is set
        not 0, IOB(DatAdrH);              ! Stash data in low memory
        
DoRead: 2,t;                  ! Thats the cylinder
        SeekCnt := NewCyl;                ! Compute distance to it
        SeekCnt := IOB(dseek);                    ! Read it baby
WaitBusy: IOB(dstat);                     ! pick up disk controller status
     SeekCnt - Cyl;         ! as Desired - Current position
        if eql Return,                    ! if already there
             r0 := IOD and 7;                  ! get state machine state
        r0 xor 7;                         ! code 7 is busy
                 SeekCnt;           ! check direction
        Dir := DirIn, if gtr goto(DoSeek); ! if positive, Direction is in
      if neq goto(WaitBusy);            ! wait until disk is busy
        Dly := 177777;                    ! Don't wait forever       Dir := DirOut;                    ! if negative, direction is out
        SeekCnt := Cyl;                   ! recompute 
        
WtDone: nop;
        nop;
        nop;
        IOB(dstat);                       ! Check doneness
        r0 := a positive difference
        SeekCnt := SeekCnt - NewCyl;
        
DoSeek: Dir, IOB(dseek);                  ! Tell disk to IOD and 7;                  ! Code 7 is busy
        Dly := Dly - 1, if eql goto(IsDone); ! Code 0 is done, Keep trying
      seek the right way
        tmp := 153, Call(SndZ80Byte);     ! Tell Z80 to do it
        tmp := 010, Call(SndZ80Byte);     ! S  if neq goto(WtDone);              ! Until you find it
        47, IOB(dseek);                   ! If you dont, Reset the diskeek Command
        tmp := SeekCnt, Call(SndZ80Byte); ! How many tracks
        Cyl := NewCyl;                    ! Now we are
        Call(WaitAWhile);                 ! Let that work
        TryCnt := TryCnt - 1;
        tmp := 10#157, if leq goto(B at a new track
        
WaitSeek: tmp := 10#157, Call(RecZ80Byte);  ! Wait for done
        Bite - 153, if neq goto(Busted);usted);    ! I give up
        GoTo(DoOneBlock);                 ! Try it again
        
IsDone: 0, IOB(dseek);              
        if neq goto(WaitSeek);
        Call(RecZ80Byte);
        Bite - 12, if neq goto(Busted);
        if neq goto(WaitSe      ! Clear disk and done
        SaveMA := MemAdr;
        MemAdr := 177002;                 ! NextAdr is at 376004
      ek);
        Return;                           ! all done

       
! 
! Receive a character from the Z80

RecZ80Byte: Big5,3);               ! Pick off head bits
        Shift, IOB(dhead);                ! head number
        0, IOB(CWAdrL);        MemAdr := MemAdr + MemAdr, Fetch; ! Pick it up
        NextDA := MDI;                    ! Chain to next DiskAddress
        !  	
ack.
!       (Tos) = L = The greater of L0 and L1.
!       Top L words of the memory stack = Set0 - Set1.
!
! Calls:
!     ;
EQUPZ:  Call(SETZCHK);
EQUPX:  TP := tmp6, NextInst(0);
EQUPop: Mdi - tmp;  !Compare Equal
        IF eql Goto(SETCOMP);
  SetAdj, SetOp.
!
!-----------------------------------------------------------------------------

Opcode(DIF), Call(SetAdj)        Tos:= 0, Return;

Opcode(NEQPowr), Call(SetAdj);
        Call(SetSizes);
        tmp3;
        IF Eql Goto(EQUPZ), ;                   ! make L1 >= L0
        if Eql Goto(DIF1);
        LoadS(DIF2);
        Nop;                             Tos := 0;
        LoadS(NEQPop);
        Call(SETCOMP);
        if Odd Goto (EQUPX);
        Goto(EQUPZ);
NEQPop: Mdi - tmp    ! allow placer to do a page escape
        Call(SetOp);                         ! compute the difference
DIF1:   NextInst(;  !Compare Equal
        IF eql Goto(SETCOMP);
        Tos := 1, Return;

Opcode(LEQPowr), Call(SetAdj);
        Call(SetS0);

DIF2:   Mdi and not tmp, Goto(SetOp);        ! difference of two words




$Title xxxPowr - Set comparisons.

! Oizes);
        tmp3;
        if Eql Goto(EQUPZ), Tos := 1;
        LoadS(LEQPop);
        Goto(EQUPCMP);
LEQPop: Mdi and no          ! make L1 >= L0
        tmp5 := tmp3, if Eql Goto(INT1);     ! if Set0 = []
        LoadS(INT2);
        Nop;      pcode EQUPowr, NEQPowr, LEQPowr, GEQPowr.
!-----------------------------------------------------------------------------
!
!                            ! allow placer to do page escape
        Call(SetOp);                         ! compute the union
IAbstract:
!       The xxxPowr opcodes are one byte instructions that compare two set
!       operands.
!
! Instruction:
!  NT1:   tmp1 := Tos - tmp5;                  ! diff. of set sizes
        dst := tmp4, Call(SetZero);          ! fill with zero      xxxPowr
!
! Environment:
!       (Tos) = L0 = Length of Set0.
!       (Tos-1) = L1 = Length of Set1.
!       Top L0 wowords
        NextInst(0);

INT2:   Mdi and tmp, Goto(SetOp);            ! intersection of two words

! Opcode DIF.
!----rds on the memory stack = Set0.
!       Next L1 words on the memory stack = Set1.
!
! Result:
!       Stack popped.
!      -------------------------------------------------------------------------
!
! Abstract:
!       DIF is a one byte instruction L0 + L1 words popped from memory stack.
!       (Tos) = Set0 xxx Set1.
!
! Calls:
!       SetFalse, SetTrue.
!
!--------- that computes the difference
!        of two sets.
!
! Instruction:
!       DIF
!
! Environment:
!       (Tos) = L0 = Le--------------------------------------------------------------------

Opcode(EQUPowr), Call(SetAdj);
        Call(SetSizes);ngth of Set0.
!       (Tos-1) = L1 = Length of Set1.
!       Top L0 words on the memory stack = Set0.
!       Next L1 words o
        tmp3;
        IF Eql Goto(EQUPZ), Tos := 1;
        LoadS(EQUPop);
        Nop;                           ! placer !n the memory stack = Set1.
!
! Result:
!       Stack popped.
!       The lesser of L0 and L1 words popped from the memory st!!!!!!!!!!!!!!!!!!!!
EQUPCMP:Call(SETCOMP);
        if Odd Goto(EQUPZ);       ! already false
        TP := tmp6, NextInst(0) ! 	
       tmp := 0, Call(SndZ80Byte);       ! Single density
        tmp := 2, Call(SndZ80Byte);       ! 2 heads
        IsFloppyrent cylinder
        
        MemAdr := 177000;                 ! Put headers sector at 376000
        MemAdr := MemAdr + Me := 001, IOB(307);        ! Z80 interrupts enabled
        Call(Flush);                      ! Ignore status returned
        mAdr;
        Sec := 1;
        TryCnt := 10, Call(FDoOneSec);
        
! Read four sectors of block
        
        Sec Dly := 77777;              ! 32k*(64*2)=4.2M cycles 
waitbyte: if intrpend Vector(Z80Int);     ! * .00017 ms/cycle = .7 sec
  GoTo(ReadDib);
        

!
! Read one Spice Segment Block from floppy into memory

        
FDoOneBlock: Cyl := NextCyl;       Dly := 100, call(WaitLp);
        BigDly := BigDly - 1;
        if neq goto(waitbyte);
        1, return;                           ! Cyl = NextCyl mod 77
        Cyl := Cyl - 10#77;
        Head := 4, if geq goto(FGotHead); ! Head = NextCyl div          ! return neq if time out
        
Z80Int: iob(106), loc(7100);              ! Here when Z80 sends a byte
        Bi 77
        Cyl := NextCyl;
        Head := 0;
        
FGotHead: Head - LastHead;
        Cyl - LastCyl, if neq goto(FDoSete := iod and 377;              ! pick up byte
        0, return;                        ! return eql
         
! 
! All othek);
        if eql goto(FGotCyl);
        
FDoSeek: tmp := 153, Call(SndZ80Byte);
        tmp := 002, Call(SndZ80Byte);    er interrupts are verboten

BadInt1: tmp := 10#162, goto(Busted), loc(7104);
BadInt2: tmp := 10#163, goto(Busted), loc(7110); ! Floppy command
        tmp := Head, Call(SndZ80Byte);    ! Head and unit
        tmp := Cyl, Call(SndZ80Byte);     ! Cylind
BadInt3: tmp := 10#164, goto(Busted), loc(7114);
BadInt4: tmp := 10#165, goto(Busted), loc(7120);
BadInt5: tmp := 10#166, goer
        tmp := 1, Call(SndZ80Byte);       ! Sector
        tmp := 4, Call(SndZ80Byte);       ! Seek command
        tmp :=to(Busted), loc(7124);
BadInt6: tmp := 10#167, goto(Busted), loc(7130);
BadInt7: tmp := 10#168, goto(Busted), loc(7134);

! 1, Call(SndZ80Byte);       ! Fake byte count
        000, IOB(307);                    ! Fake data
        
FWtDone: Call(Re
! Send a character to the Z80

SndZ80Byte: tmp, IOB(307);
        goto(WaitAWhile);

FlopBoot: bite := 0, Call(KeysOnOff);cZ80Byte);                ! Wait for done
        Bite - 153, if neq goto(FlopErr);
        if neq goto(FWtDone);
        Cal     ! Turn keyboard off
        Data := 0;
        LastCyl := 0;
        LastHead := 0;
        
! Set single density, 2 sl(RecZ80Byte);
        Bite - 21, if neq goto(FlopErr);
        if neq goto(FWtDone);
        Call(RecZ80Byte);
        Biteides, Z80 interrupts enabled
        
        Call(Flush);                      ! Make sure Z80 in right state
        tmp := and 1, if neq goto(FlopErr);
        if neq goto(FlopErr);             ! Status = error
        LastCyl := Cyl;
        Last 153, Call(SndZ80Byte);
        tmp := 014, Call(SndZ80Byte);
        tmp := 003, Call(SndZ80Byte);     ! Set floppy status
 Head := Head;
        
FGotCyl: SaveMA := MemAdr;                ! Save address
        
! Read Headers from sector 1 of cur "  	
o string
!       values for equality and/or order.  The strings must be word aligned.
!
! Instruction:
!       xxxStr
!
!      Otherwise the operand byte is zero and the length is on the
!       expression stack.
!
! Instruction:
!       xxxByt  Environment:
!       (Tos) = Byte offset for String0.
!       (Tos-1) = Word address of String0.
!       (Tos-2) = Byte offseLength
!
! Environment:
!       If Length <> 0:
!            (Tos) = Byte offset for ByteArray0.
!            (Tos-1) = Wort for String1.
!       (Tos-3) = Word address of String1.
!
! Result:
!       stack popped three times.
!       (Tos) = Strd address of ByteArray0.
!            (Tos-2) = Byte offset for ByteArray1.
!            (Tos-3) = Word address of ByteArray1.ing0 xxx String1.
!
! Calls:
!       StrCmp, SetTrue.
!
!------------------------------------------------------------------
!       If Length = 0:
!            (Tos) = Length of byte arrays.
!            (Tos-1) = Byte offset for ByteArray0.
!    -----------

Opcode(EQUStr), Call(StrCmp);
        Tos := 0, if Eql Goto(SetTrue);      ! assume false
        NextInst(0);        (Tos-2) = Word address of ByteArray0.
!            (Tos-3) = Byte offset for ByteArray1.
!            (Tos-4) = Word a

Opcode(NEQStr), Call(StrCmp);
        Tos := 0, if Neq Goto(SetTrue);      ! assume false
        NextInst(0);

Opcode(LEddress of ByteArray1.
!
! Result:
!       If Length <> 0:
!            Stack popped three times.
!       If Length = 0:
! QStr), Call(StrCmp);
        Tos := 0, if Leq Goto(SetTrue);      ! assume false
        NextInst(0);

Opcode(LESStr), Call(           Stack popped four times.
!       (Tos) = ByteArray0 xxx ByteArray1.
!
! Calls:
!       BytCmB, SetTrue.
!
!----StrCmp);
        Tos := 0, if Lss Goto(SetTrue);      ! assume false
        NextInst(0);

Opcode(GEQStr), Call(StrCmp);
  -------------------------------------------------------------------------

Opcode(EQUByt), Call(BytCmp);
        Tos := 0, Put tmp;
        IF eql Goto(SETCOMP);
        Tos := 0, Return;

Opcode(GEQPowr), Call(SetAdj);
        Call(SetSizes);
         Tos := 0, if Geq Goto(SetTrue);      ! assume false
        NextInst(0);

Opcode(GTRStr), Call(StrCmp);
        Tos :=     tmp3;
        if eql Goto(GEQPEND), Tos := 1;
        LoadS(GEQPop);
        Call(SETCOMP);
GEQPEND:TP := tmp6, NextIns 0, if Gtr Goto(SetTrue);      ! assume false
        NextInst(0);




$Title xxxByt - Byte array comparisons.

! Opcodt(0);
GEQPop: tmp1 := Mdi;
        tmp and not tmp1;
        IF eql Goto(SETCOMP);
        Tos := 0, Return;




$Titlee EQUByt, NEQByt, LEQByt, LBytBytByt, GEQByt, GTRByt.
!------------------------------------------------------------------------ xxxStr - String comparisons.

! Opcode EQUStr, NEQStr, LEQStr, LESStr, GEQStr, GTRStr.
!----------------------------------------
!
! Abstract:
!       The xxxByt opcodes are two byte instructions that compare two byte
!       arrays for equality a------------------------------------------
!
! Abstract:
!       The xxxStr opcodes are one byte instructions that compare twnd/or order.  The length of the byte arrays is
!       specified as an operand byte if it is a constant and less than 256.
!   " 	
;                 ! 3rd blk hdr at 376034;
        goto(FGotHdr);
Blk4:   MemAdr := 177022;                 ! 4th blk hdr at 3

FlopErr: tmp := 10#158, goto(Busted);
        
Flush:  Call(RecZ80Byte);                 ! Ignore Z80 data
        if eql 76044;
        goto(FGotHdr);

FDoNextSec: Sec := Sec + 5;
        Sec - 10#26;
        if leq goto(FDoit);
        Sec :=goto(Flush);
        return;
END;
                                                                                            Sec - 10#24;
FDoit:   TryCnt := 10, goto(FDoOneSec);


!
! Read one sector from floppy

FDoOneSec: tmp := 153, Call(SndZ 80Byte);
        tmp := 002, Call(SndZ80Byte);     ! Floppy command
        tmp := Head, Call(SndZ80Byte);    ! Head and unit! Perq Boot Prom Microcode   Version 4
!   Written by Brian Rosen
!   Copyright (C) 1981 Three Rivers Computer Corporation, Pi
        tmp := Cyl, Call(SndZ80Byte);     ! Cylinder
        tmp := Sec, Call(SndZ80Byte);     ! Sector
        tmp := 1, Calttsburgh PA.
!
!
!   This code resides in the 512 microinstruction Boot Prom
!   It occupies the low 512 words of the 4k add:= NextSec;
        MemAdr := SaveMA;
        TryCnt := 10, Call(FDoOneSec);
        MemAdr := MemAdr + 100, Call(FDoNextSec)l(SndZ80Byte);       ! Read floppy command
        tmp := 1, Call(SndZ80Byte);       ! Fake byte count
        000, IOB(307); ;
        MemAdr := MemAdr + 100, Call(FDoNextSec);
        MemAdr := MemAdr + 100, Call(FDoNextSec);
        
! Set next cy                   ! Fake data
        
FWtRead: Call(RecZ80Byte);                ! Wait for result
        Bite - 153, if nelinder and sector
        
        NextSec - 3;
        NextSec - 10#23, if eql goto(Blk0);
        NextSec - 10#19, if eql q goto(FlopErr);
        if neq goto(FWtRead);
        Call(RecZ80Byte);
        Bite - 5, if neq goto(FlopErr);
        if goto(Blk1);
        NextSec - 10#15, if eql goto(Blk2);
        NextSec - 10#11, if eql goto(Blk3);
        if eql goto(Blk4)neq goto(FWtRead);
        Call(RecZ80Byte);                 ! Get status
        Bite and 1, if neq goto(FlopErr);
        i;
        MemAdr := 177026;                 ! 5th blk hdr at 376054
        
FGotHdr: MemAdr := MemAdr + MemAdr, Fetch2;
   f neq goto(FlopErr);
        Call(RecZ80Byte);                 ! Get byte count
        if neq goto(FlopErr);
        Offset      NextSec := MDI;
        NextCyl := MDI;
        MemAdr := SaveMA, return;

Blk0:   MemAdr := 177002;                 ! := 0, LoadS(77);           ! Assume 64 words (full sector)
        
FRdLoop: Call(RecZ80Byte);
        Word := Bite, if neq g0th blk hdr at 376004;
        goto(FGotHdr);
Blk1:   MemAdr := 177006;                 ! 1st blk hdr at 376014;
        gotooto(FlopErr);
        Call(RecZ80Byte);
        if neq goto(FlopErr);
        Bite, LeftShift(10);
        Word := Shift or (FGotHdr);
Blk2:   MemAdr := 177012;                 ! 2nd blk hdr at 376024;
        goto(FGotHdr);
Blk3:   MemAdr := 177016Word;
        MemAdr + OffSet, Store;
        Word;
        Offset := Offset + 1, repeat(FRdLoop);
        return;       
 #  	
rue);  ! assume false
        NextInst(0);

Opcode(LESByt), Call(BytCmp);
        Tos := 0, Push, if Lss Goto(SetTrue);  ! aor 1, NextInst(0);       ! flip results
                                                                                       ssume false
        NextInst(0);

Opcode(GEQByt), Call(BytCmp);
        Tos := 0, Push, if Geq Goto(SetTrue);  ! assume fals$Title Jxxx, XJP - Jumps.

! Opcode JMPB.
!-----------------------------------------------------------------------------
!e
        NextInst(0);

Opcode(GTRByt), Call(BytCmp);
        Tos := 0, Push, if Gtr Goto(SetTrue);  ! assume false
       
! Abstract:
!       JMPB is a two byte unconditional jump instruction.
!
! Instruction:
!       JMPB    Offset
!
! Enviro NextInst(0);




$Title xxxWord - Multiple word comparisons.

! Opcode EQUWord, NEQWord.
!----------------------------nment:
!       old PC = Byte address + 1 of the Offset operand.  PC = UPC * 2 + BPC.
!
! Result:
!       new PC = old PC + O-------------------------------------------------
!
! Abstract:
!       The xxxWord opcodes are two byte instructions that coffset.
!
! Calls:
!       AdjustPC.
!
!-----------------------------------------------------------------------------

! Ompare two word
!       arrays for equality or inequality.  The length of the word arrays is
!       specified as an operand bypcode JFB, JTB.
!-----------------------------------------------------------------------------
!
! Abstract:
!       JFB andte if it is a constant and less than 256.
!       Otherwise the operand byte is zero and the length is on the
!       expressi JTB are two byte conditional jump instructions which jump
!       if the value on the top of the expression stack is false or on stack.
!
! Instruction:
!       xxxWord  Length
!
! Environment:
!       if Length <> 0:
!            (Tos) = Word addtrue
!       respectively.
!
! Instruction:
!       JxB     Offset
!
! Environment:
!       old PC = Byte address + 1 of ress of WordArray0.
!            (Tos-1) = Word address of WordArray1.
!       if Length = 0:
!            (Tos) = Length of the Offset operand.  PC = UPC * 2 + BPC.
!       (Tos) = Boolean value.
!
! Result:
!       Stack popped.
!       If conditword arrays.
!            (Tos-1) = Word address of WordArray0.
!            (Tos-2) = Word address of WordArray1.
!
! Resulion met then new PC = old PC + Offset.
!       If condition not met then new PC = old PC.
!
! Calls:
!       AdjustPC.
!
!t:
!       if Length <> 0:
!            Stack popped once.
!       if Length = 0:
!            Stack popped twice.
!       -----------------------------------------------------------------------------

! Opcode JEQB, JNEB.
!------------------------sh, if Eql Goto(SetTrue);  ! assume false
        NextInst(0);

Opcode(NEQByt), Call(BytCmp);
        Tos := 0, Push, if Neq(Tos) = WordArray0 xxx WordArray1.
!
! Calls:
!       CmpMW.
!
!----------------------------------------------------------- Goto(SetTrue);  ! assume false
        NextInst(0);

Opcode(LEQByt), Call(BytCmp);
        Tos := 0, Push, if Leq Goto(SetT------------------

Opcode(EQUWord), Call(CmpMW);
        NextInst(0);

Opcode(NEQWord), Call(CmpMW);
        Tos := Tos x # 	
attempts to verify correct operation of the processor
!   at least enough to run the boot loader.

        Define(R0,0);  !De 177777;                     ! Make non zero alu again
        0, if Eql Goto(Bad2);       ! but this time try an Equal jump
 fine registers with varing bit patterns for addresses
        Define(R1,1);
        Define(R2,2);
        Define(R4,4);
           0, if Eql Goto(good2);      ! Try equal jump with a real 0
bad3:   0, Goto(bad3);              ! Jumps don't work

sub    Define(R10,10);
        Define(R20,20);
        Define(R40,40);
        Define(R100,100);
        Define(R200,200);
   1:   Return;                     ! Used below as simple subroutine
sub2:   Call(sub1);                 ! a two level subroutine     Define(R252,252);
        Define(R277,277);
        Define(R307,307);
        Define(R337,337);
        Define(R350,350 call
        Return;                     ! return from 2nd level subr call

good2:  1, if Neq Goto(bad3);       ! had a 0, s);
        Define(R357,357);
        Define(R367,367);
        Define(R373,373);
        Define(R375,375);
        Define(Rhouldn't jump on Neq
        10, if Eql Goto(bad3);      ! make sure every alu chip can detect
        if Eql Goto(bad3);     376,376);
        Define(R377,377);


        Place(0,777);               !Boot code occupies lower 512 locations

            ! a non zero bit
        400;                        !   alu chips are on 4 bit boundaries
        if Eql Goto(bad3);
   StackReset,Next,loc(0);     ! Display 1 - We can execute something
        SrcRasterOp := 200, Next, loc(1); ! Turn Power Down      40000;
        0, if Eql Goto(bad3);
        Call(sub1);                 ! now try a simple subroutine call
        Cal bit off
        Next, loc(2);              ! Do some Nexts to make sure 2910 looks alive
        Next, loc(3);
        Goto(l(sub2);                 ! try a two level call
        R0 := 0, StackReset;        ! Display 2 - simple branch/calls work

 ressable Writable
!   Microstore.  The prom is enabled by the boot button, and
!   when enabled, overlaps the bottom 2k of RAML10), loc(4);          ! Try a simple GoTo
bad1:   Goto(bad1);                 ! Unconditional jump didn't jumpr
L10:    Goto(.  Addresses from
!   512 to 2047 are essentially unused when the prom is on (they are
!   actually the Boot prom repeated eveL20), loc(10);         ! GoTo increasing bit positions
L20:    Goto(L30), loc(20);         !   verifies Z and J mux
L30:    Gory 512 locations.  It is possible
!   to address the upper 2k of ram from the prom.
!   The prom is disabled by executing a Loto(L40), loc(30);
L40:    Goto(L100), loc(40);
L100:   GoTo(L200), loc(100);
L200:   Goto(L400), loc(200);
L400:   Goto(L11)adOp special function. When
!   disabled, the prom is not addressable, and the Ram occupies the
!   entire 4k address space.  , loc(400);        ! Go back to low addresses
L11:    177777;                     ! force non zero alu stuff
        if Neq GoIt is not possible for the prom to become enabled
!   by anything other than pressing the boot button.
!
!   This code first to(Good1);         ! Does the simplest condition branch work?
Bad2:   0, Goto(Bad2);              ! Jumps don't work

Good1:  $  	
ByteOffset
!
! Environment:
!       old PC = Byte address + 1 of the HighByteOffset operand.
!                PC = UPC * 2 +ce.
!       If condition met then new PC = old PC + Offset.
!       If condition not met then new PC = old PC.
!
! Calls:
!-----------------------------------------------------
!
! Abstract:
!       JEQB, JNEB are two byte conditional jump instruct BPC.
!
! Result:
!       new PC = old PC + Offset.
!
! Calls:
!       AdjustPC.
!
!------------------------------------ions which jump
!       if the two values on the top of the expression stack are equal or
!       not equal respectively.
!
-----------------------------------------

! Opcode JFW, JTW.
!--------------------------------------------------------------! Instruction:
!       JxB     Offset
!
! Environment:
!       old PC = byte address + 1 of the Offset operand.  PC = UPC * ---------------
!
! Abstract:
!       JFW and JTW are three byte conditional jump instructions which jump
!       if the val2 + BPC.
!       (Tos) = Value0.
!       (Tos-1) = Value1.
!
! Result:
!       Stack popped twice.
!       If condition meue on the top of the expression stack is false or true
!       respectively.
!
! Instruction:
!       JxW     LowByteOffset t then new PC = old PC + Offset.
!       If condition not met then new PC = old PC.
!
! Calls:
!       AdjustPC.
!
!------HighByteOffset
!
! Environment:
!       old PC = Byte address + 1 of the HighByteOffset operand.
!                PC = UPC *-----------------------------------------------------------------------

JMPB1:
Opcode(JMPB), JmpOffset := NextOp;            2 + BPC.
!       (Tos) = Boolean value.
!
! Result:
!       Stack popped.
!       If condition met then new PC = old PC + ! byte offset
        if ByteSign Goto(JMPB2);             ! if backward jump
        Goto(AdjustPC);

JMPB2:  JmpOffset := Offset.
!       If condition not met then new PC = old PC.
!
! Calls:
!       AdjustPC, PuntByte.
!
!---------------------JmpOffset or not 377, Goto(AdjustPC);  ! sign extend

Opcode(JFB), Tos and 1, Pop;
JFB1:   if Eql Goto(JMPB1);
PuntByte: Nex--------------------------------------------------------

! Opcode JEQW, JNEW.
!---------------------------------------------tOp;
        NextInst(0);

Opcode(JTB), Tos and 1, Pop;
JTB1:   if Neq Goto(JMPB1);
        NextOp;
        NextInst(0);
--------------------------------
!
! Abstract:
!       JEQW, JNEW are three byte conditional jump instructions which jump
! 
Opcode(JEQB), tmp := Tos, Pop;
        Tos xor tmp, Pop, Goto(JFB1);
        
Opcode(JNEB), tmp := Tos, Pop;
        Tos x      if the two values on the top of the expression stack are equal or
!       not equal respectively.
!
! Instruction:
!  or tmp, Pop, Goto(JTB1);

! Opcode JMPW.
!-----------------------------------------------------------------------------
!
     JxW     LowByteOffset HighByteOffset
!
! Environment:
!       old PC = Byte address + 1 of the HighByteOffset operand.
! Abstract:
!       JMPW is a three byte unconditional jump instruction.
!
! Instruction:
!       JMPW    LowByteOffset High!                PC = UPC * 2 + BPC.
!       (Tos) = Value0.
!       (Tos-1) = Value1.
!
! Result:
!       Stack popped twi $ 	
 xor 2;
        R4 := 4, if Neq Goto(DeepEnd);
        R4 xor 4;
        R10 := 10, if Neq Goto(DeepEnd);
        R10 xor 10       if Neq Goto(DeepEnd);
        R375 xor 2000;
        if Neq Goto(DeepEnd);
        R373 xor 4000;
        if Neq Goto;
        R20 := 20, if Neq Goto(DeepEnd);
        R20 xor 20;
        R40 := 40, if Neq Goto(DeepEnd);
        R40 xor 40;(DeepEnd);
        R367 xor 10000;
        if Neq Goto(DeepEnd);
        R357 xor 20000;
        if Neq Goto(DeepEnd);
    
        R100 := 100, if Neq Goto(DeepEnd);
        R100 xor 100;
        R200 := 200, if Neq Goto(DeepEnd);
        R200 xor    R337 xor 40000;
        if Neq Goto(DeepEnd);
        R277 xor 100000;
        if Neq Goto(DeepEnd);
        R0 := 1, St 200;
        if Neq Goto(DeepEnd);
        R377 := 400;
        R377 xor 400;
        if Neq Goto(DeepEnd);
        R376 :ackReset;        ! Display 4 - X addressing works
                                    ! read them back again on Y
        R0 x= 1000;
        R376 xor 1000;
        if Neq Goto(DeepEnd);
        R375 := 2000;
        R375 xor 2000;
        if Neq Goor R1;
        R0 := 2, if Neq Goto(DeepEnd);
        R0 xor R2;
        R0 := 4, if Neq Goto(DeepEnd);
        R0 xor R4;
to(DeepEnd);
        R373 := 4000;
        R373 xor 4000;
        if Neq Goto(DeepEnd);
        R367 := 10000;
        R367        R0 := 10, if Neq Goto(DeepEnd);
        R0 xor R10;
        R0 := 20, if Neq Goto(DeepEnd);
        R0 xor R20;
     xor 10000;
        if Neq Goto(DeepEnd);
        R357 := 20000;
        R357 xor 20000;
        if Neq Goto(DeepEnd);
        R0 := 40, if Neq Goto(DeepEnd);
        R0 xor R40;
        R0 := 100, if Neq Goto(DeepEnd);
        R0 xor R100;
          R337 := 40000;
        R337 xor 40000;
        if Neq Goto(DeepEnd);
        R277 := 100000;
        R277 xor 100000;
   R0 := 200, if Neq Goto(DeepEnd);
        R0 xor R200, Call(ChkIt);
        R0 := 400;
        R0 xor R377, Call(ChkIt);
         if Neq Goto(DeepEnd);
        R0 xor 0, StackReset;     !Display 3 - simple register read/write works
                       R0 := 1000;
        R0 xor R376, Call(ChkIt);
        R0 := 2000;
        R0 xor R375, Call(ChkIt);
        R0 := 4000                 !read then back again to check addressing
        R1 xor 1, if Neq Goto(DeepEnd);
        R2 xor 2, if Neq Go;
        R0 xor R373, Call(ChkIt);
        R0 := 10000;
        R0 xor R367, Call(ChkIt);
        R0 := 20000;
        R0 to(DeepEnd);
        R4 xor 4, if Neq Goto(DeepEnd);
        R10 xor 10, if Neq Goto(DeepEnd);
        R20 xor 20, if Neq Gotxor R357, Call(ChkIt);
        R0 := 40000;
        R0 xor R337, Call(ChkIt);
        R0 := 100000;
        R0 xor R277, Cal       R0 xor 0;                   ! try read/write of registers
        R1 := 1, if Neq Goto(DeepEnd);     ! Cant Write a 0
 o(DeepEnd);
        R40 xor 40, if Neq Goto(DeepEnd);
        R100 xor 100, if Neq Goto(DeepEnd);
        R200 xor 200, if Ne       R1 xor 1;                   ! try all bits, using different registers
        R2 := 2, if Neq Goto(DeepEnd);
        R2q Goto(DeepEnd);
        if Neq Goto(DeepEnd);
        R377 xor 400;
        if Neq Goto(DeepEnd);
        R376 xor 1000;
  %  	

!       The three words are the minimum index (Low), the maximum index
!       (High), and the self-relative address of the c        UPC + tmp2, Fetch,                   ! fetch JumpTable[Index - Low]
                           if Lss Goto(Case1);  ! iode to be executed
!       when the case selector is outside the range Low..High.  A word
!       aligned jump table immediatef Index > High

!       Case selector is in range.

        UPC := UPC + tmp2, Goto(Case3);      ! word address of JumpTablely follows the maximum index, and
!       each word in the table contains a self-relative address.
!
! Instruction:
!       [...]

!       Case index is out of range, jump to default.

Case1:  Mdi, if IntrPend Call(VectSrv);      ! allow mem to finXJP         Low
!                   High
!                   Address for out of range case
!       JumpTable:  Address for Loish
Case2:  UPC := UPC - 1, Fetch;               ! fetch address for default
        RightShift(1);
Case3:  tmp2 := Mdi;            AdjustPC, PuntByte.
!
!-----------------------------------------------------------------------------

JMPW1:
Opcode(w case
!                   Address for Low+1 case
!                       ...
!                   Address for High case
!
!JMPW), JmpOffset := NextOp;           ! why not use WordParm?
        tmp1 := NextOp;
        tmp1, LeftShift(10);
        Jm Environment:
!       (Tos) = Index = Case selector.
!
! Result:
!       Stack popped.
!       If (Index < Low) or (Index >pOffset := Shift or JmpOffset, Goto(AdjustPC);  ! jump offset

Opcode(JFW), Tos and 1, Pop;
JFW1:   if Eql Goto(JMPW1);
     High) then
!                  new PC = JumpTable byte address + 2 * (High-Low).
!       Otherwise  new PC = JumpTable byte ad    NextOp;
        Goto(PuntByte);

Opcode(JTW), Tos and 1, Pop;
JTW1:   if Neq Goto(JMPW1);
        NextOp;
        Gotodress + JumpTable[Index - Low].
!
! Calls:
!       RefillJmp, VectSrv.
!
!-------------------------------------------------(PuntByte);

Opcode(JEQW), tmp := Tos, Pop;
        Tos xor tmp, Pop, Goto(JFW1);

Opcode(JNEW), tmp := Tos, Pop;
        ----------------------------

Opcode(XJP), UState, Field(0,4);             ! read BPC
        tmp := Shift + 1, RightShift(1)Tos xor tmp, Pop, Goto(JTW1);

! Opcode XJP.
!-----------------------------------------------------------------------------;     ! round up to word boundary
        UPC := Shift + UPC, Fetch;           ! fetch Low
        UPC := UPC + 3;            
!
! Abstract:
!       XJP is a variable length instruction that implements the Pascal
!       case statement.  It is an n-wa          ! JumpTable word address
        tmp1 := Mdi, if IntrPend Call(VectSrv);  ! Low
        MA := UPC - 2, Fetch;       y branch which chooses the target
!       based on an integer value in some range Low..High.  Three words
!       follow the X         ! fetch High
        tmp2 := Tos - tmp1, RightShift(1);   ! offset within JumpTable
        tmp1 := Tos, Pop, if Lss JP in the code stream, and they must be word aligned.
!       A noise byte is added when the XJP opcode is in a low order byte.Goto(Case2);  ! if Index < Low
        tmp2 := tmp2 and AllOnes;            ! ensure tmp2 is good offset
        Mdi - tmp1;
 % 	
    R0 := 0, if Neq Goto(DeepEnd);          ! make R0 0 again
        R1 := R1 or R0;             ! 1 or 0 = 1
        R1 xor 1 + 1000100010001001
        R4 + R2, if Neq Goto(DeepEnd);          ! is 0, either way you cut it
        R0 := R0 - R2, if Nl(ChkIt);
        R0 := 1, StackReset;        ! Display 5 - Y addressing works
        R0 xor R1, Call(ChkIt);     ! an intere177777;
        R1 := R1 or R1, if Neq Goto(DeepEnd);   ! 1 or 1 = 1
        R1 xor 177777;
        R0 := R0 xnor R0, if Neq sting bug can occur in
        R0 xor R2, Call(ChkIt);     ! which Y is busted in such a way that
        R0 xor R4, Call(ChkIGoto(DeepEnd); ! 0 xnor 0 = 1
        R0 := R0 xor 177777;
        R0 xnor R1, if Neq Goto(DeepEnd);       ! 0 xnor 1 = 0
   t);     ! because the Y field is both an
        R0 xor R10, Call(ChkIt);    ! address and a constant
        R0 xor R20, Call     R1 xnor R0, if Neq Goto(DeepEnd);       ! 1 xnor 0 = 0
        R1 := R1 xnor R1, if Neq Goto(DeepEnd); ! 1 xnor 1 = 1
   (ChkIt);    ! errors can go undetected
        R0 xor R40, Call(ChkIt);    ! So we check that case here
        R0 xor R100, C     R1 xor 177777;
        R0 := not R0, if Neq Goto(DeepEnd);     ! not 0 = 1 (not a)
        R0 := R0 xor 177777;
        all(ChkIt);   ! Since CheckIt uses add
        R0 xor R200, Call(ChkIt);   ! we are also verifing ALU and carries
        R0 xnot R1, if Neq Goto(DeepEnd);           ! not 1 = 0 (not a)
        R1 := not 0;                            ! not 0 = 1 (not b)or R377, Call(ChkIt);
        R0 xor R376, Call(ChkIt);
        R0 xor R375, Call(ChkIt);
        R0 xor R373, Call(ChkIt);

        R1 xor 177777;
        R0 := not R1, if Neq Goto(DeepEnd);     ! not 1 = 0 (not b)
        if Neq Goto(DeepEnd);
          R0 xor R367, Call(ChkIt);
        R0 xor R357, Call(ChkIt);
        R0 xor R337, Call(ChkIt);
        R0 xor R277, Ca      R2 := 73567;                ! 0111 on all 4 bit boundaries
        R0 := R0 + R0;              ! add 0 to 0 (= 0)
      ll(ChkIt);
        StackReset;              ! Display 6 - Constants & Carry propogate works

        R0 := 0;                  R0 := R0 + R2, if Neq Goto(DeepEnd);    ! 0 + 73567 = 73567
        R0 := R0 xor 73567;
        R2 := R2 + R0, if Neq Goto(D    ! now check other alu functions
        R1 := 177777;
        R0 and R0;                  ! 0 and 0 = 0
        R0 and R1eepEnd);    ! 73567 + 0 = 73567
        R2 xor 73567;
        if Neq Goto(DeepEnd);
        R4 := 104210;               ! 100, if Neq Goto(DeepEnd);        ! 0 and 1 = 0
        R1 and R0, if Neq Goto(DeepEnd);        ! 1 and 0 = 0
        R1 := R1 an0 on all 4 bit boundaries
        R4 := R4 + 0;               ! 104210 + 0 = 0
        R4 xor 104210;
        R4 := R4 + R4, d R1, if Neq Goto(DeepEnd);  ! 1 and 1 = 1
        R1 xor 177777;              ! check all bits are 1
        R0 or R0, if Neqif Neq Goto(DeepEnd);    ! cause carries on all alu's
        R4 xor 10420;               ! the right answer is
        if Neq Goto(DeepEnd);         ! 0 or 0 = 0
        R0 := R0 or R1, if Neq Goto(DeepEnd);   ! 0 or 1 = 1
        R0 xor 177777;
     Goto(DeepEnd);
        R4 := 104211;               ! same number plus 1
        R2 + R4;                    ! 011101110111011 &  	

$Title CALLx, LVRD, RET, EXITT, EXGO - Calls and returns.

! Opcode CALLL.
!-----------------------------------------------LXB  ISN RoutineNumber
!
! Result:
!       New activation record built on memory stack.
!       Code state registers saved i------------------------------
!
! Abstract:
!       CALLL is a two byte routine call instruction.  It is used to call
!    n new ACB.
!       Expression stack saved in new ACB.
!       Code state registers updated.
!
! Calls:
!       CllSub, XSTM   routines in the current code segment.
!
! Instruction:
!       CALLL  RoutineNumber
!
! Result:
!       New activation ap, ChkSeg, RefillJmp, SegFault, VectSrv.
!
!-----------------------------------------------------------------------------

record built on memory stack.
!       Code state registers saved in new ACB.
!       Expression stack saved in new ACB.
!    ! Opcode CALLXW.
!-----------------------------------------------------------------------------
!
! Abstract:
!       CALLXW   Code state registers updated.
!
! Calls:
!       CllSub, RefillJmp, VectSrv.
!
!---------------------------------------- is a four byte routine call instruction.  It is used to call
!       routines in an external code segment.  The external segme-------------------------------------

Opcode(CALLL), tmp := NextOp;                ! new RN
        tmp7 := GP;             nt is
!       identified by an ISN (internal segment number) which is an index
!       into the XST (external segment table).              ! new GP = old GP
        tmp5 := CS, if IntrPend Call(VectSrv);  ! new CS = old CS
        tmp11 := 2, LoadS(Stk The XST maps an ISN into
!       an XSN (external segment number) and an XGP (external global pointer).
!
! Instruction:
!                     ! byte offset
        tmp2, if Lss Goto(Case5);            ! if jumping backward
        UPC := Shift + UPOv);            ! instruction is two bytes long
        tmp6 := CB,                          ! new CB = old CB
               C, LeftShift(1);    ! add word offset to UPC 
Case4:  tmp1 := Shift and 7, if IntrPend Call(VectSrv);  ! word in quad * 2
         Call(CllSub);            ! set up ACB etc.
        Goto(RefillJmp);                     ! enter the routine

! Opcode C    tmp2 := tmp2 and 1;                  ! byte in word
        tmp1 := tmp1 + tmp2;                 ! byte in quad = word in qALLXB.
!-----------------------------------------------------------------------------
!
! Abstract:
!       CALLXB is a threuad * 2
                                             !              + byte in word
        BPC := tmp1;                       e byte routine call instruction.  It is used to call
!       routines in an external code segment.  The external segment is
!   ! set BPC
        UPC := UPC and not 3, Goto(RefillJmp);  ! UPC is a quad address

!       Byte offset is negative, sign ex      identified by an ISN (internal segment number) which is an index
!       into the XST (external segment table).  The XST tension is necessary.

Case5:  tmp := Shift or SignXtnd, LeftShift(1);
        UPC := UPC + tmp, Goto(Case4);




$Listmaps an ISN into
!       an XSN (external segment number) and an XGP (external global pointer).
!
! Instruction:
!       CAL & 	
is geq
        R0, if Geq Goto(good7);     ! 0 is leq
        Goto(DeepEnd);

good7:  R1, if Leq Goto(good8);     ! -1 is leotoS(t2lo);
t2lo:   not 7200;
        not 1, WcsMid, if True GotoS(t2mid);
t2mid:  WcsHi, if True GotoS(t2hi);
t2hi:   R1 :=q
        Goto(DeepEnd);

good8:  R10, if Leq Goto(good9);    ! large positive is not leq
        Goto(DeepEnd);

good9:   R1 - 1, Repeat(t2lp); ! count your words
t2end:  R0 := 0, Call(4000);        ! call the code just loaded
        R0 xor 3777;R0, if Leq Goto(DeepEnd);   ! 0 is no carry
!********** no worky Perqy *******   logical functions don't set carries 
                        ! should count 2k - 1 times
        if Neq Goto(DeepEnd);
        StackReset;                 ! Display 10 - CR20 := not 0, if C19 Goto(good10);      ! calculate a 20 bit -1
        Goto(DeepEnd); 

good10: R20 + 1, if C19 Goto(good11)ontrol Store works


! fall in to the boot code 


!Perq Boot Loader
!Brian Rosen with John Strait
!Copyright (C) 1980  eq Goto(DeepEnd);    ! 0 - 73567
        R0 := R0 xor R4;            ! is 104211
        R0 := R0 - R4, if Neq Goto(DeepEnd); ;           ! -1 + 1 carries
        Goto(DeepEnd);

good11: R0 - 1, if C19 Goto(DeepEnd);           ! 0 - 1 carries
          ! and 0 - 104211
        R0 := R0 xor R2;            ! is 73567
        if Neq Goto(DeepEnd);
        1, StackReset;       if C19 Goto(DeepEnd); 
        StackReset;                 ! Display 8 - Conditional Branch works

        R0 := 0, LoadS(52        ! Display 7 - Alu works
        R1, if Gtr Goto(good4);     ! check all conditional branches we need
DeepEnd: Goto(Dee52);       ! Try LoadS and Repeat with a loop
lp1:    R0 := R0 + 1, Repeat(lp1);  ! heres your loop
        R0 xor 5253;      pEnd);             ! loop forever in the deeeep blue see


ChkIt:  R0 := R0 + R0, if Neq Goto(DeepEnd);    ! This subroutine           ! should have looped n+1 times
        if Neq Goto(DeepEnd);
        R0 := 2526;                 ! try it backwardsused above
        Return;                     ! to check constants and alu plus/carry

good4:  R1 + 1, if Gtr Goto(DeepEnd);
        LoadS(2525);
lp2:    R0 := R0 - 1, Repeat(lp2);
        if Neq Goto(DeepEnd);       ! should be 0
        StackReset           ! -1 is not greater
        if Gtr Goto(DeepEnd);       ! -1 + 1 is 0 (not Gtr)
        R10 := 77777;              ;                 ! Display 9 - Looping works

        not 0, LoadS(7777);         ! Load control store 7777 with a 
         ! largest postive number
        R10 + 1;                    ! + 1 makes a negative number
        R0 - 1, if Gtr Goto(good5)WcsLow, if True GotoS(t1Lo);! return instruction
t1Lo:   not 5000;
        not 0, WcsMid, if True GotoS(t1mid); 
t1mid:  WcsH; ! 0 - 1 is a negative number
        Goto(DeepEnd);

good5:  R0, if Gtr Goto(DeepEnd);   ! 0 is a GEQ number
        R1, ii, if True GotoS(t1hi);
t1hi:   Repeat(t1rpt);              ! decrement address to 7776t
t1rpt:  R1 := 3777;                 !f Geq Goto(good6);     ! -1 is not geq
        Goto(DeepEnd);

good6:  R10, if Geq Goto(DeepEnd);  ! a large positive number  write 2k -1 locations
t2lp:   if Eql Goto(t2end);         ! of R0 := R0 + 1, Next
        not 313;
        WcsLow, if True G '  	
----------------------------------

Opcode(CALLXB), tmp := NextOp;               ! ISN
        tmp11 := 2;                    as offset from stack base.
!            (Tos-2) = new RN = Routine number.
!            (Tos-3) = new SL = Static link as off       ! backup 2 bytes if segfault
CallExternal: Call(XSTMap);
        tmp5 := tmp, LoadS(StkOv);           ! XSN
        Caset from stack base.
!
! Calls:
!        WordParm, XSTMap, GetLL, GetSL.
!
!-----------------------------------------------ll(ChkSeg);                        ! be sure XSN is resident
        tmp6 := tmp, if Odd Goto(SegFault1); ! if not resident
  ------------------------------

Opcode(LVRD), Call(WordParm);
        tmp := Shift + tmp, Call(XSTMap);  ! ISN
        tmp2       tmp := NextOp;                       ! new RN
        tmp11 := tmp11 + 1,                  ! back up one more if stack ov:= NextOp;                 ! new RN
        tmp10 := 0;                     ! SL of top-level routine
        tmp3 := NextOp -fl
                            Call(CllSub);    ! set up ACB etc.
        Goto(RefillJmp);                     ! enter the rou 2;             ! new LL - 2
        tmp4 := CB, if Leq Goto(LVRD2); ! if calling top-level routine
        Nop;              tine

Opcode(CALLXW), tmp11 := 3, Call(WordParm);  ! backup 3 bytes if segfault
        tmp := Shift + tmp, Goto(CallExternal              ! allow placer to do page escape
        tmp10 := RN, Call(GetLL);       ! get current LL
        tmp3 := tmp3 +);  ! ISN

! Opcode LVRD.
!-----------------------------------------------------------------------------
!
! Abstract:
!  2;               ! new LL
        tmp1 := Mdi - tmp3;             ! current LL - new LL (typically >=0)
        tmp10 := AP,       LVRD is a five byte instruction that builds a variable routine
!       descriptor.  This descriptor may be used later in if Geq Call(GetSL);  ! if not calling deeper
                                        ! if calling deeper, new SL = AP
LVRD1:  a CALLV (call
!       variable) instruction.  The external segment is identified by an
!       ISN (internal segment number). tmp10 - SB, Push;               ! static link
        tmp2, Push;                     ! routine number
        tmp7 - SB, Push An ISN of zero identifies the
!       current segment.  The ISN is an index into the XST (external
!       segment table).  T;                ! global link
        tmp, Push, NextInst(0);         ! system segment number

LVRD2:  tmp10 := 0, Goto(LVRD      CALLXW  LowByteISN HighByteISN RoutineNumber
!
! Result:
!       New activation record built on memory stack.
!       he XST maps an ISN into an XSN (external
!       segment number) and an XGP (external global pointer).
!
! Instruction:
!   Code state registers saved in new ACB.
!       Expression stack saved in new ACB.
!       Code state registers updated.
!
!     LVRD    LowByteISN HighByteISNRoutineNumber LexicalLevel
!
! Result:
!       Stack pushed four times.
!       (Tos..Tos-Calls:
!       CllSub, XSTMap, ChkSeg, WordParm, RefillJmp, SegFault, VectSrv.
!
!-------------------------------------------3) = Variable routine descriptor:
!            (Tos) = XSN = External segment number.
!            (Tos-1) = XGP = Global link ' 	
   Data is sent low word 1st, then mid, then hi
!           When all 256 MI are loaded, Boot jumps to 7400
constant(ReadCsr,40adCsr);                  !Wait for a word to come from PDP-11
        IOD AND XbufCyc;             !Check for him to load his t);  !Complement of 40, the read csr address
constant(WriteCsr,241); !Write csr, with z7 set for write
constant(ReadData,42);
ransmit buffer
        IF Eql GoTo(AwaitData);           !Keep looping until he does
        15, IOB(WriteCsr);               constant(WriteData,243);
constant(XmitDone,10);  !These define the bits in the csr
constant(Flag,4);       !They are mainly fo !Clear XmitDone
        IOB(ReadData);                    !Get the data
        Data := IOD;
        5, IOB(WriteCsr), Returr reference
constant(RcsrToBus,1);  !Since the microassembler won't allow
constant(XbufCyc,2);    !expressions where a constann;         !Set Xmit Done
!
!
!       B O O T  f r o m  D I S K
!
!
!
!Use the Floppy or Hard Disk to Read Microcode
!Stt is expected
define(count,1);  !The number of microinstructions to load
define(data,2);   !the guy who has the data to be wriep the head to track 0, and read 2k of microcode
!2048 microwords of 48 bits each (3 - 16 bit words) is 6144 words
!at 256 wortten
Begin:  IOB(ReadCsr);
        IOD AND Flag;                     !Check Flag to see if Link is present
        IF NEQ GoTds/sector 6144 div 256 is 24 sectors
!
!   Display Error Codes
!     10 - Hung in Disk Boot
!     11 - Memory Data Error
! o(DiskStart);
Start:  Count := 377; !Number of micro instructions to load -1
        LoadS(7777), Count := Count + 1;  !Load R    12 - Memory Address Error
!     13 - Disk Didn't come ready
!     14 - Couln't boot from either disks
!     15 thru 21 -  Three Rivers Computer Corporation
!
! Will Boot from 1 of 3 sources
!       1 - If Link Cable is plugged in, will boot from  Counter with 1st addr to load
        5,IOB(WriteCsr); !XmitDone:=1, Flag:=0, RcsrToBus:=1, XbufCyc:=0
WaitHeader: Call(Awaitlink
!       2 - If Cable is not in, will try to boot from Floppy
!       3 - If that fails, will try to boot from Hard Disk
Data);              !Look for header word
        Data xor 12345;                   !check to see if it is right
        IF Ne!       4 - if that fails, will loop forever
!
!
!
constant(IntVec,700);  !Interrupt vector location
!
!    B O O T   f r q GoTo(WaitHeader);
MainLoop: Call(AwaitData);                !Returns with Data in UW
        Data;
        WCSlow, if true o m   L I N K
!
!Assumes PDP-11 Link on other end
!Protocol:  PDP-11 Sends a 12345 as a flag, when Perq sees it, it
!       GoToS(DatMid); !Write Control Store using R as the addr
DatMid: Call(AwaitData);
        Data;
        WCSmid, if true GoToS(    starts receiving 3 word data items to be loaded into
!           the control store.  256 (decimal) words are loaded
!     DatHi);
DatHi:  Call(AwaitData);
        Data;
        WCShi, if true GoToS(DecAdr);
DecAdr: Repeat(DoLoop), Count := Count       at location 7400 in the ram, with last word written
!           first (ie 7777 first, 7776 next,...,7400 last)
!        - 1;
DoLoop: IF Neq GoTo(MainLoop);
        GoTo(7400);                       !Jump to the code just loaded
AwaitData: IOB(Re (  	
1);

! Opcode CALLV.
!-----------------------------------------------------------------------------
!
! Abstract:
!         ! static link
                                Call(CllV);  ! set up ACB etc.
        Goto(RefillJmp);                     ! CALLV is a one byte routine call instruction.  It is used to call
!       routines described by variable routine descriptors. enter the routine

!       Stack overflow.

CallV1: Tos := tmp, Push;                    ! restore expression stack
      
!
! Instruction:
!       CALLV
!
! Environment:
!       (Tos..Tos-3) = Variable routine descriptor:
!            (Tos) =   Tos := GP - SB, Push;
        Tos := CS, Push, Goto(StkOv);

!       Segment fault.

CallV2: tmp11 := 1, Goto(SegFault1);XSN = External segment number.
!            (Tos-1) = XGP = Global link as offset from stack base.
!            (Tos-2) = new          ! instruction is one byte long

! Opcode RET.
!--------------------------------------------------------------------RN = Routine number.
!            (Tos-3) = new SL = Static link as offset from stack base.
!
! Result:
!       New activati---------
!
! Abstract:
!       RET is a one byte instruction used to return from a routine.  If
!       the return address on record built on memory stack.
!       Code state registers saved in new ACB.
!       Expression stack saved in new ACB aftefrom the ACB is zero, the program counter is
!       set to the exit point of the routine that is being returned to.
!       Tr popping four words.
!       Code state registers updated.
!
! Calls:
!       CllV, ChkSeg, RefillJmp, SegFault.
!
!-----his is used by the EXITT and EXGO opcodes.
!
! Instruction:
!       RET
!
! Result:
!       Code state registers restored ------------------------------------------------------------------------

Opcode(CALLV), tmp := Tos, Call(ChkSeg);     ! XSN
from old ACB.
!       Expression stack restored from old ACB.
!       Old activation record popped from memory stack.
!              tmp5 := Tos,                         ! new CS
                     if Odd Goto(CallV2);    ! if segment not resident
  Function result (if any) left on top of memory stack.
!
! Calls:
!       RetExit, RefillJmp, VectSrv, RestoreStack.
!
!---       tmp6 := tmp, Pop, LoadS(CallV1);     ! new CB 
        nop;                                 ! *** separate "Pop" from "T--------------------------------------------------------------------------

(*****
Opcode(RET), AP + ACBRS, Fetch;
        Mos +"
        tmp7 := Tos + SB, Pop;               ! new GP
        tmp6, Fetch;                         ! get routine dictiondi - CS;
        tmp5 := Mdi, if Neq Goto(Return4);  ! if returning to another segment
Return1: Call(RestoreStack);           ary address
        Hold, tmp := Tos, Pop, LeftShift(3); ! new RN
        Hold, tmp1 := Shift + tmp6;          ! offset to dic     ! restore expression stack
        AP + ACBGL, Fetch;
        GP := Mdi + SB, if IntrPend Call(VectSrv);  ! global pointetionary entry
        Hold, Mdi + tmp1, Fetch4;            ! fetch dictionary entry
        tmp10 := Tos + SB, Pop,           r
        AP + ACBTL, Fetch;
        TP := Mdi + SB;                     ! top pointer
        AP + ACBRR, Fetch;
        RN ( 	

define(CkSum,350);    !Should be 370, set to 350 for testing
define(Dly,252);
!  Count In Diagnostic Display Register when thts
!
!Try to read the Floppy
!
DoFloppy: MemAdr:=0, IOB(dseek);        !Turn Z80 on
        ByteCnt := 0, Call(WaitAWhile);is routine is called
constant(DskDDSstart,10#10);
!  Count In Diagnostic Display Register when this routine finishes
constant !Let it start up
        153, IOB(307);                  !Start of message
        Call(WaitAWhile);
        015, IOB(307); (DskDDSend,10#29);
!    Difference ->  DDSend - DDSstart
constant(DskDDSdif,10#19);
constant(dstat,100);   !disk status regis                 !FloppyBoot
        Call(WaitAWhile);
        000, IOB(307);                  !Kick the Z80 state machine.
 ter IOB address
constant(dseek,301);   !disk command register IOB address
constant(dhead,302);   !disk head register IOB addre       
MoreBytes: ByteCnt := ByteCnt - 2;      !Count bytes in this block
        tmp := 100, if gtr goto(RdFlop);!More to doss
constant(CylSec,310);  !disk Cylinder/Sector IOB address
constant(FileL,311);   !disk low File Serial Number IOB address
c, otherwise, new block
        
FindHdr:Call(RecZ80Byte);               !Get a Z80 byte
        tmp := tmp - 1;              onstant(FileH,312);   !disk hi File Serial Number IOB address 
constant(Block,313);   !disk Logical Block Number IOB address
c   !Count Chars
        Bite xor 125, if leq goto(IsDskRdy);   !Was it Start of message?
        if neq goto(FindHdr);        onstant(CWadrL,331);  !disk Header address low IOB address
constant(CWadrH,321);  !disk Header address hi IOB address
constant   !Try some more
GotHdr: Call(RecZ80Byte);
        Bite xor 23;                      !Good Boot Data?
        CkSum := 0, if(DatAdrL,330); !disk Data Buffer address low IOB address
constant(DatAdrH,320); !disk Data Buffer address low IOB address
cons neq goto(IsDskRdy);
        Call(RecZ80Byte);               !Get Byte Count
        ByteCnt := Bite, LoadS(7);
RdFlop: Call(tant(DirOut,0);    !move disk heads out towards track 0
constant(DirIn,10);    !move disk heads in towards track 201
DiskStartRecZ80Byte);               !Get a Data Word
        Data := Bite, Call(RecZ80Byte); !Save low byte, get high Byte
ShftByt:Bite:
        TryCnt := 50, CntlRasterOp(0);  !wait 50 mem tests for disk ready
                                        !turn Rast := Bite + Bite, Repeat(ShftByt); !Put bite in high Byte
        MemAdr, Store;
        Data + Bite, LoadS(7);
        MemAdrBad Interrupts Reading Floppy Disk Data
!     29 - Finished Disk Code
!
define(c400,4);
define(c1777,1);
define(TryCnt,10);erOp off
        100, store;                     !get memory state cleared
        iob(106);                       !read any l
define(Dir,20);
define(ByteCnt,20);   !Note Same register as Dir
define(Head,40);
define(Bite,40);      !Note Same registeratent Z80 data
        tmp := 6000;                    !Must turn off video
        100, fetch;
        tmp, IOB(341);        as Head
define(tmp,100);
define(Sec,200);
define(CylHd,357);    !Should be 377, set to 357 for testing
define(MemAdr,307);           !Initialize video addresses
        tmp, IOB(341);
        tmp, IOB(343);                  !Shut off video interrup )  	
    !      t3
        Tos := Mdi, Push;                   ! TL   t1, 2
        tmp5 := Mdi;                        ! RS   t3
    tmp3 := tmp3 - 1, Push,             !      t0
                                if IntrPend Goto(Return5);
        Tos := Md        tmp6 := Mdi;                        ! RA   t0
        tmp7 := Mdi;                        ! RR   t1
        tmp5 - CS;i, if Gtr Goto(Return4);   !      t1
        Goto(RefillJmp);

!       Interrupt while restoring the stack.

Return5: tmp4                           !      t2
        tmp10 := CB, if Neq Goto(Return6);  !      t3 if cross segment return
Return1: TP := tmp4 + 1, Call(VectSrv);
        Pop, tmp3 := tmp3 + 1, Goto(Return4);

!       Cross segment return.

(*****
Return6:  := Mdi;                          ! routine number
        AP + ACBRA, Fetch;
        tmp := Mdi, RightShift(1);          ! re:= Tos + SB,                    !      t0
                         if IntrPend Call(VectSrv);
        RN := tmp7;             turn address
        UPC := Shift and not 3, if Eql Goto(Return2);  ! if return address = 0
        UPC := UPC + CB, if IntrPe            !      t1
        AP + 2, Fetch2;                     !      t2, 3
        tmp4 := AP, Pop;                    !  nd Call(VectSrv);

! ----> The following line is a good place to set a breakpoint.  RN, CS, and
! ----> UPC have been restore    t0 old AP
        BPC := tmp6 and 7;                  !      t1
        AP := Mdi + SB;                     ! DL   t2
   d (though BPC hasn't).

        BPC := tmp and 7, Goto(Return3);

!       In the middle of an exit sequence.

Return2: Cal     GP := Mdi + SB;                     ! GL   t3
        tmp6, RightShift(1);                !      t0
        UPC := Shift l(RetExit);

Return3: AP + ACBDL, Fetch;
        AP := Mdi + SB;                     ! activation pointer
        AP + ACBLPand not 3,             !      t1
                                if Eql Goto(Return2);
        UPC := UPC + CB,               ,Fetch;
        LP := Mdi + SB,                     ! local pointer
                        Goto(RefillJmp);    ! enter routin     !      t2
                         Goto(Return3);

!       In the middle of an exit sequence.

Return2: Call(RetExit);e

!       Cross segment return.

Return4: tmp5 + tmp5, Fetch2;               ! check residence
        tmp1 := CB;        

Return3: AP + ACBLP, Fetch;                 !      t3
        LP := Mdi + SB;                     !      t0, 1, 2
                         ! save old CB just in case
        CB := Mdi and not 376;
        CB := Mdx or CB, if Odd Goto(Return5);  ! itmp4 + ACBStackSize, Fetch;         !      t3
        tmp4 := tmp4 + ACBSaveStack;        !      t0
        tmp3 := Mdi;      f not resident
        CS := tmp5, Goto(Return1);          ! code segment
        
!       Segment fault.

Return5: CB := t                  !      t1 - t2  saved word count
        tmp4 := tmp4 + tmp3,                !      t3 address+1 of last
   mp1;                        ! restore CB
        tmp11 := 1, Goto(SegFault1);
*****)
Opcode(RET), AP + 4, Fetch4;                                      if Eql Goto(RefillJmp);  ! if stack empty
Return4: tmp4 := tmp4 - 1, Fetch;           !      t3
     ) 	
 xor 13777;                 !Check Expiration of data
        MemAdr := MemAdr + 1, if neq goto(MoreBytes);
        Data := 0,           !You Made it
        Dir := DirIn, Call(seek);       !Try next cylinder, next head
        CylHd := 440;            call(Copy);
        if eql GoTo(StartIt);           !If sucessfull, go execute it
!
!Floppy didn't work, try the rigid disk        !One track out, head one
        Head := 1, Call(DoDiskRead);    !Try it here
        tmp := 4, if eql GoTo(StartIt); 
!
IsDskRdy: iob(dstat);  !Read status register
        iod and 200, ThreeWayBranch(PopStk);  !pop call stack
PopStk: TryCnt !Made it on alternate track
                                        !Code 14, Couldn't Read Disk
Busted: Call(SetDisplay);
Sl:= TryCnt - 1, if neq goto(GoManGo);
        r1 := 0, if eql GoTo(NoDskSpinUp);
wloop:  r1 := r1 - 1, store;
        r1;
   eep:  GoTo(Sleep);                    !Loop forever
SetDisplay: StackReset, Call(WaitAWhile);
        tmp := tmp - 1;
            r1, fetch;
        mdi - r1;
        tmp := 1, if neq goto(Busted);  !Code 11, Memory Error
        r1 - 1;
        if  if neq goto(SetDisplay);
        return;
!
!Looks Good, try to execute the code you loaded
!
StartIt: tmp := dskDDSdif, Cac19 goto(doread);
        goto(wloop);
doread: r1 := 0;
rloop:  r1 := r1 - 1, fetch;
        mdi - r1;
        tmp := 2, ifll(SetDisplay);  ! Read Disk OK
        GoTo(4000);
!
!Try to read 24 sectors into memory from 0 to 13777
!
DoDiskRead: Sec neq goto(Busted);  !Code 12, Memory Address Error
        r1 - 1;
        if c19 goto(IsDskRdy);
        goto(rloop);

NoD := 27;                  !Read 24 (Decimal) sectors, load into
        MemAdr := 13400;                !Do last sector first
 skSpinUp: tmp := 3, GoTo(Busted);    !Code 13,  Disk Error
        
GoManGo:C400 := 400;                    !A constant used m       CkSum := 0;                     !Initialize the Checksum
DoAnother: TryCnt := 170, Call(DoOneSec); !Give it 10 trys per any times
        C1777 := 1777;
        TryCnt := C400, LoadS(10);      !Give the disk 400 steps to get to trk 0
Jog:    Dirsector
        Sec := Sec - 1;                 !Count your sectors
        MemAdr := MemAdr - C400, if geq GoTo(DoAnother); !D := DirIn, Call(Seek);       !Shove the heads out a ways
        Head := 0, repeat(Jog);         !Move out 10 tracks, initializo another sector
!
!Data is now loaded into memory, copy it into the microstore
!
Copy:   MemAdr := 14000;                !Se head
Restore:tmp := 20;                      !in WaitABit, the TrackZero bit
        Dir := DirOut, Call(Seek);      !Go bactarting at the high end of the data
        LoadS(7777);                    !Load into top 2k of microstore
wd0:    Cksum := Ck one step
        TryCnt := TryCnt - 1, if neq goto(StartRead); !Keep trying
        Data := 0, if gtr goto(Restore);
!
!Reksum + Data, Call(NextData);  !Write high word 1st
        WCShi,  if true GotoS(wd1);
wd1:    Cksum := Cksum + Data, Call(Nexad the disk into memory
!
StartRead: CylHd := 0, Call(DoDiskRead);!First try Cylinder 0, head 0
        If Eql GoTo(StartIt);tData);  !Always accumulating checksum
        WCSmid, if true GoToS(wd2);
wd2:    Cksum := Cksum + Data, Call(NextData);
    *  	
 the exit point of the current procedure.  The
!       ACBs up to and including the one that returns to the target routine
!    return address set to the target address.
!
! ----> The assumption is made that the segment and routine numbers do not
!        are modified so that the return address is zero.  Note that the
!       RET opcode treats a return address of zero as an e    specify the current procedure.
!
! Instruction:
!       EXGO    LowByteISN HighByteISN
!               RoutineNumber
! xit request.
!
! Instruction:
!       EXITT   LowByteISN HighByteISN RoutineNumber
!
! Result:
!       PC (UPC, BPC) = Exi              LowByteAddress HighByteAddress
!
! Result:
!       PC (UPC, BPC) = Exit point of current procedure.
!       ACt point of current procedure.
!       ACBs modified as described in abstract.
!
! Calls:
!       ExSub, RetExit, RefillJmp.Bs modified as described in abstract.
!
! Calls:
!       ExSub, RetExit, RefillJmp, WordParm.
!
!--------------------------
!
!-----------------------------------------------------------------------------

Opcode(EXITT), Call(ExSub);               ---------------------------------------------------

Opcode(EXGO), Call(ExSub);                   ! set return addresses to ze   ! set return addresses to zero
        Call(RetExit);                       ! set PC to exit point
        Goto(RefillJmp);ro
        Call(WordParm);
        tmp := Shift + tmp;                  ! target address
        tmp2 + ACBRA, Store;        tmp5 + tmp5, Fetch2;               ! check residence
        CB := Mdi and not 376;
        CB := Mdx or CB, if Odd Goto(Retur                     ! continue at exit address

! Opcode EXGO.
!-----------------------------------------------------------n7);  ! if not resident
        CS := tmp5, Goto(Return1);          ! code segment
*****)
Return6: tmp := tmp5, Call(ChkSeg);------------------
!
! Abstract:
!       EXGO is a six byte instruction used to jump to a particular point
!       in anothe         ! find new code base
        CB := tmp, if Odd Goto(Return7);    ! if not resident
        CS := tmp5, Goto(Return1);r routine.  The target routine is identified in the same
!       way as an external procedure is identified in the CALLXW instr          ! code segment
        
!       Segment fault.

Return7: CB := tmp10, Pop;                  ! restore CB
        uction.
!       The target address is specified as an absolute byte address within
!       the target code segment--it is not tmp11 := 1, Goto(SegFault1);

! Opcode EXITT.
!-----------------------------------------------------------------------------self-relative.
!
!       The PC is set to the exit point of the current procedure.  The
!       ACBs up to but not including 
!
! Abstract:
!       EXITT is a four byte instruction used to exit from a routine.  The
!       routine to exit from is idthe one that returns to the target
!       routine are modified so that the return address is zero.  Note
!       that the RETentified in the same way as an external
!       procedure is identified in the CALLXW instruction.
!
!       The PC is set to opcode treats a return address of zero as an exit
!       request.  The ACB that returns to the target routine has its
!      * 	
  r0 := IOD and 7;                !Check status bits
        dly := dly - 1, if eql goto(IsDone);!status code 0 is done, Keep t a Vector
!    -> we can return from RecZ80Byte from Z80Int
Z80Int: iob(106), loc(700);             !Here on Z80 Read Interruprying
        if neq goto(WtDone);            !Until you find it
        47, IOB(dseek);                 !If you dont, Reset tt
        Bite := iod and 377, return;    !pick up byte and return
BadInt1: tmp := 5, goto(busted), loc(704);  !Bad Interrupt he disk
        Call(WaitAWhile);               !Let that work
        TryCnt := TryCnt + 1;
        if ByteSign return;     Codes
BadInt2: tmp := 6, goto(busted), loc(710);  ! 15 thru 23.
BadInt3: tmp := 7, goto(busted), loc(714);
BadInt4: tmp := 10     WCSlow, if true GoToS(wd3);
wd3:    MemAdr, Repeat(wd4);            !Decrement Address, check Address
wd4:    if gtr goto        !Try it again
        GoTo(DoOneSec);                 !I give up
IsDone: 0, IOB(dseek), return;          !Clear disk a(wd0);               !if >0 more to do
        Cksum + Data, return;           !otherwise, add final word to Cksum

NextData:nd done
!
!Seek the disk One track in dir direction
!
Seek:   dir or 27, iob(dseek);          !Set the step bit + dir bit +  MemAdr := MemAdr - 1, Fetch;  !Decr address and get that word
        Data := MDI, Return;            !Data goes on R

!
!Rreset
        dly := C1777, Call(wtwl1);      !Make a pulse
        dir, iob(dseek);                !Clear the step bit
     ead one sector from the hard disk into memory
!
DoOneSec:CylHd or Sec, IOB(CylSec);     !Physical header data
        head, I                                   ! Assumes Seek Complete Happens
!
!Wait for a bit to come up
!
WaitABit: Call(WaitAWhile)OB(dhead);               !Head number
        not 0, IOB(FileL);              !Files 1 and 2 for heads 0 and 1
        not 0, ;             !Wait some time
        iob(dstat);                     !Get the disk status
        r0 := iod;
        r0 and IOB(FileH);
        Sec, IOB(Block);                !Sector Number
        0, IOB(CWAdrL);    
        not 1, IOB(CWAdrH);   tmp, return;             !Test the bit and return
!
!Wait long enough for a sector to transfer, a head to settle, etc
!
Wait          !Stash label in high memory
        MemAdr xnor C1777, IOB(DatAdrL);
        not 0, IOB(DatAdrH);            !Stash AWhile: dly := 177777;
wtwl1:  if eql return;
        dly := dly - 1, goto(wtwl1);
!
!Get A Byte from Z80
!
RecZ80Byte: r1data in low memory
        1, IOB(dseek);                  !Read it baby
WtBzy:  IOB(dstat);                     !Wait for bus:=177777;
waitbyte: if intrpend Vector(Z80Int);   !Allow interrupts
        dly := 100, call(wtwl1);
        r1 := r1 - 1;   y
        r0 := IOD and 7;
        r0 xor 7;                       !Disk status code 7 is busy
        if neq goto(WtBzy);
                 !Dont wait too long
        if neq goto(waitbyte);          ! give up eventually
        goto(IsDskRdy);             dly := 177777;
WtDone: nop;
        nop;
        nop;
        IOB(dstat);                     !Check doneness
                 !Z80 isn't saying anything
!
!Allow only Z80 Interrupts to do anything
!  Note that the instruction at waitbyte is +  	
!-----------------------------------------------------------------------------
!
!  File : Perq.Qcode.5
!
!  Abstract:
!    tmp1 := Tos;
        Tos := tmp, Push;
        Tos := tmp1, Push;
        Tos := tmp, Push, NextInst(0);

! Opcode MMS.
  More qcode expansions
!
!-----------------------------------------------------------------------------

!----------------!-----------------------------------------------------------------------------
!
! Abstract:
!       MMS is a one byte opcode-------------------------------------------------------------
!
!  Change Log:
!
!   3 Jan 82  Michael R. Kristofic
!       that moves a value from the expression
!       stack to the memory stack.
!
! Instruction:
!       MMS
!
! Environment:
  Made qcodes 45 and 46 undefined
!
!-----------------------------------------------------------------------------

$Title !       (Tos) = Value.
!
! Result:
!       Stack popped.
!       Memory stack pushed.
!       Memory[TP] = Value.
!
! CalExpression stack and memory stack operators.

! Opcode REPL.
!--------------------------------------------------------------ls:
!       StkOv
!
!-----------------------------------------------------------------------------
       
Opcode(MMS), SL ---------------
!
! Abstract:
!       REPL is a one byte opcode that replicates the top word on the
!       expression stack- TP;
        tmp11 := 1, if C19 Goto(StkOv);      ! if not enough room on the stack
        TP := TP + 1, Store;
        Tos.
!
! Instruction:
!       REPL
!
! Environment:
!       (Tos) = Value.
!
! Result:
!       Stack pushed.
!       (Tos, Pop, NextInst(0);               ! move the value

! Opcode MMS2.
!--------------------------------------------------------) = Value.
!       (Tos-1) = Value.
!
!-----------------------------------------------------------------------------

Opcod---------------------
!
! Abstract:
!       MMS2 is a one byte opcode that moves two values from the expression
!       stace(REPL), Tos := Tos, Push, NextInst(0);

! Opcode REPL2.
!------------------------------------------------------------------k to the memory stack.
!
! Instruction:
!       MMS2
!
! Environment:
!       (Tos) = Value0.
!       (Tos-1) = Value1.
         ! store in last ACB
        tmp, Call(RetExit);                  ! set PC to exit point
        Goto(RefillJmp);     -----------
!
! Abstract:
!       REPL2 is a one byte opcode that replicates the top two words on the
!       expression sta                ! continue at exit address
$NoList

                                                                         ck.
!
! Instruction:
!       REPL2
!
! Environment:
!       (Tos) = Value0.
!       (Tos-1) = Value1.
!
! Result:
!        Stack pushed twice.
!       (Tos) = Value0.
!       (Tos-1) = Value1.
!       (Tos-2) = Value0.
!       (Tos-3) = Value1 .
!
!-----------------------------------------------------------------------------

Opcode(REPL2), tmp := Tos, Pop;
        + 	
11 Jul 80  V0.0  J. Strait.
!       Start file.


!!!     Link provides a send and receive routine for use with the Perq
! !
!       Entry   (Tos) = Data to send.
!
!       Exit    (Tos) = True if success, false otherwise.

!       Send data and       parallel communications hardware.  The routines send and receive
!       16 bit data words with timeout processing, but iset SndDataReady.

Snd:    Tos, Iob(WriteData), Loc(7410);       ! send the data
        WCsr := WCsr and not SndDataReady, Implement no other
!       communications protocol.


!!      Registers.

        Define(Count,350);                    ! Tob(WriteCsr);
        Count := 20;
Snd1:   Count := Count - 1, if Neq Goto(Snd1);
        WCsr := WCsr or SndDataReady, Iob(Wimeout counter
        Define(WCsr,351);                     ! Current WriteCsr value
        
        
!!      Constants.
riteCsr);
        Tos := CTrue, NextInst(0);
        
!        WCsr := WCsr and not SndDataReady, Iob(WriteCsr);  ! set data 
        Constant(ReadCsr,40);                 ! Link input command/status
        Constant(ReadData,42);                ! Linready
!               
!!       Watch for no SndDone (receiver has started).
!        
!        Count := not 0;             k input data
        Constant(WriteCsr,241);               ! Link output command/status
        Constant(WriteData,243);                ! timeout count
!Snd1:   if IntrPend Call(VecSrv);
!        Count := Count - 1, Iob(ReadCsr);
!        Iod and SndD, goto(busted), loc(720);
BadInt5: tmp := 11, goto(busted), loc(724);
BadInt6: tmp := 12, goto(busted), loc(730);
BadInt7: tm        ! Link output data

        Constant(SndDataReady,1);             ! output signal - assert low
        Constant(SndDop := 13, goto(busted), loc(734);
END;
                                                                                        ne,4);                  ! input signal - assert high
        Constant(RcvDataReady,2);             ! input signal - assert high!!!     Link - Perq parallel link communications routines.
!       J. P. Strait    11 July 80.
!       Copyright (C) Three Riv
        Constant(RcvDone,10);                 ! output signal - assert low
       
        Constant(CFalse,0);
        Consers Computer Corporation 1980.
!       Company Confidential.


!!      Change history.
!
!       14 Jan 82  V1.2  J Straittant(CTrue,1);

$Include IO.Dfs
        
        
        
!!      Placement.

        Place(7400,7477);
        
    .
!       Do not do retries in Link.Micro.  Let the caller take care of
!       retries so that OdtPrq doesn't have problems w    
!!!     Prs - Preset link.
!
!       Address = 7400.
!
!       Entry   none.
!
!       Exit    Link initialized.
! ith the screen
!       jumping around.
!
!       30 Jun 81  V1.1  J. Strait.
!       Use IO.Dfs to get definition of IntVec.              (Tos) = True if success, false otherwise.

Prs:    WCsr := not RcvDone, Iob(WriteCsr), Loc(7400);! initialize th
!       Move Link.Micro to #7400.
!   

!       4 Jun 81   V1.0  J. Strait.
!       Move Link.Micro to #6000.
!
!       e WriteCsr
        Tos := CTrue, Push, NextInst(0);
        

!!!     Snd - Send word to link.
!
!       Address = 7410.
 ,  	
] = Value0.
!
! Calls:
!       StkOv.
!
!-----------------------------------------------------------------------------

O  TP, Fetch;
        TP := TP - 1;
        Tos := Mdi, Push, NextInst(0);       ! move Value 1

! Opcode EXCH.
!----------pcode(MMS2), SL - TP;
        tmp11 := 1, if C19 Goto(StkOv);      ! if not enough room
        TP := TP + 1, Store;
        -------------------------------------------------------------------
!
! Abstract:
!       EXCH is a one byte instruction thatTos, Pop;                            ! move Value 0
        TP := TP + 1, Store;
        Tos, Pop, NextInst(0);                exchanges the top two values on
!       the expression stack.
!
! Instruction:
!       EXCH
!
! Environment:
!       (To! move Value 1

! Opcode MES.
!-----------------------------------------------------------------------------
!
! Abstract:s) = Word 0.
!       (Tos-1) = Word1.
!
! Result:
!       (Tos) = Word1.
!       (Tos-1) = Word0.
!
! Calls:
!       Vec
!       MES is a one byte opcode that moves a value from the memory
!       stack to the expression stack.
!
! Instruction:tSrv.
!
!-----------------------------------------------------------------------------

! Opcode EXCH2.
!------------------
!       MES
!
! Environment:
!       Memory[TP] = Value.
!
! Result:
!       Memory stack popped.
!       Stack pushed.-----------------------------------------------------------
!
! Abstract:
!       EXCH2 is a one byte instruction that exchan
!       (Tos) = Value.
!
!-----------------------------------------------------------------------------

Opcode(MES), TP, ges the top two pairs
!       of values on the expression stack.
!
! Instruction:
!       EXCH2
!
! Environment:
!       Fetch;
        TP := TP - 1;
        Tos := Mdi, Push, NextInst(0);       ! move the value

! Opcode MES2.
!--------------(Tos) = Word0.
!       (Tos-1) = Word1.
!       (Tos-2) = Word2.
!       (Tos-3) = Word3.
!
! Result:
!       (Tos) = Word---------------------------------------------------------------
!
! Abstract:
!       MES2 is a one byte opcode that moves tw2.
!       (Tos-1) = Word3.
!       (Tos-2) = Word1.
!       (Tos-3) = Word2.
!
! Calls:
!       VectSrv.
!
!-----------o values from the memory
!       stack to the expression stack.
!
! Instruction:
!       MES2
!
! Environment:
!       Me------------------------------------------------------------------

Opcode(EXCH), tmp := Tos, Pop;
        tmp1 := Tos, if Inmory[TP] = Value0.
!       Memory[TP-1] = Value1.
!
! Result:
!       Memory stack popped twice.
!       Stack pushed twicetrPend Call(VectSrv);
        Tos := tmp;
        Tos := tmp1, Push, NextInst(0);

Opcode(EXCH2), tmp := Tos, Pop;
        .
!       (Tos) = Value1.
!       (Tos-1) = Value0.
!
!---------------------------------------------------------------------tmp1 := Tos, Pop;
        tmp2 := Tos, Pop;
        tmp3 := Tos, if IntrPend Call(VectSrv);
        Tos := tmp1;
        Tos!
! Result:
!       Stack popped twice.
!       Memory stack pushed twice.
!       Memory[TP] = Value1.
!       Memory[TP-1--------

Opcode(MES2), TP, Fetch;
        TP := TP - 1;
        Tos := Mdi, Push;                    ! move Value 0
       , 	
ql Goto(Snd4);   ! if timed out
!        if Eql Goto(Snd2);                    ! if receiver not yet done
!        Tos := CTru
        

VecSrv: Vector(IntVec);


        end;
        
                                                              e, NextInst(0);            ! set success
!
!Snd3:   WCsr := WCsr or SndDataReady, Iob(WriteCsr);  ! clear data ready
!Snd4:    Tos := CFalse, NextInst(0);           ! set failure
        

!!!     Rcv - Receive word from link.
!
!       Address = 74 20.
!
!       Entry   none.
!
!       Exit    (Tos) = True if success, false otherwise.
!               (Tos-1) = Data iff Sides 2
Density SINGLE
Fast


! MICROCODE.SOURCE - MICROCODE SOURCES
! Created 26 Jan 82 11:50:55

Get PERQ.MIC         success.

!       Look for DataReady.

Rcv:    if IntrPend Call(VecSrv), Loc(7420);
        Iob(ReadCsr);
        Iod and     PERQ.MICRO
Get PERQ.DFS             PERQ.DFS
Get QCODES.DFS           PERQ.QCODES.DFS
Get QCODE.1              PERQ.QCODERcvDataReady;
        if Eql Goto(Rcv1);                    ! if no data ready
       
!       Clear RcvDone (signal that we .1
Get QCODE.2              PERQ.QCODE.2
Get QCODE.3              PERQ.QCODE.3
Get QCODE.4              PERQ.QCODE.4
Get QCOare starting).

        WCsr := WCsr or RcvDone, Iob(WriteCsr);  ! clear receive done
        
!       Read the data.
     DE.5              PERQ.QCODE.5
Get QCODE.6              PERQ.QCODE.6
Get QCODE.7              PERQ.QCODE.7
Get FLOAT.MUL        
        Iob(ReadData);                        ! request the data
        Tos := Iod, Push;                     ! read the        PERQ.FLOAT.MUL
Get ROUTIN.1             PERQ.ROUTINE.1
Get ROUTIN.2             PERQ.ROUTINE.2
Get PERQ.INI           data
        
!!       Watch for RcvDataReady to go away (sender is finished).
!        
!        Count := not 0;             PERQ.INIT
Get RO.MIC               RO.MICRO
Get LINE.MIC             LINE.MICRO
Get IO.MIC               IO.MICRO
Get IO.Done, if Eql Goto(Snd3);   ! if timed out
!        if Neq Goto(Snd1);                    ! if receiver not yet started
!                   ! timeout count
!Rcv2:   if IntrPend Call(VecSrv);
!        Count := Count - 1, Iob(ReadCsr);
!        Iod and Rc 
!!       Clear SndDataReady (signal we are finished).
!        
!        WCsr := WCsr or SndDataReady, Iob(WriteCsr);  ! clvDataReady, if Eql Goto(Rcv3);  ! if timed out
!        if Neq Goto(Rcv2);                    ! if data still ready
!
!!     ear data ready
!        
!!       Watch for SndDone (receiver is finished).
!
!        Count := 0;                            Set RcvDone (data has been received).
        
        WCsr := WCsr and not RcvDone, Iob(WriteCsr);  ! set receive done
    ! timeout count
!Snd2:   if IntrPend Call(VecSrv);
!        Count := Count - 1, Iob(ReadCsr);
!        Iod and SndDone, if E     Tos := CTrue, Push, NextInst(0);      ! set success
        
Rcv1:   Tos := CFalse, Push, NextInst(0);     ! set failure -  	

!       ATPW is a two byte instruction that adds a value in the range
!       -32768..32767 to the memory stack top pointer.
from the instruction that immediately follows it.
!
! Instruction:
!       TLATE0
!
! Environment:
!       (Tos) = Offset !
! Instruction:
!       ATPW
!
! Enivronment:
!       (Tos) = N.
!
! Result:
!       Stack popped.
!       N words puspart of virtual address.
!       (Tos-1) = Segment part of virtual address.
!
! Result:
!       Stack popped.
!       (Tos) := tmp, Push;
        Tos := tmp3, Push;
        Tos := tmp2, Push, NextInst(0);

! Opcode LDTP.
!-----------------------hed on the memory stack (TP = old TP + N).
!
! Calls:
!       VectSrv, StkOv.
!
!------------------------------------------------------------------------------------------------
!
! Abstract:
!       LDTP is a one byte instruction that loads the me-----------------------------------

Opcode(ATPB), tmp := NextOp;                 ! N
        tmp11 := 2,                    mory stack top
!       pointer onto the expression stack.  The pointer that is loaded is
!       actually a pointer to the nex      ! instruction is two bytes long
                    if ByteSign goto(ATPB2);
ATPB1:  TP := TP + tmp, if IntrPend Call(Vet free word of the memory stack.
!
! Instruction:
!       LDTP
!
! Result:
!       Stack pushed.
!       (Tos) = TP - SB ctSrv);
        SL - TP;
        if C19 Goto(ATPErr);
        NextInst(0);

!       Sign-extend a byte.

ATPB2:  tmp := t+ 1 = Memory stack top pointer as offset from
!                             stack base.
!
!----------------------------------mp or not 377, Goto(ATPB1);

Opcode(ATPW), tmp := Tos and AllOnes;
        tmp11 := 1,                          ! instruction-------------------------------------------

Opcode(LDTP), Tos := TP - SB, Push;
        Nop;                                 is one byte long
                    if Lss goto(ATPW2);
ATPW1:  TP := TP + tmp, if IntrPend Call(VectSrv);
        SL - TP; !***** MAB
        Tos := Tos + 1, NextInst(0);

! Opcode ATPB.
!---------------------------------------------------------
        if C19 Goto(ATPErr);
        Pop, NextInst(0);

!       Sign-extend a word.

ATPW2:  tmp := tmp or SignXtnd, Goto--------------------
!
! Abstract:
!       ATPB is a two byte instruction that adds a value in the range
!       -128..127 t(ATPW1);

!       Stack overflow, undo the ATPx.

ATPErr: TP := TP - tmp, goto(StkOv);





$Title TLATEx, STLATE - Vio the memory stack top pointer.
!
! Instruction:
!       ATPB    <N>
!
! Result:
!       N words pushed on the memory stacrtual address translation.

! Opcode TLATE0.
!-----------------------------------------------------------------------------k (TP = old TP + N).
!
! Calls:
!       VectSrv, StkOv.
!
!----------------------------------------------------------------
!
! Abstract:
!       TLATE0 is a one byte instruction that translates a virtual
!       address to a physical address.  If -------------

! Opcode ATPW.
!-----------------------------------------------------------------------------
!
! Abstract:the segment is not resident,
!       a segment fault is signalled.  A TLATE0 instruction that succeeds
!       is indivisible  - 	
MICRO
Get BOOT.MIC             BOOT.MICRO
Get KRNL.MIC             KRNL.MICRO
Get LINK.MIC             LINK.MICRO
          -- receiver done
! bit 4 -- receiver is promiscuous
! bit 3 -- start the transmitter on 0=> 1
! bit 2 -- transmitter Interrup! IO Microcode for 3MHz Ethernet
! Included by IO.Micro (basic IO microcode for Perq)
!
! 28 Sep 81  V1.2  Don Scelza
!     t enable
! bit 1 -- start the receiver, on 0=> 1
! bit 0 -- receiver interrupt enable

constant(eRecStart, 3);        ! RecI             Made changes to use the new IO.DFS.
!
! 16 Apr 81  V1.1  George Robertson
!                  Upgraded for versiontEn, RecGo
constant(ePromStart, 23);      ! RecIntEn, Promisc, RecGo
constant(eXmtStart, 14);       ! XmtIntEn, XmtGo


con C microcode and set up separate
!                  file IOE3.Micro.
!
!  2 Feb 81  V1.0  Gene Ball
!                  Creanstant(etherDTentry, 20);    ! Ether3 Device table entry (10 * 2)
constant(etherIntMsk, 23);     ! Ether3 interrupt mask offsetted

$Title Register definitions

! Ether registers -- 270 thru 274

define(etherTmp, 270);
define(etherDCBptr, 271);
d




$Title Ethernet Driver

! E3MHz Ethernet Driver
!-----------------------------------------------------------------efine(etherCmd, 272);
define(etherDly, 273);
define(etherCnt, 274);


$Title Ethernet IO register addresses

! Ethernet -------------
! jeb  2-feb-81 @CMU
! Ether IOCB:
!     BuffPtr    2 words;  virtual address, quad aligned, can't cross 4K
! IO register addresses

constant(E3WrRecWdCnt, 370);  ! WriteReceiveWordCount register
constant(E3RdRecWdCnt, 171);  ! ReadRec    Cmd        1 word;   0 => Reset, 1=> Status, 2 => Receive,
!                          3=> Promiscuous Receive, 4 => TransmieiveWordCount register
constant(E3WrCSR, 372);       ! WriteControlStatusRegister
constant(E3RdCSR, 173);       ! ReadCSR
cont
!     Delay      1 word;   XMT timeout delay
!     WordCount  1 word;   words to xmt/rec - should leave extra space
!      stant(E3WrXmtWdCnt, 374);  ! WriteTransmitWordCount
constant(E3RdXmtWdCnt, 175);  ! ReadTransmit Word Count
constant(E3WrDly,                     - is set to wds transferred
!     Result     1 word;   Device status  (Ether addr in high byte)
!     Next376);       ! Write start delay register
constant(E3RdNetAddr, 177);   ! Read Network address  bits <7::0>
constant(E3WrBuffHiIOCB   2 words;  ptr to next control block
!------------------------------------------------------------------------------

e, 326);    ! write high 4 bits of physical buffer addr
constant(E3WrBuffLo, 336);    ! write low 16 bits of buffer addr
constatherStart: ioDevTab + etherDTentry, Fetch2, case(StartIO,2); !Get DCB ptr
          Call(ioTLate);
          etherDCBptr := iont(E3WrHdrHi, 327);     ! write high 4 bits of header buffer address
constant(E3WrHdrLo, 337);     ! write low 16 bits of headePhysAdr, Fetch4;   ! read IOCB
          ioOffset := MDI;
          ioSeg := MDI;
          etherCMD := MDI;
          etherFS               IO.DFS
Get IOE3.MIC             IOE3.MICRO
Get VFY.MIC              VFY.MICRO
Get SYSB.MIC             SYSB.r addr


! Ether CSR fields
! bit 10 -- transmitter done
! bit 11 -- transmitter error
! bit 9 -- receiver error
! bit 8  .  	
irtual address
!                 (Segment,Offset).  This physical address is represented
!                 as an offset from sthat succeeds is indivisible from the instruction
!       that immediately follows it.
!
!       The depth of the virtual addtack base.
!
! Calls:
!       VectSrv, SegFault, RefillIndivisible.
!
!----------------------------------------------------resses in the expression stack
!       is represented by two four-bit fields in the operand byte.
!       The lower four bits -------------------------

! Opcode TLATE2.
!-----------------------------------------------------------------------------
!of the operand byte specifies the depth
!       of the Segment part of the virtual address which is closest
!       to the top
! Abstract:
!       TLATE2 is a one byte instruction that translates a virtual
!       address to a physical address.  If th of the expression stack (call this one the first
!       virtual address).  The upper four bits of the operand byte
!       se segment is not resident,
!       a segment fault is signalled.  A TLATE2 instruction that succeeds
!       is indivisible frpecifies the depth of the Segment part of the second virtual
!       address prior to any stack alteration.  A depth of 0 indic = Physical address corresponding to the virtual address
!               (Segment,Offset).  This physical address is representeom the instruction that immediately follows it.
!
! Instruction:
!       TLATE2
!
! Environment:
!       (Tos) = Word0.
!d
!               as an offset from stack base.
!
! Calls:
!       VectSrv, SegFault, RefillIndivisible.
!
!--------------       (Tos-1) = Word1.
!       (Tos-2) = Offset part of virtual address.
!       (Tos-3) = Segment part of virtual address.
---------------------------------------------------------------

! Opcode TLATE1.
!------------------------------------------!
! Result:
!       Stack popped.
!       (Tos) = Word0.
!       (Tos-1) = Word1.
!       (Tos-2) = Physical address corres-----------------------------------
!
! Abstract:
!       TLATE1 is a one byte instruction that translates a virtual
!      ponding to the virtual address
!                 (Segment,Offset).  This physical address is represented
!                 as  address to a physical address.  If the segment is not resident,
!       a segment fault is signalled.  A TLATE1 instruction than offset from stack base.
!
! Calls:
!       VectSrv, SegFault, RefillIndivisible.
!
!------------------------------------at succeeds
!       is indivisible from the instruction that immediately follows it.
!
! Instruction:
!       TLATE1
!
! E-----------------------------------------

! Opcode STLATE.
!----------------------------------------------------------------nvironment:
!       (Tos) = Word.
!       (Tos-1) = Offset part of virtual address.
!       (Tos-2) = Segment part of virtual-------------
!
! Abstract:
!       STLATE is a two byte instruction that translates one or two
!       virtual addresses to address.
!
! Result:
!       Stack popped.
!       (Tos) = Word.
!       (Tos-1) = Physical address corresponding to the v physical addresses.  If either segment
!       is not resident, a segment fault is signalled.  An STLATE
!       instruction  . 	
! = 4? Transmit
          if Neq GoTo(eRec);
          etherDly, IOB(E3WrDly);                ! set up timeout delay
        ,  check EtherDCBptr+5,6 for next IOCB
          nop;                                 ! t3 - can't start the fetch yet
         etherCnt, IOB(E3WrXmtWdCnt);           ! and transfer count
          eXmtStart, IOB(E3WrCSR);               ! start the tran   ioDevTab + etherIntMsk, Fetch;       ! get Interrupt mask
          UserIntr := MDI or UserIntr;         ! Cause Pascal inteDly := MDI;
          etherCmd;                           ! = 0?  Reset
          if Neq GoTo(eStat);
          0, IOB(E3WrCSsmitter
          goto(eRet);
          
eRec:     etherCnt, IOB(E3WrRecWdCnt);           ! setup receive transfer count
   R);                    ! reset the device
          IOB(E3RdNetAddr);                   ! get the net address
          etherT       etherCmd-2;                            ! = 2?  not Promiscuous
          if Neq GoTo(eProm);
          eRecStart, IOB(Emp := IOD;
          TOS := etherTmp and 377, push, NextInst(0);  ! return net address
          
eStat:    etherCmd-1;      3WrCSR);
          goto(eRet);
eProm:    ePromStart, IOB(E3WrCSR);
          goto(eRet);


$Title Ethernet Interrupt Servi                   ! > 1?  Do a transfer
          if Gtr GoTo(eXfr);
eRet:     IOB(E3RdCSR);
          etherTmp := IOD;
   ce

! Ethernet 3MHz Interrupt Service

eIntrServ: IOB(E3RdCSR),loc(E3Int);             ! Ether3 Interrupt Service
               TOS := etherTmp, push, NextInst(0); ! return status from StartIO

eXfr:     Call(ioXLateA);                     ! conve  etherTmp := IOD;                      ! get ether status and save it
          etherCmd-4;
          if Neq GoTo(eRCnt);
  rt ioSeg,ioOffset to
                                              !    ioPhAdrHi, ioPhysAdr
                                         IOB(E3RdXmtWdCnt);
          etherDly := IOD;
          goto(eCnt);
eRCnt:    IOB(E3RdRecWdCnt);
          etherDly        
          etherDCBptr+4, Fetch;                  ! get transfer count
          ioPhysAdr xnor C1777, IOB(E3WrHdrLo); := IOD;          

eCnt:     etherDly := etherDly and 7777;
!          etherCmd := 404;
!          MA := etherCmd, Store2;   ! give buffer addr to DMA controller
          not ioPhAdrHi, IOB(E3WrHdrHi);
          etherCnt := MDI;
          
       
!          MDO := etherDly;                    ! put word count in Post loc
!          MDO := etherTmp;                    !    ! now must add 8 wds & set as buffer address due to hdr/buffer kludge
          ! in DMA controller
          
          iput status in Post loc
!nop;        ! t2  
!nop;        ! t3  -- still can't start another store

          MA := etherDCBptoPhysAdr := ioPhysAdr + 10;
          ioPhAdrHi := ioPhAdrHi + 0 + OldCarry; ! double precision add
          ioPhysAdr xnor Cr+4, Store2;
          MDO := etherDly;                     ! put final word count in IOCB
          MDO := etherTmp;         1777, IOB(E3WrBuffLo);
          not ioPhAdrHi, IOB(E3WrBuffHi);
          
          etherCmd-4;                                        ! put status in IOCB
          0, IOB(E3WrCSR);                     ! t2 --Dismiss Interrupt

          ! someday /  	
 (Tos-Lower+1) = LowerOffset.
!       (Tos-Lower) = LowerSegment.
!
! Result:
!       stack popped twice.
!       (Tos) = W if IntrPend Call(VectSrv);  ! one byte instruction
        tmp7 := UState and 17;               ! save BPC
        BPC := 10,ord0.
!       (Tos-1) = Word1.
!          ...
!       (Tos-Upper+2) = WordUpper-2.
!       (Tos-Upper+1) = Physical address  Call(MakeVictim);         ! make a victim
        tmp2 := tmp1, Field(0,4);            ! set equal depths
        tmp6 := 0, corresponding to the virtual address
!                       (UpperSegment,UpperOffset).  This physical address
!             Dispatch(TltPop);         ! no errors yet

Opcode(STLATE), tmp2 := NextOp;              ! get STLATE parameter
        tmp11           is represented as an offset from stack base.
!       (Tos-Upper) = WordUpper+1.
!       (Tos-Upper-1) = WordUpper+2.:= 2;                          ! two byte instruction
        tmp7 := UState and 17;               ! save BPC
        BPC := 1
!          ...
!       (Tos-Lower+3) = WordLower-2.
!       (Tos-Lower+2) = Physical address corresponding to the virtual ad0, Call(MakeVictim);         ! make a victim
        tmp2 and 360, Field(4,4);            ! select left nibble
        tmp1 :=dress
!                       (LowerSegment,LowerOffset).  This physical address
!                       is represented as an  Shift,                       ! depth of deeper segment
                       if Neq Goto(STLATE1); ! if left nibble is non-zeoffset from stack base.
!
! Calls:
!       VectSrv, SegFault, RefillIndivisible.
!
!---------------------------------------ro
        tmp1 := tmp2, Goto(STLATE2);         ! set equal depths

STLATE1:tmp2 := tmp2 and 17;                 ! depth of s--------------------------------------

!       tmp1 = depth of deeper segment number (left nibble).
!       tmp2 = depth of hallower segment
        if Neq Goto(STLATE2);                ! if right nibble is non-zero
        tmp2 := tmp1;             ates
!       that no translation is to be done, and the maximum depth allowed
!       is 7.  This allows translation of one orshallower segment number (right nibble)--tmp1=tmp2
!              if only one.
!       tmp3 = base address of deeper segment. two virtual addresses
!       which may be deeper in the stack than those translated by
!       TLATE0, TLATE1, and TLATE2.

!       tmp4 = base address of shallower segment.
!       tmp5 = segment number.
!       tmp6 = error flag.
!       tmp7 = s!
! Instruction:
!       STLATE  Lower,,Upper
!
! Environment:
!       (Tos) = Word0.
!       (Tos-1) = Word1.
!         ave BPC.
!       tmp10 = offset.
!       tmp11 = PC backup count.
!       tmp12 = difference of tmp1 and tmp2.

        Con ...
!       (Tos-Upper+2) = WordUpper-2.
!       (Tos-Upper+1) = UpperOffset.
!       (Tos-Upper) = UpperSegment.
!       (stant(TltPop,2200);
        Constant(TltSeg,2202);

Opcode(TLATE0), tmp1 := 1, Goto(TltStart);   ! depth = 1

Opcode(TLATE1Tos-Upper-1) = WordUpper+1.
!       (Tos-Upper-2) = WordUpper+2.
!          ...
!       (Tos-Lower+2) = WordLower-2.
!      ), tmp1 := 2, Goto(TltStart);   ! depth = 2

Opcode(TLATE2), tmp1 := 3, Goto(TltStart);   ! depth = 3

TltStart: tmp11 := 1, / 	
 pieces of code could use them.  Also defined constants
!                 for the locations of the IO TLates.
!
! 16 Apr 81  777, initialized by Perq.Init
Define(C400,254);       ! constant 400, initialized by Perq.Init

Define(Z80State,227);   ! Z801.2  George Robertson
!                 Added 3MHz Ethernet interrupt
!                 Moved IO to 4400-5777.
!
! 10 Apr 81 input state
Define(Z80Status,233);  ! Z80 status flags: IO devices that are ready
Define(Z80WantOutput,243);  ! devices with   1.1  George Robertson
!                 Moved IO to 4000-5777.
!
!  3 Dec 80  1.0  John Strait
!
!-----------------------Z80 output messages pending
Define(Z80OState,241);  ! Z80 output state
Define(dpyTmp,374);     ! video refresh temporary
defi----------------------------------------------------

!        Entry points into this piece of microcode.

Constant(StartIOne(ioSeg,211);      !Common io stuff - Segment Number of a VA
define(ioOffset,212);   !     "            Offset of a VA
define,4400); ! entry point to start an IO operation

Constant(IntVec,5000);  ! interrupt vector address
Constant(Z80IInt,5000); ! (ioPhysAdr,213);  !     "            Physical Address
define(ioPhAdrHi,214);  !     "            High 4 bits of Physical Addresrrupt
          return;

          
                                                                                        Z80 input interrupt
Constant(BadInt1,5004); ! undefined interrupt
Constant(DiskInt,5010); ! hard disk interrupt
Constant(NetI nt,5014);  ! network interrupt
Constant(Z80OInt,5020); ! Z80 output interrupt
Constant(VidInt,5024);  ! video interrupt
Const! IO Definitions.
!-----------------------------------------------------------------------------
!
!       IO.Dfs - QCode Intant(E3Int,5030);   ! 3MHz Ethernet interrupt
Constant(ParInt,5034);  ! memory parity error interrupt


!       Locations of erpreter definitions.
!       Brian Rosen               ca. 1 Jan 80.
!       J. P. Strait       rewritten  3 Dec 80.
!      the IO TLates.   PA is in IOPhysAdr.

Constant(ioTLate, 5040);    ! TLate if a fetch of VA has been done.
Constant(ioTLateB,  Copyright (C) Three Rivers Computer Corporation, 1980.
!
! Abstract:
!       This file provides the register and constant de5044);   ! Entry point if VA is on ESTK.
Constant(ioTLateA, 5050);   ! Entry point if IOSeg and IOOffset are set. 


!      finitions provided
!       by the IO microcode for other microprograms.
!
!-------------------------------------------------- Location of the IO XLates.  PA is in IOPhysAdr (16 bits) and 
!       IOPhAdrHi (4 bits);

Constant(ioXLate, 5054);    ! Ent---------------------------

!--------------------------------------------------------------------------
!
! Change Historyry if fetch of VA has been done.
Constant(ioXLateA, 5060);   ! entry if IOSeg and IOOffset are loaded.

!       NiceRet is a .
!
! 28 Sep 81  1.3  Don Scelza
!                 Moved common definitions from IO.Micro to here so other
!                return that checks for interrupts.

Constant(NiceRet, 5064);



!       Registers.

Define(C1777,253);      ! constant 1 0  	
5), tmpstk5 := Tos, Pop;
Case(TltPop,4), tmpstk4 := Tos, Pop;
Case(TltPop,3), tmpstk3 := Tos, Pop;
Case(TltPop,2), tmpstk2 :=f translation
        BPC := tmp - tmp1, Goto(TltPush);    ! BPC is counter for restoration

TltContinue:Tos := tmpstk1 + tmp Tos, Pop;
Case(TltPop,1), tmpstk1 := Tos and AllOnes, Pop;  ! deeper offset
        tmpstk0 := Tos and AllOnes,          ! de3,           ! translate deeper address
                                   ;!**** if IntrPend Call(VectSrv);

!       Push uneper segment number
                                    if IntrPend Call(VectSrv);
        tmp := 11;
        tmpstk0 + tmpsttil BPC[3].

TltPush:Tos := NextOp BMux tmpstk2, Push, if BPC[3] Call(TltAdd);
        Tos := NextOp BMux tmpstk3, Push, if Bk0, Fetch2;           ! fetch segment table entry
        tmp5 := tmpstk0;                     ! save segment number
        tPC[3] Call(TltAdd);
        Tos := NextOp BMux tmpstk4, Push, if BPC[3] Call(TltAdd);
        Tos := NextOp BMux tmpstk5, Pushmp12 := tmp1,  Call(TltTrans);      ! translate deeper address
        tmp3 := tmp4,                        ! deeper base addre, if BPC[3] Call(TltAdd);
        Tos := NextOp BMux tmpstk6, Push, if BPC[3] Call(TltAdd);
        Tos := NextOp BMux tmpstk7ss
                      if IntrPend Call(VectSrv);
        tmp12 := tmp12 - tmp2, Field(0,4);   ! difference in depths
     , Push, if BPC[3] Call(TltAdd);
        Push;                                ! make an extra push to undo later
                 BPC := tmp - tmp12, Dispatch(TltSeg);  ! BPC is counter for depth diff.

!       Select shallower segment number.

Case(T                               ! (is this right?)
TltDone:BPC := 0, ReviveVictim;              ! undo victim, this transfers toltSeg,6), tmp5 := tmpstk6, Goto(TltShallow);
Case(TltSeg,5), tmp5 := tmpstk5, Goto(TltShallow);
Case(TltSeg,4), tmp5 := tmpstk
                                             ! MakeVictim
MakeVictim: NextOp, if BPC[3] Return;        ! make or undo the vic4, Goto(TltShallow);
Case(TltSeg,3), tmp5 := tmpstk3, Goto(TltShallow);
Case(TltSeg,2), tmp5 := tmpstk2, Goto(TltShallow);
Catim, Return
                                             ! if we're making the victim
        BPC := tmp7,                    se(TltSeg,0), BPC := tmp - tmp1, Goto(TltEnd);  ! only one virtual address

TltShallow: tmp5 := tmp5 and AllOnes;
        tmp     ! restore BPC
                     ;!**** if IntrPend Call(VectSrv);
        tmp6, Pop;                           ! get r5 + tmp5, Fetch2, Call(TltTrans);  ! fetch segment table entry
TltEnd: tmp6;                                ! check error countid of extra push
        if Neq Goto(SegFault);               ! if segment fault
        if BPC[3] Goto(RefillIndivisible);              ! set equal depths
STLATE2:tmp1, Field(0,4);
        tmp6 := 0, Dispatch(TltPop);         ! no errors yet

!     
        if Eql Goto(TltContinue);            ! if no segment faults
        Tos := tmpstk1, Push,                ! restore E-  Pop down to deeper segment number.

Case(TltPop,7), tmpstk7 := Tos, Pop;
Case(TltPop,6), tmpstk6 := Tos, Pop;
Case(TltPop,stack on error
                              if IntrPend Call(VectSrv);
        tmp12 := 0;                          ! turn of 0 	
,
!              and Memory Locations.
!
!       Brian Rosen     27-Dec-79
!       John P. Strait  27-Feb-80   rewritten
!  I/O sequence.
!          - instructions which test C19, Eql, Neq, Gtr, Geq, Lss, Leq,
!            Carry, or OverFlow.
!          Copyright (C) 1979 Three Rivers Computer Corporation
!
!
!       Change history
!
!        5 Oct 81  V1.2  JPS  Chang      - instructions which read the uState.
!          - instructions which use OldCarry.
!          - where S has a value gree to be able to access 16K controlstore and
!                             full memory complement.
!
!       13 Jan 81  V1.1  ater than 7777



!!      registers:

        constant(DataReg,377);
        define(Data,DataReg);   ! the working registJPS  Don't use memory for the display list, ala Vfy.
!
!
!       This code is loaded by boot rom microcode, fed by ODTPRQ.  Ter
        define(IntRtn,376);     ! return number for interrupt service
        define(mAddr,375);      ! memory address
   he Krnl
!       is a special piece of microcode.  It is used to debug other micro-
!       code and thus must coexist with tha     define(VR,374);         ! video refresh temp
        define(Unused373,373);  ! cursor address in IO.Micro
        define(t program.  The Krnl should use
!       as little of the Perq as possible.  When a breakpoint is set in a
!       program, theUnused372,372);  ! address of video command in IO.Micro
        define(Screen,371);     ! screen base div 2
        define(Bre Krnl must try not to destroy the state of that program.
!       The following list describes what parts of the Perq the Krnl uakPnt,370);   ! break point number
        define(tmp,367);        ! temporary register
        define(Command,366);    ! commses.
!
!       1. A piece of micro-code may use the Krnl's screen interrupt
!          handler only if it wishes to ignore aland number
        define(SSv,365);        ! save S register
        define(uStateSv,364);   ! save uState register
        ds
define(ioLen,215);      !     "            Length of a Circular Buffer
define(ioRdPtr,216);    !     "            Read Pointl other interrupts. The
!          interrupt service sequence is:
!               if IntrPend, Call(tag);
!                  er in a Circular Buffer
define(ioWrPtr,217);    !     "            Write Pointer in a Circular Buffer
define(ioTmp,220);           ...
!          tag: Vector(7600);
!
!       2. The Krnl uses registers 357-377 inclusive.
!
!       3. The Krnl uses o!     "            Temporary
define(ioTmp1,261);     !     "            Another Temporary
define(ioChar,221);     !     "     ne level of the call stack.  Thus the user program
!          should not use more than 4 levels of calls.
!
!       4. The Kr       Character out of a Circular Buffer
define(ioDevTab,225);
                                                              nl cannot preserve all of the state of the micro engine.
!          Breakpoints should not be set in the following places:
!  !!!     KRNL - Microcode for use with the PDP-11 link and ODTPRQ
!              to Examine/Deposit MicroInstructions, Registers        - in the middle of a shift sequence.
!          - in the middle of a memory sequence.
!          - in the middle of an 1  	
s to translate:
!                tmp4 = base address.
!                (Tos) = offset.
!                (Tos-1) = segment numwrite middle third
WCS2:   not Tos, Pop;
        WcsLow, if true GotoS(WCS3);         ! write low third
WCS3:   NextInst(0);! if we need a refill
        NextInst(0);                         ! continue at next Q-code


!       Find the base addressber.
!       Result:
!            if no virtual address to translate, exit to TltDone.
!            otherwise:
!             of a segment.
!
!       Environment:
!            Fetch2 of segment table entry in the recent past.
!            tmp5 = seg    Expression stack popped.
!                (Tos) = base address + offset.
!                BPC is counter to push the rest ment number.
!
!       Result:
!            tmp4 = base address if the segment is resident.
!            tmp6 = 1 if the segof the stack.

TltAdd: tmp12;
        tmp12 := 0, if Eql JumpPop(TltDone);  ! if no shallower virtual address
        tmp10 ment is not resident.

TltTrans: Tos := tmp4 := Mdi, Push;          ! lower part of base address
        tmp4 := Mdx or tmp4,:= Tos and AllOnes, Pop,       ! offset
                                       if IntrPend Call(VectSrv);
        BPC := tmp -                 ! full base address
                             if Odd Goto(TltTrans1);  ! if segment not resident
        t tmp2;                   ! counter to push remainder of stk
        Tos := tmp4 + tmp10, Return;         ! base + offset


mp4 := tmp4 and not 377;            ! clear the flags byte
        tmp4 := tmp4 - SB;                   ! bias base address by 

$Title WCS, JCS - Control store operators.

! Opcode WCS.
!--------------------------------------------------------------SB
        tmp5 + tmp5, Store;
        Tos or 4, Pop, Return;               ! set RecentlyUsed in SAT

TltTrans1: tmp6 := 1,---------------
!
! Abstract:
!       WCS is a one byte instruction that writes a single instruction
!       in the control  Pop, Return;           ! indicate segment fault
(*****
TltTrans: tmp4 := Mdi and not 376;           ! lower part of base addrstore.
!
! Instruction:
!       WCS
!
! Environment:
!       (Tos) = Address with bytes swapped.
!       (Tos-1) = High oess
        tmp4 := Mdx or tmp4,                 ! full base address
                             if Odd Goto(TltTrans1);  ! irder microstore.
!       (Tos-2) = Middle order microstore.
!       (Tos-3) = Low order microstore.
!
! Result:
!       Staf segment not resident
        tmp4 := tmp4 - SB, Return;           ! bias base address by SB

TltTrans1: tmp6 := 1, Return; ck popped four times.
!       Controlstore instruction written.
!
!----------------------------------------------------------               ! indicate segment fault
*****)


!       Add base address and offset of shallower virtual address.
!
!    -------------------

Opcode(WCS), Call(LCA);                      ! load control store address
        not Tos, Pop;
          Environment:
!            tmp12 = 0 if no shallower virtual address to translate.
!            if there is a virtual addres WcsHi, if true GotoS(WCS1);          ! write high third
WCS1:   not Tos, Pop;
        WcsMid, if true GotoS(WCS2);         !  1 	
       define(VCount,357);     ! video counter
        define(tmp1,356);       ! temporary
        
        define(R0,0);    interrupt vector
        


        Place(7400,7777);
        
        
!!!     bootstrap entry.

Boot:   LoadOp, Loc(7       ! defined for some dummy locations


!!!     commands:

        constant(FirstCmd,1630);        ! first command numb400);              ! clear boot
        Data := Hello;
        BadInt := not 0;
        Trap := 1;                      ! traer 
!!!     1630: LuA    - load microstore address
!       1631: WuWa   - write microstore word a (low third)
!       1632: Wp bad interrupts
        Screen := 1400;                 ! screen address = 3000
        Disable := 1, Call(Snd);        ! disuWb   - write microstore word b (mid third)
!       1633: WuWc   - write microstore word c (high third)
!       1634: LrA    -able interrupts and send greeting
        Goto(RuS);                      ! enter command loop via RuS
        
        
!!! load register address
!       1635: Wr     - write register
!       1636: Rr     - read register
!       1637: LmA    - load     breakpoint entry.

Break:  uStateSv := uState, Loc(7401);  ! save uState
        SSv := not 0;                   ! save  memory address
!       1640: WmW    - write memory word
!       1641: RmW    - read memory word
!       1642: SuP    - startS register 
Brk1:   IntRtn := 3, Goto(ChkInt);      ! check for interrupts
Int3:   SSv := SSv + 1, Repeat(Brk1);
        Data microprogram
!       1643:        - unused
!       1644: Clr    - clear memory
!       1645: WmB    - write memory block
!  := Hey;
        Call(Snd);                      ! send the breakpoint message
                                        ! fall       1646: WuB    - write microstore block
!       1647: RuS    - reset microprocessor state
        constant(LastCmd,1647); into command loop
        
        
!!!     Cmd - main command loop.

Cmd:    Call(Rcv);                      ! get the com        ! last command number
        

!!      miscellaneous constants:

        constant(Hello,12345);          ! messagemand number
        Command := Data;
uA1:    LoadS(0);                       ! *** this instruction is modified ***
        C to confirm the boot
        constant(Hey,54321);            ! message to get ODTPRQ's attention
        constant(ReadCsr,40);ommand := Command - FirstCmd;
        Command := Command - 1, if Eql Goto(LuA);
        Command := Command - 1, if Eql Goto(Wu           ! IO addr: link input Command/Status
        constant(WriteCsr,241);         ! IO addr: link output Command/Status
Wa);
        Command := Command - 1, if Eql Goto(WuWb);
        Command := Command - 1, if Eql Goto(WuWc);
        Command :=efine(Trap,363);       ! =1 to trap bad interrupts, =0 to ignore them
        define(BadCmd,362);     ! latest bad command
           constant(ReadData,42);          ! IO addr: link read data
        constant(WriteData,243);        ! IO addr: link write     define(BadInt,361);     ! latest bad interrupt
        define(Disable,360);    ! =1 to disable interrupts, =0 to enable
  data
        constant(XbufCyc,2);            ! Bit for "He wrote to me"
        constant(IntVec,7600);          ! address of  2  	
ne number.
!       The handler must be nested immediately inside the current routine,
!       must be in the same code segment, Pop, NextInst(0);           ! NewEP

!       Stack overflow.

ENABLE1: tmp11 := 5, Pop;                    ! instruction i as the current routine, and may not
!       be a function.  None of these is checked by the ENABLE instruction.
!
! Instructs 5 bytes
        TP := tmp4, Goto(StkOv);

! Opcode QRAISE.
!-------------------------------------------------------------ion:
!       ENABLE LowByteExceptionISN HighByteExceptionISN ExceptionRN
!              HandlerRN.
!
! Environment:
!      ----------------
!
! Abstract:
!       QRAISE is a six byte instruction which raises an exception.
!
! Instruction:
!      Memory[AP + ACBEP] = OldEP.
!
! Result:
!       Four words pushed, quad-aligned, onto the memory stack.
!       Memory[TP -  QRAISE  LowByteExceptionISN HighByteExceptionISN ExceptionRN
!               LowByteParameterSize HighByteParameterSize
!
!

! Opcode JCS.
!-----------------------------------------------------------------------------
!
! Abstract:
!       JCS i 3 + EEBES] = ExceptionSSN.
!       Memory[TP - 3 + EEBER] = ExceptionRN.
!       Memory[TP - 3 + EEBHR] = HandlerRN.
!      s a one byte instruction that jumps to some location in the
!       controlstore.  A routine called with JCS should exit via a Memory[TP - 3 + EEBNE] = OldEP.
!       Memory[AP + ACBEP]  = NewEP = TP - 3.
!
! Calls:
!       WordParm, XSTMap, StkOv.

!       NextInst jump.
!
! Instruction:
!       JCS
!
! Environment:
!       (Tos) = Address with bytes swapped.
!
! Re!
!-----------------------------------------------------------------------------

Opcode(ENABLE), tmp4 := TP, Call(WordParm);sult:
!       Stack popped.
!
! Calls:
!       Specified address.
!
!-----------------------------------------------------
        tmp := Shift + tmp;                  ! ExceptionISN
        TP := TP + 4, if Geq Call(XSTMap);   ! if not "ALL"
    ------------------------

Opcode(JCS), Call(LCA);                      ! load control store address
        GotoS;               TP := TP and not 3;
        tmp1 := NextOp;                      ! ExceptionRN
        tmp2 := NextOp;                                        ! enter control store




$Title ENABLE, QRAISE - Exception handling and raising.

! Opcode ENABLE.  ! HandlerRN
        AP + ACBEP, Fetch;
        Tos := TP := TP + 3, Push;           ! push 4 and quad-align
        SL - TP
!-----------------------------------------------------------------------------
!
! Abstract:
!       ENABLE is a six byte in;
        tmp3 := Mdi, if C19 Goto(ENABLE1);   ! OldEP
        TP - 3, Store4;
        tmp;                                 !struction which enables an exception handler.
!       The exception is identified by an internal segment number and a
!        ExceptionISN
        tmp1;                                ! ExceptionRN
        tmp2;                                ! Handleroutine number.  A negative segment number indicates a handler of
!       all exceptions.  The handler is identified by a routirRN
        tmp3;                                ! OldEP
        Tos := Tos - SB;
        AP + ACBEP, Store;
        Tos - 3 2 	
   1 lsh 10#4 +       ! F
                     7);                ! SF
        tmp1 := tmp1 and 377;           ! X = 0
      S(rA2);
        Data and 377;                   ! Y = inverted register number
                                        ! X = n Command - 1, if Eql Goto(LrA);
        Command := Command - 1, if Eql Goto(Wr);
        Command := Command - 1, if Eql Goto(R  tmp1 := not tmp1, Goto(LuA2);

!       For lower bank:
!         X   = 0.
!         Y   = 0.
!         A   = 0.
!       r);
        Command := Command - 1, if Eql Goto(LmA);
        Command := Command - 1, if Eql Goto(WmW);
        Command := Co  B   = 0.
!         Alu = 0.
!         W   = 0.
!         H   = 0.
!         F   = 3.
!         SF  = Address rsh 10#8
! mmand - 1, if Eql Goto(RmW);
        Command := Command - 1, if Eql Goto(SuP);
        Command := Command - 1, if Eql Goto(Cmd        Z   = Address and 377.
!         Cnd = 0.    (True)
!         Jmp = 14.   (LoadS)
!     or  Jmp = 3.    (Goto)

LuA1);
        Command := Command - 1, if Eql Goto(Clr);
        Command := Command - 1, if Eql Goto(WmB);
        Command := Co1:   tmp := tmp or not 17;           ! Jmp is inserted later
        tmp := tmp and not (3 lsh 4);
        tmp1 := not 0;

Lmmand - 1, if Eql Goto(WuB);
Cmd1:   BadCmd := Data,         if Eql Goto(RuS);
        BreakPnt := 10#30, Goto(7401);  ! mark uA2:   Data := Data or 377;
        Data, LoadS(uA1);
        WcsLow, if true GotoS(LuA3);
LuA3:   tmp and not (14 lsh 10#8);bad command and issue breakpoint
        
        
        
        
!!      command routines.
        



!!!     LuA      ! Jmp = 14
        WcsMid, if True GotoS(LuA4);
LuA4:   tmp1;
        WcsHi, if True GotoS(LuA5);
LuA5:   Data, LoadS( - load microstore address.

LuA:    Call(Rcv);                      ! get address with bytes swapped
        Data and 360;
uA2);
        WcsLow, if true GotoS(LuA6);
LuA6:   tmp and not (3 lsh 10#8);       ! Jmp = 3
        WcsMid, if True GotoS(Lu        tmp := Data, if Eql Goto(LuA1); ! if in lower bank

!       For upper banks:
!         X   = 0.
!         Y   = AddrA7);
LuA7:   tmp1;
        WcsHi, if True GotoS(Cmd);
        
        
!!!     WuWa - write microstore a (low third).  Musess rsh 10#8.
!         A   = 0.
!         B   = 0.
!         Alu = 0.
!         W   = 0.
!         H   = 0.
!         F  t be preceded by a LuA.

WuWa:   Call(Rcv);
        WcsLow, if true GotoS(Cmd);
        
        
!!!     WuWb - write mic = 1.
!         SF  = 7.    (Leap)
!         Z   = Address and 377.
!         Cnd = 0.    (True)
!         Jmp = 14.   (Loadrostore a (mid third).  Must be preceded by a LuA.

WuWb:   Call(Rcv);
        WcsMid, if true GotoS(Cmd);
        
       S)
!     or  Jmp = 3.    (Goto)

        tmp := not ( 0 lsh 10#12 +      ! Cnd
                     0 lsh 10#8 +       ! Jmp 
!!!     WuWc - write microstore a (high third).  Must be preceded by a LuA.

WuWc:   Call(Rcv);
        WcsHi, if true Got is inserted later
                     0 lsh 10#7 +       ! B
                     0 lsh 10#6 +       ! H
                  oS(Cmd);
        
        
!!!     LrA - load register address.
        
LrA:    Call(Rcv);
        Data := not Data, Load 3  	
Pascal level
!       interrupts.
!
! Instruction:
!       INTON
!
! Result:
!       Interrupts-off bit (bit 15) cleared i Dispatch(StartIO);




$Title RASTOP, LINE - Raster-op and line-draw.

! Opcode RASTOP.
!-----------------------------n UserIntr.
!
!-----------------------------------------------------------------------------

Opcode(INTON), UserIntr := Use------------------------------------------------
!
! Abstract:
!       RASTOP is a one byte instruction that performs a RasterIntr and 77777;
        NextInst(0);

! Opcode INTOFF.
!------------------------------------------------------------------r-Op memory
!       operation.  See the RO microcode for complete documentation.
!
! Instruction:
!       RASTOP
!
! Calls-----------
!
! Abstract:
!       INTOFF is a one byte instruction that turns off Pascal level
!       interrupts.
!
! Ins:
!       RO microcode.
!
!-----------------------------------------------------------------------------

Opcode(RASTOP), Gtruction:
!       INTOFF
!
! Result:
!       Interrupts-off bit (bit 15) set in UserIntr.
!
!-----------------------------oto(RasterOp);

! Opcode LINE.
!-----------------------------------------------------------------------------
!
! Abstract------------------------------------------------

Opcode(INTOFF), UserIntr := UserIntr or 100000;
        NextInst(0);

! :
!       LINE is a one byte instruction that draws lines.  See the Line
!       microcode for complete documentation.
!
! IOpcode STRTIO.
!-----------------------------------------------------------------------------
!
! Abstract:
!       STRTIO instruction:
!       LINE
!
! Calls:
!       Line microcode.
!
!----------------------------------------------------------- Calls:
!       ErrCall, WordParm, XSTMap.
!
!-----------------------------------------------------------------------------
s a one-byte instruction that is used to initiate some I/O
!       operation.  A device number is on the top of the expression 
Opcode(QRAISE), Call(WordParm);
        tmp := Shift + tmp;                  ! ExceptionISN
        if Geq Call(XSTMap);    stack,
!       and the action is device dependant.  Device numbers of the form
!       x * 40 + 20 are reserved for Pascal pro             ! if not "ALL"
        tmp2 := NextOp;                      ! ExceptionRN
        tmp4 := tmp, Call(WordParm);   grams to request special
!       actions of the Perq interpreter microcode.  For more documentation,!
!       see the IO micro      ! ExceptionSSN
        tmp3 := Shift + tmp;                 ! ParameterSize
        tmp1 := tmp4, Goto(ErrCall);        code and the SSLR routine.
!
! Instruction:
!       STARTIO
!
! Environment:
!       (Tos) = Device number.
!
! Result: ! ExceptionSSN




$Title INTON, INTOFF, STRTIO - Input/output and interrupts.

! Opcode INTON.
!---------------------
!       Stack popped.
!       Device dependant action performed.
!
! Calls:
!       IO microcode.
!
!----------------------------------------------------------------------------
!
! Abstract:
!       INTON is a one byte instruction that turns on ---------------------------------------------------------

Opcode(STRTIO), tmp := Tos, Pop;
        tmp, Field(0,4);
        3 	

        Data := Data and 37, if Eql Goto(Cmd);  ! if address < 2^16
        tmp := 100000;
        tmp := tmp + tmp;
LmA1:  1;
        not tmp,  Store;
        0;                              ! store a zero
        tmp, Store;
        0, if Neq Go  Data := Data - 1;               ! add upper 4 bits of address
        mAddr := mAddr + tmp, if Gtr Goto(LmA1);
        Goto(to(Clr1);           ! store another zero
        Goto(Cmd);
        
        
!!!     WmB - write memory block.  Write 256 wCmd);


!!!     WmW - write memory word.  Must be preceded with a LmA.
      
WmW:    Call(Rcv);
        MA := mAddr, storords into memory starting
!                                  at mAddr.  Must be preceded by a LmA.

WmB:    mAddr := mAddr - e;             ! store the word
        MDO := Data, Goto(Cmd);
        
        
!!!     RmW - read memory word.  Must be p1, LoadS(377);
WmB1:   Call(Rcv);                      ! get a word
        mAddr := mAddr + 1, Store;      ! and stuff it intot 377    (DataReg)
        WCShi, if true GotoS(LrA1);
LrA1:   Data and not 377, LoadS(rA1);   ! X = inverted register numberreceded with a LmA command.
        
RmW:    MA := mAddr, Fetch;             ! fetch the word from memory
        Data := MDI
                                        ! Y = not 377    (DataReg)
        WCShi, if true GotoS(LrA2);
LrA2:   Data and 377,;
        Call(Snd);                      ! send the memory word
        Goto(Cmd);
        

!!!     SuP - start micro pro LoadS(rA3);       ! Y = inverted register number
                                        ! X = not 377    (DataReg)
        Wgram.  Must be preceded with a LuA command.

SuP:    IntRtn := 200, LoadS(7);        ! flag interrupt calls as user calls
SuPCShi, if true GoToS(Cmd);
        
     
!!!     Wr - write register.  Must be preceded by a LrA.
        
Wr:     Call(Rcv1:   SSv + SSv;                      ! swap bytes without using the shifter
        SSv := SSv + SSv + OldCarry, Repeat(SuP1););
rA1:    R0 := Data;                     ! *** this instruction is modified ***
        Goto(Cmd);
        
        
!!! 
        SSv or 377, LoadS(SuP3);        ! get ready to modify LoadS instruction
        WcsLow, if true GotoS(SuP2);    ! Z =     Rr - read register - must be preceded with a LrA command.

Rr:
rA2:    Data := R0;                     ! *** this instruclow part of SSv
SuP2:   SSv := SSv or not 17;
        SSv and not 6060;
        WcsMid, if true GotoS(SuP3);    ! SF = high ption is modified ***
        Call(Snd);                      ! send the register value
        Call(Rcv);
rA3:    Data := UStart of SSv
SuP3:   LoadS(0);                       ! *** this instruction is modified ***
uA2:    Goto(0);                    ate;                 ! **** this instruction is modified ***
        Call(Snd);                      !Send the xtra 4 bits
       ! *** this instruction is modified ***
        

!!!     Clr - clear memory from 0 - 377777 inclusive.
        
Clr:        Goto(Cmd);
        
        
!!!     LmA - load memory address.

LmA:    Call(Rcv);
        mAddr := Data, Call(Rcv); tmp := 100000;
        tmp := tmp + tmp;
Clr1:   IntRtn := 2, Goto(ChkInt);      ! check for interrupts
Int2:   tmp := tmp - 4  	
-------------------------------

Opcode(PSW), Goto(UOP);

! Opcode PBLK.
!------------------------------------------------= AP - SB, Push, NextInst(0);

! Opcode INCDDS.
!--------------------------------------------------------------------------------------------------------
!
! Abstract:
!       PBLK is the unimplemented process block instruction.
!
! Instruction:
--
!
! Abstract:
!       INCDDS is a one byte instruction that increments the diagnostic
!       display (DDS).  Since incre!       PBLK
!
! Calls:
!       UOP.
!
!-----------------------------------------------------------------------------

Opmenting the diagnostic display has the
!       size effect of resetting the E-stack, the E-stack is checked to be
!       surecode(PBLK), Goto(UOP);




$Title NOOP, LSSN, LDAP, INCDDS, BREAK - Miscellaneous.

! Opcode NOOP.
!------------------- it is already empty.  If it isn't, an ErrEStk is generated.
!
! Instruction:
!       INCDDS
!
! Result:
!       Diagnosti----------------------------------------------------------
!
! Abstract:
!       NOOP is a one byte no-operation instruction.c display incremented.
!
! Calls:
!       RunError0.
!
! Side affects:
!       The expression stack is cleared.
!
!-----
!
! Instruction:
!       NOOP
!
!-----------------------------------------------------------------------------
       
O------------------------------------------------------------------------

Opcode(INCDDS), UState and 1000;
        if Neq Gotpcode(NOOP), NextInst(0);

! Opcode LSSN.
!-----------------------------------------------------------------------------
!o(INCDDS1);                ! if E-stack not empty
        StackReset, Nextinst(0);             ! increment the DDS

INCDDS1: 
! Abstract:
!       LSSN is a one byte instruction that loads the segment number of the
!       memory stack onto the expresstmp2 := ErrEStk, Goto(RunError0);

! Opcode BREAK.
!------------------------------------------------------------------------ion stack.
!
! Instruction:
!       LSSN
!
! Result:
!       Stack pushed.
!       (Tos) = SS.
!
!--------------------------
!
! Abstract:
!       BREAK is a one byte instruction that is used for a Q-code level
!       breakpoint to the Krnl.--------------------------------------------------------

Opcode(LSSN), Tos := SS, Push, NextInst(0);

! Opcode LDAP.
!---
!
! Instruction:
!       BREAK
!
! Result:
!       BrkReg = UPC.
!
! Calls:
!       Krnl.
!
!------------------------------------------

Opcode(LINE), Goto(DrawLine);




$Title PSW, PBLK - Process management.

! Opcode PSW.
!----------------------------------------------------------------------------------
!
! Abstract:
!       LDAP is a one byte instructi---------------------------------------------------------------------
!
! Abstract:
!       PSW is the unimplemented process on that loads the current activation
!       pointer.
!
! Instruction:
!       LDAP
!
! Result:
!       Stack pushed.
! swap instruction.
!
! Instruction:
!       PSW
!
! Calls:
!       UOP.
!
!----------------------------------------------      (Tos) = AP - SB.
!
!-----------------------------------------------------------------------------

Opcode(LDAP), Tos : 4 	
   3. turn off disk.
!             4. initialize screen.
!             5. clear E-stack.

RuS:    ThreeWayBranch(0);            4, Iob(WriteCsr);               ! set data ready pulse
        tmp := 20;
Snd1:   tmp := tmp - 1, if Neq Goto(Snd1);
          ! clear call stack
        ThreeWayBranch(0);
        ThreeWayBranch(0);
        ThreeWayBranch(0);
        ThreeWayBr    5, Iob(WriteCsr), Return;       ! clear data ready pulse
        
        
!!      ChkInt - check for interrupts.  Callinanch(0);
        CntlRasterOp(0);                ! turn RasterOp off
        200, IOB(301);                  ! turn disk & Z80g sequence:
!                       IntRnt := x, Goto(ChkInt);
!                Intx:  ...

ChkInt: Disable and 1;
         off
        0,IOB(307);                     ! turn off Z80 Output interrupts
        VR := 101154;                   ! next cif Neq Goto(IntX);              ! if interrupts are disabled
Int:    Iob(145);                       ! read video state
      ommand: first vertical retrace
        VCount := 0;                    ! starting vertical retrace
        IntRtn := 0, Goto(V  Iod and 20;                     ! pick video interrupt bit
        if Neq goto(VidInt);            ! if video interrupt
IntXidInt);      ! start the display
Int0:   StackReset, Goto(Cmd);          ! clear E-stack




!!      subroutines.



 :   IntRtn and 200;
        IntRtn, if Neq Return;          ! if called from user program
        IntRtn := IntRtn - 1, if Eql       
!!      Rcv - wait to receive data from PDP-11.
!             The word received is left in Data and on the R bus for t Goto(Int0);
        IntRtn := IntRtn - 1, if Eql Goto(Int1);
        IntRtn := IntRtn - 1, if Eql Goto(Int2);
              o memory
        Data, Repeat(WmB1);
        Goto(Cmd);
        
        
!!!     WuB - write microstore block.  Write micrhose
!             who follow the Call(Rcv) with a use of the R bus.

Rcv:    IntRtn := 1, Goto(ChkInt);      ! allow interruostore from 3777 to 0
!                                      inclusive.  Must be preceded by
!                                pts
Int1:   Iob(ReadCsr);                   ! check the receiver status
        Iod and XBufCyc;
        if Eql Goto(Rcv);         a LuA.

WuB:    LoadS(3777);
WuB1:   Call(Rcv);
        WcsLow, if true GotoS(WuB2);    ! write low third
WuB2:   Cal            ! if no data
        15, Iob(WriteCsr);              ! clear Xmit done of PDP-11
        Iob(ReadData);           l(Rcv);
        WcsMid, if true GotoS(WuB3);    ! write middle third
WuB3:   Call(Rcv);
        WcsHi, if true GotoS(WuB4);         ! request the data
        Data := Iod;                    ! read the data
        5, Iob(WriteCsr);               ! se   ! write high third
WuB4:   Repeat(WuB1);                   ! continue with next word
        Goto(Cmd);
        
        t Xmit done of PDP-11
        Data, Return;                   ! place data on R
        
        
!!      Snd - send data to
!!!     RuS - reset microprocessor state.
!             1. clear call stack.
!             2. turn off RasterOp
!           PDP-11.
!             The word to be sent is passed in Data.

Snd:    Data, Iob(WriteData);           ! write the data
     5  	
-----------------------------------------------------

Opcode(BREAK), BrkReg := UPC, Goto(7401);    ! cause a breakpoint
$Titnegative numbers correctly.
!
!  9 Sep 81  John Strait
!            Fix bug in CVTLI--not checking properly for overflow.
! le UNDFxxx - Undefined Q-Codes.

! Opcode Undefined.
!----------------------------------------------------------------------           Get rid of extraneous instruction in long ABS.
!            Make full use of hardware double precision subtract.
!-------
!
! Abstract:
!       These are the undefined Q-codes.  They cause an ErrUndfQcd error.
!
! Calls:
!       UOP.
!
! 31 Aug 81  John Strait
!            Fixed more bugs in multiply and divide.
!
! 22 Apr 81  George Robertson
!            
!-----------------------------------------------------------------------------

Opcode(UNDF198), Goto(UOP);
Opcode(UNDF199)Fixed bugs in multiply and divide setup.
!
! 21 Apr 81  Bernd Bruegge & Horst Mauersberg
!            Redefined multiply and , Goto(UOP);
Opcode(UNDF245), Goto(UOP);
Opcode(UNDF246), Goto(UOP);
Opcode(UNDF247), Goto(UOP);
Opcode(UNDF248), Goto(UOP);divide.
!
! 20 Apr 81  George Robertson
!            Fixed bugs in inequality comparisons.
!            Fixed bug in remaind
Opcode(UNDF249), Goto(UOP);
Opcode(UNDF45), Goto(UOP);
Opcode(UNDF46), Goto(UOP);
Opcode(UNDF47), Goto(UOP);
Opcode(UNDF48er result of LDIVIDE.
!
!
! 17 Apr 81  Bernd Bruegge & George Robertson
!            Fixed bug in LDIVIDE.
!            Cha), Goto(UOP);
Opcode(UNDF49), Goto(UOP);
Opcode(UNDF50), Goto(UOP);
Opcode(UNDF79), Goto(UOP);
Opcode(UNDF80), Goto(UOP);
Onged form of dispatch to Spice kernel ops.
!
!  9 Apr 81  George Robertson
!            Converted for latest version of interpcode(UNDF81), Goto(UOP);
Opcode(UNDF82), Goto(UOP);
Opcode(UNDF83), Goto(UOP);
Opcode(UNDF84), Goto(UOP);
Opcode(UNDF85), Gpreter.
!            Converted to two byte opcodes.
!            Added interrupt check to multiple and divide loops.
!
! 11 oto(UOP);
Opcode(UNDF86), Goto(UOP);
Opcode(UNDF87), Goto(UOP);
                                                             Mar 81  Bernd Bruegge
!            Changed opcode for ABSLong.
!
!  8 Mar 81  Bernd Bruegge & Horst Mauersberg
!             Defined.

! Opcode LOPS
!---------------------------------------------------------------------
!
! Abstract:
!       LOPS  is a two byte opcode for performing arithemetic
!       operations on long (32 bit) values.  The second byte is used
!        as a dispatch into the 15 operations.
!
! Instruction:
!       LOPS
!
! Environment:
!       In general, long operations t$Title Double precision arithmetic operators.

!  3 Jan 82  Michael Kristofic
!            Fix bug in CVTLI -- not returning ake their arguments from the EStack
!       with the low-order word on top:
!           (Tos) = low word of long
!            5 	
errupt


!!      parity interrupt service.

ParInt: Iob(147), Loc(7634);
        Goto(IntX);                     ! dismiss  parity interrupt


!!      video interrupt service.

VidInt: VR, Iob(343), Loc(7624);        ! load VidState
        VR,  Iob(340);                   ! load line count
Vid1:   0, Iob(342);                    ! load cursor address
        VR and 200$Title IO.Micro - Perq I/O microcode.
! IO Microcode.
!-----------------------------------------------------------------------;
        if Eql Goto(Vid2);              ! if we didn't load second retrace
        Screen, Iob(341);               ! address------
!
!       IO.Micro - Perq I/O microcode.
!       Brian Rosen      ca. 1 Jan 80.
!       J. P. Strait        14 Feb 81 of screen bit map div 2
        0, Iob(344);                    ! load cursor X value
        VCount := 11;
Vid2:   VR := 10.   Cleaned-up.
!       Copyright (C) Three Rivers Computer Corporation, 1980, 1981.
!
! Abstract:
!   This file provides th2000;                   ! next command: display normal
        VCount := VCount - 1;
        if Gtr Goto(IntX);              !e IO microcode for the standard PERQ system.
!
!----------------------------------------------------------------------------- if not end of screen
        VR := 101154;                   ! next command: first vertical retrace
        VCount;
        

!---------------------------------------------------------------------------
!
! Change History
!
! 29 Jan 82  V1.10 WJHif Eql Goto(IntX);              ! if end of screen
        VR := 101351;                   ! next command: second vertical retransen
!     Increment DDS during device table initialization
!
! 16 Nov 81  V1.9  Don Scelza (John Strait)
!     Put in Johnace
        Goto(IntX);
        
!!      bad interrupt service.

        BadInt := 04, Goto(Bad1), Loc(7604);
        BadI's changes for the MegaByte memory.  VidInt
!
! 28 Sep 81  V1.8  Don Scelza
!     Took useful definitions from IO.Micro and mnt := 14, Goto(Bad1), Loc(7614);
        BadInt := 20, Goto(Bad1), Loc(7620);
        BadInt := 30, Goto(Bad1), Loc(7630);
Baoved them to IO.DFS.
!     Also defined the locations of the IOTLates and IOXLates.
!
! 16 Apr 81  V1.7  George Robertson, Ge                if Eql Goto(Int3);
        BreakPnt := 10#31, Goto(7401);  ! if unknown caller, restart everything



!!   d1:   Trap and 1;
        if Eql Goto(IntX);              ! if not trapping bad interrupts
        BreakPnt := 10#32, Goto(740   Z80 interrupt service.

Z80Int: Iob(106), Loc(7600);
        Goto(IntX);                     ! dismiss Z80 interrupt


1);  ! inform ODTPrq of bad interrupt
        
        
        
        
        
        end;
                         !!      disk interrupt service.

DskInt: 200, Iob(301), Loc(7610);
        Goto(IntX);                     ! dismiss disk int  6  	
IT: NextInst(0);                

! Opcode CVTIL
!---------------------------------------------------------------------
!
Long, GTRLong
!---------------------------------------------------------------------
!
! Abstract:
!       The xxxLong opcod! Abstract:
!       CVTIL is a two byte instruction that converts an integer to a long.
!
! Instruction:
!       LOPS-CVTILes are two byte instructions that compare two long
!       values in the expression stack for equality and/or order.
!
! Inst
!
! Environment:
!       (Tos) = integer
!
! Result:
!       (Tos) = low word of Long
!       (Tos-1) = high word of Longruction:
!       LOPS-xxxLong
!
! Environment:
!       (Tos) = low word of Long1
!       (Tos-1) = high word of Long1  (B)(Tos-1) = high word of long
!
!---------------------------------------------------------------------

Opcode(LOPS), tmp := N
!
!---------------------------------------------------------------------

Case(LongOps,CVTIL), blow := TOS and AllOnes;
  extOp;
        tmp, Field(0,4);
        Dispatch(LongOps); 

! Opcode CVTLI
!---------------------------------------------      TOS := 0, if geq goto (CVTILEXIT);       ! positive?
        TOS := ALLONES;                          ! no, signextend
C------------------------
!
! Abstract:
!       CVTLI is a two byte instruction that converts a long to an integer.
!
! InstVTILEXIT:
        TOS := blow, push, NextInst(0);          ! push sign, then value

! Opcode ABL, NGL
!--------------------ruction:
!       LOPS-CVTLI
!
! Environment:
!       (Tos) = low word of Long
!       (Tos-1) = high word of Long
!
! Res-------------------------------------------------
!
! Abstract:
!       ABL and NGL are two byte instructions that return absult:
!       (Tos) = low word of Long
!
! Errors:
!       ErrCVTLI is generated if there is an overflow converting long
!  olute value
!       or negation of a long value.
!
! Instruction:
!       LOPS-ABL, LOPS-NGL
!
! Environment:
!       (To     to integer.  There is no overflow if
!
!            ((low >= 0) and (high = 0)) or
!            ((low < 0)  and (high = s) = low word of Long
!       (Tos-1) = high word of Long
!
! Result:
!       (Tos) = low word of Long
!       (Tos-1) = hi-1))
!
!       otherwise there is an overflow.
!
!---------------------------------------------------------------------

Cgh word of Long
!
!---------------------------------------------------------------------

Case(LongOps,ABL), blow := not TOSase(LongOps,CVTLI), blow := TOS, pop;       ! save low 
        bhigh := TOS, if lss Goto(CVTLI1);   ! if low < 0
        TOS , pop;
        bhigh := not TOS;
        if Lss goto(ABSPUSH);
ABSLONGa:
        blow := blow + 1;
        TOS := bhigh + 0:= blow, if eql goto(CVTLIEXIT); ! if (low >= 0) and (high = 0)
CVTLIERROR:
        tmp2 := ErrOvflLI, goto(RunError0);  ! rai + OldCarry;
        TOS := blow, push, NextInst(0);

ABSPUSH:
        TOS := not blow, push, NextInst(0);




Case(Lonse OvflLI

CVTLI1: bhigh xor ALLONES;
        TOS := blow, if neq goto (CVTLIERROR); ! if (low < 0) and (high <> -1)
CVTLIEXgOps,NGL), blow := not TOS, pop;
        bhigh := not TOS, goto(ABSLONGa);

! Opcode EQULong, NEQLong, LEQLong, LESLong, GEQ 6 	
ne Ball
!     Added support for 3MHz Ethernet
!
! 10 Apr 81  V1.6  George Robertson
!     Moved IO to 4400-5777.
!
! 31 Ma!1 if code running from interrupt, 0 if from Qcode
define(ioKbdCb,222);
define(ioRsInCb,223);
define(ioRsOutCb,224);
define(r 81  V1.5  George Robertson
!     Moved time base from clock to video refresh.
!
!  6 May 81  V1.4  John Strait.
! 1. Renamio488InCb,266);

define(Z80Chr, 226);    ! Last character received from Z80
define(Z80Buff,230);    ! Adr of ChrCtlBlk for ace dskTrack to dskCyl.
! 2. Change the StartIO that tells the microcode what cylinder the heads are
!    on to read the cylindetive device
define(Z80Tmp,231);
define(Z80Byte,257);    !Bit 0 = input hi/lo byte indicator, bit 7 is for output
define(Z80Byr number from the E-Stack.  This allows recalibrate
!    code to set the current cylinder number to MaxCylinder (201 decimal) teCnt,232); !Byte count for Z80 data coming in

define(Z80OData,235);
define(Z80Otmp,236);
define(Z80OBytCnt,237);
define(Z
!    before starting.
! 3. Don't initialize dskCyls in IO initialization--let the Pascal code do it.
!
! 14 Mar 81  V1.3  Jo80OAdr,240);

define(Z80FloppyDcb,242);
define(Z80RsoTmp, 243);
define(Z80OtmpState,244);
define(Z80SpchAdr,245);
define(Zhn Strait.
! 1. Fixed another bug or two in multi-sector transfers.
! 2. Added stuff for exceptions.
!
! 14 Feb 81  V1.2  Jo80SpchCnt,246);
define(Z80488Adr,263);
define(Z80488Cnt,264);
define(Z80488Cmd,265);
define(Z80StateAdr,247);
define(Z80Stahn Strait.
! 1. Cleaned-up the code a little bit.
! 2. Fixed a couple bugs in multi-sector disk transfers.
! 3. Fixed a bug iteType,250);
define(Z80Restart,251);
define(Z80VIntr,256);
define(Z80OVintr,260);
define(ioTabAdr,252);   ! Address of Tablen Video interrupt service.
!
! 9 Sep 80  V1.1  John Strait.
! Fix bug in speech out: not clearing bit in Z80Status.
!
!----t Words
define(dpyCntlBlk,255); !Address of Display Control Block
define(Z80FlpAdr,262);
define(dpyCm,372);      !Pointer to -----------------------------------------------------------------------

$Include IO.Dfs
$Include Perq.Dfs




        current Video command

define(dpyCBase,373);   !Base address of Cursor Pattern

define(ClkTim1,276);    ! Low order 60 Hz. cDecimal;
$Include Except.Dfs
        Octal;




$Title Register definitions.

define(r370,370);
define(dskTmp,200);
lock
define(ClkTim2,277);    ! High order 60 Hz. clock


{Ether3MBaud not assembled.

!*** NOTE:  IOE3.Micro is included ldefine(dskDCBptr,201);  !Pointer to the DCB we are working on
define(dskCMD,202);     !The command we are doing
define(dskAddrater and has register definitions for
!           the 3MHz Ethernet support.

 Ether3MBaud not assembled.}



$Title Cons,203);    !the Disk Address we are doing it to
define(dskCyl,204);   !Where the disk heads are now
define(dskSeek,205);    !hotant definitions.

constant(dskStat,100);  !io address of Status Register
constant(dskCntl,301);  !io address of Command/Conw many tracks to seek, known to Z80 microcode
define(dskNumSec,206);  !How many sectors to transfer
define(dskIntrLevel,207); trol Register
constant(dskHead,302);  !io address of Head Number Register
constant(dskCylSec,310);!io address of Cylinder/Sect 7  	
**}
 


EQLong:
Case(LongOps,EQULong), call(LongCmp);
        if Eql Goto(SetTrue);
        TOS := 0, NextInst(0);

NEL  tmp := TOS and AllOnes, pop;              ! b<low>
        tmp1 := TOS and AllOnes, pop;             ! b<high>
        tmp2 ong:
Case(LongOps,NEQLong), call(LongCmp);
        if Neq Goto(SetTrue);
        TOS := 0, NextInst(0);

Case(LongOps,LEQLo:= TOS - tmp, pop;                   ! a<low> - b<low>
        TOS := TOS - tmp1 - oldcarry, Return;     ! a<high> - b<high>
ng), Call(LongCmp);
        if Leq goto(SetTrue);   
        TOS := 0, NextInst(0);

Case(LongOps,LESLong), CALL(LongCmp);

! Opcode MPL, DVL, MODL
!---------------------------------------------------------------------
!
! Abstract:
!       The M        if Lss goto(SetTrue);
        TOS := 0, NextInst(0);

Case(LongOps,GEQLong), CALL(LongCmp);
        if Geq goto(SetTPL, DVL, and MODL opcodes are two byte instructions that
!       multiply, divide, or mod two long values in the expression starue);   
        TOS := 0, NextInst(0);

Case(LongOps,GTRLong), CALL(LongCmp);
        if Gtr goto(SetTrue);   
        TOSck.
!
! Instruction:
!       LOPS-MPL, LOPS-DVL, LOPS-MODL
!
! Environment:
!       (Tos) = low word of Long1
!       (To := 0, NextInst(0);

! Opcode ADL, SBL
!---------------------------------------------------------------------
!
! Abstracts-1) = high word of Long1
!       (Tos-2) = low word of Long0
!       (Tos-3) = high word of Long0
!
! Result:
!       Stac
!       (Tos-2) = low word of Long0
!       (Tos-3) = high word of Long0  (A)
!
! Result:
!       Stack popped.
!       (T:
!       The ADL/SBL opcodes are two byte instructions that add or
!       subtract two long values in the expression stack.os) = Long0 xxx Long1
!
! Calls:
!       SetFalse, LSSUB
!
!---------------------------------------------------------------
!
! Instruction:
!       LOPS-ADL, LOPS-SBL
!
! Environment:
!       (Tos) = low word of Long1
!       (Tos-1) = high wor------

LongCmp: BLow := Tos, Pop; 
        BHigh := Tos, Pop;
        ALow := Tos, Pop;
        ALow - BLow;
        Tos d of Long1
!       (Tos-2) = low word of Long0
!       (Tos-3) = high word of Long0
!
! Result:
!       Stack popped.
!   - BHigh - OldCarry, if Eql Goto(LC1);
        not 0, if Lss Return;
        1, Return;
   
LC1:    ALow - BLow, if Lss Goto(    (Tos) = low word of result Long0 xxx Long1
!       (Tos-1) = high word of result Long0 xxx Long1
!
!---------------------LC2);
        Tos - BHigh - OldCarry;
        1, if Neq Return;
        0, Return;
   
LC2:    not 0, Return;

{*****
Lo------------------------------------------------

Case(LongOps,ADL), tmp := TOS and AllOnes, pop;    ! b<low>
        tmp1 :=ngCmp: BLow := Tos, Pop; 
        BHigh := Tos, Pop;
        ALow := Tos, Pop;
        Tos - BHigh;
        Tos - BHigh, if  TOS and AllOnes, pop;              ! b<high>
        tmp2 := TOS + tmp, pop;
        TOS := TOS + tmp1 + oldcarry;
        TNeq Return;
        ALow - BLow;
        ALow - BLow, if Eql Return;
        1, if Carry Return;
        not 0, Return;
***OS := tmp2, push, NextInst(0);



Case(LongOps,SBL), call(LSSUB);
        TOS := tmp2, push, NextInst(0);        

LSSUB: 7 	
ble (10 * 10)
constant(ioRsiDTentry,110); !RS232 Input entry in DevTab (10 * 11)
constant(ioRsoDTentry,120); !RS232 Output entant(Z80DoSeek,20);     !bit for Z80WantOutput for disk seek
constant(Z80DoSpeech,2);
constant(Z80DoFloppy,4);
constant(Z80DoRry in DevTab (10 * 12)
constant(ioFlpDTentry,30);  !Floppy entry in DevTab (10 * 3);
constant(io488InDTentry,130);  !GPIB InpuS232,1);
constant(Z80DoGpib,10);
constant(Z80DoSetStatus,40);
constant(Z80DoGetStatus,100);
constant(Z80DataIOB,307);
constt entry in DevTab (10 * 13)
constant(io488OutDTentry,50);  !GPIB Output entry in DevTab (10 * 5);
constant(ioVltDTentry,60);  ant(OVRErr,140000);        ! status bits to set for overrun error
constant(cbRdOff,2);            ! offsets to circular buffer or Number Register
constant(dskFSNlo,311); !io address of FileSerialNumber low bits Register
constant(dskFSNhi,312); !io addre!Voltage Monitor entry in DevTab (10 * 6)
constant(ioSpchDTentry,40); !Speech entry in DevTab (10 * 4)
constant(ioSetDTentry,1ss of FileSerialNumber hi bits Register
constant(dskLBN,313);   !io address of LogicalBlockNumber Register
constant(dskHdrLo,340); !SetStatus entry in DevTab (10 * 14)
constant(ioGetDTentry,150); !GetStatus entry in DevTab (10 * 15)
constant(Z80Prefix,31); !io address of Header Buffer Address low bits Register
constant(dskHdrHi,321); !io address of Header Buffer Address hi bit153);    !Flag Char sent by Z80 at start of message
constant(ioIntMaskOffset,3);
constant(Z80NulIntMsk,3);   !guaranteed word s Register
constant(dskDataLo,330);!io address of Data Buffer address low bits Register
constant(dskDataHi,320);!io address ofof 0 in dev table
constant(dskIntMsk,13);     !Hard Disk Interrupt Mask offset in DevTab
constant(Z80VltIntMsk,63);  !Voltage  Data Buffer address hi bits Register
constant(ioBlkSizeOffset,2); !Offset in Device Table for Buffer Size
constant(ioCbOffsetInterrupt Mask offset in DevTab
constant(Z80KbdIntMsk,103); !Keyboard Interrupt Mask offset in DevTab
constant(Z80RsoIntMsk,12,0); !Offset in Device Table for CircularBuffer Pointer
constant(ioFloppyBlkSizeOffset,32); !Offset in DevTab for Floppy Blk Si3); !RS232 Output Interrupt Mask offset in DevTab
constant(Z80RsiIntMsk,113); !RS232 Input Interrupt Mask offset in DevTab
conze
             !There are 10 words/dev table entry. (10 * 3) + 2 = 32
constant(ioSpchBlkSizeOffset,42); !Offset in DevTab forstant(ClkIntMsk,73);     !60 Hz Clock Interrupt Mask offset in DevTab
constant(Z80GetIntMsk,153); !GetStatus Interrupt Mask off Speech Blk Size
             ! (10 * 4) + 2 = 42
constant(ioIntTentry,0);    !Master Z80 (IO Init) entry in Device Table
conset in DevTab
constant(Z80SetIntMsk,143); !SetStatus  Interrupt Mask offset in DevTab
constant(Z80SpkIntMsk,43);  !Speech Intestant(dskDTentry,10);    !Hard Disk entry in Device Table (10 * 1)
constant(ioDpyDTentry,210); !Display entry in Device Table (rrupt Mask offset in DevTab
constant(Z80488InIntMsk,133);  !GPIB Input Interrupt Mask offset in DevTab
constant(Z80488OutIntMs10 * 21)
constant(ioTabDTentry,70);  !Tablet entry in DevTab (10 * 7)
constant(ioKbdDTentry,100); !Keyboard entry in Device Tak,53);  !GPIB Output Interrupt Mask offset in DevTab
constant(Z80FlpIntMsk,33);  !Floppy Interrupt Mask offset in DevTab
const 8  	
 and AllOnes, push, NextInst(0);


Case(LongOps,MODL), call(LPopStack);
        call(LDivide);
        TOS := bhigh and All                ! special entry to bypass
        tmp5 := 0, goto(LMUL1);                 ! sign checks

LMULTIPLY: tmp7 := bOnes;
        TOS := blow and AllOnes, push, NextInst(0);

! Utility: LPopStack
!------------------------------------------high, leftshift(0);         ! hold b temporarily
        tmp5 := shift XOR ahigh, if geq goto(LMUL1); ! keep sign for result,
---------------------------
!
! Abstract:
!       Utility used by MPL, DVL, and MODL to set up their environments.
!
! Envi                                                ! if b is positive.
        call(LNEGB);                            ! negate bronment:
!       (Tos) = low word of long0
!       (Tos-1) = high word of long0
!       (Tos-2) = low word of long1
!       
        tmp7 := bhigh;
        ahigh;
LMUL1:  alow - blow, if geq goto(LMUL2);        ! if a is positive
        call(LNEGA)(Tos-3) = high word of long1
!
! Result:
!       Stack popped three times.
!       blow := (Tos)
!       bhigh := (Tos-1)
;                            ! negate a
        alow - blow;
LMUL2:  ahigh - bhigh - oldcarry;               ! long compare
 !       alow := (Tos-2)
!       ahigh := (Tos-3)
!       (Tos) = (Tos-3)
!
!------------------------------------------------       tmp6 := blow, if Geq Goto(Positive);    ! if a LSS b
        tmp6 := alow;                           ! exchange operands---------------------

LPopStack: blow := TOS and AllOnes, pop;
        bhigh := TOS and AllOnes, pop;
        alow := TOS a
        tmp7 := ahigh;
        alow := blow;
        ahigh := bhigh;

! Assertion : Both operands are positive at this poind AllOnes, pop;
        ahigh := TOS and AllOnes, return;

! Utility: LMULTIPLY, LMULTIPLYALL
!---------------------------nt. The larger
! one is in ahigh and alow (multiplicand), the smaller one
! is in tmp6 and tmp7 (multiplicator).
Positive:
 ------------------------------------------
!
! Abstract:
!       Subroutine Long Multiply ( b := b * a)
!
! Environment:
!       blow := 0;                              ! initialize result
        bhigh := 0, goto(LMULNEXT);

LMULLOOP:tmp6 or tmp7k popped.
!       (Tos) = low word of result Long0 xxx Long1
!       (Tos-1) = high word of result Long0 xxx Long1
!
! Calls       blow:        b.low , result.low
!       bhigh:       b.high, result.high
!       alow:        a.low
!       ahigh:    :
!       LMULTIPLY, LDIVIDE
!
!---------------------------------------------------------------------

Case(LongOps,MPL), c   a.high
!
! Work registers:
!       tmp4 : add-flag. Add multiplicand if 1, else not.
!       tmp5 : sign of result (- : iall(LPopStack);
        call(LMultiply);
        TOS := bhigh and AllOnes;      
        TOS := blow and AllOnes, push, NextIf tmp5 < 0. 
!                              + : if tmp5 >= 0) 
!       tmp6 : multiplicator.low
!       tmp7 : multiplicator.nst(0);


Case(LongOps,DVL), call(LPopStack);
        call(LDivide);
        TOS := ahigh and AllOnes;
        TOS := alowhigh             
!
!---------------------------------------------------------------------

LMULTIPLYALL: tmp7 := bhigh;     8 	
0..29);    {5 bits}
!                        Head: (0..7);     {3 bits}
!                        Cyl:  (0..201);   {8 bits}
!                    ! pick up the segment number
          ioSeg := MDI;                 ! And his Data Buffer offset
                              end;
!            FileSerialNumber: Long;         {Start of Header Block}
!            LogicalBlockNumbe  dskCMD := MDI;                   !The command to do
          dskAddr := MDI, Call(ioXlateA);!And the place on the disk to dor: Integer;
!            NumberOfGoodBytes: Integer;
!            NextBlock: Long
!            PreviousBlock: Long;           it to
          ioPhysAdr xnor C1777, IOB(dskDataLo); !Put PA of Buf ptr into dsk controller
          not ioPhAdrHi, IOB(dsk  {End of Header Block}
!            Result:   Packed Record
!                        CntrlrErr: (.....)   {3 bits}
!        DataHi);
          dskAddr, Field(5,3);             !Get head field
          SHIFT, IOB(dskHead);
          dskAddr, IOB(dsk                IllegalCmd: Boolean;
!                        TrackZero:  Boolean;
!                        WriteFault: BooleaCylSec);         !Let Hardware know about addr
          dskDCBptr+4, Fetch4;     !pick up the FSN/LBN
          dskCMD, Fieldn;
!                        SeekCompl:  Boolean;
!                        DriveReady: Boolean;
!                      end;
!(10,10);    !Num sectors to transfer
          dskNumSec := SHIFT;      !Will do multi-sector xfer if <= 1
          MDI, IOB(info
constant(cbWrOff,1);
constant(cbLnOff,3);
constant(cbBufOff,2);           ! offset from IOCB to number of blocks/buffs
            OsUnused: Array [0..2] of Unspecified;
!          end;
!
!-------------------------------------------------------


constant(Z80St0,5100);          ! Dispatch point for Z80 input intrs
constant(Z80St1,5200);
constant(Z80Msg0,5300);     ----------------------

! Hard disk StartIO.
!-----------------------------------------------------------------------------    ! Dispatch point for message type
constant(Z80Msg1,5400);

Constant(Z80OSt,5500);          ! Dispatch point for Z80 outpu
!
!-----------------------------------------------------------------------------

dskStart: dskIntrLevel := 0, Case(StartIO,t intrs




        Place(4400,5777);




$Title Hard disk.

! Hard disk.
!--------------------------------------1);
dskGetDcbPtr: ioDevTab + dskDTentry, Fetch2; 
          Call(ioTLate);                   !Get DCB ptr
          dskDCBptr---------------------------------------
!
!The format of a dsk DCB
!  dskDCB: Packed Record
!            Data: ^dskData;
!  := ioPhysAdr, Call(ioXLateA); !It was a virtual address
          not ioPhAdrHi, IOB(dskHdrHi);    !Let Hardware have upper bi           Command: (Idle,WriteCheck,Write,FormatWrite,ReadCheck,FormatRead
!                      SeekOnly, Reset);
!        ts
dskDoSector: dskTmp := dskDCBptr, Fetch4;  !get Data Buf, Cmd, NumSec & DskAdr
          dskTmp := dskTmp + 4;            !    NumSec: 0..255;      {Number of sectors to transfer}
!            DiskAddr: Packed Record
!                        Sect: (offset to header data
          dskTmp xnor C1777, IOB(dskHdrLo);!Give header address to controller
          ioOffset := MDI; 9  	
tmp6; 
        tmp6 := shift or tmp4, if odd goto(LMULADD);
        alow := alow + alow;                    ! 2*a<low>         goto(LDIV1); ! sign of result
        call(LNEGA);                          ! negate a
        bhigh;

LDIV1:  tmp7 := 0, i
LMUL7:  ahigh := ahigh + ahigh + oldcarry;      ! 2*a<high>

LMULNEXT: if intrpend call(VectSrv);
        tmp4 := 0, goto(Lf lss Call(LNEGB);        ! negate b if b LSS zero
        tmp6 := 0;

! Assertion : Both operands are positive at this pointMULLOOP);

LMUL5:  tmp4 := SIGNBIT, goto(LMUL6);

LMULADD: blow := blow + alow;                   ! add a<low> to result
  .
        bhigh or blow;                                ! check whether b zero
        push, if eql goto(DIVZERO); 

LDIV4:       bhigh := bhigh + ahigh + oldcarry;      ! add a<high> to result
        if carry goto(LMULERR);
        alow := alow + a TOS := 40;                            ! loop count
        ahigh;                                ! check a.high zero
        low, goto(LMUL7);       ! 2*a<low>

LMULERR: alow := alow + alow, goto(LMUL7);
        ! **** TP := TP + 1, Store;
        !alow, if neq goto(LDIV5);
        ahigh := alow, if eql goto(LDIVZERORESULT); ! shift 1 word
        alow := 0;
        TOS : **** ErrMulOvfl, goto(ErrExit);

LMULEND: tmp5;                                  ! check sign of result
LMULRETURN: if geq r= TOS - 20;                      ! adjust loop count: skip 1 word
LDIV5:  ahigh and not 377, leftshift(10);     ! check whethereturn;
LMULNEGEND: goto(LNEGB);



! Utility: LDIVIDE, LDIVIDEALL
!------------------------------------------------------ high byte zero
        ahigh, if neq goto(LDIVLOOP);
        ahigh := shift;                       ! shift 1 byte
        al---------------
!
! Abstract:
!       Subroutine Long Divide ( a := a : b)
!
! Environment:
!       alow:      a.low,  resow, rightshift(10); 
        ahigh := shift or ahigh;
        alow, leftshift(10);
        alow := shift; 
        TOS := TOult.low
!       ahigh:     a.high, result.high
!       blow:      b.low,  remainder.low
!       bhigh:     b.high, remainder.S - 10;                      ! adjust loop count: skip 1 byte 

LDIVLOOP: alow := alow + alow;                ! shift dividendhigh
!
! Work registers:
!       remsign:   sign of remainder
!       ressign:   sign of result
!       tmp6:      partial .low
        ahigh := ahigh + ahigh + oldcarry;    ! shift dividend.high
        tmp6 := tmp6 + tmp6 + oldcarry;       ! shiftdividend.low
!       tmp7:      partial dividend.high
!
!-------------------------------------------------------------------- partial dividend.low
        tmp7 := tmp7 + tmp7 + oldcarry,       ! shift partial dividend.high
                if intrpend -

LDIVIDEALL: ressign := 0;                     ! special entry to bypass
        remsign := 0, goto(LDIV1);            ! sicall(VectSrv); 
LDIV11: tmp6 - blow;                          ! is tmp >= b ?
        tmp7 - bhigh - oldcarry; 
        if ls, rightshift(1);           ! end test
        tmp7, if eql goto(LMULEND);
        tmp7 := shift, if odd goto(LMUL5);
LMUL6:  gn checks

LDIVIDE: remsign := ahigh, leftshift(0);      ! holds sign of remainder
        ressign := shift XOR bhigh, if geq 9 	
rk
          if eql GoTo(dskSeekOnly);
          dskCMD, IOB(dskCntl);    !start disk
          dskIntrLevel;
          if O
          dskTmp := MDI;
          MA := dskDCBptr, Store;     !Update the Data buffer offset
          MDO := dskTmp + 400;dd GoTo(NiceRet);    !Dismiss intr if thats how we got here
          TOS := not 0, push, NextInst(0);!otherwise, return with N
          dskDCBptr+6, Fetch;         !Pick up the LogicalBlockNumber
          dskTmp := MDI;
          dskDCBptr+6, Store; extInst, TOS good
          
dskCallZ80: dskCyl := dskCyl + dskSeek, IF Lss GoTo(dskSeekBack);
          10, IOB(dskCntl);
         !Update it
          dskTmp + 1;
          dskDCBptr+2, Fetch;         !Get Cmd/NumSec
          dskTmp := MDI;
             GoTo(Z80DiskSeek);
dskSeekBack: dskSeek := not dskSeek;
          dskSeek := dskSeek + 1;
          0, IOB(dskCntl);      dskDCBptr+2, Store;
          MDO := dskTmp - 400;        !Decrement NumSec
          dskDCBptr+10, Fetch;        !Get t
          GoTo(Z80DiskSeek);
dskSeekOnly: IOB(dskStat);  !Code 6 is seek only, finsih now
          dskTmp := IOD, GoTo(dskIhe Next Disk Address
          dskTmp := MDI;
          dskDCBptr+3, Store;         !Update the Disk Address
          dskTmpSrvA);

! Hard disk interrupt service.
!-----------------------------------------------------------------------------
!
!-, GoTo(dskDoSector);

Z80DiskSeek: Z80WantOutput := Z80WantOutput or Z80DoSeek, Call(Z80StartScan);
          dskIntrLevel;
----------------------------------------------------------------------------

dskIntrServ: dskIntrLevel := 1,IOB(dskStat),loc(          if Odd Goto(NiceRet);
          TOS := 0, Push, NextInst(0);




$Title Circular buffered devices.

! CirculaDiskInt); !Disk Interrupt Service
          dskTmp := IOD;              !Get disk status and save it
          0, IOB(dskCntl)r buffers.
!-----------------------------------------------------------------------------
!
!Format of a CircularBuffer
!   ;            !Clear the interrupt quick
dskISrvA: dskTmp and 47;              !Check errors (Controller and WriteFault)
          CirBuffer:  Record      {Must be aligned on a Quad Boundary}
!                    cbLen:  (0..MaxLen);  {Actually has "MaxLdskFSNlo);      !Here comes the file serial number 
          MDI, IOB(dskFSNhi);      !  a 32 bit quantity
          MDI, IOB    dskNumSec := dskNumSec - 1, if Neq GoTo(dskCmdDone);!Count # sectors
          IF Gtr GoTo(dskMoreSecs);
dskCmdDone: MA :=(dskLBN);        !And then the Logical Block Number
          dskCMD := dskCMD and 47; !Get rid of all but real command bits
  dskDCBptr+14, Store;  !Store the result status
          MDO := dskTmp;              !The disk status code
          ioDevTab         dskAddr, Field(10,10);   !get Cylinder field
          dskSeek:=SHIFT-dskCyl;!Compare to where we are now
          d + dskIntMsk, Fetch;
          UserIntr := MDI or UserIntr; !Cause Pascal interrupt
          dskIntrLevel;
          if Odd skSeek, IF Neq GoTo(dskCallZ80); !If not 0, Seek is required
dskDoCmd: dskCMD - 6;              !This command is needs extra woReturn; 
          TOS := not 0, push, NextInst(0);
dskMoreSecs: MA := dskDCBptr, Fetch;  !Get the Data buffer Pointer Offset :  	
------------------------------
!
! Abstract:
!       KOPS is a two byte opcode for performing Spice Kernel operations.
!    t microcode,
!       and should eventually replace other multiply routines in the
!       Qcode interpreter ( remove the T in    The second byte is used as a dispatch into the 16 operations.
!       The actual support for these 16 ops is in MicroKernel.front of the labels).
!
!-----------------------------------------------------------------------------

TMultiplyLong:
    s goto(LDIVDEC);
        tmp6 := tmp6 - blow;                  ! partial dividend + (- divisor)
        tmp7 := tmp7 - bhigh -Micro.
!
! Instruction:
!       KOPS
!
!---------------------------------------------------------------------

Opcode(KOP oldcarry;
        alow := alow or 1;                    ! increase result

LDIVDEC: TOS := TOS - 1;
        remsign, if gtrS),
        Goto(Uop);
{KOPS is not supported.
        call(KOpsDispatch);
        NextInst(0);

KOpsDispatch: tmp := Next goto(LDIVLOOP);
        blow := tmp6, pop, if lss goto(LDIVNEGREM); ! remainder.low
        bhigh := tmp7;                   Op;
        tmp, Field(0,4);
        Dispatch(KrnlOps); 
 KOPS is not supported.}
                                                     ! remainder.high
        ressign;
LDIVEND: if geq return;
        goto(LNEGA);                          ! negate r esult

LDIVNEGREM: bhigh := tmp7, call(LNEGB);       ! negate remainder
        ressign, goto(LDIVEND);

LDIVZERORESULT: bl ow := 0, pop;
        bhigh := 0, return;

! Utility: LNEGA, LNEGB
!-------------------------------------------------------! Routines TMultiply (Mult) and TMultiplyLong.
!-----------------------------------------------------------------------------
--------------
!
! Abstract:
!       Negate long operand a
!
! Environment for LNEGA:
!       alow
!       ahigh
!
! En!
! Abstract:
!       TMultiply: forms the lower 16 bits of the product of two integers.
!
!       TMultiplyLong: forms a 32vironment for LNEGB:
!       blow
!       bhigh
!
!---------------------------------------------------------------------

 bit result (used by MPR),
!                     assumes: operands are positive
!
! Environment:
!       tmp = Multiplier.
LNEGA:  alow := not alow;
        ahigh := not ahigh;
        alow := alow + 1;
        ahigh := ahigh + 0 + OldCarry, return!       tmp1 = Multiplicand.
!
! Work registers:
!       tmp5   :        sign
!       tmp6   :        multiplier
!       tm; 




LNEGB:  blow := not blow;
        bhigh := not bhigh;
        blow := blow + 1;
        bhigh := bhigh + 0 + OldCp11  :        high order result
!       tmp12  :        high order multiplicand
!
! Result:
!       tmp = Result<15:0>
!   arry, return;




$Title Double precision arithmetic operators.

! Opcode KOPS
!---------------------------------------    tmp1 = Result<31:16>
!
! Calls:
!       VectSrv.
!
! Note:
!       These routines are called only by the floating poin : 	
Array [0..MaxLen] of XXX (A one word packed record)
!                   end;
!
!---------------------------------------------b, Call(cbSetUp), Case(StartIO,13);
           GoTo(cbGetChr1);

! Routine cbSetUpQ.
!---------------------------------------------------------------------

! Circular buffered StartIOs.
!---------------------------------------------------------------------------------------------------
!
! Routine to initialize registers from a CircularBuffer
!
!----------------------------------------
!
!-----------------------------------------------------------------------------

cbPutChrQ: ioChar := TO-------------------------------------------------------

cbSetUpQ: Call(ioTLateB);               !Get Circular Buffer Pointer S, pop, Call(cbSetUpQ),case(StartIO,16); !cir buf put
                                            ! TOS = Char
               on TOS
cbSetUp:  ioPhysAdr, Fetch4;     !entry point for io device microcode
          ioPhysAdr := ioPhysAdr + 3;  !Set ioPhy                             ! TOS-1,TOS-2 = VA of control block
cbPutChr1: Call(cbPut);
cbPutChr2: TOS := ioTmp, push, NextInsAdr to 1st data item
          ioLen := MDI;
          ioRdPtr := MDI;
          ioWrPtr := MDI, return;

! Routine cbPutst(0); !Return results on TOS




cbGetChrQ: Call(cbSetUpQ), case(StartIO,17);    !special cir buf get
                   .
!-----------------------------------------------------------------------------
!
!Routine to put an item in a CircularBuffe                     !TOS,TOS-1 = VA of control block
cbGetChr1: Call(cbGet);
cbGetChr2: TOS := ioChar, Push;        !Return Rr
!  cbSetUp must be called prior to calling cbPut
!
!-----------------------------------------------------------------------esults on TOS - 1
           TOS := ioTmp, Push,NextInst(0);  !Return Success flag on TOS




cbKbdGet:  ioPhysAdr := ioKb------

cbPut:    ioTmp := ioRdPtr;     !must calculate (ioRdPtr - 1) - ioWrPtr
cbPut1:   ioTmp := ioTmp - 1, If Eql GoTo(cbPdCb, Call(cbSetUp), Case(StartIO,10);
           GoTo(cbGetChr1);




cbRS232Get: ioPhysAdr := ioRsInCb, Call(cbSetUp), CautOvr);  !To see if buffer is full
          ioTmp - ioWrPtr;
          ioTmp := 0, if eql Return;    ! return with 0 => failuse(StartIO,11);
           GoTo(cbGetChr1);




cbRS232Put: ioPhysAdr := ioRsOutCb, Call(cbSetUp), Case(StartIO,12);
    re
          MA := ioPhysAdr + ioWrPtr, Store;  !Put the data item in the buffer
          ioChar;  !the data
          ioWrP       ioChar := TOS, Call(cbPut);
           TOS := ioTmp;                !Return results on TOS
           if intrpend call(tr := ioWrPtr + 1;  !Now update your pointer
          ioWrPtr - ioLen;         !Watch out for wrap around
          ioTmp := vecint);    !give the io a break
           Z80WantOutput := Z80WantOutput or Z80DoRS232, Call(Z80StartScan);
                not 0, If Neq GoTo(cbPutDone); 
          ioWrPtr := 0;            !Wrap around occured, start at top of buffer
cbPutDone:ioPhen" in it}
!                    cbRdPtr: (0..MaxLen);
!                    cbWrPtr: (0..MaxLen);
!                    cbBuf:                    !Queue a request for the Z80 to start it
           NextInst(0);  




cb488Get:  ioPhysAdr := io488InC ;  	
p1 + tmp1,                 ! shift multiplicand left
                             if eql Goto(TMul9);  ! if multiplier is zero -----------------------------------------------------
!
! Abstract:
!       ChkSeg checks a segment number for residency and   
        tmp12 := tmp12 + tmp12 + oldcarry, if IntrPend Goto(TMul8);
TMulx:   tmp6,Goto(TMul5);                          ! sreturns its base
!       address (if resident).
!
! Environment:
!       tmp = Segment number.
!
! Result:
!       tmp = hift multiplier right

!       Accumulate partial product.
 
TMul6:   tmp := tmp + tmp1;                   ! accumulate prodBase address.
!       tmp and ALU result are Odd if non-resident.
!
!--------------------------------------------------------uct
        tmp11 := tmp11 + tmp12 + oldcarry,  if lss GotoS; ! save overflow        
TMul7:   tmp6, goto(TMul55);     ! shift---------------------

(*****
ChkSeg: tmp + tmp, Fetch2;                   ! fetch segment table entry
        tmp := Mdi an multiplicand left

!       Serve an interrupt.

TMul8:   Call(VectSrv);
        RightShift(1);
        Goto(TMulx);

! d not 376;            
        tmp := Mdx or tmp, Return;           ! base address and residency
*****)
ChkSeg: tmp + tmp, Fe    loads(TMul7);
        tmp11 := 0; 
        tmp12 := 0;
        tmp5 := 0, push,goto(TMul2);

TMultiply: Tos := 0, Push,      Return the result.

TMul9:   tmp5;                                ! check sign of result
        tmp := tmp and AllOnes loads(TMul11);
        tmp, LeftShift(0);
        tmp5 := Shift xor tmp1,              ! tmp5 has sign bit of result
       , if Lss Goto(TMul10);  ! if result is negative

!       Set a positive result. MultiplyLong has always positive result                                if Geq Goto(TMul1);  ! if tmp >= 0
        tmp := Tos - tmp, if IntrPend Call(VectSrv);  ! absolute va       

        tmp1 := tmp11,Pop, Return;

!       Set a negative result.

TMul10:  tmp := TOS - tmp;               ! nelue of tmp
TMul1:   tmp1;
TMul2:   tmp - tmp1, if Geq Goto(TMul3);       ! if tmp1 >= 0
        tmp1 := Tos - tmp1, Goto(TMulgate result
        tmp := tmp and AllOnes, Pop, Return;

!       Signal integer multiply overflow.
TMul11:  tmp6, Goto(TMul2);      ! absolute value of tmp1

!       tmp6 = smaller of tmp and tmp1.
!       arrange tmp and tmp1 so than tmp <= tmp1.5);!TP := TP + 1, Store;         ! overflow in multiplication
!****** temporarily disabled ************************************

TMul3:   if Leq Goto(TMul4), tmp6 := tmp;

!       Exchange tmp and tmp1.
        tmp := tmp1;
        tmp1 := tmp6;
   ************
! ***** ErrMulOvfl, Goto(ERREXIT);



                                                                             tmp6 := tmp;
TMul4:   tmp := 0;                            ! initialize product = 0
        tmp6, RightShift(1);                  ! shift multiplier right
TMul5:   tmp6 := Shift, if Odd Goto(TMul6);    ! if bit set in multiplier
TMul55:  tmp1 := tm
! 13 Jan 82  WJH      change , to ; in StkOv


$Title Addressing routines.

! Routine ChkSeg.
!------------------------ ; 	
IO,3);
           Call(ioTLate);                                    !IOCB entry
           Z80FloppyDCB := ioPhysAdr, Fetch2;wds in buff
           TOS := not 0, Push, NextInst(0);     !All is well




$Title GPIB.

! GPIB StartIO.
!----------
           Call(ioTLate);                !buffer address
           Z80FlpAdr := ioPhysAdr;
           Z80FlpAdr := Z80FlpAdr-------------------------------------------------------------------
!
!-------------------------------------------------------ysAdr - cbWrOff, Store;       ! write out new write pointer
          ioWrPtr;
          ioTmp, Return;                ! retur - 1;   !incremented before first memory ref
           Z80WantOutput := Z80WantOutput or Z80DoFloppy, Call(Z80StartScan);
   n with -1 => success
cbPutOvr: ioTmp := ioLen, GoTo(cbPut1); !RdPtr was 0, if WrPtr = Len-1 => full

! Routine cbPut.
!----        TOS := not 0, Push, NextInst(0);




$Title Speech.

! Speech StartIO.
!----------------------------------------------------------------------------------------------------------------
!
!Routine to get an item from a circular buffer
! --------------------------------------
!
!-----------------------------------------------------------------------------

Z80 cbSetUp must be called prior to calling cbGet
!
!----------------------------------------------------------------------------SpeechStart: Z80spchCnt, Case(StartIO,4);  !check speech io in progress
           if neq goto(ioBadBerries);         !if so, c-

cbGet:    ioRdPtr - ioWrPtr;            !Check for buffer empty
          ioTmp := 0,  if Eql Return;   ! return with 0 =>an't do
           ioDevTab + ioSpchDTentry, Fetch2;
           Call(ioTLate);                     !Get dcb ptr
           io no char available
          ioPhysAdr + ioRdPtr, Fetch;   !get the char
          ioRdPtr := ioRdPtr + 1;       !update the RTmp := ioPhysAdr, Fetch2; 
           Call(ioTLate);                   !Get data buffer pointer
           ioDevTab + ioSpchBlead Pointer
          ioRdPtr - ioLen;              !Check for wrap around
          ioChar := MDI, If Neq GoTo(cbGetDone);
 kSizeOffset, Fetch; !Get Block Size
           Z80SpchAdr := ioPhysAdr;       !Save buffer address
           Z80WantOutput:=Z         ioRdPtr := 0;                 !Wrap around occured, start at top
cbGetDone: ioPhysAdr - cbRdOff, Store;  ! write out n80WantOutput or Z80DoSpeech;
           ioTmp1 := MDI, If IntrPend Call(VecInt);
           ioTmp + cbBufOff, Fetch;          ew read pointer
          ioRdPtr;
          ioTmp := not 0, return;       ! return with -1 => success




$Title Floppy     !Get # buffers
           Z80SpchCnt := 0;
           MDI, RightShift(10);           !Its iun the hi byte
           ioTmdisk.

! Floppy disk StartIO.
!-----------------------------------------------------------------------------
!
!----------p := Shift;                !poor man's multiply
Z80SpchSt1: ioTmp := ioTmp - 1;           !to get total bytecount
           Z-------------------------------------------------------------------

FloppyStart: ioDevTab + ioFlpDTentry, Fetch2,  Case(Start80SpchCnt := Z80SpchCnt + ioTmp1, If gtr goto(Z80SpchSt1);
           Z80SpchAdr := Z80SpchAdr - 1, Call(Z80StartScan);!do all  <  	
ment number, and the output is a global pointer.
!       An internal segment number of zero is used to mean the current
!            tmp1 := Mdi + tmp1, if IntrPend Call(VectSrv);  ! address of LL field
        tmp1, Fetch, Return;                 ! fet  segment.
!
! Environment:
!       tmp2 = Internal segment number.
!
! Result:
!       tmp2 = External global pointer.
!ch LL field

! Routine GetLP.
!-----------------------------------------------------------------------------
!
! Abstract:
! Calls:
!       VectSrv.
!
!-----------------------------------------------------------------------------

GetGP2: Call(
!       Get the local pointer for another activation record.  The input
!       is an offset in static nesting, and the outpuVectSrv);                       ! serve an interrupt
        Nop;                                 ! let placer make two groupst is a local pointer.
!
! Environment:
!       tmp2 = AP.
!       tmp3 = offset in static nesting.
!
! Result:
!       Th
GetGP:  tmp2, if IntrPend Goto(GetGP2);
        tmp2 := tmp2 + tmp2, if Neq Goto(GetGP1);
        tmp2 := GP, Return;        e memory word containing the desired local pointer is Fetched
!       in the instruction which returns.
!
! Calls:
!       V          ! same segment as current

!       Other segment.

GetGP1: GP - tmp2, Fetch;
        tmp2 := Mdi + SB, Return;
ectSrv.
!
!-----------------------------------------------------------------------------

GetLP1: tmp3 := tmp3 + 1, Call(Vec
! Routine GetLL.
!-----------------------------------------------------------------------------
!
! Abstract:
!       GetLtSrv);
GetLP:  tmp2, Fetch;                   ! fetch static link
        tmp3 := tmp3 - 1, if IntrPend Goto(GetLP1);
       L gets the lexical level of a routine given its number and code
!       base address.  The code segment must be resident.
!
! tmp2 := Mdi + SB,                    ! AP for next activation
                          if Gtr Goto(GetLP);  ! if not there yetch2;                   ! fetch segment table entry
        tmp12 := tmp;
        Tos := tmp := Mdi, Push;            
       Environment:
!       tmp4 = Code base address as a physical address.
!       tmp10 = Routine number.
!
! Result:
!       t  tmp := Mdx or tmp,                   ! base address and flags
                           if Odd Goto(ChkSeg1);  ! if not resimp1 = Address of LL field.
!       LL word of the routine descriptor fetched--it may be read on Mdi.
!
! Calls:
!       Vectdent
        tmp := tmp and not 377;              ! clear the flags
        tmp12 + tmp12, Store;
ChkSeg1: Tos or 4, Pop, RetSrv.
!
!-----------------------------------------------------------------------------

GetLL:  tmp4, Fetch;                 urn;              ! set RecentlyUsed in SAT

! Routine GetGP.
!-------------------------------------------------------------        ! fetch dictionary pointer
        tmp10, LeftShift(3);                 ! multiply routine number by 8
        tmp1 :=----------------
!
! Abstract:
!       Get the global pointer for an external segment.  The input is an
!       internal seg Shift + tmp4;                ! offset of dictionary entry
        tmp1 := tmp1 + RDLL;                 ! offset of LL field
  < 	
mber




ioGetStatus: Tmp := ioGetDTentry, Call(ioWaitPrevSetStat), Case(StartIO,15);
                                   !ag char
           Z80State := 1, Return;         !Got it, next byte is message type




!       State 1 - Message type, bDont Get until last Set
           Z80WantOutput := Z80WantOutput or Z80DoGetStatus, Call(Z80StartScan);
           NextInst(0egin communication.

case(Z80St0,1), Z80Chr - 20, Field(0,4);  ! state 1 - Dispatch on message type
           Z80Chr, if Geq);

ioWaitPrevSetStat:  if intrpend call(VecInt);      !This may take a while
           Z80WantOutput and 140;            !W Dispatch(Z80Msg1);  !dispatch to messages 20..37
           Dispatch(Z80Msg0);                 !dispatch to messages 0..17

ait for any prior SetStat/GetStat
           If Neq GoTo(ioWaitPrevSetStat);         !  to finish before starting
           Z
!       Message 0 - Unknown message type.

  Case(Z80Msg0,0),  Z80State := 0, GoTo(NiceRet);


!       Message 1 - Keyboa80StateType := TOS, pop;               !Get the channel number
           Z80StateType, if LSS return;            ! MAB specialrd character.

  Case(Z80Msg0,1),  Z80Buff := ioKbdCb;
  Z80MsA:           Z80State := 2, GoTo(NiceRet);


!       Message----------------------

GPIBstart: ioDevTab + io488OutDTentry, Fetch2,  Case(StartIO,5);
           Call(ioTlate);
          code to locate disk heads
           ioDevTab + Tmp, Fetch2;
           Call(ioTLate);
           Z80StateAdr := ioPhysAdr;   ioTmp := ioPhysAdr, Fetch4;
           Z80WantOutput := Z80WantOutput or Z80DoGpib;
           ioOffset := MDI;
                         !Save pa of buffer address
           Z80StateType, return;




$Title Z80 to Perq communications.

! Z80ioSeg := MDI;
           Z80488Cmd := MDI;
           Z80488Cnt := MDI, Call(ioTLateA);
           Z80488Adr := ioPhysAdr, Ca to Perq interrupt service.
!-----------------------------------------------------------------------------
!
!---------------ll(Z80StartScan);
           TOS := Not 0, Push, NextInst(0);




$Title SetStatus and GetStatus.

! SetStatus and GetS--------------------------------------------------------------

Z80IntSrv: IOB(106),loc(Z80IInt);             !Read the chr
 tatus StartIOs.
!-----------------------------------------------------------------------------
!
!---------------------------          Z80Chr := IOD and 377;             !Punt upper bits
           Z80State - 20, Field(0,4);         !Dispatch to right --------------------------------------------------

ioSetStatus:  Tmp := ioSetDTentry,Call(ioWaitPrevSetStat), Case(StartIO,14routine
           Z80State, if Geq Dispatch(Z80St1); !dispatch to states 20..37
           Dispatch(Z80St0);                 );
           if LSS goto (ioSetDHeads);   ! MAB special to locate heads
           Z80WantOutput := Z80WantOutput or Z80DoSet !dispatch to states 0..17

Z80BumpState: Z80State := Z80State + 1, Return; !Next State please




!       State 0 - IdleStatus, Call(Z80StartScan);
           NextInst(0);

ioSetDHeads:  dskCyl := Tos, Pop, NextInst(0); ! Set current cylinder nu.

case(Z80St0,0), Z80Chr - Z80Prefix;        ! state 0 - idle
           if Neq GoTo(NiceRet);           !only accept the fl =  	
els
!       away.  Thus specifying zero gets the static link for a procedure
!       that is at the same level as the starting!       SetFalse sets the top of the expression stack to false.  SetFalse
!       is not called, it is jumped to.  It exits via one.
!
! Environment:
!       tmp10 = Starting AP.
!
! Result:
!       tmp10 = Desired SL.
!
! Calls:
!       VectSrv. a NextInst.
!
! Environment:
!       (Tos) = Anything.
!
! Result:
!       (Tos) = False.
!
!--------------------------
!
!-----------------------------------------------------------------------------

GetSL:  tmp10, Fetch;                    ---------------------------------------------------

SetFalse: Tos := 0, NextInst(0);

! Routine SetTrue.
!---------------    ! get next static link
        tmp1 := tmp1 - 1;
        tmp10 := Mdi + SB,                   ! static link
             --------------------------------------------------------------
!
! Abstract:
!       SetTrue sets the top of the expression s              if Geq Goto(GetSL);  ! if not there yet
        Return;

! Routine XSTMap.
!---------------------------------tack to false.  SetTrue
!       is not called, it is jumped to.  It exits via a NextInst.
!
! Environment:
!       (Tos) = A--------------------------------------------
!
! Abstract:
!       XstMap maps an internal segment number (ISN) into an externything.
!
! Result:
!       (Tos) = True.
!
!-----------------------------------------------------------------------------nal
!       segment number (SSN) and an external global pointer (XGP).  An
!       ISN of zero is taken to mean the current se

SetTrue: Tos := 1, NextInst(0);




$Title Byte array and string routines.

! Routine GetStringIndex.
!------------gment.
!
! Environment:
!       tmp = ISN.
!
! Result:
!       tmp = XSN.
!       tmp7 = XGP.
!
! Calls:
!       VectS-----------------------------------------------------------------
!
! Abstract:
!       GetStringIndex gets an index into a srv.
!
!-----------------------------------------------------------------------------

XSTMap: tmp, LeftShift(1);
        tmtring variable and checks it
!       against the dynamic length of the string.  If the index is out of
!       range, GetStrinp := Shift, if Eql Goto(XSTMap1);  ! if current segment desired
        GP - tmp, Fetch2;                    ! fetch XST entrygIndex causes an ErrInxCase error.  If the index is
!       in range, GetStringIndex fetches the correct word and returns.
!

        tmp7 := Mdi + SB;                    ! XGP
        tmp := Mdi, Return;                  ! SSN

!       ISN = 0 means! Environment:
!       (Tos) = Byte offset.
!       (Tos-1) = Word address as offset from stack base.
!
! Result:
!       St
        tmp2 + ACBLP, Fetch, Return;         ! fetch desired LP

! Routine GetSL.
!-------------------------------------- XSN = CS, XGP = GP.

XSTMap1:  tmp := CS, if IntrPend Call(VectSrv);
        tmp7 := GP, Return;




$Title Boolean rou---------------------------------------
!
! Abstract:
!       GetSL gets the static link of a procedure that is n lexical levtines.

! Routine SetFalse.
!-----------------------------------------------------------------------------
!
! Abstract:
 = 	
:= Z80488InIntMsk;
                    Z80State := 20, GoTo(NiceRet);


!       Message 7 - RS232 status.

  Case(Z80Msg0,           Z80State := 0;               !this message is over
           UserIntr := MDI or UserIntr; !Cause an interrupt
Z80S7),  Z80Buff := Z80StateAdr;
  Z80GtStat:        Z80VIntr := Z80GetIntMsk; 
                    Z80State := 17, GoTo(NiceRet);t2a:   ioPhysAdr := Z80Buff, Call(cbSetUp); !Z80Buff has ptr to cb
           Call(cbPut);                 !Put item away
    


!       Message 10 - Tablet status.

  Case(Z80Msg0,10), Z80Buff := Z80StateAdr, GoTo(Z80GtStat);


!       Message 1       ioWrPtr := ioWrPtr - 1, If Neq GoTo(NiceRet); !return if it worked
           If Lss GoTo(Z80St2c);        !otherwise we1 - Keyboard status.

  Case(Z80Msg0,11), Z80Buff := Z80StateAdr, GoTo(Z80GtStat);


!       Message 12 - Seek complete.
 have overflow
                                        !   the - 1 bumps ptr back to item
                                    
  Case(Z80Msg0,12), dskIntrLevel := 1;           ! MAB
                    Z80State:=0, GoTo(dskDoCmd);

!       Message 13     !   the test checks for wrap around
                                        !   just occuring
Z80St2b:   ioPhysAdr + ioWrP- Status change.

  Case(Z80Msg0,13), Z80State := 12, GoTo(NiceRet);


!       Message 14 - Voltage data.

  Case(Z80Msg0tr, Fetch;  !no wrap around, get that last item
           nop;                         !Fetch/Store combo needs explicit nops,14), ioDevTab + ioVltDTentry, Fetch2;!msg 14 - Voltage Data coming
                    Z80VIntr := Z80VltIntMsk, Call(ioTlate)
           nop;
           ioPhysAdr + ioWrPtr, Store;  !Restore the item
           MDO := MDI or OVRErr, Return;!with the o;
                    Z80Buff := ioPhysAdr;
  SetState13:       Z80State := 13, GoTo(NiceRet);


!       Message 15 - Voltaverrun bit set
Z80St2c:   ioWrPtr := ioLen;            !here if wrap around had occured
           ioWrPtr := ioWrPtr - 1, GoT 2 - RS232 characters.

  Case(Z80Msg0,2),  Z80Buff := ioRsInCb;
                    Z80VIntr := Z80RsiIntMsk;
             ge status.

  Case(Z80Msg0,15), Z80Buff := Z80StateAdr, GoTo(Z80GtStat);


!       Message 16 - Clock status.

  Case(Z80       Z80State := 3, GoTo(NiceRet);


!       Message 3 - Tablet data.

  Case(Z80Msg0,3),  Z80State := 5, GoTo(NiceRet);Msg0,16), Z80Buff := Z80StateAdr, GoTo(Z80GtStat);


!       Message 17 - GPIB status.
!       ********** - Where did this c


!       Message 4 - Clock data.

  Case(Z80Msg0,4),  Z80State := 11, GoTo(NiceRet);


!       Message 5 - Floppy data.ode go?



!       Message 20 - Floppy status.

  Case(Z80Msg1,0),  Z80Buff := Z80StateAdr, GoTo(Z80GtStat);


!       

  Case(Z80Msg0,5),  Z80Buff := Z80FlpAdr;
                    Z80VIntr := Z80FlpIntMsk;
                    Z80State := 15Message 21 - Floppy done.

  Case(Z80Msg1,1),  Z80State := 16;
                    Z80VIntr := Z80FlpIntMsk, Goto(NiceRet);
, GoTo(NiceRet);


!       Message 6 - GPIB data.

  Case(Z80Msg0,6),  Z80Buff := io488InCb;
                    Z80VIntr 



!       State 2 - Keyboard character.

Case(Z80St0,2), ioDevTab + Z80KbdIntMsk, Fetch;
           ioChar := Z80Chr;
 >  	
 = First source word.
!       SrcByte = First source byte.
!       Dst = Destination word physical address (Address + ByteOffs-------------------------------------------
!
! Abstract:
!       GetSrc gets the next source byte from a byte array or a strtack popped.
!       tmp4 = Physical word address of the beginning of the string.
!       tmp1 = Word offset within the stringet div 2).
!       DstLsb = Least significant bit of the destination byte address.
!       DstWord = First destination word.
.
!       Word containing character fetched and readable on Mdi.
!
! Calls:
!       ChkOvr, VectSrv.
!
!------------------!       DstByte = First destination byte.
!
! Calls:
!       VectSrv.
!
!-------------------------------------------------------------------------------------------------------------

GetStringIndex: tmp := Tos and AllOnes, Pop, RightShift(1);      ---------------------------

GetSrcDst: tmp3 := Tos and AllOnes, Pop, RightShift(1);  ! get Src byte offset
        Src := Sh ! byte offset
        tmp1 := Shift, if IntrPend Call(VectSrv);! word offset
        Tos + SB, Fetch;
        tmp4 := Mdi anift + SB, if IntrPend Call(VectSrv);
        Src := Tos + Src, Fetch;             ! Src word address
        SrcLsb := tmp3, Pd 377;
        tmp4 - tmp;
        tmp4 := Tos + SB, if Lss Goto(ChkOvr);
        tmp4 + tmp1, Fetch, Return;

! Routine Gop;                 ! Src least significant bit
        if Odd Goto(GetSD2);                 ! if first byte is upper byte
   etSrcDst.
!-----------------------------------------------------------------------------
!
! Abstract:
!       GetSrcDst get     SrcWord := Mdi;                      ! 1st Src word
        SrcByte := Mdi and 377;              ! 1st Src byte
GetSD1: ts a source and destination byte pointer from the
!       expression stack.  It also pre-fetches the first bytes referenced
!  mp3 := Tos and AllOnes, Pop, RightShift(1);     ! get Dst byte offset
        Dst := Shift + SB, if IntrPend Call(VectSrv);
       by the two byte pointers.  This is done to get the length bytes
!       for string operations.  The result conditions of G      Dst := Tos + Dst, Fetch;             ! Dst word address
        DstLsb := tmp3, Pop;                 ! Dst least significetSrcDst are
!       precisely the evironment for GetSrc, GetDst, and PutDst.
!
! Environment:
!       (Tos) = Source byte oant bit
        if Odd Goto(GetSD3);                 ! if first byte is upper byte
        DstWord := Mdi;                    ffset.
!       (Tos-1) = Source address as offset from stack base.
!       (Tos-2) = Destination byte offset.
!       (Tos-3)  ! 1st Dst word
        DstByte := Mdi and 377, Return;      ! 1st Dst byte

GetSD2: SrcWord := Mdi, Field(0,10);         !  = Destination address as offset from stack base.
!
! Result:
!       Stack popped four times.
!       Src = Source word phy1st Src word
        SrcByte := Shift, Goto(GetSD1);      ! 1st Src byte

GetSD3: DstWord := Mdi, Field(0,10);         ! 1st sical address (Address + ByteOffset div 2).
!       SrcLsb = Least significant bit of the source byte address.
!       SrcWordDst word
        DstByte := Shift, Return;            ! 1st Dst byte

! Routine GetSrc.
!---------------------------------- > 	
:= Z80ByteCnt - 1, if Odd GoTo(Z80St4a);
                                        !  data is arriving for RS232
           Z80CSt13a:
Case(Z80St0,13), Z80ByteCnt := Z80Chr;
           Z80Byte := Z80Byte and not 1,   !Start on low byte
                 hr, LeftShift(10);       !Data coming in,
           Z80Tmp := Shift, GoTo(NiceRet);!   Save as high byte
Z80St4a:   ioChar :=                        if Neq GoTo(Z80BumpState);
           Z80ByteCnt := C400, GoTo(Z80BumpState);  !zero byte count means 2 Z80Tmp, If Neq GoTo(Z80St4c); !This is a low byte
           Z80State := 0;              !Count just hit 0, all done
Z80St4c:56




!       State 14 - Data byte.

Case(Z80St0,14), Z80Byte;
           Z80Byte := Z80Byte xor 1, if Odd GoTo(Z80St14   ioDevTab + Z80VIntr, Fetch;
           ioChar := ioChar or Z80Chr; !Merge high byte with low byte
           UserIntr := MDa);
           Z80ByteCnt := Z80ByteCnt - 1;
           Z80Tmp := Z80Chr, if Gtr GoTo(NiceRet);!low byte, done if byt cnt = 0I or UserIntr, GoTo(Z80St2a); !Put data in buf




!       State 5 - Tablet low X.

Case(Z80St0,5), Z80Tmp := Z80Chr, Got
           Z80Chr := 0;                !No high byte if count was odd
Z80St14a:  Z80Chr, LeftShift(10);      !here on high byto(Z80BumpState);




!       State 6 - Tablet high X.

Case(Z80St0,6), Z80Chr, LeftShift(10);
           Z80Tmp := Shifte
           Z80Tmp := Shift or Z80Tmp;  !merge hi byte with low byte
           Z80Buff := Z80Buff + 1, Store;  !Put word in  or Z80Tmp;  !Merge with low X
           ioTabAdr, Store;            !Store as first tablet word
           Z80Tmp, GoTo(Z80Bmemory
           Z80Tmp;                     !Merged data
           Z80ByteCnt := Z80ByteCnt - 1;!Check Byte Count
        umpState);




!       State 7 - Tablet low Y.

Case(Z80St0,7), Z80Tmp := Z80Chr, GoTo(Z80BumpState);




!       St   If gtr GoTo(NiceRet);       !more bytes to go
           ioDevTab + Z80VIntr, Fetch;
           Z80State := 0;             ate 10 - Tablet high Y.

Case(Z80St0,10), Z80Chr, LeftShift(10);
           Z80Tmp := Shift or Z80Tmp;  !Merge with low Y
   !all done
           UserIntr := MDI or UserIntr, GoTo(NiceRet);!Cause done intr




!       State 15 - Floppy data.

C         ioTabAdr + 1, Store;        !Tablet Y word, save data
           Z80Tmp, GoTo(Z80BumpState);




!       State 11ase(Z80St0,15), Z80FloppyDcb+14, Store;
           Z80Chr;
           Z80VIntr := Z80FlpIntMsk, Goto(SetState13);




!   - Clock ticks.

Case(Z80St0,11), Z80State := 0, Goto(NiceRet);
! *** Moved time base maintenance to video.  GGR 31 Mar 81
     State 16 - Floppy done, concise status.

Case(Z80St0,16), Z80FloppyDcb+14, Store;
           Z80Chr;
           ioDevTao(Z80St2b);  !set up WrPtr to end of buff




!       State 3 - RS232 byte count.

Z80St3a:
Case(Z80St0,3), Z80ByteCnt :



!       State 12 - Status change data.

Case(Z80St0,12), Z80Status := Z80Chr;
           Z80Status := Z80Status or 340= Z80Chr, GoTo(Z80BumpState);




!       State 4 - RS232 data byte.

Case(Z80St0,4), Z80ByteCnt;
           Z80ByteCnt ;  !Set ok for SetStatus/GetStatus
           Z80State := 0, GoTo(Z80StartScan);




!       State 13 - Byte count.

Z80 ?  	
rv);
        Goto(GetSrc1);

! Routine GetDst.
!---------------------------------------------------------------------------ation byte into a byte array or a string.
!
! Environment:
!       Dst = Destination word physical address.
!       DstLsb =--
!
! Abstract:
!       GetDst gets the next destination byte from a byte array or a string.
!
! Environment:
!       Dst Least significant bit of the destination byte address.
!       DstWord = Current destination word with current byte removed.
 = Destination word physical address.
!       DstLsb = Least significant bit of the destination byte address.
!       DstWord !       SrcByte = Current source byte to be put into the destination.
!
! Result:
!       DstWord = Current destination word = Current destination word.
!
! Result:
!       DstWord = Current destination word with current byte removed.
!       DstBytwith source byte added.
!
! Calls:
!       VectSrv.
!
!--------------------------------------------------------------------ing.
!
! Environment:
!       Src = Source word physical address.
!       SrcLsb = Least significant bit of the source byte e = Current destination byte.
!       Destination address (Dst and DstLsb) advanced to next byte.
!
! Calls:
!       VectSrvaddress.
!       SrcWord = Current source word.
!
! Result:
!       SrcWord = Current source word.
!       SrcByte = Curren.
!
!-----------------------------------------------------------------------------

GetDst: DstLsb;
        if Odd Goto(Gett source byte.
!       Source address (Src and SrcLsb) advanced to next byte.
!
! Calls:
!       VectSrv.
!
!-------------Dst2);                ! if upper byte
GetDst1: Dst, Fetch;                         ! get a new word
        DstLsb := 1, if In----------------------------------------------------------------

GetSrc: SrcLsb;
        if Odd Goto(GetSrc2);              trPend Goto(GetDst3);  ! next byte is upper byte
        DstWord := Mdi and not 377;          ! current word
        DstByte :  ! if upper byte
GetSrc1: Src, Fetch;                         ! get a new word
        SrcLsb := 1, if IntrPend Goto(GetSrc3)= Mdi and 377, Return;      ! current byte
        
GetDst2: DstWord, RightShift(10);            ! get upper byte from current;  ! next byte is upper byte
        SrcWord := Mdi;                      ! current word
        SrcByte := Mdi and 377, Retur word
        DstByte := Shift and 377;            ! current byte
        Dstword := DstWord and 377;          ! current wordn;      ! current byte
        
GetSrc2: SrcWord, RightShift(10);            ! get upper byte from current word
        SrcBy
        Dst := Dst + 1, if IntrPend Call(VectSrv);  ! advance to next word
        DstLsb := 0, Return;                 ! nextte := Shift and 377;            ! current byte
        Src := Src + 1, if IntrPend Call(VectSrv);  ! advance to next word
     byte is lower byte

!       Serve an interrupt.

GetDst3: Call(VectSrv);
        Goto(GetDst1);

! Routine PutDst.
!--    SrcLsb := 0, Return;                 ! next byte is lower byte
        
!       Serve an interrupt.

GetSrc3: Call(VectS---------------------------------------------------------------------------
!
! Abstract:
!       PutDst puts the next destin ? 	
        Z80OState := 1, GoTo(NiceRet);


!       Message 1 - Start RS232 output.

Z80StartRS232: ioPhysAdr := ioRsOutCb, Ca   Z80OBytCnt := 40, if eql goto(Z80SSpc2); !even tho buffer is bigger
           Z80OVintr := Z80NulIntMsk;        !no interrub + Z80FlpIntMsk, Fetch;
           Z80State := 0;
           UserIntr := MDI or UserIntr, Goto(NiceRet);




!       Stall(cbSetUp);!Get read and write pointer
           Z80WantOutput := Z80WantOutput and not Z80DoRS232;
           Z80Status := te 17 - GetStatus byte count.

Case(Z80St0,17), Z80State := 13;
           Z80Buff, Store, Goto(Z80St13a);




!       SZ80Status and not Z80DoRS232;
           Z80OBytCnt := ioWrPtr;   !Compute how many chars are in buffer
           Z80OBytCnt tate 20 - GPIB byte count.

Case(Z80St1,0), Goto(Z80St3a);




!       State 21 - GPIB data.

Case(Z80St1,1), Z80Tmp :=:= Z80OBytCnt - ioRdPtr; !as WrPtr - RdPtr
           Z80Otmp := 1, if geq goto(Z80StRs1);   !But watch out for wrap around
   0;
           Z80ByteCnt := Z80ByteCnt - 1, GoTo(Z80St4a);




$Title Perq to Z80 communications.

! Start Perq to Z80         Z80OBytCnt := Z80OBytCnt + ioLen; !wrap around occurred, fix count
Z80StRs1:  Z80OBytCnt - 20;  !Don't send more than  communication.
!-----------------------------------------------------------------------------
!
!---------------------------16. bytes
           Z80OtmpState := 11, if leq GoTo(Z80FirstByte);
           Z80OBytCnt := 20, GoTo(Z80FirstByte);


!   --------------------------------------------------

Z80StartScan: Z80OState;  !Here to start a scan, check to see if we are bu    Message 2 - Start floppy.

Z80StartFloppy: Z80Otmp := 2;  !Command Code 2
           Z80WantOutput := Z80WantOutput and nsy
           If Neq Return;!something already in progress
Z80Scan:   Z80OTmp := Z80WantOutput;
           Z80Otmp := Z80Otmpot Z80DoFloppy;
           Z80Status := Z80Status and not Z80DoFloppy;
           Z80OVIntr := Z80NulIntMsk;
           Z80Ot and Z80Status; !Clear out any wants that cant be
           Z80Otmp and Z80DoSeek;
           Z80Otmp and Z80DoSpeech,  if nempState := 4, GoTo(Z80FirstByte);


!       Message 3 - Start GPIB output.

Z80StartGpib: Z80Otmp := 3;
           Z80OBytq GoTo(Z80StartSeek);
           Z80Otmp and Z80DoFloppy,  if neq GoTo(Z80StartSpeech);
           Z80Otmp and Z80DoGpib,    iCnt := Z80488Cnt;
           Z80OVintr := Z80488OutIntMsk;
           Z80OAdr := Z80488Adr;
           Z80OAdr := Z80OAdr - 1f neq GoTo(Z80StartFloppy);
           Z80Otmp and Z80DoRS232,   if neq GoTo(Z80StartGpib);
           Z80Otmp and Z80DoSetSta;        ! incremented before first fetch
           Z80WantOutput := Z80WantOutput and not Z80DoGpib;
           Z80Status :=te,if neq GoTo(Z80StartRS232);
           Z80Otmp and Z80DoGetState,if neq GoTo(Z80SSetState);
                                Z80Status and not Z80DoGpib;
           Z80OtmpState := 13, GoTo(Z80FirstByte);


!       Message 4 - Start speech.

Z80S      if neq GoTo(Z80SGetState);
           GoTo(NiceRet);

Z80FirstByte: C400 or 153, IOB(Z80DataIOB);  !Send Flag Byte
   tartSpeech: Z80Otmp := 4; !Command Code 4 
           Z80spchCnt := Z80spchCnt - 40;    !send only 40 bytes at a time
         @  	
ts of the comparison.
!
! Environment:
!       Next byte in the opcode/operand stream = Length.
!       If Length <> 0:
!    ! get next byte
        tmp2 := tmp2 - 1, Goto(BytCmp2);     ! count byte

!       Byte arrays are equal.

BytCmp4: 0, Re          (Tos) = Byte offset for ByteArray0.
!            (Tos-1) = Word address of ByteArray0.
!            (Tos-2) = Byte oturn;                          ! return Eql

!       Byte arrays are not equal, return with condition codes set for
!       bffset for ByteArray1.
!            (Tos-3) = Word address of ByteArray1.
!       If Length = 0:
!            (Tos) = Length oyte comparison.

BytCmp5: dstByte - srcByte, Return;

! Routine StrCmp.
!-------------------------------------------------f byte arrays.
!            (Tos-1) = Byte offset for ByteArray0.
!            (Tos-2) = Word address of ByteArray0.
!       ----------------------------
!
! Abstract:
!       StrCmp compares two strings.  After the call to StrCmp, the Eql,
!            (Tos-3) = Byte offset for ByteArray1.
!            (Tos-4) = Word address of ByteArray1.
!
! Result:
!       Length remNeq, Leq, Lss, Geq, and Gtr condition codes can be used to check
!       the results of the comparison.  The strings must be wooved from opcode/operand stream.
!       If Length <> 0:
!            Stack popped four times.
!       If Length = 0:
!     rd aligned.
!
! Environment:
!       (Tos) = Byte offset for String0.
!       (Tos-1) = Word address of String0.
!       (T       Stack popped five times.
!       ALU result = ByteArray0 compared to ByteArray1.
!
! Calls:
!       GetSrcDst, GetSrcos-2) = Byte offset for String1.
!       (Tos-3) = Word address of String1.
!
! Result:
!       Stack popped three times.
!---------

PutDst: DstLsb;
        if Odd Goto(PutDst1);                ! if lower byte
        SrcByte, LeftShift(10);     , GetDst, VectSrv.
!
!-----------------------------------------------------------------------------

BytCmp: tmp2 := NextOp;         ! move SrcByte to upper byte
        DstWord := Shift or DstWord,          ! put SrcByte in upper byte
                                    ! get length
        if Neq Goto(BytCmp1);                ! if non-zero length byte
        tmp2 := Tos,                      if IntrPend Call(VectSrv);
        Dst - 1, Store;
        DstWord, Return;                     ! store  Pop;                    ! get length from expression stack
BytCmp1: Call(GetSrcDst);                    ! get byte pointers
 destination word

PutDst1:DstWord := DstWord or SrcByte, Return;  ! put SrcByte in lower byte

! Routine BytCmp.
!--------       Goto(BytCmp3);                       ! enter comparison loop

BytCmp2: if Lss Goto(BytCmp4),               ! if done an---------------------------------------------------------------------
!
! Abstract:
!       BytCmp compares two byte arrays. d all equal
                               dstbyte - srcbyte;  ! compare bytes
        if Neq Goto(BytCmp5);                !  After the call to BytCmp, the Eql,
!       Neq, Leq, Lss, Geq, and Gtr condition codes can be used to check
!       the resulif done and not equal
BytCmp3:Call(GetSrc);                        ! get next byte
        Call(GetDst);                       @ 	
ek;
           Z80OData := dskSeek;
           Z80OtmpState := 10, Goto(Z80FirstByte);


!       Message 13 - Start GetStat, if eql goto(Z80OSt3e);!Save Data, drop out if done
           Z80OData or C400, IOB(Z80DataIOB);     !Send out low byte

  us.

Z80SGetState:  Z80Otmp := 13;      !Command code 13  GetStatus
           Z80WantOutput := Z80WantOutput and not Z80DoGe         Goto(NiceRet);                         ! must allow time to drop
                                                  ! itState;
           Z80OData := Z80StateType;
           Z80OAdr := Z80StateAdr;
           Z80OtmpState := 10, GoTo(Z80FirstBnterrupts, so don't get
                                                  ! the "IOB" too close to "if
                       yte);

! Perq to Z80 interrupt service.
!-----------------------------------------------------------------------------
!
!                           ! IntrPend"

! More for State 3
Z80OSt3b:  Z80OBytCnt := Z80OBytCnt - 1;          !Here on high bypt on completion
           Z80Restart := Z80Restart or Z80DoSpeech;  !keep sending chunks
Z80SSpc1:  Z80OAdr := Z80SpchAdr; !-----------------------------------------------------------------------------

Z80OIntSrv: Z80OState, Field(0,4),loc(Z80OInt);Address to doit tuit
           Z80SpchAdr := Z80SpchAdr + 20;  !Keep addr right for next time
           Z80WantOutput := Z80
           Dispatch(Z80OSt);     !Go to current state

! General Purpose - On to next sequential state and return
Z80OBumpSWantOutput and not Z80DoSpeech;
           Z80Status := Z80Status and not Z80DoSpeech;
           Z80OtmpState := 2, GoTo(Z80Ftate: Z80OState := Z80OState + 1, GoTo(NiceRet);


!       State 1 - Send Message Type.

Case(Z80OSt,1), Z80Otmp or C400, IirstByte);
Z80SSpc2:  Z80OVintr := Z80SpkIntMsk, Goto(Z80SSpc1);   ! last transfer,
                                          OB(Z80DataIOB); !Send Message Type
           Z80OState := Z80OtmpState, GoTo(NiceRet);         !What state is next

!                     ! interrupt when done


!       Message 5, 6, 7, 11, 12, 14 - Start SetStatus.

Z80SSetState:  Z80Otmp := Z80State 2 - Send Byte Count.

Case(Z80OSt,2), Z80OBytCnt or C400, IOB(Z80DataIOB); !Send Byte Count
           Z80Byte := Z80ByStateType;   !Command code 5,6,7,11,12,14  SetState
           Z80OAdr := Z80StateAdr, Fetch; !Get Byte count from 1st word in te and not 200, Goto(Z80OBumpState);
                                                  !Start with low byte


!       State buff
           Z80WantOutput := Z80WantOutput and not Z80DoSetState;
           Z80OVintr := Z80SetIntMsk;
           Z80Otm3 - Data Byte Going out.

Case(Z80OSt,3), Z80Byte;
           Z80Byte := Z80Byte xor 200, if ByteSign GoTo(Z80OSt3b);
      pState := 2;
           Z80OBytCnt := MDI, GoTo(Z80FirstByte);   !here is byte count


!        Message 10 - Start seek.

     Z80OAdr := Z80OAdr + 1, Fetch;         !Get a data word - do low byte
           Z80OBytCnt := Z80OBytCnt - 1, LeftShift(1Z80StartSeek: Z80Otmp := 10;                !Start Seek, Send code 10
           Z80WantOutput := Z80WantOutput and not Z80DoSe0);!Check byte Count
                                                  !expiration & preset shifter
           Z80OData := MDI A  	
 - srcByte, Push;      ! compare lengths, save difference
        tmp := srcByte, if Geq Goto(StrCmp1);  ! if src is shorter
        Code state pointers saved in ACB.
!       Expression stack saved in ACB.
!       Code state pointers updated.
!
! Cal       tmp := dstByte;

!       Compare the strings, tmp is length of shorter string.

StrCmp1: if Eql Goto(StrCmp3);       ls:
!       GetLL, GetSL, SvStk, VectSrv, S.
!
!-----------------------------------------------------------------------------        ! if strings equal up to tmp
        Call(GetSrc);                        ! get next character
        Call(GetDst);  

! Routine CllV.
!-----------------------------------------------------------------------------
!
! Abstract:
!       Cll                      ! get next character
        dstByte - srcByte, if IntrPend Goto(StrCmp5);
StrCmp2:if Neq Goto(StrCmp4);V is a common routine used to make a call to a routine described
!       by a variable routine descriptor.  CllV builds the new                ! if characters are not equal
        tmp := tmp - 1, Goto(StrCmp1);       ! count the character

!       Str activation
!       record and set up the new pointers (GP, AP, TP, etc.).
!
! Environment:
!       tmp = New routine numberings are equal up to length of shorter string, return with
!       condition codes set for length comparison.

StrCmp3: Tos, .
!       tmp5 = New code segment number.
!       tmp6 = New code base.
!       tmp7 = New global pointer.
!       tmp10 = NReturn;

!       Strings are not equal, return with condition codes set for character
!       comparison.

StrCmp4: dstByteew static link.
!       tmp11 = Length of call instruction (for PCBackup).
!       S = Routine to jump to on stack overflow.
 - srcByte, Return;

!       Serve an interrupt.

StrCmp5: Call(VectSrv);
        dstbyte - srcbyte, Goto(StrCmp2);



!       First half of routine dictionary entry fetched and readable on Mdi.
!
! Result:
!       New activation record built.
$List
$Title Call and return routines.

! Routine CllSub.
!--------------------------------------------------------------
!       Code state pointers saved in ACB.
!       Expression stack saved in ACB.
!       Code state pointers updated.
!
! C---------------
!
! Abstract:
!       CllSub is a common routine used by the call opcodes to build the new
!       activatioalls:
!       SvStk, VectSrv, S.
!
!-----------------------------------------------------------------------------

CllSub:       ALU result = String0 compared with String1.
!
! Calls:
!       GetSrcDst, GetSrc, GetDst, VectSrv.
!
!--------------n record and set up the new pointers (GP, AP, TP, etc.).
!
! Environment:
!       tmp = New routine number.
!       tmp5 = N---------------------------------------------------------------

StrCmp: Call(GetSrcDst);                     ! get string poiew code segment number.
!       tmp6 = New code base.
!       tmp7 = New global pointer.
!       tmp11 = Length of call instrnters
        SrcLsb := SrcLsb xor 1;              ! skip length bytes
        DstLsb := DstLsb xor 1;
        Tos := dstByteuction (for PCBackup).
!       S = Routine to jump to on stack overflow.
!
! Result:
!       New activation record built.
! A 	
Data := MDI;
           Z80OData or C400, IOB(Z80DataIOB);
           Z80OState := Z80OState + 1, GoTo(NiceRet);


!       NiceRet);!More to go
           Z80OState := 0, if eql GoTo(NiceRet);  !it is, begone
           Z80WantOutput := Z80WantOutpuState 5 - Floppy cylinder.

Case(Z80OSt,5), Z80OData, RightShift(10);
           Shift or C400, IOB(Z80DataIOB);
           t or Z80DoRS232, return; !More came in
                               !while we were outputting


!       State 13 - GPIB coZ80OState := Z80OState + 1, GoTo(NiceRet);


!       State 6 - Floppy sector.

Case(Z80OSt,6), Z80FloppyDcb + 3, Fetch;
  mmand.

Case(Z80OSt,13), Z80488Cmd or C400, IOB(Z80DataIOB);
           Z80OState := 2, GoTo(NiceRet);


!       State 0 -         Z80OData := MDI;
           Z80OData or C400, IOB(Z80DataIOB);
           Z80OState := Z80OState + 1, GoTo(NiceRet); End of message, turn off Z80 output interrupts.

Case(Z80OSt,0), Z80WantOutput and Z80Status;
           If Neq GoTo(Z80Scan


!       State 7 - Floppy command.

Case(Z80OSt,7), Z80OData, RightShift(10);
           Shift or C400, IOB(Z80DataIOB););                  !If more messages are pending
           0, IOB(Z80DataIOB);                    !Turn off interrupts
     
           Z80OState := 2;                        !Byte count is next
           Z80FloppyDcb + 4, Fetch;               !Get B      GoTo(NiceRet);




$Title Memory Parity error.

! Memory parity error interrupt service.
!-----------------------uffer size
           Z80OAdr := Z80FlpAdr;                  !The Physical Addr of buffer
           Z80OBytCnt := MDI and 777------------------------------------------------------
!
!       We simply generate a run-time error.
!
!-------------------te
           If neq goto(Z80OSt3d);                 !Check for end of msg

Z80OSt3c:  Z80WantOutput := Z80WantOutput or Z80R;             !buffer size
           if Neq GoTo(NiceRet);
           Z80OBytCnt := 1, GoTo(NiceRet);        !change buffer sestart; !Last byte is gone
           ioDevTab + Z80OVintr, Fetch;           !Request Done Interrupt
           Z80Restart := ize zero to 1


!       State 10 - Seek count.

Case(Z80OSt,10), Z80OData or C400, IOB(Z80DataIOB);
           Z80OState :0;                       !No more restarts
           Z80OState := 0;                        !No more bytes
           UserInt= 0, GoTo(NiceRet);


!       State 11 - RS232 byte count.

Case(Z80OSt,11), Z80OBytCnt or C400, IOB(Z80DataIOB);
        r := MDI or UserIntr;           !Request Interrupt here

Z80OSt3d:  Z80OData, RightShift(10);              !Send the high byte   Z80OState := 12, GoTo(NiceRet);


!       State 12 - RS232 data byte.

Case(Z80OSt,12), ioPhysAdr := ioRsOutCb, Call(cbS
           Shift or C400, IOB(Z80DataIOB);
           GoTo(NiceRet);

Z80OSt3e:  Z80OData := Shift, GoTo(Z80OSt3c);  !No moetUp);
           ioChar := 0, Call(cbGet);              !Get the byte from CirBuf
           ioChar or C400, IOB(Z80DataIOB);re bytes on an odd boundary

!       State 4 - Floppy head, unit.

Case(Z80OSt,4), Z80FloppyDcb + 2, Fetch;
           Z80O       !Data out
           Z80OBytCnt := Z80OBytCnt - 1;          !Count Them Bytes
           ioRdPtr - ioWrPtr,If neq GoTo( B  	


!       Get the new static link.

        tmp4 := tmp6;                        ! new code base (for GetLL)
        tmp10 :rve, if C19 Goto(CllSub4);  ! if stack overflow

!       Build new ACB.

CllSub2: LP := Tos - tmp2, Pop;              ! new = tmp, Call(GetLL);           ! get new lexical level
        tmp2 := Mdi - 2;
        tmp3 := tmp1,                        ! LP = local pointer
        tmp2 := TP;                          ! new AP = activation pointer
        TP, Store4;
        tmpsave address of LL in RD
                      if Leq Goto(CllSub3);  ! if calling a top-level routine
        tmp4 := CB;    10 - SB;                          ! new SL = static link
        LP - SB;                             ! new LP = local pointer                      ! current codebase
        tmp10 := RN, Call(GetLL);            ! get current LL
        tmp2 := tmp2 + 
        AP - SB;                             ! new DL = dynamic link = old AP
        GP - SB;                             ! n2;                    ! new lex level
        tmp1 := Mdi - tmp2;                  ! current LL - new LL
                     ew GL = global link = old GP
        tmp13 := UState and 17;
        UPC - CB, LeftShift(1);
        tmp13 := Shift + tmp13;                        ! (typically positive)
        tmp10 := AP, if Geq Call(GetSL);     ! if not calling deeper
          
        TP := TP + 4, Store4;
        tmp12 - tmp1;                        ! new TL = top link = old TP
        CS;                                             ! if calling deeper, new SL = AP
CllSub1: tmp3 - RDLL, Fetch4;                ! get 1st half                        ! return CS = code segment
        tmp13;                               ! RA = return address
         of RD entry

!       Call variable routine entry point.

CllV:   Tos := TP + 1, Push;                 ! address of new locaRN;                                  ! RR = return routine number
        RN := tmp;                           ! new RN = routils area
        tmp1 := Mdi + SB;                    ! PS = parameter size
        tmp2 := Mdi;                         ! RPS ne number
        CS := tmp5, if IntrPend Call(VectSrv);  ! new CS = code segment
        TP := TP + 4, Store;
        0;    = result + parameter size
        tmp3 := Mdi;                         ! LTS = locals + temporaries
        tmp4 := Mdi;                                     ! new EP = exception pointer
        CB := tmp6;                          ! new CB = code base
                   ! entry point

!       Check for stack overflow

        tmp12 := TP;                         ! save TP i        AP := tmp2;                          ! new AP = activation pointer

!       Save the expression stack.

        tmp n case of overflow
        TP := Tos + tmp3;
        TP := TP + 3;                        ! quad-align new ACB
        TP := := not 0, if IntrPend Call(VectSrv);  ! -1
        TP := TP + 1, Call(SaveStack);       ! start after length word
        TP -TP and not 3, if IntrPend Call(VectSrv);  ! new AP
        TP := TP + ACBReserve;
        SL - TP;
        TP := TP - ACBRese tmp, Store;
        tmp, if IntrPend Call(VectSrv);      ! store E-stack length
        GP := tmp7;                           B 	
 must
!      not use the shifter, and must not check for further interrupts.
!
!--------------------------------------------- or UserIntr;   !give him an interrupt
           ioTabAdr + 2, Store2;          !store it in device table
           ClkTim1 --------------------------------

Visloop:   dpyTmp, IOB(343), Loc(VidInt);  !Video Interrupt Service, Load VidState
        := ClkTim1 + 1;        !Double Precision add
           ClkTim2 := ClkTim2 + 0 + OldCarry;  !To get new clock data
              Z80State;
           dpyTmp, IOB(340), if Lss Return;  !Load LineCount
                                         ! Z80State return;                        !***this can't happen during T1
                                          !***following Store2
< 0 before DevTab setup
GetNxtCm:  dpyCntlBlk+6,Fetch;
           ioTmp := dpyTmp;
           nop;
           MDI, IOB(344);

$Title Undefined interrupts.

! Undefined interrupt service.
!----------------------------------------------------------                !Load cursor X Value
           dpyCm := dpyCm + 1, Fetch;    !Get the next Video Command word
           dpyC-------------------
!
!       We simply generate a run-time error
!
!-------------------------------------------------------Base, IOB(342);           !Load Cursor Addr if cursor time
           ioTmp AND 1200;               !Test for Vertical load stu----------------------

BadIntr1:  nop, loc(BadInt1);
BadIntr:
NetIntr:   tmp3 := 0, loc(NetInt);
           tmp2 := ErrUndff bit
           dpyTmp := MDI, IF Eql Return; !This will be the next command
           ioTmp and 200;
           if Eql gofInt, Goto(RunError);




$Title 3MHz Ethernet support.

! 3MHz Ethernet support.
!------------------------------------to(Retrace);         !if beginning of vertical retrace
VBlank:    dpyTmp := 0;                  !simulate normal command
     -----------------------------------------
!
!-----------------------------------------------------------------------------

                                    !because dpyTmp contains garbage
           dpyCntlBlk, Fetch2;           !Fetch the Video {Ether3MBaud not supported.
 $Include IOE3.Micro
 Ether3MBaud not supported.}
        Goto(BadIntr), Loc(E3Int);




$Ticontrol block
           Call(ioTLate);
           dpyCntlBlk+2, Fetch2;
           dpyCm := ioPhysAdr;           !This is adtle Initialization.

! Device table set-up StartIO.
!---------------------------------------------------------------------------------------------------------------------------------


ParIntr:   IOB(147), Loc(ParInt);
           tmp3 := 0;
      dr of first command word
           dpyCm := dpyCm - 1;           !Offset cause GetNxt increments
           MDI, IOB(341);        tmp2 := ErrMParity, Goto(RunError);




$Title Video.

! Video interrupt service.
!-------------------------------             !Load address of Screen Bit Map
           dpyCBase := MDI, GoTo(GetNxtCm); !Pick up Mem addr of cursor bit map
----------------------------------------------
!
! Design:
!      To avoid wrecking raster-op, this interrupt service routine
! *** Moved time base maintenance to video.  GGR 31 Mar 81
Retrace:   ioDevTab + ClkIntMsk, Fetch;
           UserIntr := MDI C  	
;
        Tos, Pop, Goto(SaveStack);           ! store a word
(*****

! Routine RestoreStack.
!---------------------------Shift(3);
        Hold, tmp1 := Shift + CB;
        Hold, tmp1 := tmp1 + RDEXIT;
        Hold, Mdi + tmp1, Fetch;            --------------------------------------------------
!
! Abstract:
!       RestoreStack restores the expression stack from the  ! fetch exit word in dictionary
        BPC := Mdi and 7, RightShift(1);     ! set BPC and UPC
        Mdi and not 7;
      ACB prior to
!       returning from a routine.
!
! Environment:
!       Expression stack empty.
!
! Result:
!       Expre  UPC := Shift + CB, Return;

! Routine ExSub.
!----------------------------------------------------------------------------! new GP = global pointer

!       Set up new PC.

! ----> The following instruction is a good place to set a breakpoint.  Cssion stack restored.
!
! Calls:
!       VectSrv.
!
!----------------------------------------------------------------------S,
! ----> RN, and UPC have their new values, although BPC doesn't yet.

        BPC := tmp4 and 7;                   ! CB is-------

RestoreStack:AP + ACBStackSize, Fetch;
        tmp1 := AP;
        tmp1 := tmp1 + ACBSaveStack;
        tmp2 := Md on a 256 word boundary
        tmp4 and not 7, RightShift(1);
        UPC := Shift + CB, Return;           ! quad program coui;                         ! number of saved words of stack
        tmp1 := tmp1 + tmp2, if Eql Return;  ! if no words to restonter

!       Set SL for top-level routines: LL <= 2.

CllSub3: tmp10 := SB, Goto(CllSub1);         ! static link is not usere
Restore1: tmp1 := tmp1 - 1, Fetch;
        tmp2 := tmp2 - 1, Push, if IntrPend Goto(Restore2);
        Tos := Mdi, if Gtr d

!       Signal a stack overflow.  Restore Both stacks.

CllSub4: TP := tmp12, Pop, GotoS;

! Routine SaveStack.
!----Goto(Restore1);   ! if more words to restore
        Return;

!       Serve an interrupt.

Restore2: tmp1 := tmp1 + 1, Call-------------------------------------------------------------------------
!
! Abstract:
!       SaveStack saves the expressio(VectSrv);
        Pop, tmp2 := tmp2 + 1, Goto(Restore1);
*****)

! Routine RetExit.
!------------------------------------n stack in the activation control block.
!
! Environment:
!       TP = First word address of the saved stack (length word + 1-----------------------------------------
!
! Abstract:
!       RetExit is used when a RETURN instruction finds that the retu).
!       tmp = -1.
!
! Result:
!       Expression stack pushed onto memory stack.
!       tmp = Number of saved words.
!rn
!       address is zero.  This means that the return address is the exit
!       point of the routine.
!
! Result:
!    
!-----------------------------------------------------------------------------

SaveStack:  UState and 1000;                   PC set to exit point of current routine.
!
! Calls:
!       VectSrv.
!
!------------------------------------------------ ! extract StackEmpty field
        tmp := tmp + 1, if Eql Return;       ! bottom of stack reached
        TP := TP + 1, Store-----------------------------

RetExit: CB, Fetch;                          ! fetch dictionary address
        Hold, RN, Left C 	
------
!
!-----------------------------------------------------------------------------

devTabSetUp: tmp and 20, Case(Startio488InCb := ioPhysAdr,                      ! GPIB
                 StackReset,                            ! DDS 366
        IO,0);  !Do we wish to set up stack stuff?
           if eql goto (DoDevTabSet);   !if not set stack subfunction
           Ca         nextinst(0);       




$Title ioTLate, ioTLateA, ioTLateB

! Routine ioTLate - Translate virtual address to phll(SetQState);
           NextInst(0);

DoDevTabSet: ClkTim1 := 0;
           ClkTim2 := 0;
           Z80State := 0;      ysical address.
!-----------------------------------------------------------------------------
! Abstract:
!   This routine i
           Z80Restart := 0, IOB(301);  !Let Z80 Go
           Z80SpchCnt := 0, Call(ioTLateB);
           
           Stacks used by the IO system to translate a VA to
!   a PA.
!
! Environment:
!   This routine expects a Fetch2 of the pointer to Reset;                                  ! DDS 362
           ioDevTab := ioPhysAdr, StackReset;           ! DDS 363
          have been executed.
!   The Fetch2 will happen in T3.  Entry must be made into this routine
!   by T2.
!
! Result:
!   The  ioDevTab, Fetch2;
           Call(ioTLate);
           IntPtr := ioPhysAdr;
           
           ioDevTab + ioDpyDTentry,PA of the memory is left in IOPhysAdr.
!
! Side Effects:
!   This procedure will place the Segment and Offset of the pointer Fetch2;
           Call(ioTLate);
           dpyCntlBlk := ioPhysAdr, Call(VBlank);       !set up video registers
          
!   into IOSeg and IOOffset.
!
!-----------------------------------------------------------------------------

! Routine io StackReset;                                  ! DDS 364
           
           ioDevTab + ioTabDTentry, Fetch2;
           CaTLateA - Translate virtual address to physical address.
!----------------------------------------------------------------------ll(ioTLate);
           dpyTmp := 101351;
           ioTabAdr := ioPhysAdr, Call(VisLoop);        !start screen
           St-------
! Abstract:
!   This routine is used by the IO system to translate a VA to
!   a PA.
!
! Environment:
!   This rouackReset;                                  ! DDS 365
           
           ioDevTab + ioKbdDTentry, Fetch2;
           Call(tine expects IOSeg and IOOffset to contain the Segment and
!   the Offset portions of the pointer.
!
! Result:
!   The PA ofioTLate);
           ioKbdCb := ioPhysAdr;
           
           ioDevTab + ioRsiDTentry, Fetch2;
           Call(ioTLate); the memory is left in IOPhysAdr.
!
!
!-----------------------------------------------------------------------------

! Rou
           ioRsInCb := ioPhysAdr;
           
           ioDevTab + ioRsoDTentry, Fetch2;
           Call(ioTLate);
      tine ioTLateB - Translate virtual address to physical address.
!---------------------------------------------------------------     ioRsOutCb := ioPhysAdr;
           
           ioDevTab + io488InDTentry, Fetch2;
           Call(ioTLate);
           --------------
! Abstract:
!   This routine is used by the IO system to translate a VA to
!   a PA.
!
! Environment:
!   T D  	
ExSub1: tmp2 + ACBRA, Store;                 ! set a return address to zero
        0;
        if IntrPend Call(VectSrv);
   10 + TP, Goto(ChkStk2);

ChkStk1: Call(VectSrv);                      ! serve an interrupt
ChkStk2: SL - tmp10, if IntrPend G     tmp2 + ACBRS, Fetch;                 ! get return segment number
        Mdi - tmp;
        if Neq Goto(ExSub2);         oto(ChkStk1);
        tmp10 := tmp10 - TP, if C19 Goto(ChkStk3);  ! if no room
        Return;                              !         ! if segment numbers don't match
        tmp2 + ACBRR, Fetch;                 ! get return routine number
        Mdi there's room, so return

!       No room, signal error by jumping to S.
 
ChkStk3:GotoS;

! Routine ErrCall.
!----------- tmp1;
        if Eql Return;                       ! if routine numbers match, done
ExSub2: tmp2 + ACBDL, Fetch;            -------------------------------------------------------------------
!
! Abstract:
!       ErrCall initiates the raising of an     ! get next ACB
        tmp2 := Mdi + SB, Goto(ExSub1);




$Title Error processing routines.

! Routine ChkOvr.
! exception by calling routine
!       RNRaise in segment ExcCS (procedure Raise in module Except).
!       The caller pushes p-----------------------------------------------------------------------------
!
! Abstract:
!       ChkOvr signals a ErrInxCaarameters to the exception (if any) onto the
!       memory stack before calling ErrCall.  ErrCall is jumped to and
!       ex-
!
! Abstract:
!       ExSub is used by EXIT and EXGO to get the target segment number and
!       routine number from the se error.  ChkOvr is not called, rather it
!       is jumped to.  It exits to RunError0.
!
! Result:
!       tmp2 = ErrInxCaopcode/operand stream and set return addresses
!       to zero in the memory stack.
!
! Environment:
!       Segment and rouse.
!
! Calls:
!       RunError1.
!
!-----------------------------------------------------------------------------

ChkOvtine numbers are in the opcode/operand stream.
!       tmp2 = Target AP.
!
! Result:
!       Appropriate return addresses ser: tmp2 := ErrInxCase, Goto(RunError0);

! Routine ChkStk.
!----------------------------------------------------------------t to zero.
!
! Calls:
!       WordParm, XSTMap, VectSrv.
!
!----------------------------------------------------------------------------
!
! Abstract:
!       ChkStk checks to be sure that N words can be pushed onto the memory
!       stack withou--------------

ExSub:  Call(WordParm);                      ! get ISN
        tmp := Shift + tmp, Call(XSTMap);    ! convertt overflowing.  If the words will not fit, ChkStk jumps
!       to the address in the 2910's S register.
!
! Environment:
!  to XSN
        tmp1 := NextOp;                      ! get routine number
        tmp - CS;
        tmp2 := AP, if Neq Goto(E      tmp10 = Number of words.
!       S = Address of stack overflow handler.
!
! Result:
!       tmp10 unchanged.
!
! CalxSub1);     ! if different code segment
        tmp1 - RN;
        if Eql Return;                       ! if current routine
ls:
!       VectSrv.
!
!-----------------------------------------------------------------------------

ChkStk: tmp10 := tmp D 	
nter was done.  The
!   Fetch2 will happen in T3.  That means that entry to this routine
!   must be made before T2.
!
! Resity routines

! Routine NiceRet.
!-----------------------------------------------------------------------------
!
! Abstraults:
!   The low order 16 bits of the PA are left in IOPhysAdr.  The
!   high order 4 bits are left in IOPhAdrHi.
!
! Side ct:
!   General Purpose Exit (checks for other interrupts)
!
!---------------------------------------------------------------Effects:
!   This procedure will set IOOffset and IOSeg. 
!
!------------------------------------------------------------------------------

loc(NiceRet),    if IntrPend GoTo(Vecint);              !Allow more interrupts
           Return;

! Routihis routine expects the pointer to be on the ESTK.
!
! Result:
!   The PA of the memory is left in IOPhysAdr.
!
! Side Effe-------------

! Routine ioXLateA - Translate virtual address to physical address.
!-----------------------------------------cts:
!   This procedure will place the Segment and Offset of the pointer
!   into IOSeg and IOOffset.  It also removes the poi------------------------------------
!
! Abstract:
!   This routine is used to translate a VA to a PA.  It differs from the
nter from
!   the ESTK.
!
!-----------------------------------------------------------------------------

loc(ioTLate), ioO!   IOTLates in that the PA is returned in two pieces. One is
!   16 bits while the other is 4 bits.
!
! Environment:
!   Thffset := MDI;      !entry point if a fetch of the va was made
         ioSeg := MDI, GoTo(ioTLateA);

loc(ioTLateB), ioOffsetis procedure expects the segment and offset of the pointer
!   to be in IOSeg and IOOffset.
!
! Results:
!   The low order 1 := TOS, Pop; !entry point if va is on ESTK
         ioSeg := TOS, Pop;

loc(ioTLateA), MA := ioSeg + ioSeg, Fetch2;  !entry 6 bits of the PA are left in IOPhysAdr.  The
!   high order 4 bits are left in IOPhAdrHi.
!
!--------------------------------pnt if ioSeg & ioOffset are loaded
         ioPhysAdr := MDI and not 376;
         ioPhysAdr := MDX or ioPhysAdr, if Odd goto(---------------------------------------------

loc(ioXLate), ioOffset := MDI;  !entry point if a fetch of va was just made
  ioNotResident);
         ioPhysAdr := ioPhysAdr + ioOffset, return;

$Title ioXLate, ioXLateA

! Routine ioXLate - Transla       ioSeg := MDI;
loc(ioXLateA), MA := ioSeg + ioSeg, Fetch2;  !entry pt if ioSeg & ioOffset are loaded
         ioPhysAdr te virtual address to physical address.
!-----------------------------------------------------------------------------
!
! Ab:= MDI and not 376;
         ioPhAdrHi := MDI, if Odd GoTo(ioNotResident);
                                       !save upper stract:
!   This routine is used to translate a VA to a PA.  It differs from the
!   IOTLates in that the PA is returned in twbits in a register
         ioPhysAdr := ioPhysAdr + ioOffset;  !form actual data with a double
         ioPhAdrHi := ioPhAdrHo pieces. One is
!   16 bits while the other is 4 bits.
!
! Environment:
!   This procedure expects that a Fetch2 of the poii + 0 + OldCarry, return;  !precision add

ioNotResident: tmp3 := 0;
         tmp2 := ErrIOSFlt, Goto(RunError);
$Title Util E  	

!       Four words pushed on the memory stack.
!       Memory[TP - 0] = PStart = TP - 3 - ParameterSize.
!       Memory[TP --------------------------------------------------------------
!
! Abstract:
!       PCBackup sets the Q-code program counter  1] = PEnd = TP - 3.
!       Memory[TP - 2] = ER = tmp2.
!       Memory[TP - 3] = ES = tmp1.
!       tmp10 unchanged.
!     back N bytes.  This is
!       used when a recoverable error is detected (e.g. segment fault).
!       The PC is set back in o  ExcCS unchanged.
!       ExcGP unchanged.
!       tmp1 unchanged.
!
! Calls:
!       ChkSeg, CllSub, RefillJmp, VectSrv.rder that the instruction can be re-executed
!       after the error condition is cleared.
!
! Environment:
!       tmp11 = 
!
! Design:
!       If the Except module has not been initialized, ExcCS = 0.  Since
!       segment 0 is guaranteed to be nNumber of bytes.
!
! Result:
!       tmp = New program counter as byte offset from code base.
!       UPC set back.
!      on-resident, we need not make a
!       separate check for ExcCS = 0.
!
!---------------------------------------------------- BPC set back.
!
! Calls:
!       VectSrv.
!
!------------------------------------------------------------------------------------------------------

ErrCall: TP := TP + 1, Store;
        tmp1, ThreeWayBranch(0);             ! ES, clear the call st

PCBackup: tmp := UState and 17;              ! get byte program counter
        UPC, LeftShift(1);                   ! wordack
        Tos := TP - SB, Push;
        TP := TP + 1, Store;
        tmp2, ThreeWayBranch(0);             ! ER
        TP  program counter ==> bytes
        tmp := Shift + tmp, if IntrPend Call(VectSrv);  ! full byte PC
        tmp := tmp - tmp11, := TP + 1, Store;
        Tos - tmp3, ThreeWayBranch(0);       ! PStart
        TP := TP + 1, Store;
        Tos, Pop;       RightShift(1);   ! new byte program counter
        UPC := Shift and not 3;              ! set UPC back
        BPC := tmp and                     ! PEnd
        tmp5 := ExcCS, ThreeWayBranch(0);    ! segment number of Raise
        tmp := tmp5, Call(C 7, Return;            ! set BPC back

! Routine RunError, RunError0.
!-----------------------------------------------------its to RefillJmp.  If the Except module has not been initialized,
!       is non-resident, or a stack overflow happens while cahkSeg);
        tmp6 := tmp,                         ! code base of Raise
                     if Odd Goto(Busted);    ! if nolling Raise,
!       transfer to Busted.
!
! Environment:
!       tmp3 = ParameterSize = Number of words of parameters.
!  t resident
        tmp := RNRaise,                      ! routine number of Raise
                        LoadS(Busted);           ExcCS = Segment number of the Except module.
!       ExcGP = Global pointer of the Except module.
!       tmp1 = Segment  ! where to go on stack overflow
        tmp7 := ExcGP, ThreeWayBranch(0);
        tmp7 := tmp7 + SB, Call(CllSub);     ! globnumber of the exception.
!       tmp2 = Routine number of the exception.
!
! Result:
!       Micro level call stack cleared.al pointer of Raise
        Goto(RefillJmp);                     ! enter the routine

! Routine PCBackup.
!---------------- E 	
Copyright Three Rivers Computer Corporation, 1981
!
!  Abstract:
!      Floating Point Arithmetic 
!
!  Design:
!                          seeeeeeeehhhhhhhllllllllllllllll
!
!       where s is the sign bit, e is an exponent bit, h is a high order
     assumes the following EStack layout:
!
!                           ===========
!                  TOS ---> | B<low>  |
!       word mantissa bit and l is a low order word mantissa bit. An implied
!       1 is inserted to the left of the most sign!                           | B<high> |
!                           | A<low>  |
!                           | A<high> |
!    ificant h. The value
!       is given by
!                    1.hhhhhhhllllllllllllllll X 2^(eeeeeeee - 127)
!
!       with                        =========== 
!
!         (implements the IEEE floating point standard)
!
!===========================the appropriate sign. For complete details, see the January
!       1980 issue of "Computer".
!
!----------------------------=====================================

!================================================================
!
!  Change Log:
-----------------------------------------
Constant(RealOps,6000);             
Opcode(ROPS), tmp := NextOp;
        tmp, Fiel!
!    12 Mar 82 JBB & SLB
!         Repare double precision compare of real mantissa's
!
!     3 Jan 81 Michael R. Kristofid(0,4);
        Dispatch(RealOps); 







!===========================================================================ne VecInt.
!-----------------------------------------------------------------------------
!
!--------------------------------c
!         Miscellaneous bug fixes (normalize, multiply, compare, trunc, round)
!
!=========================================---------------------------------------------

VecInt:    Vector(IntVec);

! Routine ioBadBerries.
!----------------------=======================


! Opcode ROPS
!---------------------------------------------------------------------
!
! Abstra-------------------------------------------------------
!
! Signal bad StartIO.
!
!-----------------------------------------ct:
!       ROPS is a two byte opcode for performing arithemetic
!       operations on real (32 bit) values.  The second byte ------------------------------------

ioBadBerries:  TOS := 0, NextInst(0);    !Here if StartIO should fail




        eis used
!       as a dispatch into the 15 operations.
!
! Instruction:
!       ROPS
!
! Environment:
!       In general, nd;
                                                                                                                           real operations take their argument(s) from the EStack
!       with the low-order word on top:
!           (Tos) = low word of  1st real
!           (Tos-1) = high word of 1st real
!           (Tos-2) = low word of 2nd real (if applicable)
!           $Title Floating point arithmetic operators.

!================================================================
!
!     (c) (Tos-3) = high word of 2nd real (if applicable)
!
! Note:
!       The IEEE floating point double word is the following:
!
! F  	
e caller pushes parameters to the exception (if any) onto the
!       memory stack before calling RunError.  RunError is jumpeded from
!       STLATE, two segment numbers are passed.  Otherwise, tmp5 contains a
!       segment number, and SegFault is en to and
!       exits to ErrCall.  The variant of RunError that is called depends
!       on how many words of parameters weretered at SegFault1.
!
! Environment:
!       tmp5 = First segment number.
!       tmpstk0 = Second segment number.
!        pushed on the memory stack.
!       RunError0 is called when 0 words were pushed.  If parameters were
!       pushed onto thetmp11 = Amount to back up the program counter.
!
! Result:
!       Program counter backed up.
!       Four words pushed onto memory stack, RunError can be called with ParameterSize
!       in tmp3.
!
! Environment:
!       tmp3 = ParameterSize = Nu the memory stack.
!       Memory[TP - 0] = Code segment number.
!       Memory[TP - 1] = Stack segment number.
!       Memormber of words of parameters (if calling
!                              RunError, not RunError0.
!       ExcCS = Segment numbery[TP - 2] = Second segment number.
!       Memory[TP - 3] = First segment number.
!       Segment fault error signalled.
!
! of the Except module.
!       ExcGP = Global pointer of the Except module.
!       tmp2 = Error number = Routine number of th Calls:
!       PCBackup, RunError.
!
!-----------------------------------------------------------------------------

SegFae exception.
!
! Result:
!       tmp3 unchanged.
!       ExcCS unchanged.
!       ExcGP unchanged.
!       tmp2 unchanged.ult1: tmpstk0 := tmp5;
SegFault: TP := TP + 1, Store;
        tmp5;
        TP := TP + 1, Store;
        tmpstk0;
        T
!       tmp1 = ExcCS.
!
! Calls:
!       ErrCall.
!
!--------------------------------------------------------------------P := TP + 1, Store;
        SS;
        TP := TP + 1, Store;
        CS;
        tmp3 := 4, Call(PCBackup);         ! 4 word---------

RunError0: tmp3 := 0;
Loc(RunError), tmp1 := ExcCS, Goto(ErrCall); 

! Routine SASErr.
!----------------------s of parameters on MStack
        tmp2 := ErrSegmentFault, Goto(RunError);

! Routine StkOv.
!------------------------------------------------------------------------------------
!
! Abstract:
!       SASErr causes the ErrStrLong error.
!
! Resul------------------------------------------------
!
! Abstract:
!       StkOv signals a stack overflow error.
!
! Environment:
!       tmp2 = ErrStrLong.
!
! Calls:
!       RunError0.
!
!-----------------------------------------------------------t:
!       tmp11 = Amount to back up the program counter.
!
! Result:
!       Program counter backed up.
!       Stack over------------------

SASErr: tmp2 := ErrStrLong, Goto(RunError0);

! Routine SegFault.
!-----------------------------------flow error signalled.
!
! Calls:
!       PCBackup, RunError0.
!
!----------------------------------------------------------------------------------
!
! Abstract:
!       RunError is called when the microcode wants to raise an exception.
!       Th------------------------------------------
!
! Abstract:
!       SegFault signals a segment fault error.  If SegFault is call F 	
ACK: blow := TOS, pop; 
        bsign := TOS and SignBit, field(0,7);
        bexp := TOS and 077600;
        TOS, pop, if eqexits with floating point number in ETOS, ETOS-1
!
! Vars:
!       tmp10 - the rounding bit
!
!============================l goto(UnpackBZero);
Unpackx:bhigh := shift + 200, goto(Unpack1);    ! insert the hidden bit
UnpackBZero:                     ==================================================
NORMALIZE:tmp or tmp1;                             ! check on mantissa zero               ! check on operand zero 
        bhigh := shift;                         ! don't insert hidden bit
        bhig
          tmp1 and not 377, if eql goto(NORMZERO); ! try shifting right
          if eql goto(NORMLEFT);
        
NORMRIGHTSh or blow, if neq goto(Unpackx);
        if neq goto(Unpackx);
        bsign := 0;                             ! make zero posHIFT: tmp1, rightshift(1);
                tmp1 := shift, if odd goto(NORMCARRY);
                tmp;
                tmp :=itive
Unpack1:alow := TOS, pop;
        asign := TOS and SignBit, field(0,7);
        aexp := TOS and 077600;
        TOS,if shift, if odd goto(NORMODD);
                tmp10 := 0, goto(NORMINC);
NORMODD:        tmp10 := 1, goto(NORMINC);
NORMCARRY eql goto(UnpackAZero);           ! leave last word on stack
Unpacky:ahigh := shift + 200, return;           ! insert the hidde:      tmp;
                tmp := shift or SignBit, if odd goto(NORMODDCARRY);
                tmp10 := 0, goto(NORMINC);
NOn bit
UnpackAZero:                                    ! check on operand zero 
        ahigh := shift;                        RMODDCARRY:   tmp10 := 1;
NORMINC:        TOS := TOS+200, if IntrPend Call(VectSrv); ! increment exponent

NORMTEST:tmp1 and  ! don't insert hidden bit
        ahigh or alow, if neq goto(Unpacky);
        if neq goto(Unpacky);
        asign := 0, retnot 377;                    ! is the mantissa still to big?
         tmp1, if neq goto(NORMRIGHTSHIFT);      
NORMEXIT:tmp10, urn;                     ! make zero positive




!========================================================================field(0,7);
         tmp1, if odd goto(NORMROUND);
        
NORMRETURN:tmp1 := shift or bsign, if IntrPend Call(VectSrv); ! s===
!
! Subroutine to unpack parameters
!
! Entries:
!       UNPACK: unpack 2 parameters (a,b)
!       UNPACK1:unpack 1 pa======
!
! Codesequence to normalize result, push it on ESTACK, and exit
!
! Entries:
!       NORMALIZE:      assumes exponrameter (a)
!
! Unpacked parameters:
!       bsign   B<sign>
!       bexp    B<exponent>
!       blow    b<low>
!       bhents within bounds
!       NORMOVER:       exponent overflow during previous operations
!       NORMXOVFL:      division by 0 igh   b<high> with hidden bit inserted
!       asign   A<sign>
!       aexp    A<exponent>
!       alow    a<low>
!       ahduring previous operations
!       NORMUNDER:      exponent underflow during previous operations
!
! NORMALIZE assumes:
!   igh   a<high> with hidden bit inserted
! 
!==============================================================================
UNP    TOS  -  exponent
!       tmp  -  low order mantissa
!       tmp1 -  high order mantissa
!       bsign-  sign
!
!        G  	
------------
!
! Abstract:
!       UserSrv serves Pascal level interrupts by calling the appropriate
!       Pascal level in          ! new CS = code segment number
        tmp7 := Mdi + SB;                    ! new GP = global pointer
        tmp2 :terrupt service routine.
!
! Environment.
!       UserIntr bits 0..14 non-zero.  That is, UserIntr > 0.
!
! Result:
!     = Mdi;                         ! new RN = routine number
        tmp10 := Mdi + SB;                   ! new SL = static link
 -------------------

! Routine StkOvPop.
!-----------------------------------------------------------------------------
!
!  One interrupt served.
!
! Calls:
!       ChkSeg, CllV, RefillJmp, VectSrv, StkOv.
!
! Design:
!       It is assumed that Abstract:
!       StkOvPop signals a stack overflow error after popping the expression
!       stack.
!
! Environment:
!  :
!          1) The segment with the interrupt handler is always resident.
!          2) The table with variable routine descr     tmp11 = Amount to back up the program counter.
!
! Result:
!       Stack popped.
!       Program counter backed up.
! iptors (IntTab) is
!             quadword aligned.
!
!-----------------------------------------------------------------------      Stack overflow error signalled.
!
! Calls:
!       PCBackup, RunError0, SetQState.
!
!-------------------------------------

UserSrv: tmp := UserIntr;
        tmp and 377;
        dst := 0, Goto(UserSrv1);            ! initialize count
!***----------------------------------------------

StkOvPop: Pop;
StkOv:  Call(PCBackup);
        tmp := 100;                  **            if Neq Goto(UserSrv1);
!*****  dst := 10, if IntrPend Call(VectSrv);
!*****  userintr, RightShift(10);
!*****         !(must be separate line for placer)
        Call(SetQState);                     ! set stack limit (SL)
        SL := Stmp := Shift;                        ! swap bytes
UserSrv1: if IntrPend Call(VectSrv);
        tmp, RightShift(1);            L + StackLimit;               ! add a little extra to work with
        tmp2 := ErrStackOverflow, Goto(RunError0);

! Routin      ! next bit position
        tmp := Shift, if Odd Goto(UserSrv2); ! if this bit is set
        dst := dst + 1, Goto(UserSe UOP.
!-----------------------------------------------------------------------------
!
! Abstract:
!       UOP signals an Erv1);      ! update bit position counter
        
!       Bit found, index into IntTab by the bit position to get the routinerrUndfQcd error.
!
! Result:
!       tmp2 = ErrUndfQcd.
!
! Calls:
!       RunError0.
!
!-------------------------------
!       descriptor for the interrupt handler.

UserSrv2: dst, LeftShift(2);                 ! turn index into offset
       ----------------------------------------------

UOP:    tmp2 := ErrUndfQcd, Goto(RunError0);
$NoList




$Title Interrup Shift + IntPtr, Fetch4;              ! get variable routine desc.
        UserIntr := UserIntr or 100000;      ! turn off furtts: Microcode level and Pascal level.

! Routine UserSrv.
!-----------------------------------------------------------------her interrupts
        tmp11 := 0, LoadS(StkOv);            ! watch out for stack overflow
        tmp5 := Mdi;                G 	
 0's?
           if eql goto(NORMUNDER);
           TOS - 77600;   ! exp 255?
           TOS,          if eql goto(NORMOVER);  ! and 0 mantissa
           TOS := 0,push;
           goto(RunError0);     ! raise exception


NORMZERO:TOS := 0;         ! exp > 255?
           if lss goto(NORMNOGOOD);
           TOS := TOS or tmp1;
           TOS := tmp, push, NextInst(0);
              ! return 0
         TOS := 0, push, NextInst(0);



!=========================================================       
NORMROUND:tmp := tmp + 1;
        tmp1 := tmp1 + 0 + oldcarry;
        tmp10 := 0, goto(NORMTEST);

NORMLEFT:tmp1 a=====================
!
! Floating Point Multiplication C := A * B
!
! Outline of the algorithm (a and b are the mantissas ond 200, field(0,7);        ! mantissa big enough yet?
         tmp1, if neq goto(NORMRETURN);
         tmp := tmp + tmp;
    f A and B rsp.):
!       1. compute four products (32-bit fixed point arithmetic):
!               a.high*b.high
!                tmp1 := tmp1 + tmp1 + oldcarry;
         TOS := TOS -  200, if IntrPend call(VectSrv);    ! excrement exponent
         t    a.high*b.low
!               b.high*a.low
!               a.low*b.low
!       2. sum: (a.low*b.low)<31:16> + a.high*b.lowmp10 := 0, goto(NORMLEFT);

        
!*************** special cases **************


NORMNOGOOD: tmp2 := 177777;       ! e + b.high*a.low
!          (neglect (a.low*b.low)<15:0>)
!       3. add to (a.high*b.high)<leftshift(16)>
!       4. adjust exponent has over or underflowed - 
                                  ! determine which by examining top 4 bits
            tmpxponent to compensate for fixed point arithmetic
!          and correct for double bias 
!       5. add exponents
!       6. 2 := tmp2 + tmp2;                          ! create 1000000                  tmp2 := tmp2 + tmp2;                          ! crenormalize
!
!==============================================================================
Case(RealOps,MPR), tmpstk3 := 0, ate 1000000
            tmp2 := tmp2 + 4, if IntrPend call(VectSrv);  ! create 1000000
            TOS + tmp2;              ! call(UNPACK);     ! Multiply Real
        tmp := alow, if IntrPend Call(VectSrv);    ! a.low*b.low
        tmp1 := blow, call(if the next to highest bit is on then
            if C19 goto(NORMOVER);   ! underflow else overflow

NORMUNDER:TOS := tmp1, TMulTIPLYLONG);
        tmpstk2 := tmp1;                           ! product.high, neglect low 
        tmp := ahigh, if IntrPif IntrPend call(VectSrv);  ! return the mantissa
          TOS := tmp,push;                         ! with a 0 exponent
     end Call(VectSrv);   ! a.high*b.low
        tmp1 := blow, call(TMulTIPLYLONG);
        tmpstk2 := tmpstk2 + tmp;                   tmp2 := ErrUnderReal, goto(RunError0);   ! and raise exception
          
          
NORMOVER:  tmp2 := ErrOvrReal, if I    ! product.low
        tmpstk3 := tmpstk3 + tmp1 + oldcarry;      ! product.high
        tmp := bhigh, if intrpend call(Vecuppress 
                                                      ! leading 1, insert sign
           TOS and 177600;   ! exp allntrPend call(VectSrv); 
NORMXOVFL: bsign := bsign or 77600;      ! return max exponent
           TOS := bsign;                H  	

!
! Result:
!       Interrupt served.
!
! Calls:
!       IO microcode.
!
!---------------------------------------------Goto(DIVNEG3);
        tmp1:=tmp6, if IntrPend Call(VECTSRV);! remainder
DIVX:   tmp5;
        if odd Goto (DIVNEG2);
      --------------------------------

VectSrv: Vector(IntVec);
                                                                    tmp := tmp and AllOnes, pop, Return; ! MAB
DIVINT: Call(VECTSRV);
        tmp6 - tmp1, Goto(DIVI);
DIVNEG0: tmp:=Tos-tmp, i



$Title Integer routines.

! Routine Divide.
!-----------------------------------------------------------------------f IntrPend Call(VECTSRV);
DIVNEG: tmp5:=tmp5 + 1, Goto (DIVDO);
DIVNEG1: tmp1:=Tos-tmp1, if IntrPend Call(VECTSRV);
        t------
!
! Abstract:
!       Divide forms the quotient of two integers.  A zero divisor causes
!       the ErrDivZero error.mp5 := 1,Goto (DIV0);
DIVNEG2: tmp:=Tos-tmp,pop;              ! MAB
        tmp := tmp and AllOnes, Return;
DIVINC: tmp6:=tmp
!
! Environment:
!       tmp = Dividend.
!       tmp1 = Divisor.
!
! Result:
!       tmp = Quotient.
!       tmp1 = Div6 + 1,Goto (DIVTST);
DIVZERO: tmp2 := ErrDivZero, pop, Goto(RunError0);
DIVNEG3:noop;                           ! MAB
              tmp := tmp5, Call(ChkSeg);           ! get code base
        tmp6 := tmp, Fetch,                  ! offset of routine diidend modulo Divisor.
!
! Calls:
!       RunError0, VectSrv.
!
!-----------------------------------------------------------ctionary
                            if Odd Goto(Busted);  ! if not resident
        Hold, tmp := tmp2, LeftShift(3);
       ------------------

DIVIDE: tmp1;
        tmp5:=0, push, if lss Goto (DIVNEG1);   ! sign indicator
        tmp1;
DIV0:   tm Hold, tmp1 := Shift + tmp6;          ! offset of dictionary entry
        Hold, Mdi + tmp1, Fetch4;            ! fetch dictionp10 := tmp, if eql Goto (DIVZERO);
        tmp, if lss Goto (DIVNEG0);
        if neq Goto (DIVDO);
        tmp1:=0,pop;     ary entry.
        Call(CllV);                          ! set up ACB
        dst, LeftShift(4);                   ! set up shi               ! MAB
        Return;     ! clear remainder, clear stack      MAB
DIVDO:  tmp6:=0,leftShift(10);
        tmp aft mask
        Shift or 17, ShiftOnR;               ! form LeftShift(dst)
        1;                                   ! cleand not 377;
        if neq Goto (DIV16),tmp;
        tmp:=Shift and not 377;        !swap bytes
        Tos:=10,push, Goto(DIr bit where interrupt found 
        UserIntr := Shift xor UserIntr, Goto(RefillJmp);  ! enter routine

! Routine VectSrv.
VD);
DIV16:  Tos:=20,push;
DIVD:   tmp:=tmp + tmp;
        tmp6 := tmp6 + tmp6, if carry Goto (DIVINC);
DIVTST: tmp6-tmp1, i!-----------------------------------------------------------------------------
!
! Abstract:
!       VectSrv serves micro levf IntrPend Goto(DIVINT);
DIVI:   if lss Goto (DIVT);
        tmp6:=tmp6-tmp1;
        tmp:=tmp + 1, if IntrPend Call(VECTSRV)el interrupts by vectoring into the IO
!       microcode.  VectSrv should be called.
!
! Environment.
!       IntrPend true.;
DIVT:   Tos:=Tos-1;
        !Tos;                            ! MAB
        tmp10, if gtr Goto (DIVD);
        pop, if lss  H 	
ACK);
        tmp1 := 0; 
        blow or bhigh, loadS(3);                ! set loopcount
        tmp10 := blow, if eql goto(! Add/Subtract Floating Point Numbers
!
! Algorithm:
!       1. Unpack
!       2. adjust exponents:
!            if differeRDIVZERO);   ! save divisor
        tmp11 := bhigh, if IntrPend Call(VectSrv); 
        ahigh, leftshift(7);
        ahigh :=nce of exponents too large, ignore smaller parameter
!            else shift mantissa of larger parameter to the left, mantissatSrv);   ! b.high*a.low
        tmp1 := alow, call(TMulTIPLYLONG);
        tmpstk2 := tmpstk2 + tmp;                           shift, if IntrPend Call(VectSrv);
        alow, field(11,7);
        ahigh := shift or ahigh;
        alow, leftshift(7);
 
        tmpstk3 := tmpstk3 + tmp1 + oldcarry;
        tmp := ahigh, if IntrPend Call(VectSrv);   ! a.high*b.high
        tmp       alow := shift, goto (DIVRDIV);
DIVRShift8:
        bhigh, leftshift(10);           ! shift remainder for next division1 := bhigh, call(TMulTIPLYLONG);
        tmp1 := tmp, if IntrPend Call(VectSrv);
        tmp1 := tmp1 + tmpstk3;
        tmp 
        ahigh := shift, if IntrPend Call(VectSrv);
        blow, field(10,10);
        ahigh := shift or ahigh;        ! high:= tmpstk2;        ! low order result
        
        tmp2 := aexp;                                    ! compute exponent
   order
        blow, leftshift(10);
        alow := shift;                  ! low order
        blow := tmp10, if IntrPend Ca      tmp2 := tmp2 - 41400; !subtract bias (127), and 7 (due to 32 bit mult.)
        TOS := tmp2 + bexp, if IntrPend Call(Vectll(VectSrv); ! restore divisor
DIVRDIV:bhigh := tmp11, call(LDivideAll);
        tmp1, leftshift(10);            ! insert partSrv);   ! add exponents
        bsign := bsign xor asign, goto(NORMALIZE);       ! compute sign



!=======================ial result
        tmp1 := shift, if IntrPend Call(VectSrv);
        tmp, field(10,10);
        tmp1 := shift or tmp1;       =======================================================
!
! Floating Point Division
!
! Algorithm:
!       1. Unpack parame   ! high order
        tmp, leftshift(10);
        tmp := shift or alow, repeat(DivRShift8);! low order
                    ters
!       2. remainder := dividend
!          result := long_integer_divide(remainder<<7,divisor) !delivers 8 bits
!                          ! (insert 8 result bits)
        TOS := aexp - bexp; 
        ! now adjust exponent by -8 and correct for     for i:=1 until 3 do
!            result := result<<10 + long_integer_divide(remainder<<10, divisor)
!       3. subtract exbias by +127:
        bexp := 35600;                  ! 119 << 7
        TOS := TOS + bexp;            
        bsign:= bsignponents, adjust exponent (-8) to compensate for
!          long integer arithmetic and correct for bias (+127)
!       4. norm xor asign, goto(NORMALIZE);
   
RDIVZERO:bsign := bsign xor asign;
         tmp2 := ErrRealDivZero, goto(NORMXOVFL); ! Returalize
!
!==============================================================================
Case(RealOps,DVR), tmp := 0, call(UNPn overflow bit pattern


        



!==============================================================================
!
 I  	
------------------------------------------------------------------------
!
! Abstract:
!       MakeBit makes a word in which -----------------------------------------
!
! Abstract:
!       Multiply forms the lower 16 bits of the product of two integea specific bit is set and returns the
!       bit number.
!
! Environment:
!       (Tos) = x.
!
! Result:
!       Stack prs.
!
! Environment:
!       tmp = Multiplier.
!       tmp1 = Multiplicand.
!
! Result:
!       tmp = Product.
!
! Callopped.
!       tmp = x.
!       tmp5 = Word with bit (x mod 16) set.
!
!----------------------------------------------------s:
!       VectSrv.
!
!-----------------------------------------------------------------------------

Multiply: Tos := 0, P-------------------------

MakeBit: tmp := Tos, Pop, LeftShift(4);      ! x
        tmp5 := Shift and 360;
        tmp5 or 1ush, Loc(Mult);
        Nop;                                 ! placer, allow page escape
!       tmp6 := tmp, LeftShift(0);
 7, ShiftOnR;
        1;                                   ! form word bit (x mod 16)
        tmp5 := Shift, Return;

! Rout       tmp, LeftShift(0);
        tmp5 := Shift xor tmp1,              ! tmp5 has sign bit of result
                         ine MakeMask.
!-----------------------------------------------------------------------------
!
! Abstract:
!       MakeMask        if Geq Goto(Mul1);  ! if tmp >= 0
!       tmp6 := Tos - tmp, if IntrPend Call(VectSrv);  ! absolute value of tmp
      makes a right mask of a certain number of bits set.  The
!       number of bits is in the range 0..15.  If a 16 bit mask is req  tmp := Tos - tmp, if IntrPend Call(VectSrv);  ! absolute value of tmp
Mul1:   tmp1;
Mul2:   tmp - tmp1, if Geq Goto(Mul3);  uested,
!       MakeMask returns a zero word instead.  The Set opcodes depend on this
!       routine doing this bizarre thing     ! if tmp1 >= 0
        tmp1 := Tos - tmp1, Goto(Mul2);      ! absolute value of tmp1

!       tmp6 = smaller of tmp and  tmp1 := Tos - tmp6, Goto(DIVX); ! negate remainder

! routine ExtendByte.
!------------------------------------------------.
!
! Environment:
!       tmp and 17 = One less than the number of bits desired.
!
! Result:
!       tmp unchanged.
!   -----------------------------
!
! Abstract:
!       Sign-extend a byte that is known to be negative.  ExtendByte is
!           tmp2 = Right mask.
!       tmp2 on R bus.
!
!----------------------------------------------------------------------------not called--it is jumped to.  ExtendByte exits via a NextInst.
!
! Environment:
!       tmp = A byte whose byte-sign is set.-

! make a right mask of tmp+1 bits in tmp2 unless tmp=15 in which case make
! a mask of zero bits.
MakeMask: tmp + 1, Left
!
! Result:
!       (Tos) = tmp = Input value with upper 8 bits set.
!
!---------------------------------------------------Shift(4);             ! number of bits
        Shift + 17, ShiftOnR;                ! form a LeftShift(n)
        AllOnes;
  --------------------------

ExtendByte: tmp := tmp or 177400;
        Tos := tmp, NextInst(0);

! Routine MakeBit.
!-----      tmp2 := not Shift, Return;           ! make the mask

! Routine Multiply (Mult).
!------------------------------------ I 	
tShift:
        aexp - bexp, if intrpend goto(AddRLSInt);
        tmp := tmp - 1, if eql goto(AddROp);
        aexp := aexp - rightshift(1);
        ahigh := shift, if odd call(AddROdd);
        alow;
        alow := shift or tmp1;
        aexp := a 200, if leq goto(AddRR);
        alow := alow + alow;
        ahigh := ahigh + ahigh + oldcarry, goto(AddRLeftshift);
AddRR:exp + 200, if intrpend call(VectSrv);
        bexp - aexp;
        tmp1 := 0, if neq goto(AddRRight);
        bsign, goto(Add  aexp := aexp + 200;     ! undo last decrement
AddRRightshift:
        bhigh, rightshift(1);
        bhigh := shift, if odd ROp0);
AddRAZero:
        aexp := bexp, goto(AddROp);
AddRBZero:
        bexp := aexp, goto(AddROp1);
AddRNeglectB:
      call(AddROdd);
        blow;
        blow := shift or tmp1;
        bexp := bexp + 200, if intrpend call(VectSrv);
        a  blow := 0, if intrpend call(VectSrv);
        bhigh := 0, goto(AddROp1);
AddRNeglA:
        asign := 0;
        aexp := beexp - bexp;
        tmp1 := 0, if neq goto(AddRRightshift);
AddROp: bsign;
AddROp0:if lss call(LNegB);
AddROp1:asign;
     xp, if intrpend call(VectSrv);
        alow := 0;
        ahigh := 0, goto(AddROp);
AddRLInt:call(VectSrv);
        goto(Add
!            of the smaller parameter to the right until exponents match
!       3. add/subtract mantissas
!       4. Normal   if lss call(LNegA), TOS := aexp;
        tmp1 := 0, gotoS;
AddRSub:alow := alow - blow, leftshift(0);
        ahigh := ahiize
!
!==============================================================================
Constant(MAXSHIFT,7200);        ! max pgh - bhigh - oldcarry, goto(AddREnd);
AddRLSInt:call(VectSrv);
        goto(AddRLeftShift);
AddRAdd:alow := alow + blow;
   osition to shift without losing
                                ! the entire mantissa (leftshift(7) of higher
                     ahigh := ahigh + bhigh + oldcarry, leftshift(0);
AddREnd:bsign := shift and SignBit, if lss call(LNegA);
        tmp1 :=                 ! operand + rightshift(23) of smaller operand),
                                ! 29 << 7
Case(RealOps,SBR), lahigh, if intrpend call(VectSrv);
        tmp := alow, goto(NORMALIZE);
AddROdd:tmp1 := SignBit, return;
AddRAlssB:
        oadS(AddRSub);
        goto(AddR0);
Case(RealOps,ADR), LoadS(AddRAdd);
AddR0:  tmp := MAXSHIFT;
        tmp1 := 0, call(UNPAbexp - aexp, leftshift(0);
        shift - MAXSHIFT;      ! check whether
                               ! we'll lose all signCK);
        nop;
        ahigh or alow, leftshift(0);
        bhigh or blow, if eql goto(AddRAZero);  ! shortcut if parameteificant bits
        tmp := 7, if gtr goto(AddRNeglA);
AddRLeft:
        bexp - aexp, if intrpend goto(AddRLInt);
        tmr == 0
AddR1:  aexp - bexp, if eql goto(AddRBZero);
AddR2:  shift - tmp, if lss goto(AddRAlssB);
        tmp := 7, if gtr gotp := tmp - 1, if eql goto(AddROp);
        bexp := bexp - 200, if leq goto(AddRRR);
        blow := blow + blow;
        bhigo(AddRNeglectB);    ! check whether we'll lose all 
                                                ! significant bits
AddRLefh := bhigh + bhigh + oldcarry, goto(AddRLeft);
AddRRR: bexp := bexp + 200;    ! undo last decrement
AddRRight:
        ahigh, J  	
mp6 xor tmp1;
        tmp := tmp1;
        tmp1 := tmp6;
        tmp6 := tmp;
!remove this later
Mul4:   tmp := 0;         ff the arrays are equal.
!
! Environment:
!       Next byte in the opcode/operand stream = Length.
!       If Length <> 0:
                   ! initialize product = 0
        tmp6, RightShift(1);                 ! shift multiplier right
Mul5:   tmp6!            (Tos) = Word address of WordArray0.
!            (Tos-1) = Word address of WordArray1.
!       If Length = 0:
!  := Shift, if Odd Goto(Mul6);    ! if bit set in multiplier
        tmp1 := tmp1 + tmp1,                 ! shift multiplicand l           (Tos) = Length of word arrays.
!            (Tos-1) = Word address of WordArray0.
!            (Tos-2) = Word addreeft
                             if eql Goto(Mul9);  ! if multiplier is zero
        tmp6, Goto(Mul5);                  ! shifss of WordArray1.
!
! Result:
!       Length removed from opcode/operand stream.
!       If Length <> 0:
!            Stackt multiplier right

!       Accumulate partial product.

Mul6:   tmp := tmp + tmp1, if IntrPend Goto(Mul8);  ! accumulate pr popped once.
!       If Length = 0:
!            Stack popped twice.
!       (Tos) = WordArray0 = WordArray1.
!
! Calls:
oduct
Mul7:   tmp1 := tmp1 + tmp1;                 ! shift multiplicand left
        !*****, if lss Goto(Mul11);
        tmp6!       VectSrv.
!
!-----------------------------------------------------------------------------

CmpMW:  tmp := NextOp;   , Goto(Mul5);

!       Serve an interrupt.

Mul8:   Call(VectSrv);
        RightShift(1);
        tmp, Goto(Mul7);

!                      ! get length
        if Neq Goto(CmpMW1);                ! if non-zero length byte
        tmp := Tos, Pop;    Return the result.

Mul9:   tmp5;                                ! check sign of result
        tmp := tmp and AllOnes, i                    ! get length from expression stack
CmpMW1: tmp1 := Tos + SB, Fetch;            ! pre-fetch word from array f Lss Goto(Mul10);  ! if result is negative

!       Set a positive result.

        Pop, Return;

!       Set a negative 0 
        Pop;
        Nop;                                !***** MAB
        Tos := Tos + SB, Goto(CmpMW3);      ! bias addresult.

Mul10:  tmp := tos - tmp, Pop;               ! negate result
        tmp := tmp and AllOnes, Return;

!       Signress of array 1

CmpMW2: If Leq Goto(CmpMW5);                ! if done
        tmp1 := tmp1 + 1, Fetch;            ! fetch neal integer multiply overflow.

! ***** Mul11:  tmp2 := ErrMulOvfl, Goto(RunError0);   ! multiply overflow




$Title Multxt word of array 0
CmpMW3: tmp2 := Mdi;                        ! save word from array 0
        MA := Tos, Fetch;             tmp1.
!       arrange tmp and tmp1 so than tmp <= tmp1.

!Mul3:  if Leq Goto(Mul4), tmp := 0;
Mul3:   if Leq Goto(Mul4), tmpiple word routines.

! Routine CmpMW.
!-----------------------------------------------------------------------------
!
! A6 := tmp;

!       Exchange tmp and tmp1.

!       tmp6 := tmp6 xor tmp1;
!       tmp1 := tmp1 xor tmp6;
!       tmp6 := tbstract:
!       CmpMW compares two word arrays.  After the call to CmpMW, the
!       value on the top of the stack is true i J 	
============================================
Constant(BIASMINUS1,037400);          ! 126(decimal) in the exponent field
Case(R==============================================
!
! Truncate Real
!
! Algorithm:
!       1. unpack
!       2. check for zerealOps,FLT),  tmp2 := TOS;
        bsign := TOS and Signbit, if eql goto(FLTZero);
        tmp := 0, if neq call(FLTNegate); !o or < 0.5
!       3. tmp := mantissa<23:7>
!          subtract bias from exponent
!          result := 0
!       4. while ( low order mantissa
        nop;
        tmp1 := BIASMINUS1;
        TOS := tmp1, if intrpend call(VectSrv); ! exponent
    exponent > 0)
!          {
!             leftshift result
!             leftshift low order mantissa word
!             resu    tmp1 := 0, goto(FLT0);                  ! high order mantissa
FLTLoop:tmp, rightshift(1);
        tmp := shift;
        tlt := result + next bit from a leftshift of 
!                                (h. o. mantissa + carry from l. o. mantissa) 
! mp1;
        tmp1 := shift, if odd call(FLTCarry);
FLT0:   tmp2, rightshift(1);
        tmp2 := shift, if odd call(FLTInsert)            decrement exponent
!          }
!       5. Calculate rounding bit
!       6. Exit ( check for integer overflow an;
        TOS := TOS + 200, if neq goto(FLTLoop);
        tmp10 := 0, goto(NORMEXIT);     ! assemble real number on ESTACK

d set sign)
!
!==============================================================================
Constant(EXCESS,176);          FLTCarry:tmp := tmp or SignBit, return; ! shift out of high order word into low
FLTInsert:tmp1 := tmp1 or 200, if intrpend call        ! bias - 1, non shifted

Case(RealOps,TNC), tmp:= 0, call(TNCSub);
         tmp, goto(TNCXit);

TNCSub: tmp1 := 0, (VectSrv); ! insert into position of hidden bit
        tmp2, return;
FLTZero:TOS := 0, push, NextInst(0);
FLTNegate:
      call(UNPACK1);       ! tmp1 holds the rounding bit
        aexp, field(7,10);     
        aexp := shift - EXCESS;         ! lRLeft);





!==============================================================================
!
! Float: Convert integer   tmp2:= not tmp2, rightshift(1);
        tmp2:= tmp2 + 1, return;






!==============================================into floating point number
!
! Algorithm:
!       1. if zero push 0,0 and exit
!       2. if negative, negate number, save s================================
!
! Absolute Value and Negate Real Number
!
!==============================================ign
!       3. initialize exponent with bias (excess)
!          mantissa := 0
!          loop:
!               shift mantis================================
! Abs
Case(RealOps,ABR), tmp := TOS, pop;
        TOS := TOS and not SignBit;           ! clsa right and insert number<0> into mantissa.high<6>
!                  (the hidden bit)
!               shift number right
! ear sign bit
        TOS := tmp, push, NextInst(0);


! Negate Real
!
Case(RealOps,NGR),    tmp := TOS, pop;
        TOS               increment exponent
!          until: number is zero
!       4. normalize
!
!==================================:= TOS + SignBit;           ! Invert sign
        TOS := tmp, push, NextInst(0);






!================================ K  	
 Opcode/operand file routines.

! Routine AdjustPC.
!---------------------------------------------------------------------------------------------------

! Routine RefillOp.
!--------------------------------------------------------------------------      ! fetch next word of array 1
        Tos := Tos + 1;
        tmp10 := Mdi xor tmp2, if IntrPend Goto(CmpMW6);  ! compare------
!
! Abstract:
!       AdjustPC finishes the execution of most jump instructions.  It is
!       not called, rather it
CmpMW4: If Eql Goto(CmpMW2), tmp := tmp - 1;  ! if equal, keep going
        Tos := 0, Return;                   ! not equal, is jumped to.  When AdjustPC finishes it
!       exits to RefillJmp.
!
! Environment:
!       JmpOffset = Signed offset to  set false

CmpMW5: Tos := 1, Return;                   ! equal, set true

!       Serve an interrupt.

CmpMW6: Call(VectSadd to the PC.
!
! Result:
!       PC updated.
!
! Calls:
!       VectSrv, RefillJmp.
!
!-------------------------------rv);
        tmp10, Goto(CmpMW4);

! Routine MoveMem.
!------------------------------------------------------------------------------------------------------------------

AdjustPC: tmp := UState and 17, if intrpend Call(VectSrv);  ! get BPC
       ---------
!
! Abstract:
!       MoveMem is used to move blocks of non-overlapping words.
!
! Environment:
!       (Tos) =  tmp := tmp + JmpOffset, Field(0,3);  ! form byte offset from UPC
        BPC := Shift,                        ! low three bitsSrcAddr = First address of source block.
!       dst = DstAddr = Last address of destination block.
!       tmp = N.
!
! Res of byte address
                      if Lss Goto(Adjust1);  ! if byte offset < 0
        tmp and not 7, RightShift(1);
    ult:
!       tmp = -1.
!       Memory[DstAddr-N+1] = Memory[SrcAddr+0].
!       Memory[DstAddr-N+2] = Memory[SrcAddr+1].
!      UPC := shift + UPC, Goto(RefillJmp); ! update quad address

!       Jumping backward.

Adjust1: tmp and not 7, RightShif        ...
!       Memory[DstAddr-1]   = Memory[SrcAddr+N-2].
!       Memory[DstAddr-0]   = Memory[SrcAddr+N-1].
!
! Calls:t(1);
        tmp := Shift or SignXtnd;            ! quad offset sign extended
        UPC := UPC + tmp, Goto(RefillJmp);   ! 
!       VectSrv.
!
!-----------------------------------------------------------------------------

MoveMem: tmp := tmp - 1update quad address

! Routine Refill.
!-----------------------------------------------------------------------------
!
! , if IntrPend Goto(MoveMem2);
MoveMem1: if Lss Return;
        Tos + tmp, Fetch;                    ! t3
        Nop;        Abstract:
!       Refill refills the opcode/operand file when a NextOp is done and
!       file is empty.  Refill is jumped to                         ! t0
        Nop;                                 ! t1
        dst - tmp, Store;                    ! and returns via a ReviveVictim.
!
! Environment:
!       BPC[3] true.
!
! Result:
!       UPC advanced by 4.
!       Opc t2
        Mdi, Goto(MoveMem);                  ! t3

MoveMem2: Call(VectSrv);
        tmp, Goto(MoveMem1);




$Titleode/operand file filled.
!       BPC = 0.
!
! Calls:
!       VectSrv.
!
!------------------------------------------------- K 	
 goto(TNCng);
        ahigh := ahigh + ahigh + oldcarry, field(10,1);
        tmp := shift + tmp, if intrpend call(VectSrv); !;
        asign - bsign;
        asign - bsign, if neq goto(SignsDiffer);
        aexp - bexp;
        aexp - bexp, if neq r tmp will not ovfl here
        aexp := aexp - 1, field(10,1);
TNCRND: ahigh + ahigh, if gtr goto(TNCLoop);
        tmp1 := seturn;
        alow - blow;
        ahigh - bhigh - oldcarry, if eql goto(fc1);
        not 0, if lss return;
        1, rethift, return;
        
TNC05:  ahigh + ahigh, field(10,1);
        tmp1 := shift, return;
        



!=================urn;
        
fc1:    alow - blow, if lss goto(fc2);
        ahigh - bhigh - oldcarry;
        1, if neq return;
        0,=============================================================
!
! Round Real
!
! Algorithm:
!       1. truncate
!       2. return;
        
fc2:    not 0, return;


SignsDiffer:bsign;   !signs the same when we get here-see which is asserted
    add in rounding bit
!       3. check for integer overflow, if found raise exception
!       4. check sign, return number or 2     1, if neq return; !bsign asserted-set gtr cc
        not 0, return;    !else asign asserted-set lss cc
                  's complement accordingly
!
!==============================================================================

Case(RealOps,RN      




!==============================================================================
!
!               Floating PoiD), tmp:= 0, call(TNCSub);
        tmp := tmp + tmp1;          ! add rounding bit
        tmp, if carry goto(TNCng);
        nt Comparisons
!
!==============================================================================

Case(RealOps,EQUReal), cal
TNCXit: asign, if geq goto(TNCok);  ! abs(x) <= 32767
        if geq goto(TNCng);         ! x > 0 and abs(x) > 32767
       l(FloatCompare);
        if eql goto(NQRYes);
EQRNO:  TOS := 0, NextInst(0);
                

Case(RealOps,NEQReal), call( tmp and 77777;              ! -32768 (100000) a special case
        if eql goto(TNCleave);
        
TNCng:  tmp2 := ErrRtoIFloatCompare);
        if eql goto(EQRNO);
NQRYES: TOS := 1, NextInst(0);

Case(RealOps,LEQReal), call(FloatCompare);
     Ovfl, goto(RunError0); ! Raise exception
        
TNCok:  if geq goto(TNCleave);
        not tmp, leftshift(0);           ! N   if leq goto(NQRYES);
        TOS := 0, NextInst(0);

Case(RealOps,LESReal), call(FloatCompare);
        if lss goto(NQRYEegative - return 2's complement
        TOS := shift + 1, NextInst(0);
        
TNCleave: TOS := tmp, NextInst(0);



 
S);
        TOS := 0, NextInst(0);
                

Case(RealOps,GEQReal), call(FloatCompare);
        if geq goto(NQRYES)eaves exponent one high     
        aexp, if gtr goto(TNCLoop);
        if eql goto(TNC05);             ! prepare for roundin



!========================================================
!
! Subroutine FloatCompare
!       calls Unpack
!       lg (.5 --> 1)
        asign := 0, return;             ! < .5

TNCLoop:tmp := tmp + tmp;
        alow := alow + alow, if carryeaves condition code bits set on return
!
!========================================================
FloatCompare:call(Unpack) L  	
nd serves the one with
!       the highest priority.
!
! Environment:
!       UPC and BPC set to target address.
!
! Resul,              ! t1  advance UPC and fill
                                if IntrPend Call(VectSrv);
        UserIntr;        t:
!       Opcode/operand file filled.
!
! Calls:
!       UserSrv, VectSrv.
!
!-------------------------------------------                    ! t2
        if Gtr Goto(UserSrv);                ! t3  if Pascal level interrupts
Refill1:
!       Where----------------------------------

! Routine RefillIndivisible.
!----------------------------------------------------------- := Where or  2, call(5000);    !!!! use with CheckPC !!!!
        NextInst(0);                         ! t0 (RefillOp), first ------------------
!
! Abstract:
!       RefillIndivisible is used to refill the opcode/operand file when it
!       it is edata ready
                                             ! t2 (RefillJmp), all data ready

RefillJmp: UPC, Fetch4;            ---
!
! Abstract:
!       RefillOp refills the opcode/operand file when a NextInst is done and
!       the file is empty.  Rmpty and it is necessary to have the next Q-code be indivisible
!       from the current one.  RefillIndivisible exits via a NeefillOp corresponds to Opcode(377).  RefillOp
!       exits via a NextInst.
!
!       RefillOp checks for Pascal level interrxtInst.
!
!       RefillIndivisible differs from RefillOp in that it does not check
!       for Pascal level interrupts.
!
upts and serves the one with
!       the highest priority.
!
! Environment:
!       BPC[3] true.
!
! Result:
!       UPC !       RefillIndivisible is called in the following way.
!
!           if BPC[3] Goto(RefillIndivisible);
!           NextInadvanced by 4.
!       Opcode/operand file filled.
!       BPC = 0.
!
! Calls:
!       UserSrv, VectSrv.
!
! Design:
!  st(0);
!
! Environment:
!       BPC[3] true.
!
! Result:
!       UPC advanced by 4.
!       Opcode/operand file filled.
     We don't increment UPC at location 0 (Opcode 377) because location
!       0 is executed repeatedly when the boot button i!       BPC = 0.
!
! Calls:
!       VectSrv.
!
!---------------------------------------------------------------------------s pressed, and we
!       don't want to destroy UPC.
!
!-----------------------------------------------------------------------

Refill: UPC := UPC + 4, Fetch4;              ! t3  advance UPC and fetch
        BPC := 0;                            ! t--------

! Routine RefillJmp.
!-----------------------------------------------------------------------------
!
! Abstract:0  reset BPC
        LoadOp, if IntrPend Call(VectSrv);   ! t1  fill the opcode/operand file
!       Where := Where or 3, Call
!       RefillJmp refills the opcode/operand file to complete a jump
!       instruction.  It is assumed that UPC and BPC are(5000);     !!!! use with CheckPC !!!!
        ReviveVictim;                        ! return to caller

Opcode(REFILLOP), UPC set to the
!       desired values.  RefillJmp exits via a NextInst.
!
!       RefillJmp checks for Pascal level interrupts a + 4, Fetch4;           ! t3  fetch next quad
        BPC := 0;                            ! t0
        UPC := UPC + 4, LoadOp L 	
s
define(ioLen,215);      !     "            Length of a Circular Buffer
define(ioRdPtr,216);    !     "            Read Point ;
        TOS := 0, NextInst(0);
                

Case(RealOps,GTRReal), call(FloatCompare);
        if gtr goto(NQRYES);er in a Circular Buffer
define(ioWrPtr,217);    !     "            Write Pointer in a Circular Buffer
define(ioTmp,220);      
        TOS := 0, NextInst(0);

                                                                                             !     "            Temporary
define(ioTmp1,261);     !     "            Another Temporary
define(ioChar,221);     !     "             Character out of a Circular Buffer
define(ioDevTab,225);
                                                                 Location of the IO XLates.  PA is in IOPhysAdr (16 bits) and 
!       IOPhAdrHi (4 bits);

Constant(ioXLate, 5054);    ! Ent ry if fetch of VA has been done.
Constant(ioXLateA, 5060);   ! entry if IOSeg and IOOffset are loaded.

!       NiceRet is a  return that checks for interrupts.

Constant(NiceRet, 5064);



!       Registers.

Define(C1777,253);      ! constant 1 777, initialized by Perq.Init
Define(C400,254);       ! constant 400, initialized by Perq.Init

Define(Z80State,227);   ! Z80  input state
Define(Z80Status,233);  ! Z80 status flags: IO devices that are ready
Define(Z80WantOutput,243);  ! devices with  Z80 output messages pending
Define(Z80OState,241);  ! Z80 output state
Define(dpyTmp,374);     ! video refresh temporary
defi ne(ioSeg,211);      !Common io stuff - Segment Number of a VA
define(ioOffset,212);   !     "            Offset of a VA
define (ioPhysAdr,213);  !     "            Physical Address
define(ioPhAdrHi,214);  !     "            High 4 bits of Physical Addres 