*COMDECK  COMFWIN - WRITE INSTRUCTIONS TO PREBINARY.
          CTEXT  COMFWIN - WRITE INSTRUCTIONS TO PREBINARY. 
 COMFWIN  SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMFWIN
          BASE   D
 WIN      SPACE  4,8
**        WIN -  WRITE INSTRUCTIONS TO PREBINARY. 
* 
*         ENTRY  (X7) = INSTRUCTION TO TRANSFER 
*                (B2) = EXIT ADDRESS. 
* 
*         EXIT   INSTRUCTION TRANSFERRED TO PREBINARY 
*                (X7) = DESTROYED.
* 
*         USES   A - 1,2,3,6,7
*                X - 0,1,2,6,7
*                B - 2,3,7
*                ------ C A N  N E V E R  D E S T R O Y ------
*         QCG      A0,4,5  X3,4,5  B4,5,6 
*         CCG      A4      X4      B4,5 
  
  
 #RM      IFNE   CP#RM,0
          PURGMAC WRITEO
  
*         REDEFINE WRITEO TO CALL WRITEW UNTIL FA=WTO IS AVAIL. 
  
 WRITEO   MACRO  FET
          SX7    B2 
          SX3    B7 
          LX3    18 
          BX7    X3+X7
          SX3    B6 
          MX1    -18
          BX3    -X1*X3 
          LX3    18+18
          BX7    X3+X7
          SA6    =SWTOA 
          SA7    =SWTOB 
          WRITEW FET,WTOA,1 
          SA3    WTOB 
          SB2    X3 
          AX3    18 
          SB7    X3 
          AX3    18 
          SB6    X3 
 WRITEO   ENDM
 #RM      ENDIF 
  
  
 P.COPY   =      12          DEFINE COPY BIT OF PIK=PS TABLE
  
*         WTE - ENTRY POINT FOR WRITING 60-BIT WORD TO PREBINARY. 
  
 WTE      BSS    0
          SA7    WINB 
          BX6    X3 
          MX7    0
          =A7    A7+1 
          SA6    WINC 
          EQ     WIN100 
  
  
 WIN      BSS    0           ENTRY... 
  
*         DETERMINE IF PSEUDO INSTRUCTION 
  
          BX6    X3 
          SA6    WINC        SAVE X3
          MX0    PB.GHIJL 
          SA7    WINB        SAVE (X7)
  
 .SNAP=W  IFEQ   TEST,ON
          SA3    =XCO.SNAP
          LX3    1RW
          PL     X3,WIN1
          =X6    B2 
          SA6    A7+1        STORE RETURN ADDRESS IN WINB+1 
 W=WIN    SNAP   WINB,,2,NONE,,1E5
 WIN1     BSS    0
 .SNAP=W  ENDIF 
  
          =X6    0
          SA6    A7+1        INITIALIZE WINB + 1 TO ZERO
          BX2    X0*X7
          LX2    PB.GHIJL 
          SB3    X2          (B3) = GHIJ
          AX2    PB.GHL      (X2) = GH
          ZR     X2,PSI      IF A PSEUDO, GO PROCESS IT...
  
*         ADVANCE  *ORG* COUNTER IF NECESSARY 
  
          SA1    X2+=XPIK=PS GET INSTRUCTION SKELETON 
  
*         ENTRY TO ADVANCE ORG/PARCEL AS DETERMINED BY SIZE INDICATOR 
*         (X1) AND TO ISSUE INSTRUCTION.
  
 WIN10    SA2    ORG
          SA3    PARCEL 
          SX6    X3+1 
          PL     X1,WIN40    IF SHORT, PARCEL = PARCEL + 1
          SB7    X3-3 
          ZR     B7,WIN20    IF PARCEL = 3
          SX6    X3+2 
          EQ     WIN40       PARCEL = PARCEL +2 
  
 WIN20    =X6    2
          SA6    A3          PARCEL = 2 
          =X6    X2+1 
          SA6    A2          ORG = ORG + 1
          EQ     WIN100 
  
 WIN40    SB7    X6-4 
          NZ     B7,WIN50    IF PARCEL NE 4 
          =X6    X2+1        ORG = ORG + 1
          SA6    A2 
          =X6    0           PARCEL = 0 
  
 WIN50    SA6    A3 
          SA2    WINA 
          MI     X1,WIN100   IF LONG
  
