diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card new file mode 100644 index 0000000..81ebe7b --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081-DATA.card @@ -0,0 +1,21 @@ +777 MRS-081 SAMPLE CASE-DATA CARDS FROM TECHNICAL BULLETIN EXAMPLE RUNS +5 0967 $LDR$ 01 00 10 05 11 61 00 *CASE IDENTIFICATION +5 03 10 29 34 36 43 48 50 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +5 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED +5 0967 $LDR$ 01 00 10 05 11 61 00 *CASE IDENTIFICATION +5 03 10 29 34 36 43 48 50 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +5 11 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED +5 0967 $LDR$ 01 00 09 05 11 61 00 *CASE IDENTIFICATION +5 03 10 29 34 36 43 48 50 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +5 0967 $LDR$ 00 00 10 05 11 61 00 *CASE IDENTIFICATION +5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +5 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED +5 0967 $LDR$ 00 00 10 05 11 61 00 *CASE IDENTIFICATION +5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +5 11 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS OMITTED +5 0967 $LDR$ 00 00 09 05 11 61 00 *CASE IDENTIFICATION +5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +5 0967 $LDR$ 00 00 09 05 11 61 01 *CASE IDENTIFICATION +5 03 10 17 21 29 34 36 00 00 00 00 00 00 00 00 00 00 00 00 00 *SYMPTOMS PRESENT +777 PUSHER CARD FOR 087 +777 PUSHER CARD FOR 087 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card new file mode 100644 index 0000000..c7c5623 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/MRS-081.card @@ -0,0 +1,435 @@ +2 COMMENT CONGENITAL HEART DISEASE DIAGNOSIS PROGRAM. CHDD0001 +2 FROM A SET OF CLINICAL SYMPTOMS, THE PROBABILITIES CHDD0002 +2 FOR EACH OF THE 33 CONGENITAL HEART DISEASES BEING CHDD0003 +2 PRESENT IN THE PATIENT UNDER CONSIDERATION IS CHDD0004 +2 CALCULATED AND THOSE GREATER THAN ONE PERCENT CHDD0005 +2 ARE PRINTED OUT TOGETHER WITH DISEASE IDENTIFICATION CHDD0006 +2 AND CASE INFORMATION. CHDD0007 +2 +2 FRED B FIELDING CHDD0008 +2 SAN FRANCISCO DISTRICT OFFICE CHDD0009 +2 +2 CARD SEQUENCE CODE FOR THE PROGRAM STARTS WITH CHDD0010 +2 CHDD0001 AND ROW 01-1 FOR SYMPTOM-DISEASE MATRIX. CHDD0011 +2 FIRST RELEASE 05 - 31 - 61 $CHDD0012 +2 +2 +2 INTEGER CASENO , CASEIN , SHEET , XRAY , EQUATION , CHDD0013 +2 MO , DAY , YEAR , LAST , CHDD0014 +2 E , J , K , P , X , CHDD0015 +2 TOTE , TOTP , TOTX , OUTSHEET , CHDD0016 +2 T22 , T2021 , T4243 , T4445 , T6789 , CHDD0017 +2 ( SYE() , SYP() ) , ( TE() , TP() ) , CHDD0018 +2 ROW () , MX () , M (,) $ CHDD0019 +2 REAL SUM , FTROW () , FTMX () , PYKX () , PYX () $ CHDD0020 +2 +2 ARRAY ( SYE(20) , SYP(20) ) , ( TE(50) , TP(50) ) , CHDD0021 +2 ( ROW(51) , FTROW(50) ) , ( MX(10) , FTMX(10) ) , CHDD0022 +2 PYKX (33) , PYX (33) , M (33,18) $ CHDD0023 +2 +2 EXTERNAL PROCEDURE UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $CHDD0024 +2 +2 COMMENT READ DATA FOR SYMPTOM-DISEASE MATRIX. $CHDD0025 +2 INPUT MATRIX(FOR K=(1,1,33) $ FOR J=(1,1,18) $ M(K,J) ) $CHDD0026 +2 READ ( $ $ MATRIX ) $ CHDD0027 +2 +2 COMMENT THE PROGRAM BEGINS HERE. THE FIRST TWO INPUT CARDS CHDD0028 +2 ARE READ, THE FIRST TWO LINES OF OUTPUT ARE PRINTED, CHDD0029 +2 THE NUMBER OF SYMPTOMS ARE CALCULATED, CHDD0030 +2 AND THE EQUATION TYPE DETERMINED. $ CHDD0031 +2 +2 NEWCASE.. FOR P = (1,1,20) $ SYP (P) = 0 $ CHDD0032 +2 FOR J = (1,1,50) $ TP (J) = ROW (J) = 0 $ CHDD0033 +2 FOR J = (1,1,50) $ FTROW (J) = 0.0 $ CHDD0034 +2 INPUT CASE (CASENO,CASEIN,SHEET,XRAY,EQUATION, CHDD0035 +2 MO,DAY,YEAR,LAST ) $ CHDD0036 +2 CARD1.. READ ( $ $ CASE ) $ CHDD0037 +2 OUTPUT IDOUT ( CASENO , CASEIN , MO , DAY , YEAR ) $ CHDD0038 +2 FORMAT IDFORM (B5,*CASE NUMBER*,I7,B5, CHDD0039 +2*PATIENT*,B2,A3,B5,*DATE*,B1,3(I3),W3 ) $ CHDD0040 +2 WRITE ( $ $ IDOUT , IDFORM) $ CHDD0041 +2 INPUT PRESENT ( FOR P = (1,1,20) $ SYP (P) ) $ CHDD0042 +2 CARD2.. READ ( $ $ PRESENT ) $ CHDD0043 +2 P = 1 $ CHDD0044 +2 FOR J = (1,1,50) $ CHDD0045 +2 BEGIN CHDD0046 +2 IF SYP (P) EQL J $ CHDD0047 +2 ( TP (J) = 1 $ P = P+1 ) CHDD0048 +2 END $ CHDD0049 +2 TOTP = P - 1 $ CHDD0050 +2 OUTPUT POUT ( FOR P = (1,1,TOTP) $ SYP (P) ) $ CHDD0051 +2 FORMAT PFORM (B5,*SYMPTOMS PRESENT*,B4,20(I4),W4) $ CHDD0052 +2 WRITE ( $ $ POUT , PFORM ) $ CHDD0053 +2 K = 1 $ CHDD0054 +2 IF SHEET EQL 1 $ CHDD0055 +2 ( OUTSHEET = 6600000000 $ GO TO EQTEST ) $ CHDD0056 +2 OUTSHEET = 4200000000 $ CHDD0057 +2 EQTEST.. IF EQUATION EQL 10 $ GO TO EQ10 $ CHDD0058 +2 +2 COMMENT CALCULATE PROBABILITIES USING EQUATION 9. $ CHDD0059 +2 +2 +2 COMMENT ONE ROW OF THE MATRIX IS UNPACKED AND THE CHDD0060 +2 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED. $CHDD0061 +2 +2 XP9.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0062 +2 FOR J = (8,1,16), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0063 +2 ( IF TP (J) EQL 1 $ ROW (J) = 1000 - ROW (J) ) $CHDD0064 +2 +2 COMMENT THE ROW-PRODUCT IS CALCULATED AND ZEROES TESTED FOR.$CHDD0065 +2 PYKX (K) = M (K,1) $ CHDD0066 +2 FOR P = (1,1,TOTP) $ CHDD0067 +2 BEGIN CHDD0068 +2 IF ROW ( SYP(P) ) EQL 0 $ CHDD0069 +2 ( PYKX (K) = 0.0 $ GO TO TAL9 ) $ CHDD0070 +2 FTROW (P) = ROW ( SYP(P) ) CHDD0071 +2 END $ CHDD0072 +2 +2 FOR P = (1,1,TOTP) $ CHDD0073 +2 PYKX (K) = PYKX (K).FTROW (P) $ CHDD0074 +2 +2 TAL9.. K = K+1 $ CHDD0075 +2 IF K LEQ 33 $ GO TO XP9 $ CHDD0076 +2 GO TO NORM $ CHDD0077 +2 +2 +2 COMMENT CALCULATE PROBABILITIES USING EQUATION 10. $ CHDD0078 +2 +2 EQ10.. FOR J = (1,1,50) $ TE (J) = 0 $ CHDD0079 +2 FOR E = (1,1,20) $ SYE (E) = 0 $ CHDD0080 +2 FOR X = (1,1,10) $ MX (X) = 0 $ CHDD0081 +2 FOR X = (1,1,10) $ FTMX (X) = 0.0 $ CHDD0082 +2 +2 COMMENT THE THIRD INPUT CARD IS READ, THE THIRD LINE OF CHDD0083 +2 OUTPUT IS PRINTED, AND THE NUMBER OF SYMPTOMS CHDD0084 +2 TO BE OMITTED FOR THIS CASE IS CALCULATED. $ CHDD0085 +2 +2 INPUT ( EXCLUDE ( FOR E = (1,1,20) $ SYE (E) ) ) $ CHDD0086 +2 CARD3.. READ ( $ $ EXCLUDE ) $ CHDD0087 +2 E = 1 $ CHDD0088 +2 FOR J = (1,1,50) $ CHDD0089 +2 BEGIN CHDD0090 +2 IF SYE (E) EQL J $ CHDD0091 +2 ( TE (J) = 1 $ E = E+1 ) CHDD0092 +2 END $ CHDD0093 +2 TOTE = E-1 $ CHDD0094 +2 OUTPUT EOUT ( FOR E = (1,1,TOTE+1) $ SYE (E) ) $ CHDD0095 +2 FORMAT EFORM (B5,*SYMPTOMS OMITTED*,B4,20(I4),W4) $ CHDD0096 +2 WRITE ( $ $ EOUT , EFORM ) $ CHDD0097 +2 TOTX = SHEET+8 $ CHDD0098 +2 +2 COMMENT ONE ROW OF THE MATRIX IS UNPACKED, THE CHDD0099 +2 INDEPENDENT SYMPTOMS PRESENT RECOMPLEMENTED, CHDD0100 +2 AND THE SYMPTOMS OMITTED FOR THIS CASE DELETED. $CHDD0101 +2 +2 XP10.. UNPACK ( M(K, ),SHEET,XRAY,EQUATION $ ROW( ) ) $ CHDD0102 +2 FOR J = (8,1,15) , 24, 25, (30,1,33), 38, 39, 50 $CHDD0103 +2 BEGIN CHDD0104 +2 IF TP(J) EQL 1 $ ROW (J) = 1000 - ROW (J) $ CHDD0105 +2 IF ROW (J) EQL 0 $ CHDD0106 +2 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0107 +2 IF TE (J) EQL 1 $ ROW (J) = 0 CHDD0108 +2 END $ CHDD0109 +2 +2 COMMENT THE ROW-PRODUCT IS CALCULATED FOR THOSE INDEPENDENT CHDD0110 +2 SYMPTOMS COMMON TO BOTH SHEETS, ZERO VALUES TESTED CHDD0111 +2 FOR, AND EACH ELEMENT SCALED. $CHDD0112 +2 +2 PYKX (K)= M (K,1) $ CHDD0113 +2 FOR J= (8,1,15), 24, 25, (30,1,33), 38, 39, 50 $ CHDD0114 +2 BEGIN CHDD0115 +2 FTROW(J) = ROW(J) $ FTROW(J) = FTROW(J)/100.0 $ CHDD0116 +2 IF FTROW (J) NEQ 0.0 $ CHDD0117 +2 PYKX (K) = PYKX(K).FTROW(J) CHDD0118 +2 END $ CHDD0119 +2 +2 +2 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0120 +2 EXCLUSIVE SYMPTOM-SETS COMMON TO BOTH BROWN AND CHDD0121 +2 WHITE SYMPTOM CHECK SHEETS PER TABLE V. $ CHDD0122 +2 +2 X1TO3.. MX (1) = ROW ( SYP (1) ) $ CHDD0123 +2 X4TO7.. IF TE (4) EQL 1 $ CHDD0124 +2 ( MX (2) = 100 $ GO TO X26 ) $ CHDD0125 +2 IF SYP (2) LEQ 7 $ CHDD0126 +2 ( MX (2) = ROW ( SYP(2) ) $ GO TO X26 ) $ CHDD0127 +2 MX (2) = 1000 - ROW(4) - ROW(5) - ROW(6) - ROW(7) $CHDD0128 +2 X26.. X = 3 $ CHDD0129 +2 FOR J = 26 , 28, 34, 36 $ CHDD0130 // WAS: FOR J =*26 , ... (407 MISPRINT?) +2 BEGIN CHDD0131 +2 IF TE (J) EQL 1 $ CHDD0132 +2 ( MX (X) = 100 $ GO TO LAB5 ) $ CHDD0133 +2 IF TP (J) EQL TP (J+1) $ CHDD0134 +2 ( MX(X) = 1000 - ROW(J) - ROW(J+1) $ GO TO LAB5 ) $CHDD0135 +2 IF TP (J) EQL 1 $ CHDD0136 +2 ( MX (X) = ROW (J) $ GO TO LAB5 ) $ CHDD0137 +2 MX (X) = ROW (J+1) $ CHDD0138 +2 LAB5.. X = X+1 CHDD0139 +2 END $ CHDD0140 +2 +2 BNORWH.. IF SHEET EQL 1 $ GO TO WHITE $ CHDD0141 +2 +2 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0142 +2 EXCLUSIVE SYMPTOM-SETS FOR THE BROWN SHEET OPTION. $CHDD0143 +2 +2 BROWN.. IF TP (16) EQL 1 $ ROW (16) = 1000 - ROW (16) $CHDD0144 +2 IF ROW (16) EQL 0 $ CHDD0145 +2 ( PYKX (K) = 0.0 $ GO TO TAL10 ) $ CHDD0146 +2 IF TE (16) EQL 1 $ CHDD0147 +2 ( ROW (16) = 0 $ GO TO X17TO19 ) $ CHDD0148 +2 BEGIN CHDD0149 +2 FTROW (16) = ROW (16) $ CHDD0150 +2 PYKX (K) = PYKX (K).FTROW (16) / 100.0 CHDD0151 +2 END $ CHDD0152 +2 X17TO19.. IF TE (17) EQL 1 $ CHDD0153 +2 ( MX (7) =100 $ GO TO X20 ) $ CHDD0154 +2 IF ( TP(17) EQL TP(18) ) AND ( TP(18) EQL TP(19) ) $CHDD0155 +2 BEGIN CHDD0156 +2 MX(7) =(1000-ROW(17)).(1000-ROW(18)).(1000-ROW(19)) $CHDD0157 +2 GO TO X20 CHDD0158 +2 END $ CHDD0159 +2 IF TP (19) EQL 1 $ CHDD0160 +2 ( MX (7) = ROW (19) $ GO TO X20 ) $ CHDD0161 +2 IF TP (17) EQL 0 $ CHDD0162 +2 ( MX(7) = ROW(18).(1000 - ROW(17) ) $ GO TO X20 ) $CHDD0163 +2 IF TP (18) EQL 0 $ CHDD0164 +2 ( MX(7) = ROW(17).(1000 - ROW(18) ) $ GO TO X20 ) $CHDD0165 +2 MX (7) = ROW(17).ROW(18) $ CHDD0166 +2 +2 X20.. IF TE (20) EQL 1 $ CHDD0167 +2 ( MX (8) = 100 $ GO TO FLTMX ) $ CHDD0168 +2 T2021 = ( 1000 - ROW (20) - ROW (21) ) $ CHDD0169 +2 T22 = ( 1000 0 ROW (22) ) $ CHDD0170 +2 +2 IF ( TP(20) EQL TP(21) ) AND ( TP(21) EQL TP(22) ) CHDD0171 +2 AND ( TP(22) EQL TP(23) ) $ CHDD0172 +2 (MX(8) = T2021.T22.(1000 - ROW(23) ) $ GO TO FLTMX )$CHDD0173 +2 IF TP (20) EQL 1 $ CHDD0174 +2 BEGIN CHDD0175 +2 IF TP (22) EQL 1 $ CHDD0176 +2 ( MX(8) = ROW(20).ROW(22) $ GO TO FLTMX ) $ CHDD0177 +2 MX (8) = ROW (20).T22 $ GO TO FLTMX CHDD0178 +2 END $ CHDD0179 +2 CHDD0180 +2 IF TP (21) EQL 1 $ CHDD0181 +2 BEGIN CHDD0182 +2 IF TP (22) EQL 1 $ CHDD0183 +2 ( MX(8) = ROW(21).ROW(22) $ GO TO FLTMX ) $ CHDD0184 +2 MX (8) = ROW (21).T22 $ GO TO FLTMX CHDD0185 +2 END $ CHDD0186 +2 IF TP (22) EQL 1 $ CHDD0187 +2 ( MX(8) = ROW(22).T2021 $ GO TO FLTMX ) $ CHDD0188 +2 MX (8) = ROW (23) $ GO TO FLTMX $ CHDD0189 +2 +2 COMMENT THE APPROPRIATE VALUE IS OBTAINED FOR THOSE MUTUALLY CHDD0190 +2 EXCLUSIVE SYMPTOM-SETS FOR THE WHITE SHEET OPTION. $CHDD0191 +2 +2 WHITE.. IF (TE(19) EQL TE(42) ) AND ( TE(42) EQL TE(44) ) CHDD0192 +2 AND ( TE(44) EQL 1 ) $ CHDD0193 +2 ( MX (7) = 100 $ GO TO X40 ) $ CHDD0194 +2 T4243 = ( 1000 - ROW(42) - ROW(43) ) $ CHDD0195 +2 T4445 = ( 1000 - ROW(44) - ROW(45) ) $ CHDD0196 +2 +2 IF ( TP(19) EQL TP(42) ) AND ( TP(42) EQL TP(43) ) CHDD0197 +2 AND ( TP(43) EQL TP(44) ) AND ( TP(44) EQL TP(45) ) $CHDD0198 +2 ( MX(7) = (1000 - ROW(19)).T4243.T4445 $ GO TO X40 )$CHDD0199 +2 IF TP (19) EQL 1 $ CHDD0200 +2 ( MX(7) = ROW(19) $ GO TO X40 ) $ CHDD0201 +2 IF TP (42) EQL 1 $ CHDD0202 +2 BEGIN CHDD0203 +2 IF TP(44) EQL 1 $ CHDD0204 +2 ( MX(7) = ROW(42).ROW(44) $ GO TO X40 ) $ CHDD0205 +2 IF TP (45) EQL 1 $ CHDD0206 +2 ( MX(7) = ROW(42).ROW(45) $ GO TO X40 ) $ CHDD0207 +2 MX (7) = ROW (42).T4445 $ GO TO X40 CHDD0208 +2 END $ CHDD0209 +2 IF TP (43) EQL 1 $ CHDD0210 +2 BEGIN CHDD0211 +2 IF TP (44) EQL 1 $ CHDD0212 +2 ( MX(7) = ROW(43).ROW(44) $ GO TO X40 ) $ CHDD0213 +2 IF TP (45) EQL 1 $ CHDD0214 +2 ( MX(7) = ROW(43).ROW(45) $ GO TO X40 ) $ CHDD0215 +2 MX (7) = ROW (43).T4445 $ GO TO X40 CHDD0216 +2 END $ CHDD0217 +2 IF TP (44) EQL 1 $ CHDD0218 +2 ( MX(7) = ROW(44).T4243 $ GO TO X40 ) $ CHDD0219 +2 MX (7) = ROW (45).T4243 $ CHDD0220 +2 +2 X40.. IF TE (40) EQL 1 $ CHDD0221 +2 ( MX (8) = 100 $ GO TO X2369 ) $ CHDD0222 +2 IF TP (40) EQL TP (41) $ CHDD0223 +2 ( MX(8) = 1000 - ROW(40) - ROW(41) $ GO TO X2369 ) $CHDD0224 +2 IF TP (40) EQL 1 $ CHDD0225 +2 ( MX(8) = ROW(40) $ GO TO X2369 ) $ CHDD0226 +2 MX (8) = ROW (41) $ CHDD0227 +2 +2 X2369.. IF ( TE(22) EQL TE(46) ) AND ( TE(46) EQL 1 ) $ CHDD0228 +2 ( MX (9) = 100 $ GO TO FLTMX ) $ CHDD0229 +2 T22 = 1000 - ROW (22) $ CHDD0230 +2 T6789 = 1000 - ROW(46) - ROW(47) - ROW(48) - ROW(49)$CHDD0231 +2 IF ( TP(22) EQL TP(23) ) AND ( TP(23) EQL TP(46) ) CHDD0232 +2 AND ( TP(46) EQL TP(47) ) AND ( TP(47) EQL TP(48) ) CHDD0233 +2 AND ( TP(48) EQL TP(49) ) $ CHDD0234 +2 ( MX(9) = T22.(1000 - ROW(23)).T6789 $ GO TO FLTMX)$CHDD0235 +2 IF TP (22) EQL 1 $ CHDD0236 +2 BEGIN CHDD0237 +2 FOR J = (46,1,49) $ CHDD0238 +2 BEGIN CHDD0239 +2 IF TP (J) EQL 1 $ CHDD0240 +2 ( MX(9) = ROW(J).ROW(22) $ GO TO FLTMX ) CHDD0241 +2 END $ CHDD0242 +2 MX (9) = ROW (22).T6789 $ GO TO FLTMX CHDD0243 +2 END $ CHDD0244 +2 FOR J = (46,1,49) $ CHDD0245 +2 BEGIN CHDD0246 +2 IF TP (J) EQL 1 $ CHDD0247 +2 ( MX(9) = ROW(J).T22 $ GO TO FLTMX ) CHDD0248 +2 END $ CHDD0249 +2 MX (9) = ROW (23) $ GO TO FLTMX $ CHDD0250 +2 +2 FLTMX.. FOR X = (1,1,TOTX) $ CHDD0251 +2 ( FTMX(X) = MX(X) $ FTMX(X) = FTMX(X)/100.00 ) $ CHDD0252 +2 FOR X = (1,1,TOTX) $ CHDD0253 +2 PYKX (K) = PYKX (K).FTMX (X) $ CHDD0254 +2 +2 COMMENT AT THIS POINT, THE ROW-PRODUCT HAS BEEN COMPUTED CHDD0255 +2 AND A TEST IS MADE TO DETERMINE WHETHER THERE CHDD0256 +2 ARE MORE ROWS YET TO BE PROCESSED, OR TO PRINT-OUT. $CHDD0257 +2 +2 TAL10.. K = K+1 $ CHDD0258 +2 IF K LEQ 33 $ GO TO XP10 $ CHDD0259 +2 GO TO NORM $ CHDD0260 +2 +2 COMMENT THE ROW-PROBABILITIES ARE FIRST NORMALIZED TO GIVE A CHDD0261 +2 TRUE PERCENTAGE FIGURE AND LINES 4 - 6 ARE PRINTED. $CHDD0262 +2 +2 NORM.. SUM = 0.0 $ CHDD0263 +2 OUTPUT SHOUT ( OUTSHEET ) $ CHDD0264 +2 FORMAT SHFORM(B5,*SYMPTOMS USED*,B3,A2,W4) $ CHDD0265 +2 WRITE ( $ $ SHOUT , SHFORM ) $ CHDD0266 +2 FOR K = (1,1,33) $ CHDD0267 +2 SUM = SUM + PYKX (K) $ CHDD0268 +2 OUTPUT EQOUT ( EQUATION ) $ CHDD0269 +2 FORMAT EQFORM(B5,*EQUATION USED*,I5,W6) $ CHDD0270 +2 WRITE ( $ $ EQOUT , EQFORM ) $ CHDD0271 +2 FOR K = (1,1,33) $ CHDD0272 +2 PYX (K) = PYKX (K) / SUM $ CHDD0273 +2 +2 +2 +2 FORMAT HEAD(B15,*DISEASE*,B5,*PROBABILITY*,W6) $ CHDD0274 +2 WRITE ( $ $ HEAD ) $ CHDD0275 +2 +2 COMMENT THE PROBABILITIES ARE NOW PRINTED WHICH ARE ONE CHDD0276 +2 PERCENT OR GREATER TOGETHER WITH DISEASE I. D. . $CHDD0277 +2 +2 K = 1 $ CHDD0278 +2 PRINT.. IF PYX (K) LSS 0.01 $ GO TO TALPT $ CHDD0279 +2 SWITCH K, ( Y01,Y02,Y03,Y04,Y05,Y06,Y07,Y08,Y09, CHDD0280 +2 Y10,Y11,Y12,Y13,Y14,Y15,Y16,Y17,Y18,Y19,Y20,Y21, CHDD0281 +2 Y22,Y23,Y24,Y25,Y26,Y27,Y28,Y29,Y30,Y31,Y32,Y33 ) $CHDD0282 +2 OUTPUT ANS ( FOR X = K $ PYX (X) ) $ CHDD0283 +2 FORMAT FORM1 (B8,*Y01*,B7,*N*,S16.4,W0) $ CHDD0284 +2 Y01.. WRITE ( $ $ ANS , FORM1 ) $ GO TO TALPT $ CHDD0285 +2 FORMAT FORM2 (B8,*Y02*,B5,*A S D*,S14.4,W0) $ CHDD0286 +2 Y02.. WRITE ( $ $ ANS , FORM2 ) $ GO TO TALPT $ CHDD0287 +2 FORMAT FORM3 (B8,*Y03*,B2,*A S D - P S*,S11.4,W0) $ CHDD0288 +2 Y03.. WRITE ( $ $ ANS , FORM3 ) $ GO TO TALPT $ CHDD0289 +2 FORMAT FORM4 (B8,*Y04*,B2,*A S D - P H*,S11.4,W0) $ CHDD0290 +2 Y04.. WRITE ( $ $ ANS , FORM4 ) $ GO TO TALPT $ CHDD0291 +2 FORMAT FORM5 (B8,*Y05*,B4,*C E C D*,S13.4,W0) $ CHDD0292 +2 Y05.. WRITE ( $ $ ANS , FORM5 ) $ GO TO TALPT $ CHDD0293 +2 FORMAT FORM6 (B8,*Y06*,B3,*P A P V C*,S12.4,W0) $ CHDD0294 +2 Y06.. WRITE ( $ $ ANS , FORM6 ) $ GO TO TALPT $ CHDD0295 +2 FORMAT FORM7 (B8,*Y07*,B3,*T A P V C*,S12.4,W0) $ CHDD0296 +2 Y07.. WRITE ( $ $ ANS , FORM7 ) $ GO TO TALPT $ CHDD0297 +2 FORMAT FORM8 (B8,*Y08*,B6,*T A*,S15.4,W0) $ CHDD0298 +2 Y08.. WRITE ( $ $ ANS , FORM8 ) $ GO TO TALPT $ CHDD0299 +2 FORMAT FORM9 (B8,*Y09*,B5,*EBST.*,S14.4,W0) $ CHDD0300 +2 Y09.. WRITE ( $ $ ANS , FORM9 ) $ GO TO TALPT $ CHDD0301 +2 FORMAT FORM10(B8,*Y10*,B1,*V S D - V P S*,S10.4,W0) $ CHDD0302 +2 Y10.. WRITE ( $ $ ANS , FORM10 ) $ GO TO TALPT $ CHDD0303 +2 FORMAT FORM11(B8,*Y11*,B1,*V S D - I P S*,S10.4,W0) $ CHDD0304 +2 Y11.. WRITE ( $ $ ANS , FORM11 ) $ GO TO TALPT $ CHDD0305 +2 FORMAT FORM12(B8,*Y12*,B5,*V P S*,S14.4,W0) $ CHDD0306 +2 Y12.. WRITE ( $ $ ANS , FORM12 ) $ GO TO TALPT $ CHDD0307 +2 FORMAT FORM13(B8,*Y13*,B5,*I P S*,S14.4,W0) $ CHDD0308 +2 Y13.. WRITE ( $ $ ANS , FORM13 ) $ GO TO TALPT $ CHDD0309 +2 FORMAT FORM14(B8,*Y14*,B3,*P. ATRES.*,S12.4,W0) $ CHDD0310 +2 Y14.. WRITE ( $ $ ANS , FORM14 ) $ GO TO TALPT $ CHDD0311 +2 FORMAT FORM15(B8,*Y15*,B2,*COARCT. P A*,S11.4,W0) $ CHDD0312 +2 Y15.. WRITE ( $ $ ANS , FORM15 ) $ GO TO TALPT $ CHDD0313 +2 FORMAT FORM16(B8,*Y16*,B6,*P H*,S15.4,W0) $ CHDD0314 +2 Y16.. WRITE ( $ $ ANS , FORM16 ) $ GO TO TALPT $ CHDD0315 +2 FORMAT FORM17(B8,*Y17*,B5,*A P W*,S14.4,W0) $ CHDD0316 +2 Y17.. WRITE ( $ $ ANS , FORM17 ) $ GO TO TALPT $ CHDD0317 +2 FORMAT FORM18(B8,*Y18*,B5,*P D A*,S14.4,W0) $ CHDD0318 +2 Y18.. WRITE ( $ $ ANS , FORM18 ) $ GO TO TALPT $ CHDD0319 +2 FORMAT FORM19(B8,*Y19*,B2,*P A-V FIST.*,S11.4,W0) $ CHDD0320 +2 Y19.. WRITE ( $ $ ANS , FORM19 ) $ GO TO TALPT $ CHDD0321 +2 FORMAT FORM20(B8,*Y20*,B6,*M S*,S15.4,W0) $ CHDD0322 +2 Y20.. WRITE ( $ $ ANS , FORM20 ) $ GO TO TALPT $ CHDD0323 +2 FORMAT FORM21(B8,*Y21*,B4,*MYOC. D*,S13.4,W0) $ CHDD0324 +2 Y21.. WRITE ( $ $ ANS , FORM21 ) $ GO TO TALPT $ CHDD0325 +2 FORMAT FORM22(B8,*Y22*,B2,*A O COR. A*,S12.4,W0) $ CHDD0326 +2 Y22.. WRITE ( $ $ ANS , FORM22 ) $ GO TO TALPT $ CHDD0327 +2 FORMAT FORM23(B8,*Y23*,B2,*A S - VALV.*,S11.4,W0) $ CHDD0328 +2 Y23.. WRITE ( $ $ ANS , FORM23 ) $ GO TO TALPT $ CHDD0329 +2 FORMAT FORM24(B8,*Y24*,B2,*A S - SUB.*,S12.4,W0) $ CHDD0330 +2 Y24.. WRITE ( $ $ ANS , FORM24 ) $ GO TO TALPT $ CHDD0331 +2 FORMAT FORM25(B8,*Y25*,B3,*COARCT. A*,S12.4,W0) $ CHDD0332 +2 Y25.. WRITE ( $ $ ANS , FORM25 ) $ GO TO TALPT $ CHDD0333 +2 FORMAT FORM26(B8,*Y26*,B4,*TRUNC.*,S14.4,W0) $ CHDD0334 +2 Y26.. WRITE ( $ $ ANS , FORM26 ) $ GO TO TALPT $ CHDD0335 +2 FORMAT FORM27(B8,*Y27*,B3,*TRANSP.*,S14.4,W0) $ CHDD0336 +2 Y27.. WRITE ( $ $ ANS , FORM27 ) $ GO TO TALPT $ CHDD0337 +2 FORMAT FORM28(B8,*Y28*,B3,*C TRANSP.*,S12.4,W0) $ CHDD0338 +2 Y28.. WRITE ( $ $ ANS , FORM28 ) $ GO TO TALPT $ CHDD0339 +2 FORMAT FORM29(B8,*Y29*,B4,*AB. A O*,S13.4,W0) $ CHDD0340 +2 Y29.. WRITE ( $ $ ANS , FORM29 ) $ GO TO TALPT $ CHDD0341 +2 FORMAT FORM30(B8,*Y30*,B5,*V S D*,S14.4,W0) $ CHDD0342 +2 Y30.. WRITE ( $ $ ANS , FORM30 ) $ GO TO TALPT $ CHDD0343 +2 FORMAT FORM31(B8,*Y31*,B2,*V S D - P H*,S11.4,W0) $ CHDD0344 +2 Y31.. WRITE ( $ $ ANS , FORM31 ) $ GO TO TALPT $ CHDD0345 +2 FORMAT FORM32(B8,*Y32*,B2,*P D A - P H*,S11.4,W0) $ CHDD0346 +2 Y32.. WRITE ( $ $ ANS , FORM32 ) $ GO TO TALPT $ CHDD0347 +2 FORMAT FORM33(B8,*Y33*,B1,*T A - TRANSP.*,S10.4,W0) $ CHDD0348 +2 Y33.. WRITE ( $ $ ANS , FORM33 ) $ GO TO TALPT $ CHDD0349 +2 +2 TALPT.. K = K+1 $ CHDD0350 +2 IF K LEQ 33 $ GO TO PRINT $ CHDD0351 +2 +2 COMMENT PROGRAM REPEATS TO BEGINNING IF THERE ARE MORE CHDD0352 +2 CASES TO BE RUN, AND HALTS IF NOT. THE INITIALS CHDD0353 +2 H W APPEAR IN THE A-REG. UPON COMPLETION. $CHDD0354 +2 +2 IF LAST EQL 0 $ GO TO NEWCASE $ CHDD0355 +2 STOP 7270061216 $ GO TO NEWCASE $ CHDD0356 +2 FINISH $ CHDD0357 +2 UNPACK +605 7009901000080002400088800014000898000046008680000100104 +605 8041040009080401260090800001000918000041010380210370012 +605 8021626008680000300053802042600868000044006580000300066 +605 8020526008680421260090800001000948000044006580000300066 +605 0000001000080427260090800001000968000044006580000300066 +605 8000010010180201360040800001000908041040003500000010000 +605 8020126008680433270090800001000928000044006580000300066 +605 0000046000080000300060000000100000000001000000000010000 +605 8000010010480000120097804104000488000010009980000120093 +605 8041040004600000100000000004800060031040000000000010000 +605 8020226008680409270090800001000958000044006580000300066 +605 8000030006000000010000000000100000000001000000000010000 +605 8000042008880000410089800001000008041040006400000300000 +605 0000030000080000420090800001200998041040007280410400070 +605 0000041000080401260072000001000000000149000410310400000 +605 8000120007600001490003103104000008000120007900001490003 +605 1031040000080001200082802012700868000032007180000460086 +602 8000030006500000000001 +604 00000010000000000100000000001000000000010000 +604 00000 2000000000070000000000800000000009 +604 00000 15000000000180000000001900000000001 +601 40000000007 +601 40000990000 +2 FINISH $ +777 SYMPTOM-DISEASE MATRIX DATA CARDS FOLLOW THIS CARD +777 CASE DATA CARDS FOLLOW THIS CARD diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/README.txt b/software/BALGOL/BALGOL-Examples/MRS-081/README.txt new file mode 100644 index 0000000..39bf46a --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/README.txt @@ -0,0 +1,85 @@ +Index of folder retro-220/software/BALGOL/BALGOL-Examples/MRS-081: + +Source, object, and compilation listings for BALGOL program from +Burroughs Technical Bulletin 156, 8 June 1961, Mathematical Report +Series MRS-081, "Diagnosis of Congenital Heart Disease from Clinical +Data Using the Burroughs 220 Computer". The program listing is included +in the report and is noted as having been written by Fred B. Fielding of +the Burroughs San Francisco District office in May 1961. + +This report was discovered in the Burroughs Corporation Records, Product +Literature (CBI 90), Charles Babbage Institute, University of +Minnesota, Minneapolis, Series 74, Box 43, Folder 8. + +The program and report are based on a paper, "A Mathematical Approach to +Medical Diagnosis Applied to Congenital Heart Disease" by H. R. Warner, +A. F. Toronto, L.G. Veasy, and R. Stevenson. Journal of the American +Medical Association, + +The report describes a program for computing the probability of a set of +congenital heart diseases occurring in a patient given the presence of a +set of symptoms observed in the patient. It includes sample data and an +example of using a machine-language routine with a BALGOL program. + +To run the program, load the following decks into the Cardatron card +reader in the order indicated and compile with the BALGOL compiler: + + 1. BALGOL compiler call-out card. + 2. MRS-081.card deck -- BALGOL source and machine-language cards. + 3. SYMPTOM-DATA.card deck. + 4. Case-data card deck, e.g., MRS-081-DATA.card. + + +MRS-081.card + The BALGOL source deck, including the object deck for the machine- + language subprogram. This is the original version, as transcribed + from the report. + +MRS-081-DATA.card + Sample case-data card deck for input to the program, derived from + sample run data in the report. This data must be inserted at the end + of MRS-081.card deck when the program is run. + +SYMPTOM-DATA.card + Card deck for the symptom-disease probability matrix used by the + program. This must be inserted after the cards in the MRS-081.card + deck and before any case-data cards. + +UNPACK.card + Source deck for the machine-language UNPACK subprogram used by the + BALGOL program to unpack rows from the symptom-disease probability + matrix during execution. This deck was reverse-engineered from the + numeric object code in the MRS-081.card deck. Assemble with the + BAC-Assembler. + + As published, the machine-language routine was written for the + BALGOL parameter-passing sequence used in the compiler dated + 1961-02-20 -- the one used in the report. The compiler available to + and recovered as part of the retro-220 project (dated 1962-02-01) + passes parameters in the reverse order. Thus, this version of the + subprogram cannot be used with the available compiler. See Appendix + F, "Construction of Machine Language Programs" in the March 1963 + Revised Edition of the BAC-220 Burroughs Algebraic Compiler manual + (220-21017). + +UNPACK.lst + Assembly listing generated from UNPACK.card. + +UNPACK-ML.card + Object machine-language card deck generated by assembling + UNPACK.card. The BAC-Assembler produces a machine-language deck with + six words per card. That output has been manually reformatted to + match the (mostly) five word-per-card layout shown in the report. + This reformatting was done to match the machine-language deck as + presented in the report and to allow direct verification of the + assembled object code with the transcribed object code. The + transcribed object code may never have had an assembler source and + was likely programmed directly in numeric machine language. + + +Paul Kimpel +December 2019 + Original version, transcribe program listing and data, disassemble + machine-language routine to BAC-Assembler notation, prepare sample + data deck. + diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/SYMPTOM-DATA.card b/software/BALGOL/BALGOL-Examples/MRS-081/SYMPTOM-DATA.card new file mode 100644 index 0000000..3440990 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/SYMPTOM-DATA.card @@ -0,0 +1,133 @@ +777 MRS-081 SYMPTOM-DISEASE MATRIX DATA CARDS (132 COUNT) *ROW 00@0 +5 100 *ROW 01@1 +5 010490500 010000010 000990990 900970950 950970950 990700020 *ROW 01@2 +5 070000800 010050990 999010010 150050900 970990990 010020020 *ROW 01@3 +5 020980980 010000020 700040030 000000800 050900000 *ROW 01@4 +5 081 *ROW 02@1 +5 100500500 020010020 000990650 500950980 600990980 980300200 *ROW 02@2 +5 020050900 020020990 990010010 600010200 990990990 700050050 *ROW 02@3 +5 850980980 010020010 300020200 050010900 010400000 *ROW 02@4 +5 005 *ROW 03@1 +5 300600100 200100200 000990400 300950980 900900980 980050050 *ROW 03@2 +5 020570400 010030990 990010020 300150600 990950990 850020200 *ROW 03@3 +5 700980980 010010010 050010050 600010380 010300000 *ROW 03@4 +5 001 *ROW 04@1 +5 100200700 300100250 000990200 100950950 850900980 980150200 *ROW 04@2 +5 020050400 200010990 990010010 950010500 990950990 850050200 *ROW 04@3 +5 700980980 010020010 150200020 050010400 010600000 *ROW 04@4 +5 027 *ROW 05@1 +5 200500300 150050100 000990600 500950950 700950400 850900400 *ROW 05@2 +5 020100200 100010990 990010010 700020600 900900990 050700050 *ROW 05@3 +5 850980980 150010850 050020200 020200200 200200000 *ROW 05@4 +5 005 *ROW 06@1 +5 100400500 010010010 000990850 800990950 950990980 980020020 *ROW 06@2 +5 020020600 050050990 990100150 400020900 990990990 150020020 *ROW 06@3 +5 150980980 020020020 200020020 020020600 020700000 *ROW 06@4 +5 001 *ROW 07@1 +5 200700100 650100050 000990300 200950950 800950980 980100150 *ROW 07@2 +5 100050750 050200990 990100150 850020200 990990990 900020250 *ROW 07@3 +5 750980980 020020300 100010300 050010800 020300000 *ROW 07@4 +5 018 *ROW 08@1 +5 500480020 300650010 000900200 100800950 850900980 950650050 *ROW 08@2 +5 050200200 020050990 990010010 020600990 800700990 020900020 *ROW 08@3 +5 020100900 050020500 150050020 200200200 200500000 *ROW 08@4 +5 001 *ROW 09@1 +5 100450450 220440010 000780200 200900700 850780950 750950250 *ROW 09@2 +5 050050150 020050990 990010010 020350900 800900990 100200020 *ROW 09@3 +5 600980980 250250450 450250250 150150050 050500000 *ROW 09@4 +5 054 *ROW 10@1 +5 400550050 250250100 000700250 100950950 900800980 980200020 *ROW 10@2 +5 050650250 020050980 980100150 100600800 990980990 950020850 *ROW 10@3 +5 100980980 020020200 050020020 600050250 050100000 *ROW 10@4 +5 063 *ROW 11@1 +5 400550050 300300100 000600250 100950950 900750980 980200020 *ROW 11@2 +5 050650250 020050980 980100150 100600800 990980990 950020850 *ROW 11@3 +5 100980980 020020200 050020020 600050250 050100000 *ROW 11@4 +5 045 *ROW 12@1 +5 200700100 010010010 000990500 350990990 990900980 980100020 *ROW 12@2 +5 050700200 020100980 980010010 100600800 990950990 950020850 *ROW 12@3 +5 100980980 010010010 100020020 680010250 010200000 *ROW 12@4 +5 013 *ROW 13@1 +5 200700100 010010010 000990500 350990990 990900980 980100020 *ROW 13@2 +5 020700200 020020980 980010010 100600800 990950990 950020850 *ROW 13@3 +5 100980980 010010010 100010010 680010250 010200000 *ROW 13@4 +5 014 *ROW 14@1 +5 900090010 100900000 000200100 010950000 950650980 980400050 *ROW 14@2 +5 050010020 020050980 980100100 010900800 990980990 950020850 *ROW 14@3 +5 100980980 020010300 400020050 010010020 020800000 *ROW 14@4 +5 001 *ROW 15@1 +5 050450500 010010010 000990990 990990990 990990960 990020010 *ROW 15@2 +5 010020250 020010800 980500050 100020900 990990990 100020100 *ROW 15@3 +5 020980980 010010020 020010000 020010250 020400000 *ROW 15@4 +5 013 *ROW 16@1 +5 100450450 010010010 000990300 050600900 900900990 990300050 *ROW 16@2 +5 010010050 300020980 980020020 950000700 990900990 950020900 *ROW 16@3 +5 050980980 010010010 300150050 020020050 020800000 *ROW 16@4 +5 001 *ROW 17@1 +5 300600100 050010010 000990900 000950990 900990950 900200050 *ROW 17@2 +5 600010100 050200980 980020020 700010800 600990990 010150020 *ROW 17@3 +5 020400950 100020100 200050020 020020100 050250000 *ROW 17@4 +5 072 *ROW 18@1 +5 200400400 010010010 000990800 800900990 900950950 850100020 *ROW 18@2 +5 500020130 050850980 980030050 500010800 600980990 010100020 *ROW 18@3 +5 020500950 100020050 100020020 050020200 100150000 *ROW 18@4 +5 002 *ROW 19@4 +5 200300500 450450010 000990900 800950990 990900950 980100020 *ROW 19@2 +5 200020100 020050990 990050700 050050800 990990990 050050020 *ROW 19@3 +5 020980980 020020100 100020020 020020100 100700000 *ROW 19@4 +5 008 *ROW 20@1 +5 200500300 010010010 000990500 500600950 900900200 800100100 *ROW 20@2 +5 020050100 020020980 980010010 500010800 950980990 500020100 *ROW 20@3 +5 400980980 200200100 100100100 050050100 100300000 *ROW 20@4 +5 013 *ROW 21@1 +5 700290010 010010010 000990600 500800990 950950850 980050020 *ROW 21@2 +5 020020050 020020900 980010010 200020900 500980990 050100050 *ROW 21@3 +5 050600100 020020100 100020020 020020050 050900000 *ROW 21@4 +5 001 *ROW 22@1 +5 700290010 010010010 000990700 700700200 850800950 990010010 *ROW 22@2 +5 010010010 010010990 990010010 200020990 950990990 050100050 *ROW 22@3 +5 050800100 010010010 010010010 010010010 010900000 *ROW 22@4 +5 036 *ROW 23@1 +5 100800100 010010010 000990800 700800850 990650800 980200100 *ROW 23@2 +5 020050050 010010050 950010010 200100990 600990950 050150020 *ROW 23@3 +5 020300850 020020020 200100020 050010050 010100000 *ROW 23@4 +5 009 *ROW 24@1 +5 100800100 010010010 000990800 700800850 990650800 980200100 *ROW 24@2 +5 020050050 010010050 950010010 200100990 600990950 050150020 *ROW 24@3 +5 020300850 020020020 200100020 050010050 010100000 *ROW 24@4 +5 054 *ROW 25@1 +5 100700200 010010010 000990800 700800990 990950950 990200100 *ROW 25@2 +5 020020100 010050850 900800150 100100990 700990010 050050020 *ROW 25@3 +5 020600960 010010050 200100020 020020100 050350000 *ROW 25@4 +5 005 *ROW 26@1 +5 500400100 300600010 000850850 700950990 800900980 980700020 *ROW 26@2 +5 020100100 020020980 980050100 400100700 950990990 300100400 *ROW 26@3 +5 100800950 020020400 400020020 100100100 100600000 *ROW 26@4 +5 063 *ROW 27@1 +5 900100000 200600050 100950400 300800990 950900950 980500020 *ROW 27@2 +5 020030100 020020950 980010010 200100800 800980980 400200300 *ROW 27@3 +5 050800950 020020300 300020020 030030100 100500000 *ROW 27@4 +5 001 *ROW 28@1 +5 300300300 300050100 000990900 800990990 990990950 980700020 *ROW 28@2 +5 020050300 020020950 980010010 200100900 900990990 200100100 *ROW 28@3 +5 100900900 020020300 300020020 050050300 300400000 *ROW 28@4 +5 001 *ROW 29@1 +5 600390010 010010010 800700900 500950800 990800950 980500020 *ROW 29@2 +5 020100300 020020950 980010010 900020600 950990900 700050800 *ROW 29@3 +5 050900950 020020300 300020020 100100300 300800000 *ROW 29@4 +5 252 *ROW 30@1 +5 150700150 010010010 000990800 700950990 850950950 800950050 *ROW 30@2 +5 020100100 050010980 950010010 300020950 700990990 300100050 *ROW 30@3 +5 050850950 200020920 050050010 010100010 100150000 *ROW 30@4 +5 081 *ROW 31@1 +5 300600100 300500100 000950400 300800900 800900950 990500100 *ROW 31@2 +5 020050050 250010980 950010010 900020700 950950990 700050750 *ROW 31@3 +5 150900950 010010300 300100020 010050010 050500000 *ROW 31@4 +5 005 *ROW 32@1 +5 300400300 010010050 500990800 700900990 900950980 980100100 *ROW 32@2 +5 020020200 100020980 980020020 900020700 950950990 700050750 *ROW 32@3 +5 150900950 020020100 100020020 020020200 200800000 *ROW 32@4 +5 009 *ROW 33@1 +5 400550050 500200100 000990200 100800990 700950950 900700050 *ROW 33@2 +5 020100300 100020980 990010010 300100990 800700990 020900020 *ROW 33@3 +5 020100900 100020300 300050050 100100300 300500000 *ROW 33@4 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card new file mode 100644 index 0000000..09b0267 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK-ML.card @@ -0,0 +1,23 @@ +605 7009901000080002400088800014000898000046008680000100104 +605 8041040009080401260090800001000918000041010380210370012 +605 8021626008680000300053802042600868000044006580000300066 +605 8020526008680421260090800001000948000044006580000300066 +605 0000001000080427260090800001000968000044006580000300066 +605 8000010010180201360040800001000908041040003500000010000 +605 8020126008680433270090800001000928000044006580000300066 +605 0000046000080000300060000000100000000001000000000010000 +605 8000010010480000120097804104000488000010009980000120093 +605 8041040004600000100000000004800060031040000000000010000 +605 8020226008680409270090800001000958000044006580000300066 +605 8000030006000000010000000000100000000001000000000010000 +605 8000042008880000410089800001000008041040006400000300000 +605 0000030000080000420090800001200998041040007280410400070 +605 0000041000080401260072000001000000000149000410310400000 +605 8000120007600001490003103104000008000120007900001490003 +605 1031040000080001200082802012700868000032007180000460086 +602 8000030006500000000001 +604 00000010000000000100000000001000000000010000 +604 00000 2000000000070000000000800000000009 +604 00000 15000000000180000000001900000000001 +601 40000000007 +601 40000990000 diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card new file mode 100644 index 0000000..39d22b8 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.card @@ -0,0 +1,150 @@ +1 REM UNPACK WORDS ROUTINE FOR MRS-081 PROGRAM +1 REM +1 REM UNPACKS THREE 3-DIGIT CODES PER WORD FROM A ROW OF THE +1 REM PROGRAM-S M(,) ARRAY TO ANOTHER ARRAY ROW. +1 REM PARAMETERS.. +1 REM M() 1-DIMENSIONAL SOURCE ROW +1 REM (HIDDEN) STRIDE OF M PASSED BY BALGOL +1 REM SHEET SHEET TYPE (0=BROWN, 1=WHITE) +1 REM XRAY XRAY DATA (0=EXCL, 1=INCL, NOT IMPL) +1 REM EQUATION EQUATION NUMBER (9 OR 10) +1 REM ROW() DESTINATION ROW FOR UNPACKED CODES +1 REM (HIDDEN) STRIDE OF ROW PASSED IN A-REG +1 REM +1 REM THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE +1 REM PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS +1 REM WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING +1 REM SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD +1 REM SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR +1 REM THE VERSION OF THE COMPILER DATED 1961-02-20. +1 REM +1 UNPAK NOP 7 *-*,PARAM ENTRY POINT +1 STB 8 SAVEB SAVE B+R REGS +1 STR 8 SAVER +1 CLL 8 COUNT ZERO THE WORD COUNT +1 CAD 8 ROW LOAD ROW() BASE ADDR +1 STA 8 ROWA,04 SET ADDR IN ROWA +1 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1) +1 CAD 8 K2 OFFSET TO M(2) +1 LDR 8 EQNR R = EQUATION NR +1 BFR 8 A+,02,10 BRANCH IF EQNR=10 +1 REM +1 REM UNPACK FOR EQUATION NR NEQ 10 +1 REM +1 IFL 8 COUNT,02,16 SET COUNT=16 +1 BUN 8 F+ BRANCH TO FINISH UP +1 REM +1 REM UNPACK FOR EQUATION NR EQL 10 +1 REM +1 *A IFL 8 COUNT,02,4 SET COUNT = 4 +1 STP 8 UPW CALL TO UPACK 5 WORDS +1 BUN 8 UPW+1 +1 IFL 8 COUNT,02,5 SET COUNT = 5 +1 IFL 8 ROWA,04,21 INCR ROWA TO ROW(22) +1 CAD 8 K9 OFFSET TO M(9) +1 STP 8 UPW CALL TO UNPACK 6 WORDS +1 BUN 8 UPW+1 +1 NOP 0 (NOT USED) +1 IFL 8 ROWA,04,27 INCR ROWA BY 27 TO ROW(49) +1 CAD 8 K18 OFFSET TO M(18) +1 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0) +1 BUN 8 UPW+1 +1 CAD 8 SHEET A = SHEET PARAM +1 BFA 8 B+,02,1 BRANCH IF SHEET=01 +1 REM +1 REM PROCESS SHEET NEQ 1 CASE +1 REM +1 CAD 8 ROWA LOAD CURR ROW() ADDR +1 STA 8 C+,04 SET CLL ADDRESS BELOW +1 NOP 0 (NOT USED) +1 IFL 8 COUNT,02,1 SET COUNT = 1 +1 DFL 8 ROWA,04,33 DECR ROWA BY 33 TO ROW(16) +1 CAD 8 K7 OFFSET TO M(7) +1 STP 8 UPW CALL TO UNPACK 2 WORDS +1 BUN 8 UPW+1 +1 *C CLL *-* CLEAR ROW() CELL SET ABOVE +1 BUN 8 EXIT ALL DONE +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 REM +1 REM PROCESS SHEET EQL 1 CASE +1 REM +1 *B CAD 8 ROW LOAD ROW() BASE ADDRESS +1 ADD 8 K19 OFFSET TO ROW(19) +1 STA 8 D+,04 SET STA ADDRESS BELOW +1 CAD 8 M LOAD BASE ADDRESS OF M() +1 ADD 8 K8 OFFSET TO M(8) +1 STA 8 *+1,04 SET CAD ADDRESS, NEXT +1 CAD *-* LOAD M(8) WORD AS SET ABOVE +1 SRA 6 SHIFT WORD TO 1ST CODE +1 *D STA *-*,03 STORE CODE IN ROW() AS SET ABOVE +1 NOP 0 (NOT USED) +1 IFL 8 COUNT,02,2 SET COUNT = 2 +1 DFL 8 ROWA,04,9 DECR ROWA BY 9 TO ROW(10) +1 CAD 8 K15 OFFSET TO M(15) +1 *F STP 8 UPW CALL TO UNPACK 3 WORDS +1 BUN 8 UPW+1 +1 BUN 8 EXIT ALL DONE +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 NOP 0 (NOT USED) +1 EXIT LDB 8 SAVEB RESTORE B-REG +1 LDR 8 SAVER RESTORE R-REG +1 CAD 8 UNPAK EXTRACT RETURN ADDRESS +1 STA 8 *+1,04 SET RETURN ADDRESS, NEXT +1 BUN *-* RETURN TO CALLER +1 REM +1 REM UPW.. SUBROUTINE TO UNPACK A RANGE OF WORDS +1 REM A-REG OFFSET IN M() TO 1ST SOURCE WORD +1 REM COUNT COUNT -1 OF WORDS TO UNPACK +1 REM ROWA ADDR IN ROW() TO 1ST DESTINATION WORD +1 REM RETURNS WITH A, R, AND B OVERWRITTEN, COUNT SET TO 0 +1 REM +1 UPW BUN *-* RETURN TO CALLER +1 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR +1 ADD 8 M ADD ADDRESS OF M() TO OFFSET +1 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET +1 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET +1 LDR *-* LOAD FIRST WORD OF RANGE +1 *NW IFL 8 *+1,04,1 INCR CAD ADDRESS +1 *MA CAD *-* LOAD NEXT WORD INTO A +1 SLT 4 ROTATE A+R LEFT TO 1ST CODE +1 STA - 0,03 STORE 1ST 3-DIGIT CODE TO ROW() +1 IBB 8 *+1,1 INCR ROW() ADDR +1 SLT 3 ROTATE A+R TO 2ND CODE +1 STA - 0,03 STORE 2ND 3-DIGIT CODE TO ROW() +1 IBB 8 *+1,1 INCR ROW() ADDR +1 SLT 3 ROTATE A+R TO 3RD CODE +1 STA - 0,03 STORE 3RD 3-DIGIT CODE TO ROW() +1 IBB 8 *+1,1 INCR ROW() ADDR +1 DFL 8 COUNT,02,1 DECREMENT WORD COUNT +1 BRP 8 NW- LOOP IF COUNT NOT EXHAUSTED +1 CLL 8 COUNT OTHERWISE, CLEAR COUNT AND +1 BUN 8 UPW EXIT SUBROUTINE +1 REM +1 REM STORAGE, CONSTANTS, AND PARAMETERS +1 REM +1 COUNT CNST 1 WORD COUNT FOR UNPACKING +1 NOP 0 (NOT USED) +1 SAVEB NOP 0 SAVED B-REG +1 SAVER NOP 0 SAVED R-REG +1 ROWA NOP 0 CURRENT ROW() ADDR +1 K2 HLT 2 CONSTANT 2 +1 K7 HLT 7 CONSTANT 7 +1 K8 HLT 8 CONSTANT 8 +1 K9 HLT 9 CONSTANT 9 +1 K15 HLT 15 CONSTANT 15 +1 K18 HLT 18 CONSTANT 18 +1 K19 HLT 19 CONSTANT 19 +1 HLT 1 (NOT USED) +1 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS +1 M DEFN PARAM+0 ADDR OF ARRAY M() +1 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1) +1 SHEET DEFN PARAM+2 SHEET TYPE +1 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED) +1 EQNR DEFN PARAM+4 EQUATION NUMBER +1 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY +1 CNST 40000990000 +1 FINI diff --git a/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst new file mode 100644 index 0000000..7e11685 --- /dev/null +++ b/software/BALGOL/BALGOL-Examples/MRS-081/UNPACK.lst @@ -0,0 +1,168 @@ +Assembler for the Burroughs 220 BALGOL Compiler & Library -- 2019-12-21 15:07 + +Source File: UNPACK.card + +START PASS 2 + + UNPACK WORDS ROUTINE FOR MRS-081 PROGRAM + + UNPACKS THREE 3-DIGIT CODES PER WORD FROM A ROW OF THE + PROGRAM-S M(,) ARRAY TO ANOTHER ARRAY ROW. + PARAMETERS.. + M() 1-DIMENSIONAL SOURCE ROW + (HIDDEN) STRIDE OF M PASSED BY BALGOL + SHEET SHEET TYPE (0=BROWN, 1=WHITE) + XRAY XRAY DATA (0=EXCL, 1=INCL, NOT IMPL) + EQUATION EQUATION NUMBER (9 OR 10) + ROW() DESTINATION ROW FOR UNPACKED CODES + (HIDDEN) STRIDE OF ROW PASSED IN A-REG + + THIS IS THE ORIGINAL VERSION, DISASSEMBLED FROM THE + PUBLISHED CODE, WITH PARAMETERS IN ASCENDING LOCATIONS + WITH RESPECT TO THEIR ORDER IN THE BALGOL CALLING + SEQUENCE, WITH THE (44) FIELD OF THE ENTRY POINT WORD + SPECIFYING THE BEGINNING OF THE PARAMETER AREA, AS FOR + THE VERSION OF THE COMPILER DATED 1961-02-20. + + 21 0000 7 0099 01 0000 UNPAK NOP 7 *-*,PARAM ENTRY POINT + 22 0001 8 0002 40 0088 STB 8 SAVEB SAVE B+R REGS + 23 0002 8 0001 40 0089 STR 8 SAVER + 24 0003 8 0000 46 0086 CLL 8 COUNT ZERO THE WORD COUNT + 25 0004 8 0000 10 0104 CAD 8 ROW LOAD ROW() BASE ADDR + 26 0005 8 0410 40 0090 STA 8 ROWA,04 SET ADDR IN ROWA + 27 0006 8 0401 26 0090 IFL 8 ROWA,04,1 INCR ROWA TO ROW(1) + 28 0007 8 0000 10 0091 CAD 8 K2 OFFSET TO M(2) + 29 0008 8 0000 41 0103 LDR 8 EQNR R = EQUATION NR + 30 0009 8 0210 37 0012 BFR 8 A+,02,10 BRANCH IF EQNR=10 + + UNPACK FOR EQUATION NR NEQ 10 + + 34 0010 8 0216 26 0086 IFL 8 COUNT,02,16 SET COUNT=16 + 35 0011 8 0000 30 0053 BUN 8 F+ BRANCH TO FINISH UP + + UNPACK FOR EQUATION NR EQL 10 + + 39 0012 8 0204 26 0086 *A IFL 8 COUNT,02,4 SET COUNT = 4 + 40 0013 8 0000 44 0065 STP 8 UPW CALL TO UPACK 5 WORDS + 41 0014 8 0000 30 0066 BUN 8 UPW+1 + 42 0015 8 0205 26 0086 IFL 8 COUNT,02,5 SET COUNT = 5 + 43 0016 8 0421 26 0090 IFL 8 ROWA,04,21 INCR ROWA TO ROW(22) + 44 0017 8 0000 10 0094 CAD 8 K9 OFFSET TO M(9) + 45 0018 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 6 WORDS + 46 0019 8 0000 30 0066 BUN 8 UPW+1 + 47 0020 0 0000 01 0000 NOP 0 (NOT USED) + 48 0021 8 0427 26 0090 IFL 8 ROWA,04,27 INCR ROWA BY 27 TO ROW(49) + 49 0022 8 0000 10 0096 CAD 8 K18 OFFSET TO M(18) + 50 0023 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 1 WORD (COUNT=0) + 51 0024 8 0000 30 0066 BUN 8 UPW+1 + 52 0025 8 0000 10 0101 CAD 8 SHEET A = SHEET PARAM + 53 0026 8 0201 36 0040 BFA 8 B+,02,1 BRANCH IF SHEET=01 + + PROCESS SHEET NEQ 1 CASE + + 57 0027 8 0000 10 0090 CAD 8 ROWA LOAD CURR ROW() ADDR + 58 0028 8 0410 40 0035 STA 8 C+,04 SET CLL ADDRESS BELOW + 59 0029 0 0000 01 0000 NOP 0 (NOT USED) + 60 0030 8 0201 26 0086 IFL 8 COUNT,02,1 SET COUNT = 1 + 61 0031 8 0433 27 0090 DFL 8 ROWA,04,33 DECR ROWA BY 33 TO ROW(16) + 62 0032 8 0000 10 0092 CAD 8 K7 OFFSET TO M(7) + 63 0033 8 0000 44 0065 STP 8 UPW CALL TO UNPACK 2 WORDS + 64 0034 8 0000 30 0066 BUN 8 UPW+1 + 65 0035 0 0000 46 0000 *C CLL *-* CLEAR ROW() CELL SET ABOVE + 66 0036 8 0000 30 0060 BUN 8 EXIT ALL DONE + 67 0037 0 0000 01 0000 NOP 0 (NOT USED) + 68 0038 0 0000 01 0000 NOP 0 (NOT USED) + 69 0039 0 0000 01 0000 NOP 0 (NOT USED) + + PROCESS SHEET EQL 1 CASE + + 73 0040 8 0000 10 0104 *B CAD 8 ROW LOAD ROW() BASE ADDRESS + 74 0041 8 0000 12 0097 ADD 8 K19 OFFSET TO ROW(19) + 75 0042 8 0410 40 0048 STA 8 D+,04 SET STA ADDRESS BELOW + 76 0043 8 0000 10 0099 CAD 8 M LOAD BASE ADDRESS OF M() + 77 0044 8 0000 12 0093 ADD 8 K8 OFFSET TO M(8) + 78 0045 8 0410 40 0046 STA 8 *+1,04 SET CAD ADDRESS, NEXT + 79 0046 0 0000 10 0000 CAD *-* LOAD M(8) WORD AS SET ABOVE + 80 0047 0 0000 48 0006 SRA 6 SHIFT WORD TO 1ST CODE + 81 0048 0 0310 40 0000 *D STA *-*,03 STORE CODE IN ROW() AS SET ABOVE + 82 0049 0 0000 01 0000 NOP 0 (NOT USED) + 83 0050 8 0202 26 0086 IFL 8 COUNT,02,2 SET COUNT = 2 + 84 0051 8 0409 27 0090 DFL 8 ROWA,04,9 DECR ROWA BY 9 TO ROW(10) + 85 0052 8 0000 10 0095 CAD 8 K15 OFFSET TO M(15) + 86 0053 8 0000 44 0065 *F STP 8 UPW CALL TO UNPACK 3 WORDS + 87 0054 8 0000 30 0066 BUN 8 UPW+1 + 88 0055 8 0000 30 0060 BUN 8 EXIT ALL DONE + 89 0056 0 0000 01 0000 NOP 0 (NOT USED) + 90 0057 0 0000 01 0000 NOP 0 (NOT USED) + 91 0058 0 0000 01 0000 NOP 0 (NOT USED) + 92 0059 0 0000 01 0000 NOP 0 (NOT USED) + 93 0060 8 0000 42 0088 EXIT LDB 8 SAVEB RESTORE B-REG + 94 0061 8 0000 41 0089 LDR 8 SAVER RESTORE R-REG + 95 0062 8 0000 10 0000 CAD 8 UNPAK EXTRACT RETURN ADDRESS + 96 0063 8 0410 40 0064 STA 8 *+1,04 SET RETURN ADDRESS, NEXT + 97 0064 0 0000 30 0000 BUN *-* RETURN TO CALLER + + UPW.. SUBROUTINE TO UNPACK A RANGE OF WORDS + A-REG OFFSET IN M() TO 1ST SOURCE WORD + COUNT COUNT -1 OF WORDS TO UNPACK + ROWA ADDR IN ROW() TO 1ST DESTINATION WORD + RETURNS WITH A, R, AND B OVERWRITTEN, COUNT SET TO 0 + + 105 0065 0 0000 30 0000 UPW BUN *-* RETURN TO CALLER + 106 0066 8 0000 42 0090 LDB 8 ROWA ENTRY POINT, B = CURR ROW() ADDR + 107 0067 8 0000 12 0099 ADD 8 M ADD ADDRESS OF M() TO OFFSET + 108 0068 8 0410 40 0072 STA 8 MA+,04 SET CAD ADDRESS AT OFFSET + 109 0069 8 0410 40 0070 STA 8 *+1,04 SET LDR ADDRESS AT OFFSET + 110 0070 0 0000 41 0000 LDR *-* LOAD FIRST WORD OF RANGE + 111 0071 8 0401 26 0072 *NW IFL 8 *+1,04,1 INCR CAD ADDRESS + 112 0072 0 0000 10 0000 *MA CAD *-* LOAD NEXT WORD INTO A + 113 0073 0 0001 49 0004 SLT 4 ROTATE A+R LEFT TO 1ST CODE + 114 0074 1 0310 40 0000 STA - 0,03 STORE 1ST 3-DIGIT CODE TO ROW() + 115 0075 8 0001 20 0076 IBB 8 *+1,1 INCR ROW() ADDR + 116 0076 0 0001 49 0003 SLT 3 ROTATE A+R TO 2ND CODE + 117 0077 1 0310 40 0000 STA - 0,03 STORE 2ND 3-DIGIT CODE TO ROW() + 118 0078 8 0001 20 0079 IBB 8 *+1,1 INCR ROW() ADDR + 119 0079 0 0001 49 0003 SLT 3 ROTATE A+R TO 3RD CODE + 120 0080 1 0310 40 0000 STA - 0,03 STORE 3RD 3-DIGIT CODE TO ROW() + 121 0081 8 0001 20 0082 IBB 8 *+1,1 INCR ROW() ADDR + 122 0082 8 0201 27 0086 DFL 8 COUNT,02,1 DECREMENT WORD COUNT + 123 0083 8 0000 32 0071 BRP 8 NW- LOOP IF COUNT NOT EXHAUSTED + 124 0084 8 0000 46 0086 CLL 8 COUNT OTHERWISE, CLEAR COUNT AND + 125 0085 8 0000 30 0065 BUN 8 UPW EXIT SUBROUTINE + + STORAGE, CONSTANTS, AND PARAMETERS + + 129 0086 0 0000 00 0001 COUNT CNST 1 WORD COUNT FOR UNPACKING + 130 0087 0 0000 01 0000 NOP 0 (NOT USED) + 131 0088 0 0000 01 0000 SAVEB NOP 0 SAVED B-REG + 132 0089 0 0000 01 0000 SAVER NOP 0 SAVED R-REG + 133 0090 0 0000 01 0000 ROWA NOP 0 CURRENT ROW() ADDR + 134 0091 0 0000 00 0002 K2 HLT 2 CONSTANT 2 + 135 0092 0 0000 00 0007 K7 HLT 7 CONSTANT 7 + 136 0093 0 0000 00 0008 K8 HLT 8 CONSTANT 8 + 137 0094 0 0000 00 0009 K9 HLT 9 CONSTANT 9 + 138 0095 0 0000 00 0015 K15 HLT 15 CONSTANT 15 + 139 0096 0 0000 00 0018 K18 HLT 18 CONSTANT 18 + 140 0097 0 0000 00 0019 K19 HLT 19 CONSTANT 19 + 141 0098 0 0000 00 0001 HLT 1 (NOT USED) + 142 0099 4 0000 00 0007 PARAM CNST 40000000007 ALLOCATE STORAGE FOR PARAMETERS + 143 0100 M DEFN PARAM+0 ADDR OF ARRAY M() + 144 0100 M1STR DEFN PARAM+1 STRIDE FOR M() (NOT USED, =1) + 145 0100 SHEET DEFN PARAM+2 SHEET TYPE + 146 0100 XRAY DEFN PARAM+3 XRAY PARAM (NOT USED) + 147 0100 EQNR DEFN PARAM+4 EQUATION NUMBER + 148 0100 ROW DEFN PARAM+5 ADDR OF OUTPUT ROW() ARRAY + 149 0100 4 0000 99 0000 CNST 40000990000 + 150 0101 FINI + + +SYMBOL TABLE + + 12 *A..1 40 *B..1 35 *C..1 48 *D..1 53 *F..1 + 72 *MA.1 71 *NW.1 8 BMOD 86 COUNT 103 EQNR + 60 EXIT 95 K15 96 K18 97 K19 91 K2 + 92 K7 93 K8 94 K9 99 M 100 M1STR + 99 PARAM 1 RLO 104 ROW 90 ROWA 88 SAVEB + 89 SAVER 101 SHEET 0 UNPAK 65 UPW 102 XRAY + +END PASS 2, ERRORS = 0