* 08/02/76 -- 15:00
* MODULE NAME: PRNTSM
* NUMBER: 37
* PURPOSE: PRINTOUT SERVICE ROUTINES
*
* ENTRY POINTS:
*
         DEF      S37OUTLN          PRINT ONE OUTPUT LINE
         DEF      S37PRNT           PRINT GROUP OF OUTPUT LINES
         DEF      S37PGEND,S37TOP   BOTTOM, TOP OF PAGE
         DEF      S37SKLNS          SKIP OUTPUT LINES
         DEF      E37SKIP           'T+' COMMAND ON OUTPUT
         DEF      E37STKT,E37EKT    START, END KEEP-TOGETHER  'T(','T)'
         DEF      S37SAVKT          SAVE KEEP-TOGETHER LINES
         DEF      E37BLANK          'T*' COMMAND ON OUTPUT
         DEF      E37TAG            TAG COMMAND ON OUTPUT
         DEF      E37TK             PHRASE KEEP-TOGETHER
         DEF      C37LP             LINE PRINTER TO QUEUE
         DEF      S37LP             LINE PRINTER SERVICE ROUTINE
         DEF      E37TS             TEMPORARY SPACING
         DEF      PHKTFLG           PHRASE KEEP-TOGETHER FLAG
*
         REF      S27RCPY,S27WCPY,S27CCPY  READ,WRITE,CLOSE COPY FILE
         REF      S27LPRNT          PRINT OUTPUT LINES
         REF      S08PGEND,S08SCMD  HANDLE END-OF-PAGE,SYSTEM COMMANDS
         REF      S09RDATN          READ ATTN-ATTN RESPONSE
         REF      S09SAVHF          SAVE H/F LINES
         REF      S09RDKEY,S09RDNXT READ INPUT LINES
         REF      S36LP             FORCE LINE PRINTER TO QUEUE
         REF      S38INS1           INSERT PHRASE IN SCAN LINE
         REF      S39TLNS,S39NBLNS,S39BLNS  TOP,BOTTOM LINES
         REF      S39SAVBL          SAVE BLOCK LINES
         REF      S27PRINT          PRINT OUTPUT LINES
         REF      ZRORTNST          RESET RETURN STACK AND START OVER
         REF      S40PRINT          XGP OUTPUT ROUTINE
         REF      S42TOP            SAVE NEW PRINTOUT PAGE
         REF      S42WRPRN          SAVE PRINTOUT LINES
         REF      BOXFLG
         REF      PTABSLN           PARAGRAPH INDICATOR
         REF      FILEFLG           FILE OUTPUT FLAG
         REF      3010FWD           3010 FORWARD ONLY FLAG
         REF      BATCHFLG          BATCH MODE FLAG
         REF      TEMPW             TEMPORARY WIDTH WORD
         PAGE
*
*
         SYSTEM   TEXTDEF
         SYSTEM   ITEMDEF
            INVCMDSTA
            INVPRSTA
            INVLNSTA
            INVWSSTA
*
*
*
         DEF      37P,37D,37END
37P      EQU      %
         DATA     X'37'             MODULE NUMBER
         DATA     X'080276'         DATE
         DATA     X'1500'           TIME
*
*
         TITLE    '** PRNTSM(37) **'
*
*
* S37PGEND -- BOTTOM OF PAGE
*
S37PGEND EQU      %
         SAVRTN
*
         JLZ,D1   PR:FMTFLG,RTNPGEND  TEST FOR 'AS-ENTERED'
         JLEZ,AC1 PR:RLNS,TSTBSKP   TEST REMAINING LINES ON PAGE
         BAL,SRTN S37SKLNS              >0, SKIP TO BOTTOM
TSTBSKP  EQU      %
         JEZ,AC1  PR:BSKP,TSTBLNS   TEST BOTTOM-SKIP COUNTER
         GET,D1   PR:RLNS           GET REMAINING LINES
         AW,D1    AC1               ADD SKIP SIZE
         PUT,D1   PR:RLNS           STORE IN REMAINING LINES
         BAL,SRTN S37SKLNS              >0, SKIP LINES
*
TSTBLNS  EQU      %
         BAL,SRTN S39BLNS           PRINT BOTTOM-SAVE LINES
*
RTNPGEND EQU      %                 RETURN
         RETURN
*
*
         PAGE
*
* S37TOP -- TOP OF PAGE
*
S37TOP   EQU      %
         SAVRTN
