SECTION"PS1"
// THIS FILE SHOULD BECOME THE INSERT FILE "AHDR"
GET "AHDR"
STATIC $(
INSRETURN=0; J=0; T=0; A=0; DIR=0; TYPE=0
$)
LET PASS1() BE $(
REC.P:=LEVEL()
REC.L:=REC.PLAB
$(
J:=READLINE() REPEATUNTIL J&(!LINE NE '**')
IF OP=0 DO $(
SETLABEL(LAB)
LOOP
$)
T:=GETOPN(@OP)
IF (T<0) LOGOR (NAMEP!T=0) THEN LOOP
IF (CNT=RELC)&(!CNT>TOPRELCNT) THEN TOPRELCNT:=!CNT
IF (CNT=ABSC)&(!CNT>TOPABSCNT) THEN TOPABSCNT:=!CNT
TYPE:=(!(NAMEP!T))ﰀ
SWITCHON TYPE INTO $(
CASE T.DIR:
DIR:=(!(NAMEP!T))Ͽ
SWITCHON DIR INTO $(
CASE D.ABS:
CNT:=ABSC; ENDCASE
CASE D.REL:
CNT:=RELC; ENDCASE
CASE D.ORG:
IF ARG=0 LOOP
READEXPR(@ARG)
UNLESS (EXPR.TYPE=T.ABS) LOGOR (EXPR.TYPE=T.REL) DO LOOP
!CNT:=EXPR.VALUE
SETLABEL(LAB)
IF (CNT=RELC)&(!CNT+1>TOPRELCNT) THEN TOPRELCNT:=!CNT+1
IF (CNT=ABSC)&(!CNT+1>TOPABSCNT) THEN TOPABSCNT:=!CNT+1
ENDCASE
CASE D.RES:
SETLABEL(LAB)
IF ARG=0 DO LOOP
READEXPR(@ARG)
UNLESS EXPR.TYPE=T.ABS LOOP
!CNT:=!CNT+EXPR.VALUE
IF !ARG=',' THEN ENDCASE
IF (CNT=RELC)&(!CNT+1>TOPRELCNT) THEN TOPRELCNT:=!CNT+1
IF (CNT=ABSC)&(!CNT+1>TOPRELCNT) THEN TOPABSCNT:=!CNT+1
ENDCASE
CASE D.EVEN:
CASE D.DSEG:
!CNT:=!CNT+ ((!CNT&1)=1->1,0)
ENDCASE
CASE D.EQU:
CASE D.SET:
IF LAB=0 LOOP
IF ARG=0 LOOP
READEXPR(@ARG)
UNLESS (EXPR.TYPE=T.ABS) LOGOR (EXPR.TYPE=T.REL) LOOP
SETSYMBOL(LAB,EXPR.TYPE+((DIR=D.EQU)->0,T.REDEF),EXPR.VALUE)
ENDCASE
//<3032
CASE D.INT:
IF ARG=0 LOOP
$(
T:=GETNAME(@ARG); IF T<0 THEN ENDCASE
INTERNALS:=LIST(2,INTERNALS,T)
UNLESS !ARG=',' BREAK
ARG:=ARG+1
$) REPEAT
ENDCASE
CASE D.EXT:
IF ARG=0 LOOP
$(
UNLESS LETTER(!ARG) BREAK
T:=GETNAME(@ARG); IF T<0 THEN ENDCASE
IF NAMEP!T=0 THEN $(
TEST CROSSREF THEN NAMEP!T:=LIST(4,T.EXT+EXTNUM,0,0,0)
ELSE NAMEP!T:=LIST(1,T.EXT+EXTNUM)
EXTNUM:=EXTNUM+1
EXTERNALS:=LIST(2,EXTERNALS,T)
$)
IF CROSSREF THEN ADDREF(NAMEP!T,2,!CNT)
UNLESS !ARG=',' BREAK
ARG:=ARG+1
$) REPEAT
ENDCASE
/*3032>*/
CASE D.PGM:
IF ARG=0 LOOP
UNLESS !PROG.NAME=0 THEN LOOP
J:=0
$(
J:=J+1; PROG.NAME!J:=!ARG
ARG:=ARG+1
$) REPEATWHILE CAN(!ARG)
!PROG.NAME:=J
FOR I=J+1 TO 6 DO PROG.NAME!I:=' '
PACKSTRING(PROG.NAME,PGM)
ENDCASE
//<3032
CASE D.COMMON:
IF ARG=0 LOOP
READEXPR(@ARG)
UNLESS EXPR.TYPE=T.ABS LOOP
UNLESS LAB=0 THEN $(
T:=GETNAME(@LAB); IF T<0 THEN ENDCASE
COMMONS:=LIST(2,COMMONS,T)
TEST CROSSREF THEN $(
NAMEP!T:=LIST(4,T.COMMON+COMMNUM,EXPR.VALUE,0,0)
ADDREF(NAMEP!T,2,!CNT)
$)
ELSE NAMEP!T:=LIST(2,T.COMMON+COMMNUM,EXPR.VALUE)
COMMNUM:=COMMNUM+1
$)
ENDCASE
/*3032>*/
CASE D.CEQ:
IF (LAB=0) LOGOR (ARG=0) LOOP
READEXPR(@ARG)
UNLESS ((EXPR.TYPEﰀ)=T.COMMON) LOGOR (EXPR.TYPE=T.ABS)
LOOP
T:=GETNAME(@LAB); IF T<0 THEN ENDCASE
TEST CROSSREF THEN $(
NAMEP!T:=LIST(4,T.COMMONTAG+(EXPR.TYPEϿ),EXPR.VALUE,
0,0)
ADDREF(NAMEP!T,2,!CNT)
$)
ELSE NAMEP!T:=LIST(2,T.COMMONTAG+(EXPR.TYPEϿ),
EXPR.VALUE)
ENDCASE
CASE D.INC:
$(
$(
READLINE() REPEATWHILE (OP=0) LOGOR (!LINE='**')
J:=OP
T:=GETOPN(@J); IF T<0 THEN ENDCASE
$) REPEATWHILE NAMEP!T=0
A:=!(NAMEP!T)
$) REPEATUNTIL (A=(T.DIR+D.ORG)) LOGOR (A=(T.DIR+D.END))
PENDINGLINE:=TRUE
ENDCASE
CASE D.DFF:
IF (LAB=0) LOGOR (ARG=0) LOOP
IF !ARG='←' DO $(
LET V=VEC 7
AND I=0
$(
IF (!ARG='*N') LOGOR (!ARG=' ') DO BREAK
ARG:=ARG+1
READEXPR(@ARG)
UNLESS EXPR.TYPE=T.ABS BREAK
V!I:=EXPR.VALUE; I:=I+1
$) REPEATWHILE !ARG='←'
T:=GETOPN(@LAB); IF T<0 THEN ENDCASE
NAMEP!T:=LIST(I,!V,V!1,V!2,V!3,V!4,V!5,V!6,V!7)
$( LET N = NAMEP!T
$)
ENDCASE
$)
$(
LET P1,P2=0,0
AND C=0
$(
READEXPR(@ARG)
UNLESS EXPR.TYPE=T.ABS BREAK
C:=C+EXPR.VALUE; IF C>16 BREAK
P1:=(P1<<EXPR.VALUE)+(1<<(EXPR.VALUE-1))
P2:=(P2<<EXPR.VALUE)+1
UNLESS !ARG=',' THEN BREAK
ARG:=ARG+1
$) REPEAT
T:=GETOPN(@LAB); IF T<0 THEN ENDCASE
NAMEP!T:=LIST(3,T.DFF,P1,P2)
$)
ENDCASE
CASE D.DB:
CASE D.DW:
// CASE D.DFC:
$(
LET N=(DIR=D.DB->1,2)
SETLABEL(LAB)
IF ARG=0 THEN $(
!CNT:=!CNT+N; ENDCASE
$)
$(
TEST !ARG='"' THEN $(
A:=ARG
$(
ARG:=ARG+1 REPEATUNTIL (!ARG='"')LOGOR(!ARG='*N')
IF !ARG='*N' THEN BREAK
ARG:=ARG+1
A:=A+1
$) REPEATWHILE (!ARG='"')&(!(ARG-1)='"')
!CNT:=!CNT+ARG-A -1
$)
ELSE $(
UNLESS !ARG=',' THEN READEXPR(@ARG)
!CNT:=!CNT+N
$)
UNLESS !ARG=',' THEN BREAK
ARG:=ARG+1
$) REPEAT
$)
ENDCASE
//<3032
CASE D.MAC:
CASE D.MAD:
MACRO1(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)
ENDCASE
/*3032>*/
CASE D.END:
SETLABEL(LAB)
LONGJUMP(ENDREC.P,ENDREC.L)
//<3032
CASE D.HOP:
CASE D.ZRR:
SETLABEL(LAB)
!CNT:=!CNT+1
ENDCASE
/*3032>*/
CASE D.TTL:
IF !TTL NE 0 THEN ENDCASE
J:=OP-1
UNTIL !OP='*N' THEN OP:=OP+1
!J:=OP-J-1
J:=PACKSTRING(J,TTL)
ENDCASE
//<3032
CASE D.INS:
UNLESS LETTER(!ARG) DO ENDCASE
J:=ARG-1
ARG:=ARG+1 REPEATWHILE LETTER(!ARG) LOGOR ('0'<=!ARG<='9')
UNLESS (!ARG=' ') LOGOR (!ARG='*N') DO ENDCASE
!J:=ARG-J-1
IF !J>7 DO ENDCASE
$(
LET S=VEC 2
PACKSTRING(J,S)
J:=FINDINPUT(S)
$)
IF J=0 ENDCASE
$(
LET KA,KB,KC=INPUT(),REC.P,REC.L
SELECTINPUT(J)
PASS1() // CALL TO PASS1 RESETS REC.P,REC.L ON ENTRY
ENDREAD(); SELECTINPUT(KA)
REC.P,REC.L:=KB,KC
$)
ENDCASE
CASE D.SCW:
SCW:=TRUE; ENDCASE
/*3032>*/
CASE D.EJT:
CASE D.SPC:
CASE D.LST:
CASE D.NOL:
CASE D.GCW:
CASE D.EMP:
ENDCASE
$)
ENDCASE
//<3032
CASE T.MACRO:
EXPAND(!(NAMEP!T)Ͽ,T)
ENDCASE
/*3032>*/
CASE T.OPCODE:
OPCODE(T)
ENDCASE
CASE T.DFF:
SETLABEL(LAB)
!CNT:=!CNT+1
ENDCASE
DEFAULT:
$)
$) REPEAT
REC.PLAB:
$)
.