*         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 
*         T.PB AND CLEAR *WINA*.
  
          LX1    59-P.COPY
          MX0    PB.GHL 
          HX7    PB.GH
          BX6    X0*X7       EXTRACT (X6) = (PB.GH) 
          LX7    PB.GHL+PB.GHP
          MX0    -PB.IL 
          LX6    PB.GHL 
          MI     X1,WIN65    IF *10*, *14* OR *47* INSTRUCTION
  
*         FOR *15*, *16* AND *17* INSTRUCTIONS, INTERCHANGE (J) WITH (K)
  
          SB7    X6-17B 
          GT     B7,WIN70    IF (PB.GH) .GT. 17B
          SB7    X6-15B 
          LT     B7,WIN70    IF (PB.GH) .LT. 15B
          LX0    PB.KP
          BX1    -X0*X7      (X1) = ORIGINAL (K) PORTION
          BX7    X0*X7
          LX0    -PB.KP+PB.JP 
          LX1    -PB.KP+PB.JP      (X1) = NEW (J) 
          BX6    -X0*X7      (X6) = ORIGINAL (J) PORTION
          BX7    X0*X7
          LX6    -PB.JP+PB.KP      (X6) = NEW (K) 
          BX1    X7+X1
          BX7    X1+X6
          EQ     WIN70
  
 WIN65    SB7    X6-10B 
          NZ     B7,WIN60    IF NOT TRANSMIT (10IJX) INSTRUCTION
          MX1    -PB.JL 
          LX0    PB.IP
          LX1    PB.JP
          BX0    -X0*X7      *I* REGISTER 
          BX1    -X1*X7      *J* REGISTER 
          LX0    PB.JP-PB.IP
          IX6    X0-X1
          SA3    PARCEL 
          NZ     X6,WIN60    IF NOT TRANSMIT TO SELF
          SX6    X3-1 
          SA6    PARCEL      THIS INST DOESNT COUNT / PARCEL = PARCEL-1 
          PL     X6,WINX     IF CURRENT WORD NOT NOW COMPLETELY EMPTY 
          SA3    ORG
          SX6    3
          SA6    A6          PARCEL = 3 
          SX6    X3-1 
          SA6    A3          ORG = ORG - 1
          EQ     WINX 
  
*         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. 
  
 WIN60    MX0    -PB.JL 
          NO
          LX0    PB.JP
          NO
          BX1    -X0*X7 
          NO
          LX1    PB.KP-PB.JP
          BX7    X7+X1
  
*         NOW WE MAY PACK IT AND OUTPUT THE PACKAGE TO T.PB IF FULL.
  
 WIN70    =B7    X2-1 
          MI     B7,WIN80    IF NO PACKAGE PRESENT
          LX7    -15         POSITION INSTRUCTION 
          ZR     B7,WIN80    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 
          SA7    WINB        SAVE INSTRUCTION 
          EQ     WINW        OUTPUT SAVED INSTRUCTIONS
  
 WIN80    BX7    X2+X7       ADD NEW PACKAGE
          =X0    1
          IX7    X0+X7       INCREMENT PACKAGE COUNT
          SA7    A2          STORE IN WINA
  
 WINX     SA3    WINC        RESTORE (X3) 
          JP     B2          RETURN.. 
  
*         ENTRY HERE FOR LONG INSTRUCTION OR MOST PSEUDOS.
*         OUTPUT ANY PACKED 15-BIT INSRUCTION THAT ARE WAITING. 
*         OUTPUT CURRENT INSTRUCTION (FROM WINB). FORCE UPPER 
*         IF WINB+1 IS NONZERO. RETURN. 
  
 WIN100   BSS    0           **** TEMP **** 
 WINW     BSS    0           ...WRITE PB
          SA2    WINA 
          SB7    A4          SAVE (A4,X4) 
          BX6    X4 
          SA6    WIND 
          ZR     X2,WINW7    IF NO PACKED SHORT INSTRUCTIONS WAITING
          SA3    WINA 
          MX0    -PB.INSTL
          SX7    B0          INDICATE NO ACCUMULATED SHORT INSTRUCTIONS 
          BX6    -X0+X3      MERGE FLAG WITH PACKED INSTRUCTIONS
          SA7    A2 
          WRITEO =XF.PB      WRITE ONE WORD TO PREBINARY FILE 
 WINW7    SA3    WINB 
          BX6    X3 
          WRITEO F.PB        WRITE ONE WORD (CURRENT INSTRUCTION) 
          SA1    WIND 
          SA4    B7          RESTORE (A4, X4) 
          BX4    X1 
 WINW8    SA1    WINB+1 
          ZR     X1,WINX     IF NO FORCE UPPER AFTER REQUESTED
          SA3    PARCEL 
          SA2    ORG
          ZR     X3,WINX     IF ALREADY UPPER 
          SX6    X2+B1
          MX7    0
          SA6    A2          ADVANCE ORIGIN COUNTER 
          SA7    A3          INDICATE EMPTY WORD
          EQ     WINX 
 PSI      SPACE  4,10 
