*DECK     PIG 
          IDENT  PIG
 PIG      SECT   (OBJECT CODE INSTRUCTION GROUP.),1 
  
          SST    A,C,D,L,B
          NOREF  A,C,D,L,B
  
 B=PIG    RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  PIK=TAG,PIK=I,PIK=J,PIK=XJP,PIK=BL,PIK=PI,PIK=PS,PIKX
          ENTRY  WIN,PIG,DPT
          ENTRY  NADD 
          ENTRY  WININIT,WINX 
  
*         IN FTN
          EXT    F.LF,FV.LGO,LOP=O
  
*         IN TABLES 
          EXT    BINIO,BINOUT,IGS,LINEBUF,ORG,PARCEL,TA.PRO,TT=LF 
          EXT    TA=PRO,TS.STN,TT.LF,TS.SYM,TG.PRO
  
*         IN LIST 
          EXT    PIK
  
*         IN INIT 
          EXT    ADWT,DPTA
  
*         IN ALLOC
          EXT    ALC.00,ALC.REG,ALC.PIG 
 PIG      SPACE  4,12 
**        PIG -  PROCESS INSTRUCTION GROUP. 
* 
*         THIS REPRESENTS, ROUGHLY, PASS *ONE-AND-A-HALF*.
* 
*         ENTRY  (IGS) _ FWA INST GROUP 
*                (IGE) _ LAST COMPILED INSTRUCTION. 
*         EXIT   (IGS) = (IGE) + 1
* 
*         *PIG* PROCESSES EACH INSTRUCTION GROUP (FROM (IGS) TO (IGE))
*                WHEN IT IS COMPLETE. 
*         IF AN OBJECT LISTING WAS REQUESTED, THE BINARY INSTRUCTIONS 
*                IN THE GROUP ARE CONVERTED TO SYMBOLIC AND PRINTED.
* 
*         THROUGHOUT *PIG* PROCESSING  -- 
*                (B4) = NUMBER OF INSTRUCTIONS LEFT TO PROCESS. 
*                (A5) _ CURRENT *LONG FILE* ENTRY.
* 
*         REGISTER *A5* IS LOCKED THROUGHOUT *PIG* PROCESSING 
*         TO ENSURE ANY CALLS TO *ALLOC* (I.E. FROM *DPT*) WILL 
*         NOT CAUSE A TABLE CRASH TO RENDER (A5) ERRONEOUS. 
* 
*         USES   ALL EXCEPT *A0*
*         CALLS  ADDWD, COD, PIK, WRITEW
  
  
 #FID     IFNE   .FID,0 
          ENTRY  PIGLINE,PIGLAB 
 PIGLINE  DATA   0           LINE NUMBER FOR LINE NUMBER TABLE
 PIGLAB   DATA   0           STATEMENT LABEL CORRESPONDING TO PIGLINE 
 #FID     ENDIF 
  
  
 PIG90    SA3    ALC.00      UNLOCK (A5)
          SA2    FV.LGO 
          BX6    X3 
          SA1    BINOUT 
          SA6    ALC.REG
          ZR     X2,PIG93    IF BINARY SUPPRESSED 
          PL     X1,PIG93    IF BINARY UNSUCCESSFUL 
          SA4    IGS
          SA3    TT=LF
          SA2    TT.LF
          BX6    X3 
          IX0    X2+X4
          IX3    X3-X4
          SA6    A4 
          SA2    BINIO
          ZR     X2,PIG95    IF INTERMEDIATE STILL IN CORE
          WRITEW F.LF,X0,X3 
 PIG93    SHRINK TT=LF
          SA6    IGS
 PIG95    SA2    LOP=O
          MI     X2,PIGX     IF OBJECT LISTING BEING PRODUCED 
          MX6    0
          SA6    NADD        RESET NEW ADDRESS
  
 PIG      SUBR   0           ENTRY/EXIT...
  
 #FID     IFNE   .FID,0 
          SA4    =XCO.ID
          PL     X4,PIG6     IF FID CODE NOT NECESSARY
  
          SA4    PIGLINE     LINE NUMBER
          ZR     X4,PIG6     IF 5700 TABLE ENTRY NOT REQUIRED 
          SA1    =1000000B
          IX1    X1-X4
          ZR     X1,PIG6     IF LINE ONE
          BX6    0
          =A1    A4-PIGLINE+PIGLAB LABEL NUMBER 
          LX4    P.LN-P.TRC  POSITION LINE NUMBER 
          =A6    A4-PIGLINE+PIGLINE 
          =A6    A1-PIGLAB+PIGLAB  CLEAR LABEL
          ZR     X1,PIG3     IF LABEL (PREVIOUSLY) ZERO 
  
          RJ     =XDXB       LABEL NUMBER TO BINARY 
 PIG3     BSS 
          LX6    P.SN        POSITION BINARY LABEL NUMBER 
          SA1    ORG
          BX6    X6+X4
          BX6    X6+X1       LINE NUMBER TABLE ENTRY
          ADDWD  =XT.LNT     ENTER LINE NUMBER INTO TABLE 
 PIG6     BSS 
 #FID     ENDIF 
  
          SA2    WINA        FLUSH *WINA* IF .NE. 0 
          ZR     X2,PIG10    IF *WINA* .EQ. 0 
          MX0    45 
          SX6    B0 
          SB2    PIG10
          SA6    A2          CLEAR *WINA* 
          BX7    -X0+X2 
          EQ     WIN5        OUTPUT INSTRUCTION TO TT.LF
  
 PIG10    SA4    IGS
          SA3    TT=LF
          SA2    TT.LF
          SA1    ALC.PIG     LOCK (A5)
          IX0    X2+X4
          SA5    X0-1        PRESET (A5) = (FWA - 1) OF INST GROUP
          IX3    X3-X4       LENGTH OF THIS GROUP = (TT=LF) - (IGS) 
          BX7    X1 
          SB4    X3          (B4) = NUMBER OF INSTRUCTION WORDS 
          SA7    ALC.REG
  
  
