*DECK C$ADVAN 
          IDENT  C$ADVAN
          TITLE  C$ADVAN - WRITE ... BEFORE/AFTER ADVANCING PROCESSOR 
          COMMENT WRITE ... BEFORE/AFTER ADVANCING PROCESSOR
          SST 
          B1=1
* 
**        CBADVAN - WRITE ... BEFORE/AFTER ADVANCING PROCESSOR
* 
*         CALLING SEQUENCE
*                SA0  FIT ADDRESS 
*                SX3  RECORD LENGTH 
*                SX1  INTEGER OR MNEMONIC ADVANCING COUNT 
*                SB3  1 FOR MNEMONIC, 0 FOR INTEGER 
*                SB6  RETURN ADDR 
*                EQ  C.WAA (AFTER ADV) OR C.WBA (BEFORE ADV)
* 
*         RETURNS - NOTHING - ALL EXCEPT A0 DESTROYED 
* 
*CALL IOMICROS
*CALL IODEFSC 
 C.WBA    EJECT 
* WRITE BEFORE ADVANCING
* 
          ENTRY  C.WBA
 C.WBA    BSS    0
          RJ     INIT        INITIALIZE 
          SB2    X1          COUNT (IF ANY) LEFT FROM PREV WBA
          SA3    B2+SUPPSP   GET PROPER CONTROL CHARACTER 
          RJ     PRTIL       PRINT THE LINE 
          SA3    MNEMLN      GET MNEMONIC IF ANY
          NZ     X3,WBMNEM   JUMP IF WRITE BEFORE ADV MNEM
          SA3    ADVLNS      GET COUNT OF ADVANCING LINES 
          SX6    X3-4 
          NG     X6,WBA2     JP IF LESS THAN 3 TO SKIP
          SX6    X6+B1       COUNT LEFT FOR WRITING BLANKS
          SA6    A3          RESET LINE COUNT TO NEW VALUE
          RJ     PRINTBL     PRINT BLANK LINES FOR AMOUNT TO ADVANCE
          SX3    3           SAVE 3 FOR NEXT WRITE
 WBA2     BSS    0
          STORE  A0,WBAC=X3,,7,4   SAVE LEFT OVER COUNT FOR NEXT OP 
          EQ     =XC.NORRT   RETURN 
  
 WBMNEM   BSS    0           WRITE BEFORE ADV MNEMONIC
          RJ     WRITEAD     WRITE A BLANK LINE WITH THE MNEMONIC 
          EQ     =XC.NORRT   RETURN 
 C.WAA    EJECT 
*         WRITE AFTER ADVANCING 
* 
          ENTRY  C.WAA
 C.WAA    BSS    0
          RJ     INIT        INITIALIZE 
          SA3    MNEMLN 
          NZ     X3,WAMNEM   JUMP IF WITH MNEMONIC
          SA4    ADVLNS      NUMBER OF LINES TO ADVANCE 
          IX4    X4+X1       ADD ANY LEFT FROM PREVIOUS WBA 
          SX5    X4-4 
          NG     X5,DWAA2    JP IF ADVANCING LESS THAN 3 LINES
          SX6    X5+B1       GIVES COUNT TO ADVANCE WITH BLANKS 
          SA6    A4          RESET COUNT FIELD
          RJ     PRINTBL     PRINT THE BLANKS NEEDED
          SX4    3           GIVE NBR TO USE FOR CAR CTL
 DWAA2    BSS    0
          SB2    X4          COUNT
          SA3    B2+SUPPSP   GET PROPER CONTROL CHAR
          RJ     PRTIL       OUTPUT THE ORIGINAL LINE 
          EQ     =XC.NORRT   RETURN 
  
 WAMNEM   BSS    0           WRITE AFTER ADV MNEMONIC 
          ZR     X1,WAMN1    JP IF LAST OP WAS NOT WBA WITH LEFT LINES
          BX6    X1          HAS LINES LEFT TO PRINT
          SA6    ADVLNS 
          RJ     PRINTBL     PRINT A BLANK LINE FOR LAST WBA
          SA3    MNEMLN 
 WAMN1    BSS    0
          RJ     PRTIL       OUTPUT LINE WITH PAGE EJECT OR MNEM
          EQ     =XC.NORRT   RETURN 
 C.WBAXL  EJECT 
