FSEFORM 
PROC FSEFORM; 
BEGIN 
  
  
# 
***       FSEFORM -- STRING FORMATTING AND OUTPUT ROUTINES. 
* 
*         COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
# 
  
  DEF LISTCON #0#;
  
*IFCALL SINGLE,COMFSGL
*IFCALL ONLY,COMFONL
*IFCALL MULTI,COMFMLT 
*CALL COMFFSE 
  
                             # COMMON DATA       #
  
  
CONTROL IFEQ MULTI,1; 
  XREF ARRAY RENTSTK [1:MAXREENT];     # SUBROUTINE STACK  #
    BEGIN 
    ITEM RSTK;
    END 
  XREF ITEM RSTKPTR;
CONTROL FI; 
PAGE                         # COMMON DATA, EXTERNALS      #
  
  
*CALL COMFDS1 
*CALL COMFVD2 
*CALL COMFDS2 
*CALL COMFTAB 
  
  
XREF
  BEGIN 
*CALL COMFXSB 
*CALL COMFXVT 
*CALL COMFXTI 
  END 
  
  
XDEF
  BEGIN 
*CALL COMFXFO 
  END 
PAGE PROC TTWRD;
  IOBEGIN(TTWRD)
# 
**        TTWRD - TRANSMIT ONE-WORD ACCUMULATOR TO OUTPUT.
* 
*         ENTRY  TTOWB - CONTAINS TEXT TO BE OUTPUT.
*                TTCDC - SHOWS CHARACTER COUNT IN TTOWB.
* 
*         EXIT   BOTH PARAMETERS CLEARED. 
* 
*         CALLS  VDTWTO.
# 
  VDTWTO(TTOWB);               # TRANSMIT WORD     #
  TTOWB = 0;                  # CLEAR WORD        # 
  TTCBC = -1;                 # SHOW EMPTY        # 
  IOEND 
  
  
PROC TTSYNC;
  IOBEGIN(TTSYNC) 
# 
**        TTSYNS - CONDITIONALLY DRAIN ONE-WORD ACCUMULATOR.
* 
*         ENTRY  TTCBC - CHARACTER COUNT IN TTOWB.
* 
*         EXIT   TTCBC CLEAR, OUTPUT POSSIBLY TRANSMITTED.
* 
*         CALLS  TTCHR, TTWRD.
# 
  IF TTCBC GQ 0 THEN         # DRAIN PREVIOUS    #
    BEGIN 
    CONTROL IFEQ SINGLE,1;
      IF NOT TTYOUTPUT THEN GOTO TTSYNC2; 
    CONTROL FI; 
    IF TTCBC LAN 1 EQ 0 THEN TTCHR(O"00");
    TTCHR(O"00");                    # CONTROL BYTE 0013B # 
    TTCHR(O"13"); 
TTSYNC2:  
    IF TTCBC EQ 9 THEN TTWRD; 
    TTWRD;
    END 
  IOEND                        # OF TTSYNC         #
  
  
PROC TTINIT;
  BEGIN 
# 
**        TTINIT - INITIALIZE ONE-WORD ACCUMULATOR. 
* 
*         EXIT   TTCBC, TTOCB, TTOWB - CLEARED. 
# 
  TTOWB=0;
  TTOCB=0;
  TTCBC=-1; 
  END                         # OF TTINIT         # 
PAGE PROC TTCHL(A);          # CHAR (LEFT)       #
  IOBEGIN(TTCHL)
# 
**        TTCHL - FORMAT ONE CHARACTER FROM LEFT OF PARM. 
* 
*         ENTRY  A - WORD WITH CHARACTER IN TOP OF WORD.
*                SCREENMODE - WHETHER TO USE VIRTERM OR TTWRD.
* 
*         CALLS  VDTCHR, TTWRD. 
* 
*         USES   TTOCB, TTCBC, TTOWB. 
# 
  ITEM A; 
  ITEM B; 
  IF SCREENMODE THEN
    BEGIN 
    B=C<0,1>A;
    B=XLTDSPXP[B];
    VDTCHR(B);
    END 
  ELSE
    BEGIN 
    TTOCB = A;                  # HOLD CHAR         # 
    IF TTCBC EQ 9 THEN TTWRD;   # FULL WORD         # 
    TTCBC = TTCBC + 1;          # INCREMENT POINTER # 
    C<TTCBC>TTOWB = C<0>TTOCB;  # CHAR TO WORD      # 
    END 
  IOEND 
  