**        INSTRUCTION PROCESSING LOOP.
*         IF THERE ARE NO MORE LONG FILE ENTRIES TO BE DONE, EXIT.
*         FETCH THE ENTRY AND DECIDE IF A FORCE UPPER IS NEEDED BEFORE
*                THIS INSTRUCTION.
  
 PIKX     BSS    0           ** RETURN FROM PIK **
 PIG20    SA1    WINA 
          SA2    PARCEL 
          NZ     X1,PIG21    IF PROCESSING PACKED INSTRUCTION 
          =A5    A5+1        GET NEXT TT.LF ENTRY 
          MX0    45 
          =B4    B4-1        DECREMENT INSTRUCTION COUNT
          BX4    -X0*X5 
          MI     B4,PIG90    IF FINISHED INSTRUCTION GROUP
          BX1    X0*X5       REMOVE LOW ORDER BITS
          BX3    X4+X0
          NZ     X3,PIG211   IF LONG INSTRUCTION OR PSEUDO
  
 PIG21    MX0    15 
          NO
          BX5    X0*X1       ISOLATE SHORT INSTRUCTION
          BX7    -X0*X1      REMOVE FROM PACKAGE
          NO
          LX7    15 
          NO
          SA7    A1          STORE PACKAGE REMNANT
  
 PIG211   MX0    L.LI12 
          BX3    X0*X5
          SA1    =1H
          LX3    L.LI12 
          BX6    X1 
          SB3    X3          B3 = GHIJ
          AX3    L.LGH       X3 = GH
  
 .76      IFEQ   .CPU,76
  
          SX4    B3 
          AX4    3           X4 = GHI 
          SB5    X4-014B
          MI     B5,PIG22    IF GHI LESS THAN *014* 
          SB5    X4-016B
          PL     B5,PIG22    IF GHI GREATER THAN *015*
  