*
         LI,D1    1
         PUT,D1   PR:TOPFLG         SET TOP-OF-PAGE FLAG
         BAL,SRTN S42TOP            INITIALIZE LINE-SAVING ROUTINE
         GET,D1   PR:PGNUM          GET PAGE NUMBER
         AI,D1    1                 INCREMENT BY 1
         PUT,D1   PR:PGNUM          STORE NEW PAGE NUMBER
         LW,D1    L(#ZROKEY)        SET FIRST PRINT KEY
         PUT,D1   PR:OUTKEY
*
         GET,D2   #DEPTH            GET PAGE DEPTH
         JLZ,D1   PR:FMTFLG,UNFRTN TEST A-E FLAG
         GET,D1   PR:HLNS           #OF HEADING LINES
         CW,D2    D1                TEST FOR ENOUGH ROOM
         BG       GETFLNS              YES, GET FOOTING LINES
         DEPZ,D1  PR:HLNS              NO, SET HEADING OFF
*
GETFLNS  EQU      %
         STW,D1   TMPLNS            SAVE HEADING LINES
         GET,D1   PR:FLNS           GET FOOTING LINES
         AW,D1    TMPLNS            ADD HEADING LINES
         CW,D2    D1                TEST FOR ROOM
         BG       TSTTSKP              YES, TEST TOP-SKIP
         DEPZ,D1  PR:FLNS              NO, TURN FOOTING OFF
         LW,D1    TMPLNS            GET HEADING ONLY
*
*
         PAGE
*
*
TSTTSKP  EQU      %
         SW,D2    D1                GET REMAINING LINES
         PUT,D2   PR:RLNS           STORE
         GET,AC1  PR:TSKP           GET TOP-SKIP LINES
         CW,AC1   D2                TEST FOR ROOM
         BGE      SKIPALL              NO, SKIP PAGE
         BAL,SRTN S37SKLNS          TOP-SKIP LINES
         BAL,SRTN S39TLNS           PRINT TOP-SAVE LINES
*
TSTNBSKP EQU      %
         GET,D1   PR:NBSKP          GET BOTTOM-SKIP LINES
         STW,D1   TMPLNS            ADD TO TOP-SKIP LINES
         PUT,D1   PR:BSKP           SET BOTTOM-SKIP FLAG
*
SETRLNS  EQU      %
         GET,AC1  PR:RLNS           GET REMAINING LINES
         SW,AC1   TMPLNS            SUBTRACT REM. LINES
         BLEZ     SKIPALL              ZERO, SKIP PAGE
         PUT,AC1  PR:RLNS              >0, SET REM. LINES
         BAL,SRTN S39NBLNS          TEST NEXT-BOTTOM LINES
         B        RTNTOP            RETURN
*
*
         PAGE
*
*
SKIPALL  EQU      %
         GET,AC1  PR:RLNS           GET REMAINING LINES
         BAL,SRTN S37SKLNS          SKIP LINE
         LI,D1    0                 RESET:
         PUT,D1   PR:BSKP              BOTTOM-SKIP
*
RTNTOP   EQU      %
         LI,D1    0                 RESET:
         PUT,D1   PR:TSKP              TOP-SKIP
         PUT,D1   PR:NBSKP             NEXT-PAGE BOTTOM SKIP
         RETURN
*
UNFRTN   EQU      %
         PUT,D2   PR:RLNS           STORE REMAINING LINES
         RETURN
*
*
         PAGE
*
* E37SKIP -- SKIP OUTPUT LINES
*
*
E37SKIP  EQU      %
         SAVRTN
*
         JNEZ,D1  PR:TBLMODE,RTNSKIP  TEST FOR TABLE MODE
         BAL,SRTN S08SCMD           INITIALIZE FOR FORMATTING COMMAND
         JLEZ,AC1 (#DSHW,:K(1)),RTNSKIP  GET NUMBER OF SKIP LINES
         GET,AC2  PR:SPACE          GET SPACING FLAG
         MW,AC2   AC1               MULTIPLY BY # OF SKIP LINES
         LW,AC1   AC2
         STW,AC1  NSKPLNS           SAVE NUMBER OF SKIP LINES
*
         JNEZ,D1  PR:HFSAV,SKIP     TEST H/F SAVE FLAG
         JNEZ,D1  PR:KTFLG,SKIP     TEST K-T FLAG
         JNEZ,D1  PR:BLKFLG,SKIP    TEST BLOCK SAVE FLAG
*
         CI,AC1   98                TEST FOR PAGE EJECT
         BLE      GPRLNS               NO, GET REMAINING LINES COUNT
         LI,D1    -1                SAY THAT BOX-DRAWING SOULD BE
         STB,D1   BOXFLG            CANCELED AFTER THIS SKIP.
         JNEZ,D1  PR:TOPFLG,RTNSKIP TEST FOR ALREADY AT TOP-OF-PAGE
         B        PGSKP                NO, SKIP TO END-OF-PAGE
*
GPRLNS   EQU      %
*
*
         PAGE
*
*
GETSKFLG EQU      %
         LI,X3    5                 FIVE FLAGS TO CHECK
SKPFLGVP JNEZ,X1  (#FLAGS,X3),SKPKILLBOX   CANCEL BOX-DRAWING
         BDR,X3   SKPFLGVP          IF THIS IS T+(N);...
CHKSKFLG LI,X3    +5                FIVE FLAGS TO CHECK
         GET,D1   PR:RLNS           GET REMAINING LINES COUNT.
SKPFLGLP EQU      %
         JNEZ,X1  (#FLAGS,X3),(SKPBRTBL,X3) TEST COMMAND FLAG
         BDR,X3   SKPFLGLP              NOT SET, TEST NEXT
*
SKPBRTBL EQU      %
         B        SKIPNOW           NO FLAGS SET
         B        UNCSKFLG          'UNC' FLAG
         B        TOPSKFLG          'TOP' FLAG
         B        BOTSKFLG          'BOT' FLAG
         B        ANYSKFLG          'ANY' FLAG
         B        NOWSKFLG          'NOW' FLAG
*
*
SKPKILLBOX   LI,D1   -1             SAY THAT BOX-DRAWING SHOULD BE
         STB,D1   BOXFLG            CANCELED AFTER THIS SKIP.
         B        CHKSKFLG
         PAGE
*
*
UNCSKFLG EQU      %                 'UNC' FLAG SET
         CW,AC1   D1                COMPARE SKIP TO REMAINING LINES
         BLE      SKIPNOW               <=, SKIP NOW
         GET,D2   PR:TSKP               >, GET TOP-SKIP COUNTER
         AW,D2    AC1               ADD NUMBER OF SKIP LINES
         PUT,D2   PR:TSKP           STORE IN TOP-SKIP COUNTER
         B        PGSKP             NOW GO TO BOTTOM-OF-PAGE
*
TOPSKFLG EQU      %                 'TOP' FLAG SET
         JNEZ,D2  PR:TOPFLG,SKIPNOW TEST TOP-OF-PAGE FLAG- IF SET, SKIP
SETTSKP  EQU      %                     NOT SET, SET TOP-SKIP COUNTER
         GET,D2   PR:TSKP           GET TOP-SKIP COUNTER
         AW,D2    AC1               ADD SKIP LINES
         PUT,D2   PR:TSKP           STORE IN TOP-SKIP COUNTER
         B        RTNSKIP           RETURN
*
*
         PAGE
*
*
BOTSKFLG EQU      %                 'BOT' FLAG SET
         CW,AC1   D1                COMPARE SKIP TO REMAINING LINES
         BLE      SETBSKP               <=, GO SET BOTTOM-SKIP COUNTER
         GET,D2   PR:NBSKP              >, GET NEXT-PAGE BOTTOM-SKIP
         AW,D2    AC1               ADD SKIP LINES
         PUT,D2   PR:NBSKP          STORE NEXT-PAGE BOTTOM SKIP
         B        RTNSKIP           RETURN
*
SETBSKP  EQU      %                 SET BOTTOM-SKIP COUNTER
         SW,D1    AC1               CALC. REMAINING LINES
         BEZ      PGSKP                ZERO, EJECT PAGE
         PUT,D1   PR:RLNS              >0, STORE REMAINING LINES
         GET,D2   PR:BSKP           GET COUNTER
         AW,D2    AC1               ADD SKIP LINES
         PUT,D2   PR:BSKP           STORE BOTTOM-SKIP COUNTER
         B        RTNSKIP
*
ANYSKFLG EQU      %                 'ANY' FLAG SET
         JNEZ,D2  PR:TOPFLG,SKIPNOW  TEST TOP-OF-PAGE FLAG
         CW,AC1   D1                COMPARE SKIP TO REMAINING LINES
         BLE      SETBSKP               <=, SET BOTTOM-SKIP COUNTER
         B        SETTSKP               >, SET TOP-SKIP COUNTER
*
*
         PAGE
*
*
NOWSKFLG EQU      %                 'NOW' FLAG SET
         CW,AC1   D1                COMPARE SKIP TO REMAINING LINES
         BLE      SKIPNOW               <=, SKIP NOW
         SW,AC1   D1                    >, SUBTRACT REMAINING LINES
         GET,D2   PR:TSKP           GET TOP-SKIP COUNTER
         AW,D2    AC1               ADD SKIP LINES
         PUT,D2   PR:TSKP           STORE IN TOP-SKIP COUNTER
*
PGSKP    EQU      %                 SKIP TO BOTTOM-OF-PAGE
         BAL,SRTN S08PGEND          GO TO END-OF-PAGE
         B        RTNSKIP           RETURN
*
SKIPNOW  EQU      %
         SW,D1    AC1               SUBTRACT SKIP COUNT FROM REMAING LNS
         BLEZ     PGSKP                <=0, EJECT PAGE
SKIP     EQU      %
         BAL,SRTN S37SKLNS          SKIP LINES
*
RTNSKIP  EQU      %                 RETURN
         RETURN
*
*
         PAGE
*
* E37TAG -- TAG FOUND
*
*
E37TAG   EQU      %
         SAVRTN
*
         GET,AC1  #NCCS,:K(2)       GET SIZE OF TAG
         GET,X1   #CS,:K(2)         GET BYTE ADDR OF TAG
         LW,BUF1  X1
         LI,D1    #CR               GET A CR CHAR
         AW,X1    AC1               GET ADDR OF END OF TAG
         STB,D1   0,X1              STORE CR AS LAST CHAR OF TAG
         AI,AC1   1                 INCR SIZE FOR CR
         BAL,SRTN S38INS1           INSERT TAG IN PRINT LINE
         RETURN
*
*
         PAGE
*
* S37PRNT -- PRINT RANGE OF LINES IN PRINT FILE
*
* ENTRY PARAMETERS:
*        AC1 = FIRST KEY TO PRINT
*        AC2 = LAST KEY TO PRINT
*
S37PRNT  EQU      %
         SAVRTN
*
         LCI      2                 SAVE RANGE OF KEYS TO PRINT
         STM,AC1  RN1
         LW,AC2   RN1               GET FIRST PRINT KEY
         CW,AC2   RN2               TEST FOR NO LINES
         BG       RTNPRNT              NONE, RETURN
*
RDPRLP   EQU      %
         LI,BUF2  BA(STDINBUF)      GET ADDR OF BUFFER
         LI,AC1   #STDBUFSZ         GET MAX SIZE
         BAL,SRTN S27RCPY           READ PRINT LINE
         STW,AC2  RN1               SAVE KEY
         BAL,SRTN S37OUTLN          NOW GO PRINT OUTPUT LINE
*
         LI,AC2   0                 SET KEY FOR READ NEXT
         LW,AC1   RN1               GET PREVIOUS PRINT KEY
         CW,AC1   RN2               COMPARE WITH LAST IN RANGE
         BL       RDPRLP                LESS, GET NEXT
*
RTNPRNT  EQU      %
         RETURN                         EQUAL, RETURN
*
*
         PAGE
*
* S37OUTLN -- PRINT OUTPUT LINE ON TERMINAL (PR:LPFLG=0)
*                            OR ON LINE PRINTER (PR:LPFLG=1)
* ENTRY PARAMETERS:
*        BUF2 = BYTE ADDR OF OUTPUT LINE
*        AC1  = SIZE OF OUTPUT LINE
*        AC3 = FORMAT CODE FOR THIS OUTPUT LINE
*
*        BYTE 0 OF OUTPUT LINE = NUMBER OF ACTUAL PRINT LINES
*        BYTE 1 OF OUTPUT LINE = NUMBER OF STOP CODES IN THIS LINE
*
S37OUTLN EQU      %
         SAVRTN
*
         STW,AC3  FCODE             SAVE FORMATTING CODE FOR THIS LINE
         LB,AC2   0,BUF2            GET LINE COUNT FOR THIS LINE
         SLS,AC2  24                CONVERT TO +
         SAS,AC2  -24
         LAW,AC2  AC2
         STW,AC2  SKPCOUNT          SAVE LINE SKIP COUNT
         LW,X1    BUF2              GET BUFFER ADDR
         AI,BUF2  1                 'NCREMENT POINTER
         LI,AC2   0                 INITIALIZE LAST CHAR
         STW,AC2  STOPCNT
         AI,AC1   -2                DECREMENT SIZE FOR CONTROL BYTES
         BLEZ     BRLPTRM               SKIP ONLY, GO TEST LP BRANCH
*
         LB,AC2   0,BUF2            GET STOP CODE COUNT
         STW,AC2  STOPCNT           SAVE STOP CODE COUNT
         LW,X1    BUF2              GET CURRENT POINTER
         AI,BUF2  1                 INCREMENT TO ACTUAL FIRST CHAR
         AW,X1    AC1               CALC ADDR OF LAST CHAR
         LB,AC2   0,X1              GET LAST CHAR
*
BRLPTRM  EQU      %
         STW,BUF2 LNSTART           SAVE ADDR OF FIRST CHAR
         STW,AC1  LNSZ              SAVE LINE SIZE
         JNEZ,D1  PR:LPFLG,LPPRNT   TEST LP FLAG: IF SET, GO SCAN FOR LP
         PAGE
*
*
TERMPRNT EQU      %
         CI,AC2   #CR               TEST FOR CR ON END OF LINE
         BNE      TSTSTOP               NO, ADD CR'S FOR SKIP COUNT
         MTW,-1   SKPCOUNT              YES, DECREMENT SKIPS FOR THIS CR
*
TSTSTOP  EQU      %
         MTW,0    LNSZ              TEST LINE SIZE
         BLEZ     SKTRMLNS             ZERO, GO SKIP LINES
         MTW,0    FILEFLG           TEST FOR FILE OUTPUT
         BNEZ     PRTERMLN          YES, SKIP STOP CODE PROCESSING
         MTW,-1   STOPCNT           DECREMENT STOP COUNT
         BLZ      PRTERMLN              ZERO, GO PRINT LINE
         LW,X1    LNSTART               NON-ZERO, SET POINTER AT START
         LI,AC2   #STOP             GET STOP CHAR FOR COMPARE
*
TSTSTPLP EQU      %
         MTW,-1   LNSZ              DECREMENT LINE SIZE
         BLEZ     SKTRMLNS             ZERO, SKIP LINES
         CB,AC2   0,X1              TEST FOR STOP CHAR
         BE       PRNTSTOP              YES, PRINT UP TO STOP
         AI,X1    1                     NO, INCREMENT POINTER
         B        TSTSTPLP          TEST NEXT CHARACTER
*
PRNTSTOP EQU      %
         LW,BUF1  LNSTART           GET ADDR OF LINE START
         LI,AC1   0                 REPLACE STOP CODE
         STB,AC1  0,X1                   WITH NULL
         AI,X1    1                 POINT PAST STOP CODE
         LW,AC1   X1                GET ADDR OF STOP
         SW,AC1   LNSTART           CALC SIZE TO STOP
         STW,X1   LNSTART           SAVE NEW LINE START
*
         LI,AC2   0                 SET TERMINAL FLAG
         LW,AC3   FCODE             GET FORMATTING CODE
         MTW,1    3010FWD           SET 3010 FORWARD ONLY FLAG
         BAL,SRTN S40PRINT          PRINT OUTPUT LINE
         MTW,1    3010FWD
         BAL,SRTN S09RDATN          GET RESPONSE TO STOP
         CI,SR3   #CR               TEST FOR CR RESPONSE
         BE       RTNOUTLN              YES, END-OF-LINE
         B        TSTSTOP               NO, TEST NEXT STOP
*
*
         PAGE
*
*
PRTERMLN EQU      %
         LW,BUF1  LNSTART           GET ADDR OF LINE START
         LW,AC1   LNSZ              GET SIZE LINE
         LI,AC2   0                 SET TERMINAL FLAG
         LW,AC3   FCODE             GET FORMATTING CODE
         BAL,SRTN S40PRINT          PRINT OUTPUT LINE
*
SKTRMLNS EQU      %
         LI,AC2   #CR               GET CR CHAR
         STB,AC2  MSGBUF            STORE IN BUFFER
         LI,BUF1  BA(MSGBUF)        GET ADDR OF BUFFER
*
SKLNSLP  EQU      %
         MTW,-1   SKPCOUNT          DECR SKIP COUNT
         BLZ      RTNOUTLN             ZERO, RETURN
         LI,AC1   1                 SET PRINT SIZE TO 1
         LI,AC2   0                 SET TERMINAL FLAG
         LW,AC3   FCODE             GET FORMATTING CODE
         BAL,SRTN S40PRINT          PRINT OUTPUT LINE
         B        SKLNSLP           SKIP NEXT
*
*
         PAGE
*
*
LPPRNT   EQU      %
         CI,AC1   0                 TEST FOR SKIP ONLY
         BLE      SKPONLY               YES, GO SKIP LP LINES
         LW,BUF1  LNSTART           ADDR OF OUTPUT LINE
         LW,AC1   LNSZ              GET SIZE
CALLPRNT EQU      %
         LI,AC2   1                 INITIALIZE LP OUTPUT
         JEZ,D1   PR:VFLG,PRNTLN    TEST VIDEO FLAG
         LI,AC2   2                    SET, SET XGP FLAG
*
PRNTLN   EQU      %
         LW,AC3   FCODE             GET FORMATTING CODE
         BAL,SRTN S40PRINT          PRINT OUTPUT LINE
         MTW,-1   SKPCOUNT          DECREMENT SKIP COUNT
         BLEZ     RTNOUTLN              ZERO, RETURN
*
SKPONLY  EQU      %
         LI,BUF1  BA(MSGBUF)        SET UP BLANK LINE
         LI,AC2   #BLANK
         STB,AC2  0,BUF1
         LI,AC1   1                 SET LINE SIZE TO ONE
         B        CALLPRNT          PRINT LINE
*
RTNOUTLN EQU      %                 RETURN
         RETURN
         PAGE
*
* S37SKLNS -- SKIP OUTPUT LINES
*
*
S37SKLNS EQU      %
         SAVRTN
*
         CI,AC1   0                 TEST FOR NO SKIP LINES
         BLEZ     RTNSKLNS             0, RETURN
         STW,AC1  NSKPLNS           SAVE # OF SKIP LINES
         LI,BUF3  BA(STDINBUF)      GET ADDR OF BUFFER FOR SKIPS
         STB,AC1  0,BUF3            STORE SKIP COUNT IN FIRST BYTE
         LI,AC1   1                 SET SIZE TO 1 (SKIP ONLY)
         JEZ,X1   PR:HFSAV,TSTKTSKP TEST HEADING/FOOTING SAVE FLAG
         BAL,SRTN S09SAVHF              SET, SAVE H/F LINE
         B        RTNSKLNS          RETURN
*
TSTKTSKP EQU      %
         JEZ,D1   PR:KTFLG,TSTBLSKP TEST KEEP-TOGETHER FLAG
         BAL,SRTN S37SAVKT              SET, SAVE KT LINE
         B        RTNSKLNS          RETURN
*
TSTBLSKP EQU      %
         JEZ,D1   PR:BLKFLG,SKLNS   TEST BLOCK FLAG
         BAL,SRTN S39SAVBL              SET, SAVE BLOCK LINE
         B        RTNSKLNS          RETURN
*
*
         PAGE
*
*
SKLNS    EQU      %
         GET,D1   PR:RLNS           GET REMAINING LINES
         SW,D1    NSKPLNS           SUBTRACT SKIP COUNT
         PUT,D1   PR:RLNS           STORE REMAINING LINES
*
         JLZ,D1   PR:LPFLG,RTNSKLNS TEST LP FLAG FOR INDEXING
         LI,D1    1                 SET FORMATTING CODE TO 1
         BAL,SRTN S42WRPRN          SAVE PRINTOUT LINE
*
RTNSKLNS EQU      %
         RETURN
*
*
         PAGE
*
* E37STKT -- START KEEP TOGETHER
*
*
E37STKT  EQU      %
         SAVRTN
*
         BAL,SRTN S08SCMD           NEW SYSTEM COMMAND
         JEZ,D1   PR:SPFLG,TSTKTFLG  TEST FOR SPACING
         PUT,D1   PR:SPACE          SET, RESTORE SPACE FLAG
         DEPZ,D1  PR:SPFLG          RESET SPACING K-T FLAG
TSTKTFLG EQU      %
         JNEZ,D1  PR:KTFLG,ENDKT    TEST FOR PREVIOUS K-T
         JNEZ,D1  PR:BLKFLG,RTNSTKT  TEST FOR PREVIOUS BLOCK CALLOUT
         LI,X1    3                     NOT SET, CHECK SPACING FLAGS
TSTSPFLG EQU      %
         JNEZ,D1  (#FLAGS,X1),SETSPFLG  TEST 'S','D','T' FLAGS
         BDR,X1   TSTSPFLG          TEST NEXT
         B        SETKTFLG          NOW SET KEEP-TOGETHER FLAG
*
*
         PAGE
*
*
SETSPFLG EQU      %
         GET,D2   PR:SPACE          GET CURRENT SPACING SIZE
         PUT,D2   PR:SPFLG          SET K-T SPACING FLAG
         PUT,X1   PR:SPACE          SET NEW SPACING SIZE
         JNEZ,D1  (#FLAGS,:K(4)),RTNSTKT  TEST NO KEEP-TOGETHER FLAG
*
SETKTFLG EQU      %
         JNEZ,D1  PR:TOPFLG,RTNSTKT TEST FOR TOP-OF-PAGE
         LI,D1    1                 SET KEEP-TOGETHER FLAG
         PUT,D1   PR:KTFLG
         LI,D1    0                 INITIALIZE KEEP-TOGETHER
         STW,D1   KTCNT                 LINE COUNT
         GET,D1   LN:CKEY           GET CURRENT INPUT LINE KEY
         STW,D1   KTCKEY            SAVE KEY
*
         GET,D1   PR:FMTFLG         SAVE FORMAT FLAG
         STW,D1   KTFMTFLG
         GET,D1   PR:CTRFLG         SAVE CENTERING FLAG
         STW,D1   KTCTRFLG
         GET,D1   LN:MXPSTN         GET MAX CARRIER POSITION
         STW,D1   KTMXPSTN          SAVE
         GET,D1   #WIDTH            GET WIDTH
         STW,D1   KTWIDTH           SAVE
         LW,D1    TEMPW             GET OLD WIDTH
         STW,D1   KTTEMPW           SAVE
*
RTNSTKT  EQU      %
         RETURN
*
*
         PAGE
*
* E37EKT -- END KEEP-TOGETHER BLOCK
*
*
E37EKT   EQU      %
         SAVRTN
*
         BAL,SRTN S08SCMD           NEW SYSTEM COMMAND
         DEPZ,D1  PR:P2KT           ZERO PASS 2 KEEP-TOGETHER
         JEZ,D2   PR:KTFLG,TSTSPKT  TEST K-T FLAG-IF NOT SET,TEST SPKT
ENDKT    EQU      %
         DEPZ,D1  PR:KTFLG          RESET KEEP-TOGETHER FLAG
         GET,D1   PR:RLNS           GET REMAINING LINES ON PAGE
         CW,D1    KTCNT             COMPARE TO K-T LINE COUNT
         BGE      RESCKEY               ENOUGH ROOM ON PAGE, PRINT K-T
         BAL,SRTN S08PGEND              NOT ENOUGH ROOM, END PAGE
         B        RESCKEY5
*
RESCKEY  EQU      %
         LI,D1    1
         PUT,D1   PR:P2KT           SET PASS 2 K-T FLAG
RESCKEY5 RES      0
         LW,D1    KTFMTFLG          RESTORE FORMAT FLAG
         PUT,D1   PR:FMTFLG
         LW,D1    KTCTRFLG          RESTORE CENTERING FLAG
         PUT,D1   PR:CTRFLG
         LW,D1    KTMXPSTN          GET MAX CARRIER POSITION
         PUT,D1   LN:MXPSTN         RESTORE
         LW,D1    KTWIDTH           GET WIDTH
         PUT,D1   #WIDTH            RESTORE
         LW,D1    KTTEMPW           GET OLD WIDTH
         STW,D1   TEMPW             RESTORE
*
         LW,AC2   KTCKEY            GET K-T START KEY
         BAL,SRTN S09RDKEY          RESET FILE TO FIRST LINE
         DEPZ,D1  LN:INSZ           SET INPUT SIZE TO ZERO
         B        RTNEKT            RETURN
*
*
         PAGE
*
*
TSTSPKT  EQU      %
         JEZ,D1   PR:SPFLG,TSTNWST  TEST K-T SPACING FLAG
         PUT,D1   PR:SPACE              SET, RESTORE SPACING
         DEPZ,D1  PR:SPFLG          RESET K-T SPACING FLAG
*
TSTNWST  EQU      %
         JEZ,D1   (#FLAGS,:K(5)),RTNEKT TEST NEW K-T FLAG
         BAL,SRTN E37STKT           NOW START NEW K-T
*
RTNEKT   EQU      %                 RETURN
         RETURN
*
*
         PAGE
*
* S37SAVKT -- COUNT KEEP-TOGETHER LINES
*
*
S37SAVKT EQU      %
         SAVRTN
*
         LB,AC2   0,BUF3            GET SKIP COUNT
         SLS,AC2  24                CONVERT TO +
         SAS,AC2  -24
         LAW,AC3  AC2
         AWM,AC3  KTCNT             ADD TO K-T COUNT
*
         JNEZ,D1  PR:TBLMODE,RTNCKT IF TABLE MODE, RETURN
         GET,D1   PR:RLNS           GET REMAINING LINES
         CW,D1    KTCNT             COMPARE TO K-T COUNT
         BGE      RTNCKT            OK, RETURN
         LI,D1    -1                LESS, SET NEW PARAGRAPH
         STW,D1   PTABSLN
         B        ENDKT             END KEEP-TOGETHER
RTNCKT   RES      0
         RETURN
*
*
         PAGE
*
* E37BLANK -- INSERT BLANK STRING COMMAND
*
*
E37BLANK EQU      %
         SAVRTN
*
         JLEZ,AC1 (#DSHW,:K(1)),RTNBLANK GET NUMBER OF BLANKS
         STW,AC1  SAVBLNKS          SAVE BLANK COUNT
         GET,X1   LN:OUTPTR         GET OUTPUT LINE POINTER
         GET,AC1  LN:OUTSZ          GET OUTPUT LINE SIZE
         GET,D1   LN:CPSTN          GET CURRENT CARRIER POSITION
*
         LI,AC2   #LSTCOL           MAX COLUMN POSITION
         SW,AC2   D1                SUBTRACT CURRENT CARRIER POSITION
         CW,AC2   SAVBLNKS          COMPARE TO BLANK STRING SIZE
         BGE      TSTLPINS              OK, GO TEST LP FLAG
         STW,AC2  SAVBLNKS              WONT FIT, SET NEW SIZE
*
TSTLPINS EQU      %
         JNEZ,D2  PR:LPFLG,INSTRNG  TEST LP FLAG FOR NO STOPS
         JEZ,D2   (#FLAGS,:K(1)),INSTRNG     TEST 'STOP' FLAG
         LI,AC2   #STOP             GET STOP CHAR
         STB,AC2  0,X1              STORE IN OUTPUT BUFFER
         AI,X1    1                 INCREMENT OUTPUT POINTER
         AI,AC1   1                 INCREMENT OUTPUT SIZE
         GET,D2   LN:NSTOP          INCREMENT STOP COUNT
         AI,D2    1
         PUT,D2   LN:NSTOP
         B        INCBPSTN          GO INCREMENT CARRIER POSITION
*
         PAGE
*
*
INSTRNG  EQU      %
         INSCHAR  #BLANK,*X1,*SAVBLNKS  INSERT BLANKS IN OUTPUT BUFFER
         AW,X1    SAVBLNKS          INCREMENT OUTPUT POINTER
         AW,AC1   SAVBLNKS          INCREMENT OUTPUT SIZE
*
INCBPSTN EQU      %
         AW,D1    SAVBLNKS          ADD BLANK COUNT TO POSITION
         PUT,X1   LN:OUTPTR         STORE NEW OUTPUT POINTER
         PUT,AC1  LN:OUTSZ          STORE NEW OUTPUT SIZE
         PUT,D1   LN:CPSTN          STORE NEW CARRIER POSITION
*
RTNBLANK EQU      %
         RETURN
*
*
         PAGE
*
*
* E37TK -- PHRASE KEEP-TOGETHER
*
E37TK    RES      0
         SAVRTN
         MTW,1    PHKTFLG           SET PHRASE KEEP-TOGETHER FLAG
         GET,AC1  #NCCS,:K(2)       GET SIZE OF PHRASE
         GET,X1   #CS,:K(2)         GET ADDRESS OF PHRASE
         LW,BUF1  X1
         LI,AC2   #CR               GET A CR CHAR
         AW,X1    AC1               STORE AS LAST CHAR OF PHRASE
         STB,AC2  0,X1
         AI,AC1   1                 INCR SIZE FOR CR CHAR
         BAL,SRTN S38INS1           INSERT PHRASE IN PRINT LINE
         MTW,-1   PHKTFLG           RESET PHRASE KEEP-TOGETHER FLAG
         RETURN
         PAGE
*
*
* C37LP -- LINE PRINTER TO SYMBIONT QUEUE COMMAND
*
C37LP    RES      0
         SAVRTN
         MTW,1    LPFLG             SET LINE PRINTER FLAG
         BAL,SRTN S37LP             FORCE LINE PRINTER OUTPUT
         JNEZ,D1  (#FLAGS,:K(1)),C37LP900  IF 'AUTO', EXIT
         STW,D1   LPFLG             RESET LP FLAG
C37LP900 RES      0
         RETURN
*
*
* S37LP -- LINE PRINTER SERVICE ROUTINE
*
S37LP    RES      0
         SAVRTN
         MTW,0    BATCHFLG          BATCH MODE
         BGZ      S37LP900          YES, SKIP FORCE
         MTW,0    LPFLG             OUTPUT TO LINE PRINTER
         BEZ      S37LP900          NO
         BAL,SRTN S36LP             FORCE LINE PRINTER TO QUEUE
S37LP900 RES      0
         RETURN
         PAGE
*
*
* E37TS -- TEMPORARY SPACING COMMAND
*
E37TS    RES      0
         SAVRTN
         BAL,SRTN S08SCMD           NEW SYSTEM COMMAND
         JEZ,D1   PR:SPFLG,TS20     TEST FOR PREVIOUS SPACING
         PUT,D1   PR:SPACE          SET, RESTORE PERM SPACING
         DEPZ,D1  PR:SPFLG          RESET TEMP SPACING
TS20     RES      0
         LI,X1    3
TS30     RES      0
         JNEZ,D1  (#FLAGS,X1),TS50  CHECK FOR 'S','D','T' FLAGS
         BDR,X1   TS30              CONTINUE
         B        TS500
TS50     RES      0
         GET,D1   PR:SPACE          GET PERM SPACING SIZE
         PUT,D1   PR:SPFLG          SAVE
         PUT,X1   PR:SPACE          SET NEW SPACING SIZE
TS500    RES      0
         RETURN
         PAGE
*
* LOCAL VARIABLES FOR PRNTSM
*
*
37D      CSECT    0                 PRNTSM LOCALS
*
KTCNT    RES      1                 KEEP-TOGETHER COUNT
BLKCNT   RES      1                 BLOCK COUNT
KTCKEY   RES      1                 KEEP-TOGETHER START KEY
KTFMTFLG RES      1                 K-T FORMAT FLAG
KTCTRFLG RES      1                 K-T CENTERING FLAG
KTMXPSTN RES      1                 K-T MAX CARRIER POSITION
KTWIDTH  RES      1                 K-T WIDTH
KTTEMPW  RES      1                 K-T OLD WIDTH
*
RN1      RES      1                 FIRST PRINT KEY
RN2      RES      1                 LAST PRINT KEY
LNSTART  RES      1                 ADDR OF PRINT LINE
LNSZ     RES      1                 SIZE OF PRINT LINE
SKPCOUNT RES      1                 SKIP COUNT
STOPCNT  RES      1                 STOP COUNT
*
NSKPLNS  RES      1                 # OF SKIP LINES
TMPLNS   RES      1                 TEMP LINE COUNT
SAVBLNKS RES      1                 INSERT BLANKS COUNT
SHFTMBS  MBS,X2   0                 SHIFT INSTRUCTION
*
FCODE    RES      1                 SAVE FORMATTING CODE FOR PRINTOUT LINES
PHKTFLG  DATA     0                 PHRASE KEEP-TOGETHER FLAG
LPFLG    DATA     1                 LINE PRINTER TO QUEUE FLAG (SET)
*
37END    EQU      %                 END OF PRNTSM LOCALS
*
*
         USECT    #PLOC
         END