PROC TTCHR(A);
  IOBEGIN(TTCHR)
# 
**        TTCHR - FORMAT CHARACTER FROM RIGHT OF WORD.
* 
*         ENTRY  A - WORD WITH CHARACTER IN RIGHT END.
* 
*         CALLS  TTCHL. 
# 
  ITEM A,B; 
  C<0,1>B=C<9,1>A;
  TTCHL(B); 
  IOEND                       # OF TTCHR          # 
PAGE PROC TTST(A,B);
  IOBEGIN(TTST) 
# 
**        TTST - FORMAT STRING OF SPECIFIED LENGTH. 
* 
*         ENTRY  A - STRING OF 6-BIT CHARACTERS.
*                B - LENGTH OF STRING.
* 
*         CALLS  TTCHL. 
* 
*         USES   P<STR>, STL, S2. 
# 
  ITEM A C (240), B;
  P<STR> = LOC(A);            # SAVE PARMS        # 
  STL = B - 1;
  FOR S2=0 STEP 1 UNTIL STL DO TTCHL(C<S2>ST);    # COPY STRING # 
  IOEND 
  
  
PROC TTSTR(A);
  IOBEGIN(TTSTR)
# 
**        TTSTR - FORMAT STRING TERMINATED BY $ 
* 
*         ENTRY  A - STRING.
* 
*         CALLS  TTST, TTBRK. 
* 
*         USES   S1.
# 
  ITEM A C (240); 
  S1 = 0; 
  WHYLE S1 LS 80 AND C<S1>A NQ "$" DO S1 = S1+1; # FIND END OF STR #
  IF S1 EQ 80 THEN
    BEGIN                      # ERROR             #
    TTST("NO $ IN TTSTR STRING",20);
    TTBRK;
    END 
  ELSE TTST(A,S1);            # WRITE THE STRING  # 
  IOEND 
  
  
PROC TTLCSTR(A);
  IOBEGIN(TTLCSTR)
# 
**        TTLCSTR - TTSTR WITH CONVERT TO LOWER-CASE ON SCREEN. 
* 
*         ENTRY  A - UPPER-CASE STRING WITH $ TERMINATOR. 
* 
*         CALLS  VDTCHR, MORTAL.
* 
*         USES   S1, P<STR>.
# 
  ITEM A C(240);
  ITEM B I; 
  IF NOT SCREENMODE THEN MORTAL(" SCREEN MODE REQUIRED.$"); 
  S1 = 0; 
  P<STR> = LOC(A);
  WHYLE C<S1>ST NQ "$" DO 
    BEGIN 
    B = C<S1>ST;
    IF B GQ "A" AND B LQ "Z" THEN VDTCHR(XLTDSPXP[B]+O"40");
    ELSE VDTCHR(XLTDSPXP[B]); 
    S1 = S1 + 1;
    END 
  IOEND              #   OF TTLCSTR   # 
  
  
PAGE PROC TTBRK;
  IOBEGIN(TTBRK)
# 
**        TTBRK - FORMAT END-OF-LINE. 
* 
*         ENTRY  TTCBC, SCREENMODE - CONTROL NEED TO DO ANYTHING. 
* 
*         CALLS  TTCHL, TTWRD.
# 
  IF TTCBC GQ 0 AND NOT SCREENMODE THEN  # NON-TRIVIAL       #
    BEGIN 
    IF C<TTCBC>TTOWB EQ 0 THEN TTCHL(" ");  # BLANK AFTER COLON # 
    IF TTCBC EQ 8 THEN TTCHL(" ");      # NO 66-BIT EOL     # 
    IF TTCBC GQ 8 THEN TTWRD;   # NEED EXTRA WORD # 
    TTWRD;                      # DUMP THE EOL      # 
    END 
  IOEND 
  
  
PROC TTLIN(A);               # TTSTR + TTBRK     #
  IOBEGIN(TTLIN)