*         HERE IF R/W LCM 
  
          SA4    X4+PIK=LCM-014B   X4 = INST SKELETON 
          EQ     PIG23
  
 PIG22    BSS    0
  
 .76      ENDIF 
  
          SA4    X3+PIK=PS   X4 = INST SKELETON 
 PIG23    SB2    X2-3 
          LX7    X2          X7 = CURRENT PARCEL COUNT
          SA1    ORG
          ZR     B2,PIG28    IF EMPTY WORD
          MI     X2,PIG25    IF FULL WORD 
          PL     X4,PIG30    IF SHORT (15-BIT) INST 
          ZR     X2,PIG25    IF LESS THAN 30 BITS LEFT
          GT     B3,B1,PIG30 IF NOT *CALL* OR *BSS* 
  
  
**        FORCE UPPER BEFORE THE INST.
  
 PIG25    SX7    3           INDICATE EMPTY WORD
          SA7    A2 
          SX6    X1+B1
          SA6    A1 
          SA6    NADD        SAVE NEW ADDRESS 
          BX1    X6 
  
 PIG28    PIA                CONVERT ADDRESS TO DISPLAY CODE
  
  
**        NOW ADVANCE ORG/PARCEL COUNTERS.
*         ENTRY  (X7) = PARCEL COUNT BEFORE INST
*                (X6) = ADDRESS COLUMNS OF LISTING. 
*                            ADDRESS IF AT TOP OF WORD, ELSE BLANKS.
*                (X5) = LONG FILE ENTRY 
*                (X4) = SKELETON TABLE ENTRY
*                (X3) = *GH* PORTION OF INST. 
*                (B3) = *GHIJ* PART OF INST 
  
 PIG30    SA6    LINEBUF
          SB6    -1 
          PL     X4,PIG40    IF SHORT INST
          SB6    B6-1 
          NZ     X3,PIG40    IF NOT PSEUDO INSTRUCTION
          SA4    ORG
          NZ     B3,PIG35    IF NOT *BSS* 
  
  
**        FOR *BSS*, MAKE TABLE ENTRY TO DEFINE THE SYMBOL. 
  
          MX0    -L.LTAG
          SX3    X5 
          LX5    -P.LTAG
          BX6    -X0*X5      ISOLATE NR OF WORDS TO RESERVE 
          IX6    X6+X4
          SA6    A4          ADVANCE ORIGIN COUNTER 
          SA6    NADD        SAVE NEW ADDRESS 
          LX5    P.LTAG      RESTORE X5 
          SB2    X3-C.VAR 
          MI     B2,PIG70    IF NO TAG (SIMPLE FORCE UPPER) 
          SB3    X3-C.PRO 
          SB5    X3-C.STAT
          PL     B5,PIG32    IF NOT VARIABLE TAG
          SA2    TS.SYM 
          LX4    P.PNT
          SA3    X2+B2
          BX6    X4+X3       MERGE ADDRESS INTO POINTER FIELD OF TT.NAM 
          SA6    A3 
          EQ     PIG70
  
 PIG32    PL     B3,PIG33    IF NO STATEMENT TAG
          SA2    TS.STN 
          LX4    P.SNAD 
          SA3    X2+B5
          BX6    X3+X4       MERGE ADDRESS WITH TT.STAT ENTRY 
          SA6    A3 
          EQ     PIG70
  
 PIG33    LX3    P.TAG
          BX6    X3+X4
          RJ     DPT         DEFINE PROGRAM TAG 
          EQ     PIG70
  
  
**        FORCE UPPER AFTER FOR ALL PSEUDOS EXCEPT *BSS*. 
  
 PIG35    SX7    3
          SX6    X4+B1
          SA7    PARCEL      INDICATE EMPTY WORD
          SA6    A4          ADVANCE ORIGIN COUNTER 
          SA6    NADD        SAVE NEW ADDRESS 
          EQ     PIG70
  
 PIG40    SX7    X7+B6
          SA7    PARCEL      ADVANCE PARCEL COUNT 
  
