SECTION"MAC"
GET "NLIBHDR" // STANDARD LIB HEADER
// THIS FILE SHOULD BECOME THE INSERT FILE "AHDR"
GET "AHDR"
//
// ONAME NAMEP!T !(NAMEP!T) MACTEXT (BYTE PACKE
//
// +-----+ +-----+ +-----+ +-----+
// ! ! ! ! !MAC ! ! !
// NAME<..... ! ! .............>! / ! ...>! !
// ! ! ! ! ! MAD! . ! !
// +-----+ +-----+ +-----+ . +-----+
// ! ! . ! !
// ! ....... ! !
// ! ! . .
// +-----+ . .
// ! ! . .
// !PARAM! . .
// ! 1 ! . .
// ! ! . .
// +-----+ . .
// ! ! . .
// ! ! . .
// . . . .
// . . . .
// . . . .
// . . . .
// ! ! . .
// ! ! . .
// +-----+ . .
// ! ! . .
// !PARAM! . .
// ! 16 ! ! !
// ! ! ! !
// +-----+ +-----+
// ! !
// ! 0 !
// ! !
// +-----+
// ! !
// ! !
// . .
// . .
// . .
//
// IF PARAM N =
// -N, THEN PARAMETER IS DEFAULTED TO ITSELF
// <0 AND #N, THEN PARAMETER IS DEFAULTED TO PARAM -N
// =0, NO DEFAULT, NEED NOT APPEAR ON CALL LINE
// >0, POINTER TO DEFAULT VALUE, PACKED IN BYTES
// AND TERMINATED BY A 0 BYTE
//
LET MACRO1(DIR) BE $(
LET P,T=0,0
AND ARGNO=0
IF LAB=0 THEN $(
FLUSH(); RETURN
$)
T:=GETOPN(@LAB)
IF T<0 THEN $(
FLUSH(); RETURN
$)
UNLESS NAMEP!T=0 THEN $(
!(NAMEP!T):=!(NAMEP!T) LOGOR T.MULDEF; FLUSH(); RETURN
$)
P:=LIST18()
NAMEP!T:=P
IF P=0 THEN $(
FLUSH(); RETURN
$)
!P:=T.MACRO+DIR
1!P:=MTP
P:=P+1
FOR Q=P+1 TO P+16 DO !Q:=0
IF DIR=D.MAD THEN $(
WHILE (!OP=',')&(ARGNO<=8) DO $(
OP:=OP+1; ARGNO:=ARGNO+1
ARGNO!P:=GETARG(@OP)
$)
ARGNO:=8
$)
UNLESS ARG=0 THEN $(
$(
ARGNO:=ARGNO+1
ARGNO!P:=GETARG(@ARG)
IF (ARGNO=16) LOGOR (!ARG NE ',') THEN BREAK
ARG:=ARG+1
$) REPEAT
$)
// INSERTS TEXT INTO THE MACRO STORE
// TERMITED BY AN 'END' OR 'EMP' DIRECTIVE.
// WATCHES FOR MULTIBLE ENTRY POINTS.
MACDEF:=TRUE
$(
READLINE()
UNLESS OP=0 THEN $(
T:=GETOPN(@OP)
UNLESS (T<0) LOGOR (NAMEP!T=0) THEN $(
IF (!(NAMEP!T)ﰀ)=T.DIR THEN $(
SWITCHON !(NAMEP!T)Ͽ INTO $(
CASE D.EMP:
PUTBYTE(0,MTP,0)
MTP:=MTP+1; CHECKMST()
MACDEF:=FALSE; RETURN
CASE D.MAC:
MACRO1(D.MAC); RETURN
CASE D.MAD:
MACRO1(D.MAD); RETURN
$)
$)
$)
$)
$(
LET NL=0
UNTIL LINE!NL='*N' THEN NL:=NL+1
NL:=NL-1 REPEATWHILE LINE!NL=' '
LINE!(NL+1):='*N'
FOR L=0 TO NL+1 DO $(
PUTBYTE(0,MTP,LINE!L)
MTP:=MTP+1
$)
$)
CHECKMST()
$) REPEAT
$)
AND MACRO(DIR) BE $(
LET T=0
AND ARGNO=0
IF LAB=0 THEN $(
FAULT('S'); PRINTLINE(); FLUSH(); RETURN
$)
T:=GETOPN(@LAB)
IF T<0 THEN $(
FLUSH(); RETURN
$)
UNLESS (!(NAMEP!T) & T.MULDEF)=0 THEN $(
FAULT('M'); PRINTLINE(); FLUSH(); RETURN
$)
UNLESS !(NAMEP!T)=(T.MACRO+DIR) THEN $(
FAULT('P'); PRINTLINE(); FLUSH(); RETURN
$)
IF DIR=D.MAD THEN $(
WHILE (!OP=',')&(ARGNO<8) DO $(
OP:=OP+1; ARGNO:=ARGNO+1
GETARG(@OP)
$)
ARGNO:=8
$)
UNLESS (!OP=' ') LOGOR (!OP='*N') THEN $(
FAULT('S'); PRINTLINE(); FLUSH(); RETURN
$)
UNLESS ARG=0 THEN $(
$(
ARGNO:=ARGNO+1
GETARG(@ARG)
IF (ARGNO=16) LOGOR (!ARG NE ',') THEN BREAK
ARG:=ARG+1
$) REPEAT
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
$)
FLUSH()
$)
AND GETARG(AP) = VALOF $(
LET P=!AP
IF TERM(!P) THEN RESULTIS 0
IF DTP>DEFTOP THEN $(
PROFIL:=1; FAULT('Y'); RESULTIS 0
$)
IF PASS=2 THEN $(
UNTIL TERM(!P) DO P:=P+1
!AP:=P; RESULTIS 1 //RETURN POSITIVE RESULT
$)
$(
LET D=DTP
UNTIL TERM(!P) DO $(
PUTBYTE(0,DTP,!P); P:=P+1; DTP:=DTP+1
$)
PUTBYTE(0,DTP,0); DTP:=DTP+1
!AP:=P; RESULTIS D
$)
$)
LET LIST18() = VALOF $(
LET LSPP=LSP
LSP:=LSP+18
IF LSP>LSPACEMAX THEN $(
PROFIL:=1; FAULT('Z'); RESULTIS 0
$)
RESULTIS LSPP
$)
AND FLUSH() BE $(
LET T=0
// READS LINES UNTIL AN 'EMP' OR 'END' DIRECTIVE
MACDEF:=TRUE
$(
IF PASS=2 THEN PRINTLINE()
READLINE()
IF OP=0 THEN LOOP
T:=GETOPN(@OP)
IF (T<0) LOGOR (NAMEP!T=0) THEN LOOP
$(
LET OPTYPE=!(NAMEP!T)
IF (OPTYPEﰀ)=T.DIR THEN $(
OPTYPE:=OPTYPEϿ
IF OPTYPE=D.EMP THEN BREAK
$)
$)
$) REPEAT
MACDEF:=FALSE
$)
AND CHECKMST() BE $(
IF MTP>MACTOP THEN $(
SELECTOUTPUT(ERRSTR)
NEWLINE()
WRITES("MACRO STORE OVERFLOW")
PROFIL:=1; PRINTPROFIL()
FINISH
$)
IF DTP>DEFTOP THEN $(
SELECTOUTPUT(ERRSTR)
NEWLINE()
WRITES("DEFAULT VALUE TABLE OVERFLOW")
PROFIL:=1; PRINTPROFIL()
FINISH
$)
IF ATP>ARGTOP THEN $(
SELECTOUTPUT(ERRSTR)
NEWLINE()
WRITES(" MACRO ARGUMENT TABLE OVERFLOW")
PROFIL:=1; PRINTPROFIL()
FINISH
$)
$)
AND EXPAND(DIR,T) BE $(
LET KA,KB,KC,KD=MACEXP,MACBEGIN,MACARG,MACLAB
AND KE,KF,KG=MACLABGEN,MACSTAR,MACP
AND KH,KI,KJ,KK=RSYM,ATP,MACREC.P,MACREC.L
AND KL,KM=REC.L,REC.P
AND ARGNO=0
AND V=VEC 16
UNLESS (DIR & T.MULDEF)=0 THEN $(
FAULT('M'); IF PASS=2 THEN PRINTLINE(); RETURN
$)
MACARG:=V
FOR P=MACARG TO MACARG+16 DO !P:=0
MACBEGIN:=1!(NAMEP!T)
// START DECODING MACRO CALL
TEST LAB=0 THEN MACLAB:=0
ELSE $(
MACLAB:=ATP
UNTIL TERM(!LAB) DO $(
!ATP:=!LAB; ATP:=ATP+1; LAB:=LAB+1
$)
!ATP:=0; ATP:=ATP+1
CHECKMST()
$)
MACLABGEN:=ATP; LABGEN:=LABGEN+1
!ATP:='0'+LABGEN/100; ATP:=ATP+1
!ATP:='0'+((LABGEN/10) REM 10); ATP:=ATP+1
!ATP:='0'+(LABGEN REM 10); ATP:=ATP+1
!ATP:=0; ATP:=ATP+1
CHECKMST()
TEST !OP='**' THEN $(
MACSTAR:=TRUE; OP:=OP+1
$)
ELSE MACSTAR:=FALSE
// DO ARGS
IF DIR=D.MAD THEN $(
WHILE (!OP=',')&(ARGNO<8) DO $(
ARGNO:=ARGNO+1
OP:=OP+1
TEST TERM(!OP) THEN MACARG!ARGNO:=0
ELSE $(
MACARG!ARGNO:=ATP
UNTIL TERM(!OP) THEN $(
!ATP:=!OP; ATP:=ATP+1; OP:=OP+1
$)
!ATP:=0; ATP:=ATP+1
CHECKMST()
$)
$)
ARGNO:=8
$)
UNLESS (!OP=' ') LOGOR (!OP='*N') THEN FAULT('S')
UNLESS ARG=0 THEN $(
$(
ARGNO:=ARGNO+1
TEST TERM(!ARG) THEN MACARG!ARGNO:=0
ELSE $(
MACARG!ARGNO:=ATP
TEST !ARG='"' THEN $(
$(
$(
!ATP:=!ARG; ATP:=ATP+1; ARG:=ARG+1
$) REPEATUNTIL (!ARG='"') LOGOR (!ARG='*N')
IF !ARG='*N' THEN $(
FAULT('S'); BREAK
$)
!ATP:=!ARG; ATP:=ATP+1; ARG:=ARG+1
$) REPEATWHILE !ARG='"'
$)
ELSE $(
$(
!ATP:=!ARG; ATP:=ATP+1; ARG:=ARG+1
$) REPEATUNTIL TERM(!ARG)
$)
!ATP:=0; ATP:=ATP+1
CHECKMST()
$)
UNLESS (!ARG=',')&(ARGNO<=16) THEN BREAK
ARG:=ARG+1
$) REPEAT
UNLESS (!ARG=' ') LOGOR (!ARG='*N') THEN FAULT('S')
$)
$(
LET N=0
FOR I=1 TO 16 DO $(
UNLESS MACARG!I=0 DO N:=N+1
$)
MACARG!0:=ATP
IF N>9 THEN $(
!ATP:='1'; ATP:=ATP+1; N:=N-10
$)
!ATP:='0'+N; ATP:=ATP+1
$)
!ATP:=0; ATP:=ATP+1
CHECKMST()
//DEFAULTS
MACEXP:=TRUE; RSYM:=RMACRO
$(
LET ARGDEF=NAMEP!T+1
AND KATP=ATP
ATP:=ATP+72
FOR I=1 TO 16 DO $(
IF MACARG!I=0 THEN $(
LET K=KATP
MACP:=ARGDEF!I
IF MACP=0 THEN LOOP
MACREC.P:=LEVEL(); MACREC.L:=DEF.RETURN
$(
!KATP:=RSYM()
KATP:=KATP+1
$) REPEAT
DEF.RETURN:
IF K=KATP THEN $(
FAULT('S'); LOOP
$)
MACARG!I:=K
!KATP:=0
KATP:=KATP+1
CHECKMST()
$)
$)
ATP:=KATP
$)
MACEXP:=KA
IF PASS=2 THEN PRINTLINE()
MACEXP:=TRUE; MACP:=MACBEGIN
MACREC.P,MACREC.L:=LEVEL(),MAC.RETURN
TEST PASS=1 THEN PASS1() ELSE PASS2()
MAC.RETURN:
MACEXP,MACBEGIN,MACARG,MACLAB:=KA,KB,KC,KD
MACLABGEN,MACSTAR,MACP:=KE,KF,KG
RSYM,ATP,MACREC.P,MACREC.L:=KH,KI,KJ,KK
REC.L,REC.P:=KL,KM
$)
AND SEARCH() BE $(
LET V1=VEC 30
AND J=0
AND T=0
AND P=0
AND TP=0
$(
V1!J:=!ARG
ARG:=ARG+1; J:=J+1
$) REPEATWHILE CAN(!ARG)
UNLESS (!ARG=' ') LOGOR (!ARG=',') LOGOR (!ARG='*N') THEN $(
FAULT('S')
IF PASS=2 THEN PRINTLINE(); RETURN
$)
IF MACEXP THEN MACP:=MACBEGIN // SEARCH STARTS AT BEGINNING
// OF MACRO.
SEARCHING:=TRUE
$(
J:=READLINE() REPEATUNTIL J
IF !LINE='**' LOOP
TP:=OP
IF (TP=0) LOGOR (LAB=0) LOOP
T:=GETOPN(@TP); IF T<0 LOOP
P:=NAMEP!T; IF P=0 LOOP
P:=!P
UNLESS (Pﰀ)=T.DIR LOOP
P:=PϿ
IF P=D.END THEN $(
SEARCHING:=FALSE; FAULT('G'); PENDINGLINE:=TRUE
RETURN
$)
UNLESS D.IF<=P<=D.AOP THEN LOOP
J:= VALOF $(
LET CR=0
AND CD=0 // COMPARITOR & COMPARAND
$(
UNLESS V1!CR=LINE!CD RESULTIS FALSE
CR:=CR+1; CD:=CD+1
$) REPEATWHILE CAN(V1!CR)&CAN(LINE!CD)
RESULTIS ( NOT CAN(V1!CR))&( NOT CAN(LINE!CD))
$)
IF J THEN $(
SEARCHING:=FALSE
PENDINGLINE:=TRUE; RETURN
$)
$) REPEAT
$)
.