* 
**        C.WAXL - WRITES EXTRA LINE NEEDED BY A PREVIOUS WRITE BEF ADV 
*                THE WBA WAS FOLLOWED BY A WRITE WITHOUT ADVANCING
*                IT IS CALLED FROM CBSQWR 
* 
          ENTRY  C.WBAXL
 C.WBAXL  BSS    0
          FETCH  A0,RECA,X5  GET ADDRESS OF RECORD AREA 
          SA2    X5          GET FIRST WORD OF REC AREA 
          MX6    -6 
          LX2    6
          BX1    -X6*X2      FIRST CHAR 
          SX5    X1-55B 
          ZR     X5,WBAXMN   JP IF FIRST CHAR IS A BLANK
          SB3    B1          FLAG AS MENMONIC 
          EQ     C.WAA       ACT AS IF THIS WAS WRITE AFT ADV MNEMONIC
 WBAXMN   BSS    0
          SB3    B0          NOT MENMONIC 
          SX1    B1          ADVANCING 1 LINE 
          EQ     C.WAA       GO DO REGULAR WRITE AFTER ADVANCING
 PRTIL    EJECT 
*         OUTPUT THE PRINT LINE 
*         X3  HAS CONTROL CHAR IN TOP 
 PRTIL    DATA   0
          SA5    =XC.TRPSP   TRIPLE SPACE FLAG
          ZR     X5,PRTTRP   JP IF TRIPLES OK 
          MX5    6
          BX5    X5*X3       GET SPACE CHAR 
          LX5    6
          SX5    X5-46B 
          NZ     X5,PRTTRP   JP IF NOT A - (TRIPLE SPACE CHAR)
          SA3    SGLX 
          RJ     WRITEAD     WRITE A BLANK LINE 
          SA3    DBLX        CHANGE TO A DOUBLE SPACE 
 PRTTRP   BSS    0
          FETCH  A0,RECA,X2  GET RECORD AREA ADDR 
          SA4    X2          GET FWA OF RECORD
          BX6    X4 
          SA6    =SSAVELN    SAVE FIRST WORD OF LINE
          MX0    6
          FETCH  A0,RWCD,X5  GET RPW CODE FLAG
          PL     X5,PRITLA   JUMP IF NO CODE CLAUSE 
          LX0    48          POSITION AT THIRD CHAR 
          LX3    48 
 PRITLA   BSS    0
          BX4    -X0*X4 
          BX3    X0*X3
          BX7    X4+X3
          SA7    A4          PUT ADVANCING CHAR INTO LINE 
          SA3    RECLEN      GET RECORDLENGTH 
          RJ     DOWRITE     GO WRITE THE REC 
          SA2    SAVELN 
          SA3    SVRECA      ADDR OF RECORD AREA
          BX6    X2 
          SA6    X3          RESTORE FIRST WORD OF LINE 
          EQ     PRTIL
  