**        PSI - PROCESS PSEUDO INSTRUCTION. 
* 
*         USED IN CONJUNCTION WITH THE PSEUDO INSTRUCTION JUMP TABLES 
*         AT *WINOC* AND *WINI*.  THE DECISION WHETHER TO FORCE UPPER 
*         BEFORE OR AFTER THE INSTRUCTION IS MADE AT THIS POINT.
* 
*         ENTRY  (X2) = GH  (ALWAYS 0)
*                (X7) = INSTRUCTION 
*                (WINB) = (X7)
*                (B3) = GHIJ
* 
*         EXIT   (X1) .LT. 0, THEN LONG INSTRUCTION 
*                     .GE. 0, THEN SHORT INSTRUCTION
*                (X2) = GH  (SOMETIMES) 
*                (B3) = GHIJ  (USUALLY, BUT NOT ALWAYS) 
*                (WINB) = INSTRUCTION 
*                (WINB+1) = MI IF FORCE UPPER AFTER, ELSE 0 
  
  
 PSI      BSS                ...ENTRY 
  
          IFEQ   TEST,ON,2   IF TEST MODE 
          SB7    Z.PSUD      LENGTH OF PSEUDO TABLE 
          GE     B3,B7,"BLOWUP"    IF ILLEGAL PSUEDO
  
          SA1    PSTAB       (X1) = FWA OF OC$XXX OR I.XXX JUMP TABLE 
          SA3    X1+B3
          SB7    X3          (B7) = ADDRESS OF PSEUDO PROCESSOR 
          JP     B7          EXIT TO PSEUDO PROCESSOR...
  
  
**        PSEUDO INSTRUCTION PROCESSORS.
  
  
 WI=BOS   BSS    0           BOS - BEGINNING OF STATEMENT.
 .CG      IFEQ   .CG,.FAST
          SA2    CO.DBID
          SA3    CO.DBST
          BX2    X2+X3
          ZR     X2,WIN100   IF 5700 TABLE NOT REQUIRED 
          RJ     BNW         BEGIN NEW WORD 
 .CG      ENDIF 
          EQ     WIN100 
  
  
 WO=IDNT  BSS    0           IDENT - BEGIN OBJECT PROGRAM 
          =X6    0
          SA6    =XORG       INIT  ORG  TO  0 
          SA6    =XCBI       INIT  CBI  TO  0 
          SA6    PARCEL 
          SA6    WINA        INIT PACKED 15-BIT INSTRUCTIONS
          EQ     WIN100 
  
  
 WI=LD0   BSS    0           LOAD INSTRUCTION FOR LEVEL 0 
 WI=ST0   BSS    0           STORE INSTRUCTION FOR LEVEL 0
          SA3    PARCEL 
          SA2    ORG
          =X6    X3+1 
          =X1    -1          INDICATE LONG
          EQ     WIN40       COUNT AS SHORT INSTRUCTION 
  
 WO=ADDR  BSS    0           FILE VECTOR POINTER WORD 
 WI=CPL   BSS    0           CPL LIST ITEM
 WO=PLIM  BSS    0           PRINT LIMIT WORD 
 WI=SUBI  BSS    0           SUB INDEX
 WI=SB0I  BSS    0           SUB0 INDEX 
 WI=ZERO  BSS    0           ZERO WORD
 WO=FVEC  BSS    0           FILE POINTER WORD
          MX1    0
          SX2    B1          RESERVE SPACE FOR WORD 
          RJ     DLT         ADVANCE ORIGIN COUNTER 
          EQ     WIN100 
  
  
 WO=TRAC  BSS    0           TRAC - GENERATE TRACEBACK WORDS. 
          SA3    =XS=TRACE
          =X1    X3+K.SYM*K=PFX 
          SX2    1
          RJ     DLT         DEFINE LABEL TAG (TRACE.  BSS 1) 
          SA3    =XS=TA0
          =X1    X3+K.SYM*K=PFX 
          SX2    1
          RJ     DLT         DEFINE LABEL TAG (TEMPA0.  BSS 1)
          EQ     WIN100 
  
  
 WO=CON   BSS                *READ CON TABLE PSEUDO 
          EQ     WIN100 
  
  
 WI=USE   BSS    0           *USE* PSEUDO INSTRUCTION 
 WO=USE   BSS 
          RJ     PUSE        EXCHANGE PARCEL AND ORG (BLEN) COUNTERS
          EQ     WIN100 
  
  
 WI=OTR   BSS    0           OTR INSTRUCTION (6102B)
          SA3    ORG
          SA2    PARCEL 
          =X6    2
          SA6    A2          PARCEL = 2 
          =X6    X3+1 
          ZR     X2,WIN100   IF PARCEL WAS 0
          SA6    A3          ORG = ORG + 1
          EQ     WIN100 
  
 WI=RJ6   BSS    0           RJT INSTRUCTION (0100B)
          SA3    ORG
          =X6    X3+1 
          SA6    WINB+1      FORCE UPPER AFTER
          SA2    WINB        RJ6 INSTRUCTION
          SA6    A3          ORG = ORG + 1
          MX0    -PB.BIASL
          LX2    -PB.BIASP
          BX0    -X0*X2      EXTRACT LINE/SEQUENCE NUMBER 
          SX0    X0-7776B 
          MI     X0,WIN100   IF LINE/SEQUENCE NUMBER .LT. 4095
          =X6    X6+1 
          SA6    A6          INCREMENT ORG COUNTER
          EQ     WIN100 
  
 WI=UJP   BSS    0           EQ INSTRUCTION (0400B) 
 WI=JPI   BSS    0           JP INSTRUCTION (0200B) 
 WI=RJ3   BSS    0           RJ INSTRUCTION (0100B) 
          =X6    -B1
          SA6    WINB+1      SET FLAG TO FORCE UPPER AFTER
          =X1    X6          LONG INSTRUCTION 
          EQ     WIN10
  
 WI=BSS   BSS    0           BSS, BSSZ PSEUDO INSTRUCTION 
 WO=BSS   BSS    0
 WO=BSSZ  BSS 
          BX0    X7 
          RJ     BNW         BEGIN NEW WORD 
          BX3    X0 
          MX0    -PB.TAGL 
          LX3    -PB.TAGP 
          BX1    -X0*X3 
          LX3    PB.TAGP-PB.BIASP 
          MX0    -PB.BIASL
          BX2    -X0*X3 
          RJ     DLT         DEFINE LABEL AND RESERVE BLOCK STORAGE 
          EQ     WIN100 
  
  
 WO=END   BSS    0
          =X7    0           FAKE AN INSTRUCTION TO CALL PUSE 
          RJ     PUSE        STORE PARCEL AND ORG COUNT IN T.LBT
          EQ     WIN100 
  
  