**        PRINT THE INSTRUCTION, IF DESIRED.
  
 PIG70    SA1    =XLOP=O
          ZR     X1,PIG20    IF OBJECT LIST NOT SELECTED  (OL.EQ.0) 
          EQ     PIK         PRINT INSTRUCTION KONVERSION 
  
 NADD     DATA   0           NEW CODE ADDRESS IF .NZ. 
 DPT      SPACE  4,8
**        DPT -  DEFINE PROGRAM TAG.
* 
*         ENTRY  (X6) = ENTRY FOR *TA.PRO*. 
* 
*         USES   A1,A2,A3,A6  X0  B2,B7 
*         CALLS  ALLOC
  
  
 DPT      SUBR               ENTRY/EXIT...
          SA1    TG.PRO 
          SA2    TA=PRO 
          SA6    DPTA        SAVE (X6)
          SX3    X1-C.PRO+1 
          IX0    X3-X2
          ALLOC  TA.PRO,X0   INSURE ENUF ROOM 
          SA2    DPTA 
          BX6    X2 
          LX2    -P.PWF 
          MX0    -L.PWF 
          BX2    -X0*X2      ISOLATE TAG ORDINAL
          IX0    X2+X1
          SA6    X0 
          EQ     EXIT.
  
 INST     EJECT 
**        INST - MACRO TO GENERATE INSTRUCTION SKELETONS. 
*         GENERATES TABLE OF INSTRUCTION SKELETONS USED BY *PIG* TO 
*                CONVERT INSTRUCTIONS TO HUMAN-READABLE FORM FOR THE
*                OBJECT CODE LISTING. 
* 
*         INST   (KEY),BJMP,FORCE,IJJ 
* 
*         *KEY*  = INSTRUCTION DESCRIPTOR.  EACH CHARACTER OF THE *KEY* 
*                  HAS MEANING AS FOLLOWS --
*                            I   I-PORTION OF INSTRUCTION 
*                            J   J-PORTION OF INSTRUCTION 
*                            K   K-PORTION OF INSTRUCTION (3 BITS ONLY) 
*                            Q   18-BIT *K* ADDRESS FIELD (MUST BE LAST)
*                            C   OUTPUT A *B* IF THE NEXT REGISTER IS 
*                                            NOT A ZERO,
*                                            ELSE, SKIP THE NEXT 2 ITEMS
*                            + - * / A B X , AND BLANK ALL STAND FOR
*                                            THEMSELVES.
*         *BJMP* = NON-EMPTY IF THIS A *B-REGISTER* JUMP INSTRUCTION. 
*                            (04 THRU 07 INSTRUCTION.)
*         *FORCE*= THIS INSTRUCTION FORCES THE NEXT INSTRUCTION UPPER.
*         *COPY* = COPY *J* INTO *K*. 
  
 COPY     DEFINE 2*CHAR      SAYS COPY *J* INTO *K* 
  
  
 INST     MACRO  KEY,BJMP,FORCE,IJJ 
 A        MICRO  3,1,=KEY=
 B        MICRO  5,,=KEY= 
 B        MICRO  1,,="A""B"=
 C        MICCNT B
 D        SET    0
 L        SET    0
 A        MICRO  C+3,1,=KEY=
          IFC    EQ,="A"=Q=,1 
 L        SET    L+4
          IFC    NE,,BJMP,,,1 
 L        SET    L+2
          IFC    NE,,FORCE,,,1
 L        SET    L+1
          VFD    3/L
.1        DUP    C
 D        SET    D+1
 A        MICRO  D,1,="B"=
 A        MICRO  2*1R"A"-1,2,/101112-D-E-F-G-H010203-L-M-N-O-P04-R-S-T-U
,-V-W13-Y-Z-0-1-2-3-4-5-6-7-8-905060708-(-)-$-=1409/
          VFD    4/"A"
