SECTION"UT1"
GET "AHDR"
LET LIST(SIZE,A0,A1,A2,A3,A4,A5,A6,A7) = VALOF $(
LET P=@A0
AND LSPP=LSP
LSP:=LSP+SIZE
IF LSP>LSPACEMAX THEN $(
PROFIL:=1; FAULT('Z')
RESULTIS 0
$)
FOR N=0 TO SIZE-1 DO LSPP!N:=P!N
RESULTIS LSPP
$)
AND SETLABEL(LAB) BE $(
UNLESS LAB=0 THEN SETSYMBOL(LAB,((CNT=ABSC)->T.ABS,T.REL),!CNT)
$)
AND SETSYMBOL(SYMB,TYPE,VALUE) = VALOF $(
LET T=GETNAME(@SYMB)
IF T=-1 THEN RETURN
IF PASS=1 THEN $(
IF NAMEP!T=0 THEN $(
TEST CROSSREF THEN $(
NAMEP!T:=LIST(4,TYPE,VALUE,0,0)
ADDREF(NAMEP!T,2,!CNT)
$)
ELSE NAMEP!T:=LIST(2,TYPE,VALUE)
RETURN
$)
IF CROSSREF THEN ADDREF(NAMEP!T,2,!CNT)
$(
LET A=!(NAMEP!T)
UNLESS (A&T.MULDEF)=0 RETURN
IF (A&T.REDEF)=0 THEN $(
!(NAMEP!T):=A LOGOR T.MULDEF
RETURN
$)
!(NAMEP!T):=TYPE
1!(NAMEP!T):=VALUE
$)
RETURN
$)
IF NAMEP!T=0 THEN $(
FAULT('P')
RETURN
$)
$(
LET A=!(NAMEP!T)
UNLESS (A&T.MULDEF)=0 THEN $(
FAULT('M')
RETURN
$)
IF (A&T.REDEF)=0 THEN $(
UNLESS (A&T.PASS2SET)=0 THEN $(
FAULT('M')
RETURN
$)
UNLESS (TYPE=!(NAMEP!T))&(VALUE=1!(NAMEP!T)) THEN FAULT('P')
!(NAMEP!T):=TYPE LOGOR T.PASS2SET
RETURN
$)
IF (TYPE&T.REDEF)=0 THEN $(
FAULT('L')
RETURN
$)
!(NAMEP!T):=TYPE LOGOR T.PASS2SET
1!(NAMEP!T):=VALUE
$)
$)
AND READITEM(AP,ATYPE,AVAL) = VALOF $(
LET P=!AP
AND K=0
AND T,L=0,0
AND SIGN=1
AND NOTF = 0 // COPE WITH ~ FOR 'NOT'
IF !P='~' THEN
$( NOTF := -1 // ALL 1S ON 2S COMPLEMENT MC
P := P+1
$)
IF !P='-' THEN SIGN:=-1
IF (!P='+') LOGOR (!P='-') THEN P:=P+1
IF !P='~' THEN
$( NOTF := -1 // ALL 1S ON 2S COMPLEMENT MC
P := P+1
$)
IF LETTER(!P) THEN $(
T:=GETNAME(@P)
IF (T=-1) LOGOR (NAMEP!T=0) THEN $(
FAULT('U');!AP:=P
RESULTIS FALSE
$)
IF PASS=2 THEN $(
LET A=!(NAMEP!T)
IF CROSSREF THEN ADDREF(NAMEP!T,3,!CNT)
IF ((A&T.REDEF) NE 0)&((A&T.PASS2SET)=0) THEN $(
FAULT('U'); !AP:=P
RESULTIS FALSE
$)
IF (A&T.PASS2SET)=0 THEN ITEMSET:=FALSE
$)
!ATYPE:=!(NAMEP!T)ﰀ
SWITCHON !ATYPE INTO $(
CASE T.ABS:
CASE T.REL:
!AVAL := (SIGN*(1!(NAMEP!T))) NEQV NOTF
ENDCASE
CASE T.COMMON:
!ATYPE:=!(NAMEP!T)
!AVAL:=0
ENDCASE
CASE T.COMMONTAG:
!ATYPE:=T.COMMON+(!(NAMEP!T)Ͽ)
!AVAL := (SIGN*(1!(NAMEP!T))) NEQV NOTF
ENDCASE
CASE T.EXT:
!ATYPE:=!(NAMEP!T)
!AVAL:=0
ENDCASE
DEFAULT:
FAULT('P'); !AP:=P
RESULTIS FALSE
$)
!AP:=P; RESULTIS TRUE
$)
IF '0'<=!P<='9' THEN $(
!AVAL:=0
$(
IF !AVAL>32767 THEN FAULT('C')
!AVAL:=!AVAL*10+!P-'0'
P:=P+1
$) REPEATWHILE '0'<=!P<='9'
!ATYPE:=T.ABS
!AVAL := (SIGN*(!AVAL翿)) NEQV NOTF
!AP:=P
RESULTIS TRUE
$)
P:=P+1; SWITCHON !(P-1) INTO $(
CASE '$':
TEST !P='$' THEN $(
P:=P+1; !AVAL:=0
!ATYPE:=T.ABS
$)
ELSE $(
!AVAL := (SIGN*!CNT) NEQV NOTF
!ATYPE:=(CNT=ABSC)->T.ABS,T.REL
$)
!AP:=P; RESULTIS TRUE
CASE '#':
IF !P='T' THEN $(
P:=P+1
!AVAL:=BINDIGIT(!P) ; P:=P+1
IF !AVAL<0 THEN $(
FAULT('C')
!AP:=P
RESULTIS FALSE
$)
K:=0
$(
K:=K+1
L:=BINDIGIT(!P)
IF L<0 THEN BREAK
P:=P+1
!AVAL:=(!AVAL<<1)+L
$) REPEAT
IF K>16 THEN $(
FAULT('C');!AP:=P
RESULTIS FALSE
$)
!ATYPE:=T.ABS ;!AP:=P
!AVAL := (SIGN*!AVAL) NEQV NOTF
RESULTIS TRUE
$)
IF !P='Q' THEN $(
P:=P+1
!AVAL:=OCTDIGIT(!P); P:=P+1
IF !AVAL <0 THEN $(
FAULT('C') ; !AP:=P
RESULTIS FALSE
$)
K:=0
$(
K:=K+1
L:=OCTDIGIT(!P)
IF L<0 THEN BREAK
P:=P+1
!AVAL:=(!AVAL<<3)+L
$) REPEAT
IF K>6 THEN $(
FAULT('C'); !AP:=P
RESULTIS FALSE
$)
!ATYPE:=T.ABS
!AVAL := (SIGN*!AVAL) NEQV NOTF
!AP:=P
RESULTIS TRUE
$)
!AVAL:=HEXDIGIT(!P); P:=P+1
IF !AVAL<0 THEN $(
FAULT('C'); !AP:=P
RESULTIS FALSE
$)
K:=0
$(
K:=K+1
L:=HEXDIGIT(!P)
IF L<0 BREAK
P:=P+1
!AVAL:=(!AVAL<<4)+L
$) REPEAT
IF K>4 THEN $(
FAULT('C'); !AP:=P
RESULTIS FALSE
$)
!ATYPE:=T.ABS
!AVAL := (SIGN*!AVAL) NEQV NOTF
!AP:=P
RESULTIS TRUE
CASE '"':
!AVAL:=#X0020; !ATYPE:=T.ABS
IF GETSYM(@P) DO $(
!AVAL:=ASKII(!P)
P:=P+1
IF !P ~= '"' DO $(
FAULT('A'); !AP:=P+1; RESULTIS FALSE
$)
P:=P+1
$)
!AVAL:=(SIGN*!AVAL) NEQV NOTF; !AP:=P; RESULTIS TRUE
CASE '@':
UNLESS CAN(!P) LOGOR (!P=' ') THEN $(
FAULT('C'); !AP:=P
RESULTIS FALSE
$)
!AVAL:=CANVALUE(!P); P:=P+1
FOR K=1 TO 2 DO $(
L:=CANVALUE(!P)
TEST L<0 THEN !AVAL:=!AVAL*40
ELSE $(
P:=P+1; !AVAL:=!AVAL*40+L
$)
$)
!ATYPE:=T.ABS
!AVAL := (SIGN*!AVAL) NEQV NOTF
!AP:=P
RESULTIS TRUE
DEFAULT:
FAULT('S'); !AP:=P
RESULTIS FALSE
$)
$)
AND GETSYM(A)=VALOF $(
LET B=!A
IF !B='"' THEN $(
B:=B+1; !A:=B
UNLESS !B='"' THEN RESULTIS FALSE
$)
IF !B='*N' THEN $(
FAULT('S'); RESULTIS FALSE
$)
RESULTIS TRUE
$)
AND READFIELD(N,AP) = VALOF $(
LET F,V=1,0
READEXPR(AP)
IF EXPR.TYPE=-1 THEN RETURN
UNLESS EXPR.TYPE=T.ABS DO $(
FAULT('F'); RESULTIS 0
$)
FOR I=1 TO N DO F:=2*F
F:=F-1
V:=EXPR.VALUE&F
UNLESS EXPR.VALUE=V FAULT('T')
RESULTIS V
$)
AND TWOSCOMP(N) = VALOF $(
IF N<0 RESULTIS #X10000+N
RESULTIS N
$)
AND BINDIGIT(N) = VALOF $(
IF '0' <= N <= '1' THEN RESULTIS N-'0'
RESULTIS -1
$)
AND OCTDIGIT(N) = VALOF $(
IF '0' <= N <= '7' THEN RESULTIS N-'0'
RESULTIS -1
$)
AND UNPACKBITS(WORD,VECTOR) BE $(
FOR I=0 TO 15 DO VECTOR!I:=(WORD>>I)&1
$)
AND DFC(DIR) BE $(
LET ARGCNT=0
IF ARG=0 THEN $(
FAULT('S')
RETURN
$)
$(
TEST !ARG='"' THEN $(
ARG:=ARG+1
$(
P.CODEV!ARGCNT:=0
P.CODET!ARGCNT:=T.ABS
UNLESS GETSYM(@ARG) THEN BREAK
P.CODEV!ARGCNT:=ASKII(!ARG)
ARG:=ARG+1
ARGCNT:=ARGCNT+1
$) REPEAT
$) ELSE $(
TEST !ARG=',' THEN $(
EXPR.TYPE,EXPR.VALUE:=T.ABS,0
$)
ELSE $(
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN $(
EXPR.VALUE:=0
UNTIL TERM(!ARG) DO ARG:=ARG+1
$)
$)
TEST DIR=D.DB THEN $(
P.CODET!ARGCNT:=EXPR.TYPE
P.CODEV!ARGCNT:=EXPR.VALUE
UNLESS (EXPR.VALUE & #XFF00)=0 LOGOR
(EXPR.VALUE & #XFF00)=#XFF00 THEN FAULT('S')
ARGCNT:=ARGCNT+1
$)
ELSE $(
IF EXPR.TYPE=T.ABS
THEN EXPR.VALUE:=(EXPR.VALUE<<8＀)|(EXPR.VALUE>>8ÿ)
P.CODET!ARGCNT:=EXPR.TYPE
P.CODEV!ARGCNT:=(EXPR.VALUE>>8)ÿ
ARGCNT:=ARGCNT+1
P.CODET!ARGCNT:=EXPR.TYPE
P.CODEV!ARGCNT:=EXPR.VALUE & #XFF
ARGCNT:=ARGCNT+1
$)
$)
UNLESS !ARG=',' THEN BREAK
ARG:=ARG+1
$) REPEAT
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
P.CODEN:=ARGCNT-1
P.LOCF,P.LOC:=TRUE,!CNT
FOR I=0 TO P.CODEN DO DUMP(P.CODET!I,P.CODEV!I,P.LOC+I)
!CNT:=!CNT+ARGCNT
$)
AND PRINTLINE() BE $(
//
// P.LOCF -> IS LOCN COUNTER TO BE PRINTED (DEFAULT - FALSE)
// P.LOC -> LOCN COUNTER
// P.CODET -> CODE TYPE
// P.CODEV -> CODE VALUE
// P.CODEN -> NO. OF WORDS OF CODE - 1
//
// LISTINGCONTROL < 0 ---> SUPPRESS PRINTING FOR THIS LINE ONLY
// " = 0 ---> (L.NO) PRINTING SUPPRESSED COMPLETELY
// " = 1 ---> (L.ALL) PRINT ALL (DEFAULT)
// " = 2 ---> (L.SHORT) SUPPRESS 'CODE OVERFLOW' PR
//
//<3032
UNLESS macexp THEN
/*3032>*/
lineno := lineno + 1
IF (FNO=0)&(LISTINGCONTROL<=0) THEN $(
LISTINGCONTROL:=-LISTINGCONTROL; RETURN
$)
INCRLINES()
//<3032
TEST macexp THEN spaces(5)
ELSE
/*3032>*/
$(
TEST NUMBERED THEN $(
WRCH(' ')
//CII IF NUMBERCHARS!7='0' THEN $(
//CII NUMBERCHARS!7:=' '
//CII IF NUMBERCHARS!6='0' THEN $(
//CII NUMBERCHARS!6:=' '
//CII IF NUMBERCHARS!5 ='0' THEN NUMBERCHARS!5:=' '
//CII $)
//CII $)
FOR I=0 TO 5 DO $(
TEST NUMBERCHARS!I='0' THEN NUMBERCHARS!I:=' '
ELSE BREAK
$)
//CII WRCH('.')
FOR N=5 TO 7 DO WRCH(NUMBERCHARS!N)
WRCH(' ')
$)
ELSE WRITEF(" %I4",LINENO-1)
$)
WRCH(' ')
FOR N=0 TO 2 DO WRCH(FSYM!N)
WRCH(' ')
TEST P.LOCF THEN $(
WRITEHEX(P.LOC,4)
P.LOC:=P.LOC+1
$)
ELSE WRITES(" ")
WRCH(' ')
WRCH(SYMTYPE(P.CODET!0))
WRCH(' ')
INTYPE:=(!(NAMEP!GLOBT)>>11)&1
INNUM:= !(NAMEP!GLOBT)ÿ
TEST INTYPE=0 THEN $( // NOT A PSEUDO OP OR DELCARARTIPN
LET MAXBYTES=P.CODEN>8->8,P.CODEN
FOR I=0 TO MAXBYTES DO WRITEHEX(TWOSCOMP(P.CODEV!I),2)
FOR I=0 TO (8-MAXBYTES) DO WRITES(" ")
P.LOC := P.LOC + MAXBYTES
P.CODEN:=P.CODEN-MAXBYTES
$)
ELSE $(
TEST INTYPE=0 THEN INSIZE:=0
ELSE TEST INNUM=#X26 THEN INSIZE:=0
ELSE INSIZE:=1
// INSIZE IS 0 FOR INSTRUCTIONS AND AND PSEUDO OP DB
// ALL OTHER PSEUDO OPS ARE 1
TEST P.CODEN>=0 THEN $(
TEST INNUM=#X27 THEN $( WRITEHEX(TWOSCOMP(P.CODEV!0),2)
WRITEHEX(TWOSCOMP(P.CODEV!1),2)
$)
ELSE $(
WRITEHEX(TWOSCOMP(P.CODEV!0),INSIZE*2+2)
IF INSIZE=0 THEN WRITES(" ")
$)
$)
ELSE WRITES(" ")
WRITES(" ")
P.LOC:=P.LOC+INSIZE
$)
WRITES(" ")
$(
FOR N=0 TO 71 DO $(
IF LINE!N='*N' THEN BREAK
WRCH(LINE!N)
$)
$)
WRCH('*N')
IF LISTINGCONTROL=L.ALL THEN $(
LET N=1+INSIZE
UNTIL N > P.CODEN DO $(
INCRLINES()
SPACES(10)
WRITEHEX(P.LOC,4)
P.LOC:=P.LOC+(INSIZE+1)
WRCH(' ')
WRCH(SYMTYPE(P.CODET!N))
WRCH(' ')
FOR I=0 TO INSIZE DO WRITEHEX(TWOSCOMP(P.CODEV!(I+N)),2)
WRCH('*N')
N:=N+1+INSIZE
$)
$)
INITLISTCONTROL()
$)
AND INITLISTCONTROL() BE $(
P.LOCF:=FALSE
FOR N=0 TO 2 DO FSYM!N:=' '
FNO:=0
P.CODEN:=-1
P.CODET!0:=T.NULL
$)
AND MNEWLINES(N) BE $(
UNLESS LISTINGCONTROL=L.NO THEN $(
FOR J=1 TO N DO $(
WRITES(" *N"); INCRLINES()
$)
$)
$)
AND MNEWPAGE() BE $(
UNLESS LISTINGCONTROL=L.NO THEN $(
PAGE:=PAGE+1
WRITEF("*P BCPL 8086 ASSEMBLER VERSION %N",VERSIONNUMBER)
WRITEF(" DATE %S PAGE %N*N",DATE(),PAGE)
WRITEF(" %S --- SECTION %S",TTL,PGM)
WRITES(" *N *N *N")
LINES:=4
$)
$)
.