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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 CALL INITI0 10000 IF((SYMBOL.EQ.2))GOTO 10001 IF((SYMBOL.NE.3))GOTO 10002 CALL GETSYM GOTO 10003 10002 IF((SYMBOL.NE.6))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 BREXPR(VAL) INTEGER 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER L,P INTEGER LOCAT0 INTEGER DSGET IF((SYMBOL.EQ.4))GOTO 10006 CALL ERRMSG('target of branch must be a label.') GOTO 10007 10006 L=LOCAT0(TOKEN) IF((SYMTYP(L).EQ.3))GOTO 10008 VAL=SYMVAL(L)-LC-1 IF(((VAL.LE.127).AND.(VAL.GE.-128)))GOTO 10009 CALL ERRMSG('branch out of range.') 10009 GOTO 10010 10008 P=DSGET(2) MEM(P+1)=SYMBR0(L) MEM(P+0)=LC SYMBR0(L)=P VAL=0 10010 CALL GETSYM 10007 RETURN END SUBROUTINE CHAIN0(ADDR,VAL,TYPE) INTEGER ADDR,VAL,TYPE INTEGER P,NEXT P=ADDR 10011 IF((P.EQ.-1))GOTO 10012 CALL PUTREL(TYPE,P) CALL XSEEK(P) CALL GETWO0(NEXT) CALL XSEEK(P) CALL PUTWO0(VAL) P=NEXT GOTO 10011 10012 IF((ADDR.EQ.-1))GOTO 10013 CALL SEEKE0 10013 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER I,J,MAPLEN INTEGER LENGTH,CTOA CALL PUTBY0(2) MAPLEN=(LC+7)/8 CALL PUTWO0(MAPLEN) I=1 GOTO 10016 10014 I=I+1 10016 IF((I.GT.MAPLEN))GOTO 10015 CALL PUTBY0(RMAP(I)) GOTO 10014 10015 I=1 GOTO 10019 10017 I=I+1 10019 IF((I.GT.SYMTOP))GOTO 10018 IF((MEM(SYMSYM(I)).EQ.223))GOTO 10020 CALL PUTBY0(3) CALL PUTWO0(LENGTH(MEM(SYMSYM(I)))+5) CALL PUTWO0(SYMTYP(I)) CALL PUTWO0(SYMVAL(I)) J=SYMSYM(I) GOTO 10023 10021 J=J+1 10023 IF((MEM(J).EQ.0))GOTO 10022 CALL PUTBY0(CTOA(MEM(J))) GOTO 10021 10022 CALL PUTBY0(0) 10020 GOTO 10017 10018 CALL SEEK(1) CALL PUTWO0(LC) IF((LISTI0.NE.1))GOTO 10024 CALL BUILD0 CALL CLOSE(LIST) CALL CLOSE(LSOUR0) 10024 CALL CLOSE(CODE) RETURN END INTEGER FUNCTION COMPA0(STR1,STR2) INTEGER STR1(1),STR2(1) INTEGER I I=1 GOTO 10027 10025 I=I+1 10027 IF((STR1(I).NE.STR2(I)))GOTO 10026 IF((STR1(I).NE.0))GOTO 10028 COMPA0=0 RETURN 10028 GOTO 10025 10026 IF((STR1(I).LE.STR2(I)))GOTO 10029 COMPA0=1 GOTO 10030 10029 COMPA0=-1 10030 RETURN END SUBROUTINE COMPL0(MLINK,VAL) INTEGER MLINK,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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER P,OFFSET,ADDRE0 P=MLINK 10031 IF((P.EQ.-1))GOTO 10032 ADDRE0=MEM(P+0) CALL XSEEK(ADDRE0) OFFSET=VAL-ADDRE0-1 IF(((OFFSET.LE.127).AND.(OFFSET.GE.-128)))GOTO 10033 CALL ERRMSG('a branch to this label is out of range.') 10033 CALL PUTBY0(OFFSET) ADDRE0=P P=MEM(P+1) CALL DSFREE(ADDRE0) GOTO 10031 10032 IF((MLINK.EQ.-1))GOTO 10034 CALL SEEKE0 10034 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 CALL PUTBY0(VAL) CALL PUTREL(RELOC,LC) LC=LC+1 RETURN END SUBROUTINE CPUTW0(VAL,RELOC) INTEGER VAL,RELOC CALL CPUTB0(RS(VAL,8),RELOC) CALL CPUTB0(RT(VAL,8),0) RETURN END INTEGER FUNCTION CTOA(C) INTEGER C CTOA=RT(C,7) RETURN END SUBROUTINE DOMACH(OP) INTEGER OP 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER VAL,RELOC,BASE,MASK,BASEOP(108),ADDRM0(108) DATA BASEOP/:33,:211,:311,:213,:313,:204,:304,72,72,88,71,71,87,36 *,37,39,44,46,34,133,197,47,35,45,43,38,42,32,141,40,41,17,12,14,79 *,79,95,10,129,193,67,67,83,140,25,74,74,90,52,9,136,200,76,76,92,4 *9,8,78,141,134,198,142,206,68,68,84,64,64,80,1,138,202,54,55,50,51 *,73,73,89,70,70,86,59,57,16,130,194,13,15,11,135,199,143,207,128,1 *92,63,15,22,6,23,7,77,77,93,48,53,62/ DATA ADDRM0/:4,:270,:270,:270,:270,:270,:270,:30,:4,:4,:30,:4,:4,: *2,:2,:2,:2,:2,:2,:270,:270,:2,:2,:2,:2,:2,:2,:2,:2,:2,:2,:4,:4,:4, *:30,:4,:4,:4,:270,:270,:30,:4,:4,:170,:4,:30,:4,:4,:4,:4,:270,:270 *,:30,:4,:4,:4,:4,:30,:30,:270,:270,:170,:170,:30,:4,:4,:30,:4,:4,: *4,:270,:270,:4,:4,:4,:4,:30,:4,:4,:30,:4,:4,:4,:4,:4,:270,:270,:4, *:4,:4,:70,:70,:70,:70,:270,:270,:4,:10,:4,:4,:4,:4,:30,:4,:4,:4,:4 *,:4/ BASE=BASEOP(OP) MASK=ADDRM0(OP) CALL GETSYM IF((SYMBOL.NE.5))GOTO 10035 CALL GETSYM IF((AND(MASK,:200).EQ.0))GOTO 10036 CALL CPUTB0(BASE+0,0) CALL EXPR(VAL,RELOC) IF((((RELOC.NE.1).AND.(VAL.GE.-128)).AND.(VAL.LE.255)))GOTO 10 *037 CALL ERRMSG('value relocatable or larger than 1 byte.') 10037 CALL CPUTB0(VAL,0) GOTO 10038 10036 IF((AND(MASK,:100).EQ.0))GOTO 10039 CALL CPUTB0(BASE+0,0) CALL EXPR(VAL,RELOC) CALL CPUTW0(VAL,RELOC) GOTO 10040 10039 CALL ERRMSG('immediate addressing not allowed.') 10040 CONTINUE 10038 GOTO 10041 10035 IF((SYMBOL.NE.7))GOTO 10042 CALL GETSYM IF((AND(MASK,:20).EQ.0))GOTO 10043 CALL CPUTB0(BASE+32,0) CALL EXPR(VAL,RELOC) IF((((RELOC.NE.1).AND.(VAL.GE.0)).AND.(VAL.LE.255)))GOTO 100 *44 CALL ERRMSG('value is not a valid index.') 10044 CALL CPUTB0(VAL,0) IF((SYMBOL.NE.0))GOTO 10045 CALL GETSYM GOTO 10046 10045 CALL ERRMSG('missing '']''.') 10046 GOTO 10047 10043 CALL ERRMSG('indexed addressing not permissible.') 10047 GOTO 10048 10042 IF((AND(MASK,:4).EQ.0))GOTO 10049 CALL CPUTB0(BASE+0,0) GOTO 10050 10049 IF((AND(MASK,:2).EQ.0))GOTO 10051 CALL CPUTB0(BASE+0,0) CALL BREXPR(VAL) CALL CPUTB0(VAL,0) GOTO 10052 10051 IF((AND(MASK,:10).EQ.0))GOTO 10053 CALL CPUTB0(BASE+48,0) CALL EXPR(VAL,RELOC) CALL CPUTW0(VAL,RELOC) GOTO 10054 10053 CALL ERRMSG('in do_mach: can''t happen.') 10054 CONTINUE 10052 CONTINUE 10050 CONTINUE 10048 CONTINUE 10041 RETURN END SUBROUTINE DOPSE0(OP) INTEGER OP 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER VAL,RELOC,I INTEGER LOCAT0 INTEGER SUBST(33) CALL GETSYM IF((OP.NE.0))GOTO 10055 CALL EXPR(VAL,RELOC) IF((((RELOC.NE.1).AND.(VAL.LE.255)).AND.(VAL.GE.-128)))GOTO 1005 *6 CALL ERRMSG('value relocatable or larger than 1 byte.') 10056 CALL CPUTB0(VAL,0) GOTO 10057 10055 IF((OP.NE.1))GOTO 10058 IF((SYMBOL.EQ.4))GOTO 10059 CALL ERRMSG('def usage is ''def alias real''.') GOTO 10060 10059 CALL SCOPY(TOKEN,1,SUBST,1) CALL GETSYM IF((SYMBOL.EQ.4))GOTO 10061 CALL ERRMSG('def usage is ''def alias real''.') GOTO 10062 10061 CALL ENTER(SUBST,2,LOCAT0(TOKEN)) CALL GETSYM 10062 CONTINUE 10060 GOTO 10063 10058 IF((OP.NE.2))GOTO 10064 CALL EXPR(VAL,RELOC) CALL CPUTW0(VAL,RELOC) GOTO 10065 10064 IF((OP.NE.3))GOTO 10066 CALL EXPR(VAL,RELOC) IF((RELOC.NE.1))GOTO 10067 CALL ERRMSG('value must not be relocatable.') 10067 I=1 GOTO 10070 10068 I=I+1 10070 IF((I.GT.VAL))GOTO 10069 CALL CPUTB0(0,0) GOTO 10068 10069 GOTO 10071 10066 IF((OP.NE.4))GOTO 10072 CALL EXPR(VAL,RELOC) IF((RELOC.NE.1))GOTO 10073 CALL ERRMSG('value must not be relocatable.') 10073 IF((VAL.GE.LC))GOTO 10074 CALL ERRMSG('backward origin not permitted.') 10074 CONTINUE 10075 IF((LC.GE.VAL))GOTO 10076 CALL CPUTB0(0,0) GOTO 10075 10076 CONTINUE 10072 CONTINUE 10071 CONTINUE 10065 CONTINUE 10063 CONTINUE 10057 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER L INTEGER LOCAT0 L=LOCAT0(SYM) IF((SYMTYP(L).EQ.3))GOTO 10077 CALL ERRMSG('symbol redefined.') GOTO 10078 10077 CALL CHAIN0(SYMVAL(L),VAL,TYPE) CALL COMPL0(SYMBR0(L),VAL) SYMTYP(L)=TYPE SYMVAL(L)=VAL 10078 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 CALL PRINT(-15,'*4i: *p*n.',LCNT,MSG) RETURN END SUBROUTINE 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER L INTEGER LOCAT0 IF((SYMBOL.NE.1))GOTO 10079 VAL=CONST0 RELOC=0 CALL GETSYM GOTO 10080 10079 IF((SYMBOL.NE.4))GOTO 10081 L=LOCAT0(TOKEN) IF((SYMTYP(L).NE.3))GOTO 10082 VAL=SYMVAL(L) SYMVAL(L)=LC RELOC=0 GOTO 10083 10082 VAL=SYMVAL(L) RELOC=SYMTYP(L) 10083 CALL GETSYM GOTO 10084 10081 CALL ERRMSG('missing expression.') VAL=0 RELOC=0 10084 CONTINUE 10080 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER C LOGICAL ALPHA 10085 CALL INCHAR(C) IF(((C.EQ.160).OR.(C.EQ.137)))GOTO 10085 IF((.NOT.ALPHA(C)))GOTO 10086 CALL PUSHB0(C) CALL SCANID GOTO 10087 10086 IF(((176.GT.C).OR.(C.GT.185)))GOTO 10088 CALL PUSHB0(C) CALL SCAND0 GOTO 10089 10088 IF((C.NE.164))GOTO 10090 CALL SCANH0 GOTO 10091 10090 IF((C.NE.165))GOTO 10092 CALL SCANC0 GOTO 10093 10092 IF((C.NE.219))GOTO 10094 SYMBOL=7 GOTO 10095 10094 IF((C.NE.221))GOTO 10096 SYMBOL=0 GOTO 10097 10096 IF((C.NE.163))GOTO 10098 SYMBOL=5 GOTO 10099 10098 IF((C.NE.187))GOTO 10100 SYMBOL=3 GOTO 10101 10100 IF((C.NE.138))GOTO 10102 SYMBOL=3 LCNT=LCNT+1 GOTO 10103 10102 IF((C.NE.-1))GOTO 10104 SYMBOL=2 10104 CONTINUE 10103 CONTINUE 10101 CONTINUE 10099 CONTINUE 10097 CONTINUE 10095 CONTINUE 10093 CONTINUE 10091 CONTINUE 10089 CONTINUE 10087 RETURN END SUBROUTINE GETWO0(W) INTEGER W INTEGER HI,LO CALL GETBY0(HI) CALL GETBY0(LO) 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER GETCH IF((IBP.LE.0))GOTO 10105 C=INBUF(IBP) GOTO 10106 10105 IBP=1 INBUF(IBP)=GETCH(C,-10) IF((LISTI0.NE.1))GOTO 10107 CALL PUTCH(C,LSOUR0) 10107 CONTINUE 10106 IF((C.EQ.-1))GOTO 10108 IBP=IBP-1 10108 RETURN END SUBROUTINE INITI0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER CODEF(3) INTEGER I INTEGER CREATE,GETARG,MKTEMP INTEGER ARG(128) DATA CODEF/174,239,0/ CODE=CREATE(CODEF,3) IF((CODE.NE.-3))GOTO 10109 CALL ERROR('can''t open output file.') 10109 LISTI0=0 DIREC0=.FALSE. IF((GETARG(1,ARG,128).EQ.-1))GOTO 10110 IF((ARG(1).NE.173))GOTO 10110 I=2 GOTO 10113 10111 I=I+(1) 10113 IF((ARG(I).EQ.0))GOTO 10112 IF((ARG(I).EQ.236))GOTO 10115 IF((ARG(I).EQ.204))GOTO 10115 GOTO 10114 10115 LISTI0=1 LIST=MKTEMP(3) IF((LIST.NE.-3))GOTO 10116 CALL ERROR('can''t open listing temporary file.') 10116 LSOUR0=MKTEMP(3) IF((LSOUR0.NE.-3))GOTO 10117 CALL ERROR('can''t open source temporary file.') 10117 GOTO 10118 10114 IF((ARG(I).EQ.228))GOTO 10120 IF((ARG(I).EQ.196))GOTO 10120 GOTO 10119 10120 DIREC0=.TRUE. GOTO 10121 10119 CALL ERROR('Usage: as6800 [-{l|d}].') 10121 CONTINUE 10118 GOTO 10111 10112 CONTINUE 10110 LCNT=1 LC=0 SYMTOP=0 IBP=0 CALL DSINIT(10000) CALL GETSYM CALL PUTBY0(1) I=2 GOTO 10124 10122 I=I+1 10124 IF((I.GT.3))GOTO 10123 CALL PUTBY0(0) GOTO 10122 10123 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER OP INTEGER PSEUD0,MACHOP IF((LISTI0.NE.1))GOTO 10125 CALL PRINT(LIST,'*8,i*8,i*n.',LC,LCNT) 10125 IF((PSEUD0(TOKEN,OP).NE.1))GOTO 10126 CALL DOPSE0(OP) GOTO 10127 10126 IF((MACHOP(TOKEN,OP).NE.1))GOTO 10128 CALL DOMACH(OP) GOTO 10129 10128 CALL ERRMSG('unrecognized symbol in op field.') CALL GETSYM 10129 CONTINUE 10127 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER I INTEGER EQUAL INTEGER SDUP I=1 GOTO 10132 10130 I=I+1 10132 IF((I.GT.SYMTOP))GOTO 10131 IF((EQUAL(SYM,MEM(SYMSYM(I))).NE.1))GOTO 10133 IF((SYMTYP(I).NE.2))GOTO 10134 LOCAT0=SYMVAL(I) GOTO 10135 10134 LOCAT0=I 10135 RETURN 10133 GOTO 10130 10131 IF((SYMTOP.LT.2000))GOTO 10136 CALL ERRMSG('too many symbols --- assembly stopped.') CALL SWT 10136 SYMTOP=SYMTOP+1 SYMSYM(SYMTOP)=SDUP(SYM) SYMTYP(SYMTOP)=3 SYMVAL(SYMTOP)=-1 SYMBR0(SYMTOP)=-1 LOCAT0=SYMTOP RETURN END INTEGER FUNCTION MACHOP(TOKEN,OP) INTEGER TOKEN(1) INTEGER OP INTEGER INSTS0(5,108) INTEGER TOP,BOTTOM,MIDDLE,COMP INTEGER COMPA0 DATA INSTS0/225,226,225,2*0,225,228,227,225,0,225,228,227,226,0,22 *5,228,228,225,0,225,228,228,226,0,225,238,228,225,0,225,238,228,22 *6,0,225,243,236,2*0,225,243,236,225,0,225,243,236,226,0,225,243,24 *2,2*0,225,243,242,225,0,225,243,242,226,0,226,227,227,2*0,226,227, *243,2*0,226,229,241,2*0,226,231,229,2*0,226,231,244,2*0,226,232,23 *3,2*0,226,233,244,225,0,226,233,244,226,0,226,236,229,2*0,226,236, *243,2*0,226,236,244,2*0,226,237,233,2*0,226,238,229,2*0,226,240,23 *6,2*0,226,242,225,2*0,226,243,242,2*0,226,246,227,2*0,226,246,243, *2*0,227,226,225,2*0,227,236,227,2*0,227,236,233,2*0,227,236,242,2* *0,227,236,242,225,0,227,236,242,226,0,227,236,246,2*0,227,237,240, *225,0,227,237,240,226,0,227,239,237,2*0,227,239,237,225,0,227,239, *237,226,0,227,240,248,2*0,228,225,225,2*0,228,229,227,2*0,228,229, *227,225,0,228,229,227,226,0,228,229,243,2*0,228,229,248,2*0,229,23 *9,242,225,0,229,239,242,226,0,233,238,227,2*0,233,238,227,225,0,23 *3,238,227,226,0,233,238,243,2*0,233,238,248,2*0,234,237,240,2*0,23 *4,243,242,2*0,236,228,225,225,0,236,228,225,226,0,236,228,243,2*0, *236,228,248,2*0,236,243,242,2*0,236,243,242,225,0,236,243,242,226, *0,238,229,231,2*0,238,229,231,225,0,238,229,231,226,0,238,239,240, *2*0,239,242,225,225,0,239,242,225,226,0,240,243,232,225,0,240,243, *232,226,0,240,245,236,225,0,240,245,236,226,0,242,239,236,2*0,242, *239,236,225,0,242,239,236,226,0,242,239,242,2*0,242,239,242,225,0, *242,239,242,226,0,242,244,233,2*0,242,244,243,2*0,243,226,225,2*0, *243,226,227,225,0,243,226,227,226,0,243,229,227,2*0,243,229,233,2* *0,243,229,246,2*0,243,244,225,225,0,243,244,225,226,0,243,244,243, *2*0,243,244,248,2*0,243,245,226,225,0,243,245,226,226,0,243,247,23 *3,2*0,243,249,243,2*0,244,225,226,2*0,244,225,240,2*0,244,226,225, *2*0,244,240,225,2*0,244,243,244,2*0,244,243,244,225,0,244,243,244, *226,0,244,243,248,2*0,244,248,243,2*0,247,225,233,2*0/ TOP=1 BOTTOM=108 10137 MIDDLE=RS(TOP+BOTTOM,1) COMP=COMPA0(TOKEN,INSTS0(1,MIDDLE)) IF((COMP.LT.0))GOTO 10138 TOP=MIDDLE+1 10138 IF((COMP.GT.0))GOTO 10139 BOTTOM=MIDDLE-1 10139 CONTINUE IF((TOP.LE.BOTTOM))GOTO 10137 IF((COMP.NE.0))GOTO 10140 MACHOP=1 OP=MIDDLE GOTO 10141 10140 MACHOP=0 10141 RETURN END INTEGER FUNCTION PSEUD0(TOKEN,OP) INTEGER TOKEN(1) INTEGER OP INTEGER BYTEOP(5) INTEGER DEFOP(4) INTEGER WORDOP(5) INTEGER RESOP(4) INTEGER ORGOP(4) INTEGER EQUAL DATA BYTEOP/226,249,244,229,0/ DATA DEFOP/228,229,230,0/ DATA WORDOP/247,239,242,228,0/ DATA RESOP/242,229,243,0/ DATA ORGOP/239,242,231,0/ PSEUD0=1 IF((EQUAL(TOKEN,BYTEOP).NE.1))GOTO 10142 OP=0 GOTO 10143 10142 IF((EQUAL(TOKEN,DEFOP).NE.1))GOTO 10144 OP=1 GOTO 10145 10144 IF((EQUAL(TOKEN,WORDOP).NE.1))GOTO 10146 OP=2 GOTO 10147 10146 IF((EQUAL(TOKEN,RESOP).NE.1))GOTO 10148 OP=3 GOTO 10149 10148 IF((EQUAL(TOKEN,ORGOP).NE.1))GOTO 10150 OP=4 GOTO 10151 10150 PSEUD0=0 10151 CONTINUE 10149 CONTINUE 10147 CONTINUE 10145 CONTINUE 10143 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 IBP=IBP+1 IF((IBP.LE.10))GOTO 10152 CALL ERRMSG('too many characters pushed back.') GOTO 10153 10152 INBUF(IBP)=C 10153 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER WORD,MASK WORD=ADDRE0/8+1 MASK=LS(1,7-MOD(ADDRE0,8)) IF((RELOC.NE.1))GOTO 10154 RMAP(WORD)=OR(RMAP(WORD),MASK) GOTO 10155 10154 RMAP(WORD)=AND(RMAP(WORD),NOT(MASK)) 10155 RETURN END SUBROUTINE PUTWO0(W) INTEGER W CALL PUTBY0(RS(W,8)) CALL PUTBY0(RT(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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER C 10156 CALL INCHAR(C) IF((C.NE.138))GOTO 10156 LCNT=LCNT+1 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER DEC(11) INTEGER C INTEGER I INTEGER INDEX DATA DEC/176,177,178,179,180,181,182,183,184,185,0/ CONST0=0 10157 CALL INCHAR(C) I=INDEX(DEC,C) IF((I.GE.1))GOTO 10158 CALL PUSHB0(C) GOTO 10159 10158 CONST0=10*CONST0+I-1 GOTO 10157 10159 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 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 10160 CALL INCHAR(C) I=INDEX(HEX,MAPDN(C)) IF((I.GE.1))GOTO 10161 CALL PUSHB0(C) GOTO 10162 10161 CONST0=LS(CONST0,4)+I-1 GOTO 10160 10162 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER I INTEGER C LOGICAL ALPHA I=1 10163 CALL INCHAR(C) IF((ALPHA(C).OR.((C.GE.176).AND.(C.LE.185))))GOTO 10164 GOTO 10165 10164 TOKEN(I)=C I=I+1 GOTO 10163 10165 TOKEN(I)=0 IF((C.NE.186))GOTO 10166 SYMBOL=6 GOTO 10167 10166 CALL PUSHB0(C) SYMBOL=4 10167 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 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 SUBROUTINE BUILD0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER GETIN0,GETLIN INTEGER LASTL0,B1,B2,B3,LLC,NLC,LLCNT,NLCNT,LINE(102),LISTJ0,MULTI *0,COUNT CALL SEEK(1) CALL GETCO0(B1,B2,B3,2) LASTL0=LS(B1,8)+B2 CALL XSEEK(0) CALL REWIND(LIST) CALL REWIND(LSOUR0) LLCNT=0 LLC=0 MULTI0=0 LISTJ0=0 10168 IF((LISTJ0.EQ.-1))GOTO 10169 IF((GETIN0(NLC,NLCNT).NE.-1))GOTO 10170 NLC=LASTL0 NLCNT=LLCNT+1 LISTJ0=-1 10170 IF(((NLCNT-LLCNT).LE.1))GOTO 10171 IF(((NLC-LLC).EQ.0))GOTO 10172 IF((MULTI0.NE.1))GOTO 10173 CALL GETCO0(B1,B2,B3,(NLC-LLC),NLC) CALL LISTK0(LLCNT,LLC,B1,B2,B3,(LLC-NLC),LINE) MULTI0=0 GOTO 10174 10173 CALL GETCO0(B1,B2,B3,(NLC-LLC),NLC) IF((GETLIN(LINE,LSOUR0).NE.-1))GOTO 10175 CALL ERROR('In build_listing: shouldn''t happen.') 10175 CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC),LINE) 10174 CONTINUE 10172 COUNT=NLCNT-LLCNT-1 GOTO 10178 10176 COUNT=COUNT-1 10178 IF((COUNT.LE.0))GOTO 10177 IF((-1.NE.GETLIN(LINE,LSOUR0)))GOTO 10179 CALL ERROR('in build_listing: shouldn''t happen.') 10179 CALL LISTK0(NLCNT-COUNT,LLC,0,0,0,0,LINE) GOTO 10176 10177 GOTO 10180 10171 IF((LLC.NE.NLC))GOTO 10181 IF((LLC.NE.0))GOTO 10181 LLCNT=NLCNT GOTO 10168 10181 IF((NLC.EQ.LLC))GOTO 10182 IF((LLCNT.NE.NLCNT))GOTO 10182 IF((MULTI0.NE.1))GOTO 10183 CALL GETCO0(B1,B2,B3,NLC-LLC,NLC) CALL LISTK0(LLCNT,LLC,B1,B2,B3,(LLC-NLC),LINE) GOTO 10184 10183 MULTI0=1 CALL GETCO0(B1,B2,B3,NLC-LLC,NLC) IF((-1.NE.GETLIN(LINE,LSOUR0)))GOTO 10185 CALL ERROR('In build_listing: shouldn''t happen.') 10185 CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC),LINE) 10184 GOTO 10186 10182 CALL GETCO0(B1,B2,B3,NLC-LLC,NLC) IF((MULTI0.NE.1))GOTO 10187 CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC)*(-1),LINE) MULTI0=0 GOTO 10188 10187 IF((-1.NE.GETLIN(LINE,LSOUR0)))GOTO 10189 CALL ERROR('in build_listing: can''t happen.') 10189 CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC),LINE) 10188 CONTINUE 10186 CONTINUE 10180 LLC=NLC LLCNT=NLCNT GOTO 10168 10169 CONTINUE 10190 IF((GETLIN(LINE,LSOUR0).EQ.-1))GOTO 10191 CALL LISTK0(LLCNT,LLC,B1,B2,B3,0,LINE) LLCNT=LLCNT+1 GOTO 10190 10191 RETURN END SUBROUTINE LISTK0(LCNT,LC,B1,B2,B3,NBYTES,LINE) INTEGER LCNT,LC,B1,B2,B3,NBYTES INTEGER LINE(1) INTEGER AAAAA0 INTEGER AAAAB0 AAAAA0=NBYTES GOTO 10192 10193 CALL PRINT(-11,' (*4,16,0j) *2,16,0j*n.',LC,B1) GOTO 10194 10195 CALL PRINT(-11,' (*4,16,0j) *2,16,0j *2,16,0j*n.',LC,B1 *,B2) GOTO 10194 10196 CALL PRINT(-11,' (*4,16,0j) *2,16,0j *2,16,0j *2,16,0j* *n.',LC,B1,B2,B3) GOTO 10194 10197 CALL PRINT(-11,'*5,i (*4,16,0j) *2,16,0j *s.',LCNT, *LC,B1,LINE) GOTO 10194 10198 CALL PRINT(-11,'*5,i (*4,16,0j) *2,16,0j *2,16,0j *s.' *,LCNT,LC,B1,B2,LINE) GOTO 10194 10199 CALL PRINT(-11,'*5,i (*4,16,0j) *2,16,0j *2,16,0j *2,16,0j * *s.',LCNT,LC,B1,B2,B3,LINE) GOTO 10194 10192 AAAAB0=AAAAA0+4 GOTO(10196,10195,10193,10200,10197,10198,10199),AAAAB0 10200 CALL PRINT(-11,'*5,i *s.',LCNT,LINE) 10194 RETURN END INTEGER FUNCTION GETIN0(LOCLC,LOCLC0) INTEGER LOCLC,LOCLC0 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER GETLIN,CTOI INTEGER I INTEGER LINE(102) IF((GETLIN(LINE,LIST).NE.-1))GOTO 10201 GETIN0=-1 RETURN 10201 I=1 LOCLC=CTOI(LINE,I) LOCLC0=CTOI(LINE,I) GETIN0=-2 RETURN END SUBROUTINE GETCO0(B1,B2,B3,BYTES,NLC) INTEGER B1,B2,B3,BYTES,NLC 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 LOGICAL DIREC0 COMMON /CCOM/LC,CODE,DIREC0 INTEGER LIST,LISTI0,LSOUR0 COMMON /LSTNG/LIST,LISTI0,LSOUR0 INTEGER JUNK INTEGER MAPFD INTEGER AAAAC0 AAAAC0=BYTES GOTO 10202 10203 CALL PRWF$$(:1,MAPFD(CODE),LOC(B1),1,INTL(0),JUNK,JUNK) GOTO 10204 10205 CALL PRWF$$(:1,MAPFD(CODE),LOC(B1),1,INTL(0),JUNK,JUNK) CALL PRWF$$(:1,MAPFD(CODE),LOC(B2),1,INTL(0),JUNK,JUNK) GOTO 10204 10206 CALL PRWF$$(:1,MAPFD(CODE),LOC(B1),1,INTL(0),JUNK,JUNK) CALL PRWF$$(:1,MAPFD(CODE),LOC(B2),1,INTL(0),JUNK,JUNK) CALL PRWF$$(:1,MAPFD(CODE),LOC(B3),1,INTL(0),JUNK,JUNK) GOTO 10204 10202 GOTO(10203,10205,10206),AAAAC0 CALL XSEEK(NLC) B1=0 B2=0 B3=0 10204 RETURN END C ---- Long Name Map ---- C putbyte putby0 C symbrlist symbr0 C instruction instr0 C directenabled direc0 C chainback chain0 C address addre0 C scancomment scanc0 C compare compa0 C constval const0 C cleanup clean0 C putword putwo0 C scanhex scanh0 C multiple multi0 C pseudoop pseud0 C cputbyte cputb0 C loclcnt loclc0 C addrmask addrm0 C getbyte getby0 C cputword cputw0 C pushback pushb0 C listing listk0 C getword getwo0 C scandec scand0 C lsource lsour0 C completebr compl0 C buildlisting build0 C instructions insts0 C getindex getin0 C listingend listj0 C initialize initi0 C location locat0 C lastlocation lastl0 C Listing listi0 C getcode getco0 C seekend seeke0 C dopseudo dopse0