*         THE FOLLOWING PSEUDOS NEED NO PASS 2 PROCESSING.
  
  
 WI=LOO   BSS    0           LOO - TURN ON /OFF OBJECT LISTING
 WO=LOO   BSS    0
 WI=EMI   BSS    0           EMI - END MACHINE INSTRUCTIONS.
 WI=BCI   BSS                BCI - BEGIN CCG TYPE INSTRUCTION 
 WI=ECI   BSS                ECI - END CCG TYPE INSTRUCTION 
 WO=BMI   BSS    0           BMI - BEGIN MACHINE INSTRUCTIONS.
 WO=NLST  BSS                *READ NAMELIST TABLE PSEUDO
 WO=APL   BSS                APLIST 
 WO=IOM   BSS                PROCESS I/O APLISTS
 WO=FMT   BSS                FORMAT 
 WO=EQUN  BSS                NEGATIVE RELOCATION
 WO=LCC   BSS                LOADER CONTROL DIRECTIVES
          EQ     WIN100 
 WI=DATA  BSS    0
          RJ     BNW         FORCE UPPER
          EQ     WIN100 
 PSUD     SPACE  4,10 
 WO=CMNT  BSS    0
*         MANIPULATION. 
  
  
          PURGMAC PSUD,IPSUD
  
 PSUD     MACRO  PSN
          VFD    42/0,18/WO=PSN 
 PSUD     ENDM
  
 IPSUD    MACRO  PSN
          VFD    42/0,18/WI=PSN 
 IPSUD    ENDM
*CALL     COMSPSU            PSEUDO INSTRUCTION JUMP TABLE
 SAVE     SPACE  4,10 
*         WIN SAVE AREA.
  
 PSTAB    CON    0           FWA OF OC$XXX OR I.XXX TABLE 
 WINA     CON    0           STORAGE FOR PACKED 15 BIT INSTRUCTIONS 
 WINB     CON    0           TEMP STORE OF INSTRUCTION
                             ** WINB MUST BE AT WINA+1 ** 
          CON    0           MINUS IF FORCE UPPER AFTER, ELSE 0 
 WINC     CON    0           SAVE OF X3 
 WIND     BSS    1           SAVE OF (X4) 
 BNW      SPACE  4,10 
 .CG      IFEQ   .CG,.FAST