.1        ENDD
          IFLE   $,2*6-1+4,1
 8        ERR    INST - DESCRIPTOR (KEY) IS TOO LONG
          POS    P.COPY+1 
 A        MICRO  1,2, KEY 
          VFD    1/IJJ,12/2R"A" 
 INST     ENDM
 PIK=PS   SPACE  4,8
**        PIK=PS - INSTRUCTION SKELETON TABLES FOR *PIG*
  
  
 PIK=PS   INST   (PS  Q)               00    (FAKE) 
          INST   (RJ  Q),,1            01 
          INST   (JP  CI+Q),,1         02 
          INST   (JXI XJ,Q)            03I  (FAKE)
 PIK=EQ   INST   (EQ  CI,CJ,Q),1       04 
          INST   (NE  CI,CJ,Q),1       05 
          INST   (GE  CI,CJ,Q),1       06 
          INST   (LT  CI,CJ,Q),1       07 
  
          INST   (BXI XJ),,,1          10 
          INST   (BXI XJ*XK)           11 
          INST   (BXI XJ+XK)           12 
          INST   (BXI XJ-XK)           13 
          INST   (BXI -XJ),,,1         14 
          INST   (BXI -XK*XJ)          15 
          INST   (BXI -XK+XJ)          16 
          INST   (BXI -XJ-XK)          17 
  
          INST   (LXI JKB)             20 
          INST   (AXI JKB)             21 
          INST   (LXI CJ,XK)           22 
          INST   (AXI CJ,XK)           23 
          INST   (NXI CJ,XK)           24 
          INST   (ZXI CJ,XK)           25 
          INST   (UXI CJ,XK)           26 
          INST   (PXI CJ,XK)           27 
  
          INST   (FXI XJ+XK)           30 
          INST   (FXI XJ-XK)           31 
          INST   (DXI XJ+XK)           32 
          INST   (DXI XJ-XK)           33 
          INST   (RXI XJ+XK)           34 
          INST   (RXI XJ-XK)           35 
          INST   (IXI XJ+XK)           36 
          INST   (IXI XJ-XK)           37 
  
          INST   (FXI XJ*XK)           40 
          INST   (RXI XJ*XK)           41 
          INST   (DXI XJ*XK)           42 
          INST   (MXI JKB)             43 
          INST   (FXI XJ/XK)           44 
          INST   (RXI XJ/XK)           45 
          INST   (NO  IJKB)            46 
          INST   (CXI XK),,,1          47 
  
          INST   (SAI AJ+Q)            50 
          INST   (SAI CJ+Q)            51 
          INST   (SAI XJ+Q)            52 
          INST   (SAI CK+XJ)           53 
          INST   (SAI CK+AJ)           54 
          INST   (SAI AJ-BK)           55 
          INST   (SAI CK+BJ)           56 
          INST   (SAI -BK+BJ)          57 
  
          INST   (SBI AJ+Q)            60 
          INST   (SBI CJ+Q)            61 
          INST   (SBI XJ+Q)            62 
          INST   (SBI CK+XJ)           63 
          INST   (SBI CK+AJ)           64 
          INST   (SBI AJ-BK)           65 
          INST   (SBI CK+BJ)           66 
          INST   (SBI -BK+BJ)          67 
  
          INST   (SXI AJ+Q)            70 
          INST   (SXI CJ+Q)            71 
          INST   (SXI XJ+Q)            72 
          INST   (SXI CK+XJ)           73 
          INST   (SXI CK+AJ)           74 
          INST   (SXI AJ-BK)           75 
          INST   (SXI CK+BJ)           76 
          INST   (SXI -BK+BJ)          77 
  
 .76      IFEQ   .CPU,76
  
          ENTRY  PIK=LCM
 PIK=LCM  INST   (RXJ XK)              014
          INST   (WXJ XK)              015
  
 .76      ENDIF 
  
 PIK=XJP  INST   (ZR  XJ,Q)            030
          INST   (NZ  XJ,Q)            031
          INST   (PL  XJ,Q)            032
          INST   (MI  XJ,Q)            033
          INST   (IR  XJ,Q)            034
          INST   (OR  XJ,Q)            035
          INST   (DF  XJ,Q)            036
          INST   (ID  XJ,Q)            037
  
 PIK=PI   BSS    0           PSEUDO-INST SKELETON TABLE 
          INST   (RJK Q),,FORCE        0001 
          INST   (RJ  Q),,FORCE        0002 
          INST   (JP  CI+Q),,FORCE     0003 
          INST   (EQ  Q),,FORCE        0004 
  
  
 PIK=TAG  BSSZ   3           TEMP HOLDING FOR (DPC) TAG AND OFFSET
  
 PIK=BL   CON    1L +3R      THE WORD BEFORE *PIK=I* MUST BE NEGATIVE 
 PIK=I    DATA   0           *I* REGISTER OF INSTRUCTION
 PIK=J    DATA   0           *J* REGISTER OF INSTRUCTION
          DATA   0           *K* REGISTER OF INSTRUCTION
          DATA   -1          FLAG TO INDICATE 18-BIT *K* PORTION
          DATA   1R+         PLUS 
          DATA   1R-         MINUS
          DATA   1R*         STAR 
          DATA   1R/         SLASH
          DATA   1R,         COMMA
          DATA   1RA
          DATA   1RB
          DATA   -0          FLAG TO INDICATE CONDITIONAL *B* REGISTER
          DATA   1RX
          DATA   1R          BLANK
  
          POPMAC INST 
 WIN      SPACE  4,8
