SECTION"PS2"
GET "AHDR"
STATIC $(
J=0; T=0; A=0; F=0; DIR=0
$)
LET PASS2() BE $(
INITLISTCONTROL()
// START LOOP FOR OBJECT CODE
$(
UNTIL READLINE() DO PRINTLINE()
IF !LINE='**' DO $(
PRINTLINE(); LOOP
$)
IF OP=0 DO $(
UNLESS LAB=0 DO $(
P.LOCF,P.LOC:=TRUE,!CNT
SETLABEL(LAB)
$)
PRINTLINE()
LOOP
$)
T:=GETOPN(@OP)
GLOBT:=T
IF (T<0) LOGOR (NAMEP!T=0) DO $(
FAULT('O')
SETLABEL(LAB)
P.LOCF,P.LOC:=TRUE,!CNT
PRINTLINE()
LOOP
$)
SWITCHON (!(NAMEP!T))ﰀ INTO $(
CASE T.OPCODE:
OPCODE(T); ENDCASE
CASE T.DFF:
DFF(T); ENDCASE
//<3032
CASE T.MACRO:
EXPAND(!(NAMEP!T)Ͽ,T)
LOOP
/*3032>*/
CASE T.DIR:
DIR:=(!(NAMEP!T))Ͽ
SWITCHON DIR INTO $(
CASE D.REL:
IF SCW THEN FAULT('W')
CASE D.ABS:
TEST DIR=D.ABS THEN $(
CNT:=ABSC
DUMP(T.DIR+D.ORG,T.ABS,!CNT)
$)
ELSE $(
CNT:=RELC
DUMP(T.DIR+D.ORG,T.REL,!CNT)
$)
P.LOCF:=FALSE
P.CODEN:=0
!P.CODET:=(DIR=D.ABS)->T.ABS,T.REL
!P.CODEV:=!CNT
ENDCASE
CASE D.ORG:
P.LOCF:=FALSE
P.CODEN:=0
IF ARG=0 THEN $(
FAULT('A'); ENDCASE
$)
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS (EXPR.TYPE=T.ABS) LOGOR (EXPR.TYPE=T.REL) THEN $(
FAULT('E'); ENDCASE
$)
P.CODEN:=0
!CNT:=EXPR.VALUE
SETLABEL(LAB)
DUMP(T.DIR+D.ORG,EXPR.TYPE,EXPR.VALUE)
!P.CODET:=EXPR.TYPE
!P.CODEV:=!CNT
ENDCASE
CASE D.RES:
P.LOCF,P.LOC:=TRUE,!CNT
IF SCW THEN FAULT('W')
SETLABEL(LAB)
IF ARG=0 DO $(
FAULT('S'); ENDCASE
$)
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS EXPR.TYPE=T.ABS THEN $(
FAULT('E'); ENDCASE
$)
!CNT:=!CNT+EXPR.VALUE
IF (!ARG=' ') LOGOR (!ARG='*N') THEN $(
UNLESS EXPR.VALUE=0 DUMP(T.DIR+D.ORG,
(CNT=ABSC->T.ABS,T.REL),!CNT)
ENDCASE
$)
UNLESS !ARG=',' THEN $(
FAULT('S'); ENDCASE
$)
ARG:=ARG+1
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS EXPR.TYPE=T.ABS DO $(
FAULT('E'); ENDCASE
$)
DUMP(T.DIR+D.RES,!CNT-P.LOC,EXPR.VALUE)
!P.CODET:=T.ABS
!P.CODEV:=EXPR.VALUE
P.CODEN:=0
ENDCASE
CASE D.EVEN:
CASE D.DSEG:
IF (!CNT&1)=1 THEN DUMP(T.ABS,#X90,!CNT)
!CNT:=!CNT+((!CNT&1)=1->1,0)
DUMP(T.DIR+D.EVEN,!CNT-P.LOC,T.REL)
IF DIR=D.DSEG DO DUMP(T.DIR+D.DSEG)
ENDCASE
CASE D.SET:
CASE D.EQU:
IF (LAB=0) LOGOR (ARG=0) THEN $( FAULT('S'); ENDCASE $)
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS (EXPR.TYPE=T.ABS) LOGOR (EXPR.TYPE=T.REL) DO $(
FAULT('E'); ENDCASE
$)
SETSYMBOL(LAB,EXPR.TYPE+((DIR=D.EQU)->0,T.REDEF),EXPR.VALUE)
P.LOCF:=FALSE
P.CODEN:=0
!P.CODEV:=EXPR.VALUE
!P.CODET:=EXPR.TYPE
ENDCASE
//<3032
CASE D.INT:
IF SCW THEN FAULT('W')
IF ARG=0 THEN $(
FAULT('S'); ENDCASE
$)
$(
GETNAME(@ARG)
UNLESS !ARG=',' BREAK
ARG:=ARG+1
$) REPEAT
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
ENDCASE
CASE D.EXT:
IF SCW THEN FAULT('W')
IF ARG=0 THEN $(
FAULT('S'); ENDCASE
$)
$(
UNLESS LETTER(!ARG) DO $(
FAULT('S'); ENDCASE
$)
T:=GETNAME(@ARG)
UNLESS (!(NAMEP!T)ﰀ)=T.EXT THEN $(
FAULT('E'); ENDCASE
$)
UNLESS !ARG=',' BREAK
ARG:=ARG+1
$) REPEAT
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
ENDCASE
/*3032>*/
CASE D.PGM:
IF SCW THEN FAULT('W')
IF ARG=0 THEN $(
FAULT('S'); ENDCASE
$)
FOR I=1 TO !PROG.NAME DO $(
UNLESS !ARG=I!PROG.NAME DO $(
FAULT('S'); ENDCASE
$)
ARG:=ARG+1
$)
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
ENDCASE
//<3032
CASE D.COMMON:
IF ARG=0 THEN $(
FAULT('S'); ENDCASE
$)
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS EXPR.TYPE=T.ABS THEN $(
FAULT('E'); ENDCASE
$)
UNLESS LAB=0 THEN $(
T:=GETNAME(@LAB)
UNLESS (!(NAMEP!T)ﰀ)=T.COMMON THEN $(
FAULT('P'); ENDCASE
$)
$)
ENDCASE
CASE D.CEQ:
IF (LAB=0) LOGOR (ARG=0) THEN $(
FAULT('S'); ENDCASE
$)
T:=GETNAME(@LAB)
READEXPR(@ARG)
IF EXPR.TYPE=-1 ENDCASE
UNLESS ((EXPR.TYPEﰀ)=T.COMMON) LOGOR (EXPR.TYPE=T.ABS)
$(
FAULT('A'); ENDCASE
$)
UNLESS ((EXPR.TYPEϿ)=(!(NAMEP!T)Ͽ)) &
(EXPR.VALUE=1!(NAMEP!T)) THEN $(
FAULT('P'); ENDCASE
$)
ENDCASE
/*3032>*/
CASE D.INC:
INC(); ENDCASE
CASE D.DFF:
IF (LAB=0) LOGOR (ARG=0) THEN $(
FAULT('S'); ENDCASE
$)
IF !ARG='←' THEN $(
LET V=VEC 7
AND I=0
WHILE !ARG='←' THEN $(
ARG:=ARG+1
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS EXPR.TYPE=T.ABS THEN $(
FAULT('E'); ENDCASE
$)
V!I:=EXPR.VALUE; I:=I+1
$)
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
T:=GETOPN(@LAB); IF T<0 ENDCASE
FOR J=0 TO I-1 DO
UNLESS V!J=J!(NAMEP!T) THEN $(
FAULT('P'); ENDCASE
$)
ENDCASE
$)
$(
LET P1,P2=0,0
AND C=0
$(
READEXPR(@ARG)
IF EXPR.TYPE=-1 THEN ENDCASE
UNLESS EXPR.TYPE=T.ABS THEN $(
FAULT('F'); ENDCASE
$)
C:=C+EXPR.VALUE
IF C>16 THEN $(
FAULT('F'); ENDCASE
$)
P1:=(P1<<EXPR.VALUE)+(1<<(EXPR.VALUE-1))
P2:=(P2<<EXPR.VALUE)+1
UNLESS !ARG=',' THEN BREAK
ARG:=ARG+1
$) REPEAT
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN $(
T:=GETOPN(@LAB); IF T<0 ENDCASE
UNLESS (1!(NAMEP!T)=P1)&(2!(NAMEP!T)=P2) THEN
FAULT('P')
$)
ENDCASE
$)
CASE D.DB:
CASE D.DW:
// CASE D.DFC:
SETLABEL(LAB)
DFC(DIR)
ENDCASE
//<3032
CASE D.MAC:
CASE D.MAD:
MACRO(DIR)
ENDCASE
CASE D.IF:
CASE D.IFN:
CASE D.IFA:
CASE D.IFR:
CASE D.IFP:
CASE D.IFM:
CASE D.GTO:
CASE D.GTC:
CASE D.EXM:
CASE D.AOP:
CONDASS(DIR)
UNLESS PENDINGLINE LISTINGCONTROL:=-LISTINGCONTROL
ENDCASE
CASE D.EMP:
FAULT('S'); ENDCASE
/*3032>*/
CASE D.END:
P.LOCF,P.LOC:=TRUE,!CNT
TEST ARG=0 THEN DUMP(T.DIR+D.END,0)
ELSE $(
READEXPR(@ARG)
UNLESS (EXPR.TYPE=T.ABS) LOGOR (EXPR.TYPE=T.REL) THEN $(
UNLESS EXPR.TYPE=-1 THEN FAULT('E')
$)
P.CODEN:=0
P.CODEV!0:=EXPR.VALUE
P.CODET!0:=EXPR.TYPE
DUMP(T.DIR+D.END,1,EXPR.TYPE,EXPR.VALUE)
$)
PRINTLINE()
LONGJUMP(ENDREC.P,ENDREC.L)
//<3032
CASE D.HOP:
CASE D.ZRR:
SETLABEL(LAB)
P.CODEN:=0
P.LOCF,P.LOC:=TRUE,!CNT
UNLESS !OP=',' THEN FAULT('S')
OP:=OP+1
TEST DIR=D.ZRR THEN $(
!P.CODEV:=READFIELD(4,@OP)
!P.CODEV:=#X6C00+(!P.CODEV<<4)+!P.CODEV
$)
ELSE $(
!P.CODEV:=READEXPR(@OP)-P.LOC
UNLESS 0<=!P.CODEV<=15 THEN FAULT('F')
!P.CODEV:=#XF700+!P.CODEV
$)
!CNT:=!CNT+1
DUMP(T.ABS,!P.CODEV)
ENDCASE
/*3032>*/
CASE D.SPC:
TEST ARG=0 THEN MNEWLINES(1)
ELSE $(
READEXPR(@ARG)
UNLESS EXPR.TYPE=T.ABS THEN ENDCASE
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN $(
FAULT('S'); ENDCASE
$)
MNEWLINES(EXPR.VALUE)
$)
LISTINGCONTROL:=-LISTINGCONTROL
ENDCASE
CASE D.TTL:
J:=OP-1
UNTIL !OP='*N' THEN OP:=OP+1
!J:=OP-J-1
J:=PACKSTRING(J,TTL)
CASE D.EJT:
MNEWPAGE()
LISTINGCONTROL:=-LISTINGCONTROL
ENDCASE
CASE D.LST:
PRINTLINE(); INITLISTCONTROL()
TEST ARG=0 THEN LISTINGCONTROL:=L.ALL
ELSE LISTINGCONTROL:=L.SHORT
LOOP
CASE D.NOL:
LISTINGCONTROL:=L.NO
ENDCASE
//<3032
CASE D.INS:
UNLESS LETTER(!ARG) THEN $(
FAULT('H'); ENDCASE
$)
J:=ARG-1
ARG:=ARG+1 REPEATWHILE LETTER(!ARG) LOGOR
('0'<=!ARG<='9')
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN $(
FAULT('H'); ENDCASE
$)
$(
LET C=!J
AND S=VEC 2
!J:=ARG-J-1
IF !J>7 THEN $(
!J:=C; FAULT('H'); ENDCASE
$)
PACKSTRING(J,S)
!J:=C
J:=FINDINPUT(S)
$)
IF J=0 DO $(
FAULT('H'); ENDCASE
$)
PRINTLINE()
$(
LET KA,KB,KC,KD=INPUT(),LINENO,REC.P,REC.L
SELECTINPUT(J); LINENO:=1
REC.P,REC.L:=LEVEL(),INS.RETURN
PASS2()
INS.RETURN:
ENDREAD(); SELECTINPUT(KA); LINENO:=KB
REC.P,REC.L:=KC,KD
$)
LOOP
CASE D.SCW:
UNLESS SCW THEN FAULT('P')
UNLESS (LAB=0)&(ARG=0) THEN FAULT('S')
ENDCASE
/*3032>*/
$)
ENDCASE
$)
UNLESS PENDINGLINE THEN PRINTLINE()
$) REPEAT
$)
.