*         BLANK LINE WRITER 
 PRINTBL  DATA   0
          SA4    ADVLNS      NUMBER OF BLANK LINES
          ZR     X4,PRINTBL  EXIT IF NONE 
          SA5    =XC.TRPSP   TRIPLE SPACE FLAG
          NZ     X5,PRINTET  JP IF TRIPLE SPACES NOT ALLOWED
          SX3    1S18/3+1    1/3 SHIFTED 18 
          IX6    X3*X4
          AX6    18          NUMBER / 3 
          SA6    =STRIPS     SAVE NBR OF TRIPLE SPACE LINES 
          SX5    3
          IX5    X6*X5
          IX7    X4-X5       NUMBER OF LINES LEFT 
          SA7    A4          SAVE IT
 PRINTTS  BSS    0           PRINT TRIPLE SPACED LINES
          SA2    TRIPS       NUMBER 
          ZR     X2,PRINTET  JUMP IF NONE LEFT
          SX6    X2-1        DEC COUNT
          SA6    A2 
          SA3    TRPLX       GET TRIPLE SPACE LINE
          RJ     WRITEAD     PRINT THE LINE 
          EQ     PRINTTS
 PRINTET  BSS    0
          SA2    ADVLNS      NUMBER OF LINES LEFT 
          LX2    59          DIVIDE BY 2
          BX6    X2          SINGLE FLAG
          SA6    A2          SAVE IT
          SX7    X2          DOUBLE SPACE LINES 
          SA7    =SDBLS      SAVE 
 PRINTDS  BSS    0           PRINT DOUBLE SPACED LINES
          SA2    DBLS        COUNT
          ZR     X2,PRINTED  EXIT IF NONE 
          SX6    X2-1        DEC COUNT
          SA6    A2 
          SA3    DBLX        DOUBLE SPACE LINE
          RJ     WRITEAD     WRITE IT 
          EQ     PRINTDS
 PRINTED  BSS    0
          SA2    ADVLNS      COUNT
          PL     X2,PRINTBL  EXIT IF NO SINGLE NEEDED 
          SA3    SGLX        SINGLE SPACE LINE
          RJ     WRITEAD     WRITE IT 
          EQ     PRINTBL     RETURN 
          SPACE  2
*         WRITEAD - WRITE ADVANCING LINE
* 
*         INPUT IS LINE IN X3 
* 
*         ALL REGS EXCEPT A0 AND B1 CLOBBERED 
* 
 WRITEAD  DATA 0
          BX7    X3 
          FETCH  A0,RWCD,X5  GET RPW CODE FLAG
          PL     X5,WRITEA1  JUMP IF CODE CLAUSE NOT SPECIFIED
          LX3    48          POSITION AT THIRD CHAR 
          SA2    RPTCTL      GET CONTROL CHARS
          MX5    12 
          BX5    -X5*X3      GET CARRIAGE CONTROL CHAR
          BX7    X5+X2       PUT THEM INTO DATA 
 WRITEA1  BSS    0
          SA1    ADVLNB      GET ADDR OF ADVANCING LINE BUFFER
          SA7    X1          PUT ADV CHAR IN BUFFER 
          STORE  A0,RECA=X1 
          SX3    3           SET TO WRITE 3 CHARS 
          RJ     DOWRITE     WRITE THE LINE 
          SA2    SVRECA      GET ORIG REC AREA
          STORE  A0,RECA=X2  RESTORE POINTER
          EQ     WRITEAD     EXIT 
          SPACE  3
* 
*         INIT - INITIALIZE STUFF AND SET LINE NUMBER IN WRITE
*                RETURNS WBAF LEFT JUST IN X1 
 INIT     DATA   0
          RJ     =XC.SVRTN   SAVE  RETURN 
          BX7    X3          RECORD LENGTH
          SA7    =SRECLEN    SAVE RECORD LENGTH 
          SX7    X1 
          SA7    ADVLNS 
          MX7    0
          SA2    B6-B1       GET WORD WITH LINE NUMBER
          SA4    DOWRIN      INSTRUCTION
          MX5    30 
          BX2    -X5*X2      LINE NBR 
          BX4    X5*X4
          BX6    X4+X2       NEW INST 
          SA6    A4 
          ZR     B3,NOTMN    JUMP IF NOT MNEMONIC 
          SA3    DBLX        DOUBLE SPACE LINE WITH BLANKS
          MX5    6
          LX1    54          POSITION ADVANCING MNEMONIC
          BX7    -X5*X3      MASK OFF TOP CHAR LEAVING SPACES 
          BX7    X1+X7       PUT ADVANCING MNEMONIC IN
 NOTMN    SA7    MNEMLN      SET FLAG 
          FETCH  A0,RT,X5    GET RECORD TYPE
          SX5    X5-#FT#
          NZ     X5,INITMSP  JP IF NOT FIXED LENGTH RECORDS 