**        WIN -  WRITE INTERMEDIATE FILE. 
* 
*         ENTRY  (X7) = INSTRUCTION TO TRANSFER 
*                (B2) = EXIT ADDRESS. 
* 
*         EXIT   INSTRUCTION TRANSFERRED TO INTERMEDIATE FILE.
*                (X7) = DESTROYED.
* 
*         USES   A1,A2,A3  B2,B7  X0,X1,X2,X6,X7
*                (ADWT - ADWT+1)
*                PRESERVES  A0,A4,A5  B3,B4,B5,B6  X3,X4,X5 
*                ------ C A N  N E V E R  D E S T R O Y ------
*                         A0,A4,A5  X3,X4,X5  B4,B5,B6
  
  
 WINA     BSSZ   1           STORAGE FOR PACKED 15 BIT INSTRUCTIONS 
 WININIT  BSS    1           CONTAINS (WIN) OR (WINX) -- STORED OVER WIN
  
*                            *****
 WIN      BSS                *  REPLACED BY WININIT 
*                            *****
          MX0    L.LGH
          BX1    X0*X7       GET GH FIELD 
          LX1    L.LGH       INTO LOW ORDER BITS
  
 .76      IFEQ   .CPU,76
  
          BX2    X7 
          AX2    51 
          SB3    X2-14B 
          MI     B3,WIN1     IF NOT *014* (READ LSM)
          NE     B1,B3,WIN1  IF NOT *015* (WRITE LCM) 
          SX1    B3+PIK=LCM-PIK=PS
  
 WIN1     BSS    0
  
 .76      ENDIF 
  
          SA1    X1+PIK=PS   GET INSTRUCTION SKELETON 
          SA2    WINA 
          PL     X1,WIN2     IF SHORT INSTRUCTION 
  
*         IT IS EITHER A LONG INSTRUCTION OR A PSEUDO, OUTPUT 
*         ANY PACKED INSTRUCTIONS FIRST AND THEN THIS ONE.
  
          ZR     X2,WIN5     IF NO PACKED 15 BIT INSTRUCTIONS 
          =X0    2
          SA1    TT.LF
          BX6    X3 
          SA7    ADWT        SAVE LONG INSTRUCTION
          =A6    A7+1        SAVE (X3)
          ALLOC  A1,X0       EXPAND TT.LF BY 2 WORDS
          SA1    ADWT 
          SX0    77777B 
          =A3    A1+1        RESTORE (X3) 
          MX7    0
          SA2    WINA 
          SA7    A2          CLEAR WINA 
          BX6    X1 
          BX7    X2+X0
          =A6    B7-1        OUTPUT LONG INSTRUCTION
          =A7    A6-1        OUTPUT PACKED INSTRUCTION
          JP     B2          EXIT.. 
  