**        BNW - BEGIN NEW WORD. 
* 
*         EXIT   (PARCEL) = 0 
* 
*         USES   X2,X3,A6  X2,X3,X6.
  
  
 BNW      SUBR   0           ENTRY/EXIT...
          SA2    PARCEL 
          SA3    ORG
          ZR     X2,EXIT.    IF ALREADY AT TOP OF WORD
          MX6    0
          SA6    A2          (PARCEL) = 0 
          SX6    X3+B1
          SA6    A3          ADVANCE ORIGIN COUNTER 
          EQ     EXIT.
  
 .CG      ELSE
  
          EXT    FSU#        IN CGTM
 BNW      EQU    FSU# 
 .CG      ENDIF 
 DLT      SPACE  4,10 
**        DLT - DEFINE LABEL TAG. 
* 
*         ENTRY  (X1) = TAG TO DEFINE.
*                (X2) = NUMBER OF WORDS TO RESERVE. 
*                (ORG, CBI) = SET AS DESIRED FOR DEFINITION.
*                (PARCEL)  ALREADY FORCED UPPER.
* 
*         EXIT   (ORG) ADVANCED.
* 
*         CALLS  DPT
* 
*         CANNOT DESTROY  A0,4,5  X4,5  B2,4,5,6
  
  
 DLT      SUBR   0           ENTRY/EXIT...
          SA3    ORG
          IX6    X3+X2       ADVANCE ORIGIN COUNTER 
          SA6    A3 
          ZR     X1,EXIT.    IF NO TAG
          MX0    -PB.ORDL 
          LX1    PB.TAGP-PB.ORDP
          BX6    -X0*X1      ORD[TAG] 
          AX1    -PB.ORDP+PB.PFXP  ISOLATE (X1) = PFX[TAG]
          ERRMI  PB.PFXP-PB.ORDP   CODE ASSUMES [PFX] TO LEFT OF [ORD]
          SA2    CBI
          SB7    X6          (B7) = ORDINAL OF TAG
          LX2    WC.RBP 
          =X6    ML.PROG
          LX3    WC.RAP 
          SB3    X1          (B3) = TAG PREFIX
          LX6    WC.RLP 
          BX2    X2+X3
          BX6    X2+X6       FORM ADDRESS DEFINITION WORD 
          JP     B3+DLTA     PROCESS ACCORDING TO TAG PREFIX
  
 DLTA     BSS    0           TAG TYPE JUMP VECTOR 
          LOC    0
 K=SYM    SA1    =XT.SYM
          EQ     DLT2 
 K=GL     EQ     DLT4 
 K=AP     EQ     "BLOWUP" 
 K=IO     EQ     "BLOWUP" 
 K=LC     EQ     "BLOWUP" 
 K=END    BSS    0           VERIFY VECTOR SYNCHRONIZATION
          LOC    *O 
  
  
 DLT2     BSS                ... TAG IS IN SYMBOL TABLE 
          SX2    B7+B7
          SX0    X2+B7       (X0) = INDEX = L.SYM * SYMORD
          ERRNZ  3-Z=SYM
          =B3    X1+WC.W
          SA2    X0+B3       FETCH SYMTAB ADDRESS WORD
  
 .TEST    IFEQ   TEST,ON
          CLAS=  X3,WC,(RL,RB,RA) 
          BX1    X3*X2
          NZ     X1,"BLOWUP" IF PREVIOUSLY ASSIGNED ADDRESS 
 .TEST    ENDIF 
  
          BX6    X2+X6       SET ADDRESS FIELDS 
          SA6    A2 
          EQ     EXIT.
  
  
 DLT4     BSS                ... TAG IS GENERATED LABEL 
          SB3    B7 
          CALL   DPT         DEFINE PROGRAM TAG 
          EQ     EXIT.
 COMFWIN  SPACE  4,10 
 QUAL$    IF     -DEF,QUAL$,1 
          QUAL   *
 WIN      EQU    /COMFWIN/WIN 
 WTE      EQU    /COMFWIN/WTE 
 PSTAB    EQU    /COMFWIN/PSTAB 
 WINI     EQU    /COMFWIN/IPSUD 
 WINOC    EQU    /COMFWIN/OCPSUD
 QUAL$    ENDIF 
 COMFWIN  ENDX