*      IF FIXED LENGTH RECORDS MUST HAVE BUFFER MRL LONG W/SPACES 
*      IF NOT FIXED LENGTH ONLY WRITES PART OF A WORD 
          SA1    ADVLNB      ADDR OF ADVANCING LINE BUFFER
          FETCH  A0,MRL,X6   GET MAX REC LENGTH 
          SA5    =XC.TNTH    1/10 * 2**24 
          SX6    X6+9        ROUND UP 
          IX6    X6*X5
          AX6    24          MAX REC LENGTH IN WORDS
          SA6    =STMRLWD 
          LX1    30          SIZE OF BUFF IN WORDS
          SX7    X1 
          LX1    30 
          IX7    X7-X6       LENGTH OF BUFF - MRL 
          PL     X7,INITMSP  JP IF ENOUGH ROOM IN BUFFER
          SX7    X1-LADVLNB  SEE IF LOCAL BUFFER (ONLY 1 WORD)
          ZR     X7,INITLB   JP IF IT IS (CANNOT RETURN IT) 
          SB7    A1          ADVLNB - BUFFER POINTER WORD 
          RJ     =XC.FREBK   FREE OLD BUFFER
 INITLB   BSS    0
          SA1    TMRLWD      GET MAX REC LEN
          SB5    ADVLNB      BUFFER POINTER WORD
          SB7    B0          NO GROWING 
          SB6    X1          SIZE 
          RJ     =XC.GETBK   GET A BUFFER 
          SA1    ADVLNB      GET BUFFER POINTER WORD
          SA2    SGLX 
          SB2    X1          ADDR OF BUFFER 
          AX1    30 
          SB3    X1          SIZE OF BUFFER 
          BX6    X2          WORD OF SPACES 
 INITLP1  BSS    0           FILL BUFFER WITH SPACES
          SB3    B3-B1
          SA6    B2+B3
          NZ     B3,INITLP1 
 INITMSP  BSS    0
          FETCH  A0,RECA,X6 
          SA6    =SSVRECA    SAVE ORIG REC AREA ADDR
          SA2    X6 
          MX3    12 
          BX6    X3*X2
          SA6    =SRPTCTL    SAVE REPORT WRITER CONTROL CHARS IF ANY
          FETCH  A0,WBAC,X1  GET COUNT LEFT FROM LAST WBA OP (IF ANY) 
          STORE  A0,WBAC=0   CLEAR IT 
          EQ     INIT        EXIT 
 DOWRITE  SPACE  3
*      CALL NORMAL SEQUENTIAL WRITE ROUTINE 
* 
 DOWRITE  DATA   0
          SB6    DOWREX      EXIT (NEEDED FOR LINE NUMBER TRACE)
          MX4    0           NO INVALID KEY 
 DOWRIN   EQ     =XC.WRISQ   CALL SEQUENTIAL WRITE ROUTINE
 DOWREX   BSS    0
          EQ     DOWRITE
 LINECT   DATA   0
 MNEMLN   DATA   0
 ADVLNS   DATA   0
 ADVLNB   VFD    30/1,12/0,18/LADVLNB   BUFFER POINTER WORD 
 LADVLNB  BSS    1           LOCAL BUFFER 
*      THE FOLLOWING (SUPPSP, SGLX, DBLX, TRPLX) MUST REMAIN IN ORDER 
 SUPPSP   DIS    1,+
 SGLX     DIS    1, 
 DBLX     DIS    1,0
 TRPLX    DIS    1,-
 PJXT     DIS    1,1
          END 
