IMD 1.18: 21/01/2023 0:18:52 PRQ-SFT-JBD-5 3RCC PERQ MICROCODE SOURCE DISTRIBUTION FLOPPY Copyright (C) Three Rivers Computer Corporation, 1981 single density, double sided D.5 Group name Command file MICROCODE.SOURCE SRC.CMD  e the result> Call(SetZChk); ! ! Tag: Mdi tmp; ! compare a pair of words ! if  ! t1 tmp2 := tmp2 - 1, GotoS; ! t2 ! Mdi tmp; ! t3 compare a pair of Goto(SetComp); ! if condition satisfied ! Tos := 0, Return; ! set false and quit ! ! or: ! ! words ! if Goto(SetComp); ! t0 condition not yet satisfied ! Tos := 1, Return;  Tos := 0, LoadS(Tag); ! assume false ! Call(SetComp); ! if Call(SetZChk); ! ! Tag: Mdi tmp; ! compare a pair of words ! i ! Routine SetMovUp. !----------------------------------------------------------------------------- ! ! Abstract: ! f Goto(SetComp); ! if condition not yet satisfied ! Tos := 1, Return; ! set true and quit ! ! En SetMovUp moves a block of words toward a higher address. The source ! and destination are allowed to overlap. ! ! Environment: ! tmp3 = Length of upper set. ! tmp2 = Length of lower set. ! TP = Highest address of upper set.vironment: ! (Tos) = Smallest source address - 1. ! dst = Smallest destination address - 1. ! tmp = Number  ! 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. !  is deeper in the stack must have a length which is greater than ! or equal to the length of the upper set. If the setAssumed truth value. ! ! Result: ! (Tos) = 0 or 1. ! (Tos) on the R bus. ! TP = Undefined (trashed). ! s have different ! sizes, the unmatched words of the longer set are not compared. ! SetZChk should be called after tmp3 = Undefined (trashed). ! tmp4 = Address of unchecked words in lower (longer) set. ! tmp2 = Number of unc SetComp if these words are significant. ! ! For each pair of words in the sets, SetComp gets a word of the upper ! hecked words in lower (longer) set. ! ! Calls: ! VectSrv. ! !-------------------------------------------------------- set (right operand) into tmp, fetches the corresponding word of the ! lower set (left operand), and jumps to a compari--------------------- SetComp: TP, Fetch; ! t3 tmp3 := tmp3 - 1, if IntrPend Goto(SetComp1)son routine which ! is specified by the 2910 S register. Thus the normal calling ! sequence is: ! ! ; ! t0 Tos, if Lss Return; ! t1 tmp := Mdi; ! t2 tmp4, Fet Tos := 1, LoadS(Tag); ! assume true ! Call(SetComp); ! if "3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&"3n\FXُHgf!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*G?ތ AQK'UVZZW)_,rXW#__ =3i e: ܈ t6Zd!>ߊ&U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~ZDYF.0 էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd* Dqh|0p1t&٤@J!;PI3]/sOK,>"3n\FXُHg Dqh|0p1t&Cp}; " $ `"`hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhO*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXf!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\1!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMZ)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~dEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&٤@J!;P)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&"3n\FXُHg o*ZDYF.0 էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhE{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*d@jRd@j pj j4j:X j@F j1jDqh|0p1t&٤@J!;PI31Aj!rv~R rv~A8d@jy:hrR1XvL@R :Ra: allowed to overlap. ! ! Environment: ! (Tos) = Largest source address + 1. ! dst = Largest destination address +d of the ! upper set (right operand) into tmp, fetches the corresponding ! word of the lower set (left operand), i 1. ! tmp = Negative of the number of words to move. ! ! Result: ! Memory[(Tos)-1..(Tos)+tmp] moved to Memory[dsssues a Store command to ! the memory controller, and jumps to a routine which computes the ! operation for those t-1..dst+tmp]. ! tmp = 0. ! (Tos) unchanged. ! dst unchanged. ! ! Calls: ! VectSrv. ! !---------words. The routine is specified by the 2910 ! S register. Thus the normal calling sequence is: ! ! Loa-------------------------------------------------------------------- SetMovUp:tmp10 := 1, Goto(SetMov1); ! incrementdS(Tag); ! Call(SetOp); ! ! if remaining, unmatched words change the result, set them to !  = 1 SetMovDown:tmp10 := not 0; ! increment = -11 SetMov1: Tos + tmp, Fetch; ! t3  ! an appropriate value. ! ! ! Tag: Mdi tmp, Goto(SetOp); ! compute the operation ! ! Environment: !  Nop; ! t0 Nop; ! t1 dst + tmp, Store;  tmp3 = Length of upper set. ! tmp2 = Length of lower set. ! TP = Highest address of upper set. ! tmp4 = Hi ! t2 Mdo := Mdi, if IntrPend Goto(SetMov3); ! t3 SetMov2:tmp := tmp - tmp10; if Eql Return; ghest address of lower set. ! S = Address of routine to compare one word of the set. ! ! Result: ! Upper set pop Goto(SetMov1); ! Serve an interrupt. SetMov3: Call(VectSrv); ! t0 - makes fetch safe inped from memory stack. ! tmp3 = -1. ! tmp4 = Address of unmatched words in lower (longer) set. ! tmp2 = Num VECTSRV Goto(SetMov2); ! Routine SetOp. !------------------------------------------------------------------------ber of unmatched words in lower (longer) set. ! ! Calls: ! VectSrv. ! !--------------------------------------------------- ! ! 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 Goto(Tos) unchanged. ! dst unchanged. ! ! Calls: ! VectSrv. ! !---------------------------------------------------in the stack must have a length which ! is greater than or equal to the length of the upper set. The ! result is -------------------------- ! Routine SetMovDown. !--------------------------------------------------------------------------stored back into the lower set, and the upper set is ! popped from the memory stack. If the sets have different sizes, --- ! ! Abstract: ! SetMovDown moves a block of words toward a lower address. The source ! and destination are ! the unmatched words of the longer set are not modified. ! ! For each pair of words in the sets, SetOp gets a wor 7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sO RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RK,>"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asKa0 vLDR )rR1I :@ΫR II a'Fc** Unknown partition: `cpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@lp if you need it`cN,6d 0=U`n3Jb fN,Kc-P`P9k*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|+^PJ,8:,-PJJN-N- NJ̘)-P PRpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>"0p1t&٤@J!;PI31!5asK!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )٤@J!;PI31!5asKa|?3n\FXُHg Dqh|0p1t&a|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw (SetOp1);! t0 tmp := Mdi, if Lss Return; ! t1 tmp4, Fetch; ! t2 TP maining. ! tmp2 = -1. ! !----------------------------------------------------------------------------- SetZChk: tmp4:= TP - 1; ! t3 tmp4 := tmp4 - 1; ! t0 tmp4 + 1, Store, GotoS; , Fetch; tmp4 := tmp4 - 1; tmp2 := tmp2 - 1; Mdi, if Lss Return; if Eql Goto(SetZChk);  ! t1 ! Mdi tmp, Goto(SetOp); ! t2 ! Serve an interrupt. SetOp1:Call(VectSrv);  Tos := Tos xor 1, Return; ! complement assumed truth value ! Routine SetZero. !----------------------------- tmp3 := tmp3 + 1, Goto(SetOp); ! Routine SetSizes. !---------------------------------------------------------------------------------------------------------------------- ! ! Abstract: ! SetZero inserts zero words into a set. ! ! Environme------- ! ! Abstract: ! SetSizes subtracts the sizes of two sets from TP in order to compute ! the new TP after nt: ! tmp1 = N. ! dst = Largest address to set zero. ! ! Result: ! Memory[Dst-0] = 0. ! Memory[Dsta set compare instruction. ! ! Environment: ! tmp3 = Length of one set. ! tmp2 = Length of the other set. ! ! -1] = 0. ! ... ! Memory[Dst-N+1] = 0. ! ! Calls: ! VectSrv. ! !-------------------------------------Result: ! tmp6 = TP - tmp3 - tmp2. ! !----------------------------------------------------------------------------- ---------------------------------------- SetZero: tmp1 := tmp1 - 1, if IntrPend Goto(SetZero2); SetZero1: if Lss Return; SetSizes: tmp6 := TP; tmp6 := tmp6 - tmp3; tmp6 := tmp6 - tmp2, Return; ! Routine SetZChk. !------------ ! if done dst - tmp1, Store; ! store a zero zero, Goto(SetZero); ! ----------------------------------------------------------------- ! ! Abstract: ! SetZChk is used after a set compariso Serve an interrupt. SetZero2: Call(VectSrv); tmp1, Goto(SetZero1); $Title Miscellaneous. ! Routine Setn if the presence of non-zero ! words remaining in the larger set will alter the result of the ! comparison. ! !QState. !----------------------------------------------------------------------------- ! ! Abstract: ! SetQState is us Environment: ! tmp4 = Address of remaining words in longer set. ! tmp2 = Number of remaining words in longer set.ed to set internal state of the Q-interpreter. ! ! Environment: ! tmp and 40 <> 0 if setting SB is desired. ! tm ! (Tos) = Assumed truth value. ! ! Result: ! (Tos) = Assumed truth value if all words are zero. ! (Tos) p and 100 <> 0 if setting SL is desired. ! tmp and 200 <> 0 if setting ExcCS and ExcGP is desired. ! ! Result: ! = 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. !  ) Three Rivers Computer Corporation, 1980. ! ! Abstract: ! !----------------------------------------------------------------! Perq Definitions. !----------------------------------------------------------------------------- ! ! Perq.Dfs - QCode------------- ! 14 May 81 V2.2 G. Robertson. ! 1. Moved IO up to 4400, expanded space for Perq to 2.25K. ! 2. Added  Interpreter definitions. ! Horst Mauersberg, Brian Rosen, Miles Barel ca. 1 Jan 80. ! J. P. Strait double precision arithmetic operations. ! 3. Added Spice kernal operations. ! 4. Added RO and Line as part of interpreter.  rewritten 21 Nov 80. ! Copyright (C) Three Rivers Computer Corporation, 1980. ! ! Abstract: ! Thi! 14 Mar 81 V2.1 J. Strait. ! 1. Begin installing exception handling microcode. ! 2. Make sure that the SL and RA from thes file provides the register and constant definitions provided ! by the Perq QCode interpreter microcode for other microp main program are zero, and that the ! SL of procedures inside the main program are also zero. This is needed ! for starograms. ! !----------------------------------------------------------------------------- ! 21 Apr 81 1.3 George Roberck searches for exceptions. ! 3. Minor bug corrections to stack overflow processing. ! 4. Bug correction to external calls. tson ! Added more registers for double precision arith. ! 10 Apr 81 1.2 George Robertson ! 1!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEM ! 21 Nov 80 V2.0 J. Strait. ! Start file. $Include Perq.Dfs $Include IO.Dfs Decimal; $IncluF.0 էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7de Acb.Dfs $Include EEB.Dfs $Include Except.Dfs $Include Perq.QCodes.Dfs $Include Rd.Dfs $Include VRD.Dfs )*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg rq.QCode.4 $Include Perq.QCode.5 $Include Perq.QCode.6 $Include Perq.Routine.1 $Include Perq.Routine.2 $Include Perq.Init $Title Perq.Micro - Perq Q-Code interpreter microcode. $NoList ! Perq Microcode. !------------------------------------------- $Include RO.Micro $Include Line.Micro end; ---------------------------------- ! ! Perq.Micro - Perq Q-code interpreter microcode. ! Horst Mauersberg, Brian Rosen, Miles Barel ca. 1 Jan 80. ! J. P. Strait rewritten 21 Nov 80. ! Copyright (c SL SetQS2: tmp and 200; if Eql Return; ! if not set ExcCS and ExcGP Tos := ExcCS := CS,--------- ! ! Abstract: ! Init is the entrypoint and initialization of the Perq Q-code ! interpreter microcode.  Push; ! new ExcCS ExcGP := GP; ExcGP := ExcGP - SB, Return; ! new ExcGP ! Routine LCA. ! !----------------------------------------------------------------------------- Loc(2400), ! Initialize constant  !----------------------------------------------------------------------------- ! ! Abstract: ! LCA loads a controlstoregisters. tmp := InitBlock; ! Where := not 0; !!!! use with CheckPC !!!! AllOne 3. ExcCS = CS. ! ExcGP = GP - SB. ! Stack pushed. ! (Tos) = ExcCS. ! ! Calls: ! re address into the 2910 S register. ! ! Environment: ! (Tos) = Address with bytes swapped. ! ! Result: ! Stac VectSrv. ! ! Design: ! It is assumed that the stack segment is resident. ! !--------------------------------------k popped. ! S = Address. ! ! Design: ! A LoadS(address) instruction is built and written into a location ! --------------------------------------- Loc(SetQState), src := SS; ! stack segment number tmp1 :=  in this routine. The LoadS instruction is then executed. Note that ! the High order third of the LoadS instruction isSB; ! save old stack base tmp and 40; src := src + src, if Eql Goto(SetQS1); ! if no not written because ! the address portion of the instruction doesn't touch the High order ! third. ! !---------t set SB src, Fetch2; ! get segment table entry SB := Mdi and not 377; SB := -------------------------------------------------------------------- LCA: tmp := Tos or not 17, LoadS(LCA2); ! get readyMdx or SB, if IntrPend Call(VectSrv); ! new SB tmp1 := tmp1 - SB; ! amount SB has moved TP  to write LCA2 tmp and not 6060; Tos or 377, WcsMid, if True GotoS(LCA1); ! write Mid third LCA1: WcsLow, := TP - tmp1; ! adjust interesting pointers AP := AP - tmp1; GP := GP - tmp1; LP if True GotoS(LCA2); ! write Low third LCA2: LoadS(0); ! *** modified *** Pop, Re:= LP - tmp1; SL := SL - tmp1; SetQS1: tmp and 100; if Eql Goto(SetQS2); ! if not set SL turn;  src + 1, Fetch; ! get segment size Mdi and not 17, LeftShift(4); SL := Shift + 400;  ! size field in SAT is off by one SL := SL + SB; SL := SL - StackLSlop; ! new  $List $Title Initialization. ! Routine Init. !-------------------------------------------------------------------- onstant(LongOps,3000); ! start of long operations dispatch table Constant(RasterOp,4000); ! entry point for RasterOp Constante disabled Define(IntPtr,21); ! address of interrupt table ! Temporaries. Define(tmp,30); Define(tmp1,3(DrawByte,4010); ! entry point for DrawByte RasterOp code Constant(DrawLine,4020); ! entry point for Line drawing microcode 1); Define(tmp2,32); Define(tmp3,33); Define(tmp4,34); Define(tmp5,35); Define(tmp6,36); Define(tmp7,37); Define(tmp10,40 ! Entry points to other related microcode. Constant(KrnlOps,7000); ! start of Spice kernel operations dispatc); Define(tmp11,41); Define(tmp12,42); Define(tmp13,43); Define(BLow,43); ! Double precision arithmetic temps Defh table ! QCode state registers. Define(UPC,16); ! User Program Counter, quad word addr ] absolute Dine(BHigh,44); Define(ALow,45); Define(AHigh,46); Define(ResSign,47); Define(RemSign,50); ! Long constants keefine(TP,17); ! Pointer to Top Of Memory Stack ] 20-bit Define(AP,3); ! Activation Pointer pt in registers. Define(AllOnes,60); ! 0177777, used for masking Define(SignXtnd,61); ! 3700000, used for sign extens ] memory Define(GP,4); ! Global Pointer ] addresses Define(LP,5); ! Local ion Define(Zero,51); ! 0000000, used for 1 instruction negate Define(SignBit,53); ! 0100000, used in double precisiPointer ] Define(CB,6); ! Code Base ] Define(SB,7); ! on arithmetic ! Offsets in stack bottom: Constant(StkTP,0); ! top pointer (-SB) for initialization ConstStack Base ] Define(RN,10); ! Routine Number Define(CS,11); ! Code Segment Definant(StkGP,1); ! global pointer (-SB) of system segment ! Temporary save area for E-stack (during Tlate). e(SS,12); ! Stack Segment Define(SL,13); ! Stack Limit ] ! DistinguiDefine(tmpstk0,70); Define(tmpstk1,71); Define(tmpstk2,72); Define(tmpstk3,73); Define(tmpstk4,74); Define(tmpstk5,75); De Added registers and constants for double precision arith. ! 16 Mar 81 1.1 John Strait ! Miscellaneous changes for exceptshed segments and pointers. Define(ExcCS,14); ! Code segment of Except Define(ExcGP,15); ! Global pointer of Excions. ! 21 Nov 80 1.0 John Strait ! Start file. ! Entry points into this piece of microcode. Constant(Error,ept ! Stack limits. Constant(StackLimit,370); ! stack-overflow buffer area Constant(StackLSlop,400); ! Stac2100); ! entry point for microcode detected errors Constant(Mult,31); ! entry point of multiply routine Constant(RunErrkLimit + slop factor ! Pascal level interrupts. Define(UserIntr,20); ! user interrupt register: or,601); ! entry point of run-time error routine Constant(SetQState,2600); ! entry point of set Q-interpreter state routine C ! if bit 15 is zero, interrupts are enabled ! if bit 15 is set, interrupts ar  ! main program dynamic link RN := 0; ! main program return routine CS := 0$Title RasterOp Microcode. !!! RasterOp Microcode Version 0.1 ! ! Brian Rosen & Stan Kriz & John Strait ! ; ! main program return segment CB := 0; ! main program return  *******Company Confidential******** ! Three Rivers Computer ! ! ! V0.4 18 May 81 JPS Change RO to be an include code base UPC := BPC := 0; ! main program return address tmp := 160, Call(SetQState); file. ! ! V0.3 29 Apr 81 JPS Provide an entrypoint that writes from a packed array ! of characters ! set SB and SL registers tmp10 := SB; ! main program static link SB + StkTP, Fetc (or from a string for that matter). ! ! V0.2 22 Oct 80 JPS Added 'Hold's that were lost in version 0.1. ! ! V0.1 8 Oh; TP := Mdi + SB; ! initial top pointer SB + StkGP, Fetch; GP := Mdi + SB, Loadct 80 BR Added No Power Down bit to SrcRasterOp ! define(SrcBase,116); ! base address (origin word) of source defineS(Busted); ! initial global pointer tmp := tmp5, Call(ChkSeg); tmp6 := tmp, Fetch, ! ne(DstBase,117); ! base address (origin word) of destination define(SrcQuad,100); ! memory address of source data (quad alis := 177777; SignBit := 100000; SignXtnd := not 77777; ! upper 5 bits set to 1 C1777 :=w codebase if Odd Goto(Busted); ! if not resident: BAD! Hold, tmp := InitProc, LeftShift( 1777; C400 := 400; ! Initialize no interrupts and interrupts off. UserIntr := 100000; 3); Hold, tmp1 := Shift + tmp6; Hold, Mdi + tmp1, Fetch4; ! fetch dictionary entry tmp7 := ! interrupts turned off ! Z80 state registers for IO microcode. Z80State := 100000;  GP, Call(CllV); ! set up ACB etc. Goto(RefillJmp); ! enter main program Busted: Go ! use DpyTmp Z80OState := 0; Z80Status := 0; Z80WantOutput := 0; dpyTmp := 6000; to(Busted);  ! 128 lines of Off in Visloop zero := 0, StackReset; tmp, Fetch2; tmp5 := Mdi;  ! initial code segment number SS := Mdi; ! initial stack segment number  ExcCS := 0; ! no exception module yet ExcGP := 0; AP := SB;  pc in jumps etc. ! For byte array operations. Define(Src,54); ! in byte moves, pointer to source wo LDC2 = 2; LDC3 = 3; LDC4 = 4; LDC5 = 5; LDC6 = 6; LDC7 = 7; rd Define(SrcLsb,55); ! bit 0 sez high byte (=1) or low byte (=0) Define(SrcByte,56); ! the right byte Define(Sr LDC8 = 8; LDC9 = 9; LDC10 = 10; LDC11 = 11; LDC12 = 12; LDC13 = 13; cWord,57); ! the whole word fetched Define(Dst,64); ! pointer to destination word Define(DstLsb,65); !  LDC14 = 14; LDC15 = 15; LDCMO = 16; LDCB = 17; LDCW = 18; LSA = 19;1 = high byte, 0 = low byte Define(DstByte,66); Define(DstWord,67); ! Krnl's registers. Define(BrkReg,370);  ROTSHI = 20; STIND = 21; LDCN = 22; LDB = 23; STB = 24; LDCH = ! Initialization: Constant(InitBlock,400);! memory address of boot initialization info Constant(InitProc,0); ! in 25; LDP = 26; STPF = 27; STCH = 28; EXGO = 29; QAND = 30; {itial proc #  *** LAND *** } QOR = 31; { *** LOR *** } QNOT = 32; { *** BNOT *** } EQUBool = 33; { Opcode assignment of all EQU,NEQ,LEQ,LES } NEQBool = 34; { GEQ and GTR qcodes ar{ QCodes Definitions. {----------------------------------------------------------------------------- { { QCodes.Dfs - QCode oe important } LEQBool = 35; LESBool = 36; GEQBool = 37; GTRBool = 38; EQUI = 39;pcode definitions. { M. A. Barel { Copyright (C) Three Rivers Computer Corporation. { { Abstract: { QCodes.Dfs define NEQI = 40; LEQI = 41; LESI = 42; GEQI = 43; GTRI = 44; EQUReal =s the Perq Q-code opcodes. It is included { into QCodes.Pas, Perq.Micro, and any other programs that need { the o 45; NEQReal = 46; LEQReal = 47; LESReal = 48; GEQReal = 49; GTRReal = 50; EQUStr pcode definitions. { {-----------------------------------------------------------------------------} { 10 Apr 81 Georg = 51; NEQStr = 52; LEQStr = 53; LESStr = 54; GEQStr = 55; GTRStr = 56; EQUe Robertson { Added LOPS and KOPS and their auxiliary definitions. { } { 14 Mar 81 John Strait. { Add ENABLByt = 57; NEQByt = 58; LEQByt = 59; LESByt = 60; GEQByt = 61; GTRByt = 62; fine(tmpstk6,76); Define(tmpstk7,77); ! Byte offset for jumps. Define(JmpOffset,52); !# of bytes to add to E, QRAISE, LDAP. { } LDC0 = 0; { Assignment of Byte/Word opcodes are important } LDC1 = 1;  Op function (3 bits) ! ***Note*** Following register definitions use the SAME register. define(XtraSrcFetch,106);  constant(Off,200); ! RasterOp Off constant(PauseLR,100); ! RasterOp Pause, processor shift is disabled consta! Bit 7 set if more source than dest quads needed define(XtraSrcWord,106); ! Bit 0 set if more source than dest words needed nt(PauseRL,101); constant(Phase0LR,102); ! Begin - NoClear constant(Phase0XLR,142); ! Begin - NoClear - X define(OneQuad,106); ! Bit 15 set if only 1 dest quad is needed define(MidNum,107); ! number of quads wide - 2 (ie # traSourceWord constant(Phase1LR,106); ! Mid - NoClear constant(Phase2LR,112); ! End - NoClear constanof mid cycles to do) define(MidCnt,110); ! counter for MidNum define(SrcX,112); ! source X value define(SrcY,113)t(Phase3LR,116); ! Begin/End - NoClear constant(Phase3XLR,156); ! Begin/End - NoClear - XtraSourceWord constant(Pha; ! source Y value define(DstX,114); ! destination X value define(DstY,115); ! destination Y value definese4LR,122); ! XtraSource - NoClear constant(Phase5LR,126); ! FirstSource - Clear constant(Phase6LR,132); ! End (SrcBinQ,112); ! source bit in quad *** same register as SrcX *** define(SrcBinW,113); ! source bit in word *** same re - Clear constant(Phase7LR,136); ! Begin/End - Clear constant(Phase7XLR,176); ! Begin/End - Clear - XtraSourgister as SrcY *** define(DstBinQ,114); ! destination bit in quad *** same register as DstX *** define(DstBinW,115); ! ceWord constant(Phase0RL,103); ! Begin - NoClear constant(Phase0XRL,143); ! Begin - NoClear - XtraSourceWdestination bit in word *** same register as DstY *** define(LeftSrc,120); ! leftmost source bit in word define(LeftDst,ord constant(Phase1RL,107); ! Mid - NoClear constant(Phase2RL,113); ! End - NoClear constant(Phase3RL121); ! leftmost destination bit in word define(LastDst,122); ! last destination word in quad define(DstRas,121); ,117); ! Begin/End - NoClear constant(Phase3XRL,157); ! Begin/End - NoClear - XtraSourceWord constant(Phase4RL,123)gned) define(DstQuad,101); ! memory address of destination data (quad aligned) define(SrcLineInc,102); ! # of words between! DstRasterOp value *** same register as LeftDst *** define(SrcRas,120); ! srcRasterOp value *** same register as LeftSrc * last quad of one line and 1st ! quad of next line -> ScanLineLength - width (words) ** define(Flag,123); ! bit 7 = 1 SrcQuad, bit 0 = trip flag in SetUp define(Direction,124); ! 0 for left to right, no ! with -1, +1 effects taken into account define(DstLineInc,103); ! same for destination define(Height,104); ! height 0 for right to left define(r370,370); !! CntlRasterOp Functions ! Bit 0 = LtoR ! Bit 1 = RO/PS (t (in bits) of area to be moved define(Width,105); ! width (in Bits) of area to be moved define(Func,111); ! Raster1 = RasterOp On) ! Bit 2:4 = RasterOp Functions ! Bit 5 = XtraSrcWord ! Bit 6 = disable processor shift  L6 = 115; LDL7 = 116; LDL8 = 117; LDL9 = 118; LDL10 = 119; LDL11 = 120 = 184; ADJ = 185; CALLL = 186; CALLV = 187; ATPB = 188; ATPW = 189;; LDL12 = 121; LDL13 = 122; LDL14 = 123; LDL15 = 124; LLAB = 125; LLAW  WCS = 190; JCS = 191; LDGB = 192; LDGW = 193; LGAB = 194; LGAW  EQUPowr = 63; NEQPowr = 64; LEQPowr = 65; SGS = 66; { there is no LESPowr } GEQ = 126; STLB = 127; STLW = 128; STL0 = 129; STL1 = 130; STL2 = 131; Powr = 67; SRS = 68; { there is no GTRPowr } EQUWord = 69; { Word is the last comp STL3 = 132; STL4 = 133; STL5 = 134; STL6 = 135; STL7 = 136; LDOB arison and only EQU } NEQWord = 70; { and NEQ exist } ABI = 71; ADI = 72; NG = 137; LDOW = 138; LDO0 = 139; LDO1 = 140; LDO2 = 141; LDO3 = 142; I = 73; SBI = 74; MPI = 75; DVI = 76; MODI = 77; CHK = 78;  LDO4 = 143; LDO5 = 144; LDO6 = 145; LDO7 = 146; LDO8 = 147; LDO9 = FLT = 79; TNC = 80; RND = 81; ABR = 82; ADR = 83; NGR = 84;  148; LDO10 = 149; LDO11 = 150; LDO12 = 151; LDO13 = 152; LDO14 = 153; L SBR = 85; MPR = 86; DVR = 87; INN = 88; UNI = 89; QINT = DO15 = 154; LOAB = 155; LOAW = 156; STOB = 157; STOW = 158; STO0 = 1590; { *** INT *** } DIF = 91; EXITT = 92; { *** EXIT *** } NOOP = 93; 9; STO1 = 160; STO2 = 161; STO3 = 162; STO4 = 163; STO5 = 164; STO6 { *** NOP *** } REPL = 94; REPL2 = 95; MMS = 96; MES = 97; LVRD  = 165; STO7 = 166; MVBB = 167; MVBW = 168; MOVB = 169; MOVW = 170;  = 98; LSSN = 99; XJP = 100; PSW = 101; RASTOP = 102; STRTIO = 103;  INDB = 171; INDW = 172; LDIND = 173; { Same as IND0 } IND0 = 173; { PBLK = 104; INTOFF = 105; INTON = 106; LDLB = 107; LDLW = 108; LDL0 =  Same as LDIND } IND1 = 174; IND2 = 175; IND3 = 176; IND4 = 177; IND5 = 1109; LDL1 = 110; LDL2 = 111; LDL3 = 112; LDL4 = 113; LDL5 = 114; LD78; IND6 = 179; IND7 = 180; LGAWW = 181; STMW = 182; STDW = 183; SAS ear constant(Phase7RL,137); ! Begin/End - Clear constant(Phase7XRL,177); ! Begin/End - Clear - XtraSourceWord 0, if IntrPend call(IntrIt); tmp + Width, RightShift(6); Shift; Tos := SrcBase - DstBase, if Neq g Loc(RasterOp), Call(Rop); NextInst(0); Rop: SrcBase := Tos, Pop; ! source address, 20-bit offseoto(Rop2); ! if source > 1 quad Flag := 200; ! set 1 source quad Rop2: Tos - 1; t SrcLineInc := Tos and AllOnes, Pop; ! source words per scan line SrcY := Tos and AllOnes, Pop; ! source  ! 20-bit equality test SrcY - DstY, if C19 goto(Compare); ! if Eql, compare X and Y !! Perform raY SrcX := Tos and AllOnes, if IntrPend call(IntrIt); ! source X LeftSrc := Tos and 17; ! leftmost sster-op left to right if ! (SrcBase <> DstBase) or ! ((SrcBase = DstBase) and ! ((ource bit in word tmp := Tos and 77, Pop; ! source bit in quad DstBase := Tos, Pop; ! destiSrcY > DstY) or ((SrcY = DstY) and (SrcX >= DstX)))) LtoR: LastDst := LastDst + Width, call(SetUp); ! Synchroniznation address, 20-bit offset DstLineInc := Tos and AllOnes, Pop; ! destination words per scan line DstY :=e memory and code with a fetch. For some obscure reason, ! memory cycles are numbered differently here: T1 is the cycl Tos and AllOnes, Pop; ! destination Y DstX := Tos and AllOnes; ! destination X LeftDst := Tos and 17e a ! Fetch starts in. ! ! Labels on micro-instructions indicate the action being performed: ! ! Xsr -; ! leftmost destination bit in word tmp1 := Tos and 77, Pop; ! destination bit in quad LastDs Extra source fetch cycle. ! Beg - Begin cycle. ! Mid - Middle cycle. ! End - End cycle. ! BgE -t := DstX; ! in preparation for LastDst computation Height := Tos - 1, Pop; ! height-1 of block i Begin/End cycle. ! ! Qn - Quad timing cycle n. ! Tn - Micro timing cycle n. DstQuad := DstQuad - Dn bits Direction := 0, if IntrPend call(IntrIt); ! assume left to right Width := Tos - 1, Pop; ! wistLineInc, Fetch, Call(Nop1); !synchronize CntlRasterOp(Phase5LR); !t3 and here we go Holddth-1 of block in bits Width := Width and AllOnes; Func := not Tos; ! function code Rop0: , LoadS(IntrCom); !Q0 0 First Src is always 1st SrcQuad := SrcQuad, Fetch4, call(Nop1); ! 1 tmp1 + Width, RightShift(6); MidNum := Shift - 1; ! # of middle quads (quad width - 2) OneQuad :=  OneQuad; ! 3 XtraSrcFetch, Hold, if geq GoTo(EndQ2T1);!Q2 0 XtraSrcW; ! XtraSource - NoClear constant(Phase5RL,127); ! FirstSource - Clear constant(Phase6RL,133); ! End - Cl200, if Geq goto(Rop1); ! clear all flags OneQuad := OneQuad or 100000; ! set one quad Rop1: Flag :=   = 234; CALLXW = 235; LDMC = 236; LDDC = 237; LDMW = 238; LDDW = 239; or debugging } KINTROFF = 5; KINTRON = 4; KSETSOFT = 3; KCLEARSOFT =  STLATE = 240; LINE = 241; ENABLE = 242; QRAISE = 243; LDAP = 244; UNDF245 = 2; KCURPROCESS = 1; KUNUSED = 0; 245; UNDF246 = 246; UNDF247 = 247; UNDF248 = 248; UNDF249 = 249; UNDF250 = 250; INCDDS = 251; LOPS = 252; { See below for 2nd byte } KOPS = 253; { See below for 2n$Title LDCx - Constant one word loads. ! Opcode LDC0, LDC1, ..., LDC15. !--------------------------------------------------d byte } BREAK = 254; REFILLOP = 255; {----------------------------------------------------------------------------------------------- ! ! Abstract: ! The LDCx opcodes are single byte instructions that load the ! consta = 195; STGB = 196; STGW = 197; UNDF198 = 198; UNDF199 = 199; RET = 200;  { { Long Operations - Second byte of LOPS opcode { {--------------------------------------------------------------------}  { *** RETURN *** } MMS2 = 201; MES2 = 202; LDTP = 203; JMPB = 204; J CVTLI = 0; CVTIL = 1; ADL = 2; NGL = 3; SBL = 4; MPL = 5; MPW = 205; JFB = 206; JFW = 207; JTB = 208; JTW = 209; JEQB = 21 DVL = 6; MODL = 7; ABL = 8; EQULong = 9; NEQLong = 10; LEQLong = 11; 0; JEQW = 211; JNEB = 212; JNEW = 213; IXP = 214; LDIB = 215; LDIW LESLong = 12; GEQLong = 13; GTRLong = 14; LUNUSED = 15; {------------------------------------ = 216; LIAB = 217; LIAW = 218; STIB = 219; STIW = 220; IXAB = 221; -------------------------------- { { Spice Kernel Operations - Second byte of KOPS opcode { {------------------------------- IXAW = 222; IXA1 = 223; IXA2 = 224; IXA3 = 225; IXA4 = 226; TLATE0 -------------------------------------} KBLOCK = 15; KUNBLOCK = 14; KSLEEP = 1 = 227; { *** TLATE1 *** } TLATE1 = 228; { *** TLATE2 *** } TLATE2 = 229; 3; KWAKEUP = 12; KREMOVEFROMQUEUE = 11; KADDTOQUEUE = 10; KRESUMEMICROSTATE = 9;  { *** TLATE3 *** } EXCH = 230; EXCH2 = 231; INCB = 232; INCW = 233; CALLXB KCLOCKTICK = 8; { temporary, for debugging } KINITQUEUES = 7; KINTRSRV = 6; { temporary, f rQ0T2); ! 1 BegQ2T3b:0, CntlRasterOp(Phase1LR); !Q2 3 no Video interrupt MidQ0T0: If Neq GoTo(IntrA);  !Q0 2 End and Begin/End SrcQuad := SrcQuad + SrcLineInc, Fetch4; !Q1 1 MA := DstQuad, Store4;  !Q0 0 Mid DstQuad := DstQuad + 4, Fetch4, call(Nop3);! 1 SrcQuad := SrcQuad + 4, Fetch4;  ! 2 Height := Height - 1, Return; ! 3 IntrA: CntlRasterOp(PauseLR); !Viord, If ByteSign GoTo(XsrQ2T2b); ! 1 GoTo(EndQ2T3); ! 2 XsrQ0T2: nop, call(Nop1);  !Q1 1 MA := DstQuad, Store4, call(Nop2); ! 2 IOB(145), MidCnt := MidCnt - 1; !Q2 1 !Q0 2 Xtra Src has only 2 OneQuad, Hold; !Q2 0 quad cycles  Video state tmp := IOD and 20, if eql goto(BegQ2T3); ! 2 Video interrupt bit tmp, GoTo(MidQ0T0);  XtraSrcWord, If lss Goto(XsrQ2T2b); ! 1 XsrQ2T2: If Odd GoTo(XsrQ2T3b); ! 2 XsrQ2T3: CntlRast ! 3 XsrQ2T3b:CntlRasterOp(Phase0XLR); !Q2 3 Xtra Src if IntrPend GoTo(IntrE); erOp(Phase0LR); ! 3 BegQ0T0: If IntrPend GoTo(IntrB); !Q0 0 Begin DstQuad := DstQ !Q0 0 Begin DstQuad := DstQuad + DstLineInc, Fetch4; ! 1 GoTo(BegQ0T3); uad + DstLineInc, Fetch4, call(Nop1); ! 1 BegQ0T3: nop, call(Nop1); ! 3 BegQ1T1: SrcQuad := SrcQua !Q0 2 XsrQ2T2b:If Odd GoTo(XsrQ2T3d); !Q2 2 Xtra Src XsrQ2T3c:CntlRasterOp(Phase7LR); d + 4, Fetch4; !Q1 1 MA := DstQuad, Store4, call(Nop2); ! 2 MidCnt := MidNum;  ! 3 BgEQ0T0: If IntrPend GoTo(IntrC); !Q0 0 Begin/End DstQuad := DstQuad + DstLineInc, !Q0 1 BegQ2T2: if Neq GoTo(BegQ2T3b); ! 2 away if > 2 quads BegQ2T3: CntlRasterOp(Phase6LR);  Fetch4, Call(LREndCom); ! 1 XtraSrcFetch, Hold, If Lss GoTo(ExitRO); !Q2 0 XtraSrcWord, IF ByteSign GoTo( ! 3 else, this is the end nop; !Q0 0 End DstQuad := DstXsrQ2T2b); ! 1 GoTo(EndQ2T3); ! 2 XsrQ2T3d:CntlRasterOp(Phase7XLR); !Quad + 4, Fetch4, Call(LREndCom); ! 1 XtraSrcFetch, If Lss GoTo(ExitRO); !Q2 0 EndQ2T1: XtraSrcWord, IF ByteSQ2 3 Xtra Src If IntrPend GoTo(IntrD); !Q0 0 Begin/End DstQuad := DstQuad + DstLineInc, Feign GoTo(XsrQ2T2); ! 1 nop; ! 2 EndQ2T3: CntlRasterOp(Phase4LR); tch4, Call(LREndCom); ! 1 XtraSrcFetch, If Lss GoTo(ExitRO); !Q2 0 XtraSrcWord, Hold, IF ByteSign Go ! 3 XsrQ0T0: Hold; !Q0 0 Xtra Src SrcQuad := SrcQuad + 4, Fetch4, GoTo(XsTo(XsrQ2T2b); ! 1 GoTo(EndQ2T3); ! 2 LREndCom:nop, call(Nop2);  --------- ! ! Abstract: ! LDCN is a one byte instruction that loads the constant Nil onto ! the expression stack, NextInst(0); Opcode(LDC8), Tos := 10, Push, NextInst(0); Opcode(LDC9), Tos := 11, Push, NextInst(0); Opcode(LDC10),. Nil is represented by two zero words. ! ! Instruction: ! LDCN ! ! Result: ! Stack pushed twice. ! (T Tos := 12, Push, NextInst(0); Opcode(LDC11), Tos := 13, Push, NextInst(0); Opcode(LDC12), Tos := 14, Push, NextInst(0); os) = 0. ! (Tos-1) = 0. ! !----------------------------------------------------------------------------- ! Opcode LD Opcode(LDC13), Tos := 15, Push, NextInst(0); Opcode(LDC14), Tos := 16, Push, NextInst(0); Opcode(LDC15), Tos := 17, PushCB. !----------------------------------------------------------------------------- ! ! Abstract: ! LDCB is a two byte , NextInst(0); Opcode(LDCMO), Tos := AllOnes, Push, NextInst(0); Opcode(LDCN), Tos := Zero, Push, Goto(LoadZero); Opcodinstruction that loads a constant byte onto ! the expression stack. ! ! Instruction: ! LDCB SignedByte ! ! e(LDCB), tmp := NextOp; Tos := tmp, Push, if ByteSign Goto(ExtendByte); Nxt: NextInst(0); Opcode(LDCW), Call(WorResult: ! 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------------------ ! ! 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: nt x onto the expression stack. ! ! Instruction: ! LDCx ! ! Result: ! Stack pushed. ! (Tos) = x. ! !-sion stack. ! ! Instruction: ! LDCB LowByteConstant HighByteConstant ! ! Result: ! Stack pushed. ! (---------------------------------------------------------------------------- ! Opcode LDCMO. !------------------------------Tos) = Constant. ! ! Calls: ! WordParm. ! !------------------------------------------------------------------------------------------------------------------------- ! ! Abstract: ! Load the constant -1 onto the expression stack. ! ! I--- LoadZero: Opcode(LDC0), Tos := 0, Push, NextInst(0); Opcode(LDC1), Tos := 1, Push, NextInst(0); Opcode(LDC2), nstruction: ! LDCMO ! ! Result: ! Stack pushed. ! (Tos) = -1. ! !-------------------------------------- Tos := 2, Push, NextInst(0); Opcode(LDC3), Tos := 3, Push, NextInst(0); Opcode(LDC4), Tos := 4, Push, NextInst(0); --------------------------------------- ! Opcode LDCN. !-------------------------------------------------------------------- Opcode(LDC5), Tos := 5, Push, NextInst(0); Opcode(LDC6), Tos := 6, Push, NextInst(0); Opcode(LDC7), Tos := 7, Push f Neq goto(RtoL); ! if SrcY < DstY if Geq goto(LtoR); ! if SrcX >= DstX !! Perfor XtraSrcWord, If lss Goto(XsrK2T2b); ! 1 XsrK2T2: If Odd GoTo(XsrK2T3b); ! 2 XsrK2T3: CntlRasm raster-op right to left if ! (SrcBase = DstBase) and ! ((SrcY < DstY) or ((SrcY = DstY) and (SrcterOp(Phase0RL); ! 3 BegK0T0: If IntrPend GoTo(IntrG); !Q0 0 Begin DstQuad := DstX < DstX))) RtoL: SrcY := SrcY + Height; ! start X, Y for RtoL case SrcX := SrcX + Width; Quad - DstLineInc, Fetch4R, call(Nop1);! 1 BegK0T3: nop, call(Nop1); ! 3 BegK1T1: SrcQuad := SrcQu DstY := DstY + Height; DstX := DstX + Width; Direction := not 0, call(SetUp); ! Synchronize mead - 4, Fetch4R; !Q1 1 MA := DstQuad, Store4R, call(Nop2); ! 2 MidCnt := MidNum; mory and code with a fetch. For some obscure reason, ! memory cycles are numbered differently here: T1 is the cycle a  !Q2 1 BegK2T2: if Neq GoTo(BegK2T3b); ! 2 away if > 2 quads BegK2T3: CntlRasterOp(Phase6RL); deo interrupt in Middle Call(VidInt); !Video interrupt service Call(IntrComA);  ! Fetch starts in. ! ! Labels on micro-instructions indicate the action being performed: ! ! Xsr - Ext !join common code in IntrCom GoTo(BegQ2T3b); !Happens at t2, will return to t3 Intra source fetch cycle. ! Beg - Begin cycle. ! Mid - Middle cycle. ! End - End cycle. ! BgE - BegrB: CntlRasterOp(Off), CallS; !Interrupt in Begin GoTo(XsrQ2T3); !Happens at t2, willin/End cycle. ! ! Kn - Quad timing cycle n (Qn). ! Tn - Micro timing cycle n. DstQuad := DstQuad +  return to t3 IntrC: CntlRasterOp(Off), CallS; !Interrupt in Begin/End GoTo(XsrQ2T3c); DstLineInc, Fetch, Call(Nop1); !synchronize CntlRasterOp(Phase5RL); !t3 and here we go Hol !Happens at t2, will return to t3 IntrD: CntlRasterOp(Off), CallS; !Interrupt in Begin/End XtraSrc d, LoadS(IntrCom); !Q0 0 First Src is always 1st SrcQuad := SrcQuad, Fetch4R, call(Nop1); ! 1 GoTo(XsrQ2T3d); !Happens at t2, will return to t3 IntrE: CntlRasterOp(Off), CallS; !Interrupt OneQuad; ! 3 XtraSrcFetch, Hold, if geq GoTo(EndK2T1);!Q2 0 XtraSrc in Begin XtraSrc GoTo(XsrQ2T3b); !Happens at t2, will return to t3 !! Compare source stWord, If ByteSign GoTo(XsrK2T2b); ! 1 GoTo(EndK2T3); ! 2 XsrK0T2: nop, call(Nop1); art bit with destination start bit. Compare: SrcY - DstY, if Gtr goto(LtoR); ! if SrcY > DstY SrcX - DstX, i !Q0 2 Xtra Src has only 2 OneQuad, Hold; !Q2 0 quad cycles  -------- ! ! Abstract: ! LDLB is a two byte instruction that loads a local variable with an ! offset in the rang15), LP + 17, Fetch, Goto(LoadLocal); Opcode(LDLB), tmp := NextOp; LP + tmp, Fetch; LoadLocal: Tos := Mdi, Push, Nee 0..255 onto the expression stack. ! ! Instruction: ! LDLB Offset ! ! Result: ! Stack pushed. ! (ToxtInst(0); Opcode(LDLW), Call(WordParm); tmp := Shift or tmp, if IntrPend Call(VectSrv); LP + tmp, Fetch, Gs) = Memory[LP + Offset]. ! !----------------------------------------------------------------------------- ! Opcode LDLW. oto(LoadLocal); $Title LLAx - Load local address. ! Opcode LLAB. !------------------------------------------------!----------------------------------------------------------------------------- ! ! Abstract: ! LDLW is a three byte ins----------------------------- ! ! Abstract: ! LLAB is a two byte instruction that loads the address of a local ! truction that loads a local variable with ! an offset in the range 0..65535 onto the expression stack. ! ! Instruction: variable with an offset in the range 0..255 onto the expression stack. ! ! Instruction: ! LLAB Offset ! ! Result: ! LDLW LowByteOffset HighByteOffset ! ! Result: ! Stack pushed. ! (Tos) = Memory[LP + Offset]. ! !  ! Stack pushed. ! (Tos) = LP - SB + Offset. ! !----------------------------------------------------------------Calls: ! VectSrv, WordParm. ! !----------------------------------------------------------------------------- Opcode(------------- ! Opcode LLAW. !----------------------------------------------------------------------------- ! ! Abstract: LDL0), LP + 0, Fetch, Goto(LoadLocal); Opcode(LDL1), LP + 1, Fetch, Goto(LoadLocal); Opcode(LDL2), LP + 2, Fetch, Go ! LLAW is a three byte instruction that loads the address of a local ! variable with an offset in the range 0..655to(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); ! LDLx ! ! Result: ! Stack pushed. ! (Tos) = Memory[LP + x]. ! !---------------------------------------L10), LP + 12, Fetch, Goto(LoadLocal); Opcode(LDL11), LP + 13, Fetch, Goto(LoadLocal); Opcode(LDL12), LP + 14, Fetch, Goto-------------------------------------- ! Opcode LDLB. !---------------------------------------------------------------------(LoadLocal); Opcode(LDL13), LP + 15, Fetch, Goto(LoadLocal); Opcode(LDL14), LP + 16, Fetch, Goto(LoadLocal); Opcode(LDL   !Q0 0 Mid DstQuad := DstQuad - 4, Fetch4R, call(Nop3);! 1 SrcQuad := SrcQuad - 4, Fetch ! 2 Height := Height - 1, Return; ! 3 IntrF: CntlRasterOp(PauseRL); !Video interru4R; !Q1 1 MA := DstQuad, Store4R, call(Nop2); ! 2 IOB(145), MidCnt := MidCnt - 1; !Qpt Middle Call(VidInt); !Video interrupt service Call(IntrComA); !2 1 Video state tmp := IOD and 20, if eql goto(BegK2T3); ! 2 Video interrupt bit tmp, GoTo(MidK0T0); Join common code in IntrCom GoTo(BegK2T3b); !Happens at t2, will return to t3 IntrG: CntlRast ! 3 XsrK2T3b:CntlRasterOp(Phase0XRL); !Q2 3 Xtra Src If IntrPend GoTo(IntrJ); erOp(Off), CallS; !Interrupt in Begin GoTo(XsrK2T3); !Happens at t2, will return to t3  !Q0 0 Begin DstQuad := DstQuad - DstLineInc, Fetch4R;! 1 GoTo(BegK0T3);  IntrH: CntlRasterOp(Off), CallS; !Interrupt in Begin/End GoTo(XsrK2T3c); !Happens a !Q0 2 XsrK2T2b:If Odd GoTo(XsrK2T3d); !Q2 2 Xtra Src XsrK2T3c:CntlRasterOp(Phase7RL); t t2, will return to t3 IntrI: CntlRasterOp(Off), CallS; !Interrupt in Begin/End XtraSrc GoTo(XsrK2T3d) ! 3 BgEK0T0: If IntrPend GoTo(IntrH); !Q0 0 Begin/End DstQuad := DstQuad - DstLineI; !Happens at t2, will return to t3 IntrJ: CntlRasterOp(Off), CallS; !Interrupt in Begin Xtranc, Fetch4R, Call(RLEndCom);! 1 XtraSrcFetch, Hold, If Lss GoTo(ExitRO); !Q2 0 XtraSrcWord, IF ByteSign GoSrc GoTo(XsrK2T3b); !Happens at t2, will return to t3 !! exit from raster-op. ExitRO: ! 3 else, this is the end nop; !Q0 0 End DstQuad := DsTo(XsrK2T2b); ! 1 GoTo(EndK2T3); ! 2 XsrK2T3d:CntlRasterOp(Phase7XRL); tQuad - 4, Fetch4R, Call(RLEndCom); ! 1 XtraSrcFetch, Hold, If Lss GoTo(ExitRO); !Q2 0 EndK2T1: XtraSrcWord, IF Byt !Q2 3 Xtra Src If IntrPend GoTo(IntrI); !Q0 0 Begin/End DstQuad := DstQuad - DstLineInc,eSign GoTo(XsrK2T2); ! 1 nop; ! 2 EndK2T3: CntlRasterOp(Phase4RL);  Fetch4R, Call(RLEndCom);! 1 XtraSrcFetch, If Lss GoTo(ExitRO); !Q2 0 XtraSrcWord, IF ByteSign GoTo( ! 3 XsrK0T0: Hold; !Q0 0 Xtra Src SrcQuad := SrcQuad - 4, Fetch4R, GoToXsrK2T2b); ! 1 GoTo(EndK2T3); ! 2 RLEndCom:nop, call(Nop2); !(XsrK0T2);! 1 BegK2T3b:0, CntlRasterOp(Phase1RL); !Q2 3 no Video interrupt MidK0T0: If Neq GoTo(IntrF); Q0 2 End and Begin/End SrcQuad := SrcQuad - SrcLineInc, Fetch4R;!Q1 1 MA := DstQuad, Store4R;   ! Result: ! Stack popped. ! Memory[LP + Offset] = Value. ! ! Calls: ! VectSrc, WordParm. ! !--------- (Tos) = Memory[GP + Offset]. ! !----------------------------------------------------------------------------- ! Opcode  Opcode(LLAW), Call(WordParm); tmp := Shift or tmp, if IntrPend Call(VectSrv); tmp := tmp + LP, GoTo(LoadLA-------------------------------------------------------------------- Opcode(STL0), LP + 0, Store, Goto(StoreLocal); Opcodeddr); $Title STLx - Store local variable. ! Opcode STL0, STL1, ..., STL7. !---------------------------------------(STL1), LP + 1, Store, Goto(StoreLocal); Opcode(STL2), LP + 2, Store, Goto(StoreLocal); Opcode(STL3), LP + 3, Store, Goto(-------------------------------------- ! ! Abstract: ! The STLx opcodes are single byte instructions that store local StoreLocal); Opcode(STL4), LP + 4, Store, Goto(StoreLocal); Opcode(STL5), LP + 5, Store, Goto(StoreLocal); Opcode(STL6)! variable with offset x from the expression stack. ! ! Instruction: ! STLx ! ! Environment: ! (Tos) = V, LP + 6, Store, Goto(StoreLocal); Opcode(STL7), LP + 7, Store, Goto(StoreLocal); StoreLocal: Tos, Pop, NextInst(0); Opalue. ! ! Result: ! Stack popped. ! Memory[LP + x] = Value. ! !-----------------------------------------------code(STLB), tmp := NextOp; STLB1: LP + tmp, Store; Tos, Pop, NextInst(0); Opcode(STLW), Call(WordParm); t------------------------------ ! Opcode STLB. !-----------------------------------------------------------------------------mp := Shift or tmp, if IntrPend Call(VectSrv); Goto(STLB1); $Title LDOx - Load own variable. ! Opcode LDO0 ! ! Abstract: ! STLB is a two byte instruction that stores a local variable with ! an offset in the range 0..25, LDO1, ..., LDO15. !----------------------------------------------------------------------------- ! ! Abstract: ! The5 from the expression stack. ! ! Instruction: ! STLB Offset ! ! Environment: ! (Tos) = Value. ! ! Result: LDOx opcodes are single byte instructions that load own ! variables with offset x onto the expression stack. ! ! Instr ! Stack popped. ! Memory[LP + Offset] = Value. ! !-------------------------------------------------------------uction: ! LDOx ! ! Result: ! Stack pushed. ! (Tos) = Memory[GP + x]. ! !----------------------------------------------- ! Opcode STLW !----------------------------------------------------------------------------- ! ! Abstract---------------------------------------------- ! Opcode LDOB. !-------------------------------------------------------------: ! 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. !  tch, Return; ! Happens at t1 !! SetUp. SetUp: Flag := Flag or 1, if IntrPend call(IntrInd 77, if IntrPend call(IntrIt); SrcBinW := Tos and 17; Tos := DstBinQ := DstX and 77; DstBinW := t); ! first time thru tmp1 := SrcLineInc; DstQuad := SrcX, LeftShift(4); Set1: tmp1 - 60; SrcTos and 17; ! set DstRasterOp. LastDst := LastDst and 60; Tos := Width and 17;Y, if Neq goto(Set3); ! if not 60 ! special case: 60 words/line. tmp := Shift + SrcBase;  WidRasterOp := Tos or LastDst; ! set SrcLineInc and DstLineInc. Func := Func  ! 20*Y + BaseAddress SrcY, LeftShift(5); tmp := Shift + tmp; ! 40*Y + 20*Y + or 10, LeftShift(2); !will be No Power Down bit MidNum + 1; tmp := Shift; ! wiBase Set2: DstQuad, RightShift(4); DstQuad := Shift + tmp; ! X div 20 + LineLength*Y + Base dth in words SrcLineInc := SrcLineInc - tmp; DstLineInc := DstLineInc - tmp,if IntrPend call(IntrIt); ! last Flag := Flag xor 1; DstQuad := DstQuad + SB, if Odd goto(Set6); ! physical address SrcQuad := DstQuad;  chance ! set SrcRasterOp. Tos := SrcBinQ and 60; tmp := Tos or LeftSrc; Func ! roll down SrcY := DstY; DstQuad := DstX; SrcBase := DstBase, LeftShift(4);  and 14, LeftShift(4); !No Power Down and Function[2] SrcRas := SrcRasterOp := Shift or tmp; ! tmp1 := DstLineInc, goto(Set1); Set3: tmp1 - 40; tmp := SrcY, if Neq goto(Set4); ! if not set DstRasterOp. Tos := DstBinQ and 60; tmp := Tos or LeftDst; Func and 3, LeftShift(6) 40 ! another special case: 40 words/line. the MoveMem routine depends ! on raster-op being able to ; DstRas := DstRasterOp := Shift or tmp; ! set XtraSrcFetch and XtraSrcWord. Fdo a 20-bit multiply by 40 words/line. tmp := tmp + tmp; ! 2 * SrcY tmp := tmp + tmp;lag; Tos := DstBinQ - SrcBinQ, if ByteSign goto(Set7); ! if XtraSrcFe ! 4 * SrcY tmp := tmp + tmp; ! 10 * SrcY tmp := tmp + tmp; tch not possible Tos xor Direction; if Geq goto(Set7); ! if no extra source fetch  CntlRasterOp(Off); Pop, Return; !! common interrupt routine. IntrCom: Call(IntrIt); IntrComA: ! 20 * SrcY tmp := tmp + tmp, goto(Set5); ! 40 * SrcY Set4: tmp := SrcY, call(Mult); SrcRasterOp := SrcRas; ! restore SrcRasterOp DstRasterOp := DstRas; ! restore DstRasterOp Fe ! compute SrcLineInc * SrcY Set5: tmp := tmp + SrcBase, goto(Set2); Set6: Tos := SrcBinQ := SrcX a  e(LDO13), GP + 15, Fetch, Goto(LoadOwn); Opcode(LDO14), GP + 16, Fetch, Goto(LoadOwn); Opcode(LDO15), GP + 17, Fetch, Goto $Title STOx - Store own variable. ! Opcode STO0, STO1, ..., STO7. !----------------------------------------------------(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. ! ! !----------------------------------------------------------LDOW !----------------------------------------------------------------------------- ! ! Abstract: ! LDOW is a three by------------- ! ! Abstract: ! LOAB is a two byte instruction that loads the address of an own ! variable with ante instruction that loads an own variable with an ! offset in the range 0..65535 onto the expression stack. ! ! Instruc offset in the rang 0..255 onto the expression ! stack. ! ! Instruction: ! LOAB Offset ! ! Result: ! tion: ! LDOW LowByteOffset HighByteOffset ! ! Result: ! Stack pushed. ! (Tos) = Memory[GP + Offset].  Stack pushed. ! (Tos) = GP - SB + Offset. ! !-------------------------------------------------------------------------! ! Calls: ! VectSrv, WordParm. ! !----------------------------------------------------------------------------- Op---- ! Opcode LOAW. !----------------------------------------------------------------------------- ! ! Abstract: ! code(LDO0), GP + 0, Fetch, Goto(LoadOwn); Opcode(LDO1), GP + 1, Fetch, Goto(LoadOwn); Opcode(LDO2), GP + 2, Fetch, GLOAW is a three byte instruction that loads the address of an own ! variable with an offset in the rang 0..65535 onto theoto(LoadOwn); Opcode(LDO3), GP + 3, Fetch, Goto(LoadOwn); Opcode(LDO4), GP + 4, Fetch, Goto(LoadOwn); Opcode(LDO5), expression ! stack. ! ! Instruction: ! LOAW LowByteOffset HighByteOffset ! ! Result: ! Stack pushed GP + 5, Fetch, Goto(LoadOwn); Opcode(LDO6), GP + 6, Fetch, Goto(LoadOwn); Opcode(LDO7), GP + 7, Fetch, Goto(LoadOwn. ! (Tos) = GP - SB + Offset. ! ! Calls: ! VectSrv, WordParm. ! !---------------------------------------------); Opcode(LDO8), GP + 10, Fetch, Goto(LoadOwn); Opcode(LDO9), GP + 11, Fetch, Goto(LoadOwn); Opcode(LDO10), GP + 12, -------------------------------- Opcode(LOAB), tmp := NextOp + GP; LoadOAddr: Tos := tmp - SB, Push, NextInst(0); Opcode(Fetch, Goto(LoadOwn); Opcode(LDO11), GP + 13, Fetch, Goto(LoadOwn); Opcode(LDO12), GP + 14, Fetch, Goto(LoadOwn); OpcodLOAW), Call(WordParm); tmp := Shift or tmp, if IntrPend Call(VectSrv); tmp := tmp + GP, GoTo(LoadOAddr);   memory stack. ! (Tos-5) = Destination base address as an offset from the base of the ! memory stac tmp2, if Gtr Goto(DB5); ! if screen width exhausted tmp1 := Shift, Call(Mult); ! tmp will contain SrcY  XtraSrcFetch := XtraSrcFetch and not 200; ! set extra source fetch SrcLineInc := SrcLineInc - 4; Set7: Tos :=k. ! (Tos-6) = Destination Y-coordinate. ! (Tos-7) = Destination X-coordinate. ! (Tos-8) = Raster-op functi DstBinW - SrcBinW; Tos xor Direction; if Geq return; ! if no extra source word on. ! ! Result: ! Stack popped three times. ! (Tos) = Current X-Coordinate. ! (Tos-1) = Next byte offse XtraSrcWord := XtraSrcWord or 1, return; ! set extra source word !! spending time doing nothing. Nop3: Hot. ! (Tos-2) = Termination condition: ! 0 - Character count exhausted. ! 1 - Screenld; Nop2: Hold; Nop1: Hold, return; !! vector off to the interrupt handler. IntrIt: Vector(IntVec);  width exhausted. ! 2 - Control character encountered. ! !------------------------------------------------- Define(MaxX, 130); Define(MaxByte, 131); Define(CSet, 132); Define(Screen, 133); De---------------------------- Loc(DrawByte), MaxX := Tos, Pop; MaxByte := Tos, Pop; SrcByte := Tos, Pop; fine(X, 134); Define(Y, 135); Define(RFunc, 136); Define(CharWidth, 137); Define(F SrcWord := Tos + SB, Pop; CSet := Tos + SB, Pop; Screen := Tos, Pop; Y := Tos, Pop; CSontHeight, 140); Define(Ch, 141); Define(C402, 142); ! Routine DrawByte. !------------------------------et, Fetch2; X := Tos, Pop; RFunc := Tos, Pop; FontHeight := Mdi; tmp := Mdi; Y := Y----------------------------------------------- ! ! Abstract: ! DrawByte puts characters from a byte array onto the scr - tmp; CSet := CSet + 2; C402 := 402; C402 := C402 - SB; DB1: SrcByte - MaxByte, RightShift(1); een. It draws ! until a character count is exhausted, a screen width is exhausted, or ! a control character is re SrcByte, if Geq Goto(DB3); ! if character count exhausted Shift + SrcWord, Fetch; SrcByte xor 1ached. ! ! Environment: ! (Tos) = Maximum X-coordinate + 1. ! (Tos-1) = Maximum byte offset + 1. ! (Tos, Rotate(10); Ch := Mdi, if Odd Goto(DB2); Ch := Shift; DB2: Ch := Ch and 177; Ch and not 37, Lef-2) = Byte offset from the beginning of the byte array. ! (Tos-3) = Address of the byte array as an offset from the base tShift(1); Ch, if Eql Goto(DB4); ! if control character Shift + CSet, Fetch2; tmp := FontHof the ! memory stack. ! (Tos-4) = Character set address as an offset from the base of the ! eight; tmp2 := Mdi; CharWidth := Mdi; X := X + CharWidth; X - MaxX, RightShift(12);  tack. ! ! Instruction: ! STOW LowByteOffset HighByteOffset ! ! Environment: ! (Tos) = Value. ! ! Result: s a four byte instruction that loads a global variable onto ! the expression stack. The segment number must be in the ra ! Stack popped. ! Memory[GP + Offset] = Value. ! ! Calls: ! VectSrc, WordParm. ! !---------------------nge ! 0..255 and the offset must be in the range 0..65535. ! ! Instruction: ! LDGW Segment LowByteOffset High-------------------------------------------------------- Opcode(STO0), GP + 0, Store, Goto(StoreOwn); Opcode(STO1), GP + 1ByteOffset ! ! Result: ! Stack pushed. ! (Tos) = Memory[GlobalArea + Offset]. ! ! Calls: ! GetGP, VectS, Store, Goto(StoreOwn); Opcode(STO2), GP + 2, Store, Goto(StoreOwn); Opcode(STO3), GP + 3, Store, Goto(StoreOwn); Opcorv, WordParm. ! !----------------------------------------------------------------------------- Opcode(LDGB), tmp2 := NextOpde(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------------------- ! Opcode STOB. !----------------------------------------------------------------------------- ! ! Abst, Store, Goto(StoreOwn); $Title LDGx - Load global variable. ! Opcode LDGB. !-------------------------------------ract: ! STOB is a two byte instruction that stores an own variable with ! an offset in the range 0..255 from the e---------------------------------------- ! ! Abstract: ! LDGB is a three byte instruction that loads a global variable xpression stack. ! ! Instruction: ! STOB Offset ! ! Environment: ! (Tos) = Value. ! ! Result: ! Stonto ! the expression stack. The segment number must be in the range ! 0..255 and the offset must be in the rangeack popped. ! Memory[GP + Offset] = Value. ! !------------------------------------------------------------------------- 0..255. ! ! Instruction: ! LDGB Segment Offset ! ! Result: ! Stack pushed. ! (Tos) = Memory[GlobalA---- ! Opcode STOW. !----------------------------------------------------------------------------- ! ! Abstract: ! rea + Offset]. ! ! Calls: ! GetGP. ! !----------------------------------------------------------------------------- STOW is a three byte instruction that stores an own variable with ! an offset in the range 0..65535 from the expression s ! Opcode LDGW. !----------------------------------------------------------------------------- ! ! Abstract: ! LDGW i  hree Rivers Computer Corporation. ! ! See ACM algorithm 162: ! XYMove Plotting ! Fred G. SR; 1, Pop; Bit := Shift, if IntrPend Call(LineInt); ! X1 bit mask ! Get X2,Y2 and calculate dtockton ! ! ! Calling sequence: ! ! push Style ! push X1; ! push Y1; ! push X2; ! pX,dY. Tos := Tos and AllOnes; dY := Tos - Y1, Pop, LeftShift(17); AddY := 60, if Geq goto(Lush Y2; ! push Origin; ! call Line; ! ! ! Style = 1 Erase line. ! 2 Xor line. 1); AddY := not 57; ! -60 dY := Shift - dY; ! Shift = 0 L1:  ! 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; dX Tos := RFunc, Push; Tos := CharWidth, Push; Tos := FontHeight, Push; Tos := X - CharWidth, Pge from 0 (top) to 1777 (bottom). ! 18 May 81 V1.1 John Strait ! Change Line to be an include file. ush; Tos := Y, Push; Tos := 60, Push; Tos := Screen, Push; Tos := tmp2 and C1777, Push;  define(Origin,100); define(X1,101); define(Y1,103); define(dX,104); define(dY,105);  Tos := tmp, Push; Tos := 60, Push; Tos := CSet + C402, Push; Call(Rop); SrcByte := SrcB define(Word,106); define(Bit,107); define(AddY,110); define(Last,111); define(D,112); yte + 1, Goto(DB1); DB3: Tos := 0, Push, Goto(DB6); DB4: Tos := 2, Push, Goto(DB6); DB5: Tos := 1, Push;  define(E,113); define(F,114); define(T,115); define(TplusD,116);  X := X - CharWidth, Goto(DB6); DB6: Tos := SrcByte, Push; Tos := X, Push, NextInst(0);  Loc(DrawLine), ! get the Origin. Origin := Tos, Pop; ! Get X1,Y1 and initial Word and Bit addresses. Y1 := Tos and AllOnes, LeftShift(4); Word := Shift;  !***** Word := Word + Origin; !***** !***** Word := Shift + Origin; Y1, LeftShift(5);  Word := Shift + Word, Pop; ! Y1 * 60 + Origin X1 := Tos and AllOnes, RightShift(4); Word$Title Line drawing microcode. !!! Line - Perq line drawing micro-code. ! ! J. Strait 10 April 80. ! T := Shift + Word; ! Y1 * 60 + X1 div 20 + Origin X1 and 17, LeftShift(4); not Shift, ShiftOn  GP. ! !----------------------------------------------------------------------------- ! Opcode LGAW. !--------------------- !***** BR Tos := tmp + tmp2, Push, NextInst(0); !***** BR Opcode(LGAWW), Call(WordParm); -------------------------------------------------------- ! ! Abstract: ! LGAW is a three byte instruction that loads thtmp2 := Shift + tmp, Goto(LoadGAddr); $Title STGx - Store global variable. ! Opcode STGB. !-----------------------e address of a global ! variable onto the expression stack. The segment number must be ! in the range 0..255, and------------------------------------------------------ ! ! Abstract: ! STGB is a three byte instruction that stores a g the offset must be in the range 0..65535. ! ! Instruction: ! LGAW Segment LowByteOffset HighByteOffset ! ! Resultlobal variable ! from the expression stack. The segment number must be in the ! range 0..255, and the offset must: ! Stack pushed. ! (Tos) = GlobalArea - SB + Offset. ! ! Calls: ! GetGP, WordParm. ! !---------------- be in the range 0..255. ! ! Instruction: ! STGB Segment Offset ! ! Environment: ! (Tos) = Value. ! ! Res------------------------------------------------------------- ! Opcode LGAWW. !---------------------------------------------ult: ! Stack popped. ! Memory[GlobalArea + Offset] = Value. ! ! Calls: ! GetGP. ! !---------------------------------------------------- ! ! Abstract: ! LGAWW is a four byte instruction that loads the address of a global !--------------------------------------------------------- ! Opcode STGW. !-------------------------------------------------- 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:ct: ! LGAB is a three byte instruction that loads the address of a global ! variable onto the expression stack. T !----------------------------------------------------------------------------- Opcode(LGAB), tmp2 := NextOp; Push, he segment number must be ! in the range 0..255, and the offset must be in the range 0..255. ! ! Instruction: ! Call(GetGp); tmp := NextOp + tmp2; !**** BR Tos := tmp - SB, NextInst(0); !**** BR OpLGAB Segment Offset ! ! Result: ! Stack pushed. ! (Tos) = GlobalArea - SB + Offset. ! ! Calls: ! Getcode(LGAW), tmp2 := NextOp; LoadGAddr: Call(GetGP); tmp2 := tmp2 - SB, Call(WordParm); tmp := Shift + tmp;   E := Tos; Last; Word := Word + AddY, Fetch, if Lss goto(Minus); ! X is going positive. ------ ! ! IO.Micro - Perq I/O microcode. ! Brian Rosen ca. 1 Jan 80. ! J. P. Strait 14 Feb 81 Plus: Bit and not Last, Rotate(1); PlusA: Bit := Shift, if eql goto(PlusB); Word, Store, GotoS; PlusB: . Cleaned-up. ! Copyright (C) Three Rivers Computer Corporation, 1980, 1981. ! ! Abstract: ! !---------------------Nop; Word := Word + 1, Fetch; Last, goto(PlusA); L5: dY - dX; E := E + T, if Gtr Goto(Same); -------------------------------------------------------- ! 16 Apr 81 V1.7 George Robertson, Gene Ball ! Added suppo Last; Word, Fetch, if Gtr goto(Plus); ! X is going negative. Minus: Bit and not Last, Rotate(17); rt for 3MHz Ethernet ! 10 Apr 81 V1.6 George Robertson ! Moved IO to 4400-5777. ! 31 Mar 81 V1.5 George Robertson MinusA: Bit := Shift, if eql goto(MinusB); Word, Store, GotoS; MinusB: Word := Word - 1, Fetch; Last, goto(M ! Moved time base from clock to video refresh. ! 6 May 81 V1.4 John Strait. ! 1. Rename dskTrack to dskCyl. ! 2. CinusA); ! X is not changing. Same: Word := Word + AddY, Fetch; Nop; Nop; hange the StartIO that tells the microcode what cylinder the heads are ! on to read the cylinder number from the E-Stack. T Word, Store, GotoS; ! Combine new bit with old word. Set: MDO := MDI or Bit, Goto(Top); Clear:his allows recalibrate ! code to set the current cylinder number to MaxCylinder (201 decimal) ! before starting. ! 3.  := Shift - dX; ! Shift = 0 ! Determine line style. L2: Tos := Tos and AllOnes;  MDO := MDI and not Bit, Goto(Top); Flip: MDO := MDI xor Bit, Goto(Top); LineInt: Vector(IntVec); ! Exit Tos - 1, LoadS(Clear); Word := Word + SB, if Eql goto(L3); ! physical address Tos - 2, LoadS(Flip);. ExitLine: Pop, NextInst(0);  if Eql goto(L3); LoadS(Set); ! Calculate derived values. L3: T := Tos := dY, if IntrPend Call(LineInt); D := Tos - dX; F := Tos + dX, if Lss goto(L4); T := Tos := dX; D := Tos - dY; L4: E := 0; TplusD := Tos + D; ! Main loop. Top: Tos := E + E, if IntrPend Call(LineInt);  F := F - 1; Tos + TplusD, if Lss goto(ExitLine); Tos := D + E, if Lss goto(L5); F := F - 1; $Title IO.Micro - Perq I/O microcode. ! IO Microcode. !-----------------------------------------------------------------------  ! Stack popped. ! Memory[GlobalArea + Offset] = Value. ! ! Calls: ! GetGP, VectSrc, WordParm. ! !----- the range 0..65535. ! ! Instruction: ! LDIW OffsetInStaticNesting LowByteOffset HighByteOffset ! ! Result: ! ------------------------------------------------------------------------ Opcode(STGB), tmp2 := NextOp; tmp3 := NextO Stack pushed. ! (Tos) = Memory[IntermediateArea + Offset]. ! ! Calls: ! GetLP, WordParm. ! !---------------p; StoreGlobal: Call(GetGP); tmp2 + tmp3, Store; Tos, Pop, NextInst(0); Opcode(STGW), tmp2 := NextOp; -------------------------------------------------------------- Opcode(LDIB), tmp3 := NextOp; tmp4 := NextOp + SB; L Call(WordParm); tmp3 := Shift + tmp, Goto(StoreGlobal); $Title LDIx - Load intermediate variable. ! OoadInter: tmp2 := AP, Call(GetLP); tmp4 := Mdi + tmp4; ! physical address of variable tmp4, Fpcode LDIB. !----------------------------------------------------------------------------- ! ! Abstract: ! LDIB is a tetch; Tos := Mdi, Push, NextInst(0); Opcode(LDIW), tmp3 := NextOp; Call(WordParm); tmp4 := Shift +hree byte instruction that loads an intermediate variable ! onto the expression stack. The lexical level of the variable tmp; tmp4 := tmp4 + SB, Goto(LoadInter); $Title LIAx - Load intermediate address. ! Opcode LIAB. !------ is ! represented by an offset in static nesting that must be in the ! range 0..255. The offset of the variable w----------------------------------------------------------------------- ! ! Abstract: ! LIAB is a three byte instructioithin its activation ! record must be in the range 0..255. ! ! Instruction: ! LDIB OffsetInStaticNesting Offsn that loads the address of an ! intermediate variable onto the expression stack. The lexical ! level of the variet ! ! Result: ! Stack pushed. ! (Tos) = Memory[IntermediateArea + Offset]. ! ! Calls: ! GetLP. ! !--able is represented by an offset in static ! nesting that must be in the range 0..255. The offset of the ! variab--------------------------------------------------------------------------- ! Opcode LDIW. !--------------------------------le within its activation record must be in the range 0..255. ! ! Instruction: ! LIAB OffsetInStaticNesting Offset !--------------------------------------------- ! ! 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 !   9 Sep 80 V1.1 John Strait. ! Fix bug in speech out: not clearing bit in Z80Status. $Include IO.Dfs $Include Perq.Dfs yte,257); !Bit 0 = input hi/lo byte indicator, bit 7 is for output define(Z80ByteCnt,232); !Byte count for Z80 data coming i Decimal; $Include Except.Dfs Octal; $Title Register definitions. define(r370,370); definen define(Z80OData,235); define(Z80Otmp,236); define(Z80OBytCnt,237); define(Z80OAdr,240); define(Z80FloppyDcb,242); de(dskTmp,200); define(dskDCBptr,201); !Pointer to the DCB we are working on define(dskCMD,202); !The command we are doing fine(Z80RsoTmp, 243); define(Z80OtmpState,244); define(Z80SpchAdr,245); define(Z80SpchCnt,246); define(Z80488Adr,263); defi define(dskAddr,203); !the Disk Address we are doing it to define(dskCyl,204); !Where the disk heads are now define(dskSene(Z80488Cnt,264); define(Z80488Cmd,265); define(Z80StateAdr,247); define(Z80StateType,250); define(Z80Restart,251); defineek,205); !how many tracks to seek, known to Z80 microcode define(dskNumSec,206); !How many sectors to transfer define(dskI(Z80VIntr,256); define(Z80OVintr,260); define(ioTabAdr,252); ! Address of Tablet Words define(dpyCntlBlk,255); !Address of ntrLevel,207); !1 if code running from interrupt, 0 if from Qcode define(ioSeg,211); !Common io stuff - Segment Number of Display Control Block define(Z80FlpAdr,262); define(dpyCm,372); !Pointer to current Video command define(dpyCBase,373)a VA define(ioOffset,212); ! " Offset of a VA define(ioPhysAdr,213); ! " Physical Address de; !Base address of Cursor Pattern define(ClkTim1,276); ! Low order 60 Hz. clock define(ClkTim2,277); ! High order 60fine(ioPhAdrHi,214); ! " High 4 bits of Physical Address define(ioLen,215); ! " Length of a Hz. clock {Ether3MBaud not assembled. !*** NOTE: IOE3.Micro is included later and has register definitions for !  Circular Buffer define(ioRdPtr,216); ! " Read Pointer in a Circular Buffer define(ioWrPtr,217); ! "  the 3MHz Ethernet support. Ether3MBaud not assembled.} $Title Constant definitions. constant(dskStat,100);  Write Pointer in a Circular Buffer define(ioTmp,220); ! " Temporary define(ioTmp1,261); !  !io address of Status Register constant(dskCntl,301); !io address of Command/Control Register constant(dskHead,302); !io adDon't initialize dskCyls in IO initialization--let the Pascal code do it. ! 14 Mar 81 V1.3 John Strait. ! 1. Fixed another " Another Temporary define(ioChar,221); ! " Character out of a Circular Buffer define(ioKbdCb bug or two in multi-sector transfers. ! 2. Added stuff for exceptions. ! 14 Feb 81 V1.2 John Strait. ! 1. Cleaned-up the,222); define(ioRsInCb,223); define(ioRsOutCb,224); define(io488InCb,266); define(ioDevTab,225); define(Z80Chr, 226); !  code a little bit. ! 2. Fixed a couple bugs in multi-sector disk transfers. ! 3. Fixed a bug in Video interrupt service. !Last character received from Z80 define(Z80Buff,230); ! Adr of ChrCtlBlk for active device define(Z80Tmp,231); define(Z80B activation ! record must be in the range 0..255. ! ! Instruction: ! STIB OffsetInStaticNesting Offset ! ! Environment: ! (Tos) = Value. ! ! Result: ! Stack popped. ! Memory[IntermediateArea + Offset] = Value. ! $Title LDIND, STIND - Indirect one word loads and stores. ! Opcode LDIND. !------------------------------------------------ ! Calls: ! GetLP. ! !----------------------------------------------------------------------------- ! Opcode STIW. ----------------------------- ! ! Abstract: ! LDIND is a one byte instruction that loads a word onto the ! expre intermediate variable onto the expression stack. The lexical ! level of the variable is represented by an offset in!----------------------------------------------------------------------------- ! ! Abstract: ! LDIW is a four byte inst static ! nesting that must be in the range 0..255. The offset of the ! variable within its activation record musruction that stores an intermediate variable ! from the expression stack. The lexical level of the variable is ! t be in the range 0..65535. ! ! Instruction: ! LIAW OffsetInStaticNesting LowByteOffset HighByteOffset ! ! Result:represented by an offset in static nesting that must be in the ! range 0..255. The offset of the variable within its act ! Stack pushed. ! (Tos) = IntermediateArea - SB + Offset. ! ! Calls: ! GetLP, WordParm. ! !-----------ivation ! record must be in the range 0..65535. ! ! Instruction: ! STIW OffsetInStaticNesting LowByteOffset H------------------------------------------------------------------ Opcode(LIAB), tmp3 := NextOp; tmp4 := NextOp; LoighByteOffset ! ! Environment: ! (Tos) = Value. ! ! Result: ! Stack popped. ! Memory[IntermediateArea +adIAddr: tmp2 := AP, Call(GetLP); Tos := Mdi + tmp4, Push, NextInst(0); Opcode(LIAW), tmp3 := NextOp; Call( Offset] = Value. ! ! Calls: ! GetLP, VectSrc, WordParm. ! !---------------------------------------------------------WordParm); tmp4 := Shift + tmp, Goto(LoadIAddr); $Title STIx - Store intermediate variable. ! Opcode STIB.-------------------- Opcode(STIB), tmp3 := NextOp; tmp4 := NextOp + SB; StoreInter: tmp2 := AP, Call(GetLP);  !----------------------------------------------------------------------------- ! ! Abstract: ! STIB is a three byte i Mdi + tmp4, Store; Tos, Pop, NextInst(0); Opcode(STIW), tmp3 := NextOp; Call(WordParm); tmp4 :=nstruction that stores an intermediate variable ! from the expression stack. The lexical level of the variable is !  Shift + tmp, if IntrPend Call(VectSrv); tmp4 := tmp4 + SB, Goto(StoreInter);  represented by an offset in static nesting that must be in the ! range 0..255. The offset of the variable within its  dress of Head Number Register constant(dskCylSec,310);!io address of Cylinder/Sector Number Register constant(dskFSNlo,311); !tDTentry,50); !GPIB Output entry in DevTab (10 * 5); constant(ioVltDTentry,60); !Voltage Monitor entry in DevTab (10 * 6) coio address of FileSerialNumber low bits Register constant(dskFSNhi,312); !io address of FileSerialNumber hi bits Register consnstant(ioSpchDTentry,40); !Speech entry in DevTab (10 * 4) constant(ioSetDTentry,140); !SetStatus entry in DevTab (10 * 14) cotant(dskLBN,313); !io address of LogicalBlockNumber Register constant(dskHdrLo,331); !io address of Header Buffer Address lownstant(ioGetDTentry,150); !GetStatus entry in DevTab (10 * 15) constant(Z80Prefix,153); !Flag Char sent by Z80 at start of m bits Register constant(dskHdrHi,321); !io address of Header Buffer Address hi bits Register constant(dskDataLo,330);!io addreessage constant(ioIntMaskOffset,3); constant(Z80NulIntMsk,3); !guaranteed word of 0 in dev table constant(dskIntMsk,13); ss of Data Buffer address low bits Register constant(dskDataHi,320);!io address of Data Buffer address hi bits Register consta !Hard Disk Interrupt Mask offset in DevTab constant(Z80VltIntMsk,63); !Voltage Interrupt Mask offset in DevTab constant(Z80nt(ioBlkSizeOffset,2); !Offset in Device Table for Buffer Size constant(ioCbOffset,0); !Offset in Device Table for CircularBuffKbdIntMsk,103); !Keyboard Interrupt Mask offset in DevTab constant(Z80RsoIntMsk,123); !RS232 Output Interrupt Mask offset in Deer Pointer constant(ioFloppyBlkSizeOffset,32); !Offset in DevTab for Floppy Blk Size !There are 10 words/dev tablvTab constant(Z80RsiIntMsk,113); !RS232 Input Interrupt Mask offset in DevTab constant(ClkIntMsk,73); !60 Hz Clock Interrue entry. (10 * 3) + 2 = 32 constant(ioSpchBlkSizeOffset,42); !Offset in DevTab for Speech Blk Size ! (10 * 4) + 2pt Mask offset in DevTab constant(Z80GetIntMsk,153); !GetStatus Interrupt Mask offset in DevTab constant(Z80SetIntMsk,143); !S = 42 constant(ioIntTentry,0); !Master Z80 (IO Init) entry in Device Table constant(dskDTentry,10); !Hard Disk entry in etStatus Interrupt Mask offset in DevTab constant(Z80SpkIntMsk,43); !Speech Interrupt Mask offset in DevTab constant(Z80488IDevice Table (10 * 1) constant(ioDpyDTentry,210); !Display entry in Device Table (10 * 21) constant(ioTabDTentry,70); !TabletnIntMsk,133); !GPIB Input Interrupt Mask offset in DevTab constant(Z80488OutIntMsk,53); !GPIB Output Interrupt Mask offset in entry in DevTab (10 * 7) constant(ioKbdDTentry,100); !Keyboard entry in Device Table (10 * 10) constant(ioRsiDTentry,110); !R DevTab constant(Z80FlpIntMsk,33); !Floppy Interrupt Mask offset in DevTab constant(Z80DoSeek,20); !bit for Z80WantOutputS232 Input entry in DevTab (10 * 11) constant(ioRsoDTentry,120); !RS232 Output entry in DevTab (10 * 12) constant(ioFlpDTentry for disk seek constant(Z80DoSpeech,2); constant(Z80DoFloppy,4); constant(Z80DoRS232,1); constant(Z80DoGpib,10); constant(Z,30); !Floppy entry in DevTab (10 * 3); constant(io488InDTentry,130); !GPIB Input entry in DevTab (10 * 13) constant(io488Ou80DoSetStatus,40); constant(Z80DoGetStatus,100); constant(Z80DataIOB,307); constant(OVRErr,140000); ! status bits to s ------------------------------- Opcode(STIND), tmp := Tos, Pop; Nop; !***** MAB ctSrv); Tos := tmp1, Push, NextInst(0); ! Opcode STDW. !---------------------------------------------------------- Tos + SB, Store; tmp, Pop, NextInst(0); $Title LDDC, LDDW, STDW - Double word loads and stores. ! Opc------------------- ! ! Abstract: ! STDW is a one byte instruction that stores a double word from the ! expressiode LDDC. !----------------------------------------------------------------------------- ! ! Abstract: ! LDDC is a fivon stack. ! ! Instruction: ! STDW ! ! Environment: ! (Tos-0) = Word0. ! (Tos-1) = Word1. ! (Tos-e byte instruction that loads a double word onto the ! expression stack. ! ! Instruction: ! LDDC HighByteWord2) = Address of the double word as an offset from stack base. ! ! Result: ! Memory[Address + 0] = Word0. ! Memor0 HighByteWord0 ! HighByteWord1 HighByteWord1 ! ! Result: ! Push stack twice. ! (Tos-0) = Word1. y[Address + 1] = Word1. ! Stack popped three times. ! ! Calls: ! VectSrv. ! !--------------------------------- ! (Tos-1) = Word0. ! ! Calls: ! WordParm. ! !------------------------------------------------------------------------------------------------------------- Opcode(STDW), tmp := Tos, Pop; tmp1 := Tos, Pop; Nop; ssion stack. ! ! Instruction: ! LDIND ! ! Environment: ! (Tos) = Address of the word as an offset from stack b------------ Opcode(LDDC), Call(WordParm); Tos := Shift + tmp, Push; Call(WordParm); Tos := Shift ase. ! ! Result: ! (Tos) = Memory[Address]. ! !----------------------------------------------------------------------+ tmp, Push, NextInst(0); ! Opcode LDDW. !----------------------------------------------------------------------------- ! ------- Opcode(LDIND), Nop; !***** BR Tos + SB, Fetch; !***** BR  ! Abstract: ! LDDW is a one byte instruction that loads a double word onto the ! expression stack. ! ! Instruct Tos := Mdi, NextInst(0); ! Opcode STIND. !----------------------------------------------------------------------------- ion: ! LDDW ! ! Environment: ! (Tos) = Address of the double word as an offset from stack base. ! ! Result: ! ! ! Abstract: ! STIND is a one byte instruction that stores a word from the ! expression stack. ! ! Instructio Push stack once. ! (Tos-0) = Memory[Address + 0]. ! (Tos-1) = Memory[Address + 1]. ! ! Calls: ! Ven: ! STIND ! ! Environment: ! (Tos) = Word. ! (Tos-1) = Address of the word as an offset from stack base.ctSrv. ! !----------------------------------------------------------------------------- Opcode(LDDW), tmp := Tos;  ! ! Result: ! Memory[Address] = Word. ! Stack popped twice. ! !----------------------------------------------tmp := tmp + SB, Fetch; !***** BR tmp1 := Mdi; tmp + 1, Fetch; Tos := Mdi, if IntrPend Call(Ve Integer; ! NextBlock: Long ! PreviousBlock: Long; {End of Header Block} ! Result:nto dsk controller not ioPhAdrHi, IOB(dskDataHi); dskAddr, Field(5,3); !Get head field  Packed Record ! CntrlrErr: (.....) {3 bits} ! IllegalCmd: Boolean; !  SHIFT, IOB(dskHead); dskAddr, IOB(dskCylSec); !Let Hardware know about addr dskDCBptr+4, Fetch TrackZero: Boolean; ! WriteFault: Boolean; ! SeekCompl: Bool4; !pick up the FSN/LBN dskCMD, Field(10,10); !Num sectors to transfer dskNumSec := SHIFT; !Wiet for overrun error constant(cbRdOff,2); ! offsets to circular buffer info constant(cbWrOff,1); constant(cbLnOff,ean; ! DriveReady: Boolean; ! end; ! OsUnused: Array [0..2] of Unspeci3); constant(cbBufOff,2); ! offset from IOCB to number of blocks/buffs constant(Z80St0,5100); ! Dispafied; ! end; ! !----------------------------------------------------------------------------- ! Hard disk StartItch point for Z80 input intrs constant(Z80St1,5200); constant(Z80Msg0,5300); ! Dispatch point for message type constaO. !----------------------------------------------------------------------------- ! !----------------------------------------nt(Z80Msg1,5400); Constant(Z80OSt,5500); ! Dispatch point for Z80 output intrs Place(4400,5777); ------------------------------------- dskStart: dskIntrLevel := 0, Case(StartIO,1); dskGetDcbPtr: ioDevTab + dskDTentry, Fet $Title Hard disk. ! Hard disk. !----------------------------------------------------------------------------- ! !ch2, Call(ioTLate);!Get DCB ptr dskDCBptr := ioPhysAdr, Call(ioXLateA); !It was a virtual address not ioPhThe format of a dsk DCB ! dskDCB: Packed Record ! Data: ^dskData; ! Command: (Idle,WriteCheck,Write,FoAdrHi, IOB(dskHdrHi); !Let Hardware have upper bits dskDoSector: dskTmp := dskDCBptr, Fetch4; !get Data Buf, Cmd, NumSec & rmatWrite,ReadCheck,FormatRead ! SeekOnly, Reset); ! NumSec: 0..255; {Number of sectors tDskAdr dskTmp := dskTmp + 4; !offset to header data dskTmp xnor C1777, IOB(dskHdrLo);!Give heado transfer} ! DiskAddr: Packed Record ! Sect: (0..29); {5 bits} ! er address to controller ioOffset := MDI; ! pick up the segment number ioSeg := MDI;  Head: (0..7); {3 bits} ! Cyl: (0..201); {8 bits} ! end; ! File ! And his Data Buffer offset dskCMD := MDI; !The command to do dskAddr := SerialNumber: Long; {Start of Header Block} ! LogicalBlockNumber: Integer; ! NumberOfGoodBytes: MDI, Call(ioXlateA);!And the place on the disk to do it to ioPhysAdr xnor C1777, IOB(dskDataLo); !Put PA of Buf ptr i . ! ! Instruction: ! LDMC N ! LowByteWord0 HighByteWord ! LowByteWord1 HighByteWord1 emory[TP-1] = Memory[Address+1]. ! Memory[TP-0] = Memory[Address+0]. ! Stack popped twice. ! ! Calls: ! ! ... ! LowByteWordN-2 HighByteWordN-2 ! LowByteWordN-1 HighByteWordN-1 ! ! Res ChkStk, MoveMem, StkOv, VectSrv. ! !----------------------------------------------------------------------------- Opcodeult: ! Push N words onto the memory stack. ! Memory[TP-N+1] = Word. ! Memory[TP-N+2] = Word1. ! .(LDMW), tmp := Tos, Pop; tmp10 := tmp, LoadS(LDMW1); !***** BR Tos := Tos + SB, Call(ChkStk); .. ! Memory[TP-1] = WordN-2. ! Memory[TP-0] = WordN-1. ! ! Calls: ! ChkStk, WordParm. ! !----------TP := TP + tmp; dst := TP, Call(MoveMem); Pop, NextInst(0); ! Here on stack overflow. LDMW1: Tos ------------------------------------------------------------------- Opcode(LDMC), tmp2 := NextOp; ! number of w:= Tos - SB; Tos := tmp, Push; tmp11 := 1, Goto(StkOv); ! Opcode STMW. !---------------------------------ords Nop; ! let placer do a page escape tmp11 := 2, LoadS(StkOv); tmp1-------------------------------------------- ! ! Abstract: ! STMW is a one byte instruction that stores multiple words 0 := tmp2, Call(ChkStk); ! make sure there's room LDMC1: Call(WordParm); ! get next word tfrom the ! memory stack. ! ! Instruction: ! STMW ! ! Environment: ! (Tos) = N. ! (Tos-1) = Addremp := Shift + tmp; TP := TP + 1, Store; tmp, if IntrPend Call(VectSrv); ! push it onto memory stack ss of the words as an offset from stack base. ! Memory[TP-0] = Word0. ! Memory[TP-1] = Word1. ! ... !  tmp2 := tmp2 - 1; if Gtr Goto(LDMC1); ! if not done yet NextInst(0); ! Opcode LDMW. !- Memory[TP-N+1] = WordN-1. ! ! Result: ! Memory[Address+0] = Word0. ! Memory[Address+1] = Word1. !  !***** MAB tmp2 := Tos + SB, Store; tmp, Pop, if IntrPend Goto(STDW2); STDW1: tmp2 + 1, St---------------------------------------------------------------------------- ! ! Abstract: ! LDMW is a one byte instrucore; tmp1, NextInst(0); STDW2: Call(VectSrv); Goto(STDW1); $Title LDMC, LDMW, STMW - Multtion that loads multiple words onto the ! memory stack. ! ! Instruction: ! LDMW ! ! Environment: ! (Tosiple word loads and stores. ! Opcode LDMC. !----------------------------------------------------------------------------- ) = N. ! (Tos-1) = Address of the words as an offset from stack base. ! ! Result: ! Push N words onto the memory! ! Abstract: ! LDMC is a variable length instruction that loads a multiple word ! constant onto the memory stack stack. ! Memory[TP-N+1] = Memory[Address+n-1]. ! Memory[TP-N+2] = Memory[Address+n-2]. ! ... ! M s GoTo(dskSeekBack); 10, IOB(dskCntl); GoTo(Z80DiskSeek); dskSeekBack: dskSeek := not dskSeek;  !Get Cmd/NumSec dskTmp := MDI; dskDCBptr+2, Store; MDO := dskTmp - 400; !Decrement  dskSeek := dskSeek + 1; 0, IOB(dskCntl); GoTo(Z80DiskSeek); dskSeekOnly: IOB(dskStat); !Code 6 is seek NumSec dskDCBptr+10, Fetch; !Get the Next Disk Address dskTmp := MDI; dskDCBptr+3, Storeonly, finsih now dskTmp := IOD, GoTo(dskISrvA); ! Hard disk interrupt service. !--------------------------------; !Update the Disk Address dskTmp, GoTo(dskDoSector); Z80DiskSeek: Z80WantOutput := Z80WantOutput or Z80Do--------------------------------------------- ! !-----------------------------------------------------------------------------Seek, Call(Z80StartScan); dskIntrLevel; if Odd Goto(NiceRet); TOS := 0, Push, NextInst(0);  dskIntrServ: dskIntrLevel := 1,IOB(dskStat),loc(DiskInt); !Disk Interrupt Service dskTmp := IOD; !Ge $Title Circular buffered devices. ! Circular buffers. !---------------------------------------------------------------t disk status and save it 0, IOB(dskCntl); !Clear the interrupt quick dskISrvA: dskTmp and 47; -------------- ! !Format of a CircularBuffer ! CirBuffer: Record {Must be aligned on a Quad Boundary} ! ll do multi-sector xfer if <= 1 MDI, IOB(dskFSNlo); !Here comes the file serial number MDI, IOB(dskF !Check errors (Controller and WriteFault) dskNumSec := dskNumSec - 1, if Neq GoTo(dskCmdDone);!Count # sectors SNhi); ! a 32 bit quantity MDI, IOB(dskLBN); !And then the Logical Block Number dskCMD := dsk IF Gtr GoTo(dskMoreSecs); dskCmdDone: MA := dskDCBptr+14, Store; !Store the result status MDO := dskTmp; CMD and 47; !Get rid of all but real command bits dskAddr, Field(10,10); !get Cylinder field dskSeek:=SH !The disk status code ioDevTab + dskIntMsk, Fetch; UserIntr := MDI or UserIntr; !Cause Pascal iIFT-dskCyl;!Compare to where we are now dskSeek, IF Neq GoTo(dskCallZ80); !If not 0, Seek is required dskDoCmd: dskCnterrupt dskIntrLevel; if Odd Return; TOS := not 0, push, NextInst(0); dskMoreSecs: MA := dskMD - 6; !This command is needs extra work if eql GoTo(dskSeekOnly); dskCMD, IOB(dskCntl); DCBptr, Fetch; !Get the Data buffer Pointer Offset dskTmp := MDI; MA := dskDCBptr, Store; !Update the!start disk dskIntrLevel; if Odd GoTo(NiceRet); !Dismiss intr if thats how we got here TOS : Data buffer offset MDO := dskTmp + 400; dskDCBptr+6, Fetch; !Pick up the LogicalBlockNumber = not 0, push, NextInst(0);!otherwise, return with NextInst, TOS good dskCallZ80: dskCyl := dskCyl + dskSeek, IF Ls dskTmp := MDI; dskDCBptr+6, Store; !Update it dskTmp + 1; dskDCBptr+2, Fetch;  s: ! VectSrv, MoveMem. ! !----------------------------------------------------------------------------- Opcode(STMW)ack. ! ! Instruction: ! STB ! ! Environment: ! (Tos) = Byte. ! (Tos-1) = ByteOffset. ! (Tos-2) =, tmp := Tos, Pop; tmp := tmp - 1; !***** BR dst := Tos + SB, if Lss Goto(STMW1); ! if no WordAddress as an offset from stack base. ! ! Result: ! Stack popped three times. ! Memory[Address].Byte[ByteOf words to store dst := dst + tmp; Tos := TP := TP - tmp; tmp := tmp + 1, Call(MoveMem); TP :fset] = Byte. ! ! Calls: ! VectSrv. ! !----------------------------------------------------------------------------- = TP - 1, Pop, NextInst(0); STMW1: Pop, NextInst(0); $Title LDB, STB, LDCH, STCH - Byte and Char loads and stores.  Opcode(STB), tmp2 := Tos and 377, Pop; tmp := Tos and AllOnes, Pop, RightShift(1); ! byte offset tmp1 :=  ! Opcode LDB. !----------------------------------------------------------------------------- ! ! Abstract: ! LDB iShift + SB; tmp1 := Tos + tmp1, Fetch; ! fetch the target word tmp, Pop; if Odd Goto(STB2);s a one byte instruction that loads a byte onto the expression ! stack. ! ! Instruction: ! LDB ! ! Environment ! if storing high byte ! Store the low byte. tmp := Mdi and not 377, if IntrPend : ! (Tos) = ByteOffset. ! (Tos-1) = WordAddress as an offset from stack base. ! ! Result: ! Push stack. Call(VectSrv); ! Store the target word back. STB1: tmp1, Store; tmp or tmp2, NextInst(0); ! co! (Tos) = Memory[WordAddress].Byte[ByteOffset]. ! ! Calls: ! VectSrv. ! !--------------------------------------mbine bytes and store ! Store the high byte. STB2: tmp := Mdi and 377, if IntrPend Call(VectSrv); --------------------------------------- Opcode(LDB), tmp := Tos and AllOnes, Pop, RightShift(1); tmp1 := Shift + SB, tmp2, LeftShift(10); tmp2 := Shift, Goto(STB1); ! Opcode LDCH. !------------------------------------------------- if IntrPend Call(VectSrv); ! word offset Tos + tmp1, Fetch; tmp; if Odd Goto(LDB1); ---------------------------- ! ! Abstract: ! LDCH is a one byte instruction that loads a character from a string !  ! if loading high byte Tos := Mdi AND 377,NextInst(0); ! load low byte LDB1: Mdi, Field(10,10); T onto the expression stack. ! ! Instruction: ! LDCH ! ! Environment: ! (Tos) = CharacterIndex. ! (Tosos := Shift, NextInst(0); ! load high byte ! Opcode STB. !--------------------------------------------------------1) = Address of the string as an offset from stack base. ! ! Result: ! Stack popped. ! (Tos) = Memory[Address]. ... ! Memory[Address+N-1] = WordN-1. ! Stack popped twice. ! Pop N words from the memory stack. ! ! Call---------------------- ! ! Abstract: ! STB is a one byte instruction that stores a byte from the expression ! st ------------------------- cbPutChrQ: ioChar := TOS, pop, Call(cbSetUpQ),case(StartIO,16); !cir buf put TLateB); !Get Circular Buffer Pointer on TOS cbSetUp: ioPhysAdr, Fetch4; !entry point for io device microcod ! TOS = Char ! TOS-1,TOS-2 = VA of control block cbPutChr1:e ioPhysAdr := ioPhysAdr + 3; !Set ioPhysAdr to 1st data item ioLen := MDI; ioRdPtr := MDI;  Call(cbPut); cbPutChr2: TOS := ioTmp, push, NextInst(0); !Return results on TOS cbGetChrQ: Call(cbSetUpQ), case(Start ioWrPtr := MDI, return; ! Routine cbPut. !------------------------------------------------------------------------IO,17); !special cir buf get !TOS,TOS-1 = VA of control block cbGetChr1: Call(cbGet----- ! !Routine to put an item in a CircularBuffer ! cbSetUp must be called prior to calling cbPut ! !-------------------); cbGetChr2: TOS := ioChar, Push; !Return Results on TOS - 1 TOS := ioTmp, Push,NextInst(0); !Return Succe---------------------------------------------------------- cbPut: ioTmp := ioRdPtr; !must calculate (ioRdPtr - 1) - ioss flag on TOS cbKbdGet: ioPhysAdr := ioKbdCb, Call(cbSetUp), Case(StartIO,10); GoTo(cbGetChr1); WrPtr cbPut1: ioTmp := ioTmp - 1, If Eql GoTo(cbPutOvr); !To see if buffer is full ioTmp - ioWrPtr; iocbRS232Get: ioPhysAdr := ioRsInCb, Call(cbSetUp), Case(StartIO,11); GoTo(cbGetChr1); cbRS232Put: ioPhysAdr Tmp := 0, if eql Return; ! return with 0 => failure MA := ioPhysAdr + ioWrPtr, Store; !Put the data item in the b:= ioRsOutCb, Call(cbSetUp), Case(StartIO,12); ioChar := TOS, Call(cbPut); TOS := ioTmp; uffer ioChar; !the data ioWrPtr := ioWrPtr + 1; !Now update your pointer ioWrPtr - ioLen; !Return results on TOS if intrpend call(vecint); !give the io a break Z80WantOutput := Z80WantOutput  !Watch out for wrap around ioTmp := not 0, If Neq GoTo(cbPutDone); ioWrPtr := 0; !Wrap ar cbLen: (0..MaxLen); {Actually has "MaxLen" in it} ! cbRdPtr: (0..MaxLen); ! or Z80DoRS232, Call(Z80StartScan); !Queue a request for the Z80 to start it Next cbWrPtr: (0..MaxLen); ! cbBuf: Array [0..MaxLen] of XXX (A one word packed record) ! endInst(0); cb488Get: ioPhysAdr := io488InCb, Call(cbSetUp), Case(StartIO,13); GoTo(cbGetChr1); ! Routi; ! !----------------------------------------------------------------------------- ! Circular buffered StartIOs. !-------ne cbSetUpQ. !----------------------------------------------------------------------------- ! ! Routine to initialize registe---------------------------------------------------------------------- ! !----------------------------------------------------rs from a CircularBuffer ! !----------------------------------------------------------------------------- cbSetUpQ: Call(io ; ! combine bytes and store NextInst(0); ! Store a high byte. STCH2: tmp2, LeftShift(10)moves one byte. ! ! Instruction: ! MVBW ! ! Environment: ! (Tos) = N. ! (Tos-1) = SrcByte = Source byte; tmp2 := Shift; tmp3 := Mdi and 377, Goto(STCH1); ! go store the byte $Title MVBB, MVBW, LSA, SAS offset. ! (Tos-2) = SrcWord = Source word address as offset from stack base. ! (Tos-3) = DstByte = Destination byByte[CharacterIndex+1]. ! ! Calls: ! GetStringIndex. ! !------------------------------------------------------------- - Byte array and string moves. ! Opcode MVBB. !------------------------------------------------------------------------------------------- Opcode(LDCH), Call(GetStringIndex); tmp; if Odd Goto(LDCH1); ! if the cha-- ! ! Abstract: ! MVBB is a two byte instruction that moves bytes from one area of ! memory to another. The nuracter is in high byte ! Character is in a low byte. Tos := Mdi and 377, NextInst(0); ! get low byte mber of bytes must be in the range 1..255. ! Specifying a length of zero moves one byte. ! ! Instruction: ! MVBB! Character is in a high byte. LDCH1: Mdi, field(10,10); ! get high byte Tos := Shift, Next N ! ! Environment: ! (Tos) = SrcByte = Source byte offset. ! (Tos-1) = SrcWord = Source word address as offsInst(0); ! Opcode STCH. !----------------------------------------------------------------------------- ! ! Abstract: ! et from stack base. ! (Tos-2) = DstByte = Destination byte offset. ! (Tos-3) = DstWord = Destination word address  STCH is a one byte instruction that stores a byte from the expression ! stack. ! ! Instruction: ! STCH ! as offset from stack base. ! ! Result: ! Stack popped four times. ! Memory[DstWord].Byte[DstByte+0] = Memory[Src! Environment: ! (Tos) = Character. ! (Tos-1) = CharacterIndex. ! (Tos-2) = Address of the string as an offWord].Byte[SrcByte+0]. ! Memory[DstWord].Byte[DstByte+1] = Memory[SrcWord].Byte[SrcByte+1]. ! ... ! Memoset from stack base. ! ! Result: ! Stack popped three times. ! Memory[Address].Byte[CharacterIndex] = Character.ry[DstWord].Byte[DstByte+N-1] = Memory[SrcWord].Byte[SrcByte+N-1]. ! ! Calls: ! GetSrcDst, GetSrc, GetDst, PutDst. !  ! ! Calls: ! GetStringIndex. ! !----------------------------------------------------------------------------- Opc!----------------------------------------------------------------------------- ! Opcode MVBW. !-----------------------------ode(STCH), tmp2 := Tos, Pop, Call(GetStringIndex); tmp; if Odd Goto(STCH2); ! if storing a hi------------------------------------------------ ! ! Abstract: ! MVBW is a one byte instruction that moves bytes from ogh byte ! Store a low byte. tmp3 := Mdi and not 377; STCH1: tmp4 + tmp1, Store; tmp3 or tmp2, Popne area of ! memory to another. The number of bytes must be in the range ! 1..32767. Specifying a length of zero  tr; ioTmp, Return; ! return with -1 => success cbPutOvr: ioTmp := ioLen, GoTo(cbPut1); !RdPtr was 0, DoFloppy, Call(Z80StartScan); TOS := not 0, Push, NextInst(0); $Title Speech. ! Speech StartIO. !-----if WrPtr = Len-1 => full ! Routine cbPut. !----------------------------------------------------------------------------- !------------------------------------------------------------------------ ! !-------------------------------------------------- !Routine to get an item from a circular buffer ! cbSetUp must be called prior to calling cbGet ! !--------------------------------------------------- Z80SpeechStart: Z80spchCnt, Case(StartIO,4); !check speech io in progress if neq got----------------------------------------------------- cbGet: ioRdPtr - ioWrPtr; !Check for buffer empty o(ioBadBerries); !if so, can't do ioDevTab + ioSpchDTentry, Fetch2, Call(ioTLate);!Get dcb ptr i ioTmp := 0, if Eql Return; ! return with 0 => no char available ioPhysAdr + ioRdPtr, Fetch; !get the char oTmp := ioPhysAdr, Fetch2, Call(ioTLate);!Get data buffer pointer ioDevTab + ioSpchBlkSizeOffset, Fetch; !Get Block  ioRdPtr := ioRdPtr + 1; !update the Read Pointer ioRdPtr - ioLen; !Check for wrap around Size Z80SpchAdr := ioPhysAdr; !Save buffer address Z80WantOutput:=Z80WantOutput or Z80DoSpeech;  ioChar := MDI, If Neq GoTo(cbGetDone); ioRdPtr := 0; !Wrap around occured, start at top c ioTmp1 := MDI, If IntrPend Call(VecInt); ioTmp + cbBufOff, Fetch; !Get # buffers bGetDone: ioPhysAdr - cbRdOff, Store; ! write out new read pointer ioRdPtr; ioTmp := not 0, return; Z80SpchCnt := 0; MDI, RightShift(10); !Its iun the hi byte ioTmp := Shift; !poo ! return with -1 => success $Title Floppy disk. ! Floppy disk StartIO. !-----------------------------------------r man's multiply Z80SpchSt1: ioTmp := ioTmp - 1; !to get total bytecount Z80SpchCnt := Z80SpchCnt + ioTmp------------------------------------ ! !----------------------------------------------------------------------------- Flopp1, If gtr goto(Z80SpchSt1); Z80SpchAdr := Z80SpchAdr - 1, Call(Z80StartScan);!do all wds in buff TOS := yStart: ioDevTab + ioFlpDTentry, Fetch2, Call(ioTLate), Case(StartIO,3); not 0, Push, NextInst(0); !All is well $Title GPIB. ! GPIB StartIO. !----------------------------------------- !IOCB entry Z80FloppyDCB := ioPhysAdr, Fetch2, Call(ioTLate); !buffer address Z80FlpAdr := ioPhysAdr; ------------------------------------ ! !----------------------------------------------------------------------------- GPIBsound occured, start at top of buffer cbPutDone:ioPhysAdr - cbWrOff, Store; ! write out new write pointer ioWrP Z80FlpAdr := Z80FlpAdr - 1; !incremented before first memory ref Z80WantOutput := Z80WantOutput or Z80 DstWord = Destination word address as offset from stack base. ! Memory[SrcAddr].Byte[SrcByte] = N. ! ! Result: ! dress ! of a constant string onto the expression stack. The string follows ! the LSA in the code stream, but it m Stack popped five times. ! Memory[DstWord].Byte[DstByte+0] = Memory[SrcWord].Byte[SrcByte+0]. ! Memory[DstWord].Bust be word aligned. A noise ! byte is added when the LSA opcode is in a low order byte. The end ! of the stringyte[DstByte+1] = Memory[SrcWord].Byte[SrcByte+1]. ! ... ! Memory[DstWord].Byte[DstByte+N] = Memory[SrcWord].Byt need not be word aligned. ! ! Instruction: ! LSA N Char0 Char1 ... CharN-1 ! ! Result: ! Push stack twicee[SrcByte+N]. ! ! Calls: ! GetSrcDst, GetSrc, GetDst, PutDst, SASErr. ! !--------------------------------------------. ! (Tos) = Word address within code segment. ! (Tos-1) = Code segment number. ! ! Calls: ! AdjustPC. ! --------------------------------- Opcode(MVBB), tmp := NextOp; AssignBytes: Call(GetSrcDst); ! get addresses  !----------------------------------------------------------------------------- Opcode(LSA), Tos := CS, Push; UStatete offset. ! (Tos-4) = DstWord = Destination word address as offset from stack base. ! ! Result: ! Stack popped from stack Nop; ! let placer do a page escape MoveBytes: Call(GetSrc); five times. ! Memory[DstWord].Byte[DstByte+0] = Memory[SrcWord].Byte[SrcByte+0]. ! Memory[DstWord].Byte[DstByte+1] ! get source byte Call(GetDst); ! get destination byte Call(PutDst);  = Memory[SrcWord].Byte[SrcByte+1]. ! ... ! Memory[DstWord].Byte[DstByte+N-1] = Memory[SrcWord].Byte[SrcByte+N- ! put destination byte tmp := tmp - 1; DstLsb, if Gtr Goto(MoveBytes); ! if not done 1]. ! ! Calls: ! GetSrcDst, GetSrc, GetDst, PutDst. ! !-------------------------------------------------------------- if Odd Goto(MVBB1); NextInst(0); ! Here if last byte is a low-order byte. MVBB1: Dst, Store; --------------- ! Opcode SAS. !----------------------------------------------------------------------------- ! ! Abstract: ! store last byte (low order byte) DstWord, NextInst(0); Opcode(MVBW), tmp := Tos, Pop, Goto(AssignBy ! SAS is a one byte instruction that assigns one string to another. ! ! Instruction: ! SAS ! ! Environment: tes); Opcode(SAS), tmp2 := Tos and AllOnes, Pop; Call(GetSrcDst); SrcByte - tmp2; SrcByte := SrcBy! (Tos) = Maximum length of the destination string. ! (Tos-1) = SrcByte = Source byte offset. ! (Tos-2) = Srte + 1, if Gtr Goto(SASErr); tmp := SrcByte, Goto(MoveBytes); ! Opcode LSA. !-------------------------------------cWord = Source word address as offset from stack base. ! (Tos-3) = DstByte = Destination byte offset. ! (Tos-4) = ---------------------------------------- ! ! Abstract: ! LSA is a variable length instruction that loads the virtual ad  If Neq GoTo(ioWaitPrevSetStat); ! to finish before starting Z80StateType := TOS, pop; !Get Z80State := 0, GoTo(NiceRet); ! Message 1 - Keyboard character. Case(Z80Msg0,1), Z80Buff := ioKbdCb; Z80MsA:the channel number Z80StateType, if LSS return; ! MAB special code to locate disk heads ioDevTab + Tmp,  Z80State := 2, GoTo(NiceRet); ! Message 2 - RS232 characters. Case(Z80Msg0,2), Z80Buff := ioRsInCb; tart: ioDevTab + io488OutDTentry, Fetch2, Call(ioTlate), Case(StartIO,5); ioTmp := ioPhysAdr, Fetch4; Z8Fetch2, Call(ioTLate); Z80StateAdr := ioPhysAdr; !Save pa of buffer address Z80StateType, 0WantOutput := Z80WantOutput or Z80DoGpib; ioOffset := MDI; ioSeg := MDI; Z80488Cmd := MDI; return; $Title Z80 to Perq communications. ! Z80 to Perq interrupt service. !------------------------------------- Z80488Cnt := MDI, Call(ioTLateA); Z80488Adr := ioPhysAdr, Call(Z80StartScan); TOS := Not 0, ---------------------------------------- ! !----------------------------------------------------------------------------- ZPush, NextInst(0); $Title SetStatus and GetStatus. ! SetStatus and GetStatus StartIOs. !--------------------------80IntSrv: IOB(106),loc(Z80IInt); !Read the chr Z80Chr := IOD and 377; !Punt upper bits --------------------------------------------------- ! !----------------------------------------------------------------------- Z80State - 20, Field(0,4); !Dispatch to right routine Z80State, if Geq Dispatch(Z80St1); !dispatch to------ ioSetStatus: Tmp := ioSetDTentry,Call(ioWaitPrevSetStat), Case(StartIO,14); if LSS goto (ioSetDHeads);  states 20..37 Dispatch(Z80St0); !dispatch to states 0..17 Z80BumpState: Z80State := Z80State + ! MAB special to locate heads Z80WantOutput := Z80WantOutput or Z80DoSetStatus, Call(Z80StartScan); Next1, Return; !Next State please ! State 0 - Idle. case(Z80St0,0), Z80Chr - Z80Prefix; ! state 0 - idle Inst(0); ioSetDHeads: dskCyl := Tos, Pop, NextInst(0); ! Set current cylinder number ioGetStatus: Tmp := ioGetDTent if Neq GoTo(NiceRet); !only accept the flag char Z80State := 1, Return; !Got it, next byry, Call(ioWaitPrevSetStat), Case(StartIO,15); !Dont Get until last Set Z80WantOte is message type ! State 1 - Message type, begin communication. case(Z80St0,1), Z80Chr - 20, Field(0,4); ! utput := Z80WantOutput or Z80DoGetStatus, Call(Z80StartScan); NextInst(0); ioWaitPrevSetStat: if intrpend call(Vstate 1 - Dispatch on message type Z80Chr, if Geq Dispatch(Z80Msg1); !dispatch to messages 20..37 DispaecInt); !This may take a while Z80WantOutput and 140; !Wait for any prior SetStat/GetStat tch(Z80Msg0); !dispatch to messages 0..17 ! Message 0 - Unknown message type. Case(Z80Msg0,0),  es words from one area of ! memory to another. The number of words must be in the range 1..255. ! ! Instruction: ! f IntrPend Call(VectSrv); dst := dst + SB; Tos := src + SB, Call(SetMovUp); MOV1: Pop, NextInst(0); Opco MOVB N ! ! Environment: ! (Tos) = SrcAddr = Source address as an offset from stack base. ! (Tos-1) = DstAde(MOVW), tmp := Tos, Pop, Goto(MoveWords); $Title INDx - Index address and load indirect. ! Opcode IND1, IND2, ...ddr = Destination address as an offset from stack base. ! ! Result: ! Stack popped twice. ! Memory[DstAddr+0] = , IND7. !----------------------------------------------------------------------------- ! ! Abstract: ! The INDx opcodeMemory[SrcAddr+0]. ! Memory[DstAddr+1] = Memory[SrcAddr+1]. ! ... ! Memory[DstAddr+N-1] = Memory[SrcAddrs are single byte instructions that load indirect ! with an index of x. ! ! Instruction: ! INDx ! ! Environmen+N-1]. ! ! Calls: ! SetMovUp. ! !----------------------------------------------------------------------------- ! Ot: ! (Tos) = Address as an offset from stack base. ! ! Result: ! (Tos) = Memory[Address + x]. ! !-------------pcode MOVW. !----------------------------------------------------------------------------- ! ! Abstract: ! MOVW is a o---------------------------------------------------------------- ! Opcode INDB. !-------------------------------------------ne byte instruction that moves words from one area of ! memory to another. The number of words comes from the expression---------------------------------- ! ! Abstract: ! INDB is a two byte instruction that loads indirect with an index !  ! stack and must be in the range 1..32767. ! ! Instruction: ! MOVW ! ! Environment: ! (Tos) = N. !  in the range 0..255. ! ! Instruction: ! INDB Index ! ! Environment: ! (Tos) = Address as an offset fr + 1, Push, Field(1,3); ! round byte PC up to next word tmp := Shift + UPC, Fetch; ! fetch string leng (Tos-1) = SrcAddr = Source address as an offset from stack base. ! (Tos-2) = DstAddr = Destination address as an offsth Tos := tmp - CB; ! offset within code segment tmp1 := UState and 1; ! nuet from stack base. ! ! Result: ! Stack popped three times. ! Memory[DstAddr+0] = Memory[SrcAddr+0]. ! Member of noise bytes (0 or 1) JmpOffset := Mdi + 1, Field(0,10); ! add 1 for length byte JmpOffset := Shift +mory[DstAddr+1] = Memory[SrcAddr+1]. ! ... ! Memory[DstAddr+N-1] = Memory[SrcAddr+N-1]. ! ! Calls: ! S tmp1, Goto(AdjustPC); ! set PC after string $Title MOVB, MOVW - Word array moves. ! Opcode MOVB. !--------------etMovUp. ! !----------------------------------------------------------------------------- OpCode(MOVB), tmp := NextOp; Mov--------------------------------------------------------------- ! ! Abstract: ! MOVB is a two byte instruction that moveWords: src := Tos, Pop, if Eql Goto(MOV1); src := src - 1; !***** BR dst := Tos - 1, i  GoTo(Z80GtStat); ! Message 12 - Seek complete. Case(Z80Msg0,12), dskIntrLevel := 1; ! MAB  bumps ptr back to item ! the test checks for wrap around  Z80State:=0, GoTo(dskDoCmd); ! Message 13 - Status change. Case(Z80Msg0,13), Z80State := 12, GoTo(NiceRe ! just occuring Z80St2b: ioPhysAdr + ioWrPtr, Fetch; !no wrap around, get that last item nop; t); ! Message 14 - Voltage data. Case(Z80Msg0,14), ioDevTab + ioVltDTentry, Fetch2;!msg 14 - Voltage Data coming !Fetch/Store combo needs explicit nops nop; ioPhysAdr + ioWrPtr, Store; !Restore  Z80VIntr := Z80VltIntMsk, Call(ioTlate); Z80Buff := ioPhysAdr; SetState13: Zthe item MDO := MDI or OVRErr, Return;!with the overrun bit set Z80St2c: ioWrPtr := ioLen; !here if wr80State := 13, GoTo(NiceRet); ! Message 15 - Voltage status. Case(Z80Msg0,15), Z80Buff := Z80StateAdr, GoTo(Z80Gap around had occured ioWrPtr := ioWrPtr - 1, GoTo(Z80St2b); !set up WrPtr to end of buff ! State 3  Z80VIntr := Z80RsiIntMsk; Z80State := 3, GoTo(NiceRet); ! Message 3 - TabletStat); ! Message 16 - Clock status. Case(Z80Msg0,16), Z80Buff := Z80StateAdr, GoTo(Z80GtStat); ! Mest data. Case(Z80Msg0,3), Z80State := 5, GoTo(NiceRet); ! Message 4 - Clock data. Case(Z80Msg0,4), Z80Statsage 17 - GPIB status. ! ********** - Where did this code go? ! Message 20 - Floppy status. Case(Z80Msge := 11, GoTo(NiceRet); ! Message 5 - Floppy data. Case(Z80Msg0,5), Z80Buff := Z80FlpAdr; 1,0), Z80Buff := Z80StateAdr, GoTo(Z80GtStat); ! Message 21 - Floppy done. Case(Z80Msg1,1), Z80State := 16; Z80VIntr := Z80FlpIntMsk; Z80State := 15, GoTo(NiceRet); ! Message 6 - GPIB data. Case(Z80M Z80VIntr := Z80FlpIntMsk, Goto(NiceRet); ! State 2 - Keyboard character. Case(Z80St0,2), iosg0,6), Z80Buff := io488InCb; Z80VIntr := Z80488InIntMsk; Z80State := 20, GoTo(NiceReDevTab + Z80KbdIntMsk, Fetch; ioChar := Z80Chr; Z80State := 0; !this message is over t); ! Message 7 - RS232 status. Case(Z80Msg0,7), Z80Buff := Z80StateAdr; Z80GtStat: Z80VIntr := Z80Ge UserIntr := MDI or UserIntr; !Cause an interrupt Z80St2a: ioPhysAdr := Z80Buff, Call(cbSetUp); !Z80Buff has ptr to cb tIntMsk; Z80State := 17, GoTo(NiceRet); ! Message 10 - Tablet status. Case(Z80Msg0,10), Z8 Call(cbPut); !Put item away ioWrPtr := ioWrPtr - 1, If Neq GoTo(NiceRet); !return if it 0Buff := Z80StateAdr, GoTo(Z80GtStat); ! Message 11 - Keyboard status. Case(Z80Msg0,11), Z80Buff := Z80StateAdr,worked If Lss GoTo(Z80St2c); !otherwise we have overflow ! the - 1 ! Abstract: ! INDW is a two byte instruction that loads indirect with an index ! in the range 0..65535. ! ! Inst! of the stack by a constant amount in the range 0..65535. ! ! Instruction: ! INCW LowByteAmount HighByteAmounruction: ! INDW LowByteIndex HighByteIndex ! ! Environment: ! (Tos) = Address as an offset from stack base. t ! ! Environment: ! (Tos) = Value. ! ! Result: ! (Tos) = Value + Amount. ! !-------------------------------! ! Result: ! (Tos) = Memory[Address + Index]. ! !------------------------------------------------------------------------------------------------------------------ Opcode(INCB), tmp := NextOp; Increment: Tos := Tos + tmp, NextInst(0); O--------- Opcode(IND1), tmp := 1, Goto(IndexAndLoad); Opcode(IND2), tmp := 2, Goto(IndexAndLoad); Opcode(IND3), tmp := pcode(INCW), Call(WordParm); tmp := Shift + tmp, Goto(Increment); $Title IXAx, IXP - Index array. ! Opcode3, Goto(IndexAndLoad); Opcode(IND4), tmp := 4, Goto(IndexAndLoad); Opcode(IND5), tmp := 5, Goto(IndexAndLoad); Opcode(I IXA1, IXA2, IXA3, IXA4. !----------------------------------------------------------------------------- ! ! Abstract: ! ND6), tmp := 6, Goto(IndexAndLoad); Opcode(IND7), tmp := 7, Goto(IndexAndLoad); Opcode(INDB), tmp := NextOp + SB; Indexed The IXAx opcodes are single byte instructions that index into arrays ! with x words per element. ! ! Instruction: ! Load: Tos + tmp, Fetch; Tos := Mdi, NextInst(0); Opcode(INDW), Call(WordParm); tmp := Shift + tmp, if IntrP IXAx ! ! Environment: ! (Tos) = Index. ! (Tos-1) = Address of array. ! ! Result: ! Stack popped. end Call(VectSrv); IndexAndLoad: tmp := tmp + SB, Goto(IndexedLoad); $Title INCx - Increment. ! Opcode INCB. !--- ! (Tos) = Address + x * Index. ! ! Calls: ! Multiply, VectSrv. ! !---------------------------------------------------------------------------------------------------------------------- ! ! Abstract: ! INCB is a two byte instructi--------------------------------- ! Opcode IXAB. !--------------------------------------------------------------------------on 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. ! ! In INCB Amount ! ! Environment: ! (Tos) = Value. ! ! Result: ! (Tos) = Value + Amount. ! !---------------struction: ! IXAB Size ! ! Environment: ! (Tos) = Index. ! (Tos-1) = Address of array. ! ! Result: om stack base. ! ! Result: ! (Tos) = Memory[Address + Index]. ! !------------------------------------------------------------------------------------------------------------------ ! Opcode INCW. !---------------------------------------------------------------------- ! Opcode INDW. !----------------------------------------------------------------------------- ! -------------------------------- ! ! Abstract: ! INCW is a three byte instruction that increases the value on the top  hr; !Merge high byte with low byte UserIntr := MDI or UserIntr, GoTo(Z80St2a); !Put data in buf ! Sta Z80Chr, if Gtr GoTo(NiceRet);!low byte, done if byt cnt = 0 Z80Chr := 0; !No high byte if count was te 5 - Tablet low X. Case(Z80St0,5), Z80Tmp := Z80Chr, Goto(Z80BumpState); ! State 6 - Tablet high X. Case(odd Z80St14a: Z80Chr, LeftShift(10); !here on high byte Z80Tmp := Shift or Z80Tmp; !merge hi byte with low bZ80St0,6), Z80Chr, LeftShift(10); Z80Tmp := Shift or Z80Tmp; !Merge with low X ioTabAdr, Store; yte Z80Buff := Z80Buff + 1, Store; !Put word in memory Z80Tmp; !Merged data  !Store as first tablet word Z80Tmp, GoTo(Z80BumpState); ! State 7 - Tablet low Y. Case(Z80St0, Z80ByteCnt := Z80ByteCnt - 1;!Check Byte Count If gtr GoTo(NiceRet); !more bytes to go ioDevT7), Z80Tmp := Z80Chr, GoTo(Z80BumpState); ! State 10 - Tablet high Y. Case(Z80St0,10), Z80Chr, LeftShift(10); ab + Z80VIntr, Fetch; Z80State := 0; !all done UserIntr := MDI or UserIntr, GoTo(NiceRet);! Z80Tmp := Shift or Z80Tmp; !Merge with low Y ioTabAdr + 1, Store; !Tablet Y word, save data Cause done intr ! State 15 - Floppy data. Case(Z80St0,15), Z80FloppyDcb+14, Store; Z80Chr;  Z80Tmp, GoTo(Z80BumpState); ! State 11 - Clock ticks. Case(Z80St0,11), Z80State := 0, Goto(NiceRet);  Z80VIntr := Z80FlpIntMsk, Goto(SetState13); ! State 16 - Floppy done, concise status. Case(Z80St0,16), Z8! *** Moved time base maintenance to video. GGR 31 Mar 81 ! State 12 - Status change data. Case(Z80St0,12), Z0FloppyDcb+14, Store; Z80Chr; ioDevTab + Z80FlpIntMsk, Fetch; Z80State := 0; Use- RS232 byte count. Z80St3a: Case(Z80St0,3), Z80ByteCnt := Z80Chr, GoTo(Z80BumpState); ! State 4 - RS232 data80Status := Z80Chr; Z80Status := Z80Status or 340; !Set ok for SetStatus/GetStatus Z80State := 0, GoTo( byte. Case(Z80St0,4), Z80ByteCnt; Z80ByteCnt := Z80ByteCnt - 1, if Odd GoTo(Z80St4a); Z80StartScan); ! State 13 - Byte count. Z80St13a: Case(Z80St0,13), Z80ByteCnt := Z80Chr; Z80Byte  ! data is arriving for RS232 Z80Chr, LeftShift(10); !Data coming in, Z80Tmp := Shi:= Z80Byte and not 1, !Start on low byte if Neq GoTo(Z80BumpState); Z80Bft, GoTo(NiceRet);! Save as high byte Z80St4a: ioChar := Z80Tmp, If Neq GoTo(Z80St4c); !This is a low byte Z80SyteCnt := C400, GoTo(Z80BumpState); !zero byte count means 256 ! State 14 - Data byte. Case(Z80St0,14), Z80Bytate := 0; !Count just hit 0, all done Z80St4c: ioDevTab + Z80VIntr, Fetch; ioChar := ioChar or Z80Cte; Z80Byte := Z80Byte xor 1, if Odd GoTo(Z80St14a); Z80ByteCnt := Z80ByteCnt - 1; Z80Tmp := ----------------------- ! ! Abstract: ! IXP is a two byte instruction that indexes into packed arrays. ! The inpt=element offset * BPE tmp, LeftShift(4), Push; Tos := Shift or tmp3, NextInst(0); ! form field descriptor! Stack popped. ! (Tos) = Address + Size * Index. ! ! Calls: ! Multiply, VectSrv. ! !-------------------uts are ! 1) information about the size of an element represented as a byte ! where the upper 4 bits cont---------------------------------------------------------- ! Opcode IXAW. !-------------------------------------------------ain one less than the number of ! elements per word and the lower 4 bits contain one less than ! the n---------------------------- ! ! Abstract: ! IXAW is a three byte instruction that indexes arrays with 0..32767 ! umber of bits per element. ! 2) the index. ! 3) the address of the array. ! The output is a packed fi words per element. ! ! Instruction: ! IXAW LowByteSize HighByteSize ! ! Environment: ! (Tos) = Index. ! eld pointer--a word address and ! a field descriptor. ! ! Instruction: ! IXP SizeInformation ! ! Environme (Tos-1) = Address of array. ! ! Result: ! Stack popped. ! (Tos) = Address + Size * Index. ! ! Calls: ! nt: ! (Tos) = Index. ! (Tos-1) = Address of array. ! ! Result: ! (Tos) = Field descriptor. ! (Tos- Multiply, VectSrv. ! !----------------------------------------------------------------------------- Opcode(IXA1), tmp1) = Word address of element. ! ! Calls: ! Multiply, VectSrv. ! !---------------------------------------------------- := Tos and AllOnes, Pop, Goto(IXArray2); Opcode(IXA2), tmp := Tos and AllOnes, Pop, Goto(IXArray5); Opcode(IXA3), tmp := ------------------------- Opcode(IXP), tmp3 := NextOp; ! get size information tmp3, RightShift(4); Tos and AllOnes; tmp := tmp + tmp, if IntrPend Call(VectSrv); tmp := Tos + tmp, Pop, Goto(IXArray2); Opcode tmp1 := Shift + 1, ! elements per word = EPW if IntrPend Call(VectSrv); (IXA4), tmp := Tos and AllOnes, Pop, Goto(IXArray4); Opcode(IXAW), tmp := Tos, Pop, Goto(IXArray1); Opcode(IXAB), tmp := N tmp := Tos and AllOnes, Pop; Call(Divide); ! word offset = index div EPW extOp; IXArray1: tmp1 := Tos and AllOnes, Pop, Call(Multiply); !***** Multiply pops IXArray2: Goto(IXArray3);  ! element offset = index mod EPW Tos := Tos + tmp; ! add word offset t !***** burn a cycle after a pop IXArray3: Tos := Tos + tmp, NextInst(0); IXArray4: tmp := tmp + tmp, if IntrPend Call(Vo address tmp3 := tmp3 and 17; ! bits per element - 1 tmp := tmp3, if IntrPend Call(VectSrv); ectSrv); IXArray5: tmp := tmp + tmp, Goto(IXArray3); ! Opcode IXP. !------------------------------------------------------ tmp := tmp + 1, ! bits per element = BPE Call(Multiply); ! bit offse  ! State 21 - GPIB data. Case(Z80St1,1), Z80Tmp := 0; Z80ByteCnt := Z80ByteCnt - 1, GoTo(Z80St4a); , if geq goto(Z80StRs1); !But watch out for wrap around Z80OBytCnt := Z80OBytCnt + ioLen; !wrap around occurred, f $Title Perq to Z80 communications. ! Start Perq to Z80 communication. !-------------------------------------------------ix count Z80StRs1: Z80OBytCnt - 20; !Don't send more than 16. bytes Z80OtmpState := 11, if leq GoTo(Z80FirstByte)---------------------------- ! !----------------------------------------------------------------------------- Z80StartScan:; Z80OBytCnt := 20, GoTo(Z80FirstByte); ! Message 2 - Start floppy. Z80StartFloppy: Z80Otmp := 2; !Co Z80OState; !Here to start a scan, check to see if we are busy If Neq Return;!something already in progress Z80Scammand Code 2 Z80WantOutput := Z80WantOutput and not Z80DoFloppy; Z80Status := Z80Status and not Z80DoFlon: Z80OTmp := Z80WantOutput; Z80Otmp := Z80Otmp and Z80Status; !Clear out any wants that cant be Z80Otppy; Z80OVIntr := Z80NulIntMsk; Z80OtmpState := 4, GoTo(Z80FirstByte); ! Message 3 - Start GPmp and Z80DoSeek; Z80Otmp and Z80DoSpeech, if neq GoTo(Z80StartSeek); Z80Otmp and Z80DoFloppy, if neq IB output. Z80StartGpib: Z80Otmp := 3; Z80OBytCnt := Z80488Cnt; Z80OVintr := Z80488OutIntMsk; GoTo(Z80StartSpeech); Z80Otmp and Z80DoGpib, if neq GoTo(Z80StartFloppy); Z80Otmp and Z80DoRS232, i Z80OAdr := Z80488Adr; Z80OAdr := Z80OAdr - 1; ! incremented before first fetch Z80WantOutputf neq GoTo(Z80StartGpib); Z80Otmp and Z80DoSetState,if neq GoTo(Z80StartRS232); Z80Otmp and Z80DoGetStat := Z80WantOutput and not Z80DoGpib; Z80Status := Z80Status and not Z80DoGpib; Z80OtmpState := 13, GoTo(e,if neq GoTo(Z80SSetState); if neq GoTo(Z80SGetState); GoTo(NiceRet); Z80FZ80FirstByte); ! Message 4 - Start speech. Z80StartSpeech: Z80Otmp := 4; !Command Code 4 Z80spchCnt :irstByte: C400 or 153, IOB(Z80DataIOB); !Send Flag Byte Z80OState := 1, GoTo(NiceRet); ! Message 1 - Sta= Z80spchCnt - 40; !send only 40 bytes at a time Z80OBytCnt := 40, if eql goto(Z80SSpc2); !even tho buffer is bigrt RS232 output. Z80StartRS232: ioPhysAdr := ioRsOutCb, Call(cbSetUp);!Get read and write pointer Z80WantOutput :ger Z80OVintr := Z80NulIntMsk; !no interrupt on completion Z80Restart := Z80Restart or Z80DoSpeecrIntr := MDI or UserIntr, Goto(NiceRet); ! State 17 - GetStatus byte count. Case(Z80St0,17), Z80State := 13; = Z80WantOutput and not Z80DoRS232; Z80Status := Z80Status and not Z80DoRS232; Z80OBytCnt := ioWrPtr;  Z80Buff, Store, Goto(Z80St13a); ! State 20 - GPIB byte count. Case(Z80St1,0), Goto(Z80St3a); !Compute how many chars are in buffer Z80OBytCnt := Z80OBytCnt - ioRdPtr; !as WrPtr - RdPtr Z80Otmp := 1 eld ! Opcode STPF. !----------------------------------------------------------------------------- ! ! Abstract: ! $Title ROTSHI, QAND, QOR, QNOT - Logical operators. ! Opcode ROTSHI. !-----------------------------------------------------STPF is a one byte instruction that stores a packed field. Its ! input is the same as the output of an IXP instruction-------------------------- ! ! Abstract: ! ROTSHI is a two byte instruction that performs a shift or rotate on ! aa packed ! field pointer which consists of a word address and a field descriptor. ! ! Instruction: ! STPF ! !  word in the expression stack. The function (shift or rotate) is ! selected by an operand byte. 0 means shift and non-zEnvironment: ! (Tos) = Value. ! (Tos-1) = FieldDescriptor. ! (Tos-2) = Address as an offset from stack baseero means ! rotate. ! ! A positive shift count means shift left, and a negative shift count ! means shift  $Title LDP, STPF - Load and store packed field. ! Opcode LDP. !--------------------------------------------------. ! ! Result: ! Stack popped three times. ! Memory[Address].Field(FieldDescriptor) = Value. ! ! Calls: ! --------------------------- ! ! Abstract: ! LDP is a one byte instruction that loads a packed field. Its ! inpu VectSrv. ! !----------------------------------------------------------------------------- Opcode(STPF), tmp := Tos, Pop; t is the same as the output of an IXP instruction--a packed ! field pointer which consists of a word address and a field  ! value to be stored tmp1 := Tos, ShiftOnR; ! set up shifter with field desc. Alldescriptor. ! ! Instruction: ! LDP ! ! Environment: ! (Tos) = FieldDescriptor. ! (Tos-1) = Address as aOnes, Pop; tmp2 := Shift; ! right mask as wide as field tmp := tmp and tmp2, if IntrPendn offset from stack base. ! ! Result: ! Stack popped. ! (Tos) = Memory[Address].Field(FieldDescriptor). ! ! Ca Call(VectSrv); ! mask off value tmp3 := Tos + SB, Fetch; ! fetch destination tmp1 := tmp1 or 17,lls: ! VectSrv. ! !----------------------------------------------------------------------------- Opcode(LDP), tmp := ShiftOnR; ! LeftShift(FirstBit) tmp2, Pop; tmp2 := Shift; ! position mask to mak Tos, Pop; ! field descriptor tmp1 := Tos, if IntrPend Call(VectSrv); ! word address tmp1 + SBe hole tmp1 := Mdi and not tmp2; ! form hole tmp; tmp := Shift, if IntrPend Call(VectSrv);, Fetch; ! fetch the word tmp, ShiftOnR; ! set up shifter with field desc.  ! position value tmp3, Store; tmp1 or tmp, NextInst(0); ! combine and store  Mdi; ! push Mdi at the shifter Tos := Shift, NextInst(0); ! read the fi ------------------------------------------------------- ! !-------------------------------------------------------------------t3b: Z80OBytCnt := Z80OBytCnt - 1; !Here on high byte If neq goto(Z80OSt3d); !Check for enh; !keep sending chunks Z80SSpc1: Z80OAdr := Z80SpchAdr; !Address to doit tuit Z80SpchAdr := Z80SpchAdr + 20; !K---------- Z80OIntSrv: Z80OState, Field(0,4),loc(Z80OInt); Dispatch(Z80OSt); !Go to current state ! Generaeep addr right for next time Z80WantOutput := Z80WantOutput and not Z80DoSpeech; Z80Status := Z80Status l Purpose - On to next sequential state and return Z80OBumpState: Z80OState := Z80OState + 1, GoTo(NiceRet); ! Stateand not Z80DoSpeech; Z80OtmpState := 2, GoTo(Z80FirstByte); Z80SSpc2: Z80OVintr := Z80SpkIntMsk, Goto(Z80SSpc1);  1 - Send Message Type. Case(Z80OSt,1), Z80Otmp or C400, IOB(Z80DataIOB); !Send Message Type Z80OState := Z80Otmp ! last transfer, ! interrupt when done ! Message 5, 6, 7, 1State, GoTo(NiceRet); !What state is next ! State 2 - Send Byte Count. Case(Z80OSt,2), Z80OBytCnt or C400, I1, 12, 14 - Start SetStatus. Z80SSetState: Z80Otmp := Z80StateType; !Command code 5,6,7,11,12,14 SetState Z80OB(Z80DataIOB); !Send Byte Count Z80Byte := Z80Byte and not 200, Goto(Z80OBumpState); OAdr := Z80StateAdr, Fetch; !Get Byte count from 1st word in buff Z80WantOutput := Z80WantOutput and not Z80DoSetSta !Start with low byte ! State 3 - Data Byte Going out. Case(Z80OSt,3), Z80Byte; Z8te; Z80OVintr := Z80SetIntMsk; Z80OtmpState := 2; Z80OBytCnt := MDI, GoTo(Z80FirstByte); !0Byte := Z80Byte xor 200, if ByteSign GoTo(Z80OSt3b); Z80OAdr := Z80OAdr + 1, Fetch; !Get a data word - do lhere is byte count ! Message 10 - Start seek. Z80StartSeek: Z80Otmp := 10; !Start Seek, Send code ow byte Z80OBytCnt := Z80OBytCnt - 1, LeftShift(10);!Check byte Count 10 Z80WantOutput := Z80WantOutput and not Z80DoSeek; Z80OData := dskSeek; Z80OtmpState := 10 !expiration & preset shifter Z80OData := MDI, if eql goto(Z80OSt3e);!Save Data, drop out if done Z8, Goto(Z80FirstByte); ! Message 13 - Start GetStatus. Z80SGetState: Z80Otmp := 13; !Command code 13 GetStat0OData or C400, IOB(Z80DataIOB); !Send out low byte Goto(NiceRet); ! must allow time tus Z80WantOutput := Z80WantOutput and not Z80DoGetState; Z80OData := Z80StateType; Z80OAdr :o drop ! interrupts, so don't get = Z80StateAdr; Z80OtmpState := 10, GoTo(Z80FirstByte); ! Perq to Z80 interrupt service. !---------------------- ! the "IOB" too close to "if ! IntrPend" ! More for State 3 Z80OS  tmp1 := Shift + 215; ! 8..15,13 tmp - 10; if Lss Goto(RotSh3); ! if count < 8rds in the expression stack. ! ! Instruction: ! QOR ! ! Environment: ! (Tos) = Word0. ! (Tos-1) = Word1, 8..15,13 tmp1 := tmp1 + 201, Goto(RotSh3); ! if count >= 8, 8..15,14 ! Shift. RotSh1: tmp1 := . ! ! Result: ! Stack popped. ! (Tos) = Word0 or Word1. ! !---------------------------------------------------17, if Geq Goto(RotSh2); tmp1 := tmp1 + tmp; ! shift right, we need 15 - n. tmp := not tmp; -------------------------- Opcode(QOR), tmp := Tos, Pop; Tos := Tos or tmp, NextInst(0); ! Opcode QNOT. !------ ! n is negative so 15 - (-n)=15+n tmp := tmp + 1; RotSh2: tmp, LeftShift(4); tmp1 := Shif----------------------------------------------------------------------- ! ! Abstract: ! QNOT is a one byte instruction t + tmp1, Goto(RotSh3); ! 0..15,15 for shift left ! 0..15,15..0 for shift right that complements the low order bit ! of a word in the expression stack. ! ! Instruction: ! QNOT ! ! Environmen ! Do the shift or rotate. RotSh3: tmp1, ShiftOnR; ! set up the shifter Tos; t: ! (Tos) = Word. ! ! Result: ! (Tos) = not Word. ! !-------------------------------------------------------- ! data to be shifted Tos := Shift, NextInst(0); ! put the result on the stack ! Opco--------------------- Opcode(QNOT), Tos := Tos xor 1, NextInst(0); $Title xxxBool - Boolean comparisons. ! Opcodright. The shift count must be in the range -15..15. ! ! A positive rotate count means rotate right, and a negative rotde QAND. !----------------------------------------------------------------------------- ! ! Abstract: ! QAND is a one ate ! count means rotate right. The rotate count may be in the range ! -32768..32767. ! ! Instruction: ! byte instruction that computes a fullword bitwise AND ! of two words in the expression stack. ! ! Instruction: !  ROTSHI Function ! ! Environment: ! (Tos) = Shift or rotate count. ! (Tos-1) = Word to shift or rotate. ! ! R QAND ! ! Environment: ! (Tos) = Word0. ! (Tos-1) = Word1. ! ! Result: ! Stack popped. ! (Tos) =esult: ! Stack popped. ! (Tos) = Shifted or rotated word. ! !--------------------------------------------------- Word0 and Word1. ! !----------------------------------------------------------------------------- Opcode(QAND), tmp := Tos-------------------------- Opcode(ROTSHI), tmp := NextOp; ! function tmp := Tos, Pop, if Eql Goto(RotS, Pop; Tos := Tos and tmp, NextInst(0); ! Opcode QOR. !-----------------------------------------------------------h1); ! 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 two wo IOB); Z80OState := Z80OState + 1, GoTo(NiceRet); ! State 7 - Floppy command. Case(Z80OSt,7), Z80OData, Z80WantOutput and Z80Status; If Neq GoTo(Z80Scan); !If more messages are pending 0, IO RightShift(10); Shift or C400, IOB(Z80DataIOB); Z80OState := 2; !Byte count is nB(Z80DataIOB); !Turn off interrupts GoTo(NiceRet); $Title Memory Parity error. ! Memext Z80FloppyDcb + 4, Fetch; !Get Buffer size Z80OAdr := Z80FlpAdr; !The ory parity error interrupt service. !----------------------------------------------------------------------------- ! ! Physical Addr of buffer Z80OBytCnt := MDI and 777; !buffer size if Neq GoTo(NiceRet); We simply generate a run-time error. ! !----------------------------------------------------------------------------- Pard of msg Z80OSt3c: Z80WantOutput := Z80WantOutput or Z80Restart; !Last byte is gone ioDevTab + Z80OVintr, Fetch; Z80OBytCnt := 1, GoTo(NiceRet); !change buffer size zero to 1 ! State 10 - Seek count. Case(Z80OSt,10 !Request Done Interrupt Z80Restart := 0; !No more restarts Z80OState :=), Z80OData or C400, IOB(Z80DataIOB); Z80OState := 0, GoTo(NiceRet); ! State 11 - RS232 byte count. Ca 0; !No more bytes UserIntr := MDI or UserIntr; !Request Interrupt here Z80OSt3dse(Z80OSt,11), Z80OBytCnt or C400, IOB(Z80DataIOB); Z80OState := 12, GoTo(NiceRet); ! State 12 - RS232 da: Z80OData, RightShift(10); !Send the high byte Shift or C400, IOB(Z80DataIOB); GoTo(NiceRta byte. Case(Z80OSt,12), ioPhysAdr := ioRsOutCb, Call(cbSetUp); ioChar := 0, Call(cbGet); !Get the et); Z80OSt3e: Z80OData := Shift, GoTo(Z80OSt3c); !No more bytes on an odd boundary ! State 4 - Floppy head, unit.byte from CirBuf ioChar or C400, IOB(Z80DataIOB); !Data out Z80OBytCnt := Z80OBytCnt - 1;  Case(Z80OSt,4), Z80FloppyDcb + 2, Fetch; Z80OData := MDI; Z80OData or C400, IOB(Z80DataIOB);  !Count Them Bytes ioRdPtr - ioWrPtr,If neq GoTo(NiceRet);!More to go Z80OState := 0, if eql GoTo(NiceRe Z80OState := Z80OState + 1, GoTo(NiceRet); ! State 5 - Floppy cylinder. Case(Z80OSt,5), Z80OData, RightShift(t); !it is, begone Z80WantOutput := Z80WantOutput or Z80DoRS232, return; !More came in 10); Shift or C400, IOB(Z80DataIOB); Z80OState := Z80OState + 1, GoTo(NiceRet); ! State 6 - F !while we were outputting ! State 13 - GPIB command. Case(Z80OSt,13), Z80488Cmd or C400, IOB(Z80DataIOB); loppy sector. Case(Z80OSt,6), Z80FloppyDcb + 3, Fetch; Z80OData := MDI; Z80OData or C400, IOB(Z80Data Z80OState := 2, GoTo(NiceRet); ! State 0 - End of message, turn off Z80 output interrupts. Case(Z80OSt,0),  Ord(False) = 0. ! Ord(True) = 1. ! False < True. ! ! Instruction: ! xxxBool ! ! Environment:vironment: ! (Tos) = Word. ! ! Result: ! (Tos) = - Word. ! ! Calls: ! Nxt. *** BAD: jumps into anot ! (Tos) = Word0. ! (Tos-1) = Word1. ! ! Result: ! Stack popped. ! (Tos) = Word0 xxx Word1. ! ! her Q-code *** ! !----------------------------------------------------------------------------- Opcode(ABI), tmp := Tos; Design: ! These opcodes should be removed at a later time since the integer ! comparisons will do the right thing  if Geq Goto(Nxt); ! if already positive NegateInteger: Tos := Zero - tmp, NextInst(0); Opcode(NGI)for single bit inputs. ! ! Calls: ! Integer comparisons. ! !---------------------------------------------------------, tmp := Tos, Goto(NegateInteger); ! Opcode ADI, SBI, MPI, DVI. !---------------------------------------------------------------------------- Opcode(EQUBool), Goto(EQUInt); Opcode(NEQBool), tmp := Tos, Pop; ! this one's also used f--------------------- ! ! Abstract: ! ADI, SBI, MPI, DVI are one byte instructions that perform addition, ! subtor Tos := Tos xor tmp, NextInst(0); ! fullword XOR Opcode(LEQBool), Goto(LEQInt); Opcode(LESBool), Goto(LESIraction, multiplication, and division respectively on two ! integer values in the expression stack. ! ! Instruction: !nt); Opcode(GEQBool), Goto(GEQInt); Opcode(GTRBool), Goto(GTRInt); $Title - xxI, MODI, CHK - Integer arithmetic.  xxI ! ! Environment: ! (Tos) = Word0. ! (Tos-1) = Word1. ! ! Result: ! Stack popped. ! (T ! Opcode ABI. !----------------------------------------------------------------------------- ! ! Abstract: ! ABI ios) = Word0 function Word1. ! ! Calls: ! Multiply, Divide. ! !-------------------------------------------------------s a one byte instruction that computes the absolute value of ! an integer in the expression stack. ! ! Instruction: ! ---------------------- Opcode(ADI), tmp := Tos, Pop; Nop; !***** MAB Tos := ABI ! ! Environment: ! (Tos) = Word. ! ! Result: ! (Tos) = Absolute value of Word. ! ! Calls: !  Tos + tmp, NextInst(0); Opcode(SBI), tmp := Tos, Pop; Nop; !***** MAB Tos e EQUBool, NEQBool, LEQBool, LESBool, GEQBool, GTRBool. !---------------------------------------------------------------------- Nxt. *** BAD: jumps into another Q-code *** ! !--------------------------------------------------------------------------------- ! ! Abstract: ! The xxxBool opcodes are one byte instructions that compare two boolean ! values in the e--- ! Opcode NGI. !----------------------------------------------------------------------------- ! ! Abstract: ! xpression 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 ! ! En for every command 6 June 80 JPS GetNxtCm: dpyCntlBlk+6,Fetch; ioTmp := dpyTmp; MDI, IOB(344); S ! dpyCntlBlk+6,Fetch; ioTmp := ioTmp + ioTmp; ioTmp + ioTmp, IOB(341); !Load address of !Load cursor X Value dpyCm := dpyCm + 1, Fetch; !Get the next Video Command word dpyCBase, Screen Bit Map ! MDI, IOB(344); !Load cursor X Value dpyCBase := dpyCBase + dpyCBase, GoTo IOB(342); !Load Cursor Addr if cursor time ioTmp AND 1200; !Test for Vertical load stuff bi(GetNxtCm); ! *** Moved time base maintenance to video. GGR 31 Mar 81 Retrace: ioDevTab + ClkIntMsk, Fetch; Ut dpyTmp := MDI, IF Eql Return; !This will be the next command ioTmp and 200; if Eql goto(ReserIntr := MDI or UserIntr; !give him an interrupt ioTabAdr + 2, Store2; !store it in device table trace); !if beginning of vertical retrace VBlank: dpyTmp := 0; !simulate normal command  ClkTim1 := ClkTim1 + 1; !Double Precision add ClkTim2 := ClkTim2 + 0 + OldCarry; !To get new clock dat !because dpyTmp contains garbage dpyCntlBlk, Fetch2, Call(ioTLate); !Fetch the Videa return; !***this can't happen during T1 !***follo control block dpyCntlBlk+2, Fetch2; dpyCm := ioPhysAdr; !This is addr of first command word owing Store2 $Title Undefined interrupts. ! Undefined interrupt service. !----------------------------------------Intr: IOB(147), Loc(ParInt); tmp3 := 0; tmp2 := ErrMParity, Goto(RunError); $Title Video.  dpyCm := dpyCm - 1; !Offset cause GetNxt increments !**** Note **** Screen Bit Map Address a ! Video interrupt service. !----------------------------------------------------------------------------- ! ! Design: ! nd Cursor Bit Map ! address are kept as 20 bit Physical Addresses ! ri To avoid wrecking raster-op, this interrupt service routine must ! not use the shifter, and must not check for further ightshifted by 4 in a 16 bit word. We leftshift ! them by three bits because the hardware does the nterrupts. ! !----------------------------------------------------------------------------- Visloop: dpyTmp, IOB(343), Lo ! fourth. ioTmp := MDI; !Load Mem addr of screen bit map dpc(VidInt); !Video Interrupt Service, Load VidState Z80State; dpyTmp, IOB(340), if Lss Return; !Load LiyCBase := MDI; !Pick up Mem addr of cursor bit map dpyCBase := dpyCBase + dpyCBase; dpyCBasneCount ! Z80State < 0 before DevTab setup ! *** load cursor X every e := dpyCBase + dpyCBase; ioTmp := ioTmp + ioTmp; ! *** load cursor X every for every command 6 June 80 JP := Tos - tmp, NextInst(0); Opcode(MPI), tmp1 := Tos and AllOnes, Pop; tmp := Tos and AllOnes, Call(Multiply);  ! get Maximum tmp2 := Tos; ! get Value !***** BR tmp2 - tmp1;  Tos := tmp, NextInst(0); Opcode(DVI), tmp1 := Tos and AllOnes, Pop; tmp := Tos and AllOnes, Call(Divide);  !***** BR tmp2 - tmp, if Lss Goto(ChkOvr); ! if Value < Minimum !***** BR if Gtr Goto(ChkOvr);  Tos := tmp, NextInst(0); ! Opcode MODI. !----------------------------------------------------------------------------- ! ! if Value > Maximum NextInst(0); ! if in range $Title xxxI - Integer compa ! Abstract: ! MODI is a one byte instruction that computes the modulus (remainder ! after integer division) of trisons. ! Opcode EQUI, NEQI, LEQI, LESI, GEQI, GTRI. !---------------------------------------------------------------------wo 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 the exp(Tos-1) = Word1. ! ! Result: ! Stack popped. ! (Tos) = Word0 mod Word1. ! ! Calls: ! Divide. ! !-----ression stack for equality and/or order. ! ! Instruction: ! xxxI ! ! Environment: ! (Tos) = Word0. ! (T------------------------------------------------------------------------ Opcode(MODI), tmp1 := Tos, Pop; tmp := Tos,os-1) = Word1. ! ! Result: ! Stack popped. ! (Tos) = Word0 xxx Word1. ! ! Calls: ! SetFalse, SetTrue.  Call(Divide); Tos := tmp1, NextInst(0); ! Opcode CHK. !----------------------------------------------------------! !----------------------------------------------------------------------------- EQUInt: Opcode(EQUI), tmp := Tos, Pop; ------------------- ! ! Abstract: ! CHK is a one byte instruction that checks an integer value to be sure ! that tmp1 := Tos; !***** BR tmp1 := tmp1 xor tmp; !***** BR MAB if Eql it is in a certain range. If the value is out of range, an ! ErrInxCase error is caused. ! ! Instruction: ! CH Goto(SetTrue); ! if equal Tos := 0, NextInst(0); ! set false NEQInt: Opcode(NEQI), tmK ! ! Environment: ! (Tos) = Minimum. ! (Tos-1) = Maximum. ! (Tos-2) = Value ! ! Result: ! Stackp := Tos, Pop; tmp1 := Tos; !***** BR tmp1 := tmp1 xor tmp; !***** BR M popped twice. ! (Tos) = Value. ! ! Calls: ! ChkOvr. ! !------------------------------------------------------AB if Neq Goto(SetTrue); ! if not equal Tos := 0, NextInst(0); ! set false LEQ----------------------- Opcode(CHK), tmp := Tos, Pop; ! get Minimum tmp1 := Tos, Pop; Int: Opcode(LEQI), tmp := Tos, Pop; tmp1 := Tos; !***** BR tmp1 := tmp1 - tmp;  ----------------------------------------------------------- ! !---------------------------------------------------------------nCb := ioPhysAdr, nextinst(0); $Title Miscellaneous routines. ! Routine ioTLate - Translate virtual address to phys-------------- {Ether3MBaud not supported. $Include IOE3.Micro Ether3MBaud not supported.} Goto(BadIntr), Loc(E3ical address. !----------------------------------------------------------------------------- ! !-----------------------------Int); $Title Initialization. ! Device table set-up StartIO. !----------------------------------------------------------------------------------------------------- ! Routine ioTLateA - Translate virtual address to physical address. !------------------------------ ! !----------------------------------------------------------------------------- devTabSetUp: tmp ----------------------------------------------------------------------- ! !---------------------------------------------------and 20, Case(StartIO,0); !Do we wish to set up stack stuff? if eql goto (DoDevTabSet); !if not set stack subfunct-------------------------- ! Routine ioTLateB - Translate virtual address to physical address. !----------------------------ion Call(SetQState); NextInst(0); DoDevTabSet: ClkTim1 := 0; ClkTim2 := 0; Z8------------------------------------------------- ! !-------------------------------------------------------------------------0State := 0; Z80Restart := 0, IOB(301); !Let Z80 Go Z80SpchCnt := 0, Call(ioTLateB); ---- !Routine to translate a virtual address to a physical address ioTLate: ioOffset := MDI; !entry point if a fetch of theioDevTab := ioPhysAdr; ioDevTab, Fetch2, Call(ioTLate); IntPtr := ioPhysAdr; ioDevTab + ioDp va was made ioSeg := MDI, GoTo(ioTLateA); ioTLateB: ioOffset := TOS, Pop; !entry point if va is on ESTK ioyDTentry, Fetch2, Call(ioTLate); dpyCntlBlk := ioPhysAdr, Call(VBlank); !set up video registers ioSeg := TOS, Pop; ioTLateA:MA := ioSeg + ioSeg, Fetch2; !entry pnt if ioSeg & ioOffset are loaded ioPhysAdr := MDI anDevTab + ioTabDTentry, Fetch2, Call(ioTLate); dpyTmp := 101351; ioTabAdr := ioPhysAdr, Call(VisLoop); d not 376; ioPhysAdr := MDX or ioPhysAdr, if Odd goto(ioNotResident); ioPhysAdr := ioPhysAdr + ioOffset, ret------------------------------------- ! ! We simply generate a run-time error ! !------------------------------------- !start screen ioDevTab + ioKbdDTentry, Fetch2, Call(ioTLate); ioKbdCb := ioPhysAdr; ioD---------------------------------------- BadIntr1: nop, loc(BadInt1); BadIntr: NetIntr: tmp3 := 0, loc(NetInt); evTab + ioRsiDTentry, Fetch2, Call(ioTLate); ioRsInCb := ioPhysAdr; ioDevTab + ioRsoDTentry, Fetch2, Cal tmp2 := ErrUndfInt, Goto(RunError); $Title 3MHz Ethernet support. ! 3MHz Ethernet support. !------------------l(ioTLate); ioRsOutCb := ioPhysAdr; ioDevTab + io488InDTentry, Fetch2, Call(ioTLate); io488I at ! (integer to real), truncate (real to integer), round, absolute ! value, negation, addition, subtraction, mult Tos xor tmp1, if Neq Goto(SetFalse); Tos := 1, if Neq Goto(SetFalse); NextInst(0); Opcode(NEQReal), iplication, and ! division respectively for real numbers in the expression stack. ! Real numbers are as yet unimpltmp := Tos, Pop, Call(RealCmp); Tos xor tmp1, if Neq Goto(SetTrue); Tos := 0, if Neq Goto(SetTrue); Nemented and so these instructions ! cause ErrUndfQcd errors. ! !-------------------------------------------------------extInst(0); Opcode(LEQReal), Goto(UOP); !CALL(SubtractReal); !IF LEQ Goto(CndYes), Pop; !Tos := 0, !***** BR MAB if Leq Goto(SetTrue); ! if less than or equal Tos := 0, NextInst(0); ---------------------- Opcode(FLT), Goto(UOP); Opcode(TNC), Goto(UOP); Opcode(RND), Goto(UOP); Opcode(ABR), Goto(U ! set false LESInt: Opcode(LESI), tmp := Tos, Pop; tmp1 := Tos; !***** BR OP); !Tos := Tos and not 100000; !NextInst(0); Opcode(NGR), Goto(UOP); !Tos := Tos xor XXXX;  tmp1 := tmp1 - tmp; !***** BR MAB if Lss Goto(SetTrue); ! if less than To !NextInst(0); Opcode(ADR), Goto(UOP); Opcode(SBR), Goto(UOP); !Call(SubtractReal); !NextInst(0); s := 0, NextInst(0); ! set false GEQInt: Opcode(GEQI), tmp := Tos, Pop; tmp1 := Tos; Opcode(MPR), Goto(UOP); Opcode(DVR), Goto(UOP); $Title xxxReal - Real comparisons. ! Opcode EQUReal, NEQReal, LE !***** BR tmp1 := tmp1 - tmp; !***** BR MAB if Geq Goto(SetTrue); ! ifQReal, LESReal, GEQReal, GTRealReal. !----------------------------------------------------------------------------- ! ! Abstr greater than or equal Tos := 0, NextInst(0); ! set false GTRInt: Opcode(GTRI), tmp := Tos, Pop; act: ! The xxxReal opcodes are one byte instructions that compare two real ! values in the expression stack for eq tmp1 := Tos; !***** BR tmp1 := tmp1 - tmp; !***** BR MAB if Gtr uality and/or order. Currently ! only EQLReal and NEQReal are implemented. The others cause an ! ErrUndfQcd erroGoto(SetTrue); ! if greater than Tos := 0, NextInst(0); ! set false $Title FLT, Tr. ! ! Instruction: ! xxxReal ! ! Environment: ! (Tos), (Tos-1) = Real0. ! (Tos-2), (Tos-3) = Real1. !NC, RND, xxR - Real arithmetic. ! Opcode FLT, TNC, RND, ABR, NGR, ADR, SBR, MPR, DVR. !------------------------------------ ! Result: ! Stack popped. ! (Tos) = Real0 xxx Real1. ! ! Calls: ! RealCmp, SetFalse, SetTrue. ! !--------------------------------------------- ! ! Abstract: ! FLT, TNC, RND, ABR, NGR, ADR, SBR, MPR, and DVR implement flo------------------------------------------------------------------------- Opcode(EQUReal), tmp := Tos, Pop, Call(RealCmp);  urn; ! Routine ioXLate - Translate virtual address to physical address. !----------------------------------------------------------------------------- ioBadBerries: TOS := 0, NextInst(0); !Here if StartIO should fail end; --------------------------- ! ! Routine to translate a virtual address to a physical address and leave upper ! bits of pa in a register ! !----------------------------------------------------------------------------- ioXLate: ioOffset := MDI; !entry point if a fetch of va was just made ioSeg := MDI; ioXLateA:MA := ioSeg + ioSeg, Fetch2; !entry pt if ioSeg & ioO! IO Definitions. !----------------------------------------------------------------------------- ! ! IO.Dfs - QCode Intffset are loaded ioPhysAdr := MDI and not 376; ioPhAdrHi := MDI, if Odd GoTo(ioNotResident); erpreter definitions. ! Brian Rosen ca. 1 Jan 80. ! J. P. Strait rewritten 3 Dec 80. !  !save upper bits in a register ioPhysAdr := ioPhysAdr + ioOffset; !form actual data with a d Copyright (C) Three Rivers Computer Corporation, 1980. ! ! Abstract: ! This file provides the register and constant deouble ioPhAdrHi := ioPhAdrHi + 0 + OldCarry, return; !precision add ioNotResident: tmp3 := 0; tmp2 := Erfinitions provided ! by the IO microcode for other microprograms. ! !--------------------------------------------------rIOSFlt, Goto(RunError); ! Routine NiceRet. !----------------------------------------------------------------------------- --------------------------- ! 16 Apr 81 1.2 George Robertson ! Added 3MHz Ethernet interrupt !  ! ! General Purpose Exit (checks for other interrupts) ! !------------------------------------------------------------------ Moved IO to 4400-5777. ! ! 10 Apr 81 1.1 George Robertson ! Moved IO to 4000-5777. ! ! 3 Dec 80 ----------- NiceRet: if IntrPend GoTo(Vecint); !Allow more interrupts Return; ! Routine VecInt1.0 John Strait ! Start file. ! Entry points into this piece of microcode. Constant(StartIO,4400. !----------------------------------------------------------------------------- ! !-----------------------------------------); ! entry point to start an IO operation Constant(IntVec,5000); ! interrupt vector address Constant(Z80IInt,5000); ! Z80 i------------------------------------ VecInt: Vector(IntVec); ! Routine ioBadBerries. !-------------------------------nput interrupt Constant(BadInt1,5004); ! undefined interrupt Constant(DiskInt,5010); ! hard disk interrupt Constant(NetInt,50---------------------------------------------- ! ! Signal bad StartIO. ! !--------------------------------------------------14); ! network interrupt Constant(Z80OInt,5020); ! Z80 output interrupt Constant(VidInt,5024); ! video interrupt Constant(E  ! S: set of Low..High ! ! is represented in the same way as ! ! A: packed array[0..High] of Boohe set that is ! lower in the memory stack must have a length that is greater than ! or equal to the length of thelean ! ! where ! ! x in S <==> A[x]. ! ! That is, bit B of word W is set when W*16 + B  other set. If the lower set has a ! smaller length, it is adjusted to be the same length as the longer ! set. !is a member of the set. ! Thus the position of a certain element does not depend on the declared ! low bound of th !----------------------------------------------------------------------------- ! Opcode ADJ. !---------------------------e set type. Sets are implemented as though all sets ! have a low bound of 0. The number of words in such a set is exact-------------------------------------------------- ! ! Abstract: ! ADJ is a two byte instruction that adjusts a set prily ! High div 16 + 1. No length information is stored when a set is in ! memory. The length is compiled into theor to storing ! it. ! ! Instruction: ! ADJ DesiredLength ! ! Environment: ! (Tos) = Actual length.  code. ! ! On the stack (expression and memory stacks together), a set is ! represented by a length on the expres ! ! Result: ! Stack popped. ! Set on the memory stack adjusted to have the desired length. ! ! Calls: !  NextInst(0); Opcode(LESReal), Goto(UOP); !CALL(SubtractReal); !IF LSS Goto(CndYes), Pop; !Tos := sion stack, and a bit string ! on the memory stack. The length is in words. The bit string is ! in reverse order0, NextInst(0); Opcode(GEQReal), Goto(UOP), Opcode(061); !CALL(SubtractReal); !IF GEQ Goto(CndYes), Pop;  as though it were loaded via a LDMW instruction. ! Thus bit B of word Memory[TP-W] is set when W*16 + B is a member !  !Tos := 0, NextInst(0); Opcode(GTRReal), Goto(UOP), Opcode(062); !CALL(SubtractReal); !IF GTR Goto(C of the set. ! ! A set is loaded onto the stack by loading its declared length (in ! words) onto the expressindYes), Pop; !Tos := 0, NextInst(0); $Title ADJ, SGS, SRS, INN, UNI, QINT, DIF - Set arithmetic. ! Data ston stack, and loading its bit string onto ! the memory stack with LDMW. ! ! A set is stored into memory by adjustructure SET. !----------------------------------------------------------------------------- ! ! Abstract: ! Sets are ring its length on the memory ! stack until it is the same as the declared length. This is done ! adding zero wordepresented in two ways--the first is used when a set is ! in memory (in a variable). The second is used when a set is los or deleting words from its high end (farthest ! from the top of the memory stack). The length word is popped from ! aded ! onto the expression and memory stack. ! ! In memory, a set is stored as a collection of bits. The set !  the expression stack, and an STMW is used to store the set. ! ! When a two operand set instruction is to be done, t  and receive routine for use with the Perq ! parallel communications hardware. The routines send and receive ! 16ss, false otherwise. ! Send data and set SndDataReady. Snd: Tos, Iob(WriteData), Loc(7410); ! send the data bit data words with timeout processing, but implement no other ! communications protocol. !! Registers.  WCsr := WCsr and not SndDataReady, Iob(WriteCsr); Count := 20; Snd1: Count := Count - 1, if Neq Goto(Snd1) Define(Count,350); ! Timeout counter Define(WCsr,351); ! Current WriteCsr v; WCsr := WCsr or SndDataReady, Iob(WriteCsr); Tos := CTrue, NextInst(0); ! WCsr := WCsr and3Int,5030); ! 3MHz Ethernet interrupt Constant(ParInt,5034); ! memory parity error interrupt ! Registers. alue !! Constants. Constant(ReadCsr,40); ! Link input command/status Define(C1777,253); ! constant 1777, initialized by Perq.Init Define(C400,254); ! constant 400, initialized by Perq.I Constant(ReadData,42); ! Link input data Constant(WriteCsr,241); ! Link output command/nit Define(Z80State,227); ! Z80 input state Define(Z80Status,233); ! Z80 status flags: IO devices that are ready Define(status Constant(WriteData,243); ! Link output data Constant(SndDataReady,1); ! outpZ80WantOutput,243); ! devices with Z80 output messages pending Define(Z80OState,241); ! Z80 output state Define(dpyTmp,374);ut signal - assert low Constant(SndDone,4); ! input signal - assert high Constant(RcvDataRead ! video refresh temporary y,2); ! input signal - assert high Constant(RcvDone,10); ! output signal - assert low  Constant(CFalse,0); Constant(CTrue,1); $Include IO.Dfs !! Placement!!! Link - Perq parallel link communications routines. ! J. P. Strait 11 July 80. ! Copyright (C) Three Riv. Place(7400,7477); !!! Prs - Preset link. ! ! Address = 7400. ! ! Entry ners Computer Corporation 1980. ! Company Confidential. !! Change history. ! ! 30 Jun 81 V1.1 J. Straione. ! ! Exit Link initialized. ! (Tos) = True if success, false otherwise. Prs: WCsr := not Rcvt. ! Use IO.Dfs to get definition of IntVec. ! Move Link.Micro to #7400. ! ! 4 Jun 81 V1.0 J. Strait. Done, Iob(WriteCsr), Loc(7400);! initialize the WriteCsr Tos := CTrue, Push, NextInst(0); !!! Snd - Se! Move Link.Micro to #6000. ! ! 11 Jul 80 V0.0 J. Strait. ! Start file. !!! Link provides a sendnd word to link. ! ! Address = 7410. ! ! Entry (Tos) = Data to send. ! ! Exit (Tos) = True if succe  ! if set is already the right size ! Lengthen the set with zero words. Adj1: Tos := TP - tmp, P! ! Calls: ! MakeBit, SetZero, ChkStk, SetOverFlow, VectSrv. ! !------------------------------------------------------ush; ! save address of deep end TP := TP + tmp1, if IntrPend Call(VectSrv); SL - TP; tm----------------------- Opcode(SGS), tmp11 := 1, Call(MakeBit); ! make a word with a single bit tmp - 10000; p, if C19 Goto(Adj4); ! if not enough room dst := Tos + tmp1, if Eql Goto(Adj2); ! if null set C tmp, if Lss Goto(SGS2); ! if member <= 4095 ! Make a null set. SGS1: Tos := 0, Push, NextInst(all(SetMovUp); ! open up the set Adj2: tmp1 := tmp3, Call(SetZero); ! zero out the new words 0); ! null set SGS2: dst := TP, if Lss Goto(SGS1); ! if member < 0 tmp, RightShift(4); tmp Pop, NextInst(0); ! Shorten set by deleting words. Adj3: Tos := TP + 1, Push; ! end of set +1 := Shift + 1, Push; ! set size tmp10 := tmp1, LoadS(SetOverFlow); dst := dst + tmp1, Call(ChkStk 1 TP := TP + tmp1, if IntrPend Call(VectSrv); dst := Tos + tmp1, Call(SetMovDown); ! delete words Po); ! see if the set will fit TP := TP + 1, Store; ! push the bit tmp5, if IntrPend Call(Vep, NextInst(0); ! It won't fit, signal an error. Adj4: tmp11 := 2; ! PC backup TctSrv); tmp1 := tmp1 - 1, Call(SetZero); ! push the zeros TP := dst, NextInst(0); ! Opcode SRS. !----P := TP - tmp1; ! TP backup SetOverFlow: Tos := tmp, Goto(StkOv); ! restore ESTK ! Opcode SGS. ------------------------------------------------------------------------- ! ! Abstract: ! SRS is a one byte instruction!----------------------------------------------------------------------------- ! ! Abstract: ! SGS is a one byte instru that builds a subrange set--a set ! that consists of a contiguous span of members. If the high bound ! is greate SetMovUp, SetMovDown, VectSrv, StkOv. ! !----------------------------------------------------------------------------- Opcction that builds a singleton set--a set ! that consists of a single member. If the member ordinal is outside ! tode(ADJ), tmp := Tos, pop; ! actual length tmp1 := NextOp - tmp; ! difference in length he range 0..4095 a null set is built. ! ! Instruction: ! SGS ! ! Environment: ! (Tos) = N = Member ordinal. ! tmp3 := tmp1, if Gtr Goto(Adj1); ! if set should be lengthened tmp1; ! allow ! Result: ! (Tos) = L = Length of set = N div 16 + 1. ! N words pushed onto memory stack. ! Memory[TP-0]  placer to do page escape if Lss Goto(Adj3); ! if set should be shortened NextInst(0); = 0. ! Memory[TP-1] = 0. ! ... ! Memory[TP-L+2] = 0. ! Memory[TP-L+1] = 1 LeftShift (N mod 16).  if receiver not yet done ! Tos := CTrue, NextInst(0); ! set success ! !Snd3: WCsr := WCsr or SndDataReadye, Iob(WriteCsr); ! set receive done Rcv4: Tos := CFalse, Push, NextInst(0); ! set failure VecSrv: Vector(I, Iob(WriteCsr); ! clear data ready !Snd4: Tos := CFalse, NextInst(0); ! set failure !!! Rcv - RentVec); end; ceive word from link. ! ! Address = 7420. ! ! Entry none. ! ! Exit (Tos) = True if success, false otherwise. ! (Tos-1) = Data iff success. ! Wait for DataReady. Rcv: Count := not 0, Loc(7420);  ! timeout count Rcv1: if IntrPend Call(VecSrv); Count := Count - 1, Iob(ReadCsr); Iod and RcvDataRea !nop; ! t2 !nop; ! t3 -- still can't start another store MA := etherDCBptr+4, Store2; dy, if Eql Goto(Rcv4); ! if timed out if Eql Goto(Rcv1); ! if no data ready ! Clear MDO := etherDly; ! put final word count in IOCB MDO := etherTmp; ! put statu not SndDataReady, Iob(WriteCsr); ! set data ready ! !! Watch for no SndDone (receiver has started). !  RcvDone (signal that we are starting). WCsr := WCsr or RcvDone, Iob(WriteCsr); ! clear receive done !  ! Count := not 0; ! timeout count !Snd1: if IntrPend Call(VecSrv); ! Count := C Read the data. Iob(ReadData); ! request the data Tos := Iod, Push; ount - 1, Iob(ReadCsr); ! Iod and SndDone, if Eql Goto(Snd3); ! if timed out ! if Neq Goto(Snd1);  ! read the data !! Watch for RcvDataReady to go away (sender is finished). ! ! C ! if receiver not yet started ! !! Clear SndDataReady (signal we are finished). ! ! WCsrount := not 0; ! timeout count !Rcv2: if IntrPend Call(VecSrv); ! Count := Count - 1, Iob(ReadC := WCsr or SndDataReady, Iob(WriteCsr); ! clear data ready ! !! Watch for SndDone (receiver is finished). ! sr); ! Iod and RcvDataReady, if Eql Goto(Rcv3); ! if timed out ! if Neq Goto(Rcv2); ! if dat! Count := 0; ! timeout count !Snd2: if IntrPend Call(VecSrv); ! Count := Count - 1,a still ready ! !! Set RcvDone (data has been received). WCsr := WCsr and not RcvDone, Iob(WriteCsr); Iob(ReadCsr); ! Iod and SndDone, if Eql Goto(Snd4); ! if timed out ! if Eql Goto(Snd2); !  ! set receive done Tos := CTrue, Push, NextInst(0); ! set success Rcv3: WCsr := WCsr and not RcvDon Instruction: ! SRS ! ! Environment: ! (Tos) = High bound. ! (Tos-1) = Low bound. ! ! Result: ! S ! number of middle words + 1 ! Store the contiguous 177777's. SRS3: tmp4 := tmp1, if Leq Goto(SRS6)tack popped. ! (Tos) = Length of set = High div 16 + 1. ! N words pushed onto memory stack. ! Memory[TP-0] ; dst := dst + 1, Store; AllOnes, if IntrPend Goto(SRS5); SRS4: tmp := tmp - 1, Goto(SRS3); SRS5: Call= 0. ! Memory[TP-1] = 0. ! ... ! Memory[TP-(Low div 16)+1] = 0. ! Memory[TP-(Low div 16)] = LeftM(VectSrv); Goto(SRS4); SRS6: tmp1, Field(0,4); tmp := Shift - 1, Call(MakeMask); ! RightMask(Lask(16 - (Low mod 16)). ! Memory[TP-(Low div 16)-1] = 177777. ! Memory[TP-(Low div 16)-2] = 177777. ! ..ow mod 16) dst, Fetch; ! t3 fetch a 177777 or RightMask tmp1, RightShift(4); . ! Memory[TP-(High div 16)+1] = 177777. ! Memory[TP-(High div 16)] = RightMask((High mod 16) + 1). ! ! Calls:  ! t0 tmp1 := Shift; ! t1 number of zero words dst, Store; ! MakeMask, SetZero, ChkStk, VectSrv. ! !-----------------------------------------------------------------------------  ! t2 Mdi and not tmp2; ! t3 LeftMask(16-(Low div 16)) TP := TP + tmp10, if IntrPend C Opcode(SRS), tmp := Tos, Pop; ! high bound tmp1 := Tos; ! low bound !***** Ball(VectSrv); dst := TP, Call(SetZero); ! make the zero words Tos := tmp10 + 1, NextInst(0); R tmp1 - tmp, if Lss Goto(SRS7); ! if low bound < 0 !***** BR if Gtr Goto(SRS7); ! if ! push length on stack ! Make a null set. SRS7: Tos := 0, NextInst(0); ! There's no room on the stack.  low bound > high bound tmp - 10000; if Geq Goto(SRS7); ! if high bound > 4095 load SRS8: Tos := tmp1, Push; ! restore ESTK tmp11 := 1, Goto(StkOv); ! Opcode INN. !-----------------S(SRS8); tmp, RightShift(4); tmp10 := Shift, Call(ChkStk); ! length-1 = (High div 16) TP := TP------------------------------------------------------------ ! ! Abstract: ! INN is a one byte instruction that determi + 1, Call(MakeMask); ! RightMask((High mod 16) + 1) dst := TP, Store, if Neq Goto(SRS1); ! store the right masknes set membership. ! ! Instruction: ! INN ! ! Environment: ! (Tos) = L = Length of set. ! (Tos-1) = El AllOnes, Goto(SRS2); ! zero mask means all ones SRS1: tmp2; ! Uppeement. ! Top L words on the memory stack = the Set. ! ! Result: ! Stack popped. ! L words popped from memr than 4095, the low bound is less than 0, or the low ! bound is greater than the high bound, a null set is built. ! ! r word SRS2: tmp := tmp or 17, if IntrPend Call(VectSrv); tmp - tmp1, RightShift(4); tmp := Shift;   7 57 Data error in bit 15 of the stack ! 10 58 Stack empty set when the stack is full ! 11 59 Data error on stack ! 12 60 Data error after POP. Bit 14 ! !VFY Version 1.3 ! Diagnostic Micro-Code for Perq ! Can be used stand alone, or as part of boot sequence ! 8-Mar-81 BR  13 61 Data error after POP. Bit 13 ! 14 62 Data error after POP. Bit 12 !  Version 1.3. Recreated source code from binary ! ! ??-???-?? ??? Version 1.2. Moved C19 test past top 4 test !  15 63 Data error after POP. Bit 11 ! 16 64 Data error after POP. Bit 10 !  Added dispatch test ! Made DDS sequence work correctly ! ! 17-Sep-80 DAS 17 65 Data error after POP. Bit 9 ! 20 66 Data error after POP. Bit 8 !  Version 1.1. Added the code to allow VFY to ! be used at boot time. BVFY no longer lives.  21 67 Data error after POP. Bit 7 ! 22 68 Data error after POP. Bit 6 !  ! 12-Sep-80 DAS Added version numbers and reformated the file. ! ! Running instructions: ! ! R0 is used by VFY23 69 Data error after POP. Bit 5 ! 24 70 Data error after POP. Bit 4 ! 25 as a switch register. ! The bits have the following meaning when set: ! ! Bit0 - Multiple passes. When set do more  71 Data error after POP. Bit 3 ! 26 72 Data error after POP. Bit 2 ! 27 than one pass. ! Bit1 - Ignore parity test. ! Bit7 - VFY was started at boot time. This will effect !  73 Empty wrong. ! 30 74 Data error after POP. Bit 1 ! 31 75 s in IOCB 0, IOB(E3WrCSR); ! t2 --Dismiss Interrupt ! someday, check EtherDCBptr+5,error reporting and termination. ! ! After setting R0 simply type "4001G" to ODTPRQ. ! ! ! Error Codes: ! ! ErrorTyp6 for next IOCB nop; ! t3 - can't start the fetch yet ioDevTab + etherIntMe DDS ! ! 1 51 Empty stack bit not working ! 2 52 Could not load Tsk, Fetch; ! get Interrupt mask UserIntr := MDI or UserIntr; ! Cause Pascal interrupt returnOS ! 3 53 Push did not work ! 4 54 Stack Empty did not go off ! 5 ;  55 Data error in push ! 6 56 Empty or Full set when that is not the case !   Top L0 words on the memory stack = Set0. ! Next L1 words on the memory stack = Set1. ! ! Result: ! Stack popped ! if Set0 = [] LoadS(INT2); Nop; ! allow placer to do page escape . ! The lesser of L0 and L1 words popped from the memory stack. ! (Tos) = L = The greater of L0 and L1. ! TCall(SetOp); ! compute the union INT1: tmp1 := Tos - tmp5; ! diff. of set sizes ory stack. ! (Tos) = Element in Set. ! ! Calls: ! MakeBit. ! !------------------------------------------------op L words of memory stack = Set0 + Set1. ! ! Calls: ! SetAdj, SetOp. ! !------------------------------------------------------------------------- Opcode(INN), tmp2 := Tos, Pop; ! get length of the set Call(MakeBit); --------------------------------- Opcode(UNI), Call(SetAdj); ! make L1 >= L0 if Neq Goto(UNI1);  ! make a bit Nop; ! allow placer to do page escape tmp, Ri ! if Set0 <> [] NextInst(0); ! result is Set1 UNI1: LoadS(UNI2); ghtShift(4); ! potential element tmp := Shift, Push, ! word offset Call(SetOp); ! compute the union NextInst(0); UNI2: Mdi or tmp, Goto(SetOp); ! if Lss Goto(INN2); ! if potential member < 0 tmp - tmp2; if Geq Goto(INN2), ! if union of two words ! Opcode QINT. !----------------------------------------------------------------------------- ! ! Abs word offset >= length MA := TP - tmp, Fetch; ! get word from stack Mdi and tmp5; tract: ! QINT is a one byte instruction that computes the intersection ! of two sets. ! ! Instruction: !  ! test the bit Tos := 1, ! assume true if Eql Goto(INN2); QINT ! ! Environment: ! (Tos) = L0 = Length of Set0. ! (Tos-1) = L1 = Length of Set1. ! Top L0 words on  ! if bits don't match INN1: TP := TP - tmp2, NextInst(0); ! cut back stack to get rid of set INN2: Tos :the memory stack = Set0. ! Next L1 words on the memory stack = Set1. ! ! Result: ! Stack popped. ! The le= 0, Goto(INN1); ! not in set, push false ! Opcode UNI. !---------------------------------------------------sser of L0 and L1 words popped from the memory stack. ! (Tos) = L = The greater of L0 and L1. ! Top L words of the-------------------------- ! ! Abstract: ! UNI is a one byte instruction that computes the union of two sets. ! ! Ins memory stack = Set0 * Set1. ! ! Calls: ! SetAdj, SetOp. ! !---------------------------------------------------------truction: ! UNI ! ! Environment: ! (Tos) = L0 = Length of Set0. ! (Tos-1) = L1 = Length of Set1. ! -------------------- Opcode(QINT), Call(SetAdj); ! make L1 >= L0 tmp5 := tmp3, if Eql Goto(INT1);   Call test falied ! 34 78 Odd didn't jump on a 1. ! 35 79 Odd jumped on a 0. And ALU function failed. ! 66 104 Or-Not ALU function failed. ! 67 105 Not- ! 36 80 Byte sign didn't jump on 200. ! 37 81 Byte sign jumped on 0. ! A ALU function failed. ! 70 106 Not-B ALU function failed. ! 71 107 Xor ALU fu 40 82 C19 didn't jump when it should have. ! 41 83 BCP[3] didn't jump when it shnction failed. ! 72 108 Xnor ALU function failed. ! 73 109 OldCarry-Add ALU fuould have. ! 42 84 C19 jumped when it shouldn't have. ! 43 85 BCP[3] jumped nction failed. ! 74 110 OldCarry-Sub ALU function failed. ! 75 111 OldCarry-Adwhen it shouldn't have. ! 44 86 GTR didn't jump. ! 45 87 GTR jumped when it d /w No OldCarry failed. ! 76 112 Fetch error on Force Bad Parity. ! 77 113 Unshouldn't have. ! 46 88 GEQ didn't jump. ! 47 89 GEQ jumped when it shouldn'expected Parity error. ! 100 114 No parity errors on force bad parity. ! 101 11t have. ! 50 90 LSS didn't jump when it should have. ! 51 91 LSS jumped when5 Wrong address on force bad parity. ! 102 116 Upper 4 bit test failed. !  it shouldn't have. ! 52 92 LEQ didn't jump. ! 53 93 LEQ jumped when it shou 103 117 MDX test failed. ! 104 118 Stack upper bits test failed. ! ldn't have. ! 54 94 GEQ didn't jump on equal. ! 55 95 LEQ didn't jump on equ 105 119 Dual Addr/Fetch4 test failed. ! 106 120 Unexpected refill. al. ! 56 96 Carry didn't jump when it should have. ! 57 97 Carry jumped when! 107 121 BPC test failed. ! 110 122 Fetch4 test failed. !  it shouldn't have. ! 60 98 Overflow didn't jump when it should have. ! 61 99  111 123 Fetch4R test failed ! 112 124 Store4 test failed. ! 11 Overflow jumped when it shouldn't have. ! 62 100 And-Not ALU function failed. ! 63 3 125 Fetch2 test failed. ! 114 126 Store2 test failed. ! 115  Data error after POP. Bit 0 ! 32 76 Empty not set after all pops. ! 33 77 101 Or ALU function failed. ! 64 102 Or-Not ALU function failed. ! 65 103 !  LoadS(DIF2); Nop; ! allow placer to do a page escape Call(SetOp);  Odd Goto (EQUPX); Goto(EQUPZ); NEQPop: Mdi - tmp; !Compare Equal IF eql Goto(SETCOMP); Tos := 1, R ! compute the difference DIF1: NextInst(0); DIF2: Mdi and not tmp, Goto(SetOp); ! difference of teturn; Opcode(LEQPowr), Call(SetAdj); Call(SetSizes); tmp3; if Eql Goto(EQUPZ), Tos := 1; wo words $Title xxxPowr - Set comparisons. ! Opcode EQUPowr, NEQPowr, LEQPowr, GEQPowr. !------------------------- LoadS(LEQPop); Goto(EQUPCMP); LEQPop: Mdi and not tmp; IF eql Goto(SETCOMP); Tos := 0, Return; O---------------------------------------------------- ! ! Abstract: ! The xxxPowr opcodes are one byte instructions thatpcode(GEQPowr), Call(SetAdj); Call(SetSizes); tmp3; if eql Goto(GEQPEND), Tos := 1; LoadS(GE compare two set ! operands. ! ! Instruction: ! xxxPowr ! ! Environment: ! (Tos) = L0 = Length of Set0.QPop); Call(SETCOMP); GEQPEND:TP := tmp6, NextInst(0); GEQPop: tmp1 := Mdi; tmp and not tmp1; IF eq dst := tmp4, Call(SetZero); ! fill with zero words NextInst(0); INT2: Mdi and tmp, Goto(SetOp);  ! (Tos-1) = L1 = Length of Set1. ! Top L0 words on the memory stack = Set0. ! Next L1 words on the memory  ! intersection of two words ! Opcode DIF. !-------------------------------------------------------------------------stack = Set1. ! ! Result: ! Stack popped. ! L0 + L1 words popped from memory stack. ! (Tos) = Set0 xxx Se---- ! ! Abstract: ! DIF is a one byte instruction that computes the difference ! of two sets. ! ! Instructiot1. ! ! Calls: ! SetFalse, SetTrue. ! !----------------------------------------------------------------------------- n: ! DIF ! ! Environment: ! (Tos) = L0 = Length of Set0. ! (Tos-1) = L1 = Length of Set1. ! Top L0 Opcode(EQUPowr), Call(SetAdj); Call(SetSizes); tmp3; IF Eql Goto(EQUPZ), Tos := 1; LoadS( words on the memory stack = Set0. ! Next L1 words on the memory stack = Set1. ! ! Result: ! Stack popped. ! EQUPop); Nop; ! placer !!!!!!!!!!!!!!!!!!!!! EQUPCMP:Call(SETCOMP); if Odd Goto(EQU The lesser of L0 and L1 words popped from the memory stack. ! (Tos) = L = The greater of L0 and L1. ! Top L woPZ); ! already false TP := tmp6, NextInst(0); EQUPZ: Call(SETZCHK); EQUPX: TP := tmp6, NextInst(0); EQUPop: rds of the memory stack = Set0 - Set1. ! ! Calls: ! SetAdj, SetOp. ! !-----------------------------------------------Mdi - tmp; !Compare Equal IF eql Goto(SETCOMP); Tos:= 0, Return; Opcode(NEQPowr), Call(SetAdj); C------------------------------ Opcode(DIF), Call(SetAdj); ! make L1 >= L0 if Eql Goto(DIF1); all(SetSizes); tmp3; IF Eql Goto(EQUPZ), Tos := 0; LoadS(NEQPop); Call(SETCOMP); if! ween 50 and 149 ! The Error reporting scheme increments the error register by 10#20 constant(DDSoffset,10#20); !Vfy exits wit ! Make sure it worked if neq GoTo(ErrorExit), ErrorType := 5; ! 055-Data error in push h 150 in the DDS, therefore we ask for 150 - 29 - 1 - 20 = 100 ! increments before exiting exit - start - first -  tmp1 := tmp1 + tmp1; ! LeftShift data value tmp1 - 100000;  127 NextOp test failed. ! 116 128 Fetch/Store overlap failed. ! 11offset = diff constant(DDSDif,10#100); place(4000,6377); ! ! Start here on Boot. Set the Boot bit in TestContinue. 7 129 Bad interrupt Loc 4. ! 120 130 Bad interrupt Loc 9. ! 121 ! BStart: TestContinue := 202, LoadOP, Loc(4000); ! Booting and no parity. ! ! Test the E stack. (Start  131 Bad interrupt Loc 20. ! 122 132 Bad interrupt Loc 30. ! 123here for VFY from ODTPRQ). ! StackTest: StackReset, ErrorType := 0, Loc(4001); ! Bump DDS to 30 dpytmp := 101 133 Memory error on No Dual Addr test. ! 124 134 Memory error on No Dual Addr I154; dpycnt := 0; !TestContinue := 2; tmp := UState AND 1000; ! Check Empty Fnvert. ! 125 135 Field didn't work ! 126 136 Dispatch did not jump ! 127lag if neq GoTo(ErrorExit), ErrorType := 1; ! 051-Empty Stack bit not working TOS := 1;  137 Wrong Dispatch target ! ! Register definitions. ! define(ErrorType,1); define(tmp,2);  ! Load a one tmp := TOS - 1; ! Check it if neq GoTo( define(adr,3); define(last,4); define(ParityHit,5); define(ParityErr,6); define(r0,0); define(r1,1); define(r2,2); definErrorExit), ErrorType := 2; ! 052-Couldn't load TOS TOS := 2, Push; !e(r3,3); define(r4,4); define(r5,5); define(r6,6); define(tmp1,7); define(R10,10); define(R11,11); define(R12,12); defin try pushing a value tmp := TOS - 2; if neq GoTo(ErrorExit), ErrorType := 3; ! 053-Push Didn't work e(R13,13); define(R370,370); define(etmp,14); define(ecnt,15); define(MaxAdrP1,16); define(dpytmp,300); define(dpycnt,301) tmp := UState AND 1000; ! Check empty again if eql GoTo(ErrorExit), ErrorType ; define(TestContinue,0); constant(BreakPoint,7401); constant(SYSBEntry,7000); constant(ErrorReturn,101); constant(GoodRe:= 4; ! 054-Stack Empty did not go off tmp1 := 4; ! Start data value turn,100); !This program enters at DDS = 29 during boot ! The instruction at 4001 increments it to 30 ! Error codes lie bet Pushl: TOS := tmp1, Push; ! Push new value on stack tmp := TOS - tmp1; " lt: ! stack popped three times. ! (Tos) = String0 xxx String1. ! ! Calls: ! StrCmp, SetTrue. ! !-------Array1. ! (Tos-3) = Word address of ByteArray1. ! If Length = 0: ! (Tos) = Length of byte arrays.---------------------------------------------------------------------- Opcode(EQUStr), Call(StrCmp); Tos := 0, if Eq ! (Tos-1) = Byte offset for ByteArray0. ! (Tos-2) = Word address of ByteArray0. ! (Tos-3) =l Goto(SetTrue); ! assume false NextInst(0); Opcode(NEQStr), Call(StrCmp); Tos := 0, if Neq Goto(SetTr Byte offset for ByteArray1. ! (Tos-4) = Word address of ByteArray1. ! ! Result: ! If Length <> 0: ! ue); ! assume false NextInst(0); Opcode(LEQStr), Call(StrCmp); Tos := 0, if Leq Goto(SetTrue); !  Stack popped three times. ! If Length = 0: ! Stack popped four times. ! (Tos) = ByteArray0 xxx Bassume false NextInst(0); Opcode(LESStr), Call(StrCmp); Tos := 0, if Lss Goto(SetTrue); ! assume falseyteArray1. ! ! Calls: ! BytCmB, SetTrue. ! !------------------------------------------------------------------------- NextInst(0); Opcode(GEQStr), Call(StrCmp); Tos := 0, if Geq Goto(SetTrue); ! assume false Ne---- Opcode(EQUByt), Call(BytCmp); Tos := 0, Push, if Eql Goto(SetTrue); ! assume false NextInst(0); OpxtInst(0); Opcode(GTRStr), Call(StrCmp); Tos := 0, if Gtr Goto(SetTrue); ! assume false NextInst(0); code(NEQByt), Call(BytCmp); Tos := 0, Push, if Neq Goto(SetTrue); ! assume false NextInst(0); Opcode(LEQBy $Title xxxByt - Byte array comparisons. ! Opcode EQUByt, NEQByt, LEQByt, LBytBytByt, GEQByt, GTRByt. !-------------t), Call(BytCmp); Tos := 0, Push, if Leq Goto(SetTrue); ! assume false NextInst(0); Opcode(LESByt), Call(Bl Goto(SETCOMP); Tos := 0, Return; $Title xxxStr - String comparisons. ! Opcode EQUStr, NEQStr, LEQStr, LE---------------------------------------------------------------- ! ! Abstract: ! The xxxByt opcodes are two byte instruSStr, GEQStr, GTRStr. !----------------------------------------------------------------------------- ! ! Abstract: ! Tctions that compare two byte ! arrays for equality and/or order. The length of the byte arrays is ! specified as he xxxStr opcodes are one byte instructions that compare two string ! values for equality and/or order. The strings mustan operand byte if it is a constant and less than 256. ! Otherwise the operand byte is zero and the length is on the !  be word aligned. ! ! Instruction: ! xxxStr ! ! Environment: ! (Tos) = Byte offset for String0. ! (Tos- expression stack. ! ! Instruction: ! xxxByt Length ! ! Environment: ! If Length <> 0: ! (Tos1) = Word address of String0. ! (Tos-2) = Byte offset for String1. ! (Tos-3) = Word address of String1. ! ! Resu) = Byte offset for ByteArray0. ! (Tos-1) = Word address of ByteArray0. ! (Tos-2) = Byte offset for Byte"  tmp := TOS xor 40000; ! Should be 40000 if neq GoTo(ErrorExit), ErrorType := 12;  Pop; tmp := TOS xor 4; if neq GoTo(ErrorExit), ErrorType := 26; ! 072-Data error after pop bit 2 ! 060-Data error after pop bit 14 Pop; tmp := TOS xor 20000; if neq GoTo(ErrorExit), ErrorType := 1 tmp := UState AND 1000; if eql GoTo(ErrorExit), ErrorType := 27; ! 073-Empty wrong Pop3; ! 061-Data error after pop bit 13 Pop; tmp := TOS xor 10000; if neq GoTo(ErrorExit), Erro; tmp := TOS xor 2; if neq GoTo(ErrorExit), ErrorType := 30; ! 074-Data error after pop bit 1 rType := 14; ! 062-Data error after pop bit 12 Pop; tmp := TOS xor 4000; if neq GoTo(ErrorEx Pop; tmp := TOS xor 1; if neq GoTo(ErrorExit), ErrorType := 31; ! 075-Data error after pop bit 0 it), ErrorType := 15; ! 063-Data error after pop bit 11 Pop; tmp := TOS xor 2000; if neq GoT tmp := UState AND 1000; if neq GoTo(ErrorExit), ErrorType := 32; ! 076-Empty Not set after all pops  ! Are we done? if neq goto(Pushl); ! No, do again tmp := Uo(ErrorExit), ErrorType := 16; ! 064-Data error after pop bit 10 Pop; tmp := TOS xor 1000; iState AND 1000; ! Check no empty if eql GoTo(ErrorExit), ErrorType := 6; ! 056-Empty orf neq GoTo(ErrorExit), ErrorType := 17; ! 065-Data error after pop bit 9 Pop; tmp := TOS xor 400;  Full when not so tmp := 100000; ! Push last item on stack TOS := tmp, Pus if neq GoTo(ErrorExit), ErrorType := 20; ! 066-Data error after pop bit 8 Pop; tmp := TOS xor 2h; ! Check it tmp := TOS - 100000; if neq GoTo(ErrorExit), ErrorType := 7; 00; if neq GoTo(ErrorExit), ErrorType := 21; ! 067-Data error after pop bit 7 Pop; tmp := TO ! 057-Data error bit 15 on stack tmp := UState AND 1000; ! Check for full tmp - 1S xor 100; if neq GoTo(ErrorExit), ErrorType := 22; ! 068-Data error after pop bit 6 Pop; tm000; ! Empty Clear if neq GoTo(ErrorExit), ErrorType := 10; ! 058-Stack Emptp := TOS xor 40; if neq GoTo(ErrorExit), ErrorType := 23; ! 069-Data error after pop bit 5 Pop; y set when full tmp := TOS xor 100000; ! Check data still there if neq GoTo(ErrorExit tmp := TOS xor 20; if neq GoTo(ErrorExit), ErrorType := 24; ! 070-Data error after pop bit 4 Pop;), ErrorType := 11; ! 059-Data Error on stack Pop; ! Pop one off  tmp := TOS xor 10; if neq GoTo(ErrorExit), ErrorType := 25; ! 071-Data error after pop bit 3 #  := 0, Push, if Gtr Goto(SetTrue); ! assume false NextInst(0); $Title xxxWord - Multiple word comparisons.  ! Opcode EQUWord, NEQWord. !----------------------------------------------------------------------------- ! ! Abstract: ! $Title Jxxx, XJP - Jumps. ! Opcode JMPB. !----------------------------------------------------------------------------- !  The xxxWord opcodes are two byte instructions that compare two word ! arrays for equality or inequality. The lengt ! Abstract: ! JMPB is a two byte unconditional jump instruction. ! ! Instruction: ! JMPB Offset ! ! Enviroh of the word arrays is ! specified as an operand byte if it is a constant and less than 256. ! Otherwise the opernment: ! old PC = Byte address + 1 of the Offset operand. PC = UPC * 2 + BPC. ! ! Result: ! new PC = old PC + Oand byte is zero and the length is on the ! expression stack. ! ! Instruction: ! xxxWord Length ! ! Environmeffset. ! ! Calls: ! AdjustPC. ! !----------------------------------------------------------------------------- ! Ont: ! if Length <> 0: ! (Tos) = Word address of WordArray0. ! (Tos-1) = Word address of WordArraypcode JFB, JTB. !----------------------------------------------------------------------------- ! ! Abstract: ! JFB and1. ! if Length = 0: ! (Tos) = Length of word arrays. ! (Tos-1) = Word address of WordArray0. !  JTB are two byte conditional jump instructions which jump ! if the value on the top of the expression stack is false or  (Tos-2) = Word address of WordArray1. ! ! Result: ! if Length <> 0: ! Stack popped once. ! true ! respectively. ! ! Instruction: ! JxB Offset ! ! Environment: ! old PC = Byte address + 1 of  if Length = 0: ! Stack popped twice. ! (Tos) = WordArray0 xxx WordArray1. ! ! Calls: ! CmpMW. ! !the Offset operand. PC = UPC * 2 + BPC. ! (Tos) = Boolean value. ! ! Result: ! Stack popped. ! If condit----------------------------------------------------------------------------- Opcode(EQUWord), Call(CmpMW); NextInstion met then new PC = old PC + Offset. ! If condition not met then new PC = old PC. ! ! Calls: ! AdjustPC. ! !(0); Opcode(NEQWord), Call(CmpMW); Tos := Tos xor 1, NextInst(0); ! flip results ----------------------------------------------------------------------------- ! Opcode JEQB, JNEB. !------------------------ytCmp); Tos := 0, Push, if Lss Goto(SetTrue); ! assume false NextInst(0); Opcode(GEQByt), Call(BytCmp);  Tos := 0, Push, if Geq Goto(SetTrue); ! assume false NextInst(0); Opcode(GTRByt), Call(BytCmp); Tos#  ! 2nd level return CS: Call(DS); ! 3rd level call, now call level 4 tmpry gtr/lss/leq/geq r2 - 40124; if gtr goto(bad6); r2 - 40122; if gtr goto(good8); E := tmp + 4, Return; ! 3rd level return DS: Call(ES); ! 4th lrrorType := 44, goto(ErrorExit); ! 086-gtr didn't jump when it should bad6: ErrorType := 45, goto(ErrorExit); evel call, now call level 5 tmp := tmp + 10, return; ! 4th level return ES: tmp := tmp + 20 ! 087-gtr jumped when it shouldn't good8: r2 - 40124; if geq goto(bad7); r2 - 40122; , return; ! 5th level call, return now ! ! Jump tests. ! JmpTest:0;  if geq goto(good9); ErrorType := 46, goto(ErrorExit); ! 088-geq didn't jump when it should bad7:  ! Try Even/Odd Jump Condition if Odd goto(bad1); ! Should not jump ErrorType := 47, goto(ErrorExit); ! 089-geq jumped when it shouldn't (gtr) good9: r2 - 40122; if lss 1; if Odd goto(good1); ! Should jump ErrorType := 34, goto(ErrorExit);  goto(bad8); r2 - 40124; if lss goto(good10); ErrorType := 50, goto(ErrorExit); ! 090-l ! 078-Odd didn't jump on a 1 bad1: ErrorType := 35, goto(ErrorExit); ! 079-Odd jumped on a 0 good1:ss didn't jump when it should bad8: ErrorType := 51, goto(ErrorExit); ! 091-lss jumped when it shouldn't go 0; ! Try Byte sign jump if ByteSign goto(bad2); 200; iod10: r2 - 40122; if leq goto(bad9); r2 - 40124; if leq goto(good11); ErrorType := 52, goto( ! ! Test the 2910 call stack ! CallTest: tmp := 0, Call(AS); ! Test 2910 call stack tmf ByteSign goto(good6); ErrorType := 36, goto(ErrorExit); ! 080-Byte Sign didn't jump on a 200 bad2: Ep - 37; ! 5 levels should be 5 bit set if eql GoTo(JmpTest); CallErr:ErrorType := 37, goto(ErrorExit); ! 081-Byte Sign jumped on a 0 good6: bpc := 0; rrorType := 33, GoTo(ErrorExit); ! 077-Call Test failed AS: Call(BS);  ! Try jumping on BPC[3] if bpc[3] goto(bad5); bpc := 10; if bpc[3] goto(good7); Erro ! 1st level call, now call level 2 tmp := tmp + 1, return; ! 1st level return BS: Call(CSrType := 41, goto(ErrorExit); ! 083-BPC[3] didn't jump when it should bad5: ErrorType := 43, goto(ErrorExit); ); ! 2nd level call, now call level 3 tmp := tmp + 2, return;  ! 085-BPC[3] jumped when it shouldn't good7: r2 := 40123; ! Random data to t$ 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$  ! 094-geq didn't jump when it was eql good12: r2 - 40123; if leq goto(good13); ErrorType := 55, g 66, goto(ErrorExit); ! 104-OR NOT alu function failed good20: r2 := not r2; r2 - 12040; if eoto(ErrorExit); ! 095-leq didn't jump when it was eql good13: r2 := 177776; r2 := r2 + 1; ifql goto(good21); ErrorType := 67, goto(ErrorExit); ! 105-NOT A alu function failed good21: r2 := not 4 carry goto(bad10); r2 := r2 + 1; if carry goto(good14); ErrorType := 56, goto(ErrorExit); 5216; r2 - 132561; if eql goto(good22); ErrorType := 70, goto(ErrorExit); ! 106-NOT B a ! 096-Carry didn't jump when it should bad10: ErrorType := 57, goto(ErrorExit); ! 097-Carry jumped when it slu function failed good22: r2 := r2 xor 152525; r2 - 060044; if eql goto(good23); ErrorType := 71, ghouldn't good14: r2 := 77776; r2 := r2 + 1; if overflow goto(bad11); r2 := r2 + 1; if oveoto(ErrorExit); ! 107-XOR alu function failed good23: r2 := r2 xnor 275; r2 - 117546; if eqrflow goto(good15); ErrorType := 60, goto(ErrorExit); ! 098-Overflow didn't jump when it should bad11: l goto(good24); ErrorType := 72, goto(ErrorExit); ! 108-XOR alu function failed good24: r2 := 177777; ErrorType := 61, goto(ErrorExit); ! 099-Overflow jumped when it shouldn't good15: r2 := 12345; r2 := r r2 := r2 + 1; r2 := r2 + 0 + oldcarry; r2 - 1; if eql goto(good25); ErrorType := 732 and not 770; r2 - 12005; if eql goto(good16); ErrorType := 62, goto(ErrorExit); ! 100, goto(ErrorExit); ! 109-OldCarry Add alu function failed good25: r2 := 0; r2 := r2 - 1; r2 :-And Not ALU function failed good16: r2 := r2 or 340; r2 - 12345; if eql goto(good17); ErrorType := r2 - 0 - oldcarry; 0; !********r2 - 177776; if eql goto(good26); ErrorType := 74, goto(ErrorExit); = 63, goto(ErrorExit); ! 101-OR alu function failed good17: r2 := r2 or not 377; r2 - 177745;  ! 110-OldCarry subtract function failed good26: r2 := 0; r2 := r2 + 0; r2 := r2 + 0 + oldcarr if eql goto(good18); ErrorType := 64, goto(ErrorExit); ! 102-OR NOT alu function failed good18: r2 :=y; if eql goto(good27); ErrorType := 75, goto(ErrorExit); ! 111-OldCarry Add with no OldCarry faErrorExit); ! 092-leq didn't jump when it should bad9: ErrorType := 53, goto(ErrorExit); ! 093-le r2 and 307; r2 - 305; if eql goto(good19); ErrorType := 65, goto(ErrorExit); ! 103-ANDq jumped when it shouldn't good11: r2 - 40123; if geq goto(good12); ErrorType := 54, goto(ErrorExit);  alu function failed good19: r2 := r2 or not 12345; r2 - 165737; if eql goto(good20); ErrorType :=%  ! 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; %  nop; ma := 100, fetch; nop; nop; mdi - 12345; if eql goto(FPE1);  - tmp1; IF Neq GoTo(BpcErr),tmp := tmp - 1; IF Neq GoTo(BpcL); MA := 100, Store4; MDO := 40iled good27: ! ! Memory test ! MemTest:MaxAdrP1 := 100000; MaxAdrP1 := MaxAdrP1 + MaxAdrP1; MaxAd ErrorType := 76, GoTo(ErrorExit); ! 112-Fetch error on Force Bad Parity FPE1: 0, Iob(343); rP1 := MaxAdrP1 + MaxAdrP1; adr := MaxAdrP1; ! No dual address test IOB(147);  ! turn off force bad parity if IntrPend Call(VecInt); if IntrPend Call(VecInt); if Int ! Read Parity error register to clear any error present ParityHit := 0; rPend Call(VecInt); if IntrPend Call(VecInt); ParityHit; if neq goto(FPE2); ErrorType := 100 ! Should not get Parity Errors Wloop: IF IntrPend Call(VecInt); adr := adr - 1, Store; , GoTo(ErrorExit); ! 114-No parity errors on Force Bad Parity FPE2: ParityErr - 100; if eql goto(FPE3);  MDO := adr; nop; adr, Fetch; nop; nop; MDI xor adr; adr - 1, if Neq GoTo( ErrorType := 101, GoTo(ErrorExit); ! 115-Wrong address on Force Bad Parity FPE3: MemTestI:adr := MaxAdrMemErr); IF C19 GoTo(Read); GoTo(Wloop); Read: adr := MaxAdrP1; Rloop: IF IntrPend Call(VecInt)P1; ! No dual address inverted test WloopI: IF IntrPend Call(VecInt); adr := adr - 1, Sto; adr := adr - 1, Fetch; adr; ! Dont take a chance on Abort re; MDO := not adr; nop; adr, Fetch; nop; nop; MDI xnor adr; adr  adr; tmp := MDI; tmp xor adr; adr - 1, IF Neq GoTo(MemErr); ParityHit, IF C19 GoTo(MemDone)- 1, if Neq GoTo(MemErrI); IF C19 GoTo(ReadI); GoTo(WloopI); ReadI: adr := MaxAdrP1; RloopI: IF; GoTo(Rloop); MemDone: IF Eql GoTo(ForcePE); ! end of test, check for parity error  IntrPend Call(VecInt); adr := adr - 1, Fetch; adr; ! Dont take a chanc IsParErr: tmp := ParityErr; ! yes, we got a parity error ErrorType := 77, GoTo(ErrorExit)e on Abort adr; tmp := MDI; tmp xnor adr; adr - 1, IF Neq GoTo(MemErrI); ParityHit,; ! 113-Unexpected Parity Error ForcePE:TestContinue and 2; if neq goto(MemTestI); tmp IF C19 GoTo(MemDoneI); GoTo(RloopI); MemDoneI: IF Neq GoTo(IsParErr); ! ! Test the Byte Program Cou := 10000; tmp, iob(343); ! Write Bad Parity ma := 100, store; 12345;nter ! BpcT: 0, Iob(343); tmp := 17,; BpcL: BPC := tmp; tmp1 := USTATE AND 17; tmp&  $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& ; IF Neq GoTo(Fet4RErr); R13 - 400; IF Neq GoTo(Fet4RErr); MA := 100, Store4R; MDO  adr := adr - 4, Fetch4; tmp := adr; r10 := MDI; r11 := MDI; r12 := MDI; r13:= 400; MDO := 1402; MDO := 2404; MDO := 3406; 0; MA := 100, Fetch4R;  := MDI; r10 xor tmp; tmp := tmp + 1, if Neq GoTo(MemErr4); r11 xor tmp; tmp := tmp + 1, if  ! t0 R10 := MDI; R11 := MDI; R12 := MDI; R13 := MDI; R10 - 400; Neq GoTo(MemErr4); r12 xor tmp; tmp := tmp + 1, if Neq GoTo(MemErr4); r13 xor tmp; adr - 1,  IF Neq GoTo(Str4RErr); R11 - 1402; IF Neq GoTo(Str4RErr); R12 - 2404; IF Neq GoTo(Str4RErr)if Neq GoTo(MemErr4); ParityHit, IF C19 GoTo(MemDone4); GoTo(Rloop4); MemDone4: if Neq GoTo(IsParEr0; MDO := 1402; MDO := 2404; MDO := 3406; 0; MA := 100, Fetch4; ; R13 - 3406; IF Neq GoTo(Fet4RErr); MA := 100, Store2; MDO := 2404; MDO := 3406;  ! t0 bpc := 0; ! t1 loadop; ! t MA := 100, Fetch2; !t0 R10 := MDI; R11 := MDI; R10 - 2404; IF Neq GoTo(Fet2Err); 2 R10 := MDI; R11 := MDI; R12 := MDI; R13 := MDI; R10 - 400; IF Neq GoTo(F R11 - 3406; IF Neq GoTo(Fet2Err); MA := 102, Store2; MDO := 1234; MDO := 5432; et4Err); R11 - 1402; IF Neq GoTo(Fet4Err); R12 - 2404; IF Neq GoTo(Fet4Err); R13 -  MA := 102, Fetch2; !t0 R10 := MDI; R11 := MDI; R10 - 1234; IF Neq GoTo(Fet2AErr); 3406; IF Neq GoTo(Fet4Err); tmp := 0; ! ! Test NextOp ! NextOpT:tm R11 - 5432; IF Neq GoTo(Fet2AErr); MA := 100, Fetch; adr; MA := 200, Store; MDO :=p1 := NextOp; tmp - tmp1; IF Neq GoTo(NOerr); tmp - 7; tmp := tmp + 1, IF Neq GoTo(NextOpT); MDI; MA := 100, Fetch; tmp := MDI; tmp - 2404; if neq goto(FSOvlpErr); MemTest4: MA := 100, Fetch4R; ! t0 bpc := 0; ! t1 loadr := MaxAdrP1; ! No dual address Fetch/Store4 Wloop4: IF IntrPend Call(VecInt); adr := aadop; ! t2 R10 := MDI; R11 := MDI; R12 := MDI; R13 := MDdr - 4, Store4; MDO := adr; MDO := adr + 1; MDO := adr + 2; MDO := adr + 3; adr - 1I; R10 - 3406; IF Neq GoTo(Fet4RErr); R11 - 2404; IF Neq GoTo(Fet4RErr); R12 - 1402; IF C19 GoTo(Read4); GoTo(Wloop4); Read4: adr := MaxAdrP1; Rloop4: IF IntrPend Call(VecInt); ' ---------------------------------- 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' eq goto(ErrorExit); ! 117-MDX test failed r5, push; ! Check that the Stack upper 4 hen it shouldn't Case(DspTst,0), R2 := 0; ! the correct answer is DspChk: R3 - R2; bits works r4 := tos,pop; r6 := not ustate(r4); r6 := r6 and 170000; r6 - r2; Error ! check answer ErrorType := 127, if Neq Goto(ErrorExit); ! 137-Wrong Dispatch target R3Type := 104, if neq goto(ErrorExit); ! 118-Stack upper bits test failed StackOk:r5 := r5 + 100000;  := R3 + 1; ! next target R3 - 20; ! do 16 targets  ! Cause carry, incr top4 r3 := r3 + 1; ! Next lower bit r2 := r2 + 10000;  if Lss Goto(DspLp); !End of Test Code TestContinue and 1; ! shall we loop if  ! Next upper 4 bit if neq goto(top4lp); tmp1 := not 0; ! Sneq goto(StackTest); etmp := DDSdif, Call(SetDDS); ! set DDS to 150 if ByteSign GoTo(SYSBEntry);et no carry tmp1 := tmp1 + 0; if C19 goto(C19Yes); ! C19 test is backwards Err ! if started via boot R370 := GoodReturn; ! if started via ODTPRQ ErroorType := 40, GoTo(ErrorExit); ! 082-C19 didn't jump when it should have C19Yes: tmp1 := tmp1 + 1; rType := 0, GoTo(BreakPoint); Case(DspTst,1), R2 := 1, Goto(DspChk); Case(DspTst,2), R2 := 2, Goto(DspChk); Case(DspTstr); Top4: r5 := 100000; r2 := 10000; r3 := 1; Top4lp: r5 := r5 + 100000;  ! -1 + 1 causes carries if C19 Goto(C19No); R3 := 0; ! Prepare  ! try upper 4 bits, carry propogate a 1 up there r6 := not USTATE(r5); ! Read Y[19:16] on USTfor Dispatch test DspLp: R3, Field(0,4); ! first check Field R4 := Shift; ATE[15:12] r6 := r6 and 170000; r6 - r2; ErrorType := 102, if neq goto(ErrorExit); ! 116-Upper 4 Bi ! pick up the field R4 - R3; ! should be the same ErrorTypet Test failed Ma := 100, Store2; ! now try to pick them up with MDX 0; r3;  := 125, if Neq Goto(ErrorExit); ! 135-Field didn't work R3, Field(0,4); ! do it again c MA := 100, Fetch2; R4 := MDI; ! Make sure MDX or R4 gets good results onstant(DspTst,5000); R4 := Shift, Dispatch(DspTst); ! save results, Dispatch ErrorType := 126, R4 := MDX or R4; R6 := not UState(r4); r6 := r6 and 170000; r6 - r2; ErrorType := 103, if n Goto(ErrorExit); ! 136-Dispatch did not jump C19No: ErrorType := 42, Goto(ErrorExit); ! 084-C19 jumped w( 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( st,14), R2 := 14, Goto(DspChk); Case(DspTst,15), R2 := 15, Goto(DspChk); Case(DspTst,16), R2 := 16, Goto(DspChk); Case(ErrorExit); ! 125-Fetch2 test failed Fet2AErr: ErrorType := 114, GoTo(ErrorExit); ! 126-Store2 test failed DspTst,17), R2 := 17, Goto(DspChk); ! ! The error routines. ! ErrorExit: etmp := ErrorType, Call(SetDDS); ! NOerr: ErrorType := 115, GoTo(ErrorExit); ! 127-NextOp test failed FSOvlpErr: ErrorType := 116, GoTo(ErrorExit); save error code if ByteSign goto(Busted); ! if started via boot R370 := ErrorReturn, GoTo(Br ! 128-Fetch/Store Overlap failed ! ! Set up the interrupt vectors. ! VecInt: Vector(Z80Int); eakPoint); ! if started via ODTPRQ SetDDS: etmp := etmp + DDSoffset; ! DDS starts at 30 Err ! Service interrupts Z80Int: IOB(106),return, Loc(5300); ! If Z80 Interrupts, read register to dismiLp: StackReset, ecnt := 10; ! increment DDS ErrWt: ecnt := ecnt - 1, if neq goto(ErrWt); ! but noss it BadInt1: ErrorType := 117, GoTo(ErrorExit), Loc(5304);! 129-Bad Interrupt loc 4 DskInt: 0, IOB(301),return, Loc(5310t to quickly etmp := etmp - 1; ! how many incrs do we need if neq goto(ErrLp); ); ! If Dsk Interrupts, function:=0 to dismiss BadInt3: ErrorType := 120, GoTo(ErrorExit), Loc(5314);! 130-Bad  TestContinue, return; ! return Switch Reg on R Busted: goto(busted); Interrupt loc 14 BadInt4: ErrorType := 121, GoTo(ErrorExit), Loc(5320);! 131-Bad interrupt loc 20 DpyInt: dpytmp, Iob(343 ! Loop for a long time. MemErr: ErrorType := 123, GoTo(ErrorExit); ! 133-Memory Error on No Dual Addr Test ), Loc(5324); ! load vidstate !tmp := 6000, Loc(6324); dpytmp, Iob(340); ! l MemErrI: ErrorType := 124, GoTo(ErrorExit); ! 134-Mem Error on No Dual Adr Invert MemErr4: ErrorType := 105, GoTo(Eoad line count Dpy1: 0, Iob(342); ! cursor address dpycnt := dpycnt - 1; rrorExit); ! 119-Dual Addr/Fetch4 test failed Refill: ErrorType := 106, GoTo(ErrorExit); ! 120-Unexpected redpytmp := 102000, if Gtr Return; dpycnt; dpytmp := 101154, if Eql Return; dpytmp := 101351; ,3), R2 := 3, Goto(DspChk); Case(DspTst,4), R2 := 4, Goto(DspChk); Case(DspTst,5), R2 := 5, Goto(DspChk); Case(DspTst,6fill BpcErr: tmp := tmp + 1; ErrorType := 107, GoTo(ErrorExit); ! 121-BPC test failed Fet4Err: ErrorTyp), R2 := 6, Goto(DspChk); Case(DspTst,7), R2 := 7, Goto(DspChk); Case(DspTst,10), R2 := 10, Goto(DspChk); Case(DspTst,1e := 110, GoTo(ErrorExit); ! 122-Fetch4 test failed Fet4RErr:ErrorType := 111, GoTo(ErrorExit); ! 123-Fetch4R1), R2 := 11, Goto(DspChk); Case(DspTst,12), R2 := 12, Goto(DspChk); Case(DspTst,13), R2 := 13, Goto(DspChk); Case(DspT test failed Str4RErr:ErrorType := 112, GoTo(ErrorExit); ! 124-Store4 test failed Fet2Err: ErrorType := 113, GoTo()  ! 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 )  0, Iob(341); ! screen address 0, Iob(344); ! cursor  153 - Hard Disk Restore Failure ! 154 - No such boot ! 155 - No interpreter for that key ! 156 - No system for thax dpycnt := 11, Goto(Dpy1); BadInt6: ErrorType := 122, GoTo(ErrorExit), Loc(5330);!132-Bad interrupt loc 3t key ! 157 - Disk Error ! 158 - Floppy error ! 159 - Malformed Boot File ! 160 - CheckSum error in microcode !0 ParInt: ParityHit := 1, Loc(5334); IOB(147); ! Read 161 - CheckSum error in QCode ! 162 thru 168 - Bad interrupts ! this code sets the DDS to 198 on exit ! ! 2 May 81 Parity error register ParityErr := IOD, Return; END;  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 to cylinder 0. ! 25 Apr 81 V2.2 JPS Fix bug in hard disk seek code -- it wasn't waiting for ! the seek to finish. ! 24 Mar 81 V2.1 JPS Change DIBDA to 40 for new file system. place(7000,7777); ! Boot Loads into the upper! SysB - Perq System Loader ! V1.0 Brian Rosen - Three Rivers Computer Corporation ! V2.0 George Robertson - Carnegie-Mell 2k of microstore define(r0,0); define(c400,1); define(BootID,2); define(BootKey,3); define(c1777,4); define(data,5); defon University ! ! SysB starts by turning off the Z80 (in case a floppy boot was in ! progress). ! It then reads the boot id ine(Bite,6); define(BigDly,7); define(Boot1st,10); define(Interp1st,11); define(TryCnt,12); define(NextDA,13); define(Savefrom the keyboard (lower case alphabetics are ! hard disk boots, upper case alphabetics are floppy boots). ! The default boot MA,14); define(Cyl,15); define(NewCyl,16); define(SeekCnt,17); define(Dir,20); define(Head,21); define(tmp,22); define(Seis 'a'. ! Start by reading microcode and loading it into the lower 3.75k of microstore. ! Then load system qcode. ! Then storc,23); define(SecCnt,24); define(Dly,25); define(KeyTryCnt,26); define(DskType,27); define(CylHd,30); define(MemAdr,31); e disk id (0 or 1) and keystroke into the 4th and 5th words ! of the SIT table. ! Then start microcode at QCode entry point, 2define(CkSum,32); define(Offset,33); define(ByteCnt,34); define(NextCyl,35); define(NextSec,13); ! Note Same as NextDA de400. ! ! This code is loaded by Boot, The Prom Bootstrap Loader ! ! The Diagnostic Display is set to 150 when this code is efine(Word,36); define(LastHead,37); define(LastCyl,40); define(BootCyl,41); define(BootSec,10); ! Notentered ! Errors are: ! 150 - Sysb not loaded correctly ! 151 - Sysb did not complete ! 152 - Illegal Boot Key !  same as Boot1st define(InterpCyl,42); define(InterpSec,11); ! Note same as Interp1st define(IsFloppy,43)*  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 ! *  in Disk Information Table for BootTable and InterpTable constant(BootTableOffset,10#10); ! Must agree with DiskIO.P ! Boot keystroke BootID := Bite; ! BootID is index BootID := BootID - 101; ! subtas constant(InterpTableOffset,10#62); SysbStart: Data := 0, StackReset,Loc(7000); ! Increment the Diagnostic Displract ASCII for "A" BootID - 31, if lss goto(Busted); ! ID out of range if leq goto(FlopBoot); ! Uppay C400 := 400; ! A constant used many times C1777 := 1777; tmp := 6000; er case => Floppy Boot BootID := BootID - 40; BootID - 31, if lss goto(Busted); if gtr goto(Busted); ; define(LastAdr,44); ! end of system qcode constant(dstat,100); constant(dseek,301); constant(dhead,302); constant( tmp, IOB(343); ! shut off video interrupts ThreeWayBranch(0); ! Make sure 2910 stacCylSec,310); constant(FileL,311); constant(FileH,312); constant(Block,313); constant(CWadrL,331); constant(CWadrH,321); cok is empty ThreeWayBranch(0); ! We turn the Z80 off for 2 reasons ! First, the hardware has a glitch when first stanstant(DatAdrL,330); constant(DatAdrH,320); constant(DirOut,0); constant(DirIn,10); constant(DIBDA,40); rting up the Writable ! Control Store ram, the power surge can screw up the Z80. ! Secondly, we want to shut off the floppy bo ! Disk Information Block disk addr constant(StTrack,0); constant(StHead,0); constant(DIBCyl,5); ! Dot sequence if it had started KeyTryCnt := 2, Call(Z80Off); ! Wait a while for key isk Info Block cylinder on Floppy constant(DIBSec,3); ! Disk Info Block sector on Floppy constant(SITInf ! Shut down Z80 to stop boot Call(WaitAWhile); ! Delay a few milliseconds KeyRetry: 0, IOo,406); ! The SAT/SIT table is 1st, followed by the cursor, ! and together, all are 3000 octal long constant(SatSitCursB(301); ! turn Z80 on Cyl := 0, Call(WaitAWhile); ! Let it start up ! ! Read keyboLen,3000); constant(EndSatSitCursSec,6); ! SatSitCursLen / #400 ! the screen image is 1024 lines of (768/16) worard bite := 1, Call(KeysOnOff); ! Turn Keyboard on FindCh: Call(RecZ80Byte); ! Wait for keyboads or 48k ! it starts after the SAT/SIT table constant(ScreenLen,140000); constant(EndScreenP1,143000); ! end ord char Bite - 153, if neq goto(NoKeys); IsFloppy := 0, if neq goto(FindCh); Call(RecZ80Byte); f screen + 1 = SatSitCursLen + ScreenLen ! ! For Spice boots, the microcode is loaded after the system qcode and ! is 3.75* Bite - 1, if neq goto(FindCh); ! Keyboard char prefix TryCnt := C400, if neq goto(FindCh); Call(RecZ80By3 long constant(UCodeSize,26400); constant(sysbDDSdif,10#47); ! What to add to DDS on good exit ! ! Offsette); tmp := 10#152, if neq goto(FindCh);! preset error code for Illegal boot BootKey := Bite; + $Title Expression stack and memory stack operators. ! Opcode REPL. !------------------------------------------------------- ! Calls: ! StkOv ! !----------------------------------------------------------------------------- Opcode(MM---------------------- ! ! Abstract: ! REPL is a one byte opcode that replicates the top word on the ! expressioS), SL - TP; tmp11 := 1, if C19 Goto(StkOv); ! if not enough room on the stack TP := TP + 1, Store; n stack. ! ! Instruction: ! REPL ! ! Environment: ! (Tos) = Value. ! ! Result: ! Stack pushed. !  Tos, Pop, NextInst(0); ! move the value ! Opcode MMS2. !------------------------------------------------- (Tos) = Value. ! (Tos-1) = Value. ! !----------------------------------------------------------------------------- ---------------------------- ! ! Abstract: ! MMS2 is a one byte opcode that moves two values from the expression !  Opcode(REPL), Tos := Tos, Push, NextInst(0); ! Opcode REPL2. !----------------------------------------------------------- stack to the memory stack. ! ! Instruction: ! MMS2 ! ! Environment: ! (Tos) = Value0. ! (Tos-1) = Va------------------ ! ! Abstract: ! REPL2 is a one byte opcode that replicates the top two words on the ! expresslue1. ! ! Result: ! Stack popped twice. ! Memory stack pushed twice. ! Memory[TP] = Value1. ! Memoion stack. ! ! Instruction: ! REPL2 ! ! Environment: ! (Tos) = Value0. ! (Tos-1) = Value1. ! ! Resultry[TP-1] = Value0. ! ! Calls: ! StkOv. ! !---------------------------------------------------------------------------: ! Stack pushed twice. ! (Tos) = Value0. ! (Tos-1) = Value1. ! (Tos-2) = Value0. ! (Tos-3) =-- Opcode(MMS2), SL - TP; tmp11 := 1, if C19 Goto(StkOv); ! if not enough room TP := TP + 1, Store;  Value1. ! !----------------------------------------------------------------------------- Opcode(REPL2), tmp := Tos, Pop;  Tos, Pop; ! move Value 0 TP := TP + 1, Store; Tos, Pop, NextInst(0);  ! store in last ACB tmp, Call(RetExit); ! set PC to exit point Goto(RefillJmp);  tmp1 := Tos; Tos := tmp, Push; Tos := tmp1, Push; Tos := tmp, Push, NextInst(0); ! Opcode ! continue at exit address $NoList  MMS. !----------------------------------------------------------------------------- ! ! Abstract: ! MMS is a one byte opcode that moves a value from the expression ! stack to the memory stack. ! ! Instruction: ! MMS ! ! Environment: ! (Tos) = Value. ! ! Result: ! Stack popped. ! Memory stack pushed. ! Memory[TP] = Value. !+ t some time iob(dstat); ! Get the disk status r0 := iod; r0 and tmp, return; if eql goto(Busted);! No boot for that key BootID + InterpTableOffset, Fetch2; ! Get DA of Interpreter InterpS ! Test the bit and return ! ! Wait long enough for a sector to transfer, a head to settle, etc WaitAWhile: Dlec := MDI; ! Interp1st overlaps InterpSec InterpCyl := MDI; ! Must be 0 when Hard Disk y := 77777; WaitLp: if eql return; Dly := Dly - 1, goto(WaitLp); ! ! Here when we didn't see a keystroke NoKeis on InterpSec + InterpCyl; tmp := 10#155, if eql goto(Busted);! No interpreter for that key ! ! ys: KeyTryCnt := KeyTryCnt - 1; ! Try it a few times if gtr goto(KeyRetry); ! give the Z80 another chaLoad system qcode first MemAdr := 0; NextCyl := BootCyl; NextSec := BootSec; SecCnnce BootKey := 141; BootID := 0, goto(GotID); ! Default boot is 'a' ! ! Send a keyboard status chat := 0; TryCnt := 10, Call(DoOneBlock); ! Skip over segment hdr blk NextCyl + NextSec; tmp := 10#15nge message to Z80 KeysOnOff: tmp := 153, Call(SndZ80Byte); ! Start of message tmp := 007, Call(SndZ80Byte); 9, if eql goto(Busted);! Malformed boot file DoNextBlock: SecCnt - EndSatSitCursSec; ! Are we at end of Sat/Sit tab GotID: bite := 0, Call(KeysOnOff); ! Turn keyboard off ! !Position the heads Restore:tmp := 20; ! Set Keyboard Status tmp := 001, Call(SndZ80Byte); ! One byte bite, IOB(307), return; ! 0 = Off ! in WaitABit, the Track 0 bit Dir := DirOut, Call(Seek); ! Go back one step TryCnt := TryCnt - 1, 1 = On ! ! Read Disk Information Block ReadDIB: MemAdr := 0; ! Read into memory 0 - 377, if neq goto(ReadDIB); ! Keep trying tmp := 10#153, if gtr goto(Restore); goto(Busted); ! NextCyl := DIBCyl; IsFloppy; NextSec := DIBSec, if neq goto(RdDib1); NextDA := DIBDA;  busted if Restore failed ! ! Seek the disk One track in dir direction Seek: Dir or 27, iob(dseek);  ! NextDA overlaps NextSec NextCyl := 0; ! Must be 0 when Hard Disk is on RdDib1: Try ! Set the step bit + dir bit + reset Dly := C1777, Call(WaitLp); ! Make a pulse Dir, iob(dseek); Cnt := 10, Call(DoOneBlock); ! Read the DIB BootID := BootID + BootID; ! Get DA of Boot, 2 words/entry  ! Clear the step bit ! Fall into WaitABit  BootID + BootTableOffset, Fetch2; ! Offset to BootTable BootSec := MDI; ! Boot1st overlaps BootSec  ! Assumes Seek Complete Happens ! ! Wait for a bit to come up WaitABit: Call(WaitAWhile); ! Wai BootCyl := MDI; ! Must be 0 when Hard Disk is on BootSec + BootCyl; tmp := 10#154, , stract: ! MES is a one byte opcode that moves a value from the memory ! stack to the expression stack. ! ! Instr VectSrv. ! !----------------------------------------------------------------------------- ! Opcode EXCH2. !-----------uction: ! MES ! ! Environment: ! Memory[TP] = Value. ! ! Result: ! Memory stack popped. ! Stack ------------------------------------------------------------------ ! ! Abstract: ! EXCH2 is a one byte instruction thatpushed. ! (Tos) = Value. ! !----------------------------------------------------------------------------- Opcode(MES exchanges the top two pairs ! of values on the expression stack. ! ! Instruction: ! EXCH2 ! ! Environment: !), TP, 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)---------------------------------------------------------------------- ! ! Abstract: ! MES2 is a one byte opcode that m = Word2. ! (Tos-1) = Word3. ! (Tos-2) = Word1. ! (Tos-3) = Word2. ! ! Calls: ! VectSrv. ! !----oves two values from the memory ! stack to the expression stack. ! ! Instruction: ! MES2 ! ! Environment: ! ------------------------------------------------------------------------- Opcode(EXCH), tmp := Tos, Pop; tmp1 := Tos Memory[TP] = Value0. ! Memory[TP-1] = Value1. ! ! Result: ! Memory stack popped twice. ! Stack pushe, if IntrPend Call(VectSrv); Tos := tmp; Tos := tmp1, Push, NextInst(0); Opcode(EXCH2), tmp := Tos, Pop; d twice. ! (Tos) = Value1. ! (Tos-1) = Value0. ! !-------------------------------------------------------------- tmp1 := Tos, Pop; tmp2 := Tos, Pop; tmp3 := Tos, if IntrPend Call(VectSrv); Tos := tmp1; --------------- Opcode(MES2), TP, Fetch; TP := TP - 1; Tos := Mdi, Push; ! move Value 0  Tos := tmp, Push; Tos := tmp3, Push; Tos := tmp2, Push, NextInst(0); ! Opcode LDTP. !---------------- TP, Fetch; TP := TP - 1; Tos := Mdi, Push, NextInst(0); ! move Value 1 ! Opcode EXCH. !---------------------------------------------------------------- ! ! Abstract: ! LDTP is a one byte instruction that loads-------------------------------------------------------------------------- ! ! Abstract: ! EXCH is a one byte instructi the memory stack top ! pointer onto the expression stack. The pointer that is loaded is ! actually a pointer to on that exchanges the top two values on ! the expression stack. ! ! Instruction: ! EXCH ! ! Environment: ! the next free word of the memory stack. ! ! Instruction: ! LDTP ! ! Result: ! Stack pushed. ! (Tos) = T ! move Value 1 ! Opcode MES. !----------------------------------------------------------------------------- ! ! Ab (Tos) = Word 0. ! (Tos-1) = Word1. ! ! Result: ! (Tos) = Word1. ! (Tos-1) = Word0. ! ! Calls: ! , a CkRest: MemAdr := MemAdr - 1, Fetch; Cksum, if C19 goto(LdMic); ! if MemAdr < 20-bit zero MemAdr := um it and put it into wcs ! *** NB: The rest of sysb (and all that it calls) must be above 7377 DoCSum: MemAdr := LMemAdr - EndScreenP1; Cksum := MDI + CkSum; MemAdr - 1; if C19 goto(SastAdr, goto(CkMic); ! necessary to cross page boundary CkMic: MemAdr := MemAdr + UCodeSize, loc(7400); CkSum := kpScr); ! if MemAdr = EndScreenP1 MemAdr := MemAdr + EndScreenP1; goto(CkRest); ! Load0, LoadS(7377), loc(7401); wd0: Cksum := Cksum + Data, Call(NextData), loc(7402); WCShi, if true GotoS(wd1), loc(74 interpreter microcode ! Will load all data from microcode file, but ASSUMES that it is 3.75k ! (or 45 blocks) long. LdMic:03); wd1: Cksum := Cksum + Data, Call(NextData), loc(7404); WCSmid, if true GotoS(wd2), loc(7405); wd2: Cksum : tmp := 10#161, if neq goto(Busted); ! Checksum error in Qcode MemAdr := LastAdr; ! load 3.75k of Uco= Cksum + Data, Call(NextData), loc(7406); WCSlow, if true GotoS(wd3), loc(7407); wd3: Repeat(wd0), loc(7410); de in hi memory NextSec := InterpSec; NextCyl := InterpCyl; TryCnt := 10, Call(DoOneBlock); ! Ski Cksum := Cksum + Data, loc(7411); tmp := 10#160, if neq goto(Busted), loc(7412); ! CkSum Err in Microcode! p over segment hdr blk NextSec + NextCyl; tmp := 10#156, if eql goto(Busted); ! No system for that key  CkDone: MemAdr := SITInfo, loc(7413); MemAdr, Store2, loc(7414); ! Store harddisk=0 and keystroke IsF DoNextIB: TryCnt := 10, Call(DoOneBlock); NextSec + NextCyl; MemAdr := MemAdr + C400, if neq goto(DoNextIBloppy, loc(7415); BootKey, loc(7416); tmp := sysbDDSdif, Call(SetDDS), loc(7417); ! Good load (we hope) ); ! Chain until 00 ! Clear the rest of the microcode image. Clear: tmp := MemAdr; tmp := tmp - LastAdr;  Call(Z80Off), loc(7420); ! shut off disk and Z80 ThreeWayBranch(0), loc(7421); ! Make sure 2910 stack le if neq goto(NotEndSS); MemAdr := MemAdr + ScreenLen; ! Bypass screen area NotEndSS: TryCnt : tmp - UCodeSize; if C19 Goto(Cl1); ! if (MemAdr - LastAdr) < UCodeSize Goto(Seek0); = 10, Call(DoOneBlock); SecCnt := SecCnt + 1; NextCyl + NextSec; MemAdr := MemAdr + C400, if neq goto ! if (MemAdr - LastAdr) >= UCodeSize Cl1: MemAdr, Store; 0; MemAdr := MemAdr + 1, Goto(Clea(DoNextBlock); ! Got system boot, checksum it, then load interpreter LastAdr := MemAdr; r); ! Seek to cylinder 0 (if booted from hard disk). Seek0: IsFloppy; Cksum := 0, if Neq Goto(DoCSum);  ! save end address Cksum := 0, goto(CkRest); SkpScr: MemAdr := SatSitCursLen; ! skip over the screen are! if booted from floppy do checksum NextDA := 0, Call(HardSeek); ! seek to cylinder 0 ! Got interpreter, checks-  ! instruction is two bytes long if ByteSign goto(ATPB2); ATPB1: TP := TP + tmp, if IntrPend ---------------------------------------------------------------------- ! Opcode TLATE1. !-----------------------------------Call(VectSrv); SL - TP; if C19 Goto(ATPErr); NextInst(0); ! Sign-extend a byte. ATPB2: t------------------------------------------ ! ! Abstract: ! TLATE1 is a one byte instruction that translates a virtual P - SB + 1 = Memory stack top pointer as offset from ! stack base. ! !---------------------------mp := tmp or not 377, Goto(ATPB1); Opcode(ATPW), tmp := Tos and AllOnes; tmp11 := 1, ! inst-------------------------------------------------- Opcode(LDTP), Tos := TP - SB, Push; Nop; ruction is one byte long if Lss goto(ATPW2); ATPW1: TP := TP + tmp, if IntrPend Call(VectSrv); S !***** MAB Tos := Tos + 1, NextInst(0); ! Opcode ATPB. !--------------------------------------------------L - TP; if C19 Goto(ATPErr); Pop, NextInst(0); ! Sign-extend a word. ATPW2: tmp := tmp or SignXtn--------------------------- ! ! Abstract: ! ATPB is a two byte instruction that adds a value in the range ! -128d, Goto(ATPW1); ! Stack overflow, undo the ATPx. ATPErr: TP := TP - tmp, goto(StkOv); $Title TLATEx, STLA..127 to the memory stack top pointer. ! ! Instruction: ! ATPB ! ! Result: ! N words pushed on the memoTE - Virtual address translation. ! Opcode TLATE0. !-----------------------------------------------------------------------ry stack (TP = old TP + N). ! ! Calls: ! VectSrv, StkOv. ! !--------------------------------------------------------------- ! ! Abstract: ! TLATE0 is a one byte instruction that translates a virtual ! address to a physical addres-------------------- ! Opcode ATPW. !----------------------------------------------------------------------------- ! ! Abss. If the segment is not resident, ! a segment fault is signalled. A TLATE0 instruction that succeeds ! is indivtract: ! ATPW is a two byte instruction that adds a value in the range ! -32768..32767 to the memory stack top poiisible from the instruction that immediately follows it. ! ! Instruction: ! TLATE0 ! ! Environment: ! (Tos) = nter. ! ! Instruction: ! ATPW ! ! Enivronment: ! (Tos) = N. ! ! Result: ! Stack popped. ! N woOffset part of virtual address. ! (Tos-1) = Segment part of virtual address. ! ! Result: ! Stack popped. ! rds pushed on the memory stack (TP = old TP + N). ! ! Calls: ! VectSrv, StkOv. ! !----------------------------------- (Tos) = Physical address corresponding to the virtual address ! (Segment,Offset). This physical address is rep------------------------------------------ Opcode(ATPB), tmp := NextOp; ! N tmp11 := 2, resented ! as an offset from stack base. ! ! Calls: ! VectSrv, SegFault, RefillIndivisible. ! !--------  ThreeWayBranch(0), loc(7425); goto(2400), loc(7426); ! Enter QCode ucode ! !Get a word ou ! Memory address register r0 := UState(MemAdr); r0 and 10000; ! Check bit 16 of MemAdr t of memory to load into microstore NextData: MemAdr := MemAdr - 1, Fetch, loc(7440); ! Decr addr and get that word if eql goto(MemHi); ! if bit 16 is set not 0, IOB(DatAdrH); ! Stash data in low memor Data := MDI, Return, loc(7441); ! Data goes on R ! ! Here when we have to give up Busy DoRead: 2, IOB(dseek); ! Read it baby WaitBusy: IOB(dstat); ! pick up disk ted: tmp := tmp - 10#151, Call(SetDDS), loc(7450); Sleep: GoTo(Sleep), loc(7451); ! Loop forever ! ! Setcontroller status r0 := IOD and 7; ! get state machine state r0 xor 7;  Diagnostic Display SetDDS: Dly := 10, StackReset, loc(7460); ! Increment display DDSWt: if eql goto(DDSWt1), loc( ! code 7 is busy if neq goto(WaitBusy); ! wait until disk is busy Dly := 177777; 7461); ! wait 8 cycles Dly := Dly - 1, goto(DDSWt), loc(7462); DDSWt1: tmp := tmp - 1, loc(7463); if ! Don't wait forever WtDone: nop; nop; nop; IOB(dstat); ! Check d neq goto(SetDDS), loc(7464); return, loc(7465); ! ! Turn Z80 Off Z80Off: 200, IOB(301), loc(7500); oneness r0 := IOD and 7; ! Code 7 is busy Dly := Dly - 1, if eql goto(IsDone); ! Code 0 is do ! shut off disk and Z80 0, IOB(307), loc(7501); ! shut off Z80 output interrupts IOB(106), locne, Keep trying if neq goto(WtDone); ! Until you find it 47, IOB(dseek); ! If y(7502); ! dismiss Z80 input interrupt IOB(147), return, loc(7503); ! dismiss memory parity interrupt ou dont, Reset the disk Call(WaitAWhile); ! Let that work TryCnt := TryCnt - 1; tmp : ! ! Read one Spice Segment Block from hard disk into memory DoOneBlock: IsFloppy; if neq goto(FDoOneBlock); = 10#157, if leq goto(Busted); ! I give up GoTo(DoOneBlock); ! Try it again IsDone: 0, IO Call(HardSeek); ! seek to right cylinder NextDA, IOB(CylSec); ! Physical header data B(dseek); ! Clear disk and done SaveMA := MemAdr; MemAdr := 177002; ! NextA NextDA, Field(5,3); ! Pick off head bits Shift, IOB(dhead); ! head number dr is at 376004 MemAdr := MemAdr + MemAdr, Fetch; ! Pick it up NextDA := MDI; ! Chain to neis empty ThreeWayBranch(0), loc(7422); ThreeWayBranch(0), loc(7423); ThreeWayBranch(0), loc(7424);  0, IOB(CWAdrL); ! Label is at 376000 not 1, IOB(CWAdrH); MemAdr xnor C1777, IOB(DatAdrL); .  If the segment is not resident, ! a segment fault is signalled. A TLATE2 instruction that succeeds ! is indivis specifies the depth of the Segment part of the second virtual ! address prior to any stack alteration. A depth of ible from the instruction that immediately follows it. ! ! Instruction: ! TLATE2 ! ! Environment: ! (Tos) = Wo0 indicates ! that no translation is to be done, and the maximum depth allowed ! is 7. This allows translation ofrd0. ! (Tos-1) = Word1. ! (Tos-2) = Offset part of virtual address. ! (Tos-3) = Segment part of virtual add one or two virtual addresses ! which may be deeper in the stack than those translated by ! TLATE0, TLATE1, and TLress. ! ! Result: ! Stack popped. ! (Tos) = Word0. ! (Tos-1) = Word1. ! (Tos-2) = Physical addressATE2. ! ! Instruction: ! STLATE Lower,,Upper ! ! Environment: ! (Tos) = Word0. ! (Tos-1) = Word1. !  corresponding to the virtual address ! (Segment,Offset). This physical address is represented !  ... ! (Tos-Upper+2) = WordUpper-2. ! (Tos-Upper+1) = UpperOffset. ! (Tos-Upper) = UpperSegment. ! ! address to a physical address. If the segment is not resident, ! a segment fault is signalled. A TLATE1 instruc as an offset from stack base. ! ! Calls: ! VectSrv, SegFault, RefillIndivisible. ! !-----------------------------tion that succeeds ! is indivisible from the instruction that immediately follows it. ! ! Instruction: ! TLATE1 ------------------------------------------------ ! Opcode STLATE. !--------------------------------------------------------- ! ! Environment: ! (Tos) = Word. ! (Tos-1) = Offset part of virtual address. ! (Tos-2) = Segment part of -------------------- ! ! Abstract: ! STLATE is a two byte instruction that translates one or two ! virtual addrevirtual address. ! ! Result: ! Stack popped. ! (Tos) = Word. ! (Tos-1) = Physical address corresponding tsses to physical addresses. If either segment ! is not resident, a segment fault is signalled. An STLATE ! instro the virtual address ! (Segment,Offset). This physical address is represented ! as an offsetuction that succeeds is indivisible from the instruction ! that immediately follows it. ! ! The depth of the virt from stack base. ! ! Calls: ! VectSrv, SegFault, RefillIndivisible. ! !---------------------------------------------ual addresses in the expression stack ! is represented by two four-bit fields in the operand byte. ! The lower fou-------------------------------- ! Opcode TLATE2. !-------------------------------------------------------------------------r bits of the operand byte specifies the depth ! of the Segment part of the virtual address which is closest ! to ---- ! ! Abstract: ! TLATE2 is a one byte instruction that translates a virtual ! address to a physical address.the top of the expression stack (call this one the first ! virtual address). The upper four bits of the operand byte ! .  if neq goto(WaitSeek); Return; ! all done ! ! Receive a character from theheads IsFloppy := 001, IOB(307); ! Z80 interrupts enabled Call(Flush); ! Ignore st Z80 RecZ80Byte: BigDly := 77777; ! 32k*(64*2)=4.2M cycles waitbyte: if intrpend Vector(Z80Int); ! * .0001atus returned GoTo(ReadDib); ! ! Read one Spice Segment Block from floppy into memory FDoOnext DiskAddress MemAdr := SaveMA, return; MemHi: not 1, IOB(DatAdrH); ! Stash data in high memory 7 ms/cycle = .7 sec Dly := 100, call(WaitLp); BigDly := BigDly - 1; if neq goto(waitbyte); 1 goto(DoRead); ! ! Seek to NextDA (if necessary). HardSeek: NextDA, Field(10,10); ! pick off upper byte , return; ! return neq if time out Z80Int: iob(106), loc(7100); ! Here when Z80 s NewCyl := Shift; ! Thats the cylinder SeekCnt := NewCyl; ! Compute distance toends a byte Bite := iod and 377; ! pick up byte 0, return; ! return eql  it SeekCnt := SeekCnt - Cyl; ! as Desired - Current position if eql Return, ! if a ! ! All other interrupts are verboten BadInt1: tmp := 10#162, goto(Busted), loc(7104); BadInt2: tmp := 10#163, glready there SeekCnt; ! check direction Dir := DirIn, if gtr goto(DoSeek); ! if positoto(Busted), loc(7110); BadInt3: tmp := 10#164, goto(Busted), loc(7114); BadInt4: tmp := 10#165, goto(Busted), loc(7120); Badive, Direction is in Dir := DirOut; ! if negative, direction is out SeekCnt := Cyl; Int5: tmp := 10#166, goto(Busted), loc(7124); BadInt6: tmp := 10#167, goto(Busted), loc(7130); BadInt7: tmp := 10#168, goto(Bu ! recompute a positive difference SeekCnt := SeekCnt - NewCyl; DoSeek: Dir, IOB(dseek); sted), loc(7134); ! ! Send a character to the Z80 SndZ80Byte: tmp, IOB(307); goto(WaitAWhile); FlopBoot: bite ! Tell disk to seek the right way tmp := 153, Call(SndZ80Byte); ! Tell Z80 to do it tmp := 010, Ca := 0, Call(KeysOnOff); ! Turn keyboard off Data := 0; LastCyl := 0; LastHead := 0; ! ll(SndZ80Byte); ! Seek Command tmp := SeekCnt, Call(SndZ80Byte); ! How many tracks Cyl := NewCyl; Set single density, 2 sides, Z80 interrupts enabled Call(Flush); ! Make sure Z80 in righ ! Now we are at a new track WaitSeek: tmp := 10#157, Call(RecZ80Byte); ! Wait for done Bite - 15t state tmp := 153, Call(SndZ80Byte); tmp := 014, Call(SndZ80Byte); tmp := 003, Call(SndZ80Byte); 3, if neq goto(Busted); if neq goto(WaitSeek); Call(RecZ80Byte); Bite - 12, if neq goto(Busted);  ! Set floppy status tmp := 0, Call(SndZ80Byte); ! Single density tmp := 2, Call(SndZ80Byte); ! 2 / pper+2. ! ... ! (Tos-Lower+3) = WordLower-2. ! (Tos-Lower+2) = Physical address corresponding to the virPC := 10, Call(MakeVictim); ! make a victim tmp2 and 360, Field(4,4); ! select left nibble tual address ! (LowerSegment,LowerOffset). This physical address ! is representedtmp1 := Shift, ! depth of deeper segment if Neq Goto(STLATE1); ! if left nibble is as an offset from stack base. ! ! Calls: ! VectSrv, SegFault, RefillIndivisible. ! !-------------------------------- non-zero tmp1 := tmp2, Goto(STLATE2); ! set equal depths STLATE1:tmp2 := tmp2 and 17; ! dep--------------------------------------------- ! tmp1 = depth of deeper segment number (left nibble). ! tmp2 = deth of shallower segment if Neq Goto(STLATE2); ! if right nibble is non-zero tmp2 := tmp1; pth of shallower segment number (right nibble)--tmp1=tmp2 ! if only one. ! tmp3 = base address of deeper se ! set equal depths STLATE2:tmp1, Field(0,4); tmp6 := 0, Dispatch(TltPop); ! no errors yet gment. ! tmp4 = base address of shallower segment. ! tmp5 = segment number. ! tmp6 = error flag. ! t ! Pop down to deeper segment number. Case(TltPop,7), tmpstk7 := Tos and AllOnes, Pop; Case(TltPop,6), tmpstk6 := Tos mp7 = save BPC. ! tmp10 = offset. ! tmp11 = PC backup count. ! tmp12 = difference of tmp1 and tmp2. and AllOnes, Pop; Case(TltPop,5), tmpstk5 := Tos and AllOnes, Pop; Case(TltPop,4), tmpstk4 := Tos and AllOnes, Pop; Case(TltP Constant(TltPop,2200); Constant(TltSeg,2202); Opcode(TLATE0), tmp1 := 1, Goto(TltStart); ! depth = 1 Opcodeop,3), tmpstk3 := Tos and AllOnes, Pop; Case(TltPop,2), tmpstk2 := Tos and AllOnes, Pop; Case(TltPop,1), tmpstk1 := Tos and Al (Tos-Upper-1) = WordUpper+1. ! (Tos-Upper-2) = WordUpper+2. ! ... ! (Tos-Lower+2) = WordLower-2. (TLATE1), tmp1 := 2, Goto(TltStart); ! depth = 2 Opcode(TLATE2), tmp1 := 3, Goto(TltStart); ! depth = 3 TltStart: tmp1! (Tos-Lower+1) = LowerOffset. ! (Tos-Lower) = LowerSegment. ! ! Result: ! stack popped twice. ! (T1 := 1, if IntrPend Call(VectSrv); ! one byte instruction tmp7 := UState and 17; ! save BPC BPCos) = Word0. ! (Tos-1) = Word1. ! ... ! (Tos-Upper+2) = WordUpper-2. ! (Tos-Upper+1) = Physical a := 10, Call(MakeVictim); ! make a victim tmp2 := tmp1, Field(0,4); ! set equal depths tmp6ddress corresponding to the virtual address ! (UpperSegment,UpperOffset). This physical address !  := 0, Dispatch(TltPop); ! no errors yet Opcode(STLATE), tmp2 := NextOp; ! get STLATE parameter  is represented as an offset from stack base. ! (Tos-Upper) = WordUpper+1. ! (Tos-Upper-1) = WordU tmp11 := 2; ! two byte instruction tmp7 := UState and 17; ! save BPC B/ Z80Byte); Bite and 1, if neq goto(FlopErr); if neq goto(FlopErr); ! Status = error LastCy ! 4th blk hdr at 376044; goto(FGotHdr); FDoNextSec: Sec := Sec + 5; Sec - 10#26; if leq goto(l := Cyl; LastHead := Head; FGotCyl: SaveMA := MemAdr; ! Save address ! Read HeadeFDoit); Sec := Sec - 10#24; FDoit: TryCnt := 10, goto(FDoOneSec); ! ! Read one sector from floppy FDoOneSecrs from sector 1 of current cylinder MemAdr := 177000; ! Put headers sector at 376000 : tmp := 153, Call(SndZ80Byte); tmp := 002, Call(SndZ80Byte); ! Floppy command tmp := Head, Call(SndZ80Byt MemAdr := MemAdr + MemAdr; Sec := 1; TryCnt := 10, Call(FDoOneSec); ! Read four sectors of block e); ! Head and unit tmp := Cyl, Call(SndZ80Byte); ! Cylinder tmp := Sec, Call(SndZ80Byte); ! Sector Sec := NextSec; MemAdr := SaveMA; TryCnt := 10, Call(FDoOneSec); MemAdr := MemAdr  tmp := 1, Call(SndZ80Byte); ! Read floppy command tmp := 1, Call(SndZ80Byte); ! Fake byte count Block: Cyl := NextCyl; ! Cyl = NextCyl mod 77 Cyl := Cyl - 10#77; Head := 4, if geq goto(FGotHead+ 100, Call(FDoNextSec); MemAdr := MemAdr + 100, Call(FDoNextSec); MemAdr := MemAdr + 100, Call(FDoNextSec); ); ! Head = NextCyl div 77 Cyl := NextCyl; Head := 0; FGotHead: Head - LastHead; Cyl - Las ! Set next cylinder and sector NextSec - 3; NextSec - 10#23, if eql goto(Blk0); NtCyl, if neq goto(FDoSeek); if eql goto(FGotCyl); FDoSeek: tmp := 153, Call(SndZ80Byte); tmp := 002extSec - 10#19, if eql goto(Blk1); NextSec - 10#15, if eql goto(Blk2); NextSec - 10#11, if eql goto(Blk3); , Call(SndZ80Byte); ! Floppy command tmp := Head, Call(SndZ80Byte); ! Head and unit tmp := Cyl, Call(Sn if eql goto(Blk4); MemAdr := 177026; ! 5th blk hdr at 376054 FGotHdr: MemAdr := MemAdrdZ80Byte); ! Cylinder tmp := 1, Call(SndZ80Byte); ! Sector tmp := 4, Call(SndZ80Byte); ! Seek  + MemAdr, Fetch2; NextSec := MDI; NextCyl := MDI; MemAdr := SaveMA, return; Blk0: MemAdr := 177command tmp := 1, Call(SndZ80Byte); ! Fake byte count 000, IOB(307); ! Fake data 002; ! 0th blk hdr at 376004; goto(FGotHdr); Blk1: MemAdr := 177006; ! 1st blk hdr a FWtDone: Call(RecZ80Byte); ! Wait for done Bite - 153, if neq goto(FlopErr); if neq gotot 376014; goto(FGotHdr); Blk2: MemAdr := 177012; ! 2nd blk hdr at 376024; goto(FGotHdr); B(FWtDone); Call(RecZ80Byte); Bite - 21, if neq goto(FlopErr); if neq goto(FWtDone); Call(Reclk3: MemAdr := 177016; ! 3rd blk hdr at 376034; goto(FGotHdr); Blk4: MemAdr := 177022; 0  tmpstk0; ! save segment number tmp12 := tmp1, Call(TltTrans); ! translate deeper address = NextOp BMux tmpstk5, Push, if BPC[3] Call(TltAdd); Tos := NextOp BMux tmpstk6, Push, if BPC[3] Call(TltAdd);  tmp3 := tmp4, ! deeper base address if IntrPend Call(VectSrv); tmp1 Tos := NextOp BMux tmpstk7, Push, if BPC[3] Call(TltAdd); Push; ! make an extra push to2 := tmp12 - tmp2, Field(0,4); ! difference in depths BPC := tmp - tmp12, Dispatch(TltSeg); ! BPC is counter for dep undo later ! (is this right?) TltDone:BPC := 0, ReviveVictim; ! undth diff. ! Select shallower segment number. Case(TltSeg,6), tmp5 := tmpstk6, Goto(TltShallow); Case(TltSeg,5), tmp5o victim, this transfers to ! MakeVictim MakeVictim: NextOp, if BPC[3] Return;  := tmpstk5, Goto(TltShallow); Case(TltSeg,4), tmp5 := tmpstk4, Goto(TltShallow); Case(TltSeg,3), tmp5 := tmpstk3, Goto(TltSha ! make or undo the victim, Return ! if we're making the victim BPC :llow); Case(TltSeg,2), tmp5 := tmpstk2, Goto(TltShallow); Case(TltSeg,0), BPC := tmp - tmp1, Goto(TltEnd); ! only one virtual= tmp7, ! restore BPC ;!**** if IntrPend Call(VectSrv); tmp6, Pop;  address TltShallow: tmp5 + tmp5, Fetch2, Call(TltTrans); ! fetch segment table entry TltEnd: tmp6;  ! get rid of extra push if Neq Goto(SegFault); ! if segment fault if BPC[3]  ! check error count if Eql Goto(TltContinue); ! if no segment faults Tos := tmpstk1, Push, Goto(RefillIndivisible); ! if we need a refill NextInst(0); ! continue at next Q-code !  ! restore E-stack on error if IntrPend Call(VectSrv); tmp12 := 0;  Find the base address of a segment. ! ! Environment: ! Fetch2 of segment table entry in the recent pas ! turn off translation BPC := tmp - tmp1, Goto(TltPush); ! BPC is counter for restoration TltCot. ! tmp5 = segment number. ! ! Result: ! tmp4 = base address if the segment is resident. ! ntinue:Tos := tmpstk1 + tmp3, ! translate deeper address ;!**** if IntrPend Call(V tmp6 = 1 if the segment is not resident. TltTrans: Tos := tmp4 := Mdi, Push; ! lower part of base address lOnes, Pop; tmpstk0 := Tos and AllOnes, ! deeper segment number if IntrPeectSrv); ! Push until BPC[3]. TltPush:Tos := NextOp BMux tmpstk2, Push, if BPC[3] Call(TltAdd); Tos := Nextnd Call(VectSrv); tmp := 11; tmpstk0 + tmpstk0, Fetch2; ! fetch segment table entry tmp5 :=Op BMux tmpstk3, Push, if BPC[3] Call(TltAdd); Tos := NextOp BMux tmpstk4, Push, if BPC[3] Call(TltAdd); Tos :0  Word := Bite, if neq goto(FlopErr); Call(RecZ80Byte); if neq goto(FlopErr); Bite, LeftShift(10); It is not possible for the prom to become enabled ! by anything other than pressing the boot button. ! ! This code first  Word := Shift or Word; MemAdr + OffSet, Store; Word; Offset := Offset + 1, repeat(FRdLoop); attempts to verify correct operation of the processor ! at least enough to run the boot loader. Define(R0,0); !De return; FlopErr: tmp := 10#158, goto(Busted); Flush: Call(RecZ80Byte); ! Ignore Z8fine registers with varing bit patterns for addresses Define(R1,1); Define(R2,2); Define(R4,4); 0 data if eql goto(Flush); return; END;  Define(R10,10); Define(R20,20); Define(R40,40); Define(R100,100); Define(R200,200);  Define(R252,252); Define(R277,277); Define(R307,307); Define(R337,337); Define(R350,350); Define(R357,357); Define(R367,367); Define(R373,373); Define(R375,375); Define(R376,376); Define(R377,377); Place(0,777); !Boot code occupies lower 512 locations ! Perq Boot Prom Microcode Version 4 ! Written by Brian Rosen ! Copyright (C) 1981 Three Rivers Computer Corporation, Pi StackReset,Next,loc(0); ! Display 1 - We can execute something SrcRasterOp := 200, Next, loc(1); ! Turn Power Down 000, IOB(307); ! Fake data FWtRead: Call(RecZ80Byte); ! Wait for result ttsburgh PA. ! ! ! This code resides in the 512 microinstruction Boot Prom ! It occupies the low 512 words of the 4k add Bite - 153, if neq goto(FlopErr); if neq goto(FWtRead); Call(RecZ80Byte); Bite - 5, if neq gotoressable Writable ! Microstore. The prom is enabled by the boot button, and ! when enabled, overlaps the bottom 2k of RAM(FlopErr); if neq goto(FWtRead); Call(RecZ80Byte); ! Get status Bite and 1, if neq go. Addresses from ! 512 to 2047 are essentially unused when the prom is on (they are ! actually the Boot prom repeated eveto(FlopErr); if neq goto(FlopErr); Call(RecZ80Byte); ! Get byte count if neq goto(Flory 512 locations. It is possible ! to address the upper 2k of ram from the prom. ! The prom is disabled by executing a LopErr); Offset := 0, LoadS(77); ! Assume 64 words (full sector) FRdLoop: Call(RecZ80Byte); adOp special function. When ! disabled, the prom is not addressable, and the Ram occupies the ! entire 4k address space. 1 ual address tmp10 := Tos and AllOnes, Pop, ! offset if IntrPend Call(Vectith bytes swapped. ! ! Result: ! Stack popped. ! ! Calls: ! Specified address. ! !-------------------------- tmp4 := Mdx or tmp4, ! full base address if Odd Goto(TltTrans1); ! if segmSrv); BPC := tmp - tmp2; ! counter to push remainder of stk Tos := tmp4 + tmp10, Return; ent not resident tmp4 := tmp4 and not 377; ! clear the flags byte tmp4 := tmp4 - SB;  ! base + offset $Title WCS, JCS - Control store operators. ! Opcode WCS. !----------------------------------- ! bias base address by SB tmp5 + tmp5, Store; Tos or 4, Pop, Return; ! set RecentlyUsed in S------------------------------------------ ! ! Abstract: ! WCS is a one byte instruction that writes a single instructiAT TltTrans1: tmp6 := 1, Pop, Return; ! indicate segment fault (***** TltTrans: tmp4 := Mdi and not 376; on ! in the control store. ! ! Instruction: ! WCS ! ! Environment: ! (Tos) = Address with bytes swapped ! lower part of base address tmp4 := Mdx or tmp4, ! full base address i. ! (Tos-1) = High order microstore. ! (Tos-2) = Middle order microstore. ! (Tos-3) = Low order microstore.f Odd Goto(TltTrans1); ! if segment not resident tmp4 := tmp4 - SB, Return; ! bias base address by SB Tlt ! ! Result: ! Stack popped four times. ! Controlstore instruction written. ! !-------------------------------Trans1: tmp6 := 1, Return; ! indicate segment fault *****) ! Add base address and offset of shallower---------------------------------------------- Opcode(WCS), Call(LCA); ! load control store address  virtual address. ! ! Environment: ! tmp12 = 0 if no shallower virtual address to translate. ! i not Tos, Pop; WcsHi, if true GotoS(WCS1); ! write high third WCS1: not Tos, Pop; WcsMid, if tf there is a virtual address to translate: ! tmp4 = base address. ! (Tos) = offset. ! rue GotoS(WCS2); ! write middle third WCS2: not Tos, Pop; WcsLow, if true GotoS(WCS3); ! write low t (Tos-1) = segment number. ! Result: ! if no virtual address to translate, exit to TltDone. ! hird WCS3: NextInst(0); ! Opcode JCS. !----------------------------------------------------------------------------- !  otherwise: ! Expression stack popped. ! (Tos) = base address + offset. ! BPC i ! Abstract: ! JCS is a one byte instruction that jumps to some location in the ! controlstore. A routine called s counter to push the rest of the stack. TltAdd: tmp12; tmp12 := 0, if Eql JumpPop(TltDone); ! if no shallower virtwith JCS should exit via a ! NextInst jump. ! ! Instruction: ! JCS ! ! Environment: ! (Tos) = Address w1 L20), loc(10); ! GoTo increasing bit positions L20: Goto(L30), loc(20); ! verifies Z and J mux L30: Go R1 xor 1; ! try all bits, using different registers R2 := 2, if Neq Goto(DeepEnd); R2to(L40), loc(30); L40: Goto(L100), loc(40); L100: GoTo(L200), loc(100); L200: Goto(L400), loc(200); L400: Goto(L11) xor 2; R4 := 4, if Neq Goto(DeepEnd); R4 xor 4; R10 := 10, if Neq Goto(DeepEnd); R10 xor 10, loc(400); ! Go back to low addresses L11: 177777; ! force non zero alu stuff if Neq Go; R20 := 20, if Neq Goto(DeepEnd); R20 xor 20; R40 := 40, if Neq Goto(DeepEnd); R40 xor 40; to(Good1); ! Does the simplest condition branch work? Bad2: 0, Goto(Bad2); ! Jumps don't work Good1:  R100 := 100, if Neq Goto(DeepEnd); R100 xor 100; R200 := 200, if Neq Goto(DeepEnd); R200 xor 177777; ! Make non zero alu again 0, if Eql Goto(Bad2); ! but this time try an Equal jump  200; if Neq Goto(DeepEnd); R377 := 400; R377 xor 400; if Neq Goto(DeepEnd); R376 : 0, if Eql Goto(good2); ! Try equal jump with a real 0 bad3: 0, Goto(bad3); ! Jumps don't work sub= 1000; R376 xor 1000; if Neq Goto(DeepEnd); R375 := 2000; R375 xor 2000; if Neq Go1: Return; ! Used below as simple subroutine sub2: Call(sub1); ! a two level subroutineto(DeepEnd); R373 := 4000; R373 xor 4000; if Neq Goto(DeepEnd); R367 := 10000; R367 call Return; ! return from 2nd level subr call good2: 1, if Neq Goto(bad3); ! had a 0, s xor 10000; if Neq Goto(DeepEnd); R357 := 20000; R357 xor 20000; if Neq Goto(DeepEnd); houldn't jump on Neq 10, if Eql Goto(bad3); ! make sure every alu chip can detect if Eql Goto(bad3);  R337 := 40000; R337 xor 40000; if Neq Goto(DeepEnd); R277 := 100000; R277 xor 100000;  ! a non zero bit 400; ! alu chips are on 4 bit boundaries if Eql Goto(bad3);  if Neq Goto(DeepEnd); R0 xor 0, StackReset; !Display 3 - simple register read/write works  40000; 0, if Eql Goto(bad3); Call(sub1); ! now try a simple subroutine call Cal !read then back again to check addressing R1 xor 1, if Neq Goto(DeepEnd); R2 xor 2, if Neq Go 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 L10), loc(4); ! Try a simple GoTo bad1: Goto(bad1); ! Unconditional jump didn't jumpr L10: Goto( R0 xor 0; ! try read/write of registers R1 := 1, if Neq Goto(DeepEnd); ! Cant Write a 0 2 stack. ! Memory[TP - 3 + EEBES] = ExceptionSSN. ! Memory[TP - 3 + EEBER] = ExceptionRN. ! Memory[TP - 3 + EHighByteParameterSize ! ! Calls: ! ErrCall, WordParm, XSTMap. ! !----------------------------------------------------EBHR] = HandlerRN. ! Memory[TP - 3 + EEBNE] = OldEP. ! Memory[AP + ACBEP] = NewEP = TP - 3. ! ! Calls: ! ------------------------- Opcode(QRAISE), Call(WordParm); tmp := Shift + tmp; ! ExceptionISN  WordParm, XSTMap, StkOv. ! !----------------------------------------------------------------------------- Opcode(ENABLE),  if Geq Call(XSTMap); ! if not "ALL" tmp2 := NextOp; ! ExceptionRN tmp4tmp4 := TP, Call(WordParm); tmp := Shift + tmp; ! ExceptionISN TP := TP + 4, if Geq Call(XSTM := tmp, Call(WordParm); ! ExceptionSSN tmp3 := Shift + tmp; ! ParameterSize tmp1 := t--------------------------------------------------- Opcode(JCS), Call(LCA); ! load control store addressap); ! if not "ALL" TP := TP and not 3; tmp1 := NextOp; ! ExceptionRN tmp2 :=  GotoS; ! enter control store $Title ENABLE, QRAISE - Exception handling and raiNextOp; ! HandlerRN AP + ACBEP, Fetch; Tos := TP := TP + 3, Push; ! push 4 and sing. ! Opcode ENABLE. !----------------------------------------------------------------------------- ! ! Abstract: ! quad-align SL - TP; tmp3 := Mdi, if C19 Goto(ENABLE1); ! OldEP TP - 3, Store4; tmp;  ENABLE is a six byte instruction which enables an exception handler. ! The exception is identified by an internal seg ! ExceptionISN tmp1; ! ExceptionRN tmp2; ment number and a ! routine number. A negative segment number indicates a handler of ! all exceptions. The handl ! HandlerRN tmp3; ! OldEP Tos := Tos - SB; AP + ACBer is identified by a routine number. ! The handler must be nested immediately inside the current routine, ! must EP, Store; Tos - 3, Pop, NextInst(0); ! NewEP ! Stack overflow. ENABLE1: tmp11 := 5, Pop; be in the same code segment as the current routine, and may not ! be a function. None of these is checked by the ENABLE  ! instruction is 5 bytes TP := tmp4, Goto(StkOv); ! Opcode QRAISE. !----------------------------------instruction. ! ! Instruction: ! ENABLE LowByteExceptionISN HighByteExceptionISN ExceptionRN ! HandlerRN. ------------------------------------------- ! ! Abstract: ! QRAISE is a six byte instruction which raises an exception. ! ! Environment: ! Memory[AP + ACBEP] = OldEP. ! ! Result: ! Four words pushed, quad-aligned, onto the memory  ! ! Instruction: ! QRAISE LowByteExceptionISN HighByteExceptionISN ExceptionRN ! LowByteParameterSize 2 ; R0 xor R373, Call(ChkIt); R0 := 10000; R0 xor R367, Call(ChkIt); R0 := 20000; R0  Goto(DeepEnd); ! 0 or 0 = 0 R0 := R0 or R1, if Neq Goto(DeepEnd); ! 0 or 1 = 1 R0 xor 177777; 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, Calo(DeepEnd); R40 xor 40, if Neq Goto(DeepEnd); R100 xor 100, if Neq Goto(DeepEnd); R200 xor 200, if Nel(ChkIt); R0 := 1, StackReset; ! Display 5 - Y addressing works R0 xor R1, Call(ChkIt); ! an intereq Goto(DeepEnd); if Neq Goto(DeepEnd); R377 xor 400; if Neq Goto(DeepEnd); R376 xor 1000; sting bug can occur in R0 xor R2, Call(ChkIt); ! which Y is busted in such a way that R0 xor R4, Call(ChkI if Neq Goto(DeepEnd); R375 xor 2000; if Neq Goto(DeepEnd); R373 xor 4000; if Neq Gotot); ! because the Y field is both an R0 xor R10, Call(ChkIt); ! address and a constant R0 xor R20, Call(DeepEnd); R367 xor 10000; if Neq Goto(DeepEnd); R357 xor 20000; if Neq Goto(DeepEnd); (ChkIt); ! errors can go undetected R0 xor R40, Call(ChkIt); ! So we check that case here R0 xor R100, C R337 xor 40000; if Neq Goto(DeepEnd); R277 xor 100000; if Neq Goto(DeepEnd); R0 := 1, Stall(ChkIt); ! Since CheckIt uses add R0 xor R200, Call(ChkIt); ! we are also verifing ALU and carries R0 xackReset; ! Display 4 - X addressing works ! read them back again on Y R0 xor R377, Call(ChkIt); R0 xor R376, Call(ChkIt); R0 xor R375, Call(ChkIt); R0 xor R373, Call(ChkIt); or R1; R0 := 2, if Neq Goto(DeepEnd); R0 xor R2; R0 := 4, if Neq Goto(DeepEnd); R0 xor R4;  R0 xor R367, Call(ChkIt); R0 xor R357, Call(ChkIt); R0 xor R337, Call(ChkIt); R0 xor R277, Ca R0 := 10, if Neq Goto(DeepEnd); R0 xor R10; R0 := 20, if Neq Goto(DeepEnd); R0 xor R20; ll(ChkIt); StackReset; ! Display 6 - Constants & Carry propogate works R0 := 0;  R0 := 40, if Neq Goto(DeepEnd); R0 xor R40; R0 := 100, if Neq Goto(DeepEnd); R0 xor R100;  ! now check other alu functions R1 := 177777; R0 and R0; ! 0 and 0 = 0 R0 and R1 R0 := 200, if Neq Goto(DeepEnd); R0 xor R200, Call(ChkIt); R0 := 400; R0 xor R377, Call(ChkIt); , if Neq Goto(DeepEnd); ! 0 and 1 = 0 R1 and R0, if Neq Goto(DeepEnd); ! 1 and 0 = 0 R1 := R1 an R0 := 1000; R0 xor R376, Call(ChkIt); R0 := 2000; R0 xor R375, Call(ChkIt); R0 := 4000d R1, if Neq Goto(DeepEnd); ! 1 and 1 = 1 R1 xor 177777; ! check all bits are 1 R0 or R0, if Neq3  interrupts. ! ! Instruction: ! INTOFF ! ! Result: ! Interrupts-off bit (bit 15) set in UserIntr. ! !-------- Opcode(RASTOP), Goto(RasterOp); ! Opcode LINE. !-------------------------------------------------------------------------------------------------------------------------------------------- Opcode(INTOFF), UserIntr := UserIntr or 100000; ------------ ! ! Abstract: ! LINE is a one byte instruction that draws lines. See the Line ! microcode for comp NextInst(0); ! Opcode STRTIO. !----------------------------------------------------------------------------- ! ! lete documentation. ! ! Instruction: ! LINE ! ! Calls: ! Line microcode. ! !--------------------------------Abstract: ! STRTIO is a one-byte instruction that is used to initiate some I/O ! operation. A device number is on--------------------------------------------- Opcode(LINE), Goto(DrawLine); $Title PSW, PBLK - Process management.  the top of the expression stack, ! and the action is device dependant. Device numbers of the form ! x * 40 + 20  ! Opcode PSW. !----------------------------------------------------------------------------- ! ! Abstract: ! PSW isare reserved for Pascal programs to request special ! actions of the Perq interpreter microcode. For more documentation, the unimplemented process swap instruction. ! ! Instruction: ! PSW ! ! Calls: ! UOP. ! !-------------------! ! see the IO microcode and the SSLR routine. ! ! Instruction: ! STARTIO ! ! Environment: ! (Tos) = De---------------------------------------------------------- Opcode(PSW), Goto(UOP); ! Opcode PBLK. !---------------------mp4, Goto(ErrCall); ! ExceptionSSN $Title INTON, INTOFF, STRTIO - Input/output and interrupts. ! Opcode INTvice number. ! ! Result: ! Stack popped. ! Device dependant action performed. ! ! Calls: ! IO microcodeON. !----------------------------------------------------------------------------- ! ! Abstract: ! INTON is a one byte. ! !----------------------------------------------------------------------------- Opcode(STRTIO), tmp := Tos, Pop;  instruction that turns on Pascal level ! interrupts. ! ! Instruction: ! INTON ! ! Result: ! Interrupts tmp, Field(0,4); Dispatch(StartIO); $Title RASTOP, LINE - Raster-op and line-draw. ! Opcode RASTOP. !---off bit (bit 15) cleared in UserIntr. ! !----------------------------------------------------------------------------- Opc--------------------------------------------------------------------------- ! ! Abstract: ! RASTOP is a one byte instruode(INTON), UserIntr := UserIntr and 77777; NextInst(0); ! Opcode INTOFF. !---------------------------------------ction that performs a Raster-Op memory ! operation. See the RO microcode for complete documentation. ! ! Instruction: -------------------------------------- ! ! Abstract: ! INTOFF is a one byte instruction that turns off Pascal level !  ! RASTOP ! ! Calls: ! RO microcode. ! !-----------------------------------------------------------------------3 eepEnd); ! 73567 + 0 = 73567 R2 xor 73567; if Neq Goto(DeepEnd); R4 := 104210; ! 100f Geq Goto(good6); ! -1 is not geq Goto(DeepEnd); good6: R10, if Geq Goto(DeepEnd); ! a large positive number 0 on all 4 bit boundaries R4 := R4 + 0; ! 104210 + 0 = 0 R4 xor 104210; R4 := R4 + R4, is geq R0, if Geq Goto(good7); ! 0 is leq Goto(DeepEnd); good7: R1, if Leq Goto(good8); ! -1 is leif Neq Goto(DeepEnd); ! cause carries on all alu's R4 xor 10420; ! the right answer is if Neqq Goto(DeepEnd); good8: R10, if Leq Goto(good9); ! large positive is not leq Goto(DeepEnd); good9:  Goto(DeepEnd); R4 := 104211; ! same number plus 1 R2 + R4; ! 011101110111011R0, if Leq Goto(DeepEnd); ! 0 is no carry !********** no worky Perqy ******* logical functions don't set carries  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 N177777; R1 := R1 or R1, if Neq Goto(DeepEnd); ! 1 or 1 = 1 R1 xor 177777; R0 := R0 xnor R0, if Neq eq Goto(DeepEnd); ! 0 - 73567 R0 := R0 xor R4; ! is 104211 R0 := R0 - R4, if Neq Goto(DeepEnd); Goto(DeepEnd); ! 0 xnor 0 = 1 R0 := R0 xor 177777; R0 xnor R1, if Neq Goto(DeepEnd); ! 0 xnor 1 = 0  ! and 0 - 104211 R0 := R0 xor R2; ! is 73567 if Neq Goto(DeepEnd); 1, StackReset;  R1 xnor R0, if Neq Goto(DeepEnd); ! 1 xnor 0 = 0 R1 := R1 xnor R1, if Neq Goto(DeepEnd); ! 1 xnor 1 = 1  ! Display 7 - Alu works R1, if Gtr Goto(good4); ! check all conditional branches we need DeepEnd: Goto(Dee R1 xor 177777; R0 := not R0, if Neq Goto(DeepEnd); ! not 0 = 1 (not a) R0 := R0 xor 177777; pEnd); ! loop forever in the deeeep blue see ChkIt: R0 := R0 + R0, if Neq Goto(DeepEnd); ! This subroutine not R1, if Neq Goto(DeepEnd); ! not 1 = 0 (not a) R1 := not 0; ! not 0 = 1 (not b)used above Return; ! to check constants and alu plus/carry good4: R1 + 1, if Gtr Goto(DeepEnd); R1 xor 177777; R0 := not R1, if Neq Goto(DeepEnd); ! not 1 = 0 (not b) if Neq Goto(DeepEnd);  ! -1 is not greater if Gtr Goto(DeepEnd); ! -1 + 1 is 0 (not Gtr) R10 := 77777;  R2 := 73567; ! 0111 on all 4 bit boundaries R0 := R0 + R0; ! add 0 to 0 (= 0)  ! largest postive number R10 + 1; ! + 1 makes a negative number R0 - 1, if Gtr Goto(good5) R0 := R0 + R2, if Neq Goto(DeepEnd); ! 0 + 73567 = 73567 R0 := R0 xor 73567; R2 := R2 + R0, if Neq Goto(D; ! 0 - 1 is a negative number Goto(DeepEnd); good5: R0, if Gtr Goto(DeepEnd); ! 0 is a GEQ number R1, i4 NOOP. !----------------------------------------------------------------------------- ! ! Abstract: ! NOOP is a one byt Result: ! Diagnostic display incremented. ! ! Calls: ! RunError0. ! ! Side affects: ! The expression se no-operation instruction. ! ! Instruction: ! NOOP ! !--------------------------------------------------------------tack is cleared. ! !----------------------------------------------------------------------------- Opcode(INCDDS), UState an--------------- Opcode(NOOP), NextInst(0); ! Opcode LSSN. !------------------------------------------------------d 1000; if Neq Goto(INCDDS1); ! if E-stack not empty StackReset, Nextinst(0); ! inc----------------------- ! ! Abstract: ! LSSN is a one byte instruction that loads the segment number of the ! merement the DDS INCDDS1: tmp2 := ErrEStk, Goto(RunError0); ! Opcode BREAK. !---------------------------------------------mory stack onto the expression stack. ! ! Instruction: ! LSSN ! ! Result: ! Stack pushed. ! (Tos) = SS.-------------------------------- ! ! Abstract: ! BREAK is a one byte instruction that is used for a Q-code level !  ! !----------------------------------------------------------------------------- Opcode(LSSN), Tos := SS, Push, NextInst(0 breakpoint to the Krnl. ! ! Instruction: ! BREAK ! ! Result: ! BrkReg = UPC. ! ! Calls: ! Krnl. !); ! Opcode LDAP. !----------------------------------------------------------------------------- ! ! Abstract: ! L !----------------------------------------------------------------------------- Opcode(BREAK), BrkReg := UPC, Goto(7401); DAP is a one byte instruction that loads the current activation ! pointer. ! ! Instruction: ! LDAP ! ! Result: ! cause a breakpoint $Title UNDFxxx - Undefined Q-Codes. ! Opcode Undefined. !------------------------------------------- ! Stack pushed. ! (Tos) = AP - SB. ! !----------------------------------------------------------------------------------------------------------- ! ! Abstract: ! These are the undefined Q-codes. They cause an ErrUndfQcd error. !---- Opcode(LDAP), Tos := AP - SB, Push, NextInst(0); ! Opcode INCDDS. !------------------------------------------------ ! Calls: ! UOP. ! !----------------------------------------------------------------------------- Opcode(UNDF198), -------------------------------------------------------- ! ! Abstract: ! PBLK is the unimplemented process block instru----------------------------- ! ! Abstract: ! INCDDS is a one byte instruction that increments the diagnostic ! ction. ! ! Instruction: ! PBLK ! ! Calls: ! UOP. ! !--------------------------------------------------------display (DDS). Since incrementing the diagnostic display has the ! size effect of resetting the E-stack, the E-stack is --------------------- Opcode(PBLK), Goto(UOP); $Title NOOP, LSSN, LDAP, INCDDS, BREAK - Miscellaneous. ! Opcode checked to be ! sure it is already empty. If it isn't, an ErrEStk is generated. ! ! Instruction: ! INCDDS ! !4 ; ! Display 9 - Looping works not 0, LoadS(7777); ! Load control store 7777 with a  at location 7400 in the ram, with last word written ! first (ie 7777 first, 7776 next,...,7400 last) ! WcsLow, if True GotoS(t1Lo);! return instruction t1Lo: not 5000; not 0, WcsMid, if True GotoS(t1mid); t1mid: WcsH Data is sent low word 1st, then mid, then hi ! When all 256 MI are loaded, Boot jumps to 7400 constant(ReadCsr,40i, if True GotoS(t1hi); t1hi: Repeat(t1rpt); ! decrement address to 7776t t1rpt: R1 := 3777; !); !Complement of 40, the read csr address constant(WriteCsr,241); !Write csr, with z7 set for write constant(ReadData,42);  write 2k -1 locations t2lp: if Eql Goto(t2end); ! of R0 := R0 + 1, Next not 313; WcsLow, if True Gconstant(WriteData,243); constant(XmitDone,10); !These define the bits in the csr constant(Flag,4); !They are mainly footoS(t2lo); t2lo: not 7200; not 1, WcsMid, if True GotoS(t2mid); t2mid: WcsHi, if True GotoS(t2hi); t2hi: R1 :=r reference constant(RcsrToBus,1); !Since the microassembler won't allow constant(XbufCyc,2); !expressions where a constan R1 - 1, Repeat(t2lp); ! count your words t2end: R0 := 0, Call(4000); ! call the code just loaded R0 xor 3777;t is expected define(count,1); !The number of microinstructions to load define(data,2); !the guy who has the data to be wri ! should count 2k - 1 times if Neq Goto(DeepEnd); StackReset; ! Display 10 - Ctten Begin: IOB(ReadCsr); IOD AND Flag; !Check Flag to see if Link is present IF NEQ GoTR20 := 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 ; ! -1 + 1 carries Goto(DeepEnd); good11: R0 - 1, if C19 Goto(DeepEnd); ! 0 - 1 carries  Three Rivers Computer Corporation ! ! Will Boot from 1 of 3 sources ! 1 - If Link Cable is plugged in, will boot from  if C19 Goto(DeepEnd); StackReset; ! Display 8 - Conditional Branch works R0 := 0, LoadS(52link ! 2 - If Cable is not in, will try to boot from Floppy ! 3 - If that fails, will try to boot from Hard Disk 52); ! Try LoadS and Repeat with a loop lp1: R0 := R0 + 1, Repeat(lp1); ! heres your loop R0 xor 5253; ! 4 - if that fails, will loop forever ! ! ! constant(IntVec,700); !Interrupt vector location ! ! B O O T f r  ! should have looped n+1 times if Neq Goto(DeepEnd); R0 := 2526; ! try it backwards 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 !  LoadS(2525); lp2: R0 := R0 - 1, Repeat(lp2); if Neq Goto(DeepEnd); ! should be 0 StackReset starts receiving 3 word data items to be loaded into ! the control store. 256 (decimal) words are loaded ! 5 Goto(UOP); Opcode(UNDF199), Goto(UOP); Opcode(UNDF245), Goto(UOP); Opcode(UNDF246), Goto(UOP); Opcode(UNDF247), Goto(UOP);  ! ! Instruction: ! LOPS ! ! Environment: ! In general, long operations take their arguments from the EStack !Opcode(UNDF248), Goto(UOP); Opcode(UNDF249), Goto(UOP); Opcode(UNDF250), Goto(UOP);  with the low-order word on top: ! (Tos) = low word of long ! (Tos-1) = high word of long ! !--------------------------------------------------------------------- Opcode(LOPS), tmp := NextOp; tmp, Field(0,4);  Dispatch(LongOps); ! Opcode CVTLI !--------------------------------------------------------------------- ! ! Abstrac$Title Double precision arithmetic operators. ! 8 Mar 81 Bernd Bruegge & Horst Mauersberg ! Defined. ! ! 11 Mt: ! CVTLI is a two byte instruction that converts a long to an integer. ! ! Instruction: ! LOPS-CVTLI ! ! Envar 81 Bernd Bruegge ! Changed opcode for ABSLong. ! ! 9 Apr 81 George Robertson ! Converted for latironment: ! (Tos) = low word of long ! (Tos-1) = high word of long ! ! Result: ! (Tos) = low word of longest version of interpreter. ! Converted to two byte opcodes. ! Added interrupt check to multiple and div ! ! Calls: ! ErrCVTLI is generated if b.high <> 0 or b.high <> ALLONE's ! !-----------------------------------------ide loops. ! ! 17 Apr 81 Bernd Bruegge & George Robertson ! Fixed bug in LDIVIDE. ! Changed form of d---------------------------- Case(LongOps,CVTLI), blow := TOS and AllOnes, pop; ! save bhigh := TOS and AllOnispatch to Spice kernel ops. ! ! 20 Apr 81 George Robertson ! Fixed bugs in inequality comparisons. ! es; TOS := blow, if eql goto(CVTLIEXIT); ! b.high = 0? i.e  Fixed bug in remainder result of LDIVIDE. ! ! 21 Apr 81 Bernd Bruegge & Horst Mauersberg ! Redefined multiply an! valid result? ! No: bhigh xor ALLONES; ! b.d divide. ! ! 22 Apr 81 George Robertson ! Fixed bugs in multiply and divide setup. ! Opcode LOPS !---------high = ALLONES? ! No: blow, if neq goto (CVTLIERROR); ! ne------------------------------------------------------------ ! ! Abstract: ! LOPS is a two byte opcode for performing agative overflow if geq goto (CVTLIERROR); ! sign bit in blow = 0? rithemetic ! operations on long (32 bit) values. The second byte is used ! as a dispatch into the 15 operations.  ! No: negative overflow CVTLIEXIT: NextInst(0); CVTLIERROR: tmp2 := ErrOvflLI, goto(Run5 q GoTo(WaitHeader); MainLoop: Call(AwaitData); !Returns with Data in UW Data; WCSlow, if true  as Head define(tmp,100); define(Sec,200); define(CylHd,357); !Should be 377, set to 357 for testing define(MemAdr,307); GoToS(DatMid); !Write Control Store using R as the addr DatMid: Call(AwaitData); Data; WCSmid, if true GoToS( define(CkSum,350); !Should be 370, set to 350 for testing define(Dly,252); ! Count In Diagnostic Display Register when thDatHi); DatHi: Call(AwaitData); Data; WCShi, if true GoToS(DecAdr); DecAdr: Repeat(DoLoop), Count := Count is routine is called constant(DskDDSstart,10#10); ! Count In Diagnostic Display Register when this routine finishes constant- 1; DoLoop: IF Neq GoTo(MainLoop); GoTo(7400); !Jump to the code just loaded AwaitData: IOB(Re(DskDDSend,10#29); ! Difference -> DDSend - DDSstart constant(DskDDSdif,10#19); constant(dstat,100); !disk status regisadCsr); !Wait for a word to come from PDP-11 IOD AND XbufCyc; !Check for him to load his tter IOB address constant(dseek,301); !disk command register IOB address constant(dhead,302); !disk head register IOB addreransmit buffer IF Eql GoTo(AwaitData); !Keep looping until he does 15, IOB(WriteCsr); ss constant(CylSec,310); !disk Cylinder/Sector IOB address constant(FileL,311); !disk low File Serial Number IOB address c !Clear XmitDone IOB(ReadData); !Get the data Data := IOD; 5, IOB(WriteCsr), Returonstant(FileH,312); !disk hi File Serial Number IOB address constant(Block,313); !disk Logical Block Number IOB address cn; !Set Xmit Done ! ! ! B O O T f r o m D I S K ! ! ! !Use the Floppy or Hard Disk to Read Microcode !Stonstant(CWadrL,331); !disk Header address low IOB address constant(CWadrH,321); !disk Header address hi IOB address constantep 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 wor(DatAdrL,330); !disk Data Buffer address low IOB address constant(DatAdrH,320); !disk Data Buffer address low IOB address consds/sector 6144 div 256 is 24 sectors ! ! Display Error Codes ! 10 - Hung in Disk Boot ! 11 - Memory Data Error ! tant(DirOut,0); !move disk heads out towards track 0 constant(DirIn,10); !move disk heads in towards track 201 DiskStarto(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 -  Counter with 1st addr to load 5,IOB(WriteCsr); !XmitDone:=1, Flag:=0, RcsrToBus:=1, XbufCyc:=0 WaitHeader: Call(AwaitBad Interrupts Reading Floppy Disk Data ! 29 - Finished Disk Code ! define(c400,4); define(c1777,1); define(TryCnt,10);Data); !Look for header word Data xor 12345; !check to see if it is right IF Ne define(Dir,20); define(ByteCnt,20); !Note Same register as Dir define(Head,40); define(Bite,40); !Note Same register6 , pop; bhigh := not TOS; if lss goto(ABSPUSH); ABSLONGa: blow := blow +1; TOS := bhigh + 0 f lss goto(SetTrue); TOS := 0, NextInst(0); Case(LongOps,GEQLong), CALL(LSSUB); if lss goto(SetFalse); + oldcarry; TOS := blow, push, NextInst(0); ABSPUSH: TOS := not blow, push; TOS := TOS, NextInst(0); TOS := 1, NextInst(0); Case(LongOps,GTRLong), CALL(LSSUB); TOS or tmp2, if lss goto(SetFalse); i Case(LongOps,NGL), blow := not TOS, pop; bhigh := not TOS, goto(ABSLONGa); ! Opcode EQULong, NEQLong, Lf eql goto(SetFalse); TOS := 1, NextInst(0); ! Opcode ADL, SBL !-----------------------------------------------Error0); ! OvflLI overflow ! Opcode CVTIL !--------------------------------------------------------------------- ! EQLong, LESLong, GEQLong, GTRLong !--------------------------------------------------------------------- ! ! Abstract: ! ! Abstract: ! CVTIL is a two byte instruction that converts an integer to a long. ! ! Instruction: ! LOPS-CVTIL  The xxxLong opcodes are two byte instructions that compare two long ! values in the expression stack for equality and/ ! ! Environment: ! (Tos) = integer ! ! Result: ! (Tos) = low word of long ! (Tos-1) = high word of longor order. ! Currently EQULong and NEQLong are implemented by EQLReal and ! NEQReal. ! ! Instruction: ! LO ! !--------------------------------------------------------------------- Case(LongOps,CVTIL), blow := TOS and AllOnes; PS-xxxLong ! ! Environment: ! (Tos) = low word of long0 ! (Tos-1) = high word of long0 ! (Tos-2) = low wo TOS := 0, if geq goto (CVTILEXIT); ! positive? TOS := ALLONES; ! no, signextend Crd of long1 ! (Tos-3) = high word of long1 ! ! Result: ! Stack popped. ! (Tos) = long0 xxx long1 ! ! CaVTILEXIT: TOS := blow, push, NextInst(0); ! push value, then sign ! Opcode ABL, NGL !--------------------lls: ! SetFalse, LSSUB ! !--------------------------------------------------------------------- Case(LongOps,EQULong------------------------------------------------- ! ! Abstract: ! ABL and NGL are two byte instructions that return abs), call(LongCmp); NextInst(0); LongCmp: tmp := TOS, pop; tmp1 := TOS, pop; TOS xor tmp, pop; olute value ! or negation of a long value. ! ! Instruction: ! LOPS-ABL, LOPS-NGL ! ! Environment: ! (To TOS xor tmp1, if neq goto(LCFalse); TOS := 1, if eql return; LCFalse: TOS := 0, return; Case(LongOps,NEQLong), s) = low word of long ! (Tos-1) = high word of long ! ! Result: ! (Tos) = low word of long ! (Tos-1) = hicall(LongCmp); TOS := TOS xor 1, NextInst(0); Case(LongOps,LEQLong), Call(LSSUB); TOS or tmp2, if lss goto(gh word of long ! !--------------------------------------------------------------------- Case(LongOps,ABL), blow := not TOSSetTrue); if eql goto(SetTrue); TOS := 0, NextInst(0); Case(LongOps,LESLong), CALL(LSSUB); i6 : 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); MemAdrerOp off 100, store; !get memory state cleared iob(106); !read any l xor 13777; !Check Expiration of data MemAdr := MemAdr + 1, if neq goto(MoreBytes); Data := 0,atent Z80 data tmp := 6000; !Must turn off video 100, fetch; tmp, IOB(341);  call(Copy); if eql GoTo(StartIt); !If sucessfull, go execute it ! !Floppy didn't work, try the rigid disk  !Initialize video addresses tmp, IOB(341); tmp, IOB(343); !Shut off video interrup ! IsDskRdy: iob(dstat); !Read status register iod and 200, ThreeWayBranch(PopStk); !pop call stack PopStk: TryCnt ts ! !Try to read the Floppy ! DoFloppy: MemAdr:=0, IOB(dseek); !Turn Z80 on ByteCnt := 0, Call(WaitAWhile);:= TryCnt - 1, if neq goto(GoManGo); r1 := 0, if eql GoTo(NoDskSpinUp); wloop: r1 := r1 - 1, store; r1;  !Let it start up 153, IOB(307); !Start of message Call(WaitAWhile); 015, IOB(307);  r1, fetch; mdi - r1; tmp := 1, if neq goto(Busted); !Code 11, Memory Error r1 - 1; if  !FloppyBoot Call(WaitAWhile); 000, IOB(307); !Kick the Z80 state machine. c19 goto(doread); goto(wloop); doread: r1 := 0; rloop: r1 := r1 - 1, fetch; mdi - r1; tmp := 2, if MoreBytes: ByteCnt := ByteCnt - 2; !Count bytes in this block tmp := 100, if gtr goto(RdFlop);!More to do neq goto(Busted); !Code 12, Memory Address Error r1 - 1; if c19 goto(IsDskRdy); goto(rloop); NoD, otherwise, new block FindHdr:Call(RecZ80Byte); !Get a Z80 byte tmp := tmp - 1; skSpinUp: tmp := 3, GoTo(Busted); !Code 13, Disk Error GoManGo:C400 := 400; !A constant used m !Count Chars Bite xor 125, if leq goto(IsDskRdy); !Was it Start of message? if neq goto(FindHdr); any times C1777 := 1777; TryCnt := C400, LoadS(10); !Give the disk 400 steps to get to trk 0 Jog: Dir !Try some more GotHdr: Call(RecZ80Byte); Bite xor 23; !Good Boot Data? CkSum := 0, if := DirIn, Call(Seek); !Shove the heads out a ways Head := 0, repeat(Jog); !Move out 10 tracks, initializ neq goto(IsDskRdy); Call(RecZ80Byte); !Get Byte Count ByteCnt := Bite, LoadS(7); RdFlop: Call(e head Restore:tmp := 20; !in WaitABit, the TrackZero bit Dir := DirOut, Call(Seek); !Go bacRecZ80Byte); !Get a Data Word Data := Bite, Call(RecZ80Byte); !Save low byte, get high Byte ShftByt:Bitek one step TryCnt := TryCnt - 1, if neq goto(StartRead); !Keep trying Data := 0, if gtr goto(Restore); ! !Re7  LSSUB: tmp := not TOS, pop; ! not b tmp1 := not TOS, pop; ! no------------------------------------- ! ! Abstract: ! Utility used by MPL, DVL, and MODL to set up their environments. t b tmp := tmp + 1; ! - b tmp1 := tmp1 + 0 + oldcarry; ! -  ! ! Environment: ! (Tos) = low word of long0 ! (Tos-1) = high word of long0 ! (Tos-2) = low word of long1b tmp2 := TOS + tmp, pop; ! a + (-b) TOS := TOS + tmp1 + oldcarry, Return;  ! (Tos-3) = high word of long1 ! ! Result: ! Stack popped three times. ! blow := (Tos) ! bhigh := ! a + (-b) ! Opcode MPL, DVL, MODL !--------------------------------------------------------------------- ! (Tos-1) ! alow := (Tos-2) ! ahigh := (Tos-3) ! (Tos) = (Tos-3) ! !-------------------------------------- ! Abstract: ! The MPL, DVL, and MODL opcodes are two byte instructions that ! multiplies, divides, or mods two l------------------------------- LPopStack: blow := TOS and AllOnes, pop; bhigh := TOS and AllOnes, pop; aloong values in the expression stack. ! ! Instruction: ! LOPS-MPL, LOPS-DVL, LOPS-MODL ! ! Environment: ! (Tos) w := TOS and AllOnes, pop; ahigh := TOS and AllOnes, return; ! Utility: LMULTIPLY, LMULTIPLYALL !--------------------------------------- ! ! Abstract: ! The ADL/SBL opcodes are two byte instructions that add or ! subtract two = low word of long0 ! (Tos-1) = high word of long0 ! (Tos-2) = low word of long1 ! (Tos-3) = high word of llong values in the expression stack. ! ! Instruction: ! LOPS-ADL, LOPS-SBL ! ! Environment: ! (Tos) = low wordong1 ! ! Result: ! Stack popped. ! (Tos) = low word of result long ! (Tos-1) = high word of result long  of long0 ! (Tos-1) = high word of long0 ! (Tos-2) = low word of long1 ! (Tos-3) = high word of long1 ! !! ! Calls: ! LMULTIPLY, LDIVIDE ! !--------------------------------------------------------------------- Case(LongO Result: ! Stack popped. ! (Tos) = low word of result long ! (Tos-1) = high word of result long ! !------ps,MPL), call(LPopStack); call(LMultiply); TOS := bhigh and AllOnes; TOS := blow and AllOnes, p--------------------------------------------------------------- Case(LongOps,ADL), tmp := TOS and AllOnes, pop; ! b ush, NextInst(0); Case(LongOps,DVL), call(LPopStack); call(LDivide); TOS := ahigh and AllOnes; T tmp1 := TOS and AllOnes, pop; ! b tmp2 := TOS + tmp, pop; TOS := TOS + tmp1 + oldcaOS := alow and AllOnes, push, NextInst(0); Case(LongOps,MODL), call(LPopStack); call(LDivide); TOS := bhirry; TOS := tmp2, push, NextInst(0); Case(LongOps,SBL), call(LSSUB); TOS := tmp2, push, NextInst(0); gh and AllOnes; TOS := blow and AllOnes, push, NextInst(0); ! Utility: LPopStack !--------------------------------7 o another sector ! !Data is now loaded into memory, copy it into the microstore ! Copy: MemAdr := 14000; !S dly := 177777; WtDone: nop; nop; nop; IOB(dstat); !Check doneness tarting at the high end of the data LoadS(7777); !Load into top 2k of microstore wd0: Cksum := C r0 := IOD and 7; !Check status bits dly := dly - 1, if eql goto(IsDone);!status code 0 is done, Keep tksum + Data, Call(NextData); !Write high word 1st WCShi, if true GotoS(wd1); wd1: Cksum := Cksum + Data, Call(Nexrying if neq goto(WtDone); !Until you find it 47, IOB(dseek); !If you dont, Reset tad 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);  !You Made it Dir := DirIn, Call(seek); !Try next cylinder, next head CylHd := 440;  WCSlow, if true GoToS(wd3); wd3: MemAdr, Repeat(wd4); !Decrement Address, check Address wd4: if gtr goto !One track out, head one Head := 1, Call(DoDiskRead); !Try it here tmp := 4, if eql GoTo(StartIt); (wd0); !if >0 more to do Cksum + Data, return; !otherwise, add final word to Cksum NextData:!Made it on alternate track !Code 14, Couldn't Read Disk Busted: Call(SetDisplay); Sl MemAdr := MemAdr - 1, Fetch; !Decr address and get that word Data := MDI, Return; !Data goes on R ! !Reep: GoTo(Sleep); !Loop forever SetDisplay: StackReset, Call(WaitAWhile); tmp := tmp - 1; ead one sector from the hard disk into memory ! DoOneSec:CylHd or Sec, IOB(CylSec); !Physical header data head, I if neq goto(SetDisplay); return; ! !Looks Good, try to execute the code you loaded ! StartIt: tmp := dskDDSdif, CaOB(dhead); !Head number not 0, IOB(FileL); !Files 1 and 2 for heads 0 and 1 not 0, ll(SetDisplay); ! Read Disk OK GoTo(4000); ! !Try to read 24 sectors into memory from 0 to 13777 ! DoDiskRead: SecIOB(FileH); Sec, IOB(Block); !Sector Number 0, IOB(CWAdrL); not 1, IOB(CWAdrH);  := 27; !Read 24 (Decimal) sectors, load into MemAdr := 13400; !Do last sector first  !Stash label in high memory MemAdr xnor C1777, IOB(DatAdrL); not 0, IOB(DatAdrH); !Stash  CkSum := 0; !Initialize the Checksum DoAnother: TryCnt := 170, Call(DoOneSec); !Give it 10 trys per data in low memory 1, IOB(dseek); !Read it baby WtBzy: IOB(dstat); !Wait for bussector Sec := Sec - 1; !Count your sectors MemAdr := MemAdr - C400, if geq GoTo(DoAnother); !Dy r0 := IOD and 7; r0 xor 7; !Disk status code 7 is busy if neq goto(WtBzy); 8 iplicator.high ! !--------------------------------------------------------------------- LMULTIPLYALL: tmp5 :=  LMULNEXT: if intrpend call(VectSrv); tmp4 := 0, goto(LMULLOOP); LMUL5: tmp4 := SIGNBIT, goto(LMUL6); L0; ! special entry to bypass tmp7 := bhigh, goto(LMUL1); ! sign checks LMULTIPLY:MULADD: blow := blow + alow; ! add a to result bhigh := bhigh + ahigh + oldcarry; ! add a to result if carry goto(LMULERR); alow := alow + alow, goto(LMUL7); ! 2*a LMULERR: ! **** T result, ! goto LMUL1, if b is positive. if lss goto(LMUL2); P := TP + 1, Store; ! **** ErrMulOvfl, goto(ErrExit); LMULEND: tmp5; ! check sign call(LNEGB); ! negate b LMUL3: tmp7 := bhigh, call(LNEGA); ! negate a LMUL1: bhigh - of result LMULRETURN: if geq return; LMULNEGEND: goto(LNEGB); ! Utility: LDIVIDE, LDIVIDEALL !---------------------------ahigh, if lss goto(LMUL3); bhigh - ahigh, if gtr goto(LMULX); blow - alow, if eql goto(LMUL4); ! make s------------------------------------------ ! ! Abstract: ! Subroutine Long Divide ( a := a : b) ! ! Environment: ! ure: b LEQ a LMULX: tmp6 := alow; ! eXchange operands tmp7 := ahigh; alow := blow; alow: a.low, result.low ! ahigh: a.high, result.high ! blow: b.low, remainder.low ! bh ahigh := bhigh, goto(Positive); LMUL4: tmp6 := blow, if gtr goto(LMULX); ! Assertion : Both operands are positiveigh: b.high, remainder.high ! ! Work registers: ! remsign: sign of remainder ! ressign: sign of result  at this point. The larger ! one is in ahigh and alow (multiplicand), the smaller one ! is in tmp6 and tmp7 (multiplicator). ! tmp6: partial dividend.low ! tmp7: partial dividend.high ! !--------------------------------------------------------------------------------------------- ! ! Abstract: ! Subroutine Long Multiply ( b := b * a) ! ! EnvirPositive: blow := 0; ! initialize result bhigh := 0, goto(LMULNEXT); LMUL2: conment: ! blow: b.low , result.low ! bhigh: b.high, result.high ! alow: a.low ! all(LNEGB); tmp7 := bhigh, goto(LMUL1); LMULLOOP:tmp6 + tmp7, rightshift(1); ! end test tmp7, ifahigh: a.high ! ! Work registers: ! tmp4 : add-flag. Add multiplicand if 1, else not. ! tmp5 : sign of res eql goto(LMULEND); tmp7 := shift, if odd goto(LMUL5); LMUL6: tmp6; tmp6 := shift or tmp4, if odd goto(LMULult (- : if tmp5 < 0. ! + : if tmp5 >= 0) ! tmp6 : multiplicator.low ! tmp7 : multADD); alow := alow + alow; ! 2*a LMUL7: ahigh := ahigh + ahigh + oldcarry; ! 2*a8 AWhile: dly := 177777; wtwl1: if eql return; dly := dly - 1, goto(wtwl1); ! !Get A Byte from Z80 ! RecZ80Byte: r1 is a special piece of microcode. It is used to debug other micro- ! code and thus must coexist with that program.:=177777; waitbyte: if intrpend Vector(Z80Int); !Allow interrupts dly := 100, call(wtwl1); r1 := r1 - 1;  The Krnl should use ! as little of the Perq as possible. When a breakpoint is set in a ! program, the Krnl must !Dont wait too long if neq goto(waitbyte); ! give up eventually goto(IsDskRdy);  try not to destroy the state of that program. ! The following list describes what parts of the Perq the Krnl uses. ! ! !Z80 isn't saying anything ! !Allow only Z80 Interrupts to do anything ! Note that the instruction at waitbyte is 1. A piece of micro-code may use the Krnl's screen interrupt ! handler only if it wishes to ignore all other in a Vector ! -> we can return from RecZ80Byte from Z80Int Z80Int: iob(106), loc(700); !Here on Z80 Read Interrupterrupts. The ! interrupt service sequence is: ! if IntrPend, Call(tag); ! ... t Bite := iod and 377, return; !pick up byte and return BadInt1: tmp := 5, goto(busted), loc(704); !Bad Interrupt ! tag: Vector(7600); ! ! 2. The Krnl uses registers 357-377 inclusive. ! ! 3. The Krnl uses one level ohe 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 !Try it again GoTo(DoOneSec); !I give up IsDone: 0, IOB(dseek), return; !Clear disk a, goto(busted), loc(720); BadInt5: tmp := 11, goto(busted), loc(724); BadInt6: tmp := 12, goto(busted), loc(730); BadInt7: tmnd done ! !Seek the disk One track in dir direction ! Seek: dir or 27, iob(dseek); !Set the step bit + dir bit + p := 13, goto(busted), loc(734); END; reset dly := C1777, Call(wtwl1); !Make a pulse dir, iob(dseek); !Clear the step bit !!! KRNL - Microcode for use with the PDP-11 link and ODTPRQ ! to Examine/Deposit MicroInstructions, Registers ! Assumes Seek Complete Happens ! !Wait for a bit to come up ! WaitABit: Call(WaitAWhile), ! and Memory Locations. ! ! Brian Rosen 27-Dec-79 ! John P. Strait 27-Feb-80 rewritten ! ; !Wait some time iob(dstat); !Get the disk status r0 := iod; r0 and  Copyright (C) 1979 Three Rivers Computer Corporation ! ! ! Change history ! ! 13 Jan 81 V1.1 JPS Don'ttmp, return; !Test the bit and return ! !Wait long enough for a sector to transfer, a head to settle, etc ! Wait use memory for the display list, ala Vfy. ! ! ! This code is loaded by boot rom microcode, fed by ODTPRQ. The Krnl !9 oto(LDIV1); ! sign checks LDIVIDE: remsign := bhigh, leftshift(0); ! holds sign of remainder ressign blow; ! is tmp >= b ? tmp7 + bhigh + oldcarry; if lss goto(LDIVDEC); tmp6  := shift XOR ahigh, if lss goto(LDIV1); ! sign of result LDIV3: if lss call(LNEGA); ! negate a cal:= tmp6 + blow; ! partial dividend + (- divisor) tmp7 := tmp7 + bhigh + oldcarry; alow := alol(LNEGB); ! negate b ! NOTE: From this point on blow,bhigh contains the 2's complement ! of the divw or 1; ! Increase result LDIVDEC: TOS := TOS - 1; remsign, if gtr goto(LDIVLOOP); blow isor. This speeds up the inner loop! LDIV1: tmp7 := 0, if geq Call(LNEGA); tmp6 := 0; bhigh or blow; := tmp6, pop, if lss goto(LDIVNEGREM); ! remainder.low bhigh := tmp7; ! remainder.high  ! check whether b zero push, if eql goto(DIVZERO); LDIV4: TOS := 40;  ressign; LDIVEND: if geq return; goto(LNEGA); LDIVNEGREM: bhigh := tmp7, call(LNEGB); ressign, goto( ! loop count ahigh; ! check a.high zero alow, if neq goto(LDIV5); LDIVEND); LDIVZERORESULT: alow := 0, pop; ahigh := 0, return; ! Utility: LNEGA, LNEGB !------------------------ ahigh := alow, if eql goto(LDIVZERORESULT); ! shift 1 word alow := 0; TOS := TOS - 20; --------------------------------------------- ! ! Abstract: ! Negate long operand a ! ! Environment for LNEGA: !  ! adjust loop count: skip 1 word LDIV5: ahigh and not 377, leftshift(10); ! check whether high byte zero ahig alow ! ahigh ! ! Environment for LNEGB: ! blow ! bhigh ! !------------------------------------------h, if neq goto(LDIVLOOP); ahigh := shift; ! shift 1 byte alow, field(10,10); a--------------------------- LNEGA: alow := not alow; ahigh := not ahigh; alow := alow + 1; ahighigh := shift or ahigh; alow, leftshift(10); alow := shift; TOS := TOS - 10; ! h := ahigh + 0 + oldcarry, return; LNEGB: blow := not blow; bhigh := not bhigh; blow := blow + 1;adjust loop count: skip 1 byte LDIVLOOP: alow := alow + alow; ! shift dividend.low ahigh := ahigh +  bhigh := bhigh + 0 + oldcarry, return; $Title Double precision arithmetic operators. ! Opcode KOPS !----ahigh + oldcarry; ! shift dividend.high tmp6 := tmp6 + tmp6 + oldcarry; ! shift partial dividend.low ----------------------------------------------------------------- ! ! Abstract: ! KOPS is a two byte opcode for perform---------------------------- LDIVIDEALL: ressign := 0; ! special entry to bypass remsign := 0, gtmp7 := tmp7 + tmp7 + oldcarry, ! shift partial dividend.high if intrpend call(VectSrv); LDIV11: tmp6 +9 ed later). ! - instructions which use OldCarry (this may be fixed later). !! registers: define(address ! 1640: WmW - write memory word ! 1641: RmW - read memory word ! 1642: SuP - start microprData,377); ! the working register define(IntRtn,376); ! return number for interrupt service define(mogram ! 1643: LXmA - load extended memory address > 65KW ! 1644: Clr - clear memory ! 1645: WmB - wAddr,375); ! memory address define(VR,374); ! video refresh temp define(Unused373,373); ! cursorrite memory block ! 1646: WuB - write microstore block ! 1647: RuS - reset microprocessor state con address in IO.Micro define(Unused372,372); ! address of video command in IO.Micro define(Screen,371); ! stant(LastCmd,1647); ! last command number !! miscellaneous constants: constant(Hello,12345screen base div 2 define(BreakPnt,370); ! break point number define(tmp,367); ! temporary register ); ! message to confirm the boot constant(Hey,54321); ! message to get ODTPRQ's attention  define(Command,366); ! command number define(SSv,365); ! save S register define(uStateSv,364)constant(ReadCsr,40); ! IO addr: link input Command/Status constant(WriteCsr,241); ! IO addr: link ou; ! save uState register define(Trap,363); ! =1 to trap bad interrupts, =0 to ignore them define(BadCmtput Command/Status constant(ReadData,42); ! IO addr: link read data constant(WriteData,243); d,362); ! latest bad command define(BadInt,361); ! latest bad interrupt define(Disable,360); ! =1 t! IO addr: link write data constant(XbufCyc,2); ! Bit for "He wrote to me" constant(IntVec,7600); o disable interrupts, =0 to enable define(VCount,357); ! video counter define(R0,0); ! ! address of interrupt vector Place(7400,7777); !!! bootstrap entry. f the call stack. Thus the user program ! should not use more than 4 levels of calls. ! ! 4. Breakpoints shou defined for some dummy locations !!! commands: constant(FirstCmd,1630); ! first command number !!!ld not be set in the following places: ! - in the middle of a shift sequence. ! - in the middle of a memory  1630: LuA - load microstore address ! 1631: WuWa - write microstore word a (low third) ! 1632: WuWb - sequence. ! - in the middle of an I/O sequence. ! - instructions which test C19, Eql, Neq, Gtr, Geq, Lss, Lewrite microstore word b (mid third) ! 1633: WuWc - write microstore word c (high third) ! 1634: LrA - load req, ! Carry, or OverFlow (this may be fixed later). ! - instructions which read the uState (this may be fixgister address ! 1635: Wr - write register ! 1636: Rr - read register ! 1637: LmA - load memory : r tmp, Return; ! base address and residency *****) ChkSeg: tmp + tmp, Fetch2; ! fetch segment tablits number and code ! base address. The code segment must be resident. ! ! Environment: ! tmp4 = Code base addre entry tmp12 := tmp; Tos := tmp := Mdi, Push; tmp := Mdx or tmp, ! basess as a physical address. ! tmp10 = Routine number. ! ! Result: ! tmp1 = Address of LL field. ! LL word ing Spice Kernel operations. ! The second byte is used as a dispatch into the 16 operations. ! The actual support e address and flags if Odd Goto(ChkSeg1); ! if not resident tmp := tmp and not 377; for these 16 ops is in MicroKernel.Micro. ! ! Instruction: ! KOPS ! !------------------------------------------------ ! clear the flags tmp12 + tmp12, Store; ChkSeg1: Tos or 4, Pop, Return; ! set RecentlyUsed in SAT --------------------- Opcode(KOPS), Goto(Uop); {KOPS is not supported. call(KOpsDispatch); NextIn ! Routine GetGP. !----------------------------------------------------------------------------- ! ! Abstract: ! Gest(0); KOpsDispatch: tmp := NextOp; tmp, Field(0,4); Dispatch(KrnlOps); KOPS is not supported.} t the global pointer for an external segment. The input is an ! internal segment number, and the output is a global pointer. ! An internal segment number of zero is used to mean the current ! segment. ! ! Environment: ! tmp2 = Internal segment number. ! ! Result: ! tmp2 = External global pointer. ! ! Calls: ! VectSrv. ! !---------- $Title Addressing routines. ! Routine ChkSeg. !--------------------------------------------------------------------------------------------------------------------------------------- GetGP2: Call(VectSrv); ! serve an i--------- ! ! Abstract: ! ChkSeg checks a segment number for residency and returns its base ! address (if residenterrupt Nop; ! let placer make two groups GetGP: tmp2, if IntrPend Goto(GetGP2); nt). ! ! Environment: ! tmp = Segment number. ! ! Result: ! tmp = Base address. ! tmp and ALU result ar tmp2 := tmp2 + tmp2, if Neq Goto(GetGP1); tmp2 := GP, Return; ! same segment as current ! e Odd if non-resident. ! !----------------------------------------------------------------------------- (***** ChkSeg: tmp Other segment. GetGP1: GP - tmp2, Fetch; tmp2 := Mdi + SB, Return; ! Routine GetLL. !----------------------- + tmp, Fetch2; ! fetch segment table entry tmp := Mdi and not 376; tmp := Mdx o------------------------------------------------------ ! ! Abstract: ! GetLL gets the lexical level of a routine given :  ! trap bad interrupts Screen := 1400; ! screen address = 3000 Disable := 1, Ca Command := Command - 1, if Eql Goto(WuB); BadCmd := Data, if Eql Goto(RuS); BreakPnt := 10#30,ll(Snd); ! disable interrupts and send greeting Goto(RuS); ! enter command loop via RuS  Goto(7401); ! mark bad command and issue breakpoint !! command routines.  !!! breakpoint entry. Break: uStateSv := uState, Loc(7401); ! save uState SSv := not 0;  !!! LuA - load microstore address. LuA: Call(Rcv); tmp := Data; tmp := tmp or not 17;  ! save S register Brk1: IntRtn := 3, Goto(ChkInt); ! check for interrupts Int3: SSv := SSv + 1, Repeat Data := Data or 377, LoadS(uA1); WcsLow, if true GotoS(LuA1); LuA1: tmp and not 6060; WcsMid, if true (Brk1); Data := Hey; Call(Snd); ! send the breakpoint message GotoS(LuA2); LuA2: Data, LoadS(uA2); WcsLow, if true GotoS(LuA3); LuA3: tmp and not 1460; WcsMid, if tru ! fall into command loop !!! Cmd - main command loop. Cmd: Call(Rcv); e GotoS(Cmd); !!! WuWa - write microstore a (low third). Must be preceded by a LuA. WuWa: Call(Rc ! get the command number Command := Data; uA1: LoadS(0); ! *** this instruction is mov); WcsLow, if true GotoS(Cmd); !!! WuWb - write microstore a (mid third). Must be preceded bdified *** Command := Command - FirstCmd; Command := Command - 1, if Eql Goto(LuA); Command := Commany a LuA. WuWb: Call(Rcv); WcsMid, if true GotoS(Cmd); !!! WuWc - write microstore a (highd - 1, if Eql Goto(WuWa); Command := Command - 1, if Eql Goto(WuWb); Command := Command - 1, if Eql Goto(WuWc) third). Must be preceded by a LuA. WuWc: Call(Rcv); WcsHi, if true GotoS(Cmd); !!! LrA ; Command := Command - 1, if Eql Goto(LrA); Command := Command - 1, if Eql Goto(Wr); Command := Comma- load register address. LrA: Call(Rcv); Data := not Data, LoadS(rA2); Data and 377; nd - 1, if Eql Goto(Rr); Command := Command - 1, if Eql Goto(LmA); Command := Command - 1, if Eql Goto(WmW);  ! Y = inverted register number WCShi, if true GotoS(LrA1); LrA1: Data and not 377, LoadS(rA1); ! X = invert Command := Command - 1, if Eql Goto(RmW); Command := Command - 1, if Eql Goto(SuP); Command := Commanded register number WCShi, if true GotoS(LrA2); LrA2: Data and 377, LoadS(rA3); ! Y = inverted register number Boot: LoadOp, Loc(7400); ! clear boot Data := Hello; BadInt := not 0; Trap := 1;  - 1, if Eql Goto(LXmA); Command := Command - 1, if Eql Goto(Clr); Command := Command - 1, if Eql Goto(WmB); ; ointer is Fetched ! in the instruction which returns. ! ! Calls: ! VectSrv. ! !-------------------------------. ! ! Result: ! tmp = XSN. ! tmp7 = XGP. ! ! Calls: ! VectSrv. ! !--------------------------------------------------------------------------------- GetLP1: tmp3 := tmp3 + 1, Call(VectSrv); GetLP: tmp2, Fetch; ------------------------------------------ XSTMap: tmp, LeftShift(1); tmp := Shift, if Eql Goto(XSTMap1); ! if curr ! fetch static link tmp3 := tmp3 - 1, if IntrPend Goto(GetLP1); tmp2 := Mdi + SB, ! AP fent segment desired GP - tmp, Fetch2; ! fetch XST entry tmp7 := Mdi + SB; or next activation if Gtr Goto(GetLP); ! if not there yet tmp2 + ACBLP, Fetch, Return;  ! XGP tmp := Mdi, Return; ! SSN ! ISN = 0 means XSN = CS, XGP = GP. XSTMap1: tmp := CS, ! fetch desired LP ! Routine GetSL. !----------------------------------------------------------------------------- !  if IntrPend Call(VectSrv); tmp7 := GP, Return; $Title Boolean routines. ! Routine SetFalse. !-----------of the routine descriptor fetched--it may be read on Mdi. ! ! Calls: ! VectSrv. ! !----------------------------------! Abstract: ! GetSL gets the static link of a procedure that is n lexical levels ! away. Thus specifying zero get------------------------------------------- GetLL: tmp4, Fetch; ! fetch dictionary pointer s the static link for a procedure ! that is at the same level as the starting one. ! ! Environment: ! tmp10 = Sttmp10, LeftShift(3); ! multiply routine number by 8 tmp1 := Shift + tmp4; ! offset of diarting AP. ! ! Result: ! tmp10 = Desired SL. ! ! Calls: ! VectSrv. ! !--------------------------------------ctionary entry tmp1 := tmp1 + RDLL; ! offset of LL field tmp1 := Mdi + tmp1, if IntrPend Call(--------------------------------------- GetSL: tmp10, Fetch; ! get next static link tmp1 := VectSrv); ! address of LL field tmp1, Fetch, Return; ! fetch LL field ! Routine GetLP. !---------tmp1 - 1; tmp10 := Mdi + SB, ! static link if Geq Goto(GetSL); ! if not -------------------------------------------------------------------- ! ! Abstract: ! Get the local pointer for another there yet Return; ! Routine XSTMap. !-----------------------------------------------------------------------------activation record. The input ! is an offset in static nesting, and the output is a local pointer. ! ! Environment: !  ! ! Abstract: ! XstMap maps an internal segment number (ISN) into an external ! segment number (SSN) and an ext tmp2 = AP. ! tmp3 = offset in static nesting. ! ! Result: ! The memory word containing the desired local pernal global pointer (XGP). An ! ISN of zero is taken to mean the current segment. ! ! Environment: ! tmp = ISN;  SuP1: SSv + SSv; ! swap bytes without using the shifter SSv := SSv + SSv + OldCarry, Repeat(Su !!! WuB - write microstore block. Write microstore from 3777 to 0 ! inclusive.P1); SSv or 377, LoadS(SuP3); ! get ready to modify LoadS instruction WcsLow, if true GotoS(SuP2); ! Must be preceded by ! a LuA. WuB: LoadS(3777); WuB1: Call(Rcv); WcsLow WCShi, if true GoToS(Cmd); !!! Wr - write register. Must be preceded by a LrA. Wr:  Z = low part of SSv SuP2: SSv := SSv or not 17; SSv and not 6060; WcsMid, if true GotoS(SuP3); ! SF = h Call(Rcv); rA1: R0 := Data; ! *** this instruction is modified *** Goto(Cmd); igh part of SSv SuP3: LoadS(0); ! *** this instruction is modified *** uA2: Goto(0);  !!! Rr - read register - must be preceded with a LrA command. Rr: rA2: Data := R0; ! *** th ! *** this instruction is modified *** !!! LXmA - load extended memory address. Sets the memois instruction is modified *** Call(Snd); ! send the register value Call(Rcv); rA3: Dry address to ! 200000 + Data. LXmA: Call(Rcv); mAddr := 100000ata := UState; ! **** this instruction is modified *** Call(Snd); !Send the xtra 4; mAddr := mAddr + mAddr; ! set bit 16 mAddr := mAddr + Data, Goto(Cmd); !!! Clr - cl bits Goto(Cmd); !!! LmA - load memory address. LmA: Call(Rcv); mAddr := Data, ear memory from 0 - 377777 inclusive. Clr: tmp := 100000; tmp := tmp + tmp; Clr1: IntRtn := 2, Goto(ChGoto(Cmd); !!! WmW - write memory word. Must be preceded with a LmA. WmW: Call(Rcv); MA := mAddr,kInt); ! check for interrupts Int2: tmp := tmp - 1; not tmp, Store; 0; ! store; ! store the word MDO := Data, Goto(Cmd); !!! RmW - read memory word. Must store a zero tmp, Store; 0, if Neq Goto(Clr1); ! store another zero Goto(Cmd);  be preceded with a LmA command. RmW: MA := mAddr, Fetch; ! fetch the word from memory Data : !!! WmB - write memory block. Write 256 words into memory starting ! at mAddr. = MDI; Call(Snd); ! send the memory word Goto(Cmd); !!! SuP - start micr Must be preceded by a LmA. WmB: mAddr := mAddr - 1, LoadS(377); WmB1: Call(Rcv); ! get a word o program. Must be preceded with a LuA command. SuP: IntRtn := 200, LoadS(7); ! flag interrupt calls as user calls mAddr := mAddr + 1, Store; ! and stuff it into memory Data, Repeat(WmB1); Goto(Cmd); < ed, it is jumped to. It exits via a NextInst. ! ! Environment: ! (Tos) = Anything. ! ! Result: ! (Tos) = True the ! expression stack. It also pre-fetches the first bytes referenced ! by the two byte pointers. This is done. ! !----------------------------------------------------------------------------- SetTrue: Tos := 1, NextInst(0);  to get the length bytes ! for string operations. The result conditions of GetSrcDst are ! precisely the evironme $Title Byte array and string routines. ! Routine GetStringIndex. !--------------------------------------------------------nt for GetSrc, GetDst, and PutDst. ! ! Environment: ! (Tos) = Source byte offset. ! (Tos-1) = Source address as --------------------- ! ! Abstract: ! GetStringIndex gets an index into a string variable and checks it ! againsoffset from stack base. ! (Tos-2) = Destination byte offset. ! (Tos-3) = Destination address as offset from stack t the dynamic length of the string. If the index is out of ! range, GetStringIndex causes an ErrInxCase error. If the ibase. ! ! Result: ! Stack popped four times. ! Src = Source word physical address (Address + ByteOffset div 2). ndex is ! in range, GetStringIndex fetches the correct word and returns. ! ! Environment: ! (Tos) = Byte offset. ! SrcLsb = Least significant bit of the source byte address. ! SrcWord = First source word. ! SrcByte = Fir ! (Tos-1) = Word address as offset from stack base. ! ! Result: ! Stack popped. ! tmp4 = Physical word ast source byte. ! Dst = Destination word physical address (Address + ByteOffset div 2). ! DstLsb = Least significaddress of the beginning of the string. ! tmp1 = Word offset within the string. ! Word containing character fetchednt bit of the destination byte address. ! DstWord = First destination word. ! DstByte = First destination byte. !------------------------------------------------------------------ ! ! Abstract: ! SetFalse sets the top of the express and readable on Mdi. ! ! Calls: ! ChkOvr, VectSrv. ! !--------------------------------------------------------------ion stack to false. SetFalse ! is not called, it is jumped to. It exits via a NextInst. ! ! Environment: ! (To--------------- GetStringIndex: tmp := Tos and AllOnes, Pop, RightShift(1); ! byte offset tmp1 := Shift, if Ins) = Anything. ! ! Result: ! (Tos) = False. ! !----------------------------------------------------------------------trPend Call(VectSrv);! word offset Tos + SB, Fetch; tmp4 := Mdi and 377; tmp4 - tmp; tmp4 :=------- SetFalse: Tos := 0, NextInst(0); ! Routine SetTrue. !----------------------------------------------------------- Tos + SB, if Lss Goto(ChkOvr); tmp4 + tmp1, Fetch, Return; ! Routine GetSrcDst. !-------------------------------------------------- ! ! Abstract: ! SetTrue sets the top of the expression stack to false. SetTrue ! is not call--------------------------------------------- ! ! Abstract: ! GetSrcDst gets a source and destination byte pointer from< ! starting vertical retrace IntRtn := 0, Goto(VidInt); ! start the display Int0: StackReset, Goto(Cmd);  Neq goto(VidInt); ! if video interrupt IntX: IntRtn and 200; IntRtn, if Neq Return; ! if called ! clear E-stack !! subroutines. !! Rcv - wait to receive data from PDP-11. !  from user program IntRtn := IntRtn - 1, if Eql Goto(Int0); IntRtn := IntRtn - 1, if Eql Goto(Int1); The word received is left in Data and on the R bus for those ! who follow the Call(Rcv) with a use of the R bus. IntRtn := IntRtn - 1, if Eql Goto(Int2); if Eql Goto(Int3); BreakPnt := 10#31, Goto(7401 Rcv: IntRtn := 1, Goto(ChkInt); ! allow interrupts Int1: Iob(ReadCsr); ! check the receiver status); ! if unknown caller, restart everything !! Z80 interrupt service. Z80Int: Iob(106), Loc(7600); Goto( Iod and XBufCyc; if Eql Goto(Rcv); ! if no data 15, Iob(WriteCsr); ! cleaIntX); ! dismiss Z80 interrupt !! disk interrupt service. DskInt: 200, Iob(301), Loc(7610); , if true GotoS(WuB2); ! write low third WuB2: Call(Rcv); WcsMid, if true GotoS(WuB3); ! write middle third Wr Xmit done of PDP-11 Iob(ReadData); ! request the data Data := Iod; ! reauB3: Call(Rcv); WcsHi, if true GotoS(WuB4); ! write high third WuB4: Repeat(WuB1); ! continud the data 5, Iob(WriteCsr); ! set Xmit done of PDP-11 Data, Return; ! place de with next word Goto(Cmd); !!! RuS - reset microprocessor state. ! 1. clear callata on R !! Snd - send data to PDP-11. ! The word to be sent is passed in Data. Snd:  stack. ! 2. turn off RasterOp ! 3. turn off disk. ! 4. initialize screen. !  Data, Iob(WriteData); ! write the data 4, Iob(WriteCsr); ! set data ready pulse tmp  5. clear E-stack. RuS: ThreeWayBranch(0); ! clear call stack ThreeWayBranch(0); ThreeWayBr:= 20; Snd1: tmp := tmp - 1, if Neq Goto(Snd1); 5, Iob(WriteCsr), Return; ! clear data ready pulse anch(0); ThreeWayBranch(0); ThreeWayBranch(0); CntlRasterOp(0); ! turn RasterOp off  !! ChkInt - check for interrupts. Calling sequence: ! IntRnt := x, Goto(ChkInt); !  200, IOB(301); ! turn disk & Z80 off 0,IOB(307); ! turn off Z80 Output inte Intx: ... ChkInt: Disable and 1; if Neq Goto(IntX); ! if interrupts are disabled Int: Iorrupts VR := 101154; ! next command: first vertical retrace VCount := 0; b(145); ! read video state Iod and 20; ! pick video interrupt bit if=  Src := Tos + Src, Fetch; ! Src word address SrcLsb := tmp3, Pop; ! Src least significant -------------------- GetSrc: SrcLsb; if Odd Goto(GetSrc2); ! if upper byte GetSrc1: Src, Fetch; bit if Odd Goto(GetSD2); ! if first byte is upper byte SrcWord := Mdi; !  ! get a new word SrcLsb := 1, if IntrPend Goto(GetSrc3); ! next byte is upper byte SrcWor1st Src word SrcByte := Mdi and 377; ! 1st Src byte GetSD1: tmp3 := Tos and AllOnes, Pop, RightShift(1); d := Mdi; ! current word SrcByte := Mdi and 377, Return; ! current byte GetSrc2: S ! get Dst byte offset Dst := Shift + SB, if IntrPend Call(VectSrv); Dst := Tos + Dst, Fetch; !rcWord, RightShift(10); ! get upper byte from current word SrcByte := Shift and 377; ! current by Dst word address DstLsb := tmp3, Pop; ! Dst least significant bit if Odd Goto(GetSD3); te Src := Src + 1, if IntrPend Call(VectSrv); ! advance to next word SrcLsb := 0, Return; ! n ! if first byte is upper byte DstWord := Mdi; ! 1st Dst word DstByte := Mdi andext byte is lower byte ! Serve an interrupt. GetSrc3: Call(VectSrv); Goto(GetSrc1); ! Routine G 377, Return; ! 1st Dst byte GetSD2: SrcWord := Mdi, Field(0,10); ! 1st Src word SrcByte := Shift, GotoetDst. !----------------------------------------------------------------------------- ! ! Abstract: ! GetDst gets the (GetSD1); ! 1st Src byte GetSD3: DstWord := Mdi, Field(0,10); ! 1st Dst word DstByte := Shift, Return; next destination byte from a byte array or a string. ! ! Environment: ! Dst = Destination word physical address. !  ! 1st Dst byte ! Routine GetSrc. !-----------------------------------------------------------------------------  DstLsb = Least significant bit of the destination byte address. ! DstWord = Current destination word. ! ! Result: ! ! ! Abstract: ! GetSrc gets the next source byte from a byte array or a string. ! ! Environment: ! Src = Sourc DstWord = Current destination word with current byte removed. ! DstByte = Current destination byte. ! Destie word physical address. ! SrcLsb = Least significant bit of the source byte address. ! SrcWord = Current source wnation address (Dst and DstLsb) advanced to next byte. ! ! Calls: ! VectSrv. ! !------------------------------------- ! Calls: ! VectSrv. ! !----------------------------------------------------------------------------- GetSrcDst: tmord. ! ! Result: ! SrcWord = Current source word. ! SrcByte = Current source byte. ! Source address (Src p3 := Tos and AllOnes, Pop, RightShift(1); ! get Src byte offset Src := Shift + SB, if IntrPend Call(VectSrv); and SrcLsb) advanced to next byte. ! ! Calls: ! VectSrv. ! !---------------------------------------------------------=  cursor X value VCount := 11; Vid2: VR := 102000; ! next command: display normal VCount : ! communications protocol. !! Registers. Define(Count,350); ! Timeout counter = VCount - 1; if Gtr Goto(IntX); ! if not end of screen VR := 101154; ! next co Define(WCsr,351); ! Current WriteCsr value !! Constants. Constantmmand: first vertical retrace VCount; if Eql Goto(IntX); ! if end of screen VR := 101351(ReadCsr,40); ! Link input command/status Constant(ReadData,42); ! Link input data ; ! next command: second vertical retrace Goto(IntX); !! bad interrupt service.  Constant(WriteCsr,241); ! Link output command/status Constant(WriteData,243); ! Link out BadInt := 04, Goto(Bad1), Loc(7604); BadInt := 14, Goto(Bad1), Loc(7614); BadInt := 20, Goto(Bad1), Loc(put data Constant(SndDataReady,1); ! output signal - assert low Constant(SndDone,4); 7620); BadInt := 30, Goto(Bad1), Loc(7630); Bad1: Trap and 1; if Eql Goto(IntX); ! if not trap ! input signal - assert high Constant(RcvDataReady,2); ! input signal - assert high Constantping bad interrupts BreakPnt := 10#32, Goto(7401); ! inform ODTPrq of bad interrupt (RcvDone,10); ! output signal - assert low Constant(CFalse,0); Constant(CTrue,1);  end;  Constant(VecInt,3400); !! Placement. Place(6000,6077);  Goto(IntX); ! dismiss disk interrupt !! parity interrupt service. ParInt: Iob(147), Loc(7634); Goto(IntX); ! dismiss parity interrupt !! video interrupt service. VidInt: VR, I!!! Link - Perq parallel link communications routines. ! J. P. Strait 11 July 80. ! Copyright (C) Three Rivob(343), Loc(7624); ! load VidState VR, Iob(340); ! load line count Vid1: 0, Iob(342); ers Computer Corporation 1980. ! Company Confidential. !! Change history. ! ! 4 Jun 81 J. Strait. !  ! load cursor address VR and 200; if Eql Goto(Vid2); ! if we didn't load second re Move Link.Micro to #6000. !!! Link provides a send and receive routine for use with the Perq ! parallel comtrace Screen, Iob(341); ! address of screen bit map div 2 0, Iob(344); ! loadmunications hardware. The routines send and receive ! 16 bit data words with timeout processing, but implement no other >  Goto(PutDst1); ! if lower byte SrcByte, LeftShift(10); ! move SrcByte to upper byte --------------------------------------------------------- BytCmp: tmp2 := NextOp; ! get length ---------------------------------------- GetDst: DstLsb; if Odd Goto(GetDst2); ! if upper byte GetDs DstWord := Shift or DstWord, ! put SrcByte in upper byte if IntrPend Call(VectSt1: Dst, Fetch; ! get a new word DstLsb := 1, if IntrPend Goto(GetDst3); ! next byte is upper rv); Dst - 1, Store; DstWord, Return; ! store destination word PutDst1:DstWord := DstWobyte DstWord := Mdi and not 377; ! current word DstByte := Mdi and 377, Return; ! current byte rd or SrcByte, Return; ! put SrcByte in lower byte ! Routine BytCmp. !---------------------------------------------------- GetDst2: DstWord, RightShift(10); ! get upper byte from current word DstByte := Shift and 377; ------------------------- ! ! Abstract: ! BytCmp compares two byte arrays. After the call to BytCmp, the Eql, !  ! current byte Dstword := DstWord and 377; ! current word Dst := Dst + 1, if IntrPend Call(Ve Neq, Leq, Lss, Geq, and Gtr condition codes can be used to check ! the results of the comparison. ! ! Environment: ! ctSrv); ! advance to next word DstLsb := 0, Return; ! next byte is lower byte ! Serve an inte Next byte in the opcode/operand stream = Length. ! If Length <> 0: ! (Tos) = Byte offset for ByteArray0rrupt. GetDst3: Call(VectSrv); Goto(GetDst1); ! Routine PutDst. !----------------------------------------------. ! (Tos-1) = Word address of ByteArray0. ! (Tos-2) = Byte offset for ByteArray1. ! (Tos-3) ------------------------------- ! ! Abstract: ! PutDst puts the next destination byte into a byte array or a string. != Word address of ByteArray1. ! If Length = 0: ! (Tos) = Length of byte arrays. ! (Tos-1) = Byte  ! Environment: ! Dst = Destination word physical address. ! DstLsb = Least significant bit of the destination byoffset for ByteArray0. ! (Tos-2) = Word address of ByteArray0. ! (Tos-3) = Byte offset for ByteArray1. te address. ! DstWord = Current destination word with current byte removed. ! SrcByte = Current source byte to be ! (Tos-4) = Word address of ByteArray1. ! ! Result: ! Length removed from opcode/operand stream. ! Ifput into the destination. ! ! Result: ! DstWord = Current destination word with source byte added. ! ! Calls: !  Length <> 0: ! Stack popped four times. ! If Length = 0: ! Stack popped five times. ! ALU VectSrv. ! !----------------------------------------------------------------------------- PutDst: DstLsb; if Odd result = ByteArray0 compared to ByteArray1. ! ! Calls: ! GetSrcDst, GetSrc, GetDst, VectSrv. ! !--------------------> riteCsr Tos := CTrue, Push, NextInst(0); !!! Snd - Send word to link. ! ! Address = 6010. ! s := CFalse, NextInst(0); ! set failure !!! Rcv - Receive word from link. ! ! Address = 6020.! Entry (Tos) = Data to send. ! ! Exit (Tos) = True if success, false otherwise. ! Send data and set ! ! Entry none. ! ! Exit (Tos) = True if success, false otherwise. ! (Tos-1) = Data iff suc SndDataReady. Snd: Tos, Iob(WriteData), Loc(6010); ! send the data WCsr := WCsr and not SndDataReady, Iob(cess. ! Wait for DataReady. Rcv: Count := not 0, Loc(6020); ! timeout count Rcv1: if IntrPend Call(WriteCsr); Count := 20; Snd1: Count := Count - 1, if Neq Goto(Snd1); WCsr := WCsr or SndDataReady, Iob(WritVecSrv); Count := Count - 1, Iob(ReadCsr); Iod and RcvDataReady, if Eql Goto(Rcv4); ! if timed out ieCsr); Tos := CTrue, NextInst(0); ! WCsr := WCsr and not SndDataReady, Iob(WriteCsr); ! set data reaf Eql Goto(Rcv1); ! if no data ready ! Clear RcvDone (signal that we are starting). dy ! !! Watch for no SndDone (receiver has started). ! ! Count := not 0;  WCsr := WCsr or RcvDone, Iob(WriteCsr); ! clear receive done ! Read the data. Iob(ReadDat ! timeout count !Snd1: if IntrPend Call(VecSrv); ! Count := Count - 1, Iob(ReadCsr); ! Iod and SndDonea); ! request the data Tos := Iod, Push; ! read the data !! , if Eql Goto(Snd3); ! if timed out ! if Neq Goto(Snd1); ! if receiver not yet started !  Watch for RcvDataReady to go away (sender is finished). ! ! Count := not 0; ! timeout co!! Clear SndDataReady (signal we are finished). ! ! WCsr := WCsr or SndDataReady, Iob(WriteCsr); ! clearunt !Rcv2: if IntrPend Call(VecSrv); ! Count := Count - 1, Iob(ReadCsr); ! Iod and RcvDataReady, if Eql Goto( data ready ! !! Watch for SndDone (receiver is finished). ! ! Count := 0; ! Rcv3); ! if timed out ! if Neq Goto(Rcv2); ! if data still ready ! !! Set RcvDone (data has timeout count !Snd2: if IntrPend Call(VecSrv); ! Count := Count - 1, Iob(ReadCsr); ! Iod and SndDone, if Eql been received). WCsr := WCsr and not RcvDone, Iob(WriteCsr); ! set receive done Tos := CTrue, Push, !!! Prs - Preset link. ! ! Address = 6000. ! ! Entry none. ! ! Exit Link initialized. ! Goto(Snd4); ! if timed out ! if Eql Goto(Snd2); ! if receiver not yet done ! Tos := CTrue,  (Tos) = True if success, false otherwise. Prs: WCsr := not RcvDone, Iob(WriteCsr), Loc(6000); ! initialize the WNextInst(0); ! set success ! !Snd3: WCsr := WCsr or SndDataReady, Iob(WriteCsr); ! clear data ready !Snd4: To? can be used to check ! the results of the comparison. The strings must be word aligned. ! ! Environment: ! (Tosrrupt. StrCmp5: Call(VectSrv); dstbyte - srcbyte, Goto(StrCmp2); $List $Title Call and return routines. ) = Byte offset for String0. ! (Tos-1) = Word address of String0. ! (Tos-2) = Byte offset for String1. ! (T ! Routine CllSub. !----------------------------------------------------------------------------- ! ! Abstract: ! Cllos-3) = Word address of String1. ! ! Result: ! Stack popped three times. ! ALU result = String0 compared with StSub is a common routine used by the call opcodes to build the new ! activation record and set up the new pointers (GP, APring1. ! ! Calls: ! GetSrcDst, GetSrc, GetDst, VectSrv. ! !----------------------------------------------------------, TP, etc.). ! ! Environment: ! tmp = New routine number. ! tmp5 = New code segment number. ! tmp6 = New if Neq Goto(BytCmp1); ! if non-zero length byte tmp2 := Tos, Pop; ! get length from e------------------- StrCmp: Call(GetSrcDst); ! get string pointers SrcLsb := SrcLsb xor 1; xpression stack BytCmp1: Call(GetSrcDst); ! get byte pointers Goto(BytCmp3);  ! skip length bytes DstLsb := DstLsb xor 1; Tos := dstByte - srcByte, Push; ! compare lengths, sa! enter comparison loop BytCmp2: if Lss Goto(BytCmp4), ! if done and all equal ve difference tmp := srcByte, if Geq Goto(StrCmp1); ! if src is shorter tmp := dstByte; ! Compare thdstbyte - srcbyte; ! compare bytes if Neq Goto(BytCmp5); ! if done and not equal BytCmp3:Call(GetSrc);e strings, tmp is length of shorter string. StrCmp1: if Eql Goto(StrCmp3); ! if strings equal up to tmp  ! get next byte Call(GetDst); ! get next byte tmp2 := tmp2 - 1, Call(GetSrc); ! get next character Call(GetDst); ! get next character  Goto(BytCmp2); ! count byte ! Byte arrays are equal. BytCmp4: 0, Return; ! return Eql  dstByte - srcByte, if IntrPend Goto(StrCmp5); StrCmp2:if Neq Goto(StrCmp4); ! if characters are not equa ! Byte arrays are not equal, return with condition codes set for ! byte comparison. BytCmp5: dstByte - srcBytl tmp := tmp - 1, Goto(StrCmp1); ! count the character ! Strings are equal up to length of shorter strine, Return; ! Routine StrCmp. !----------------------------------------------------------------------------- ! ! Abstract:g, return with ! condition codes set for length comparison. StrCmp3: Tos, Return; ! Strings are not equal, re ! StrCmp compares two strings. After the call to StrCmp, the Eql, ! Neq, Leq, Lss, Geq, and Gtr condition codes turn with condition codes set for character ! comparison. StrCmp4: dstByte - srcByte, Return; ! Serve an inte?  Use IO.Dfs to get definition of IntVec. ! Move Link.Micro to #7400. ! ! 4 Jun 81 J. Strait. ! Move True, Push, NextInst(0); !!! Snd - Send word to link. ! ! Address = 7410. ! ! Entry (Tos) = D NextInst(0); ! set success Rcv3: WCsr := WCsr and not RcvDone, Iob(WriteCsr); ! set receive done Rcv4: ToLink.Micro to #6000. !!! Link provides a send and receive routine for use with the Perq ! parallel communications := CFalse, Push, NextInst(0); ! set failure VecSrv: Vector(VecInt); end; s hardware. The routines send and receive ! 16 bit data words with timeout processing, but implement no other ! cSides 2 Density SINGLE Fast ! MICROCODE.SOURCE - MICROCODE SOURCES ! Created 05 Jun 81 12:50:06 Get PERQ.MIC ommunications protocol. !! Registers. Define(Count,350); ! Timeout counter Defi PERQ.MICRO Get PERQ.DFS PERQ.DFS Get QCODES.DFS PERQ.QCODES.DFS Get QCODE.1 PERQ.QCODEne(WCsr,351); ! Current WriteCsr value !! Constants. Constant(ReadCsr,4.1 Get QCODE.2 PERQ.QCODE.2 Get QCODE.3 PERQ.QCODE.3 Get QCODE.4 PERQ.QCODE.4 Get QCO0); ! Link input command/status Constant(ReadData,42); ! Link input data ConstaDE.5 PERQ.QCODE.5 Get QCODE.6 PERQ.QCODE.6 Get ROUTIN.1 PERQ.ROUTINE.1 Get ROUTIN.2 nt(WriteCsr,241); ! Link output command/status Constant(WriteData,243); ! Link output data  PERQ.ROUTINE.2 Get PERQ.INI PERQ.INIT Get RO.MIC RO.MICRO Get LINE.MIC LINE.MI Constant(SndDataReady,1); ! output signal - assert low Constant(SndDone,4); ! inCRO Get IO.MIC IO.MICRO Get IO.DFS IO.DFS Get IOE3.MIC IOE3.MICRO Get VFY.MIC put signal - assert high Constant(RcvDataReady,2); ! input signal - assert high Constant(RcvDone,1 VFY.MICRO Get SYSB.MIC SYSB.MICRO Get BOOT.MIC BOOT.MICRO Get KRNL.MIC KRNL.MICRO 0); ! output signal - assert low Constant(CFalse,0); Constant(CTrue,1); $Include I Get LINK.MIC LINK.MICRO O.Dfs !! Placement. Place(7400,7477); !!! Prs - Preset l!!! Link - Perq parallel link communications routines. ! J. P. Strait 11 July 80. ! Copyright (C) Three Rivink. ! ! Address = 7400. ! ! Entry none. ! ! Exit Link initialized. ! (Tos) = True iers Computer Corporation 1980. ! Company Confidential. !! Change history. ! ! 30 Jun 81 J. Strait. ! f success, false otherwise. Prs: WCsr := not RcvDone, Iob(WriteCsr), Loc(7400);! initialize the WriteCsr Tos := C@ ew pointers (GP, AP, TP, etc.). ! ! Environment: ! tmp = New routine number. ! tmp5 = New code segment number. e entry point. CllV: Tos := TP + 1, Push; ! address of new locals area tmp1 := Mdi + SB; ! tmp6 = New code base. ! tmp7 = New global pointer. ! tmp10 = New static link. ! tmp11 = Length of c ! PS = parameter size tmp2 := Mdi; ! RPS = result + parameter size tmp3 := Mall instruction (for PCBackup). ! S = Routine to jump to on stack overflow. ! First half of routine dictionary entdi; ! LTS = locals + temporaries tmp4 := Mdi; ! entry point ! ry fetched and readable on Mdi. ! ! Result: ! New activation record built. ! Code state pointers saved in ACB. Check for stack overflow tmp12 := TP; ! save TP in case of overflow TP := Tos + tmp3! Expression stack saved in ACB. ! Code state pointers updated. ! ! Calls: ! SvStk, VectSrv, S. ! !-----; TP := TP + 3; ! quad-align new ACB TP := TP and not 3, if IntrPend Call(VectSrv); ! ------------------------------------------------------------------------ CllSub: ! Get the new static link. new AP TP := TP + ACBReserve; SL - TP; TP := TP - ACBReserve, if C19 Goto(CllSub4); ! if stack overf tmp4 := tmp6; ! new code base (for GetLL) tmp10 := tmp, Call(GetLL); ! get new lexilow ! Build new ACB. CllSub2: LP := Tos - tmp2, Pop; ! new LP = local pointer tmp2 := TP; code base. ! tmp7 = New global pointer. ! tmp11 = Length of call instruction (for PCBackup). ! S = Routine cal level tmp2 := Mdi - 2; tmp3 := tmp1, ! save address of LL in RD to jump to on stack overflow. ! ! Result: ! New activation record built. ! Code state pointers saved in ACB. !  if Leq Goto(CllSub3); ! if calling a top-level routine tmp4 := CB; ! current codebase  Expression stack saved in ACB. ! Code state pointers updated. ! ! Calls: ! GetLL, GetSL, SvStk, VectSrv, S tmp10 := RN, Call(GetLL); ! get current LL tmp2 := tmp2 + 2; ! new lex level . ! !----------------------------------------------------------------------------- ! Routine CllV. !---------------------- tmp1 := Mdi - tmp2; ! current LL - new LL ! (typically positiv------------------------------------------------------- ! ! Abstract: ! CllV is a common routine used to make a call toe) tmp10 := AP, if Geq Call(GetSL); ! if not calling deeper ! if call a routine described ! by a variable routine descriptor. CllV builds the new activation ! record and set up the ning deeper, new SL = AP CllSub1: tmp3 - RDLL, Fetch4; ! get 1st half of RD entry ! Call variable routin@ f IntrPend Call(VecSrv); ! Count := Count - 1, Iob(ReadCsr); ! Iod and SndDone, if Eql Goto(Snd4); ! if timed  WCsr := WCsr and not RcvDone, Iob(WriteCsr); ! set receive done Tos := CTrue, Push, NextInst(0); ! set out ! if Eql Goto(Snd2); ! if receiver not yet done ! Tos := CTrue, NextInst(0); !success Rcv3: WCsr := WCsr and not RcvDone, Iob(WriteCsr); ! set receive done Rcv4: Tos := CFalse, Push, NextIn set success ! !Snd3: WCsr := WCsr or SndDataReady, Iob(WriteCsr); ! clear data ready !Snd4: Tos := CFalse, NextInst(0);st(0); ! set failure VecSrv: Vector(IntVec); end;  ! set failure !!! Rcv - Receive word from link. ! ! Address = 7420. ! ! Entry noneata to send. ! ! Exit (Tos) = True if success, false otherwise. ! Send data and set SndDataReady. Snd: . ! ! Exit (Tos) = True if success, false otherwise. ! (Tos-1) = Data iff success. ! Wait for Tos, Iob(WriteData), Loc(7410); ! send the data WCsr := WCsr and not SndDataReady, Iob(WriteCsr); Count DataReady. Rcv: Count := not 0, Loc(7420); ! timeout count Rcv1: if IntrPend Call(VecSrv); Count : := 20; Snd1: Count := Count - 1, if Neq Goto(Snd1); WCsr := WCsr or SndDataReady, Iob(WriteCsr); Tos := CT= Count - 1, Iob(ReadCsr); Iod and RcvDataReady, if Eql Goto(Rcv4); ! if timed out if Eql Goto(Rcv1); rue, NextInst(0); ! WCsr := WCsr and not SndDataReady, Iob(WriteCsr); ! set data ready ! !!  ! if no data ready ! Clear RcvDone (signal that we are starting). WCsr := WCsr or RcvDone Watch for no SndDone (receiver has started). ! ! Count := not 0; ! timeout count !, Iob(WriteCsr); ! clear receive done ! Read the data. Iob(ReadData); Snd1: if IntrPend Call(VecSrv); ! Count := Count - 1, Iob(ReadCsr); ! Iod and SndDone, if Eql Goto(Snd3); !  ! request the data Tos := Iod, Push; ! read the data !! Watch for RcvDataReady tif timed out ! if Neq Goto(Snd1); ! if receiver not yet started ! !! Clear SndDataReao go away (sender is finished). ! ! Count := not 0; ! timeout count !Rcv2: if IntrPenddy (signal we are finished). ! ! WCsr := WCsr or SndDataReady, Iob(WriteCsr); ! clear data ready ! ! Call(VecSrv); ! Count := Count - 1, Iob(ReadCsr); ! Iod and RcvDataReady, if Eql Goto(Rcv3); ! if timed out !! Watch for SndDone (receiver is finished). ! ! Count := 0; ! timeout count !Snd2: i if Neq Goto(Rcv2); ! if data still ready ! !! Set RcvDone (data has been received). A := UState and 17; UPC - CB, LeftShift(1); tmp13 := Shift + tmp13; TP := TP + 4, Store4; tmp1re Both stacks. CllSub4: TP := tmp12, Pop, GotoS; ! Routine SaveStack. !------------------------------------------------2 - tmp1; ! new TL = top link = old TP CS; ! return CS = code s----------------------------- ! ! Abstract: ! SaveStack saves the expression stack in the activation control block. ! egment tmp13; ! RA = return address RN; ! RR =  ! Environment: ! TP = First word address of the saved stack (length word + 1). ! tmp = -1. ! ! Result: ! return routine number RN := tmp; ! new RN = routine number CS := tmp5, if IntrPend C Expression stack pushed onto memory stack. ! tmp = Number of saved words. ! !-----------------------------------------all(VectSrv); ! new CS = code segment TP := TP + 4, Store; 0; ! new EP = ex------------------------------------ SaveStack: UState and 1000; ! extract StackEmpty field tmp := ception pointer CB := tmp6; ! new CB = code base AP := tmp2; tmp + 1, if Eql Return; ! bottom of stack reached TP := TP + 1, Store; Tos, Pop, Goto(SaveStack);  ! new AP = activation pointer ! Save the expression stack. tmp := not 0, if IntrPend Call(VectSrv); ! -1  ! store a word (***** ! Routine RestoreStack. !----------------------------------------------------------------------- TP := TP + 1, Call(SaveStack); ! start after length word TP - tmp, Store; tmp, if IntrPend Call(------ ! ! Abstract: ! RestoreStack restores the expression stack from the ACB prior to ! returning from a routiVectSrv); ! store E-stack length GP := tmp7; ! new GP = global pointer ! Set up ne. ! ! Environment: ! Expression stack empty. ! ! Result: ! Expression stack restored. ! ! Calls: ! new PC. ! ----> The following instruction is a good place to set a breakpoint. CS, ! ----> RN, and UPC have their new valueVectSrv. ! !----------------------------------------------------------------------------- RestoreStack:AP + ACBStackSize, F ! new AP = activation pointer TP, Store4; tmp10 - SB; ! new SL =s, although BPC doesn't yet. BPC := tmp4 and 7; ! CB is on a 256 word boundary tmp4 and no static link LP - SB; ! new LP = local pointer AP - SB; t 7, RightShift(1); UPC := Shift + CB, Return; ! quad program counter ! Set SL for top-level routine ! new DL = dynamic link = old AP GP - SB; ! new GL = global link = old GP tmp13 s: LL <= 2. CllSub3: tmp10 := SB, Goto(CllSub1); ! static link is not used ! Signal a stack overflow. RestoA  'Hold's that were lost in version 0.1. ! ! V0.1 8 Oct 80 BR Added No Power Down bit to SrcRasterOp ! define(SrcBas*** same register as DstX *** define(DstBinW,115); ! destination bit in word *** same register as DstY *** define(LeftSre,116); ! base address (origin word) of source define(DstBase,117); ! base address (origin word) of destination define(Sc,120); ! leftmost source bit in word define(LeftDst,121); ! leftmost destination bit in word define(LastDst,122); ! rcQuad,100); ! memory address of source data (quad aligned) define(DstQuad,101); ! memory address of destination data (qulast destination word in quad define(DstRas,121); ! DstRasterOp value *** same register as LeftDst *** define(SrcRas,120ad aligned) define(SrcLineInc,102); ! # of words between last quad of one line and 1st ! quad of next ); ! srcRasterOp value *** same register as LeftSrc *** define(Flag,123); ! bit 7 = 1 SrcQuad, bit 0 = trip flag inline -> ScanLineLength - width (words) ! with -1, +1 effects taken into account define(DstLineInc,103) SetUp define(Direction,124); ! 0 for left to right, not 0 for right to left define(r370,370); !! CntlRasterOp Fu; ! same for destination define(Height,104); ! height (in bits) of area to be moved define(Width,105); ! width (in Binctions ! Bit 0 = LtoR ! Bit 1 = RO/PS (1 = RasterOp On) ! Bit 2:4 = RasterOp Functions ! Bit 5ts) of area to be moved define(Func,111); ! RasterOp function (3 bits) ! ***Note*** Following register definiti = XtraSrcWord ! Bit 6 = disable processor shift constant(Off,200); ! RasterOp Off constant(PauseLR,100); ons use the SAME register. define(XtraSrcFetch,106); ! Bit 7 set if more source than dest quads needed define(XtraSrcWord,106); ! Bit 0 set if more source than dest words needed define(OneQuad,106); ! Bit 15 set if only 1 dest quad is needed $Title RasterOp Microcode. !!! RasterOp Microcode Version 0.1 ! ! Brian Rosen & Stan Kriz & John Strait ! define(MidNum,107); ! number of quads wide - 2 (ie # of mid cycles to do) define(MidCnt,110); ! counter for MidNum d Copyright (C) Three Rivers Computer, 1981. ! ! ! V0.5 16 Jul 81 JPS Change "Company Confidential" notice to "Copyright".efine(SrcX,112); ! source X value define(SrcY,113); ! source Y value define(DstX,114); ! destination X value ! ! V0.4 18 May 81 JPS Change RO to be an include file. ! ! V0.3 29 Apr 81 JPS Provide an entrypoint that writes fr define(DstY,115); ! destination Y value define(SrcBinQ,112); ! source bit in quad *** same register as SrcX *** om a packed array ! of characters (or from a string for that matter). ! ! V0.2 22 Oct 80 JPS Addeddefine(SrcBinW,113); ! source bit in word *** same register as SrcY *** define(DstBinQ,114); ! destination bit in quad B etch; tmp1 := AP; tmp1 := tmp1 + ACBSaveStack; tmp2 := Mdi; ! number of savedes ! to zero in the memory stack. ! ! Environment: ! Segment and routine numbers are in the opcode/operand strea words of stack tmp1 := tmp1 + tmp2, if Eql Return; ! if no words to restore Restore1: tmp1 := tmp1 - 1, Fetch; m. ! tmp2 = Target AP. ! ! Result: ! Appropriate return addresses set to zero. ! ! Calls: ! WordParm, X tmp2 := tmp2 - 1, Push, if IntrPend Goto(Restore2); Tos := Mdi, if Gtr Goto(Restore1); ! if more words to restoreSTMap, VectSrv. ! !----------------------------------------------------------------------------- ExSub: Call(WordParm);  Return; ! Serve an interrupt. Restore2: tmp1 := tmp1 + 1, Call(VectSrv); Pop, tmp2 := tmp2 + 1, G ! get ISN tmp := Shift + tmp, Call(XSTMap); ! convert to XSN tmp1 := NextOp; oto(Restore1); *****) ! Routine RetExit. !----------------------------------------------------------------------------- ! ! get routine number tmp - CS; tmp2 := AP, if Neq Goto(ExSub1); ! if different code segment  ! Abstract: ! RetExit is used when a RETURN instruction finds that the return ! address is zero. This means tha tmp1 - RN; if Eql Return; ! if current routine ExSub1: tmp2 + ACBRA, Store; t the return address is the exit ! point of the routine. ! ! Result: ! PC set to exit point of current routine.  ! set a return address to zero 0; if IntrPend Call(VectSrv); tmp2 + ACBRS, Fetch; !  ! ! Calls: ! VectSrv. ! !----------------------------------------------------------------------------- RetExit: CBget return segment number Mdi - tmp; if Neq Goto(ExSub2); ! if segment numbers don't match , Fetch; ! fetch dictionary address Hold, RN, LeftShift(3); Hold, tmp1 := Shift + CB; tmp2 + ACBRR, Fetch; ! get return routine number Mdi - tmp1; if Eql Return;  Hold, tmp1 := tmp1 + RDEXIT; Hold, Mdi + tmp1, Fetch; ! fetch exit word in dictionary BP ! if routine numbers match, done ExSub2: tmp2 + ACBDL, Fetch; ! get next ACB tmp2 := Mdi + SC := Mdi and 7, RightShift(1); ! set BPC and UPC Mdi and not 7; UPC := Shift + CB, Return; ! Routine EB, Goto(ExSub1); $Title Error processing routines. ! Routine ChkOvr. !--------------------------------------------xSub. !----------------------------------------------------------------------------- ! ! Abstract: ! ExSub is used by --------------------------------- ! ! Abstract: ! ChkOvr signals a ErrInxCase error. ChkOvr is not called, rather it EXIT and EXGO to get the target segment number and ! routine number from the opcode/operand stream and set return address! is jumped to. It exits to RunError0. ! ! Result: ! tmp2 = ErrInxCase. ! ! Calls: ! RunError1. ! !--B  ! Begin/End - NoClear - XtraSourceWord constant(Phase4LR,122); ! XtraSource - NoClear constant(Phase5LR,126); ! es; ! destination X LeftDst := Tos and 17; ! leftmost destination bit in word tmp1 := Tos and FirstSource - Clear constant(Phase6LR,132); ! End - Clear constant(Phase7LR,136); ! Begin/End - Clear const77, Pop; ! destination bit in quad LastDst := DstX; ! in preparation for LastDst computation ant(Phase7XLR,176); ! Begin/End - Clear - XtraSourceWord constant(Phase0RL,103); ! Begin - NoClear constant Height := Tos - 1, Pop; ! height-1 of block in bits Direction := 0, if IntrPend call(IntrIt); ! assume le(Phase0XRL,143); ! Begin - NoClear - XtraSourceWord constant(Phase1RL,107); ! Mid - NoClear constant(Phasft to right Width := Tos - 1, Pop; ! width-1 of block in bits Width := Width and AllOnes; e2RL,113); ! End - NoClear constant(Phase3RL,117); ! Begin/End - NoClear constant(Phase3XRL,157); ! BeginFunc := not Tos; ! function code Rop0: tmp1 + Width, RightShift(6); MidNum := Shift - 1; !/End - NoClear - XtraSourceWord constant(Phase4RL,123); ! XtraSource - NoClear constant(Phase5RL,127); ! FirstSourc # of middle quads (quad width - 2) OneQuad := 200, if Geq goto(Rop1); ! clear all flags OneQuad := OneQe - Clear constant(Phase6RL,133); ! End - Clear constant(Phase7RL,137); ! Begin/End - Clear constant(Phase7uad or 100000; ! set one quad Rop1: Flag := 0, if IntrPend call(IntrIt); tmp + Width, RightShift(6); XRL,177); ! Begin/End - Clear - XtraSourceWord Loc(RasterOp), Call(Rop); NextInst(0); Rop: SrcB Shift; Tos := SrcBase - DstBase, if Neq goto(Rop2); ! if source > 1 quad Flag := 200; ase := Tos, Pop; ! source address, 20-bit offset SrcLineInc := Tos and AllOnes, Pop; ! source words per sca ! set 1 source quad Rop2: Tos - 1; ! 20-bit equality test SrcY - DstY, if C19 goto(Comparn line SrcY := Tos and AllOnes, Pop; ! source Y SrcX := Tos and AllOnes, if IntrPend call(IntrIt); ! source); ! if Eql, compare X and Y !! Perform raster-op left to right if ! (SrcBase <> DstBase) or !  ! RasterOp Pause, processor shift is disabled constant(PauseRL,101); constant(Phase0LR,102); ! Begin - NoCleare X LeftSrc := Tos and 17; ! leftmost source bit in word tmp := Tos and 77, Pop; ! source bit constant(Phase0XLR,142); ! Begin - NoClear - XtraSourceWord constant(Phase1LR,106); ! Mid - NoClear con in quad DstBase := Tos, Pop; ! destination address, 20-bit offset DstLineInc := Tos and AllOnes, stant(Phase2LR,112); ! End - NoClear constant(Phase3LR,116); ! Begin/End - NoClear constant(Phase3XLR,156); Pop; ! destination words per scan line DstY := Tos and AllOnes, Pop; ! destination Y DstX := Tos and AllOnC se in segment ExcCS (procedure Raise in module Except). ! The caller pushes parameters to the exception (if any) onto theWayBranch(0); ! PStart TP := TP + 1, Store; Tos, Pop; ! PEnd tmp5 := ! memory stack before calling ErrCall. ErrCall is jumped to and ! exits to RefillJmp. If the Except module has  ExcCS, ThreeWayBranch(0); ! segment number of Raise tmp := tmp5, Call(ChkSeg); tmp6 := tmp, not been initialized, ! is non-resident, or a stack overflow happens while calling Raise, ! transfer to Busted. ! ! code base of Raise if Odd Goto(Busted); ! if not resident tmp := RNRaise, --------------------------------------------------------------------------- ChkOvr: tmp2 := ErrInxCase, Goto(RunError0);  ! Environment: ! tmp3 = ParameterSize = Number of words of parameters. ! ExcCS = Segment number of the Except mo! Routine ChkStk. !----------------------------------------------------------------------------- ! ! Abstract: ! ChkStdule. ! ExcGP = Global pointer of the Except module. ! tmp1 = Segment number of the exception. ! tmp2 = Rouk checks to be sure that N words can be pushed onto the memory ! stack without overflowing. If the words will not fit, Ctine number of the exception. ! ! Result: ! Micro level call stack cleared. ! Four words pushed on the memory sthkStk jumps ! to the address in the 2910's S register. ! ! Environment: ! tmp10 = Number of words. ! S = ack. ! Memory[TP - 0] = PStart = TP - 3 - ParameterSize. ! Memory[TP - 1] = PEnd = TP - 3. ! Memory[TP - 2]Address of stack overflow handler. ! ! Result: ! tmp10 unchanged. ! ! Calls: ! VectSrv. ! !----------------- = ER = tmp2. ! Memory[TP - 3] = ES = tmp1. ! tmp10 unchanged. ! ExcCS unchanged. ! ExcGP unchanged.------------------------------------------------------------ ChkStk: tmp10 := tmp10 + TP, Goto(ChkStk2); ChkStk1: Call(Vec ! tmp1 unchanged. ! ! Calls: ! ChkSeg, CllSub, RefillJmp, VectSrv. ! ! Design: ! If the Except module tSrv); ! serve an interrupt ChkStk2: SL - tmp10, if IntrPend Goto(ChkStk1); tmp10 := tmp10 - TP, has not been initialized, ExcCS = 0. Since ! segment 0 is guaranteed to be non-resident, we need not make a ! sepif C19 Goto(ChkStk3); ! if no room Return; ! there's room, so return ! No room, arate check for ExcCS = 0. ! !----------------------------------------------------------------------------- ErrCall: TP := signal error by jumping to S. ChkStk3:GotoS; ! Routine ErrCall. !------------------------------------------------------TP + 1, Store; tmp1, ThreeWayBranch(0); ! ES, clear the call stack Tos := TP - SB, Push; ----------------------- ! ! Abstract: ! ErrCall initiates the raising of an exception by calling routine ! RNRaiTP := TP + 1, Store; tmp2, ThreeWayBranch(0); ! ER TP := TP + 1, Store; Tos - tmp3, ThreeC  ((SrcBase = DstBase) and ! ((SrcY > DstY) or ((SrcY = DstY) and (SrcX >= DstX)))) LtoR: LastDs ! 3 BegQ1T1: SrcQuad := SrcQuad + 4, Fetch4; !Q1 1 MA := DstQuad, Store4, call(Nopt := LastDst + Width, call(SetUp); ! Synchronize memory and code with a fetch. For some obscure reason, ! mem2); ! 2 MidCnt := MidNum; !Q0 1 BegQ2T2: if Neq GoTo(BegQ2T3b); ! ory cycles are numbered differently here: T1 is the cycle a ! Fetch starts in. ! ! Labels on micro-instruction2 away if > 2 quads BegQ2T3: CntlRasterOp(Phase6LR); ! 3 else, this is the end nop; s indicate the action being performed: ! ! Xsr - Extra source fetch cycle. ! Beg - Begin cycle. ! Mid - !Q0 0 End DstQuad := DstQuad + 4, Fetch4, Call(LREndCom); ! 1 XtraSrcFetch, If Lss  Middle cycle. ! End - End cycle. ! BgE - Begin/End cycle. ! ! Qn - Quad timing cycle n. ! Tn -GoTo(ExitRO); !Q2 0 EndQ2T1: XtraSrcWord, IF ByteSign GoTo(XsrQ2T2); ! 1 nop;  Micro timing cycle n. DstQuad := DstQuad - DstLineInc, Fetch, Call(Nop1); !synchronize CntlRasterOp(Phase ! 2 EndQ2T3: CntlRasterOp(Phase4LR); ! 3 XsrQ0T0: Hold; !Q0 0 X5LR); !t3 and here we go Hold, LoadS(IntrCom); !Q0 0 First Src is always 1st tra Src SrcQuad := SrcQuad + 4, Fetch4, GoTo(XsrQ0T2); ! 1 BegQ2T3b:0, CntlRasterOp(Phase1LR); !Q2  SrcQuad := SrcQuad, Fetch4, call(Nop1); ! 1 OneQuad; ! 3 XtraSrcF3 no Video interrupt MidQ0T0: If Neq GoTo(IntrA); !Q0 0 Mid DstQuad := DstQuad + 4, Fetch4, caetch, Hold, if geq GoTo(EndQ2T1);!Q2 0 XtraSrcWord, If ByteSign GoTo(XsrQ2T2b); ! 1 GoTo(EndQ2T3); ll(Nop3);! 1 SrcQuad := SrcQuad + 4, Fetch4; !Q1 1 MA := DstQuad, Store4, call(Nop2); ! 2 ! 2 XsrQ0T2: nop, call(Nop1); !Q0 2 Xtra Src has only 2 OneQuad, Hold; IOB(145), MidCnt := MidCnt - 1; !Q2 1 Video state tmp := IOD and 20, if eql goto(BegQ2T3); ! 2  !Q2 0 quad cycles XtraSrcWord, If lss Goto(XsrQ2T2b); ! 1 XsrQ2T2: If Odd G Video interrupt bit tmp, GoTo(MidQ0T0); ! 3 XsrQ2T3b:CntlRasterOp(Phase0XLR); oTo(XsrQ2T3b); ! 2 XsrQ2T3: CntlRasterOp(Phase0LR); ! 3 BegQ0T0: If IntrPend GoTo(IntrB !Q2 3 Xtra Src if IntrPend GoTo(IntrE); !Q0 0 Begin DstQuad := DstQuad + DstLineInc, Fe); !Q0 0 Begin DstQuad := DstQuad + DstLineInc, Fetch4, call(Nop1); ! 1 BegQ0T3: nop, call(Nop1); tch4; ! 1 GoTo(BegQ0T3); !Q0 2 XsrQ2T2b:If Odd GoTo(XsrQ2T3d); D . ! !----------------------------------------------------------------------------- PCBackup: tmp := UState and 17;  ErrCall. ! !----------------------------------------------------------------------------- RunError0: tmp3 := 0; Loc(RunE ! get byte program counter UPC, LeftShift(1); ! word program counter ==> bytes tmp := Srror), tmp1 := ExcCS, Goto(ErrCall); ! Routine SASErr. !------------------------------------------------------------------hift + tmp, if IntrPend Call(VectSrv); ! full byte PC tmp := tmp - tmp11, RightShift(1); ! new byte program counter ----------- ! ! Abstract: ! SASErr causes the ErrStrLong error. ! ! Result: ! tmp2 = ErrStrLong. ! ! Calls:  UPC := Shift and not 3; ! set UPC back BPC := tmp and 7, Return; ! set BPC back !  ! RunError0. ! !----------------------------------------------------------------------------- SASErr: tmp2 := ErrStrRoutine RunError, RunError0. !----------------------------------------------------------------------------- ! ! Abstract: ! Long, Goto(RunError0); ! Routine SegFault. !-----------------------------------------------------------------------------  RunError is called when the microcode wants to raise an exception. ! The caller pushes parameters to the exception ! ! Abstract: ! SegFault signals a segment fault error. If SegFault is called from ! STLATE, two segment numbers ! routine number of Raise LoadS(Busted); ! where to go on stack overflow tm(if any) onto the ! memory stack before calling RunError. RunError is jumped to and ! exits to ErrCall. The varip7 := ExcGP, ThreeWayBranch(0); tmp7 := tmp7 + SB, Call(CllSub); ! global pointer of Raise Goto(RefillJmp)ant of RunError that is called depends ! on how many words of parameters were pushed on the memory stack. ! RunErr; ! enter the routine ! Routine PCBackup. !------------------------------------------------------------or0 is called when 0 words were pushed. If parameters were ! pushed onto the memory stack, RunError can be called with P----------------- ! ! Abstract: ! PCBackup sets the Q-code program counter back N bytes. This is ! used when a arameterSize ! in tmp3. ! ! Environment: ! tmp3 = ParameterSize = Number of words of parameters (if calling ! recoverable error is detected (e.g. segment fault). ! The PC is set back in order that the instruction can be re-executed RunError, not RunError0. ! ExcCS = Segment number of the Except module. ! ExcGP = Glob ! after the error condition is cleared. ! ! Environment: ! tmp11 = Number of bytes. ! ! Result: ! tmp al pointer of the Except module. ! tmp2 = Error number = Routine number of the exception. ! ! Result: ! tmp3 unc= New program counter as byte offset from code base. ! UPC set back. ! BPC set back. ! ! Calls: ! VectSrvhanged. ! ExcCS unchanged. ! ExcGP unchanged. ! tmp2 unchanged. ! tmp1 = ExcCS. ! ! Calls: ! D  !Happens at t2, will return to t3 IntrB: CntlRasterOp(Off), CallS; !Interrupt in Begin dle cycle. ! End - End cycle. ! BgE - Begin/End cycle. ! ! Kn - Quad timing cycle n (Qn). ! Tn  GoTo(XsrQ2T3); !Happens at t2, will return to t3 IntrC: CntlRasterOp(Off), CallS; !Interrup- Micro timing cycle n. DstQuad := DstQuad + DstLineInc, Fetch, Call(Nop1); !synchronize CntlRasterOp(Phast in Begin/End GoTo(XsrQ2T3c); !Happens at t2, will return to t3 IntrD: CntlRasterOp(Off), Cae5RL); !t3 and here we go Hold, LoadS(IntrCom); !Q0 0 First Src is always 1st  !Q2 2 Xtra Src XsrQ2T3c:CntlRasterOp(Phase7LR); ! 3 BgEQ0T0: If IntrPend GoTo(IntrC); !QllS; !Interrupt in Begin/End XtraSrc GoTo(XsrQ2T3d); !Happens at t2, will return to t3 0 0 Begin/End DstQuad := DstQuad + DstLineInc, Fetch4, Call(LREndCom); ! 1 XtraSrcFetch, Hold, If Lss GoT IntrE: CntlRasterOp(Off), CallS; !Interrupt in Begin XtraSrc GoTo(XsrQ2T3b); !Happeno(ExitRO); !Q2 0 XtraSrcWord, IF ByteSign GoTo(XsrQ2T2b); ! 1 GoTo(EndQ2T3); ! s at t2, will return to t3 !! Compare source start bit with destination start bit. Compare: SrcY - DstY, if Gtr got 2 XsrQ2T3d:CntlRasterOp(Phase7XLR); !Q2 3 Xtra Src If IntrPend GoTo(IntrD); !Q0 0o(LtoR); ! if SrcY > DstY SrcX - DstX, if Neq goto(RtoL); ! if SrcY < DstY if Geq Begin/End DstQuad := DstQuad + DstLineInc, Fetch4, Call(LREndCom); ! 1 XtraSrcFetch, If Lss GoTo(ExitRO) goto(LtoR); ! if SrcX >= DstX !! Perform raster-op right to left if ! (SrcBase = DstBase) and ; !Q2 0 XtraSrcWord, Hold, IF ByteSign GoTo(XsrQ2T2b); ! 1 GoTo(EndQ2T3); ! ((SrcY < DstY) or ((SrcY = DstY) and (SrcX < DstX))) RtoL: SrcY := SrcY + Height; ! start ! 2 LREndCom:nop, call(Nop2); !Q0 2 End and Begin/End SrcQuad := SrcQuad + SrcLinX, Y for RtoL case SrcX := SrcX + Width; DstY := DstY + Height; DstX := DstX + Width; DieInc, Fetch4; !Q1 1 MA := DstQuad, Store4; ! 2 Height := Height - 1, Return; rection := not 0, call(SetUp); ! Synchronize memory and code with a fetch. For some obscure reason, ! memory ! 3 IntrA: CntlRasterOp(PauseLR); !Video interrupt in Middle Call(VidInt); !cycles are numbered differently here: T1 is the cycle a ! Fetch starts in. ! ! Labels on micro-instructions inVideo interrupt service Call(IntrComA); !join common code in IntrCom GoTo(BegQ2T3b); dicate the action being performed: ! ! Xsr - Extra source fetch cycle. ! Beg - Begin cycle. ! Mid - MidE Memory[TP - 3] = First segment number. ! Segment fault error signalled. ! ! Calls: ! PCBackup, RunError. ! !--= SL + StackLimit; ! add a little extra to work with tmp2 := ErrStackOverflow, Goto(RunError0); ! Rou--------------------------------------------------------------------------- SegFault1: tmpstk0 := tmp5; SegFault: TP := TP +tine UOP. !----------------------------------------------------------------------------- ! ! Abstract: ! UOP signals a 1, Store; tmp5; TP := TP + 1, Store; tmpstk0; TP := TP + 1, Store; SS; TPn ErrUndfQcd error. ! ! Result: ! tmp2 = ErrUndfQcd. ! ! Calls: ! RunError0. ! !---------------------------- := TP + 1, Store; CS; tmp3 := 4, Call(PCBackup); ! 4 words of parameters on MStack tmp2 := E------------------------------------------------- UOP: tmp2 := ErrUndfQcd, Goto(RunError0); $NoList $Title InterrrSegmentFault, Goto(RunError); ! Routine StkOv. !-------------------------------------------------------------------------rupts: Microcode level and Pascal level. ! Routine UserSrv. !------------------------------------------------------------------ ! ! Abstract: ! StkOv signals a stack overflow error. ! ! Environment: ! tmp11 = Amount to back up the pr--------------- ! ! Abstract: ! UserSrv serves Pascal level interrupts by calling the appropriate ! Pascal levelogram counter. ! ! Result: ! Program counter backed up. ! Stack overflow error signalled. ! ! Calls: !  interrupt service routine. ! ! Environment. ! UserIntr bits 0..14 non-zero. That is, UserIntr > 0. ! ! Result: ! PCBackup, RunError0. ! !----------------------------------------------------------------------------- ! Routine StkOvPop.  One interrupt served. ! ! Calls: ! ChkSeg, CllV, RefillJmp, VectSrv, StkOv. ! ! Design: ! It is assumed t!----------------------------------------------------------------------------- ! ! Abstract: ! StkOvPop signals a stackhat: ! 1) The segment with the interrupt handler is always resident. ! 2) The table with variable routine de are passed. Otherwise, tmp5 contains a ! segment number, and SegFault is entered at SegFault1. ! ! Environment: !  overflow error after popping the expression ! stack. ! ! Environment: ! tmp11 = Amount to back up the program c tmp5 = First segment number. ! tmpstk0 = Second segment number. ! tmp11 = Amount to back up the program counteounter. ! ! Result: ! Stack popped. ! Program counter backed up. ! Stack overflow error signalled. ! ! r. ! ! Result: ! Program counter backed up. ! Four words pushed onto the memory stack. ! Memory[TP - 0] =Calls: ! PCBackup, RunError0, SetQState. ! !--------------------------------------------------------------------------- Code segment number. ! Memory[TP - 1] = Stack segment number. ! Memory[TP - 2] = Second segment number. ! -- StkOvPop: Pop; StkOv: Call(PCBackup); tmp := 100, Call(SetQState); ! set stack limit (SL) SL :E op2); ! 2 MidCnt := MidNum; !Q2 1 BegK2T2: if Neq GoTo(BegK2T3b); !  !Q0 0 Begin/End DstQuad := DstQuad - DstLineInc, Fetch4R, Call(RLEndCom);! 1 XtraSrcFetch, Hold, If Lss  2 away if > 2 quads BegK2T3: CntlRasterOp(Phase6RL); ! 3 else, this is the end nop; GoTo(ExitRO); !Q2 0 XtraSrcWord, IF ByteSign GoTo(XsrK2T2b); ! 1 GoTo(EndK2T3);  !Q0 0 End DstQuad := DstQuad - 4, Fetch4R, Call(RLEndCom); ! 1 XtraSrcFetch, Hold,! 2 XsrK2T3d:CntlRasterOp(Phase7XRL); !Q2 3 Xtra Src If IntrPend GoTo(IntrI); !Q If Lss GoTo(ExitRO); !Q2 0 EndK2T1: XtraSrcWord, IF ByteSign GoTo(XsrK2T2); ! 1 nop; 0 0 Begin/End DstQuad := DstQuad - DstLineInc, Fetch4R, Call(RLEndCom);! 1 XtraSrcFetch, If Lss GoTo(Exit ! 2 EndK2T3: CntlRasterOp(Phase4RL); ! 3 XsrK0T0: Hold; !Q0 0 RO); !Q2 0 XtraSrcWord, IF ByteSign GoTo(XsrK2T2b); ! 1 GoTo(EndK2T3); !  Xtra Src SrcQuad := SrcQuad - 4, Fetch4R, GoTo(XsrK0T2);! 1 BegK2T3b:0, CntlRasterOp(Phase1RL); !Q 2 RLEndCom:nop, call(Nop2); !Q0 2 End and Begin/End SrcQuad := SrcQuad - SrcLineInc, Fetch SrcQuad := SrcQuad, Fetch4R, call(Nop1); ! 1 OneQuad; ! 3 XtraSrc2 3 no Video interrupt MidK0T0: If Neq GoTo(IntrF); !Q0 0 Mid DstQuad := DstQuad - 4, Fetch4R,Fetch, Hold, if geq GoTo(EndK2T1);!Q2 0 XtraSrcWord, If ByteSign GoTo(XsrK2T2b); ! 1 GoTo(EndK2T3);  call(Nop3);! 1 SrcQuad := SrcQuad - 4, Fetch4R; !Q1 1 MA := DstQuad, Store4R, call(Nop2); !  ! 2 XsrK0T2: nop, call(Nop1); !Q0 2 Xtra Src has only 2 OneQuad, Hold 2 IOB(145), MidCnt := MidCnt - 1; !Q2 1 Video state tmp := IOD and 20, if eql goto(BegK2T3); ! ; !Q2 0 quad cycles XtraSrcWord, If lss Goto(XsrK2T2b); ! 1 XsrK2T2: If Odd  2 Video interrupt bit tmp, GoTo(MidK0T0); ! 3 XsrK2T3b:CntlRasterOp(Phase0XRL); GoTo(XsrK2T3b); ! 2 XsrK2T3: CntlRasterOp(Phase0RL); ! 3 BegK0T0: If IntrPend GoTo(Intr !Q2 3 Xtra Src If IntrPend GoTo(IntrJ); !Q0 0 Begin DstQuad := DstQuad - DstLineInc,G); !Q0 0 Begin DstQuad := DstQuad - DstLineInc, Fetch4R, call(Nop1);! 1 BegK0T3: nop, call(Nop1); Fetch4R;! 1 GoTo(BegK0T3); !Q0 2 XsrK2T2b:If Odd GoTo(XsrK2T3d);  ! 3 BegK1T1: SrcQuad := SrcQuad - 4, Fetch4R; !Q1 1 MA := DstQuad, Store4R, call(N !Q2 2 Xtra Src XsrK2T3c:CntlRasterOp(Phase7RL); ! 3 BgEK0T0: If IntrPend GoTo(IntrH); F --------- UserSrv: tmp := UserIntr; tmp and 377; dst := 0, Goto(UserSrv1); ! initialize count !ionary entry. Call(CllV); ! set up ACB dst, LeftShift(4); ! set up ***** if Neq Goto(UserSrv1); !***** dst := 10, if IntrPend Call(VectSrv); !***** userintr, RightShift(10); !****shift mask Shift or 17, ShiftOnR; ! form LeftShift(dst) 1; ! c* tmp := Shift; ! swap bytes UserSrv1: if IntrPend Call(VectSrv); tmp, RightShift(1); lear bit where interrupt found UserIntr := Shift xor UserIntr, Goto(RefillJmp); ! enter routine ! Routine VectSrv ! next bit position tmp := Shift, if Odd Goto(UserSrv2); ! if this bit is set dst := dst + 1, Goto(Us. !----------------------------------------------------------------------------- ! ! Abstract: ! VectSrv serves micro erSrv1); ! update bit position counter ! Bit found, index into IntTab by the bit position to get the routilevel interrupts by vectoring into the IO ! microcode. VectSrv should be called. ! ! Environment. ! IntrPend trne ! descriptor for the interrupt handler. UserSrv2: dst, LeftShift(2); ! turn index into offset ue. ! ! Result: ! Interrupt served. ! ! Calls: ! IO microcode. ! !------------------------------------------ Shift + IntPtr, Fetch4; ! get variable routine desc. UserIntr := UserIntr or 100000; ! turn off f----------------------------------- VectSrv: Vector(IntVec); urther interrupts tmp11 := 0, LoadS(StkOv); ! watch out for stack overflow tmp5 := Mdi;  ! new CS = code segment number tmp7 := Mdi + SB; ! new GP = global pointer tmp $Title Integer routines. ! Routine Divide. !-----------------------------------------------------------------------2 := Mdi; ! new RN = routine number tmp10 := Mdi + SB; ! new SL = static link------ ! ! Abstract: ! Divide forms the quotient of two integers. A zero divisor causes ! the ErrDivZero error. tmp := tmp5, Call(ChkSeg); ! get code base tmp6 := tmp, Fetch, ! offset of routine ! ! Environment: ! tmp = Dividend. ! tmp1 = Divisor. ! ! Result: ! tmp = Quotient. ! tmp1 = Div dictionary if Odd Goto(Busted); ! if not resident Hold, tmp := tmp2, LeftShift(3); idend modulo Divisor. ! ! Calls: ! RunError0, VectSrv. ! !-----------------------------------------------------------scriptors (IntTab) is ! quadword aligned. ! !-------------------------------------------------------------------- Hold, tmp1 := Shift + tmp6; ! offset of dictionary entry Hold, Mdi + tmp1, Fetch4; ! fetch dictF ; !Happens at t2, will return to t3 IntrH: CntlRasterOp(Off), CallS; !Interrupt in Begin/End := DstX; SrcBase := DstBase, LeftShift(4); tmp1 := DstLineInc, goto(Set1); Set3: tmp1 - 40;  GoTo(XsrK2T3c); !Happens at t2, will return to t3 IntrI: CntlRasterOp(Off), CallS;  tmp := SrcY, if Neq goto(Set4); ! if not 40 ! another special case: 40 words/line. the Move !Interrupt in Begin/End XtraSrc GoTo(XsrK2T3d); !Happens at t2, will return to t3 IntrJ: CntMem routine depends ! on raster-op being able to do a 20-bit multiply by 40 words/line. tmp := tmp + tmp; lRasterOp(Off), CallS; !Interrupt in Begin XtraSrc GoTo(XsrK2T3b); !Happens at t2, will  ! 2 * SrcY tmp := tmp + tmp; ! 4 * SrcY tmp := tmp + tmp; return to t3 !! exit from raster-op. ExitRO: CntlRasterOp(Off); Pop, Return; !! commo ! 10 * SrcY tmp := tmp + tmp; ! 20 * SrcY tmp := tmp + tmp, goto(Set5); n interrupt routine. IntrCom: Call(IntrIt); IntrComA:SrcRasterOp := SrcRas; ! restore SrcRasterOp DstRaste ! 40 * SrcY Set4: tmp := SrcY, call(Mult); ! compute SrcLineInc * SrcY Set5: tmp := tmp + SrcBase, rOp := DstRas; ! restore DstRasterOp Fetch, Return; ! Happens at t1 !! Setgoto(Set2); Set6: Tos := SrcBinQ := SrcX and 77, if IntrPend call(IntrIt); SrcBinW := Tos and 17; Up. SetUp: Flag := Flag or 1, if IntrPend call(IntrIt); ! first time thru tmp1 := SrcLineInc; DstQuad  Tos := DstBinQ := DstX and 77; DstBinW := Tos and 17; ! set DstRasterOp. := SrcX, LeftShift(4); Set1: tmp1 - 60; SrcY, if Neq goto(Set3); ! if not 60 ! special casLastDst := LastDst and 60; Tos := Width and 17; WidRasterOp := Tos or LastDst; ! set SrcL4R;!Q1 1 MA := DstQuad, Store4R; ! 2 Height := Height - 1, Return; ! 3 Ine: 60 words/line. tmp := Shift + SrcBase; ! 20*Y + BaseAddress SrcY, LeftShift(5); trF: CntlRasterOp(PauseRL); !Video interrupt Middle Call(VidInt); !Video interrup tmp := Shift + tmp; ! 40*Y + 20*Y + Base Set2: DstQuad, RightShift(4); DstQuad := Shift + tmpt service Call(IntrComA); !Join common code in IntrCom GoTo(BegK2T3b); ; ! X div 20 + LineLength*Y + Base Flag := Flag xor 1; DstQuad := DstQuad + SB, if Odd goto(S !Happens at t2, will return to t3 IntrG: CntlRasterOp(Off), CallS; !Interrupt in Begin GoTo(XsrK2T3)et6); ! physical address SrcQuad := DstQuad; ! roll down SrcY := DstY; DstQuadG 6 + 1,Goto (DIVTST); DIVZERO: tmp2 := ErrDivZero, pop, Goto(RunError0); DIVNEG3:noop; ! MAB uested, ! MakeMask returns a zero word instead. The Set opcodes depend on this ! routine doing this bizarre thing tmp1 := Tos - tmp6, Goto(DIVX); ! negate remainder ! routine ExtendByte. !------------------------------------------------. ! ! Environment: ! tmp and 17 = One less than the number of bits desired. ! ! Result: ! tmp unchanged. ! ------------------ DIVIDE: tmp1; tmp5:=0, push, if lss Goto (DIVNEG1); ! sign indicator tmp1; DIV0: tm----------------------------- ! ! Abstract: ! Sign-extend a byte that is known to be negative. ExtendByte is ! p10 := tmp, if eql Goto (DIVZERO); tmp, if lss Goto (DIVNEG0); if neq Goto (DIVDO); tmp1:=0,pop; not called--it is jumped to. ExtendByte exits via a NextInst. ! ! Environment: ! tmp = A byte whose byte-sign is set.  ! MAB Return; ! clear remainder, clear stack MAB DIVDO: tmp6:=0,leftShift(10); tmp a ! ! Result: ! (Tos) = tmp = Input value with upper 8 bits set. ! !---------------------------------------------------nd not 377; if neq Goto (DIV16),tmp; tmp:=Shift and not 377; !swap bytes Tos:=10,push, Goto(DI-------------------------- ExtendByte: tmp := tmp or 177400; Tos := tmp, NextInst(0); ! Routine MakeBit. !-----VD); DIV16: Tos:=20,push; DIVD: tmp:=tmp + tmp; tmp6 := tmp6 + tmp6, if carry Goto (DIVINC); DIVTST: tmp6-tmp1, i------------------------------------------------------------------------ ! ! Abstract: ! MakeBit makes a word in which f IntrPend Goto(DIVINT); DIVI: if lss Goto (DIVT); tmp6:=tmp6-tmp1; tmp:=tmp + 1, if IntrPend Call(VECTSRV)a specific bit is set and returns the ! bit number. ! ! Environment: ! (Tos) = x. ! ! Result: ! Stack p; DIVT: Tos:=Tos-1; !Tos; ! MAB tmp10, if gtr Goto (DIVD); pop, if lss opped. ! tmp = x. ! tmp5 = Word with bit (x mod 16) set. ! !----------------------------------------------------Goto(DIVNEG3); tmp1:=tmp6, if IntrPend Call(VECTSRV);! remainder DIVX: tmp5; if odd Goto (DIVNEG2); ------------------------- MakeBit: tmp := Tos, Pop, LeftShift(4); ! x tmp5 := Shift and 360; tmp5 or 1 tmp := tmp and AllOnes, pop, Return; ! MAB DIVINT: Call(VECTSRV); tmp6 - tmp1, Goto(DIVI); DIVNEG0: tmp:=Tos-tmp, i7, ShiftOnR; 1; ! form word bit (x mod 16) tmp5 := Shift, Return; ! Routf IntrPend Call(VECTSRV); DIVNEG: tmp5:=tmp5 + 1, Goto (DIVDO); DIVNEG1: tmp1:=Tos-tmp1, if IntrPend Call(VECTSRV); tine MakeMask. !----------------------------------------------------------------------------- ! ! Abstract: ! MakeMask mp5 := 1,Goto (DIV0); DIVNEG2: tmp:=Tos-tmp,pop; ! MAB tmp := tmp and AllOnes, Return; DIVINC: tmp6:=tmpmakes 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 reqG  1; tmp := Shift; ! width in words SrcLineInc := SrcLineInc - tmp; DstLin Define(CharWidth, 137); Define(FontHeight, 140); Define(Ch, 141); Define(C402, 142); eInc := DstLineInc - tmp,if IntrPend call(IntrIt); ! last chance ! set SrcRasterOp. Tos := SrcBin ! Routine DrawByte. !----------------------------------------------------------------------------- ! ! Abstract: ! Q and 60; tmp := Tos or LeftSrc; Func and 14, LeftShift(4); !No Power Down and Function[2]  DrawByte puts characters from a byte array onto the screen. It draws ! until a character count is exhausted, a screen  SrcRas := SrcRasterOp := Shift or tmp; ! set DstRasterOp. Tos := DstBinQ and 60; width is exhausted, or ! a control character is reached. ! ! Environment: ! (Tos) = Maximum X-coordinate + 1. tmp := Tos or LeftDst; Func and 3, LeftShift(6); DstRas := DstRasterOp := Shift or tmp; !  ! (Tos-1) = Maximum byte offset + 1. ! (Tos-2) = Byte offset from the beginning of the byte array. ! (Tos-3 set XtraSrcFetch and XtraSrcWord. Flag; Tos := DstBinQ - SrcBinQ, if ByteSign goto(Set7); ) = Address of the byte array as an offset from the base of the ! memory stack. ! (Tos-4) = Character se ! if XtraSrcFetch not possible Tos xor Direction; if Geq goto(Sett address as an offset from the base of the ! memory stack. ! (Tos-5) = Destination base address as an o7); ! if no extra source fetch XtraSrcFetch := XtraSrcFetch and not 200; ! set extra source fetchffset from the base of the ! memory stack. ! (Tos-6) = Destination Y-coordinate. ! (Tos-7) = Dest SrcLineInc := SrcLineInc - 4; Set7: Tos := DstBinW - SrcBinW; Tos xor Direction; if Geq returination X-coordinate. ! (Tos-8) = Raster-op function. ! ! Result: ! Stack popped three times. ! (Tos) =n; ! if no extra source word XtraSrcWord := XtraSrcWord or 1, return; ! set extra source word Current X-Coordinate. ! (Tos-1) = Next byte offset. ! (Tos-2) = Termination condition: ! 0 - C !! spending time doing nothing. Nop3: Hold; Nop2: Hold; Nop1: Hold, return; !! vector off toharacter count exhausted. ! 1 - Screen width exhausted. ! 2 - Control character encountere the interrupt handler. IntrIt: Vector(IntVec); Define(MaxX, 130); Define(MaxByte, 131); Defd. ! !----------------------------------------------------------------------------- Loc(DrawByte), MaxX := Tos, Pop; ineInc and DstLineInc. Func := Func or 10, LeftShift(2); !will be No Power Down bit MidNum +ine(CSet, 132); Define(Screen, 133); Define(X, 134); Define(Y, 135); Define(RFunc, 136); H  tmp, LeftShift(0); tmp5 := Shift xor tmp1, ! tmp5 has sign bit of result  Return the result. Mul9: tmp5; ! check sign of result tmp := tmp and AllOnes, i if Geq Goto(Mul1); ! if tmp >= 0 ! tmp6 := Tos - tmp, if IntrPend Call(VectSrv); ! absolute value of tmp f Lss Goto(Mul10); ! if result is negative ! Set a positive result. Pop, Return; ! Set a negative  tmp := Tos - tmp, if IntrPend Call(VectSrv); ! absolute value of tmp Mul1: tmp1; Mul2: tmp - tmp1, if Geq Goto(Mul3); result. Mul10: tmp := tos - tmp, Pop; ! negate result tmp := tmp and AllOnes, Return; ! Sign ! if tmp1 >= 0 tmp1 := Tos - tmp1, Goto(Mul2); ! absolute value of tmp1 ! tmp6 = smaller of tmp and al integer multiply overflow. ! ***** Mul11: tmp2 := ErrMulOvfl, Goto(RunError0); ! multiply overflow $Title Multtmp1. ! 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. !----------------------------------------------------------------------------- ! ! A tmp2 = Right mask. ! tmp2 on R bus. ! !----------------------------------------------------------------------------6 := tmp; ! Exchange tmp and tmp1. ! tmp6 := tmp6 xor tmp1; ! tmp1 := tmp1 xor tmp6; ! tmp6 := t- ! 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, Leftmp6 xor tmp1; tmp := tmp1; tmp1 := tmp6; tmp6 := tmp; !remove this later Mul4: tmp := 0; Shift(4); ! number of bits Shift + 17, ShiftOnR; ! form a LeftShift(n) AllOnes;  ! initialize product = 0 tmp6, RightShift(1); ! shift multiplier right Mul5: tmp6 tmp2 := not Shift, Return; ! make the mask ! Routine Multiply (Mult). !------------------------------------ := Shift, if Odd Goto(Mul6); ! if bit set in multiplier tmp1 := tmp1 + tmp1, ! shift multiplicand l----------------------------------------- ! ! Abstract: ! Multiply forms the lower 16 bits of the product of two integeeft if eql Goto(Mul9); ! if multiplier is zero tmp6, Goto(Mul5); ! shifrs. ! ! Environment: ! tmp = Multiplier. ! tmp1 = Multiplicand. ! ! Result: ! tmp = Product. ! ! Callt multiplier right ! Accumulate partial product. Mul6: tmp := tmp + tmp1, if IntrPend Goto(Mul8); ! accumulate prs: ! VectSrv. ! !----------------------------------------------------------------------------- Multiply: Tos := 0, Poduct Mul7: tmp1 := tmp1 + tmp1; ! shift multiplicand left !*****, if lss Goto(Mul11); tmp6ush, Loc(Mult); Nop; ! placer, allow page escape ! tmp6 := tmp, LeftShift(0); , Goto(Mul5); ! Serve an interrupt. Mul8: Call(VectSrv); RightShift(1); tmp, Goto(Mul7); ! H  C402, Push; Call(Rop); SrcByte := SrcByte + 1, Goto(DB1); DB3: Tos := 0, Push, Goto(DB6); DB4: Toress bits <7::0> constant(E3WrBuffHi, 326); ! write high 4 bits of physical buffer addr constant(E3WrBuffLo, 336); ! wrs := 2, Push, Goto(DB6); DB5: Tos := 1, Push; X := X - CharWidth, Goto(DB6); DB6: Tos := SrcByte, Push; ite low 16 bits of buffer addr constant(E3WrHdrHi, 327); ! write high 4 bits of header buffer address constant(E3WrHdrLo,  MaxByte := Tos, Pop; SrcByte := Tos, Pop; SrcWord := Tos + SB, Pop; CSet := Tos + SB, Pop;  Tos := X, Push, NextInst(0);  Screen := Tos, Pop; Y := Tos, Pop; CSet, Fetch2; X := Tos, Pop; RFunc := Tos, Pop;  FontHeight := Mdi; tmp := Mdi; Y := Y - tmp; CSet := CSet + 2; C402 := 402; C402 := C402 - SB; DB1: SrcByte - MaxByte, RightShift(1); SrcByte, if Geq Goto(DB3); ! if character count exhauste! IO Microcode for 3MHz Ethernet ! Included by IO.Micro (basic IO microcode for Perq) ! ! 16 Apr 81 V1.1 George Robertson d Shift + SrcWord, Fetch; SrcByte xor 1, Rotate(10); Ch := Mdi, if Odd Goto(DB2); Ch := Shif! Upgraded for version C microcode and set up separate ! file IOE3.Micro. ! ! 2 Feb 81 V1t; DB2: Ch := Ch and 177; Ch and not 37, LeftShift(1); Ch, if Eql Goto(DB4); ! if control chara.0 Gene Ball ! Created $Title Register definitions ! Ether registers -- 270 thru 274 define(etherTmcter Shift + CSet, Fetch2; tmp := FontHeight; tmp2 := Mdi; CharWidth := Mdi; X := Xp, 270); define(etherDCBptr, 271); define(etherCmd, 272); define(etherDly, 273); define(etherCnt, 274); $Title Ethernet + CharWidth; X - MaxX, RightShift(12); tmp2, if Gtr Goto(DB5); ! if screen width exhausted  IO register addresses ! Ethernet IO register addresses constant(E3WrRecWdCnt, 370); ! WriteReceiveWordCount register ctmp1 := Shift, Call(Mult); ! tmp will contain SrcY Tos := RFunc, Push; Tos := CharWidth, Push; onstant(E3RdRecWdCnt, 171); ! ReadReceiveWordCount register constant(E3WrCSR, 372); ! WriteControlStatusRegister constaTos := FontHeight, Push; Tos := X - CharWidth, Push; Tos := Y, Push; Tos := 60, Push; Tos :=nt(E3RdCSR, 173); ! ReadCSR constant(E3WrXmtWdCnt, 374); ! WriteTransmitWordCount constant(E3RdXmtWdCnt, 175); ! ReadT Screen, Push; Tos := tmp2 and C1777, Push; Tos := tmp, Push; Tos := 60, Push; Tos := CSet +ransmit Word Count constant(E3WrDly, 376); ! Write start delay register constant(E3RdNetAddr, 177); ! Read Network addI  popped once. ! If Length = 0: ! Stack popped twice. ! (Tos) = WordArray0 = WordArray1. ! ! Calls: ult: ! tmp = -1. ! Memory[DstAddr-N+1] = Memory[SrcAddr+0]. ! Memory[DstAddr-N+2] = Memory[SrcAddr+1]. ! ! VectSrv. ! !----------------------------------------------------------------------------- CmpMW: tmp := NextOp;  ... ! Memory[DstAddr-1] = Memory[SrcAddr+N-2]. ! Memory[DstAddr-0] = Memory[SrcAddr+N-1]. ! ! Calls: ! get length if Neq Goto(CmpMW1); ! if non-zero length byte tmp := Tos, Pop; ! VectSrv. ! !----------------------------------------------------------------------------- MoveMem: tmp := tmp - 1 ! get length from expression stack CmpMW1: tmp1 := Tos + SB, Fetch; ! pre-fetch word from array , if IntrPend Goto(MoveMem2); MoveMem1: if Lss Return; Tos + tmp, Fetch; ! t3 Nop; 0 Pop; Nop; !***** MAB Tos := Tos + SB, Goto(CmpMW3); ! bias add ! t0 Nop; ! t1 dst - tmp, Store; !ress of array 1 CmpMW2: If Leq Goto(CmpMW5); ! if done tmp1 := tmp1 + 1, Fetch; ! fetch ne t2 Mdi, Goto(MoveMem); ! t3 MoveMem2: Call(VectSrv); tmp, Goto(MoveMem1); $Titlext word of array 0 CmpMW3: tmp2 := Mdi; ! save word from array 0 MA := Tos, Fetch;  Opcode/operand file routines. ! Routine AdjustPC. !----------------------------------------------------------------------- ! 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 itbstract: ! CmpMW compares two word arrays. After the call to CmpMW, the ! value on the top of the stack is true i CmpMW4: If Eql Goto(CmpMW2), tmp := tmp - 1; ! if equal, keep going Tos := 0, Return; ! not equal,ff the arrays are equal. ! ! Environment: ! Next byte in the opcode/operand stream = Length. ! If Length <> 0:  set false CmpMW5: Tos := 1, Return; ! equal, set true ! Serve an interrupt. CmpMW6: Call(VectS! (Tos) = Word address of WordArray0. ! (Tos-1) = Word address of WordArray1. ! If Length = 0: ! rv); tmp10, Goto(CmpMW4); ! Routine MoveMem. !-------------------------------------------------------------------- (Tos) = Length of word arrays. ! (Tos-1) = Word address of WordArray0. ! (Tos-2) = Word addre--------- ! ! Abstract: ! MoveMem is used to move blocks of non-overlapping words. ! ! Environment: ! (Tos) = ss of WordArray1. ! ! Result: ! Length removed from opcode/operand stream. ! If Length <> 0: ! StackSrcAddr = First address of source block. ! dst = DstAddr = Last address of destination block. ! tmp = N. ! ! ResI  3=> Promiscuous Receive, 4 => Transmit ! Delay 1 word; XMT timeout delay ! WordCount 1 word; words to xmt/r= MDI; ! now must add 8 wds & set as buffer address due to hdr/buffer kludge ! in DMA controllec - should leave extra space ! - is set to wds transferred ! Result 1 word; Device status er ioPhysAdr := ioPhysAdr + 10; ioPhAdrHi := ioPhAdrHi + 0 + OldCarry; ! double precision add  (Ether addr in high byte) ! NextIOCB 2 words; ptr to next control block !--------------------------------------------- ioPhysAdr xnor C1777, IOB(E3WrBuffLo); not ioPhAdrHi, IOB(E3WrBuffHi); etherCmd-4; --------------------------------- etherStart: ioDevTab + etherDTentry, Fetch2, Call(ioTLate), case(StartIO,2); !Get DCB ptr  ! = 4? Transmit if Neq GoTo(eRec); etherDly, IOB(E3WrDly); ! set etherDCBptr := ioPhysAdr, Fetch4; ! read IOCB ioOffset := MDI; ioSeg := MDI; etherC up timeout delay etherCnt, IOB(E3WrXmtWdCnt); ! and transfer count eXmtStart, IOB(E3WrCSR); 337); ! write low 16 bits of header addr ! Ether CSR fields ! bit 10 -- transmitter done ! bit 11 -- transmitter erroMD := MDI; etherDly := MDI; etherCmd; ! = 0? Reset if Neq GoTo(eStatr ! bit 9 -- receiver error ! bit 8 -- receiver done ! bit 4 -- receiver is promiscuous ! bit 3 -- start the transmitter on ); 0, IOB(E3WrCSR); ! reset the device IOB(E3RdNetAddr); ! get the ne0=> 1 ! bit 2 -- transmitter Interrupt enable ! bit 1 -- start the receiver, on 0=> 1 ! bit 0 -- receiver interrupt enable t address etherTmp := IOD; TOS := etherTmp and 377, push, NextInst(0); ! return net address  constant(eRecStart, 3); ! RecIntEn, RecGo constant(ePromStart, 23); ! RecIntEn, Promisc, RecGo constant(eXmtStarteStat: etherCmd-1; ! > 1? Do a transfer if Gtr GoTo(eXfr); eRet: IOB(E3RdCSR); , 14); ! XmtIntEn, XmtGo constant(etherDTentry, 20); ! Ether3 Device table entry (10 * 2) constant(etherIntMsk, 2 etherTmp := IOD; TOS := etherTmp, push, NextInst(0); ! return status from StartIO eXfr: Call(ioXLateA); 3); ! Ether3 interrupt mask offset $Title Ethernet Driver ! E3MHz Ethernet Driver !--------------------------- ! convert ioSeg,ioOffset to ! ioPhAdrHi, ioPhysAdr --------------------------------------------------- ! jeb 2-feb-81 @CMU ! Ether IOCB: ! BuffPtr 2 words; virtual add etherDCBptr+4, Fetch; ! get transfer count ioPhysAdr xress, quad aligned, can't cross 4K ! Cmd 1 word; 0 => Reset, 1=> Status, 2 => Receive, ! nor C1777, IOB(E3WrHdrLo); ! give buffer addr to DMA controller not ioPhAdrHi, IOB(E3WrHdrHi); etherCnt :J ---------------------------------------------- AdjustPC: tmp := UState and 17, if intrpend Call(VectSrv); ! get BPC advanced by 4. ! Opcode/operand file filled. ! BPC = 0. ! ! Calls: ! UserSrv, VectSrv. ! ! Design: !  tmp := tmp + JmpOffset, Field(0,3); ! form byte offset from UPC BPC := Shift, ! low three bits We don't increment UPC at location 0 (Opcode 377) because location ! 0 is executed repeatedly when the boot button i of byte address if Lss Goto(Adjust1); ! if byte offset < 0 tmp and not 7, RightShift(1); s pressed, and we ! don't want to destroy UPC. ! !--------------------------------------------------------------------- UPC := shift + UPC, Goto(RefillJmp); ! update quad address ! Jumping backward. Adjust1: tmp and not 7, RightShif-------- ! Routine RefillJmp. !----------------------------------------------------------------------------- ! ! Abstract:t(1); tmp := Shift or SignXtnd; ! quad offset sign extended UPC := UPC + tmp, Goto(RefillJmp); !  ! RefillJmp refills the opcode/operand file to complete a jump ! instruction. It is assumed that UPC and BPC areupdate quad address ! Routine Refill. !----------------------------------------------------------------------------- ! !  set to the ! desired values. RefillJmp exits via a NextInst. ! ! RefillJmp checks for Pascal level interrupts aAbstract: ! Refill refills the opcode/operand file when a NextOp is done and ! file is empty. Refill is jumped tond serves the one with ! the highest priority. ! ! Environment: ! UPC and BPC set to target address. ! ! Resul and returns via a ReviveVictim. ! ! Environment: ! BPC[3] true. ! ! Result: ! UPC advanced by 4. ! Opct: ! Opcode/operand file filled. ! ! Calls: ! UserSrv, VectSrv. ! !-------------------------------------------ode/operand file filled. ! BPC = 0. ! ! Calls: ! VectSrv. ! !----------------------------------------------------------------------------------- ! Routine RefillIndivisible. !--------------------------------------------------------------------------------------- ! Routine RefillOp. !-------------------------------------------------------------------------------------------- ! ! Abstract: ! RefillIndivisible is used to refill the opcode/operand file when it ! it is e--- ! ! 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 Ne is jumped to. When AdjustPC finishes it ! exits to RefillJmp. ! ! Environment: ! JmpOffset = Signed offset to efillOp corresponds to Opcode(377). RefillOp ! exits via a NextInst. ! ! RefillOp checks for Pascal level interradd to the PC. ! ! Result: ! PC updated. ! ! Calls: ! VectSrv, RefillJmp. ! !-------------------------------upts and serves the one with ! the highest priority. ! ! Environment: ! BPC[3] true. ! ! Result: ! UPC J  if Neq GoTo(eRCnt); IOB(E3RdXmtWdCnt); etherDly := IOD; goto(eCnt); eRCnt: IOB(E3RdRecW0p1t&٤@J!;PI31!5asdCnt); etherDly := IOD; eCnt: etherDly := etherDly and 7777; ! etherCmd := 404; !  RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asKa|?V `hBd*f!7G7rTmp; ! put status in Post loc !nop; ! t2 !nop; ! t3 -- still can't start another store M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nD MA := etherDCBptr+4, Store2; MDO := etherDly; ! put final word count in IOCB p1t&٤@J!;PI31!5asKa MDO := etherTmp; ! put status in IOCB 0, IOB(E3WrCSR); ! t2 --Dismiss Interaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*Interrupt Service etherTmp := IOD; ! get ether status and save it etherCmd-4; nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|K  ! t3 UserIntr; ! t0 LoadOp, if Gtr Goto(UserSrv); ! t1 No ! shift the high byte $Title Real number routines. ! Routine RealCmp. !-----------------------------------xtInst. ! ! RefillIndivisible differs from RefillOp in that it does not check ! for Pascal level interrupts. ! p, if IntrPend Call(VectSrv); ! t2, data starts here Nop; ! t3, 2nd word in opfile! RefillIndivisible is called in the following way. ! ! if BPC[3] Goto(RefillIndivisible); ! NextIn Nop; ! t0, 3rd word in opfile Goto(Refill1); ! t1, 4rd st(0); ! ! Environment: ! BPC[3] true. ! ! Result: ! UPC advanced by 4. ! Opcode/operand file filled. word in opfile RefillIndivisible: UPC := UPC + 4, Fetch4; ! t3 advance UPC and fetch BPC := 0; ! BPC = 0. ! ! Calls: ! VectSrv. ! !--------------------------------------------------------------------------- ! t0 LoadOp, if IntrPend Call(VectSrv); ! t1 fill opcode/operand file Nop; -- Refill: UPC := UPC + 4, Fetch4; ! t3 advance UPC and fetch BPC := 0; ! t ! t2 ! Where := Where or 4, call(5000); !!!! use with CheckPC !!!! NextInst(0); 0 reset BPC LoadOp, if IntrPend Call(VectSrv); ! t1 fill the opcode/operand file ! Where := Where or 3, Call ! t0 first data ready ! Routine WordParm. !------------------------------------------------------------------------(5000); !!!! use with CheckPC !!!! ReviveVictim; ! return to caller Opcode(REFILLOP), UPC----- ! ! Abstract: ! WordParm gets a one word (two byte) parameter from the operand ! stream for the interprete + 4, Fetch4; ! t3 fetch next quad BPC := 0; ! t0 UPC := UPC + 4, LoadOpr of a Q-code. The high byte is left on ! the shifter output, so the normal calling sequence is ! ! Call(Wo, ! t1 advance UPC and fill if IntrPend Call(VectSrv); UserIntr; rdParm); ! tmp := tmp + Shift; ! form word parameter ! ! Environment: ! Two bytes in the operan ! t2 if Gtr Goto(UserSrv); ! t3 if Pascal level interrupts Refill1: ! Whered stream. ! ! Result: ! tmp = Low byte. ! tmp1 = High byte. ! R = High byte shifted up into the high byte := Where or 2, call(5000); !!!! use with CheckPC !!!! NextInst(0); ! t0 (RefillOp), first . ! !----------------------------------------------------------------------------- WordParm: tmp := NextOp; data ready ! t2 (RefillJmp), all data ready RefillJmp: UPC, Fetch4;  ! get the low byte tmp1 := NextOp; ! get the high byte tmp1, LeftShift(10), Return; K hEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&٤@J!;'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&"3n\FXُHg6o*ZDYF.0 էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhU{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~ZDYF.0 էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd* Dqh|0p1t&٤@J!;PI3`hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)EMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXf!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\1!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asKa|?V `hBHg Dqh|0p1t&٤@J!;P)*]/sOK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw d*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)țI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhE{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*YF.0 էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FL t. It does this by inserting zero words into the lower ! set if it is shorter. ! ! Environment: ! (Tos) = L0 = tmp4 := TP, if IntrPend Call(VectSrv); tmp4 := tmp4 - tmp3; ! address of Set1 tmp3, Return; Length of Set0. ! (Tos-1) = L1 = Length of Set1. ! Top L0 words on the memory stack = Set0. ! Next L1 words ! put nL0 on result ! There's not enough room on the stack. SetAdj2: Tos := tmp3; tmp1 on the memory stack = Set1. ! ! Result: ! stack popped. ! tmp3 = nL0 = New length of Set0. ! tmp2 = (Tos1 := 1, Goto(StkOv); ! make a stack overflow ! Routine SetComp. !----------------------------------------------) = 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 ! ------------------------------------------ ! ! Abstract: ! RealCmp does a portion of a comparison of two real numbers ( the memory stack = Set1. ! tmp4 = Address of Set1 in memory stack. ! nL0 is on the R bus. ! ! Calls: ! Vtwo ! double words) for exact equality. ! ! Environment: ! tmp = High order word of first real number. ! ectSrv, ChkStk, SetMovUp, SetZero, StkOv. ! !----------------------------------------------------------------------------- (Tos) = Low order word of first real number. ! (Tos-1) = High order word of second real number. ! (Tos-2) = Low orSetAdj: tmp3 := Tos and AllOnes, Pop; ! L0=nL0 Tos := tmp1 := Tos and AllOnes; ! L1 !***** BR tmpder word of second real number. ! ! Result: ! Stack popped twice. ! tmp = High order word of first real number. 1 := tmp1 - tmp3, LoadS(SetAdj2); ! difference !***** BR tmp2 := Tos, if Geq Goto(SetAdj1); ! L1=nL1 if Set1 >= Set0 ! tmp1 = Low order word of first real number. ! (Tos) = Low order word of second real number. ! The Xor of  tmp := Tos + tmp3; ! amount to copy Tos := zero - tmp1, Push; ! make difference the two high order words is left on the R bus. ! !----------------------------------------------------------------------------positive tmp1 := Tos, if IntrPend Call(VectSrv); ! difference tmp10 := Tos, Call(ChkStk); ! be sure - RealCmp:tmp1 := Tos, Pop; Tos xor tmp, Pop, Return; $Title Set routines. ! Routine SetAdj. !--------there's enough room Tos := TP - tmp; ! smallest source address TP := TP + tmp1; --------------------------------------------------------------------- ! ! Abstract: ! SetAdj adjusts two sets on the to ! new top of memory stack dst := Tos + tmp1, Call(SetMovUp); ! largest destination address tmp2 :=p of the stacks so that the lower ! set has a length that is greater than or equal to the length of the ! upper se tmp3, Pop; ! nL1=nL0 Tos := tmp2, Call(SetZero); ! zero words to adjust set size SetAdj1: L nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|K,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK,>0p1t&٤@J!;PI31!5asM!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nGp1t&٤@J!;PI31!5asKa"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sOK|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw >٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@aw RpzSd)ț'w\)*]/sOK,>"3n\FXُHg Dqh|0p1t&٤@J!;PI31!5asK,>"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t&"3n\FXُHg Dqh|0p1t& էڏ}kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gOa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )ʹR%|pw U~O*~d#9f"nDk*kl(եp{U{Z)嵶P^M!>٤@J!;PI31!5asKa|?V `hBd*f!7G7gO7nG1 )٤@J!;PI31!5asKa|?7nG1 )ʹR%|pw U~O*~d#9f"nDk*ʌ^@E,ʙhEMn~Kaw RpzSd)ț'w\)*]/sO