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)&#XFC00)=T.DIR THEN $(
               SWITCHON !(NAMEP!T)&#X3FF 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&#XFC00)=T.DIR THEN $(
                  OPTYPE:=OPTYPE&#X3FF
                  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&#XFC00)=T.DIR LOOP
            P:=P&#X3FF
            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
$)
.