# 
**        TTLIN - COMBINED TTSTR AND TTBRK. 
* 
*         ENTRY  A - PARAMETER TO PASS ON TO TTSTR. 
* 
*         CALLS  TTSTR, TTBRK.
# 
  ARRAY A;; 
  TTSTR(A);                   # OUTPUT STRING     # 
  TTBRK;                      # END LINE          # 
  IOEND 
  
  
PROC GETNUM(A,B); 
  BEGIN 
# 
**        GETNUM - FORMAT NUMBER BY RADIX.
* 
*         ENTRY  A - BINARY INTEGER TO ENCODE.
*                B - RADIX (BASE).
* 
*         EXIT   NUMS1 - CONTAINS FORMATTED NUMBER. 
*                S1, S2 - RESIDUAL VALUES LEFT FOR PUTNUM USAGE.
* 
*         MACROS MOD. 
* 
*         USES   S1,S2. 
# 
  ITEM A,B; 
  S1=ABS(A);
  S2 = -1;                  # COUNT DIGITS      # 
  WHYLE S1 GQ B DO          # NOT DONE YET      # 
    BEGIN 
    S2 = S2 + 1;            # BUMP POINTER      # 
    C<S2>NUMS1 = MOD(S1,B) + O"33";   # GET A DIGIT       # 
    S1 = S1/B;              # REDUCE NUMBER     # 
    END 
  END 
  
  
PROC PUTNUM;                 # WRITE SET UP NUM  #
  IOBEGIN(PUTNUM) 
# 
**        PUTNUM - TRANSMIT NUMS1 AS BUILT BY GETNUM. 
* 
*         ENTRY  NUMS1 - ENCODED NUMBER IN GETNUM FORMAT. 
*                S1, S2 - AS LEFT BY GETNUM.
* 
*         EXIT   S2 - DESTROYED.
* 
*         CALLS  TTCHL, TTCHR.
# 
  TTCHR(S1+O"33");          # FIRST DIGIT       # 
  FOR S2=S2 STEP -1 UNTIL 0 DO TTCHL(C<S2>NUMS1);  # REST OF DIGITS # 
  IOEND 
PAGE PROC TTNUM(A,B);        # NUMBER A IN RADIX B         #
  IOBEGIN(TTNUM)
# 
**        TTNUM - EXTERNAL INTERFACE TO ENCODE NUMBERS. 
* 
*         ENTRY  A - INTEGER TO ENCODE AND TRANSMIT.
*                B - RADIX. 
* 
*         CALLS  GETNUM, TTCHL, PUTNUM. 
# 
  ITEM A,B; 
  GETNUM(A,B);              # SET UP S1,S2,NUMS1          # 
  IF A LS 0 THEN TTCHL("-");          # MINUS SIGN        # 
  PUTNUM;                   # AND WRITE NUMBER  # 
  IOEND 
  
  
PROC TTDEC(A);               # NUMBER A IN DECIMAL         #
  IOBEGIN(TTDEC)
# 
**        TTDEC - ENCODE INTEGER IN DECIMAL.
* 
*         ENTRY  A - INTEGER. 
* 
*         CALLS  TTNUM. 
# 
  TTNUM(A,10);
  IOEND 
  
  
PROC TTLPAD(A,N,C);          # LEFT PAD DECIMAL NUM        #
  IOBEGIN(TTLPAD) 
# 
**        TTLPAD - LEFT PADDED ENCODE AND TRANSMIT OF INTEGER.
* 
*         ENTRY  A - INTEGER. 
*                N - FIELD WIDTH. 
*                C - PADDING CHARACTER. 
* 
*         CALLS  GETNUM, PUTNUM, TTCHL. 
* 
*         USES   S2, S3, S4.
# 
  ITEM A,N,C; 
  IF A GQ 0 THEN              # DON'T DO NEGATIVE # 
    BEGIN 
    GETNUM(A,10);             # S2=WIDTH-1        # 
    S3 = N - S2 - 3;          # S3=PAD WIDTH-1    # 
    S4 = C;                   # PAD CHARACTER     # 
    FOR S3=S3 STEP -1 UNTIL 0 DO TTCHL(S4);       # WRITE PADDING # 
    PUTNUM;                   # WRITE NUMBER      # 
    END 
  IOEND 
  
  
  
END TERM
