|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5056 (0x13c0)
Types: TextFile
Notes: Mikados_K
Names: »PSCT6.K«
└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS )
└─⟦this⟧ »PSCT6.K«
PROGRAM FORMATTEST;
(* EXAMPLE OF AN ADVANCED FORMATTING ROUTINE FOR MIKADOS *)
(* PASCAL E EXTENDED PRECISION REALS *)
(* APPLICATION NOTE - RM/800103 - NOT COPYRIGHTED *)
VAR TEST: STRING;
PROCEDURE FORMAT( BINARY: REAL; VAR ASCII: STRING );
CONST FILLER = '*'; (*CHANGE TO ' ' IF LEADING *'S NOT REQUIRED*)
VAR I,J: INTEGER;
FINISHED: BOOLEAN;
PROCEDURE BCDTOASCII( BINARY: REAL; VAR ASCII: STRING );
(* CONVERTS THE EXTENDED PRECISION BINARY REAL IN 'BINARY' *)
(* INTO AN ASCII STRING IN 'ASCII'. THE RESULTING FORMAT *)
(* OF 'ASCII' IS: *)
(* POS. X (1<=X<=13) DIGIT OF WEIGHT 10^(11-X) IN BASE 10 *)
(* REPRESENTATION OF 'BINARY' *)
(* POS. 14 SIGN ('+' OR '-') *)
(* POS. 15-16 EXPONENT *)
(* *)
(* THE ROUTINE CAN ONLY BE USED WITH PASCAL E AND DEPENDS *)
(* ON THE INTERNAL REPRESENTATION OF EXTENDED PRECISION *)
(* NUMBERS *)
TYPE BYTE = 0..255;
EQUIVALENCER = RECORD (*VERY DIRTY TRICK*)
CASE BOOLEAN OF
TRUE: (INN: REAL);
FALSE: (OUT: PACKED ARRAY(1..8) OF BYTE)
END;
VAR I,J,INDEX,EXPONENT: INTEGER;
BCD: BYTE;
CONVERT: EQUIVALENCER;
BEGIN
ASCII := '0000000000000+00';
IF BINARY>=0.0 THEN BINARY:=BINARY+0.005 ELSE BINARY:=BINARY-0.005;
CONVERT.INN := BINARY;
IF CONVERT.OUT(1) >= 128 THEN ASCII(14) := '-';
EXPONENT := CONVERT.OUT(8) - 128;
IF EXPONENT > 11 THEN ASCII := '????????????????'
ELSE
BEGIN
FOR I:=EXPONENT DOWNTO -1 DO
BEGIN
J := EXPONENT - I + 3;
BCD := CONVERT.OUT(J DIV 2);
INDEX := 12 - I;
IF J MOD 2 = 1 THEN ASCII(INDEX):=CHR(BCD MOD 16 + ORD('0'))
ELSE ASCII(INDEX):=CHR(BCD DIV 16 + ORD('0'));
END;
BCD := CONVERT.OUT(8);
ASCII(15) := CHR( BCD DIV 10 + ORD('0') );
ASCII(16) := CHR( BCD MOD 10 + ORD('0') );
END;
END (*BCD TO ASCII*);
BEGIN (*FORMAT BINARY NUMBER INTO PRETTY ASCII STRING *)
(*TRAILING SIGN, DECIMAL COMMA, POSITIONAL DOTS *)
(*FILLER CHARACTERS OPTIONAL *)
BCDTOASCII( BINARY, ASCII );
ASCII := CONCAT( ASCII, ' ' );
I := 1;
WHILE (ASCII(I)='0') AND (I<11) DO
BEGIN
ASCII(I) := FILLER;
I := I + 1
END;
ASCII(18) := ASCII(14);
ASCII(17) := ASCII(13);
ASCII(16) := ASCII(12);
FINISHED := FALSE;
I := 15;
FOR J := 11 DOWNTO 2 DO
BEGIN
IF (J+1) MOD 3 = 0 THEN
BEGIN
IF FINISHED THEN ASCII(I) := FILLER ELSE ASCII(I) := '.';
I := I - 1;
END;
IF FINISHED THEN ASCII(I) := FILLER ELSE ASCII(I) := ASCII(J);
FINISHED := FINISHED OR (ASCII(J-1)=FILLER);
I := I - 1;
END;
ASCII(15) := ',';
END (*FORMAT*);
BEGIN (* MAIN PROGRAM *)
FORMAT( 1.23, TEST );WRITELN(LIST, 1.23:25:2,TEST:20);
FORMAT( -123456.777, TEST );WRITELN(LIST, -123456.777:25:2,TEST:20);
FORMAT( 4445556667.9, TEST );WRITELN(LIST, 4445556667.9:25:2,TEST:20);
FORMAT( -0.05, TEST );WRITELN(LIST, -0.05:25:2,TEST:20);
FORMAT( 1E11, TEST );WRITELN(LIST, 1E11:25 ,TEST:20);
FORMAT( 1E-11, TEST );WRITELN(LIST, 1E-11:25 ,TEST:20);
END (*MAIN PROGRAM*).
0x0000…0015 Line {l1=0x13, l2=»PROGRAM FORMATTEST;«, l3=0x13}
0x0015…0055 Line {l1=0x3e, l2=» (* EXAMPLE OF AN ADVANCED FORMATTING ROUTINE FOR MIKADOS *)«, l3=0x3e}
0x0055…0095 Line {l1=0x3e, l2=» (* PASCAL E EXTENDED PRECISION REALS *)«, l3=0x3e}
0x0095…00d5 Line {l1=0x3e, l2=» (* APPLICATION NOTE - RM/800103 - NOT COPYRIGHTED *)«, l3=0x3e}
0x00d5…00e8 Line {l1=0x11, l2=»VAR TEST: STRING;«, l3=0x11}
0x00e8…00eb Line {l1=0x01, l2=» «, l3=0x01}
0x00eb…0121 Line {l1=0x34, l2=»PROCEDURE FORMAT( BINARY: REAL; VAR ASCII: STRING );«, l3=0x34}
0x0121…0164 Line {l1=0x41, l2=»CONST FILLER = '*'; (*CHANGE TO ' ' IF LEADING *'S NOT REQUIRED*)«, l3=0x41}
0x0164…0177 Line {l1=0x11, l2=»VAR I,J: INTEGER;«, l3=0x11}
0x0177…018f Line {l1=0x16, l2=» FINISHED: BOOLEAN;«, l3=0x16}
0x018f…0192 Line {l1=0x01, l2=» «, l3=0x01}
0x0192…01cc Line {l1=0x38, l2=»PROCEDURE BCDTOASCII( BINARY: REAL; VAR ASCII: STRING );«, l3=0x38}
0x01cc…020f Line {l1=0x41, l2=» (* CONVERTS THE EXTENDED PRECISION BINARY REAL IN 'BINARY' *)«, l3=0x41}
0x020f…0252 Line {l1=0x41, l2=» (* INTO AN ASCII STRING IN 'ASCII'. THE RESULTING FORMAT *)«, l3=0x41}
0x0252…0295 Line {l1=0x41, l2=» (* OF 'ASCII' IS: *)«, l3=0x41}
0x0295…02d8 Line {l1=0x41, l2=» (* POS. X (1<=X<=13) DIGIT OF WEIGHT 10^(11-X) IN BASE 10 *)«, l3=0x41}
0x02d8…031b Line {l1=0x41, l2=» (* REPRESENTATION OF 'BINARY' *)«, l3=0x41}
0x031b…035e Line {l1=0x41, l2=» (* POS. 14 SIGN ('+' OR '-') *)«, l3=0x41}
0x035e…03a1 Line {l1=0x41, l2=» (* POS. 15-16 EXPONENT *)«, l3=0x41}
0x03a1…03e4 Line {l1=0x41, l2=» (* *)«, l3=0x41}
0x03e4…0427 Line {l1=0x41, l2=» (* THE ROUTINE CAN ONLY BE USED WITH PASCAL E AND DEPENDS *)«, l3=0x41}
0x0427…046a Line {l1=0x41, l2=» (* ON THE INTERNAL REPRESENTATION OF EXTENDED PRECISION *)«, l3=0x41}
0x046a…04ad Line {l1=0x41, l2=» (* NUMBERS *)«, l3=0x41}
0x04ad…04b0 Line {l1=0x01, l2=» «, l3=0x01}
0x04b0…04c5 Line {l1=0x13, l2=»TYPE BYTE = 0..255;«, l3=0x13}
0x04c5…04f7 Line {l1=0x30, l2=» EQUIVALENCER = RECORD (*VERY DIRTY TRICK*)«, l3=0x30}
0x04f7…051e Line {l1=0x25, l2=» CASE BOOLEAN OF«, l3=0x25}
0x051e…054c Line {l1=0x2c, l2=» TRUE: (INN: REAL);«, l3=0x2c}
0x054c…058f Line {l1=0x41, l2=» FALSE: (OUT: PACKED ARRAY(1..8) OF BYTE)«, l3=0x41}
0x058f…05a9 Line {l1=0x18, l2=» END;«, l3=0x18}
0x05a9…05cb Line {l1=0x20, l2=»VAR I,J,INDEX,EXPONENT: INTEGER;«, l3=0x20}
0x05cb…05db Line {l1=0x0e, l2=» BCD: BYTE;«, l3=0x0e}
0x05db…05f7 Line {l1=0x1a, l2=» CONVERT: EQUIVALENCER;«, l3=0x1a}
0x05f7…05fe Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x05fe…061e Line {l1=0x1e, l2=» ASCII := '0000000000000+00';«, l3=0x1e}
0x061e…0665 Line {l1=0x45, l2=» IF BINARY>=0.0 THEN BINARY:=BINARY+0.005 ELSE BINARY:=BINARY-0.005;«, l3=0x45}
0x0665…067f Line {l1=0x18, l2=» CONVERT.INN := BINARY;«, l3=0x18}
0x067f…06b2 Line {l1=0x31, l2=» IF CONVERT.OUT(1) >= 128 THEN ASCII(14) := '-';«, l3=0x31}
0x06b2…06d7 Line {l1=0x23, l2=» EXPONENT := CONVERT.OUT(8) - 128;«, l3=0x23}
0x06d7…070c Line {l1=0x33, l2=» IF EXPONENT > 11 THEN ASCII := '????????????????'«, l3=0x33}
0x070c…0714 Line {l1=0x06, l2=» ELSE«, l3=0x06}
0x0714…071f Line {l1=0x09, l2=» BEGIN«, l3=0x09}
0x071f…0741 Line {l1=0x20, l2=» FOR I:=EXPONENT DOWNTO -1 DO«, l3=0x20}
0x0741…074e Line {l1=0x0b, l2=» BEGIN«, l3=0x0b}
0x074e…076c Line {l1=0x1c, l2=» J := EXPONENT - I + 3;«, l3=0x1c}
0x076c…0790 Line {l1=0x22, l2=» BCD := CONVERT.OUT(J DIV 2);«, l3=0x22}
0x0790…07a8 Line {l1=0x16, l2=» INDEX := 12 - I;«, l3=0x16}
0x07a8…07ec Line {l1=0x42, l2=» IF J MOD 2 = 1 THEN ASCII(INDEX):=CHR(BCD MOD 16 + ORD('0'))«, l3=0x42}
0x07ec…0831 Line {l1=0x43, l2=» ELSE ASCII(INDEX):=CHR(BCD DIV 16 + ORD('0'));«, l3=0x43}
0x0831…083d Line {l1=0x0a, l2=» END;«, l3=0x0a}
0x083d…0859 Line {l1=0x1a, l2=» BCD := CONVERT.OUT(8);«, l3=0x1a}
0x0859…0889 Line {l1=0x2e, l2=» ASCII(15) := CHR( BCD DIV 10 + ORD('0') );«, l3=0x2e}
0x0889…08b9 Line {l1=0x2e, l2=» ASCII(16) := CHR( BCD MOD 10 + ORD('0') );«, l3=0x2e}
0x08b9…08c3 Line {l1=0x08, l2=» END;«, l3=0x08}
0x08c3…08da Line {l1=0x15, l2=»END (*BCD TO ASCII*);«, l3=0x15}
0x08da…08dd Line {l1=0x01, l2=» «, l3=0x01}
0x08dd…0918 Line {l1=0x39, l2=»BEGIN (*FORMAT BINARY NUMBER INTO PRETTY ASCII STRING *)«, l3=0x39}
0x0918…0953 Line {l1=0x39, l2=» (*TRAILING SIGN, DECIMAL COMMA, POSITIONAL DOTS *)«, l3=0x39}
0x0953…098e Line {l1=0x39, l2=» (*FILLER CHARACTERS OPTIONAL *)«, l3=0x39}
0x098e…09ae Line {l1=0x1e, l2=» BCDTOASCII( BINARY, ASCII );«, l3=0x1e}
0x09ae…09d1 Line {l1=0x21, l2=» ASCII := CONCAT( ASCII, ' ' );«, l3=0x21}
0x09d1…09dc Line {l1=0x09, l2=» I := 1;«, l3=0x09}
0x09dc…0a02 Line {l1=0x24, l2=» WHILE (ASCII(I)='0') AND (I<11) DO«, l3=0x24}
0x0a02…0a0d Line {l1=0x09, l2=» BEGIN«, l3=0x09}
0x0a0d…0a26 Line {l1=0x17, l2=» ASCII(I) := FILLER;«, l3=0x17}
0x0a26…0a36 Line {l1=0x0e, l2=» I := I + 1«, l3=0x0e}
0x0a36…0a40 Line {l1=0x08, l2=» END;«, l3=0x08}
0x0a40…0a5b Line {l1=0x19, l2=» ASCII(18) := ASCII(14);«, l3=0x19}
0x0a5b…0a76 Line {l1=0x19, l2=» ASCII(17) := ASCII(13);«, l3=0x19}
0x0a76…0a91 Line {l1=0x19, l2=» ASCII(16) := ASCII(12);«, l3=0x19}
0x0a91…0aa7 Line {l1=0x14, l2=» FINISHED := FALSE;«, l3=0x14}
0x0aa7…0ab3 Line {l1=0x0a, l2=» I := 15;«, l3=0x0a}
0x0ab3…0ace Line {l1=0x19, l2=» FOR J := 11 DOWNTO 2 DO«, l3=0x19}
0x0ace…0ad9 Line {l1=0x09, l2=» BEGIN«, l3=0x09}
0x0ad9…0af6 Line {l1=0x1b, l2=» IF (J+1) MOD 3 = 0 THEN«, l3=0x1b}
0x0af6…0b03 Line {l1=0x0b, l2=» BEGIN«, l3=0x0b}
0x0b03…0b44 Line {l1=0x3f, l2=» IF FINISHED THEN ASCII(I) := FILLER ELSE ASCII(I) := '.';«, l3=0x3f}
0x0b44…0b57 Line {l1=0x11, l2=» I := I - 1;«, l3=0x11}
0x0b57…0b63 Line {l1=0x0a, l2=» END;«, l3=0x0a}
0x0b63…0ba7 Line {l1=0x42, l2=» IF FINISHED THEN ASCII(I) := FILLER ELSE ASCII(I) := ASCII(J);«, l3=0x42}
0x0ba7…0bd9 Line {l1=0x30, l2=» FINISHED := FINISHED OR (ASCII(J-1)=FILLER);«, l3=0x30}
0x0bd9…0bea Line {l1=0x0f, l2=» I := I - 1;«, l3=0x0f}
0x0bea…0bf4 Line {l1=0x08, l2=» END;«, l3=0x08}
0x0bf4…0c09 Line {l1=0x13, l2=» ASCII(15) := ',';«, l3=0x13}
0x0c09…0c1b Line {l1=0x10, l2=»END (*FORMAT*);«, l3=0x10}
0x0c1b…0c1e Line {l1=0x01, l2=» «, l3=0x01}
0x0c1e…0c38 Line {l1=0x18, l2=»BEGIN (* MAIN PROGRAM *)«, l3=0x18}
0x0c38…0c80 Line {l1=0x46, l2=»FORMAT( 1.23, TEST );WRITELN(LIST, 1.23:25:2,TEST:20);«, l3=0x46}
0x0c80…0cc8 Line {l1=0x46, l2=»FORMAT( -123456.777, TEST );WRITELN(LIST, -123456.777:25:2,TEST:20);«, l3=0x46}
0x0cc8…0d10 Line {l1=0x46, l2=»FORMAT( 4445556667.9, TEST );WRITELN(LIST, 4445556667.9:25:2,TEST:20);«, l3=0x46}
0x0d10…0d58 Line {l1=0x46, l2=»FORMAT( -0.05, TEST );WRITELN(LIST, -0.05:25:2,TEST:20);«, l3=0x46}
0x0d58…0da0 Line {l1=0x46, l2=»FORMAT( 1E11, TEST );WRITELN(LIST, 1E11:25 ,TEST:20);«, l3=0x46}
0x0da0…0de8 Line {l1=0x46, l2=»FORMAT( 1E-11, TEST );WRITELN(LIST, 1E-11:25 ,TEST:20);«, l3=0x46}
0x0de8…0dff Line {l1=0x15, l2=»END (*MAIN PROGRAM*).«, l3=0x15}
0x0dff…0e00 00 ┆ ┆
0x0e00…0e20 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ┆ ┆
[…0x2c…]
0x13a0…13c0 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 63 ┆ c┆