SECTION"UT2"
GET "AHDR"
LET READLINE()= VALOF $(
LET CH,I,J=0,0,0
IF PENDINGLINE THEN $(
PENDINGLINE:=FALSE
RESULTIS TRUE
$)
$(
CH:=RSYM()
IF CH='*N' THEN $(
line!i := '*N'
//<3032
UNLESS macexp THEN
/*3032>*/
numbered := FALSE
BREAK
$)
IF I=72 THEN $(
LINE!72:='*N'
//<3032
IF MACEXP THEN $(
FAULT('B')
CH:=RSYM() REPEATUNTIL CH='*N'
BREAK
$)
/*3032>*/
IF PASS=1 THEN $(
J:=FALSE
$(
CH:=RSYM()
//$(
//LET A=OUTPUT()
//SELECTOUTPUT(ERRSTR)
//WRITEF(" CH='%C',NUMBERED=%S,J=%S*N",CH,NUMBERED->"T","F",J->"T","F")
//SELECTOUTPUT(A)
//$)
IF CH='*N' THEN BREAK
UNLESS CH=' ' THEN J:=TRUE
$) REPEAT
IF NUMBERED THEN NUMBERED:=J
BREAK
$)
IF NUMBERED THEN $(
LET I=0
$(
NUMBERCHARS!I:=CH
CH:=RSYM(); I:=I+1
$) REPEATUNTIL (CH='*N') LOGOR (I=8)
UNTIL I=8 DO $(
NUMBERCHARS!I:=' '; I:=I+1
$)
$)
UNTIL CH='*N' DO CH:=RSYM()
BREAK
$)
LINE!I:=CH; I:=I+1
$) REPEAT
//$(
//LET J=0
//WRITEF(" -%N-",PASS)
//WRCH(LINE!J)<>J:=J+1 REPEATWHILE LINE!(J-1) NE '*N'
//$)
I:=0; LAB,OP,ARG:=0,0,0
IF !LINE='**' THEN RESULTIS TRUE
UNTIL (LINE!I=' ') LOGOR (LINE!I='*N') THEN I:=I+1
UNLESS I=0 THEN $(
LAB:=LINE
//<3032
UNLESS macdef THEN
/*3032>*/
$(
UNLESS LETTER(!LINE) THEN $(
FAULT('L')
RESULTIS FALSE
$)
FOR N=0 TO I-1 DO
UNLESS CAN(LINE!N) THEN $(
FAULT('L')
RESULTIS FALSE
$)
$)
$)
WHILE LINE!I=' ' THEN I:=I+1
IF LINE!I='*N' THEN RESULTIS TRUE
UNLESS letter(line!i) THEN
//<3032
UNLESS macdef THEN
/*3032>*/
$(
FAULT('S')
RESULTIS FALSE
$)
OP:=LINE+I; J:=I
UNTIL (LINE!I=' ') LOGOR (LINE!I='*N') THEN I:=I+1
//<3032
UNLESS macdef THEN
/*3032>*/
$(
FOR N=J TO I-1 DO $(
UNLESS CAN(LINE!N) LOGOR (LINE!N='**') $(
FAULT('S')
RESULTIS FALSE
$)
IF TERM(LINE!(N+1)) THEN BREAK
$)
$)
J:=I
WHILE LINE!I=' ' THEN I:=I+1
IF LINE!I='*N' THEN RESULTIS TRUE
UNLESS I-J>=10 THEN ARG:=LINE+I
RESULTIS TRUE
$)
//NOT REALLY CAN - DOES NOT INCLUDE SPACE
AND CAN(SYM) = ('A'<=SYM<='I') LOGOR ('J'<=SYM<='R') LOGOR
('S'<=SYM<='Z') LOGOR ('0'<=SYM<='9') LOGOR
(SYM='$') LOGOR (SYM='.') LOGOR (SYM=':')
AND GETNAME(ATAG) = POINTER(ATAG,1)
AND GETOPN(ATAG) = POINTER(ATAG,-1)
AND POINTER(ATAG,INCR) = VALOF $(
LET DPP=DP
AND NAME=(INCR=1)->SNAME,ONAME
AND HASHV,REHASHV=0,0
AND ENTRY,R=0,0
AND TAG=!ATAG
WHILE CAN(!TAG) THEN $(
DP:=DP+1
PUTBYTE(0,DP,!TAG)
TAG:=TAG+1
$)
!ATAG:=TAG
// CHECK TO SEE IF TAG POINTS TO A VALID NAME
IF DP=DPP THEN RESULTIS -1
// CHECK FOR SYMBOL TABLE OVERFLOW
PUTBYTE(0,DPP,DP-DPP) // LENGTH
IF (PASS=1)&(dictmax-dp < 0) THEN $(
PROFIL:=1; DP:=DPP; RESULTIS -1
$)
DP:=DP+1
HASHV:=HASH(DPP)
REHASHV:=HASHV
R:=1
$(
IF NAME!REHASHV=-1 THEN $( // NEW ENTRY
IF dictmax-dp < 0 THEN $(
PROFIL:=1; DP:=DPP; FAULT('V'); RESULTIS -1
$)
NAME!REHASHV:=DPP // POINTER TO NAME
RESULTIS REHASHV+((INCR<0)->NAMESIZE,0)
$)
ENTRY:=VALOF $(
LET M=NAME!REHASHV
FOR J=0 TO GETBYTE(0,M) DO
UNLESS GETBYTE(0,DPP+J)=GETBYTE(0,M+J) THEN
RESULTIS FALSE
RESULTIS TRUE
$)
IF ENTRY THEN $( // FOUND
DP:=DPP
RESULTIS REHASHV+((INCR<0)->NAMESIZE,0)
$)
R:=R*5&((NAMESIZE<<2)-1)
REHASHV:=(HASHV+(R>>2))&(NAMESIZE-1)
COLLISIONS:=COLLISIONS+1
IF REHASHV=HASHV THEN $( // BACK TO WHERE WE START
WRITES(" **** SYMBOL TABLE FULL *****N ")
SELECTOUTPUT(ERRSTR)
WRITES(" **** SYMBOL TABLE FULL *****N ")
PROFIL:=1; PRINTPROFIL(); STOP(-1)
$)
$) REPEAT
$)
AND HASH(P) = VALOF $(
LET BC=0
AND LEN=GETBYTE(0,P)
FOR J=0 TO LEN BY 4 DO $(
LET M=LEN-J
AND LC=0
IF M>3 THEN M:=3
FOR K=J TO J+M DO
LC:=(LC<<2)+GETBYTE(0,P+K)
BC:=BC+LC
$)
RESULTIS BC&(NAMESIZE-1)
$)
AND READEXPR(AP) BE $(
LET VAL=0 // RUNNING TOTAL
AND CTYPE,CVAL=0,0 // CURRENT SYMBOL'S TYPE AND VALU
AND OPN=0
AND T=VEC 10
AND V=VEC 10 // USED FOR CALCULATING TYPE OF E
AND J=0
AND P=!AP
ITEMSET:=TRUE
FOR I= 0 TO 10 DO T!I,V!I:=0,0
J:=READITEM(@P,@CTYPE,@CVAL)
UNLESS J THEN $(
EXPR.TYPE:=-1
!AP:=P
RETURN
$)
UNLESS CTYPE=T.ABS THEN $(
!T:=CTYPE; !V:=1
$)
VAL:=CVAL
$(
OPN:=!P
IF TERM(OPN) LOGOR (OPN='←') LOGOR COMP(OPN) THEN $(
!AP:=P
EXPR.TYPE:=0
FOR I=0 TO 10 DO $(
IF V!I NE 0 THEN
TEST V!I=1 THEN $(
IF EXPR.TYPE NE 0 THEN $(
EXPR.TYPE:=-1; FAULT('E')
!AP:=P
RETURN
$)
EXPR.TYPE:=T!I
$) ELSE $(
EXPR.TYPE:=-1; FAULT('E')
RETURN
$)
$)
IF EXPR.TYPE=0 THEN EXPR.TYPE:=T.ABS
EXPR.VALUE:=VAL
RETURN
$)
P:=P+1
J:=READITEM(@P,@CTYPE,@CVAL)
UNLESS J THEN $(
EXPR.TYPE:=-1
!AP:=P
RETURN
$)
J:=0
UNLESS CTYPE=T.ABS THEN $(
UNTIL (T!J=CTYPE) LOGOR (T!J=0) THEN J:=J+1
T!J:=CTYPE
$)
SWITCHON OPN INTO $(
CASE '+': VAL:=VAL+CVAL
UNLESS CTYPE=T.ABS THEN V!J:=V!J+1
ENDCASE
CASE '-': VAL:=VAL-CVAL
UNLESS CTYPE=T.ABS THEN V!J:=V!J-1
ENDCASE
CASE '**':
CASE '/': J:= VALOF $(
FOR N=0 TO 10 DO
IF V!N NE 0 THEN RESULTIS FALSE
RESULTIS TRUE
$)
UNLESS J&(CTYPE=T.ABS) THEN $(
EXPR.TYPE:=-1; FAULT('E')
!AP:=P
RETURN
$)
TEST OPN='**' THEN VAL:=VAL*CVAL
ELSE $(
IF CVAL=0 THEN $(
EXPR.TYPE:=-1; FAULT('E')
!AP:=P
RETURN
$)
VAL:=VAL/CVAL
$)
ENDCASE
DEFAULT: EXPR.TYPE:=-1 // ILLEGAL OPERATOR
FAULT('E')
!AP:=P
RETURN
$)
$) REPEAT
$)
AND TERM(C) = ((C='*N') LOGOR (C=' ') LOGOR (C=',') LOGOR (C=0)|C='('|
C='[')
AND COMP(SYM) = ((SYM='<') LOGOR (SYM='=') LOGOR (SYM='>'))
AND LETTER(C) = (('A'<=C<='I') LOGOR ('J'<=C<='R') LOGOR ('S'<=C<='Z'))
AND HEXDIGIT(N) = VALOF $(
IF '0'<=N<='9' THEN RESULTIS N-'0'
IF 'A'<=N<='F' THEN RESULTIS N-'A'+10
RESULTIS -1
$)
AND CANVALUE(C) = VALOF $(
IF 'A'<=C<='I' THEN RESULTIS C-'A'+1
IF 'J'<=C<='R' THEN RESULTIS C-'J'+10
IF 'S'<=C<='Z' THEN RESULTIS C-'S'+19
IF '0'<=C<='9' THEN RESULTIS C-'0'+27
SWITCHON C INTO $(
CASE ' ': RESULTIS 0
CASE '$': RESULTIS 39
CASE ':': RESULTIS 37
CASE '.': RESULTIS 38
DEFAULT: RESULTIS -1
$)
$)
AND SYMTYPE(VAL) = VALOF
SWITCHON VALﰀ INTO $(
CASE T.NULL: RESULTIS ' '
CASE T.ABS: RESULTIS 'A'
CASE T.REL: RESULTIS 'R'
CASE T.EXT: RESULTIS 'X'
CASE T.COMMON: RESULTIS 'C'
DEFAULT: RESULTIS '?'
$)
AND FAULT(SYM) BE $(
IF SEARCHING LOGOR (PASS=1) LOGOR (FNO>2) THEN RETURN
INCRLINES()
FAULTS:=FAULTS+1
WRITEF(" ********************ERROR %C*N",SYM)
FSYM!FNO:=SYM
FNO:=FNO+1
$)
AND INCRLINES() BE $(
IF LINES=LINESPERPAGE THEN MNEWPAGE()
LINES:=LINES+1
$)
AND RSTREAM() = VALOF $(
LET C=RDCH()
IF C<0 THEN LONGJUMP(REC.P,REC.L)
RESULTIS C
$)
//<3032
AND RMACRO() = VALOF $(
LET C=GETBYTE(0,MACP)
MACP:=MACP+1
SWITCHON C INTO $(
CASE 0:
IF INPARFORM THEN $(
MACP:=MACP-1; RESULTIS 0
$)
LONGJUMP(MACREC.P,MACREC.L)
DEFAULT:
RESULTIS C
CASE '[':
RSYM:=RPARFORM; PARP:=MACLABGEN; RESULTIS RSYM()
CASE ':':
IF INPARFORM THEN $(
MACP:=MACP-1; RESULTIS 0
$)
C:=RSYM()
IF C='**' THEN $(
IF MACSTAR THEN RESULTIS '**'
RESULTIS RSYM()
$)
IF C='@' THEN $(
RSYM:=RPARFORM; PARP:=MACLAB; RESULTIS RSYM()
$)
$(
LET J,P,Q,TYPE,VALUE=0,ATP+1,ATP,0,0
INPARFORM:=TRUE
!ATP:=':'; ATP:=P; !ATP:=C
TEST '0'<=C<='9' THEN $(
$(
ATP:=ATP+1; !ATP:=RSYM()
$) REPEATWHILE '0'<=!ATP<='9'
$)
ELSE $(
WHILE CAN(!ATP) DO $(
ATP:=ATP+1; !ATP:=RSYM()
$)
$)
TERMINATOR:=!ATP
INPARFORM:=FALSE
$(
LET KA=SEARCHING
SEARCHING:=TRUE
J:=READITEM(@P,@TYPE,@VALUE)
SEARCHING:=KA
$)
TEST J&(TYPE=T.ABS)&(0<=VALUE<=16) THEN PARP:=MACARG!VALUE
ELSE $(
!ATP:=0; PARP:=Q
$)
CHECKMST(); ATP:=Q
RSYM:=RPARFORM; RESULTIS RSYM()
$)
$)
$)
AND RPARFORM() = VALOF $(
LET C=(PARP=0)->0,!PARP
TEST C=0 THEN $(
RSYM:=RMACRO
IF TERMINATOR=0 THEN RESULTIS RSYM()
C:=TERMINATOR; TERMINATOR:=0
$)
ELSE PARP:=PARP+1
RESULTIS C
$)
/*3032>*/
.