*         15 BIT INSTRUCTION. FIRST WE MUST CHECK IF IT IS A TRANSMIT 
*         TO ITSELF, THEN IF IT IS A *10*,*14* OR *47* INSTRUCTION
*         WE MUST COPY THE *J* PART INTO THE *K* PART, THEN PACK
*         IT. IF PACKING IT COMPLETES THE PACKAGE WE OUTPUT IT TO 
*         TT.LF AND CLEAR *WINA*. 
  
 WIN2     IFBIT  X1,-COPY,WIN4     IF NOT *10*,*14* OR *47* INSTRUCTION 
          MX1    1
          MX0    L.LGH
          LX1    58          FORM *10* OPCODE 
          BX6    X0*X7
          IX1    X1-X6
          NZ     X1,WIN3     IF NOT *10* OPCODE 
          MX0    -L.LI
          MX1    -L.LJ
          LX0    P.LI 
          LX1    P.LJ 
          BX0    -X0*X7      *I* REGISTER 
          BX1    -X1*X7      *J* REGISTER 
          LX0    P.LJ-P.LI
          IX6    X0-X1
          NZ     X6,WIN3     IF NOT TRANSMIT TO SELF
          JP     B2          EXIT.. 
  
*         IT*S A *10*,*14* OR *47* INSTRUCTION, COPY *J* INTO *K* FIELD.
*         THIS IS DONE HERE BECAUSE *GEN* IS SIMPLIFIED IF HE 
*         DOES NOT HAVE TO COMPLETE THE *K* PORTION OF THESE
*         INSTRUCTIONS. 
  
 WIN3     MX0    -L.LJ
          NO
          LX0    P.LJ 
          NO
          BX1    -X0*X7 
          NO
          LX1    P.LK-P.LJ
          BX7    X7+X1
  
*         NOW WE MAY PACK IT AND OUTPUT THE PACKAGE TO TT.LF IF FULL. 
  
 WIN4     =B7    X2-1 
          MI     B7,WIN6     IF NO PACKAGE PRESENT
          LX7    -15         POSITION INSTRUCTION 
          ZR     B7,WIN6     IF ONE PACKAGE PRESENT 
          LX7    -15         RE-POSITION INSTRUCTION
          SX0    77777B 
          BX7    X2+X7       INSERT THIRD PACKAGE 
          MX6    0
          BX7    X0+X7       INSERT LOW ORDER BITS
          SA6    A2          CLEAR WINA 
  
*         OUTPUT (X7) TO TT.LF, ALSO CALLED FROM *PIG*
*         INITIALIZATION CODE.
  
 WIN5     SA1    TT.LF
          BX6    X3 
          =X0    1
          SA7    ADWT        SAVE INSTRUCTION 
          =A6    A7+1        SAVE (X3)
          ALLOC  A1,X0       EXPAND TT.LF BY 1 WORD 
          SA1    ADWT 
          =A3    A1+1        RESTORE (X3) 
          BX7    X1 
          =A7    B7-1        OUTPUT INSTRUCTION TO TT.LF
          JP     B2          EXIT.. 
  
 WIN6     BX7    X2+X7       ADD NEW PACKAGE
          =X0    1
          IX7    X0+X7       INCREMENT PACKAGE COUNT
          SA7    A2          STORE IN WINA
  
                             *****
 WINX     BSS                * THIS LOCATION USED TO OVERWRITE WIN
                             *****
          JP     B2          EXIT.. 
          LIST   D
          END 
