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 # CTTOWB = 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, STL, S2. # ITEM A C (240), B; P = LOC(A); # SAVE PARMS # STL = B - 1; FOR S2=0 STEP 1 UNTIL STL DO TTCHL(CST); # 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 CA 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. # ITEM A C(240); ITEM B I; IF NOT SCREENMODE THEN MORTAL(" SCREEN MODE REQUIRED.$"); S1 = 0; P = LOC(A); WHYLE CST NQ "$" DO BEGIN B = CST; 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 CTTOWB 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 # CNUMS1 = 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(CNUMS1); # 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