INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE CALL INITI0 10000 IF((SYMBOL.EQ.2))GOTO 10001 IF((SYMBOL.NE.3))GOTO 10002 CALL GETSYM GOTO 10003 10002 IF((SYMBOL.NE.5))GOTO 10004 CALL ENTER(TOKEN,1,LC) CALL GETSYM GOTO 10005 10004 CALL INSTR0 10005 CONTINUE 10003 GOTO 10000 10001 CALL CLEAN0 CALL SWT END LOGICAL FUNCTION ALPHA(C) INTEGER C ALPHA=C.EQ.224.OR.C.EQ.223.OR.(225.LE.C.AND.C.LE.250).OR.(193.LE.C *.AND.C.LE.218) RETURN END SUBROUTINE CHAIN0(ADDR,VAL,TYPE) INTEGER ADDR,VAL,TYPE INTEGER P,NEXT P=ADDR 10006 IF((P.EQ.-1))GOTO 10007 CALL PUTREL(TYPE,P) CALL XSEEK(P) CALL GETWO0(NEXT) CALL XSEEK(P) CALL PUTWO0(VAL) P=NEXT GOTO 10006 10007 IF((ADDR.EQ.-1))GOTO 10008 CALL SEEKE0 10008 RETURN END SUBROUTINE CLEAN0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER I,J,MAPLEN INTEGER LENGTH,CTOA CALL PUTBY0(2) MAPLEN=(LC+7)/8 CALL PUTWO0(MAPLEN) I=1 GOTO 10011 10009 I=I+1 10011 IF((I.GT.MAPLEN))GOTO 10010 CALL PUTBY0(RMAP(I)) GOTO 10009 10010 I=1 GOTO 10014 10012 I=I+1 10014 IF((I.GT.SYMTOP))GOTO 10013 IF(((MEM(SYMSYM(I)).EQ.223).OR.(SYMTYP(I).EQ.4)))GOTO 10015 CALL PUTBY0(3) CALL PUTWO0(LENGTH(MEM(SYMSYM(I)))+5) CALL PUTWO0(SYMTYP(I)) CALL PUTWO0(SYMVAL(I)) J=SYMSYM(I) GOTO 10018 10016 J=J+1 10018 IF((MEM(J).EQ.0))GOTO 10017 CALL PUTBY0(CTOA(MEM(J))) GOTO 10016 10017 CALL PUTBY0(0) 10015 GOTO 10012 10013 CALL SEEK(1) CALL PUTWO0(LC) CALL CLOSE(CODE) RETURN END INTEGER FUNCTION COMPA0(STR1,STR2) INTEGER STR1(1),STR2(1) INTEGER I I=1 GOTO 10021 10019 I=I+1 10021 IF((STR1(I).NE.STR2(I)))GOTO 10020 IF((STR1(I).NE.0))GOTO 10022 COMPA0=0 RETURN 10022 GOTO 10019 10020 IF((STR1(I).LE.STR2(I)))GOTO 10023 COMPA0=1 GOTO 10024 10023 COMPA0=-1 10024 RETURN END SUBROUTINE CPUTB0(VAL,RELOC) INTEGER VAL,RELOC INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE CALL PUTBY0(VAL) CALL PUTREL(RELOC,LC) LC=LC+1 RETURN END SUBROUTINE CPUTW0(VAL,RELOC) INTEGER VAL,RELOC CALL CPUTB0(RT(VAL,8),RELOC) CALL CPUTB0(RS(VAL,8),0) RETURN END INTEGER FUNCTION CTOA(C) INTEGER C CTOA=RT(C,7) RETURN END SUBROUTINE DOMACH(OP) INTEGER OP,EXPR INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER RELOC,V(83) INTEGER IOV1,IOV2,ITYP,MCODE,I,JUNK DATA V/8011,5206,2136,2128,5198,2160,5230,7205,7220,0047,0063,2184 *,7252,7212,7196,7244,7236,5254,7228,7204,0039,1009,1005,1011,0243, *0251,8013,0118,5219,1004,1003,7218,7250,7195,7210,7194,7242,7234,7 *226,7202,7058,1010,7042,6001,3064,4006,0000,2176,8000,5246,5211,02 *33,1193,1197,0023,0031,0216,0201,0007,0248,0208,0192,0240,0232,022 *4,0015,1199,0200,2152,5222,8002,7034,0249,7050,1002,0055,2144,5214 *,0235,2168,5238,0227,-1/ ITYP=V(OP)/1000 MCODE=V(OP)-ITYP*1000 I=ITYP+1 GOTO 10025 10027 CALL CPUTB0(MCODE,0) CALL GETSYM GOTO 10026 10028 IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10127 RETURN 10127 CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8,0) GOTO 10026 10029 IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10128 RETURN 10128 CALL CPUTB0(MCODE+MOD(IABS(IOV1),8),0) GOTO 10026 10030 IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10129 RETURN 10129 IF((EXPR(IOV2,RELOC).NE.-3))GOTO 10130 RETURN 10130 CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8+MOD(IOV2,8),0) GOTO 10026 10031 IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10131 RETURN 10131 CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8,0) IF((EXPR(IOV2,RELOC).NE.-3))GOTO 10132 RETURN 10132 CALL CPUTB0(RT(IOV2,8),RELOC) GOTO 10026 10032 CALL CPUTB0(MCODE,0) IF((EXPR(IOV1,RELOC).NE.-3))GOTO 10133 RETURN 10133 CALL CPUTB0(RT(IOV1,8),RELOC) GOTO 10026 10033 IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10134 RETURN 10134 CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8,0) IF((EXPR(IOV2,RELOC).NE.-3))GOTO 10135 RETURN 10135 CALL CPUTW0(IOV2,RELOC) GOTO 10026 10034 CALL CPUTB0(MCODE,0) IF((EXPR(IOV1,RELOC).NE.-3))GOTO 10136 RETURN 10136 CALL CPUTW0(IOV1,RELOC) GOTO 10026 10035 CONTINUE 10025 GOTO(10027,10028,10029,10030,10031,10032,10033,10034),I 10026 IF((SYMBOL.EQ.3))GOTO 10137 CALL ERRMSG('end of line expected.') 10138 IF((SYMBOL.EQ.3))GOTO 10139 CALL GETSYM GOTO 10138 10139 CONTINUE 10137 RETURN END SUBROUTINE DOPSE0(OP) INTEGER OP,EXPR INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER VAL,RELOC INTEGER LOCAT0 INTEGER SUBST(33) IF((OP.NE.0))GOTO 10140 IF((EXPR(VAL,RELOC).NE.-3))GOTO 10141 RETURN 10141 IF((((RELOC.NE.1).AND.(VAL.LE.255)).AND.(VAL.GE.-128)))GOTO 1014 *2 CALL PRINT(-11,'reloc = *i; val = *i*n.',RELOC,VAL) 10142 CALL CPUTB0(VAL,0) GOTO 10143 10140 IF((OP.NE.1))GOTO 10144 CALL GETSYM IF((SYMBOL.EQ.4))GOTO 10145 CALL ERRMSG('def usage is ''def alias real''.') GOTO 10146 10145 CALL SCOPY(TOKEN,1,SUBST,1) CALL GETSYM IF((SYMBOL.EQ.4))GOTO 10147 CALL ERRMSG('def usage is ''def alias real''.') GOTO 10148 10147 CALL ENTER(SUBST,2,LOCAT0(TOKEN)) CALL GETSYM 10148 CONTINUE 10146 GOTO 10149 10144 IF((EXPR(VAL,RELOC).NE.-3))GOTO 10150 RETURN 10150 CALL CPUTW0(VAL,RELOC) 10149 CONTINUE 10143 RETURN END SUBROUTINE ENTER(SYM,TYPE,VAL) INTEGER SYM(1) INTEGER TYPE,VAL INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER L INTEGER LOCAT0 L=LOCAT0(SYM) IF((SYMTYP(L).EQ.3))GOTO 10151 CALL ERRMSG('symbol redefined.') GOTO 10152 10151 CALL CHAIN0(SYMVAL(L),VAL,TYPE) SYMTYP(L)=TYPE SYMVAL(L)=VAL 10152 RETURN END SUBROUTINE ERRMSG(MSG) INTEGER MSG(1) INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE CALL PRINT(-15,'*4i: *p*n.',LCNT,MSG) RETURN END INTEGER FUNCTION EXPR(VAL,RELOC) INTEGER VAL,RELOC INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER L,VAL2,OPERA0 INTEGER LOCAT0,CALLE0 IF((SYMBOL.NE.3))GOTO 10153 EXPR=-3 CALL ERRMSG('expression expected.') VAL=0 RELOC=0 RETURN 10153 EXPR=-2 CALL GETSYM IF((SYMBOL.NE.1))GOTO 10154 VAL=CONST0 CALL GETSYM IF(((SYMBOL.LT.6).OR.(SYMBOL.GT.7)))GOTO 10155 OPERA0=SYMBOL EXPR=CALLE0(VAL2,RELOC) IF((OPERA0.NE.6))GOTO 10156 VAL=OR(VAL,VAL2) GOTO 10157 10156 IF((OPERA0.NE.7))GOTO 10158 VAL=AND(VAL,VAL2) 10158 CONTINUE 10157 CONTINUE 10155 RELOC=0 GOTO 10159 10154 IF((SYMBOL.NE.4))GOTO 10160 L=LOCAT0(TOKEN) IF((SYMTYP(L).NE.3))GOTO 10161 VAL=SYMVAL(L) SYMVAL(L)=LC RELOC=0 GOTO 10162 10161 VAL=SYMVAL(L) RELOC=SYMTYP(L) 10162 CALL GETSYM GOTO 10163 10160 EXPR=-3 CALL ERRMSG('missing expression.') VAL=0 RELOC=0 10164 IF((SYMBOL.EQ.3))GOTO 10165 CALL GETSYM GOTO 10164 10165 CONTINUE 10163 CONTINUE 10159 RETURN END INTEGER FUNCTION CALLE0(VAL,RELOC) INTEGER VAL,RELOC INTEGER EXPR CALLE0=EXPR(VAL,RELOC) RETURN END SUBROUTINE GETBY0(B) INTEGER B INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER JUNK INTEGER MAPFD CALL PRWF$$(:1,MAPFD(CODE),LOC(B),1,INTL(0),JUNK,JUNK) RETURN END SUBROUTINE GETSYM INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER C LOGICAL ALPHA 10166 CALL INCHAR(C) IF(((C.EQ.160).OR.(C.EQ.137)))GOTO 10166 IF((.NOT.ALPHA(C)))GOTO 10167 CALL PUSHB0(C) CALL SCANID GOTO 10168 10167 IF(((176.GT.C).OR.(C.GT.185)))GOTO 10169 CALL PUSHB0(C) CALL SCAND0 GOTO 10170 10169 IF((C.NE.164))GOTO 10171 CALL SCANH0 GOTO 10172 10171 IF((C.NE.163))GOTO 10173 CALL SCANC0 GOTO 10174 10173 IF(((C.NE.187).AND.(C.NE.138)))GOTO 10175 IF((C.NE.138))GOTO 10176 LCNT=LCNT+1 10176 SYMBOL=3 GOTO 10177 10175 IF((C.NE.252))GOTO 10178 SYMBOL=6 GOTO 10179 10178 IF((C.NE.166))GOTO 10180 SYMBOL=7 GOTO 10181 10180 IF((C.NE.-1))GOTO 10182 SYMBOL=2 10182 CONTINUE 10181 CONTINUE 10179 CONTINUE 10177 CONTINUE 10174 CONTINUE 10172 CONTINUE 10170 CONTINUE 10168 RETURN END SUBROUTINE GETWO0(W) INTEGER W INTEGER HI,LO CALL GETBY0(LO) CALL GETBY0(HI) W=OR(LS(HI,8),LO) RETURN END SUBROUTINE INCHAR(C) INTEGER C INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER GETCH IF((IBP.LE.0))GOTO 10183 C=INBUF(IBP) GOTO 10184 10183 IBP=1 INBUF(IBP)=GETCH(C,-10) 10184 IF((C.EQ.-1))GOTO 10185 IBP=IBP-1 10185 RETURN END SUBROUTINE INITI0 INTEGER CREATE INTEGER S(4,26) INTEGER I,V(26) INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER CODEF(3) DATA CODEF/174,239,0/ DATA S/225,0,0,0,226,227,0,0,226,0,0,0,227,0,0,0,228,229,0,0,228,0 *,0,0,229,0,0,0,232,236,0,0,232,0,0,0,236,0,0,0,237,0,0,0,240,243,2 *47,0,243,240,0,0,193,0,0,0,194,195,0,0,194,0,0,0,195,0,0,0,196,197 *,0,0,196,0,0,0,197,0,0,0,200,204,0,0,200,0,0,0,204,0,0,0,205,0,0,0 *,208,211,215,0,211,208,0,0/ DATA V/7,0,0,1,2,2,3,4,4,5,6,6,6,7,0,0,1,2,2,3,4,4,5,6,6,6/ CODE=CREATE(CODEF,3) IF((CODE.NE.-3))GOTO 10186 CALL ERROR('can''t open output file.') 10186 LCNT=1 LC=0 SYMTOP=0 IBP=0 CALL DSINIT(10000) CALL GETSYM CALL PUTBY0(1) I=2 GOTO 10189 10187 I=I+1 10189 IF((I.GT.3))GOTO 10188 CALL PUTBY0(0) GOTO 10187 10188 I=1 GOTO 10192 10190 I=I+1 10192 IF((I.GT.26))GOTO 10191 CALL ENTER(S(1,I),4,V(I)) GOTO 10190 10191 RETURN END SUBROUTINE INSTR0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER MAPDN INTEGER OP,I INTEGER PSEUD0,MACHOP I=1 GOTO 10195 10193 I=I+1 10195 IF((TOKEN(I).EQ.0))GOTO 10194 TOKEN(I)=MAPDN(TOKEN(I)) GOTO 10193 10194 IF((PSEUD0(TOKEN,OP).NE.1))GOTO 10196 CALL DOPSE0(OP) GOTO 10197 10196 IF((MACHOP(TOKEN,OP).NE.1))GOTO 10198 CALL DOMACH(OP) GOTO 10199 10198 CALL ERRMSG('unrecognized symbol in op field.') CALL GETSYM 10199 CONTINUE 10197 RETURN END INTEGER FUNCTION LOCAT0(SYM) INTEGER SYM(1) INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER I INTEGER EQUAL INTEGER SDUP I=1 GOTO 10202 10200 I=I+1 10202 IF((I.GT.SYMTOP))GOTO 10201 IF((EQUAL(SYM,MEM(SYMSYM(I))).NE.1))GOTO 10203 IF((SYMTYP(I).NE.2))GOTO 10204 LOCAT0=SYMVAL(I) GOTO 10205 10204 LOCAT0=I 10205 RETURN 10203 GOTO 10200 10201 IF((SYMTOP.LT.2000))GOTO 10206 CALL ERRMSG('too many symbols --- assembly stopped.') CALL SWT 10206 SYMTOP=SYMTOP+1 SYMSYM(SYMTOP)=SDUP(SYM) SYMTYP(SYMTOP)=3 SYMVAL(SYMTOP)=-1 LOCAT0=SYMTOP RETURN END INTEGER FUNCTION MACHOP(TOKEN,OP) INTEGER TOKEN(1) INTEGER OP INTEGER INSTS0(5,83) INTEGER TOP,BOTTOM,MIDDLE,COMP INTEGER COMPA0 DATA INSTS0/0,0,0,0,0,225,227,233,0,0,225,228,227,0,0,225,228,228, *0,0,225,228,233,0,0,225,238,225,0,0,225,238,233,0,0,227,225,236,23 *6,0,227,227,0,0,0,227,237,225,0,0,227,237,227,0,0,227,237,240,0,0, *227,237,0,0,0,227,238,227,0,0,227,238,250,0,0,227,240,0,0,0,227,24 *0,229,0,0,227,240,233,0,0,227,240,239,0,0,227,250,0,0,0,228,225,22 *5,0,0,228,225,228,0,0,228,227,242,0,0,228,227,248,0,0,228,233,0,0, *0,229,233,0,0,0,232,229,248,0,0,232,236,244,0,0,233,238,0,0,0,233, *238,242,0,0,233,238,248,0,0,234,227,0,0,0,234,237,0,0,0,234,237,24 *0,0,0,234,238,227,0,0,234,238,250,0,0,234,240,0,0,0,234,240,229,0, *0,234,240,239,0,0,234,250,0,0,0,236,228,225,0,0,236,228,225,248,0, *236,232,236,228,0,236,248,233,0,0,237,239,246,0,0,237,246,233,0,0, *238,239,240,0,0,239,242,225,0,0,239,242,231,0,0,239,242,233,0,0,23 *9,245,244,0,0,240,227,232,236,0,240,239,240,0,0,240,245,243,232,0, *242,225,236,0,0,242,225,242,0,0,242,227,0,0,0,242,229,244,0,0,242, *236,227,0,0,242,237,0,0,0,242,238,227,0,0,242,238,250,0,0,242,240, *0,0,0,242,240,229,0,0,242,240,239,0,0,242,242,227,0,0,242,243,244, *0,0,242,250,0,0,0,243,226,226,0,0,243,226,233,0,0,243,229,244,0,0, *243,232,236,228,0,243,240,232,236,0,243,244,225,0,0,243,244,225,24 *8,0,243,244,227,0,0,243,245,226,0,0,243,245,233,0,0,248,227,232,23 *1,0,248,242,225,0,0,248,242,233,0,0,248,244,232,236,0,-1,-1,-1,-1, *-1/ TOP=1 BOTTOM=83 10207 MIDDLE=RS(TOP+BOTTOM,1) COMP=COMPA0(TOKEN,INSTS0(1,MIDDLE)) IF((COMP.LT.0))GOTO 10208 TOP=MIDDLE+1 10208 IF((COMP.GT.0))GOTO 10209 BOTTOM=MIDDLE-1 10209 CONTINUE IF((TOP.LE.BOTTOM))GOTO 10207 IF((COMP.NE.0))GOTO 10210 MACHOP=1 OP=MIDDLE GOTO 10211 10210 MACHOP=0 10211 RETURN END INTEGER FUNCTION PSEUD0(TOKEN,OP) INTEGER TOKEN(1) INTEGER OP INTEGER BYTEOP(5) INTEGER DEFOP(4) INTEGER WORDOP(5) INTEGER EQUAL DATA BYTEOP/226,249,244,229,0/ DATA DEFOP/228,229,230,0/ DATA WORDOP/247,239,242,228,0/ PSEUD0=1 IF((EQUAL(TOKEN,BYTEOP).NE.1))GOTO 10212 OP=0 GOTO 10213 10212 IF((EQUAL(TOKEN,DEFOP).NE.1))GOTO 10214 OP=1 GOTO 10215 10214 IF((EQUAL(TOKEN,WORDOP).NE.1))GOTO 10216 OP=2 GOTO 10217 10216 PSEUD0=0 10217 CONTINUE 10215 CONTINUE 10213 RETURN END SUBROUTINE PUSHB0(C) INTEGER C INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE IBP=IBP+1 IF((IBP.LE.10))GOTO 10218 CALL ERRMSG('too many characters pushed back.') GOTO 10219 10218 INBUF(IBP)=C 10219 RETURN END SUBROUTINE PUTBY0(B) INTEGER B INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER W,JUNK INTEGER MAPFD W=RT(B,8) CALL PRWF$$(:2,MAPFD(CODE),LOC(W),1,INTL(0),JUNK,JUNK) RETURN END SUBROUTINE PUTREL(RELOC,ADDRE0) INTEGER RELOC,ADDRE0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER WORD,MASK WORD=ADDRE0/8+1 MASK=LS(1,7-MOD(ADDRE0,8)) IF((RELOC.NE.1))GOTO 10220 RMAP(WORD)=OR(RMAP(WORD),MASK) GOTO 10221 10220 RMAP(WORD)=AND(RMAP(WORD),NOT(MASK)) 10221 RETURN END SUBROUTINE PUTWO0(W) INTEGER W CALL PUTBY0(RT(W,8)) CALL PUTBY0(RS(W,8)) RETURN END SUBROUTINE SCANC0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER C 10222 CALL INCHAR(C) IF((C.NE.138))GOTO 10222 SYMBOL=3 RETURN END SUBROUTINE SCAND0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER DEC(11) INTEGER C INTEGER I INTEGER INDEX DATA DEC/176,177,178,179,180,181,182,183,184,185,0/ CONST0=0 10223 CALL INCHAR(C) I=INDEX(DEC,C) IF((I.GE.1))GOTO 10224 CALL PUSHB0(C) GOTO 10225 10224 CONST0=10*CONST0+I-1 GOTO 10223 10225 SYMBOL=1 RETURN END SUBROUTINE SCANH0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER HEX(17) INTEGER C INTEGER MAPDN INTEGER I INTEGER INDEX DATA HEX/176,177,178,179,180,181,182,183,184,185,225,226,227,228,2 *29,230,0/ CONST0=0 10226 CALL INCHAR(C) I=INDEX(HEX,MAPDN(C)) IF((I.GE.1))GOTO 10227 CALL PUSHB0(C) GOTO 10228 10227 CONST0=LS(CONST0,4)+I-1 GOTO 10226 10228 SYMBOL=1 RETURN END SUBROUTINE SCANID INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER I INTEGER C LOGICAL ALPHA I=1 10229 CALL INCHAR(C) IF((ALPHA(C).OR.((C.GE.176).AND.(C.LE.185))))GOTO 10230 GOTO 10231 10230 TOKEN(I)=C I=I+1 GOTO 10229 10231 TOKEN(I)=0 IF((C.NE.186))GOTO 10232 SYMBOL=5 GOTO 10233 10232 CALL PUSHB0(C) SYMBOL=4 10233 RETURN END INTEGER FUNCTION SDUP(STR) INTEGER STR(1) INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER P INTEGER LENGTH,DSGET P=DSGET(LENGTH(STR)+1) CALL SCOPY(STR,1,MEM,P) SDUP=P RETURN END SUBROUTINE SEEKE0 INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER JUNK INTEGER MAPFD CALL PRWF$$(:3+:10,MAPFD(CODE),LOC(0),0,INTL(65536),JUNK,JUNK) RETURN END SUBROUTINE SEEK(POSN) INTEGER POSN INTEGER MEM(10000) COMMON /DS$MEM/MEM INTEGER SYMBOL,LCNT,IBP,CONST0 INTEGER TOKEN(33),INBUF(10) COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0 INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP INTEGER RMAP(4096) COMMON /RELMAP/RMAP INTEGER LC,CODE COMMON /CCOM/LC,CODE INTEGER JUNK INTEGER MAPFD CALL PRWF$$(:3+:10,MAPFD(CODE),LOC(0),0,INTL(POSN),JUNK,JUNK) RETURN END SUBROUTINE XSEEK(POSN) INTEGER POSN CALL SEEK(POSN+3) RETURN END C ---- Long Name Map ---- C putbyte putby0 C symbrlist symbr0 C instruction instr0 C chainback chain0 C scancomment scanc0 C address addre0 C compare compa0 C constval const0 C cleanup clean0 C putword putwo0 C operator opera0 C scanhex scanh0 C pseudoop pseud0 C cputbyte cputb0 C getbyte getby0 C cputword cputw0 C pushback pushb0 C getword getwo0 C scandec scand0 C instructions insts0 C initialize initi0 C location locat0 C callexpr calle0 C seekend seeke0 C dopseudo dopse0