$ORIGIN=1000 $FILE=FILE1 $EXTERNALS=JMP 0124 $EXTERNALS=XNTRY 1414 $EXTERNALS=.XFER 1431 * * SETP - SET POINTERS * * LDA * LDB * RAM SETP (OR INIT) * DEF COUNT (COUNT MAY BE CHANGED BY ROUTINE) * RETURNS WITH A=0; AND B:=B + COUNT; * SETP B JSB S3 GETQX Q:=COUNT SETPL Q DEC Q NEG DONE? F S3 DEC M CW NMPV STORE VALUE JMP A DONE DONE OR MEM. PROTECT A RRS IOR T FLG A INC A INC VALUE S3 INC B INC ADDRESS B JMP S3 SETPL DO IT AGAIN; * * PRIMARY JMP TABLE * JMP XNTRY ENTRY FOR EXT. PREC. B JSB S3 GETQD Q:=1ST ADDR; S3:=B; ADR JMP TBL2 * JMP *-256 JMP *-256 JMP *-256 JMP *-256 JMP *-256 * * SECONDARY JMP TABLE TBL2 JMP .XFER JMP .GOTO JMP ..MAP Q JMP S3 .ENTR S3:=DATA OUT PTR; CR SUB B 4 Q JMP S3 .ENTP S3:=DATA OUT PTR; SFLG INIT CORE JMP SETP * * * $ORIGIN=1131 * ..MAP --- FORTRAN 4 -- INDEX CALCULATOR * * LDA * LDB * RAM ..MAP * DEF BASE * DEF <1ST SUBSCRIPT> * DEF <2ND SUBSCRIPT> * (DEF <3RD SUBSCRIPT>) IF A=-1; * DEF * (DEF ) IF A=-1; * RETURNS A=ADDRESS OF VARIABLE; * *..MAP ..MAP Q RRS IOR M RW S4:=BASE A LWF R1 FLG:=2 OR 3DIM NOR A A:=-1 T ADD S4 JSB GETQ1 S1:=SUB1 - 1 Q RRS IOR M RW A T ADD S1 JSB GETQ1 S2:=SUB2 -1 Q RRS IOR M RW A T ADD S2 JSB GETQ1 S3:=SUB3 - 1 Q RRS IOR M RW OR DIM1-1 IF 2DIM A T ADD S3 RSS FLG JSB GETQ1 A:=DIM1 Q RRS IOR M RW FLG S3 INC A UNC (2DIM) T IOR A (3DIM) IOR Q CNTR RPT A:=DIM1*(SUB2-1) Q S2 MPY Q R1 CTRI A IOR S2 FLG JMP DIM2 SKIP SECTION IF 2DIM JSB GETQD A:=DIM1 Q RRS IOR M RW T IOR A IOR Q CNTR RPT A:=DIM1*(SUB3-1) Q S3 MPY Q R1 CTRI JSB GETQ1 S3:=DIM2 Q RRS IOR M RW T IOR S3 IOR Q CNTR RPT A:=DIM2*DIM1*(SUB3-1 Q S3 MPY Q R1 CTRI * A:=DIM1*(DIM2*(SUB3-1) A S2 ADD A + (SUB2-1)) DIM2 A S1 ADD A + (SUB1-1) B IOR S1 A:=INDEX*WORDS/VARAB IOR Q CNTR RPT Q S1 MPY Q R1 CTRI A S4 ADD A EOP + BASE P INC P EXIT * * * * * * .ENTP AND .ENTR * .ENTR CR SUB B 2 .ENTP P INC S4 S4:=MACRO RETURN B P ADD B B:=ENTRY POINT B JSB P GETQD B:=DATA IN PTR B S3 SUB A A:=LENGTH ALLOWED Q JSB B GETQX Q:=1ST PARAMETER F P DEC M CW NMPV SET RETURN ADDR IOR Q RRS IOR T * S1:=-NR OF PARAMETERS PASSED -1 * CAREFUL ABOUT TIMING; NOTE USE OF T... B T SUB S1 S1:=-NR ACTUAL PARM. A S1 ADD RSS NEG IF ACTUAL > ALLOWED A NOR S1 THEN S1:=ALLOWED B CLO P P:=IN PTR S3 IOR B B:=S3 AT START Q JMP A .ENTC CHECK FOR ZERO PARAM * * TRANSFER THE PARAMETERS * .ENTL B JSB S3 GETQ1 Q:=NEXT PARM ADR F S3 DEC M CW NMPV STORE ADR. JMP .ENTX Q RRS IOR T S3 INC B BUMP OUT PTR .ENTC S1 INC Q TBZ BUMP CNTR, DONE? Q JMP S1 .ENTL NO... .ENTX S4 IOR P RSS EOP YES--EXIT * * * * * * .GOTO - FOR FORTRAN - COMPUTED GOTO STATEMENT * * RAM .GOTO * DEF *+N+2 * DEF J * DEF
* DEF
* . . . * DEF
* RETURNS TO
* .GOTO Q JSB B GETQ1 B:= *+N+2; Q:=J; Q RRS IOR M RW T IOR Q TBZ IF J=0 Q IOR RSS NEG OR J<0 INC Q THEN J:=1; * Q P ADD P P:=POINTER TO RETURN B P DEC RSS NEG IF P>MAX B DEC P THEN P:=MAX; * JSB GETQD GO GET RETURN ADR; Q JMP S1 JMP GO "JMP" TO IT; * * * * * $ORIGIN=1240 * MOVE - MOVE A BUFFER OF WORDS. SAME GENERAL CALLING SEQUENCE AS MOVB. * A=FROM ADDRESS; B:=TO ADDRESS; Q OR DEF COUNT HAS LENGTH OF BUFFER; * IN INTERRUPT MODE THE CORE VALUE OF COUNT MAY GET CHANGED. * MOVE Q JSB S1 GETQX S1:=CNTR ADR; Q:=CNT; * (NOTE: S3=B) MOVEL A RRS IOR M RW START READ OF DATA A INC A BUMB IN PTR B INC B BUMB OUT PTR T IOR S4 S4:=DATA Q DEC Q NEG DEC CNTR, DONE? F S3 DEC M CW NMPV NOT DONE; START WRIT JMP DONE MEM PROT. OR DONE. S4 IOR T RSS FLG STORE; IF INTR SKIP B JMP S3 MOVEL IF NOT INTERR. 2MICS Q CJMP S3 INTRX IF INTERRUP. B JMP S3 MOVEL MOVE MORE DATA * INTRX F S1 DEC M CW NMPV STORE COUNT IOR S3 IOR T DECP P IOR Q EOP P:=P-1; Q DEC P DONE P INC P RSS EOP * * * * * $ORIGIN=1262 * XPACK SUBROUTINE NORMALIZES, ROUNDS, AND PACKS THE * EXPONENTS INTO 2 OR 3-WORD RESULTS. IT T&EN PRO- * CEEDS TO THE TRANSFER ROUTINEC * XPACK B IOR S4 IF HI, A S4 IOR S3 MID, Q S3 IOR RSS TBZ LOW = 0 JMP XFER THEN WRITE IN CORE JMP NORML ELSE NORMALIZE; * * NORMALIZE THE RESULT IF IT IS NOT ZERO. * F DEC F EXP X # EXP X - 1 Q LWF Q L1 LEFT SHIFT LO X MAN A LWF A L1 LEFT SHIFT MID X MN B LWF B L1 LEFT SHIFT HI X MAN NORML B IOR S2 L1 LEFT SHIFT HI X MAN CFLG B S2 XOR NEG IF TOP 2 BITS SAME JMP *-7 LEFT S&IFT X * * ROUND THE RESULT, AND CHECK FOR MANTISSA OVERFLOWS. * CR RSB S2 177 SET ROUND FOR -NR. B IOR NEG IF X POSITIVE CR IOR S2 200 1 MORE NEEDED Q S2 ADD Q RSS COUT ADD ROUND TO LO X A INC A COUT IF COUT,INC MID X Q JMP S1 UNDOV SAVE LO X, C&ECK XP B INCO B IF COUT, INC HI X Q CLO S1 RSS OVF IF OVFLO FROM ROUND JMP RNDOV SET HI X # 040000 JSB NORML CHECK HI X#1100.C.. * * * C&ECK FOR EXPONENT UNDERFLOW OR OVERFLOW. * UNDOV CR CFLG P 200 IF EXP X LESS F P ADD RSS NEG THAN -200B JMP Q UNFLO THEN EXP UNDERFLO F P SUB NEG IF EXP X GREATER JMP OVFLO THAN &177B, OVFLO * * PACK EXPONENT INTO THE MANTISSA. * EXPAK F IOR Q SAVE EXP X IN Q S1 IOR F SAVE LO X MAN IN F Q LWF L1 SET EXP SIGN IN FLG Q LWF Q L1 POSITION EXP SIGN Q CR AND S1 377 MASK EXP X TO S1 F CL AND Q 377 MASK OFF LO OF X Q S1 RSB Q PACK EXP AND MANT JMP XFER GO WRITE X IN CORE RNDOV F INC F ADD 1 TO EXP X B RSB B R1 SET &I X TO 040000 JMP UNDOV CHECK EXP X * * SET UP ARGUMENTS FOR UNDERFLOW OR OVERFLOW. * UNFLO SOV B SET OVF AND SET X JMP A XFER TO ZERO OVFLO B SOV NEG SET OVERFLOW JMP *+4 CL IOR B 200 IF X NEGT SET X TO CR IOR Q 376 -INFINITY AND JMP A XFER WRITE X IN CORE NOR B R1 IF X POST SET X TO NOR A &INFINITY AND NOR Q L1 WRITE X IN CORE * * XFER SUBROUTINE WRITES RESULT ARGUMENT INTO CORE, * AND RESTORES THE FENCE ADDRESS WHICH &AS BEEN SAVED * IN CORE LOCATION 0, AS WELL AS ACCESSING THE ADDRESS * OF THE DEF X OF T&E CALLING SEQUENCE. THE DBLE * ROUTINE ENTERS AT DXFER, SINCE IT DOES NOT USE * CORE LOCATIONS 0 OR 1 * XFER IOR M RW READ SAVED F FROM 0 T CFLG F RESTORE ORIGINAL F INC S3 SET S3 TO ADDRESS 1 S3 IOR M RW READ FROM 1 TO GET T RSB P ADDRESS OF DEF X Q JSB S1 GETQD Q:=ADR OF X; S1:=EXP; DXFER Q IOR S3 AAB CLEAR AAB FF F S3 DEC M CW NMPV WRITE JMP END IN &I B RRS IOR T X MANTISSA S3 INC S4 F S4 DEC M CW NMPV WRITE JMP END IN MID A RRS IOR T X MANTISSA S4 INC S3 F S3 DEC M CW NMPV WRITE IN LO IOR X MANTISSA END S1 CFLG T FLG IF FLAG ON, ENTERED P INC P FROM DBLE SO SET P INC P EOP FINAL P AS NEEDED; * NOTE THAT THE NEXT P INC P WILL ALSO BE EXECUTED * * * GETQ1 P INC P GETQD P IOR M RW START READ IOR CNTR ONLY 16 INDIRECTS GETQL T IOR Q NEG INDIRECT? RSB NO, RETURN GETQX Q RRS IOR M RW CTRI YES,START READ, JMP GETQL IF <16 THEN GO AGAIN T SOV Q ELSE STOP & SET OVF RSB ADN RETURN *END * $END