ibm:ibm1130-lib:dmsr2v12:kforph10_lst
KFORPH10
| Table Of Contents |
|---|
|
- kforph10.lst
ASM1130 CROSS ASSEMBLER V1.22 -- V2M12 -- Sun Nov 1 19:25:06 2020 Source File: \kforph10.asm 1130 FORTRAN COMPILER PHASE 10 2 | *************************************************** K1000020 3 | * * K1000030 4 | *STATUS - VERSION 2 MODIFICATION 8 * K1000040 5 | * * K1000050 6 | *FUNCTION/OPERATION- * K1000060 7 | * * CONVERTS FORMAT STATEMENTS INTO A CHAIN OF * K1000070 8 | * FORMAT SPECIFICATIONS FOR INTERPERTATION BY * K1000080 9 | * THE FORTRAN I/O SUBROUTINE. * K1000090 10 | * * CHECKS THAT ALL FORMAT STATEMENTS HAVE A * K1000100 11 | * STATEMENT NUMBER. * K1000110 12 | * * CHECKS FORMAT STATEMENTS FOR SYNTAX AND * K1000120 13 | * VALID STATEMENT TYPES. * K1000130 14 | * * CONVERTS QUOTE TYPE FORMAT TO H TYPE. * K1000140 15 | * * K1000150 16 | *ENTRY POINTS * K1000160 17 | * * START-ENTERED BY ROL SUBPROGRAM FR PREV PHS * K1000170 18 | * * K1000180 19 | *INPUT- * K1000190 20 | * * STRING AREA * K1000200 21 | * * SYMBOL TABLE AREA * K1000210 22 | * * FCOM * K1000220 23 | * * K1000230 24 | *OUTPUT- * K1000240 25 | * * STRING AREA * K1000250 26 | * * SYMBOL TABLE AREA * K1000260 27 | * * FCOM * K1000270 28 | * * K1000280 29 | *EXTERNAL REFERENCES * K1000290 30 | * SUBROUTINES- * K1000300 31 | * * ROL * K1000310 32 | * COMMA/DCOM- * K1000320 33 | * * $PHSE * K1000330 34 | * * K1000340 35 | *EXITS- * K1000350 36 | * NORMAL-A CALL TO ROL LOADS IN THE NEXT PHASE * K1000360 37 | * ERROR- * K1000370 38 | * * OVERLAP ERROR CAUSES PHASE TO STOP * K1000380 39 | * PROCESSING AND AN EXIT TO THE NEXT PHASE * K1000390 40 | * * COMPILATION ERRORS DETECTED BY THIS PHASE* K1000400 41 | * ARE 27, 28, 29, 30 * K1000410 42 | * * K1000420 43 | *TABLES/WORK AREAS- * K1000430 44 | * * FCOM * K1000440 45 | * * SYMBOL TABLE * K1000450 46 | * * STRING AREA * K1000460 47 | * * K1000470 48 | *ATTRIBUTES-N/A * K1000480 49 | * * K1000490 50 | *NOTES- * K1000500 51 | * THE SWITCHES USED IN THIS PHASE FOLLOW * K1000510 52 | * IF NON-ZERO, THE SWITCH IS TRANSFER =T. * K1000520 53 | * IF ZERO, THE SWITCH IS NORMAL = N. * K1000530 54 | * SW1-BEGINNING OF SPECIFICATION * K1000540 55 | * N=BEGINNING OF SPECIFICATION * K1000550 56 | * SW2-I TYPE SPECIFICATION * K1000560 57 | * T=I TYPE SPECIFICATION * K1000570 58 | * SW3-SECOND NUMBER OF SPECIFICATION * K1000580 59 | * T=SECOND NUMBER OF SPECIFICATION * K1000590 60 | * SW4-LEFT/RIGHT SW FOR INPUT DATA (GET SUBR)* K1000600 61 | * N=LEFT * K1000610 62 | * SW5-END OF STMNT SW (GET SUBR) * K1000620 63 | * T=END OF STATEMENT * K1000630 64 | * SW6-COMMA ALLOWABLE * K1000640 65 | * N=COMMA ALLOWABLE * K1000650 66 | * SW7-LEFT/RIGHT SW FOR HOLL O/P SPEC * K1000660 67 | * N=LEFT * K1000670 68 | * SW8-COMMA MANDATORY * K1000680 69 | * T=COMMA NOT MANDATORY * K1000690 70 | * SW9-REDO OUTPUT * K1000700 71 | * T=OK TO PUT OUT REDO COUNT * K1000710 72 | * SW11-H OR QUOTE TYPE SPECIFICATION * K1000720 73 | * T=H OR QUOTE TYPE SPECIFICATION * K1000730 74 | * SW12-QUOTE TYPE SPECIFICATION * K1000740 75 | * T=QUOTE TYPE SPECIFICATION * K1000750 76 | * SW15-DIGIT ENCOUNTERED * K1000760 77 | * T=DIGIT ENCOUNTERED * K1000770 78 | * SW16-INCOMPLETE SPECIFICATION * K1000780 79 | * T=INCOMPLETE SPECIFICATION * K1000790 80 | * * K1000800 81 | *************************************************** K1000810 1130 FORTRAN COMPILER PHASE 10 83 | ABS K1000830 84 | * K1000840 85 | * SYSTEM EQUATES K1000850 8000 86 | MEMRY EQU /8000 K1000860 7A23 87 | OVERL EQU MEMRY-1501 START OF FCOM 2-4 K1000870 7FBC 88 | ROL EQU MEMRY-68 LOCN OF RTN TO READ NXT PH K1000880 0078 89 | $PHSE EQU /78 NO. OF PHASE NOW IN CORE K1000890 7A23 90 | ORG OVERL K1000900 0028 91 | PHID EQU 40 ID NUMBER THIS PHASE K1000910 0003 92 | PHLEN EQU 3 NO. SECTORS THIS PHASE K1000915 93 | * K1000920 94 | * FORTRAN COMMUNICATION AREA K1000930 7A23 95 | ORG BSS 1 ORIGIN ADDRESS 2-4 K1000935 7A24 96 | SOFS BSS 1 START OF STRING K1000940 7A25 97 | EOFS BSS 1 END OF STRING K1000950 7A26 98 | SOFST BSS 1 START OF SYMBOL TABLE K1000960 7A27 99 | SOFNS BSS 1 START OF NON-STATEMENT NUMBERS K1000970 7A28 100 | SOFXT BSS 1 START OF SUBSCRIPT TEMPORARIES K1000980 7A29 101 | SOFGT BSS 1 START OF GENERATED TEMPORARIES K1000990 7A2A 102 | EOFST BSS 1 END OF SYMBOL TABLE K1001000 7A2B 103 | COMON BSS 1 NEXT AVAILABLE COMMON K1001010 7A2C 104 | CSIZE BSS 1 SIZE OF COMMON K1001020 7A2D 105 | ERROR BSS 1 OVERLAP ERROR K1001030 7A2E 106 | FNAME BSS 1 PROGRAM NAME K1001040 7A2F 107 | BSS 1 K1001050 7A30 108 | SORF BSS 1 SUBROUTINE(-) OR FUNCTION(+) K1001060 7A31 109 | CCWD BSS 1 CONTROL CARD WORD K1001070 110 | * BIT 15 TRANSFER TRACE K1001080 111 | * BIT 14 ARITHMETIC TRACE K1001090 112 | * BIT 13 EXTENDED PRECISION K1001100 113 | * BIT 12 LIST SYMBOL TABLE K1001110 114 | * BIT 11 LIST SUBPROGRAM NAMES K1001120 115 | * BIT 10 LIST SOURCE PROGRAM K1001130 116 | * BIT 9 ONE WORD INTEGERS K1001140 117 | * BIT 8 ORIGIN 2-4 K1001145 7A32 118 | IOCS BSS 1 IOCS CONTROL CARD WORD K1001150 119 | * BIT 15 CARD K1001160 120 | * BIT 14 PAPER TAPE K1001170 121 | * BIT 13 TYPEWRITER K1001180 122 | * BIT 12 1403 PRINTER K1001190 123 | * BIT 11 2501 READER K1001200 124 | * BIT 10 KEYBOARD K1001210 125 | * BIT 9 1442 PUNCH K1001220 126 | * BIT 8 DISK K1001230 127 | * BIT 7 1132 PRINTER K1001240 128 | * BIT 3 PLOTTER K1001250 129 | * BIT 1 UNFORMATTED DISK K1001260 7A33 130 | DFCNT BSS 1 K1001270 131 | * K1001280 132 | * K1001290 133 | * END OF FORTRAN COMMUNICATION K1001300 134 | * AREA K1001310 135 | *************************************************** K1001320 1130 FORTRAN COMPILER PHASE 10 137 | * K1001340 7A36 138 | BPHAR EQU *+2 K1001350 7A34 0000 139 | DC 0 LOADER WORK AREA K1001360 7A35 FFD8 140 | DC -40 PHASE ID FOR SLET LOOKUP K1001370 7A36 000C 141 | DC NXTPH-*+1 TABLE FOR NEXT PHASE ENTRY K1001380 7A37 0001 142 | DC 1 ONE ENTRY TO BE SET BY LDR K1001390 7A36 143 | ORG *-2 K1001400 144 | * K1001410 7A36 6128 145 | START LDX 1 PHID GET ID THIS PHASE K1001420 7A37 6D00 0078 146 | STX L1 $PHSE SAVE IN SYSTEM PHASE AREA K1001430 147 | * OVERLAP ERROR ON K1001440 148 | * K1001450 7A39 C0F3 149 | LD ERROR LD OVERLAP ERROR FLAG K1001460 7A3A 4C18 7A46 150 | BSC L LXQ,+- BR IF NO ERROR K1001470 151 | * K1001480 152 | * K1001490 7A3C 6580 7A43 153 | OUT LDX I1 NXTPH+1 LOAD PARAM FOR READING K1001500 7A3E C805 154 | LDD NXTPH+2 *NEXT PHASE K1001510 7A3F 4C00 7FBC 155 | BSC L ROL GO TO READ NEXT PHASE K1001520 7A42 156 | BSS E 0 K1001530 7A42 0029 157 | NXTPH DC 41 ID OF NEXT PHASE K1001540 7A43 158 | BSS 3 LOADER TABLE FOR NXT PHS K1001550 159 | * K1001560 160 | * MOVE STRING TO SYMBOL TABLE K1001570 7A46 6680 7A2A 161 | LXQ LDX I2 EOFST GET POINTER TO O/P STRING K1001580 7A48 6580 7A25 162 | LDX I1 EOFS GET POINTER TO I/P STRING K1001590 7A4A C0DA 163 | LD EOFS COMPUTE NUMBER OF WORDS IN K1001600 7A4B 90D8 164 | S SOFS *THE STRING-1 K1001610 7A4C D001 165 | STO XX+1 SAVE STRING LENGTH-1 K1001620 7A4D 6700 0000 166 | XX LDX L3 0 PUT STRING LENGTH-1 IN XR3 K1001630 7A4F 7301 167 | MDX 3 1 INCR STRING LENGTH-1 BY 1 K1001640 7A50 C100 168 | LOOPP LD 1 0 LD WD FROM I/P STRING K1001650 7A51 D2FF 169 | STO 2 -1 SAVE IN O/P STRING K1001660 7A52 71FF 170 | MDX 1 -1 DECR I/P POINTER K1001670 7A53 72FF 171 | MDX 2 -1 DECR O/P POINTER K1001680 7A54 73FF 172 | MDX 3 -1 DECR STRING LENGTH COUNT K1001690 7A55 70FA 173 | MDX LOOPP LOOP UNLESS FINISHED K1001700 7A56 6A04 174 | STX 2 ORIG+1 SAVE START LOC O/P STRING K1001710 7A57 6680 7A24 175 | LDX I2 SOFS GET START LOC I/P STRING K1001720 7A59 6A4F 176 | STX 2 NEOFS SAVE TEMPORARILY K1001730 177 | * K1001740 178 | * INITIALIZE PHASE K1001750 7A5A 6500 0000 179 | ORIG LDX L1 0 PREV O/P STRING PT NOW I/P K1001760 180 | * K1001770 181 | * END STATEMENT K1001780 7A5C C100 182 | ABEL LD 1 0 GET ID WD FR I/P STRING K1001790 7A5D 1801 183 | SRA 1 SHIFT OUT LOW ORDER BIT K1001800 7A5E E045 184 | AND IDTPE MASK IN ID TYPE BITS (1-5) K1001810 7A5F 9045 185 | S ENDC TEST FOR END STMNT K1001820 7A60 4C20 7A66 186 | BSC L CBEL,Z BR IF NOT END K1001830 7A62 C100 187 | LD 1 0 MOVE END STMNT FR I/P K1001840 7A63 D200 188 | STO 2 0 *STRING TO O/P STRING K1001850 7A64 6AC0 189 | STX 2 EOFS SAVE END OF O/P STRING PT K1001860 7A65 70D6 190 | MDX OUT BR TO EXIT FR THIS PHASE K1001870 191 | * K1001880 192 | * FORMAT STATEMENT K1001890 7A66 903F 193 | CBEL S FORMC TEST FOR FORMAT STMNT K1001900 7A67 4C18 7A78 194 | BSC L DECEM,+- BRANCH IF FOUND K1001910 195 | * K1001920 196 | * MOVE NON FORMAT STATEMENT K1001930 7A69 692E 197 | STX 1 VENT SAVE I/P STRING POINTER K1001940 7A6A C100 198 | LD 1 0 LD ID WD FR STRING K1001950 7A6B 1802 199 | SRA 2 RIGHT JUSTIFY STMNT NORM K1001960 7A6C E03F 200 | AND IDNRM MASK STMNT NORM K1001970 7A6D D001 201 | STO VENT1+1 SAVE AS WORD COUNT K1001980 7A6E 6700 0000 202 | VENT1 LDX L3 0 GET WD CNT THIS STMNT K1001990 7A70 C100 203 | LUP LD 1 0 LD WD I/P STRING K1002000 7A71 D200 204 | STO 2 0 SAVE IN O/P STRING K1002010 7A72 7101 205 | MDX 1 1 INCR. I/P STRING PT K1002020 7A73 7201 206 | MDX 2 1 INCR O/P STRING PT K1002030 7A74 73FF 207 | MDX 3 -1 DECR WD COUNT K1002040 7A75 70FA 208 | MDX LUP LOOP UNLESS FINISHED K1002050 7A76 6A32 209 | STX 2 NEOFS SAVE END OF O/P STRING K1002060 7A77 70E4 210 | MDX ABEL BR TO PROCESS NXT STMNT K1002070 211 | * K1002080 212 | * STATEMENT NUMBER K1002090 7A78 6932 213 | DECEM STX 1 IDSAV SAVE LOC OF I/P ID WD K1002100 7A79 C100 214 | LD 1 0 GET ID WORD K1002110 7A7A D02D 215 | STO IDSTO SAVE IN TEMP STORAGE K1002120 7A7B 4C04 7AC0 216 | BSC L INDIC,E BR IF STMNT NUMBERED K1002130 217 | * K1002140 218 | * SET UP ERROR NO = 28 K1002150 7A7D C029 219 | LD ERRA LOAD ERROR NO. CON = 28 K1002160 7A7E D02B 220 | STO ERRNO SAVE FOR OUTPUT PURPOSE K1002170 221 | * K1002180 222 | * REPLACE STATEMENT WITH ERROR K1002190 7A7F C028 223 | BAKER LD IDSTO LD ID WORD K1002200 7A80 1802 224 | SRA 2 RIGHT JUSTIFY NORM K1002210 7A81 E02A 225 | AND IDNRM MASK NORM BITS K1002220 7A82 D02A 226 | STO NRMSV SAVE NORM K1002230 7A83 8027 227 | A IDSAV INCR BY LOC OF ID K1002240 7A84 D02A 228 | STO GET1 SAVE AS START OF NXT STMNT K1002250 7A85 6680 7AA9 229 | LDX I2 NEOFS PUT END O/P STRING PT XR2 K1002260 7A87 C020 230 | LD IDSTO LD ID WD K1002270 7A88 4C04 7A8B 231 | BSC L JAM,E BR IF STMNT NUMBERED K1002280 7A8A 7004 232 | MDX JAM+4 BR TO CONTINUE K1002290 7A8B C00D 233 | JAM LD ERIID LD ERR ID WD +STMNT NO.FLAG K1002300 7A8C D200 234 | STO 2 0 SAVE IN O/P STRING K1002310 7A8D 7201 235 | MDX 2 1 INCR O/P STRING PT K1002320 7A8E 7002 236 | MDX JAM+6 SKIP NXT 2 INSTRUCTIONS K1002330 7A8F C01E 237 | LD ERRID LD ERR ID WD W/O STMNT NO. K1002340 7A90 D200 238 | STO 2 0 SAVE IN O/P STRING K1002350 7A91 C018 239 | LD ERRNO GET ERROR NUMBER K1002360 7A92 D201 240 | STO 2 1 SAVE IN O/P STRING K1002370 7A93 7202 241 | MDX 2 2 INCR O/P STRING PT K1002380 7A94 6A14 242 | STX 2 NEOFS SAVE POINTER K1002390 7A95 6580 7AAF 243 | LDX I1 GET1 GET LOC OF NXT STMNT K1002400 7A97 70C4 244 | MDX ABEL BR TO PROCESS NXT STMNT K1002410 245 | * K1002420 246 | * CONSTANTS K1002430 7A98 0000 247 | VENT DC 0 LOC I/P STRING ID WD K1002440 7A99 A00D 248 | ERIID DC /A00D ERR ID W/ STMNT NO. FLAG K1002450 7A9A 249 | BSS E 0 K1002460 7A9A 0000 250 | SUM DC 0 SUM TABLE K1002470 7A9B 0000 251 | SW1 DC 0 BEGINNING OF SPEC SW K1002480 7A9C 0000 252 | SW2 DC 0 I TYPE SPEC SW K1002490 7A9D 0000 253 | SW3 DC 0 2ND NO. OF SPEC SW K1002500 7A9E 0000 254 | SW4 DC 0 LEFT/RIGHT CHAR SW FOR GET K1002510 7A9F 0000 255 | SW5 DC 0 END OF STMNT SW FOR GET K1002520 7AA0 0000 256 | SW6 DC 0 COMMA ALLOWABLE SW K1002530 7AA1 0000 257 | SW7 DC 0 LEFT/RIGHT SW FOR H SPEC K1002540 7AA2 0000 258 | SW8 DC 0 COMMA MANDATORY SW K1002550 7AA3 0000 259 | SW9 DC 0 REDO SW K1002560 7AA4 7C00 260 | IDTPE DC /7C00 MASK FOR STRING ID WORD K1002570 7AA5 0800 261 | ENDC DC /0800 END STMNT CONSTANT K1002580 7AA6 2800 262 | FORMC DC /3000-/0800 FORMAT TYPE CONSTANT K1002590 7AA7 001C 263 | ERRA DC 28 CONSTANT ERR 28 K1002600 7AA8 0000 264 | IDSTO DC 0 ID WD STORAGE K1002610 7AA9 0000 265 | NEOFS DC 0 END OF OUTPUT STRING K1002620 7AAA 0000 266 | ERRNO DC 0 ERROR NO. FOR O/P K1002630 7AAB 0000 267 | IDSAV DC 0 LOC OF ID WORD K1002640 7AAC 01FF 268 | IDNRM DC /01FF MASK TO GET NORM K1002650 7AAD 0000 269 | NRMSV DC 0 NORM CURRENT STMNT K1002660 7AAE A008 270 | ERRID DC /A008 ERROR ID NO STMNT NO. K1002670 7AAF 0000 271 | GET1 DC 0 LOC. OF NXT STMNT IN STRING K1002680 7AB0 07FF 272 | MASK DC /07FF STMNT NO. MASK K1002690 7AB1 0040 273 | MASK1 DC /0040 FORMAT FLAG FOR SYM TBL K1002700 7AB2 00FF 274 | MASKK DC /00FF RIGHT CHAR MASK. K1002710 7AB3 0000 275 | SAVE DC 0 SYM TBL POINTER K1002720 7AB4 FFFD 276 | THREE DC /FFFD MINUS THREE CONSTANT K1002730 7AB5 00F0 277 | MASK2 DC /00F0 NUMERIC EBC CONSTANT MASK K1002740 7AB6 000A 278 | TEN DC 10 CONSTANT TEN K1002750 7AB7 0091 279 | N145 DC 145 MAX LENGTH FMT STRING K1002760 7AB8 001B 280 | ERRB DC 27 ERR 27 CONSTANT K1002770 7AB9 FFFF 281 | MONE DC /FFFF MINUS ONE CONSTANT K1002780 7ABA 0000 282 | REDO DC 0 REDO INDICATOR K1002790 7ABB 0000 283 | NORM DC 0 NORM O/P STMNT-2 K1002800 7ABC 0000 284 | NCNT DC 0 NORM O/P STMNT-2 K1002810 7ABD 0002 285 | TWO DC 2 CONSTANT K1002820 7ABE 0009 286 | NINE DC 9 CONSTANT K1002830 7ABF 0000 287 | SW15 DC 0 DIGIT ENCOUNTERED SW K1002840 288 | * K1002850 289 | * INDICATE FORMAT STATEMENT K1002860 290 | * IN SYMBOL TABLE ID WORD K1002870 291 | * K1002880 7AC0 C101 292 | INDIC LD 1 1 MOVE SYM TBL POINTER FR I/P K1002890 7AC1 D201 293 | STO 2 1 *STRING TO O/P STRING K1002900 7AC2 E0ED 294 | AND MASK MASK OUT HIGH ORDER BITS K1002910 7AC3 A0F0 295 | M THREE SYM TBL PT TO STMNT NO. K1002920 7AC4 1090 296 | SLT 16 *BY -3 K1002930 7AC5 90EE 297 | S THREE SUBTRACT -3 K1002940 7AC6 8400 7A26 298 | A L SOFST ADD TO START OF SYM TBL K1002950 7AC8 D0EA 299 | STO SAVE SAVE SYM TBL ADDR STMNT NO. K1002960 7AC9 6780 7AB3 300 | LDX I3 SAVE PUT SYM TBL ADDR XR3 K1002970 7ACB C300 301 | LD 3 0 LD SYM TBL ID WD K1002980 7ACC E8E4 302 | OR MASK1 FLAG BIT 9 OF SYM TBL ID WD K1002990 7ACD D300 303 | STO 3 0 *TO INDICATE FMT STMNT K1003000 304 | * K1003010 305 | * INITIALIZE TO SCAN BODY OF K1003020 306 | * STATEMENT K1003030 7ACE C100 307 | LD 1 0 MOVE STRING ID WD FR I/P K1003040 7ACF D200 308 | STO 2 0 *TO O/P STRING K1003050 7AD0 6E00 7DA4 309 | STX L2 VIGG SAVE LOC O/P STRING ID WD K1003060 7AD2 1802 310 | SRA 2 RIGHT JUSTIFY NORM K1003070 7AD3 E0D8 311 | AND IDNRM MASK TO GET NORM BITS ONLY K1003080 7AD4 D0D8 312 | STO NRMSV SAVE NORM K1003090 7AD5 90E7 313 | S TWO DECR BY 2 WDS (ID+STMNT NO) K1003100 7AD6 D0E5 314 | STO NCNT SAVE WD CNT K1003110 7AD7 D0E3 315 | STO NORM SAVE WD CNT K1003120 7AD8 C0E0 316 | LD MONE LD -1 K1003130 7AD9 D400 7BAA 317 | STO L LOOP INITIALIZE NO. REPEATS. K1003140 7ADB 7102 318 | MDX 1 2 MOVE PTR PAST ID & STMNT NO K1003150 7ADC 630A 319 | LDX 3 10 SET UP TO CLEAR SUM AND SWS K1003160 7ADD 1010 320 | SLA 16 CLEAR ACC K1003170 7ADE D400 7DA5 321 | STO L TABC CLEAR WD CNT O/P STRING K1003180 7AE0 7202 322 | MDX 2 2 INCR O/P STRING PT K1003190 7AE1 D700 7A99 323 | STO L3 SUM-1 ZERO SUM & SWITCH AREA. K1003200 7AE3 73FF 324 | MDX 3 -1 DECR TABLE COUNT K1003210 7AE4 70FC 325 | MDX *-4 LOOP IF NOT DONE K1003220 7AE5 D400 7C71 326 | STO L SW11 ZERO H OR QUOTE SW K1003230 7AE7 D037 327 | STO SW12 ZERO QUOTE TYPE SPEC SW K1003240 7AE8 D0D1 328 | STO REDO ZERO REDO SW K1003250 7AE9 D400 7BB0 329 | STO L REP ZERO REPEAT SW K1003260 7AEB D400 7B1C 330 | STO L GREP ZERO GROUP REPEAT SW K1003270 7AED D0D1 331 | STO SW15 ZERO DIGIT ENCOUNTERED SW K1003280 332 | * K1003290 333 | * GET CHAR FROM FORMAT STRING K1003300 7AEE 4400 7D5C 334 | BSI L GET BR TO SUBR TO GET CHAR K1003310 335 | * K1003320 336 | * X=LEFT PARENTHESIS K1003330 7AF0 9020 337 | S PARNL TEST FOR LEFT PARENTHESIS. K1003340 7AF1 4C20 7B09 338 | BSC L J,Z BR IF NOT FOUND (ERR 27) K1003350 339 | * K1003360 340 | * GET X K1003370 7AF3 4400 7D5C 341 | DOG BSI L GET GET NXT CHAR FR FMT STMNT K1003380 7AF5 D01C 342 | STO X SAVE CHAR K1003390 343 | * K1003400 344 | * IS X NUMERIC K1003410 7AF6 90BE 345 | S MASK2 SUBTRACT NUMERIC EBC CON F0 K1003420 7AF7 4C28 7B21 346 | BSC L TST,+Z BR IF NOT NUMERIC K1003430 7AF9 90C4 347 | S NINE TEST IF NO. GT 9 K1003440 7AFA 4C30 7B21 348 | BSC L TST,Z- BR IF YES K1003450 349 | * K1003460 350 | * SUM=SUM*10+X K1003470 7AFC C09D 351 | LD SUM GET PREV SUM K1003480 7AFD A0B8 352 | M TEN MPY BY 10 K1003490 7AFE 1090 353 | SLT 16 SHIFT ANS TO ACC K1003500 7AFF 90B5 354 | S MASK2 REMOVE BITS 0-3 FR PRODUCT K1003510 7B00 8011 355 | A X ADD CHAR K1003520 7B01 D098 356 | STO SUM SAVE K1003530 357 | * K1003540 358 | * TAG SW15 DIGIT ENCOUNTERED SW K1003550 359 | * SET SW NON ZERO K1003560 7B02 68BC 360 | STX 0 SW15 K1003570 361 | * SUM GREATER THAN 145 K1003580 7B03 90B3 362 | S N145 SUBTRACT CON 145 K1003590 7B04 4C30 7CC5 363 | BSC L ERR29,-Z BR IF SUM GT 145 (ERR 29) K1003600 364 | * K1003610 365 | * NORMALIZE SW16 K1003620 7B06 1010 366 | SLA 16 CLEAR INCOMPLETE SPEC K1003630 7B07 D018 367 | STO SW16 *SWITCH K1003640 7B08 70EA 368 | MDX DOG BR TO GET ANOTHER CHAR K1003650 369 | * K1003660 370 | * SET UP ERROR 27 K1003670 7B09 C0AE 371 | J LD ERRB LD ERR CON (=27) K1003680 7B0A D09F 372 | STO ERRNO SAVE IN ERR NO. BFR K1003690 7B0B 6400 7A7F 373 | LDX L BAKER BR TO ERROR O/P SUBR K1003700 374 | * K1003710 375 | * SET UP ERROR 30 K1003720 7B0D C010 376 | ERR30 LD ER30 LD ERR CON (=30) K1003730 7B0E D09B 377 | STO ERRNO SAVE IN ERR BFR K1003740 7B0F 4C00 7A7F 378 | BSC L BAKER BR TO ERROR O/P SUBR K1003750 379 | * K1003760 380 | * CONSTANTS K1003770 7B11 004D 381 | PARNL DC /004D ( K1003780 7B12 0000 382 | X DC 0 CHAR FR FMT STRING K1003790 7B13 00C6 383 | FEF DC /00C6 F (TEST CONSTANT) K1003800 7B14 FFFF 384 | EE DC /00C5-/00C6 E (TEST CONSTANT) K1003810 7B15 0004 385 | EYE DC /00C9-/00C5 E (TEST CONSTANT) K1003820 7B16 FFFF 386 | ACH DC /00C8-/00C9 H (TEST CONSTANT) K1003830 7B17 001F 387 | XEX DC /00E7-/00C8 X (TEST CONSTANT) K1003840 7B18 FFDA 388 | AA DC /00C1-/00E7 A (TEST CONSTANT) K1003850 7B19 004D 389 | LP DC /004D ( (TEST CONSTANT) K1003860 7B1A 0061 390 | DIV DC /0061 / (TEST CONSTANT) K1003870 7B1B FFFC 391 | RPET DC /005D-/0061 ) (TEST CONSTANT) K1003880 7B1C 0000 392 | GREP DC 0 GROUP REPEAT SW K1003890 7B1D B000 393 | TENC DC /B000 REDO COUNT CON K1003900 7B1E 001E 394 | ER30 DC 30 ERROR 30 CONSTANT K1003910 7B1F 0000 395 | SW12 DC 0 QUOTE TYPE SPEC SW K1003920 7B20 0000 396 | SW16 DC 0 INCOMPLETE SPEC SW K1003930 397 | * K1003940 398 | * TEST SW1 K1003950 7B21 C400 7A9B 399 | TST LD L SW1 TEST FOR BEGINNING OF SPEC K1003960 7B23 4C20 7B89 400 | BSC L TST1,Z BR IF NOT BEGINNING K1003970 401 | * K1003980 402 | * X=F K1003990 7B25 C0EC 403 | LD X LD STRING CHAR K1004000 7B26 90EC 404 | S FEF TEST FOR F K1004010 7B27 4C18 7D4C 405 | BSC L B,+- BR IF CHAR = F K1004020 406 | * K1004030 407 | * X=E K1004040 7B29 90EA 408 | S EE TEST FOR E K1004050 7B2A 4C18 7D51 409 | BSC L C,+- BR IF CHAR = E K1004060 410 | * K1004070 411 | * X=I K1004080 7B2C 90E8 412 | S EYE TEST FOR I K1004090 7B2D 4C18 7D54 413 | BSC L D,+- BR IF CHAR = I K1004100 414 | * K1004110 415 | * X=H K1004120 7B2F 90E6 416 | S ACH TEST FOR H K1004130 7B30 4C18 7C64 417 | BSC L E,+- BR IF CHAR = H K1004140 418 | * K1004150 419 | * X=X K1004160 7B32 90E4 420 | S XEX TEST FOR X K1004170 7B33 4C18 7D48 421 | BSC L ZX,+- BR IF CHAR = X K1004180 422 | * K1004190 423 | * X=A K1004200 7B35 90E2 424 | S AA TEST FOR A K1004210 7B36 4C18 7D59 425 | BSC L I,+- BR IF CHAR = A K1004220 426 | * K1004230 427 | * X=LEFT PARENTHESIS ( K1004240 7B38 C0D9 428 | LD X LOAD STRING CHAR K1004250 7B39 90DF 429 | S LP TEST FOR ( K1004260 7B3A 4C18 7C13 430 | BSC L GRP1,+- BR IF CHAR = ( K1004270 431 | * K1004280 432 | * X=DIVIDE K1004290 7B3C C0D5 433 | ECHO LD X LOAD STRING CHAR K1004300 7B3D 90DC 434 | S DIV TEST FOR / K1004310 7B3E 4C18 7C2A 435 | BSC L RP,+- BR IF CHAR = / K1004320 436 | * K1004330 437 | * X=RIGHT PARENTHESIS) K1004340 7B40 90DA 438 | S RPET TEST FOR ) K1004350 7B41 4C18 7B5E 439 | BSC L MAN,+- BR IF CHAR = ) K1004360 440 | * K1004370 441 | * X=T K1004380 7B43 907E 442 | S TCON1 TEST FOR T K1004390 7B44 4C20 7B4E 443 | BSC L INK,Z BR IF CHAR NOT = T K1004400 444 | * K1004410 445 | * INDICATE T TYPE K1004420 7B46 C400 7BC3 446 | LD L TTYPE LD T INDICATOR CON K1004430 7B48 D400 7D47 447 | STO L COMTP SAVE IN O/P INDR AREA K1004440 7B4A 4400 7DC6 448 | BSI L SUBR BR TO TEST SW15 AND SUM K1004450 7B4C 4C00 7CFE 449 | BSC L POP BR TO PROCESS T FORMAT K1004460 450 | * K1004470 451 | * QUOTES K1004480 7B4E C0C3 452 | INK LD X TEST CHAR FOR QUOTE K1004490 7B4F 9400 7C6C 453 | S L QUOTC *MARK K1004500 7B51 4C20 7B09 454 | BSC L J,Z BR TO O/P ERR 27 IF NOT K1004510 7B53 C400 7A9A 455 | LD L SUM REPEAT ON LITERAL 2-8 K1004511 7B55 4C20 7B09 456 | BSC L J,Z YES,BRANCH TO ERR 27 2-8 K1004512 457 | * K1004520 458 | * TAG SW12 K1004530 7B57 7401 7B1F 459 | MDX L SW12,1 TAG QUOTE TYPE SPEC SW K1004540 460 | * K1004550 461 | * WW=0 K1004560 7B59 1010 462 | SLA 16 CLEAR ACC K1004570 7B5A D400 7BAB 463 | STO L WW CLEAR TOTAL FIELD WIDTH K1004580 7B5C 4C00 7C75 464 | BSC L O BR TO PROCESS QUOTE K1004590 465 | * K1004600 466 | * RIGHT PARENTHESES FOUND K1004610 467 | * SW15 AND SW16 NORMAL K1004620 7B5E C400 7ABF 468 | MAN LD L SW15 TEST IF DIGIT ENCOUNTERED K1004630 7B60 E8BF 469 | OR SW16 *AND INCOMPLETE SPEC SW OFF K1004640 7B61 4C20 7B09 470 | BSC L J,Z BR IF EITHER SW ON (ERR 27) K1004650 471 | * K1004660 472 | * GREP=0 K1004670 7B63 C0B8 473 | LD GREP TEST GROUP REPEAT SW K1004680 7B64 4C20 7B73 474 | BSC L FOX,Z BR IF NON-ZERO K1004690 475 | * K1004700 476 | * PUT REDO K1004710 7B66 C400 7ABA 477 | LD L REDO GET REDO INDICATOR K1004720 7B68 E8B4 478 | OR TENC ADD COUNT MASK K1004730 7B69 4400 7DA9 479 | BSI L PUT PUT REDO IN O/P STRING K1004740 480 | * K1004750 481 | * SET SW9 TO TRANSFER K1004760 7B6B 7401 7AA3 482 | MDX L SW9,1 INDICATES OK TO PUT REDO K1004770 483 | * K1004780 484 | * GET X K1004790 7B6D 4400 7D5C 485 | BSI L GET BR TO GET NXT CHAR K1004800 7B6F 7099 486 | MDX J BR IF RETURN FR GET-ERR 27 K1004810 487 | * K1004820 488 | * CONSTANTS K1004830 7B70 004B 489 | PERD DC /004B EBC DECML PT K1004840 7B71 8000 490 | EITC DC /8000 GROUP REPEAT CONSTANT K1004850 7B72 0001 491 | ONE DC 1 USEFUL CONSTANT K1004860 492 | * K1004870 493 | * GROUP REPEAT SW NON ZERO K1004880 494 | * OUTPUT GROUP REPEAT COUNT K1004890 495 | * K1004900 496 | * GREP=1 K1004910 7B73 C0A8 497 | FOX LD GREP LD GROUP REPEAT SW K1004920 7B74 90FD 498 | S ONE TEST FOR GROUP REPEAT =1 K1004930 7B75 4C18 7B7F 499 | BSC L XENO,+- BR IF = K1004940 500 | * K1004950 501 | * PUT GROUP REPEAT K1004960 7B77 C0F9 502 | LD EITC LD GROUP REPEAT CON K1004970 7B78 E8A3 503 | OR GREP ADD TO GROUP REPEAT COUNT K1004980 7B79 4400 7DA9 504 | BSI L PUT PUT ON O/P STRING K1004990 7B7B C02E 505 | LD LOOP GET -NO. WDS TO REPEAT K1005000 7B7C 80F5 506 | A ONE ADD 1 K1005010 7B7D 4400 7DA9 507 | BSI L PUT PUT ON O/P STRING K1005020 508 | * K1005030 509 | * GREP=0 K1005040 7B7F 1010 510 | XENO SLA 16 RESET GROUP REPEAT CON K1005050 7B80 D09B 511 | STO GREP *TO 0 K1005060 512 | * K1005070 513 | * GET X K1005080 7B81 4400 7D5C 514 | BSI L GET BR TO GET NXT CHAR K1005090 7B83 D400 7B12 515 | STO L X *FROM I/P STRING K1005100 516 | * K1005110 517 | * TAG SW8 K1005120 7B85 7401 7AA2 518 | MDX L SW8,1 SET COMMA MANDATORY SW K1005130 7B87 4C00 7D28 519 | BSC L QUAD BR TO PROCESS NEW SPEC TYPE K1005140 520 | * K1005150 521 | * TEST SW3 K1005160 7B89 C400 7A9D 522 | TST1 LD L SW3 LD 2ND NO. OF SPEC SW K1005170 7B8B 4C18 7C4E 523 | BSC L M,+- BR IF NO 2ND NO. K1005180 524 | * K1005190 525 | * SUM=0 K1005200 7B8D C400 7A9A 526 | LD L SUM TEST FIELD WIDTH K1005210 7B8F 4C18 7B09 527 | BSC L J,+- BR IF ZERO K1005220 528 | * K1005230 529 | * WW=SUM K1005240 7B91 D019 530 | STO WW SAVE TOTAL FIELD WIDTH K1005250 531 | * K1005260 532 | * SUM=0 K1005270 7B92 4400 7DBE 533 | BSI L NLIZE BR TO CLEAR SUM AND SW15 K1005280 534 | * K1005290 535 | * TEST SW2 K1005300 7B94 C400 7A9C 536 | LD L SW2 TEST FOR I TYPE SPEC K1005310 7B96 4C18 7D0A 537 | BSC L K,+- BR IF NOT I TYPE SPEC K1005320 538 | * K1005330 539 | * WW LESS THAN 127 K1005340 7B98 C012 540 | LD WW TEST TOTAL FIELD WIDTH K1005350 7B99 9013 541 | S N127 *VS 127 K1005360 7B9A 4C30 7B0D 542 | BSC L ERR30,-Z BR IF GT 127 K1005370 543 | * K1005380 544 | * X=PERIOD K1005390 7B9C C400 7DA3 545 | LD L WALT GET RIGHT CHAR FR TEMP STO K1005400 7B9E 90D1 546 | S PERD TEST FOR PERIOD K1005410 7B9F 4C20 7B09 547 | BSC L J,Z BR IF NOT PERIOD (ERR 27) K1005420 548 | * K1005430 549 | * TAG SW16 K1005440 7BA1 7401 7B20 550 | MDX L SW16,1 SET INCOMPLETE SPEC SW K1005450 551 | * K1005460 552 | * NORMALIZE SW2 K1005470 7BA3 1010 553 | SLA 16 CLEAR ACC K1005480 7BA4 D400 7A9C 554 | STO L SW2 SET SW TO IND NON I TYPE K1005490 555 | * K1005500 556 | * NORMALIZE SW3 K1005510 7BA6 D400 7A9D 557 | STO L SW3 SET SW TO IND NO 2ND NO. K1005520 7BA8 6400 7AF3 558 | LDX L DOG BR TO PROCESS NXT CHAR K1005530 559 | * CONSTANTS K1005540 560 | * K1005550 7BAA 0000 561 | LOOP DC 0 -NO. WDS BACK TO GROUP REP K1005560 7BAB 0000 562 | WW DC 0 TOTAL FIELD WIDTH K1005570 7BAC 0000 563 | DD DC 0 DECIMAL WIDTH K1005580 7BAD 007F 564 | N127 DC 127 MAX TOTAL FIELD WIDTH K1005590 7BAE 7000 565 | N7 DC /7000 SLASH FLAG K1005600 7BAF 001F 566 | N31 DC 31 MAX DECML WIDTH K1005610 7BB0 0000 567 | REP DC 0 REPEAT COUNT K1005620 7BB1 0000 568 | BOX DC 0 SPECIAL TYPE CODE STORAGE K1005630 7BB2 A035 569 | OPA DC /A035 SPECIAL TYPE CODE CHAR = A K1005640 7BB3 A014 570 | OPB DC /A014 SPECIAL TYPE CODE CHAR = B K1005650 7BB4 A040 571 | OPS DC /A040 SPECIAL TYPE CODE CHAR = S K1005660 7BB5 A005 572 | OPT DC /A005 SPECIAL TYPE CODE CHAR = T K1005670 7BB6 A016 573 | OPD DC /A016 SPECIAL TYPE CODE CHAR = D K1005680 7BB7 A025 574 | OPL DC /A025 SPECIAL TYPE CODE CHAR = L K1005690 7BB8 A015 575 | OPR DC /A015 SPECIAL TYPE CODE CHAR = R K1005700 7BB9 0000 576 | V1S1 DC 0 STMNT NORM-2 K1005710 7BBA 00C1 577 | ACON DC /00C1 A TEST CONSTANT K1005720 7BBB 0001 578 | BCON DC /00C2-/00C1 B TEST CONSTANT K1005730 7BBC 0020 579 | SCON DC /00E2-/00C2 S TEST CONSTANT K1005740 7BBD 0001 580 | TCON DC /00E3-/00E2 T TEST CONSTANT K1005750 7BBE FFE1 581 | DCON DC /00C4-/00E3 D TEST CONSTANT K1005760 7BBF 000F 582 | LCON DC /00D3-/00C4 L TEST CONSTANT K1005770 7BC0 0006 583 | RCON DC /00D9-/00D3 R TEST CONSTANT K1005780 7BC1 005D 584 | RPARN DC /005D ) TEST CONSTANT K1005790 7BC2 0086 585 | TCON1 DC /00E3-/005D T TEST CONSTANT K1005800 7BC3 6000 586 | TTYPE DC /6000 T INDICATOR CONSTANT K1005810 587 | * K1005820 588 | * SAVE POINTER AND SAVE SW4 K1005830 589 | * X=LEFT PARENTHESIS K1005840 7BC4 6920 590 | GRP STX 1 BK+1 SAVE I/P STRING PT K1005850 7BC5 CC00 7A9E 591 | LDD L SW4 GET CONTENTS SW4 AND SW5 K1005860 7BC7 DC00 7C72 592 | STD L SW45H SAVE IN TEMPORARY STORAGE K1005870 7BC9 C400 7ABC 593 | LD L NCNT GET STMNT NORM-2 K1005880 7BCB D0ED 594 | STO V1S1 SAVE K1005890 595 | * K1005900 596 | * GET X K1005910 7BCC 4400 7D5C 597 | BSI L GET GET STRING CHAR K1005920 7BCE 7015 598 | MDX BK BR TO PROCESS K1005930 599 | * K1005940 600 | * X=A K1005950 7BCF 90EA 601 | S ACON TEST CHAR FOR A K1005960 7BD0 4C18 7BEE 602 | BSC L BOY,+- BR IF = A K1005970 603 | * K1005980 604 | * X=B K1005990 7BD2 90E8 605 | S BCON TEST CHAR FOR B K1006000 7BD3 4C18 7BF0 606 | BSC L BOY1,+- BR IF = B K1006010 607 | * K1006020 608 | * X=S K1006030 7BD5 90E6 609 | S SCON TEST CHAR FOR S K1006040 7BD6 4C18 7BF2 610 | BSC L BOY2,+- BR IF = S K1006050 611 | * K1006060 612 | * X=T K1006070 7BD8 90E4 613 | S TCON TEST CHAR FOR T K1006080 7BD9 4C18 7BF4 614 | BSC L BOY3,+- BR IF = T K1006090 615 | * K1006100 616 | * X=D K1006110 7BDB 90E2 617 | S DCON TEST CHAR FOR D K1006120 7BDC 4C18 7BF6 618 | BSC L BOY4,+- BR IF = D K1006130 619 | * K1006140 620 | * X=L K1006150 7BDE 90E0 621 | S LCON TEST CHAR FOR L K1006160 7BDF 4C18 7BF8 622 | BSC L BOY5,+- BR IF = L K1006170 623 | * K1006180 624 | * X=R K1006190 7BE1 90DE 625 | S RCON TEST CHAR FOR R K1006200 7BE2 4C18 7BFA 626 | BSC L BOY6,+- BR IF = R K1006210 627 | * K1006220 628 | * BACK UP K1006230 7BE4 6500 0000 629 | BK LDX L1 *-* RESET I/P STRING POINTER K1006240 7BE6 CC00 7C72 630 | LDD L SW45H RELOAD SW4 AND SW5 K1006250 7BE8 DC00 7A9E 631 | STD L SW4 RESTORE TO PREV STATE K1006260 7BEA C0CE 632 | LD V1S1 RESET STMNT NORM-2 K1006270 7BEB D400 7ABC 633 | STO L NCNT SAVE K1006280 7BED 7025 634 | MDX GRP1 BR TO PROCESS PREV CHAR K1006290 635 | * K1006300 636 | * INDICATE A SPECIAL TYPE K1006310 7BEE C0C3 637 | BOY LD OPA CHAR=A, LD SPECIAL TYPE CDE K1006320 7BEF 7005 638 | MDX BOY3+1 BR TO STORE K1006330 639 | * K1006340 640 | * INDICATE B SPECIAL TYPE K1006350 7BF0 C0C2 641 | BOY1 LD OPB CHAR=B, LD SPECIAL TYPE CDE K1006360 7BF1 7009 642 | MDX BOY6+1 BR TO STORE K1006370 643 | * K1006380 644 | * INDICATE S SPECIAL TYPE K1006390 7BF2 C0C1 645 | BOY2 LD OPS CHAR=S, LD SPECIAL TYPE CDE K1006400 7BF3 7007 646 | MDX BOY6+1 BR TO STORE K1006410 647 | * K1006420 648 | * INDICATE T SPECIAL TYPE K1006430 7BF4 C0C0 649 | BOY3 LD OPT CHAR=T, LD SPECIAL TYPE CDE K1006440 7BF5 7005 650 | MDX BOY6+1 BR TO STORE K1006450 651 | * K1006460 652 | * INDICATED D SPECIAL TYPE K1006470 7BF6 C0BF 653 | BOY4 LD OPD CHAR=D, LD SPECIAL TYPE CDE K1006480 7BF7 7003 654 | MDX BOY6+1 BR TO STORE K1006490 655 | * K1006500 656 | * INDICATE L SPECIAL TYPE K1006510 7BF8 C0BE 657 | BOY5 LD OPL CHAR=L, LD SPECIAL TYPE CDE K1006520 7BF9 7001 658 | MDX BOY6+1 BR TO STORE K1006530 659 | * K1006540 660 | * INDICATE R SPECIAL TYPE K1006550 7BFA C0BD 661 | BOY6 LD OPR CHAR=R, LD SPECIAL TYPE CDE K1006560 7BFB D0B5 662 | STO BOX SAVE SPECIAL TYPE CODE K1006570 663 | * K1006580 664 | * GET X K1006590 7BFC 4400 7D5C 665 | BTEST BSI L GET BR TO GET ANOTHER CHAR K1006600 666 | * K1006610 667 | * RIGHT PARENTHESIS K1006620 7BFE 90C2 668 | S RPARN TEST CHAR FOR ) K1006630 7BFF 4C20 7BE4 669 | BSC L BK,Z BR IF NOT K1006640 670 | * K1006650 671 | * PUT SPECIFICATION K1006660 7C01 C0AF 672 | LD BOX GET SPECIAL TYPE CODE K1006670 7C02 4400 7DA9 673 | BSI L PUT PUT ON O/P STRING K1006680 674 | * K1006690 675 | * SUM = 0 K1006700 7C04 4400 7DC6 676 | BSI L SUBR BR TO SEE IF DIGIT FOUND K1006710 7C06 C400 7A9A 677 | LD L SUM GET FIELD WIDTH K1006720 7C08 4C18 7C0F 678 | BSC L BT11A,+- BR IF FIELD WIDTH = 0 K1006730 679 | * K1006740 680 | * PUT FIELD REPEAT K1006750 7C0A C060 681 | LD N9 GET FIELD REPEAT FLAG K1006760 7C0B EC00 7A9A 682 | OR L SUM ADD FIELD WIDTH K1006770 7C0D 4400 7DA9 683 | BSI L PUT PUT ON O/P STRING K1006780 684 | * K1006790 685 | * CALL NLIZE K1006800 7C0F 4400 7DBE 686 | BT11A BSI L NLIZE CLEAR SW15 AND SUM K1006810 687 | * GET X K1006820 7C11 4C00 7CEB 688 | BT11 BSC L LIMA BR TO PROCESS NXT CHAR K1006830 689 | * K1006840 690 | * GREP=0 K1006850 7C13 C400 7B1C 691 | GRP1 LD L GREP LD GROUP REPEAT CNT K1006860 7C15 4C20 7B09 692 | BSC L J,Z BR TO ERR IF 0, ERR 27 K1006870 693 | * K1006880 694 | * INITIALIZE RE DO K1006890 7C17 D400 7ABA 695 | STO L REDO SAVE IN REDO COUNT K1006900 696 | * K1006910 697 | * SUM = 0 K1006920 7C19 4400 7DC6 698 | BSI L SUBR BR TO TEST SW15 AND SUM K1006930 699 | * K1006940 700 | * GREP = SUM OR 1 IF SUM = 0 K1006950 7C1B C400 7A9A 701 | LD L SUM LD SUM K1006960 7C1D 4C20 7C21 702 | BSC L *+2,Z BR IF NOT = 0 K1006970 7C1F C400 7B72 703 | LD L ONE SET GROUP REPEAT CONSTANT K1006980 7C21 D400 7B1C 704 | STO L GREP *TO 1 K1006990 705 | * K1007000 706 | * CALL NLIZE K1007010 7C23 4400 7DBE 707 | BSI L NLIZE CLEAR SW15 AND SUM K1007020 708 | * K1007030 709 | * LOOP=-1 K1007040 7C25 C400 7AB9 710 | LD L MONE GET -1 CONSTANT K1007050 7C27 D082 711 | STO LOOP SAVE K1007060 7C28 6400 7AF3 712 | LDX L DOG BR TO PROCESS NXT CHAR K1007070 713 | * K1007080 714 | * SUM=0 2-1 K1007090 7C2A C400 7A9A 715 | RP LD L SUM 2-1 K1007100 7C2C 4C20 7B09 716 | BSC L J,Z BR TO ERR IF NE 0 (ERR 27) K1007110 717 | * K1007120 718 | * PUT SLASH K1007130 7C2E C400 7BAE 719 | LD L N7 GET SLASH INDICATOR K1007140 7C30 4400 7DA9 720 | BSI L PUT PUT ON O/P STRING K1007150 7C32 4C00 7CEB 721 | BSC L LIMA BR TO GET ANOTHER CHAR K1007160 722 | * K1007170 723 | * TEST INDICATORS AND GET NEXT K1007180 724 | * CHAR AND FIELD WIDTH K1007190 725 | * K1007200 726 | * REP=0 K1007210 7C34 C400 7BB0 727 | F LD L REP GET REPEAT FLAG K1007220 7C36 4C20 7B09 728 | BSC L J,Z BR TO ERR IF NE 0 (ERR 27) K1007230 729 | * K1007240 730 | * SUM=0 K1007250 7C38 C400 7A9A 731 | LD L SUM TEST SUM FIELD WIDTH K1007260 7C3A 4C18 7B09 732 | BSC L J,+- BR TO ERR IF = 0 (ERR 27) K1007270 733 | * K1007280 734 | * WW=SUM K1007290 7C3C C400 7A9A 735 | LD L SUM K1007300 7C3E D400 7BAB 736 | STO L WW SAVE SUM IN TOT FLD WIDTH K1007310 737 | * K1007320 738 | * CALL NLIZE K1007330 7C40 4400 7DBE 739 | BSI L NLIZE CLEAR SUM AND SW15 K1007340 740 | * K1007350 741 | * TEST SW6 K1007360 7C42 C400 7AA0 742 | LD L SW6 TEST FOR COMMA ALLOWABLE K1007370 7C44 4C20 7C75 743 | BSC L O,Z BR IF NOT ALLOWABLE K1007380 744 | * K1007390 745 | * TAG SW8 K1007400 7C46 7401 7AA2 746 | MDX L SW8,1 SET COMMA NOT MANDATORY SW K1007410 747 | * K1007420 748 | * GET X K1007430 7C48 4400 7D5C 749 | BSI L GET GET NEXT CHAR K1007440 7C4A D400 7B12 750 | STO L X SAVE K1007450 7C4C 4C00 7D0A 751 | BSC L K BR TO BUILD SPECIFICATIONS K1007460 752 | * K1007470 753 | * TEST SW15 K1007480 7C4E C400 7ABF 754 | M LD L SW15 LD DIGIT ENCOUNTERED SW K1007490 7C50 4C18 7B09 755 | BSC L J,+- BR IF NO DIGIT FOUND K1007500 756 | * K1007510 757 | * DD LESS THAN 32 K1007520 7C52 C400 7A9A 758 | LD L SUM GET FIELD WIDTH K1007530 7C54 9400 7BAF 759 | S L N31 SUBTRACT CONSTANT =31 K1007540 7C56 4C30 7B0D 760 | BSC L ERR30,Z- BR IF WIDTH GT 31 K1007550 761 | * K1007560 762 | * DD=SUM K1007570 7C58 C400 7A9A 763 | LD L SUM GET FIELD WITH K1007580 7C5A D400 7BAC 764 | STO L DD SAVE AS DECML WIDTH K1007590 765 | * K1007600 766 | * WW G.T. DD K1007610 7C5C 9400 7BAB 767 | S L WW COMPARE WITH TOT FLD WIDTH K1007620 7C5E 4C30 7B0D 768 | BSC L ERR30,-Z BR ERR IF TOT LT DECML K1007630 769 | * K1007640 770 | * CALL NLIZE K1007650 7C60 4400 7DBE 771 | BSI L NLIZE BR TO CLEAR SUM AND SW15 K1007660 7C62 4C00 7D0A 772 | BSC L K BR TO BUILD SPECIFICATIONS K1007670 773 | * K1007680 774 | * TAG SW6 K1007690 7C64 7401 7AA0 775 | E MDX L SW6,1 SET COMMA NOT ALLOWABLE SW K1007700 7C66 70CD 776 | MDX F BR TO TEST IF GET NXT CHAR K1007710 777 | * K1007720 778 | * CONSTANTS K1007730 7C67 0040 779 | BLANK DC /0040 EBC BLANK K1007740 7C68 0000 780 | Y DC 0 LEFT CHAR TO PACK O/P AREA K1007750 7C69 006B 781 | COMMA DC /006B EBC COMMA K1007760 7C6A 5000 782 | N5 DC /5000 HOLLERITH MASK K1007770 7C6B 9000 783 | N9 DC /9000 FIELD REPEAT FLAG K1007780 7C6C 007D 784 | QUOTC DC /007D QUOTE MASK K1007790 7C6D 0000 785 | CT DC 0 NO. CHARS HOLL FMT K1007800 7C6E 0000 786 | JAMEY DC 0 O/P STRING WD CNT K1007810 7C6F 001D 787 | ER29 DC 29 ERROR 29 CONSTANT K1007820 7C70 0092 788 | C146 DC 146 MAX HOLL CHAR CNT K1007830 7C71 0000 789 | SW11 DC 0 H OR QUOTE TYPE SPEC SW K1007840 7C72 790 | BSS E 0 K1007850 7C72 0000 791 | SW45H DC *-* TEMP STO SW4 K1007860 7C73 0000 792 | DC *-* TEMP STO SW5 K1007870 7C74 0000 793 | NCNTH DC *-* TEMP STO NORM COUNT K1007880 794 | * K1007890 795 | * NORMALIZE SW6 (COMMA ALLOWABLE) K1007900 7C75 1010 796 | O SLA 16 CLEAR ACC K1007910 7C76 D400 7AA0 797 | STO L SW6 SET COMMA ALLOWABLE FLAG K1007920 798 | * K1007930 799 | * SET UP COUNT K1007940 7C78 D0F4 800 | STO CT CLEAR CNT OF NO. HOLL CHARS K1007960 801 | * K1007970 802 | * PUT H SPEC. K1007980 7C79 6AF4 803 | STX 2 JAMEY SAVE O/P STRING POINTER K1007990 7C7A C0EF 804 | LD N5 LD HOLL SPEC MASK K1008000 7C7B EC00 7BAB 805 | OR L WW ADD TO TOTAL FIELD WIDTH K1008010 7C7D 4400 7DA9 806 | BSI L PUT PUT SPEC ON O/P STRING K1008020 807 | * K1008030 808 | * TAG SW11 K1008040 7C7F 7401 7C71 809 | MDX L SW11,1 K1008050 810 | * SET H OR QUOTE SPEC FLAG K1008060 811 | * GET X K1008070 7C81 4400 7D5C 812 | KILO BSI L GET GET NEXT CHAR K1008080 7C83 D400 7B12 813 | STO L X SAVE K1008090 814 | * K1008100 815 | * TEST SW12-QUOTE TYPE SPEC K1008110 7C85 C400 7B1F 816 | LD L SW12 LD SWITCH K1008120 7C87 4C18 7CCE 817 | BSC L LOB,+- BR IF NOT QUOTE TYPE SPEC K1008130 818 | * K1008140 819 | * X = QUOTE K1008150 7C89 C400 7B12 820 | LD L X LD STRING CHAR K1008160 7C8B 90E0 821 | S QUOTC TEST FOR QUOTE CONSTANT K1008170 7C8C 4C18 7C99 822 | BSC L LOB3,+- BR IF QUOTE FOUND K1008180 823 | * K1008190 824 | * CHAR NOT QUOTE, PROCESS AS K1008200 825 | * HOLLERITH CHAR K1008210 826 | * NCNT = 0 K1008220 7C8E C400 7ABC 827 | LD L NCNT TEST NORM COUNT K1008230 7C90 4C18 7CC5 828 | BSC L ERR29,+- BR IF COUNT = 0 K1008240 829 | * K1008250 7C92 C400 7ABD 830 | LOB2 LD L TWO GET A CONSTANT = 2 K1008260 831 | * WW=2 K1008270 7C94 D400 7BAB 832 | STO L WW SET TOTAL FIELD WIDTH =2 K1008280 833 | * K1008290 834 | * CT=CT+1 K1008300 7C96 7401 7C6D 835 | MDX L CT,1 INCR HOLL CHAR COUNT K1008310 7C98 7035 836 | MDX LOB BR TO O/P CHAR K1008320 837 | * K1008330 838 | * SECOND QUOTE FOUND IN QUOTE TYPE K1008340 839 | * SPECIFICATION K1008350 840 | * K1008360 841 | * SAVE STATUS OF GET ROUTINE K1008370 7C99 CC00 7A9E 842 | LOB3 LDD L SW4 GET SW4 AND SW5 K1008380 7C9B D8D6 843 | STD SW45H SAVE IN TEMP STO K1008390 7C9C C400 7ABC 844 | LD L NCNT GET NORM COUNT K1008400 7C9E D0D5 845 | STO NCNTH SAVE IN TEMP STO K1008410 7C9F 690C 846 | STX 1 RXR1H+1 SAVE I/P STRING POINTER K1008420 847 | * K1008430 848 | * GET X K1008440 7CA0 4400 7D5C 849 | BSI L GET GET ANOTHER CHAR K1008450 850 | * K1008460 851 | * X = QUOTE K1008470 7CA2 90C9 852 | S QUOTC TEST CHAR FOR QUOTE K1008480 7CA3 4C18 7C92 853 | BSC L LOB2,+- BR TO O/P HOLL QUOTE IF YES K1008490 854 | * K1008500 855 | * RESTORE STATUS OF GET ROUTINE K1008510 7CA5 C8CC 856 | LDD SW45H LOAD SW4 AND SW5 FR TEMP K1008520 7CA6 DC00 7A9E 857 | STD L SW4 RESTORE SW4 AND SW5 K1008530 7CA8 C0CB 858 | LD NCNTH LD TEMP NORM COUNT K1008540 7CA9 D400 7ABC 859 | STO L NCNT SAVE K1008550 7CAB 6500 0000 860 | RXR1H LDX L1 *-* RESTORE I/P STRING POINTER K1008560 861 | * K1008570 862 | * PUT OUT SPECIAL QUOTE K1008580 7CAD 6A06 863 | STX 2 JAMES+1 SAVE O/P STRING POINTER K1008590 7CAE 6680 7C6E 864 | LDX I2 JAMEY LD START OF QUOTE AREA PT K1008600 7CB0 C200 865 | LD 2 0 LD FIRST WD OF QUOTE AREA K1008610 7CB1 E8BB 866 | OR CT ADD NO CHARS K1008620 7CB2 D200 867 | STO 2 0 SAVE IN FIRST WORD K1008630 7CB3 6600 0000 868 | JAMES LDX L2 0 RESTORE O/P STRING POINTER K1008640 869 | * K1008650 870 | * CT LESS THAN 146 K1008660 7CB5 C0B7 871 | LD CT LD HOLL CHAR CNT K1008670 7CB6 4C20 7CC2 872 | BSC L NZER,Z BR IF CNT NON-ZERO K1008680 7CB8 72FF 873 | MDX 2 -1 DECREMENT OUTPUT POINTER K1008690 7CB9 74FF 7DA5 874 | MDX L TABC,-1 IF ZERO LENGTH LITERAL K1008700 7CBB 1000 875 | NOP (MAY SKIP) K1008710 7CBC 74FF 7ABA 876 | MDX L REDO,-1 DECR REDO K1008720 7CBE 1000 877 | NOP (MAY SKIP) K1008730 7CBF 7401 7BAA 878 | MDX L LOOP,1 INCR LOOP K1008740 7CC1 1000 879 | NOP (MAY SKIP) K1008750 7CC2 880 | NZER EQU * K1008760 7CC2 90AD 881 | S C146 SUBTRACT MAX SIZE LITERAL K1008770 7CC3 4C28 7CCA 882 | BSC L JILL,+Z BR IF LITERAL LT 146 K1008780 883 | * K1008790 884 | * SET UP ERROR 29 K1008800 7CC5 C0A9 885 | ERR29 LD ER29 LD ERR 29 CON K1008810 7CC6 D400 7AAA 886 | STO L ERRNO SAVE IN ERR NO. K1008820 7CC8 4C00 7A7F 887 | BSC L BAKER BR TO OUTPUT ERR K1008830 888 | * K1008840 889 | * NORMALIZE SW12 K1008850 7CCA 1010 890 | JILL SLA 16 CLEAR ACC K1008860 7CCB D400 7B1F 891 | STO L SW12 SET NON-QUOTE TYPE SPEC. K1008870 7CCD 7010 892 | MDX HILO+3 BR TO CONT WITH STRING K1008880 893 | * K1008890 894 | * OUTPUT HOLLERITH CHARACTERS K1008900 895 | * PACKED 2 TO A WORD K1008910 896 | * TEST SW7 K1008920 7CCE C400 7AA1 897 | LOB LD L SW7 LD LEFT/RIGHT SW K1008930 7CD0 4C18 7CF5 898 | BSC L GAM,+- BR IF LEFT K1008940 899 | * K1008950 900 | * NORMALIZE SW7 K1008960 7CD2 1010 901 | SLA 16 CLEAR ACC K1008970 7CD3 D400 7AA1 902 | STO L SW7 SET SW TO LEFT FOR NXT CHAR K1008980 903 | * K1008990 904 | * PUT Y X K1009000 7CD5 C092 905 | LD Y LD LEFT HOLL CHAR TO BE O/P K1009010 7CD6 1008 906 | SLA 8 SHIFT TO LEFT HALF OF WD K1009020 7CD7 EC00 7B12 907 | OR L X ADD PRESENT CHAR RIGHT HALF K1009030 7CD9 4400 7DA9 908 | BSI L PUT BR TO PUT PACKED WD IN O/P K1009040 909 | * K1009050 910 | * WW=WW-1 K1009060 7CDB 74FF 7BAB 911 | HILO MDX L WW,-1 DECR TOTAL FIELD WIDTH K1009070 912 | * K1009080 913 | * WW=0 K1009090 7CDD 70A3 914 | MDX KILO BR TO GET NXT CHAR IF ANY K1009100 915 | * K1009110 916 | * TEST SW7 K1009120 7CDE C400 7AA1 917 | LD L SW7 TEST FOR LEFT CHAR TO O/P K1009130 7CE0 4C18 7CEB 918 | BSC L LIMA,+- BR IF LEFT CHAR TO O/P K1009140 919 | * K1009150 920 | * PUT Y BLANK K1009160 7CE2 C085 921 | LD Y LD LEFT CHAR K1009170 7CE3 1008 922 | SLA 8 SHIFT TO LEFT HALF OF WD K1009180 7CE4 EC00 7C67 923 | OR L BLANK ADD EBC BLANK IN RIGHT HALF K1009190 7CE6 4400 7DA9 924 | BSI L PUT PUT WD ON O/P STRING K1009200 925 | * K1009210 926 | * NORMALIZE SW7 K1009220 7CE8 1010 927 | SLA 16 CLEAR ACC TO SET LEFT HALF K1009230 7CE9 D400 7AA1 928 | STO L SW7 *O/P SW FOR NEXT HOLL O/P K1009240 929 | * K1009250 930 | * TAG SW8 K1009260 7CEB 7401 7AA2 931 | LIMA MDX L SW8,1 SET COMMA MANDATORY SW K1009270 932 | * K1009280 933 | * NORMALIZE SW11 K1009290 7CED 1010 934 | SLA 16 CLEAR ACC TO SET NOT H OR K1009300 7CEE D400 7C71 935 | STO L SW11 *QUOTE SPEC SW K1009310 936 | * K1009320 937 | * GET X K1009330 7CF0 4400 7D5C 938 | BSI L GET GET NXT CHAR K1009340 7CF2 D400 7B12 939 | STO L X SAVE K1009350 7CF4 7033 940 | MDX QUAD BR TO PROCESS NEW SPEC K1009360 941 | * K1009370 942 | * Y=X K1009380 7CF5 C400 7B12 943 | GAM LD L X GET STRING CHAR FOR LEFT K1009390 7CF7 D400 7C68 944 | STO L Y *HAND O/P OF PACKED WD K1009400 945 | * K1009410 946 | * TAG SW7 K1009420 7CF9 7401 7AA1 947 | MDX L SW7,1 SET SW FOR RIGHT CHAR NXT K1009430 7CFB 70DF 948 | MDX HILO CONTINUE PROCESSING STRING K1009440 949 | * K1009450 950 | * TAG SW2 K1009460 7CFC 7401 7A9C 951 | OLD MDX L SW2,1 SET I TYPE SPEC SW K1009470 952 | * K1009480 953 | * TAG SW3 K1009490 7CFE 7401 7A9D 954 | POP MDX L SW3,1 SET 2ND NO. OF SPEC SW K1009500 955 | * K1009510 956 | * REP=SUM K1009520 7D00 C400 7A9A 957 | LD L SUM LD FIELD WIDTH K1009530 7D02 D400 7BB0 958 | STO L REP SAVE IN REPEAT K1009540 959 | * K1009550 960 | * CALL NLIZE K1009560 7D04 4400 7DBE 961 | BSI L NLIZE CLEAR SUM, SW15 K1009570 962 | * K1009580 963 | * TAG SW1 K1009590 7D06 7401 7A9B 964 | MDX L SW1,1 SET END OF SPEC SW K1009600 7D08 6400 7AF3 965 | LDX L DOG BR FOR NXT SPEC TYPE K1009610 966 | * K1009620 967 | * BUILD SPECIFICATIONS K1009630 7D0A C400 7BAC 968 | K LD L DD LD DECML FIELD WIDTH K1009640 7D0C 1007 969 | SLA 7 LEFT JUSTIFY K1009650 7D0D EC00 7BAB 970 | OR L WW ADD TOT FIELD WIDTH-RIGHT K1009660 7D0F E837 971 | OR COMTP ADD O/P TYPE INDICATOR K1009670 972 | * K1009680 973 | * PUT SPECIFICATION K1009690 7D10 4400 7DA9 974 | BSI L PUT PUT SPEC ON O/P STRING K1009700 975 | * K1009710 976 | * DD=0 K1009720 7D12 1010 977 | SLA 16 CLEAR ACC K1009730 7D13 D400 7BAC 978 | STO L DD CLEAR DECML FIELD WIDTH K1009740 979 | * K1009750 980 | * WW=0 K1009760 7D15 D400 7BAB 981 | STO L WW CLEAR TOTAL FIELD WIDTH K1009770 982 | * K1009780 983 | * REP=0 K1009790 7D17 C400 7BB0 984 | LD L REP TEST REPEAT COUNT K1009800 7D19 4C18 7D28 985 | BSC L QUAD,+- BR IF 0 FOR NXT SPEC K1009810 986 | * K1009820 987 | * REP=1 K1009830 7D1B 9400 7B72 988 | S L ONE SUBTRACT 1 K1009840 7D1D 4C18 7D25 989 | BSC L ZEBRA,+- BR IF = 1 K1009850 990 | * K1009860 991 | * PUT REPEAT K1009870 7D1F C400 7C6B 992 | LD L N9 LD REPEAT INDICATOR K1009880 7D21 EC00 7BB0 993 | OR L REP ADD REPEAT COUNT K1009890 7D23 4400 7DA9 994 | BSI L PUT PUT ON O/P STRING K1009900 995 | * K1009910 996 | * REP=0 K1009920 7D25 1010 997 | ZEBRA SLA 16 CLEAR ACC K1009930 7D26 D400 7BB0 998 | STO L REP CLEAR REPEAT COUNT K1009940 999 | * K1009950 1000 | * NEW SPECIFICATION TYPE TO BE K1009960 1001 | * PROCESSED K1009970 1002 | * NORMALIZE SW1 K1009980 7D28 1010 1003 | QUAD SLA 16 CLEAR ACC TO SET BEGINNING K1009990 7D29 D400 7A9B 1004 | STO L SW1 *OF SPEC SW K1010000 1005 | * K1010010 1006 | * X=COMMA K1010020 7D2B C400 7B12 1007 | LD L X LD STRING WD K1010030 7D2D 9400 7C69 1008 | S L COMMA SUBTRACT EBC COMMA K1010040 7D2F 4C20 7D37 1009 | BSC L CATT,Z BR IF COMMA NOT FOUND K1010050 1010 | * K1010060 1011 | * NORMALIZE SW15 (DIGIT ENCOUNTERED SW) K1010070 7D31 D400 7ABF 1012 | STO L SW15 SET DIGIT NOT ENCOUNTERED K1010080 1013 | * K1010090 1014 | * NORMALIZE SW8 (MANDATORY COMMA) K1010100 7D33 D400 7AA2 1015 | STO L SW8 SET COMMA MANDATORY K1010110 7D35 4C00 7AF3 1016 | BSC L DOG BR TO CALC FIELD WIDTH K1010120 1017 | * K1010130 1018 | * TEST SW8 K1010140 7D37 C400 7AA2 1019 | CATT LD L SW8 LD COMMA MANDATORY SW K1010150 7D39 4C18 7B3C 1020 | BSC L ECHO,+- BR IF COMMA MANDATORY K1010160 1021 | * K1010170 1022 | * NORMALIZE SW8 K1010180 7D3B 1010 1023 | SLA 16 CLEAR ACC K1010190 7D3C D400 7AA2 1024 | STO L SW8 SET COMMA MANDATORY SW K1010200 7D3E C400 7B12 1025 | LD L X LD STRING CHAR K1010210 7D40 6400 7AF6 1026 | LDX L DOG+3 BR TO PROCESS K1010220 1027 | * K1010230 1028 | * CONSTANTS K1010240 7D42 4000 1029 | XTYPE DC /4000 X TYPE SPEC CONSTANT K1010250 7D43 1000 1030 | FTYPE DC /1000 F TYPE SPEC CONSTANT K1010260 7D44 0000 1031 | ETYPE DC 0 E TYPE SPEC CONSTANT K1010270 7D45 2000 1032 | ITYPE DC /2000 I TYPE SPEC CONSTANT K1010280 7D46 3000 1033 | ATYPE DC /3000 A TYPE SPEC CONSTANT K1010290 7D47 0000 1034 | COMTP DC 0 CON INDICATING O/P TYPE K1010300 1035 | * K1010310 1036 | * SET INDICATORS FOR VARIOUS TYPE K1010320 1037 | * SPECIFICATIONS K1010330 1038 | * INDICATE X TYPE K1010340 7D48 C0F9 1039 | ZX LD XTYPE LD X TYPE CONSTANT K1010350 7D49 D0FD 1040 | STO COMTP SAVE IN CONSTANT TYPE K1010360 7D4A 4C00 7C34 1041 | BSC L F BR TO CALC FIELD WIDTH K1010370 1042 | * K1010380 1043 | * INDICATE F TYPE K1010390 7D4C C0F6 1044 | B LD FTYPE LD F TYPE SPEC CONSTANT K1010400 7D4D D0F9 1045 | STO COMTP SAVE CONSTANT TYPE K1010410 7D4E 4400 7DC6 1046 | BB BSI L SUBR CLEAR SUM AND SW15 K1010420 7D50 70AB 1047 | MDX OLD BR TO CONTINUE K1010430 1048 | * K1010440 1049 | * INDICATE E TYPE K1010450 7D51 C0F2 1050 | C LD ETYPE LD E TYPE SPEC CONSTANT K1010460 7D52 D0F4 1051 | STO COMTP SAVE CONSTANT TYPE K1010470 7D53 70FA 1052 | MDX BB BR TO CONTINUE K1010480 1053 | * K1010490 1054 | * INDICATE I TYPE K1010500 7D54 C0F0 1055 | D LD ITYPE LD I TYPE SPEC CONSTANT K1010510 7D55 D0F1 1056 | STO COMTP SAVE CONSTANT TYPE K1010520 7D56 4400 7DC6 1057 | DD2 BSI L SUBR CLEAR SW15 AND SUM K1010530 7D58 70A5 1058 | MDX POP BR TO CONTINUE K1010540 1059 | * K1010550 1060 | * INDICATE A TYPE K1010560 7D59 C0EC 1061 | I LD ATYPE LD A TYPE SPEC CONSTANT K1010570 7D5A D0EC 1062 | STO COMTP SAVE K1010580 7D5B 70FA 1063 | MDX DD2 BR TO CONTINUE K1010590 1064 | * K1010600 1065 | * SUBROUTINE TO GET A WORD FROM A K1010610 1066 | * FORMAT STATEMENT FOR ANALYSIS K1010620 1067 | * TAKES PACKED EBC CHARS FROM INPUT K1010630 1068 | * STRING AND EMITS ONE CHAR AT A TIME K1010640 1069 | * RIGHT JUSTIFIED IN THE ACCUMULATOR K1010650 1070 | * K1010660 7D5C 0000 1071 | GET DC 0 BSI ENTRY POINT K1010670 1072 | * K1010680 1073 | * TEST SW5 FOR END OF STMNT K1010690 7D5D C400 7A9F 1074 | GETY LD L SW5 LD END OF STMNT SW K1010700 7D5F 4C18 7D7B 1075 | BSC L MAT,+- BR IF NOT END OF STMNT K1010710 1076 | * K1010720 1077 | * TEST SW9 K1010730 7D61 C400 7AA3 1078 | LD L SW9 LD REDO SW K1010740 7D63 4C18 7D77 1079 | BSC L FAT,+- BR IF NOT OK TO O/P REDO K1010750 1080 | * K1010760 1081 | * RE-ADJUST ID NORM K1010770 7D65 6A0C 1082 | STX 2 ZR+1 SAVE O/P STRING POINTER K1010780 7D66 6680 7DA4 1083 | LDX I2 VIGG LD I/D LOC OF O/P STRING K1010790 7D68 C03C 1084 | LD TABC LD NO. WDS O/P STRING K1010800 7D69 8400 7ABD 1085 | A L TWO ADD 2 FOR STMNT NO. AND ID K1010810 7D6B 1002 1086 | SLA 2 SHIFT TO NORM (BITS 6-13) K1010820 7D6C D038 1087 | STO TABC SAVE IN COUNT AREA K1010830 7D6D C200 1088 | LD 2 0 LD ID WD O/P STRING K1010840 7D6E E037 1089 | AND MATB MASK OUT PREV STMNT NORM K1010850 7D6F E835 1090 | OR TABC MASK IN NEW NORM K1010860 7D70 D200 1091 | STO 2 0 SAVE NEW ID WD O/P STRING K1010870 7D71 6600 0000 1092 | ZR LDX L2 0 LD ACTUAL O/P STRING PT K1010880 7D73 6E00 7AA9 1093 | STX L2 NEOFS SAVE AS END OF STRING K1010890 7D75 4C00 7A5C 1094 | BSC L ABEL BR TO PROCESS NXT STMNT K1010900 1095 | * K1010910 1096 | * PUT BLANK IN A REGISTER K1010920 7D77 C400 7C67 1097 | FAT LD L BLANK LD EBC BLANK K1010930 7D79 4C80 7D5C 1098 | BSC I GET RETURN TO CALLING PROGRAM K1010940 1099 | * K1010950 1100 | * TEST SW4 K1010960 7D7B C400 7A9E 1101 | MAT LD L SW4 LD LEFT/RIGHT CHAR SW K1010970 7D7D 4C20 7D95 1102 | BSC L LUKE,Z BR IF RIGHT CHAR K1010980 1103 | * K1010990 1104 | * TAG SW4 K1011000 7D7F 7401 7A9E 1105 | MDX L SW4,1 SET SW TO PROCESS RIGHT NXT K1011010 1106 | * K1011020 1107 | * PUT LEFT CHAR. IN A REGISTER K1011030 7D81 C100 1108 | LD 1 0 LD WD I/P STRING K1011040 7D82 1808 1109 | SRA 8 CHAR IN BITS 8-15 K1011050 7D83 E400 7AB0 1110 | AND L MASK MASK OUT BIS 0-7 K1011060 7D85 D01D 1111 | STO WALT SAVE IN TEMP STORAGE K1011070 1112 | * K1011080 1113 | * TEST SW11 K1011090 7D86 C400 7C71 1114 | ABIT LD L SW11 LD QUOTE TYPE SPEC SW K1011100 7D88 4C18 7D8C 1115 | BSC L LARR,+- BR IF NOT QUOTE TYPE K1011110 7D8A C018 1116 | LD WALT LD O/P WD K1011120 7D8B 7007 1117 | MDX LARR+7 BR TO EXIT K1011130 1118 | * K1011140 1119 | * IS CHARACTER BLANK K1011150 7D8C C016 1120 | LARR LD WALT LD CHAR FROM TEMP STO K1011160 7D8D 9400 7C67 1121 | S L BLANK TEST FOR EBC BLANK K1011170 7D8F 4C18 7D5D 1122 | BSC L GETY,+- BR IF BLANK TO GET NXT CHAR K1011180 7D91 8400 7C67 1123 | A L BLANK ELSE, RESTORE CHAR K1011190 7D93 4C80 7D5C 1124 | BSC I GET RETURN TO CALLING PROGRAM K1011200 1125 | * K1011210 1126 | * NORMALIZE SW4 K1011220 7D95 1010 1127 | LUKE SLA 16 SET LEFT/RIGHT CHAR SW FOR K1011230 7D96 D400 7A9E 1128 | STO L SW4 *LEFT CHAR NEXT TIME K1011240 1129 | * K1011250 1130 | * PUT RIGHT CHAR IN A REGISTER K1011260 7D98 C100 1131 | LD 1 0 LD WD FR I/P STRING K1011270 7D99 E400 7AB2 1132 | AND L MASKK MASK OUT BITS 0-7 K1011280 7D9B D007 1133 | STO WALT SAVE IN TEMPORARY STORAGE K1011290 1134 | * K1011300 1135 | * MOVE POINTER 1 K1011310 7D9C 7101 1136 | MDX 1 1 INCR INPUT STRING POINTER K1011320 1137 | * K1011330 1138 | * NCNT=NCNT-1 K1011340 7D9D 74FF 7ABC 1139 | MDX L NCNT,-1 DECR COUNT OF WDS IN STMNT K1011350 1140 | * K1011360 1141 | * NCNT=0 K1011370 7D9F 70E6 1142 | MDX ABIT BR IF COUNT NOT FINISHED K1011380 1143 | * K1011390 1144 | * TAG SW5 K1011400 7DA0 7401 7A9F 1145 | MDX L SW5,1 SET END OF STMNT SW K1011410 7DA2 70E3 1146 | MDX ABIT BR TO TEST CHAR K1011420 1147 | * K1011430 1148 | * CONSTANTS K1011440 7DA3 0000 1149 | WALT DC 0 TEMP STO FOR CHAR OBTAINED K1011450 7DA4 0000 1150 | VIGG DC 0 LOC OF STMNT ID K1011460 7DA5 0000 1151 | TABC DC 0 NO. WDS O/P STRING STMNT K1011470 7DA6 F803 1152 | MATB DC /F803 MASK TO CLEAR NORM ID WD K1011480 7DA7 0000 1153 | VAB DC 0 TEMP STO I/P STRING PT K1011490 7DA8 0000 1154 | VAB1 DC 0 TEMP STO O/P STRING PT K1011500 1155 | * K1011510 1156 | * SUBROUTINE TO PUT WORD ON OUTPUT K1011520 1157 | * STRING. ACC CONTAINS WORD TO BE K1011530 1158 | * OUTPUT ON ENTRY TO THIS SUBROUTINE. K1011540 1159 | * K1011550 7DA9 0000 1160 | PUT DC 0 SUBROUTINE ENTRY POINT K1011560 1161 | * K1011570 1162 | * PUT A REGISTER IN BUILD BUFFER K1011580 7DAA D200 1163 | STO 2 0 SAVE O/P WD IN STRING K1011590 7DAB 7401 7DA5 1164 | MDX L TABC,1 INCR O/P WD CNT K1011600 1165 | * K1011610 1166 | * MOVE POINTER K1011620 7DAD 7201 1167 | MDX 2 1 INCR O/P STRING PT K1011630 1168 | * K1011640 1169 | * CHECK OVERLAP K1011650 7DAE 69F9 1170 | STX 1 VAB1 SAVE I/P STRING PT K1011660 7DAF 6AF7 1171 | STX 2 VAB SAVE O/P STRING PT K1011670 7DB0 C0F7 1172 | LD VAB1 COMPARE I/P POINTER K1011680 7DB1 90F5 1173 | S VAB * WITH OUTPUT POINTER K1011690 7DB2 4C10 7DB8 1174 | BSC L VAB2,- BR IF I/P GE O/P K1011700 1175 | * K1011710 1176 | * SET UP OVERLAP ERROR K1011720 7DB4 7401 7A2D 1177 | MDX L ERROR,1 SET SYSTEM OVERLAP ERR FLAG K1011730 7DB6 4C00 7A3C 1178 | BSC L OUT BR TO EXIT FR COMPILER K1011740 1179 | * K1011750 1180 | * REDO=REDO + 1 K1011760 7DB8 7401 7ABA 1181 | VAB2 MDX L REDO,1 INCR REDO COUNT K1011770 1182 | * K1011780 1183 | * LOOP=LOOP-1 K1011790 7DBA 74FF 7BAA 1184 | MDX L LOOP,-1 INCR LOOP COUNT K1011800 7DBC 4C80 7DA9 1185 | BSC I PUT RETURN TO CALLING PROGRAM K1011810 1186 | * K1011820 1187 | * THIS SUBR NORMALIZES SUM AND SW15 K1011830 1188 | * K1011840 7DBE 0000 1189 | NLIZE DC 0 SUBROUTINE ENTRY POINT K1011850 1190 | * K1011860 1191 | * SUM = 0 K1011870 7DBF 1010 1192 | SLA 16 CLEAR ACC K1011880 7DC0 D400 7A9A 1193 | STO L SUM CLEAR FIELD WIDTH K1011890 1194 | * K1011900 1195 | * NORMALIZE SW15 K1011910 7DC2 D400 7ABF 1196 | STO L SW15 CLEAR DIGIT ENCOUNTERED SW K1011920 7DC4 4C80 7DBE 1197 | BSC I NLIZE RETURN TO CALLING PROG K1011930 1198 | * K1011940 1199 | * THIS ROUTINE TESTS SW15 AND SUM K1011950 1200 | * K1011960 7DC6 0000 1201 | SUBR DC 0 SUBROUTINE ENTRY POINT K1011970 1202 | * K1011980 1203 | * SW15 TAGED K1011990 7DC7 C400 7ABF 1204 | LD L SW15 TEST FOR DIGIT ENCOUNTERED K1012000 7DC9 4818 1205 | BSC +- SKIP IF YES K1012010 7DCA 7004 1206 | MDX OUT2 RETURN TO CALLING PROG IF N K1012020 1207 | * K1012030 1208 | * SUM=0 K1012040 7DCB C400 7A9A 1209 | LD L SUM LD FIELD WIDTH K1012050 7DCD 4C18 7B09 1210 | BSC L J,+- BR TO ERR IF = 0 (ERR 27) K1012060 7DCF 4C80 7DC6 1211 | OUT2 BSC I SUBR RETURN TO CALLING PROG IF N K1012070 7DD1 1212 | BSS BPHAR+PHLEN*320-1-* PATCH AREA K1012080 7DF5 0000 1213 | DC 0 K1012090 7DF6 1214 | END BPHAR-2 K1012100 There were no errors in this assembly === CROSS REFERENCES ========================================================== Name Val Defd Referenced $PHSE 0078 89 146 AA 7B18 388 424 ABEL 7A5C 182 210 244 1094 ABIT 7D86 1114 1142 1146 ACH 7B16 386 416 ACON 7BBA 577 601 ATYPE 7D46 1033 1061 B 7D4C 1044 405 BAKER 7A7F 223 373 378 887 BB 7D4E 1046 1052 BCON 7BBB 578 605 BK 7BE4 629 590 598 669 BLANK 7C67 779 923 1097 1121 1123 BOX 7BB1 568 662 672 BOY 7BEE 637 602 BOY1 7BF0 641 606 BOY2 7BF2 645 610 BOY3 7BF4 649 614 638 BOY4 7BF6 653 618 BOY5 7BF8 657 622 BOY6 7BFA 661 626 642 646 650 654 658 BPHAR 7A36 138 1212 1214 BT11 7C11 688 BT11A 7C0F 686 678 BTEST 7BFC 665 C 7D51 1050 409 C146 7C70 788 881 CATT 7D37 1019 1009 CBEL 7A66 193 186 CCWD 7A31 109 COMMA 7C69 781 1008 COMON 7A2B 103 COMTP 7D47 1034 447 971 1040 1045 1051 1056 1062 CSIZE 7A2C 104 CT 7C6D 785 800 835 866 871 D 7D54 1055 413 DCON 7BBE 581 617 DD 7BAC 563 764 968 978 DD2 7D56 1057 1063 DECEM 7A78 213 194 DFCNT 7A33 130 DIV 7B1A 390 434 DOG 7AF3 341 368 558 712 965 1016 1026 E 7C64 775 417 ECHO 7B3C 433 1020 EE 7B14 384 408 EITC 7B71 490 502 ENDC 7AA5 261 185 EOFS 7A25 97 162 163 189 EOFST 7A2A 102 161 ER29 7C6F 787 885 ER30 7B1E 394 376 ERIID 7A99 248 233 ERR29 7CC5 885 363 828 ERR30 7B0D 376 542 760 768 ERRA 7AA7 263 219 ERRB 7AB8 280 371 ERRID 7AAE 270 237 ERRNO 7AAA 266 220 239 372 377 886 ERROR 7A2D 105 149 1177 ETYPE 7D44 1031 1050 EYE 7B15 385 412 F 7C34 727 776 1041 FAT 7D77 1097 1079 FEF 7B13 383 404 FNAME 7A2E 106 FORMC 7AA6 262 193 FOX 7B73 497 474 FTYPE 7D43 1030 1044 GAM 7CF5 943 898 GET 7D5C 1071 334 341 485 514 597 665 749 812 849 938 1098 1124 GET1 7AAF 271 228 243 GETY 7D5D 1074 1122 GREP 7B1C 392 330 473 497 503 511 691 704 GRP 7BC4 590 GRP1 7C13 691 430 634 HILO 7CDB 911 892 948 I 7D59 1061 425 IDNRM 7AAC 268 200 225 311 IDSAV 7AAB 267 213 227 IDSTO 7AA8 264 215 223 230 IDTPE 7AA4 260 184 INDIC 7AC0 292 216 INK 7B4E 452 443 IOCS 7A32 118 ITYPE 7D45 1032 1055 J 7B09 371 338 454 456 470 486 527 547 692 716 728 732 755 1210 JAM 7A8B 233 231 232 236 JAMES 7CB3 868 863 JAMEY 7C6E 786 803 864 JILL 7CCA 890 882 K 7D0A 968 537 751 772 KILO 7C81 812 914 LARR 7D8C 1120 1115 1117 LCON 7BBF 582 621 LIMA 7CEB 931 688 721 918 LOB 7CCE 897 817 836 LOB2 7C92 830 853 LOB3 7C99 842 822 LOOP 7BAA 561 317 505 711 878 1184 LOOPP 7A50 168 173 LP 7B19 389 429 LUKE 7D95 1127 1102 LUP 7A70 203 208 LXQ 7A46 161 150 M 7C4E 754 523 MAN 7B5E 468 439 MASK 7AB0 272 294 1110 MASK1 7AB1 273 302 MASK2 7AB5 277 345 354 MASKK 7AB2 274 1132 MAT 7D7B 1101 1075 MATB 7DA6 1152 1089 MEMRY 8000 86 87 88 MONE 7AB9 281 316 710 N127 7BAD 564 541 N145 7AB7 279 362 N31 7BAF 566 759 N5 7C6A 782 804 N7 7BAE 565 719 N9 7C6B 783 681 992 NCNT 7ABC 284 314 593 633 827 844 859 1139 NCNTH 7C74 793 845 858 NEOFS 7AA9 265 176 209 229 242 1093 NINE 7ABE 286 347 NLIZE 7DBE 1189 533 686 707 739 771 961 1197 NORM 7ABB 283 315 NRMSV 7AAD 269 226 312 NXTPH 7A42 157 141 153 154 NZER 7CC2 880 872 O 7C75 796 464 743 OLD 7CFC 951 1047 ONE 7B72 491 498 506 703 988 OPA 7BB2 569 637 OPB 7BB3 570 641 OPD 7BB6 573 653 OPL 7BB7 574 657 OPR 7BB8 575 661 OPS 7BB4 571 645 OPT 7BB5 572 649 ORG 7A23 95 ORIG 7A5A 179 174 OUT 7A3C 153 190 1178 OUT2 7DCF 1211 1206 OVERL 7A23 87 90 PARNL 7B11 381 337 PERD 7B70 489 546 PHID 0028 91 145 PHLEN 0003 92 1212 POP 7CFE 954 449 1058 PUT 7DA9 1160 479 504 507 673 683 720 806 908 924 974 994 1185 QUAD 7D28 1003 519 940 985 QUOTC 7C6C 784 453 821 852 RCON 7BC0 583 625 REDO 7ABA 282 328 477 695 876 1181 REP 7BB0 567 329 727 958 984 993 998 ROL 7FBC 88 155 RP 7C2A 715 435 RPARN 7BC1 584 668 RPET 7B1B 391 438 RXR1H 7CAB 860 846 SAVE 7AB3 275 299 300 SCON 7BBC 579 609 SOFGT 7A29 101 SOFNS 7A27 99 SOFS 7A24 96 164 175 SOFST 7A26 98 298 SOFXT 7A28 100 SORF 7A30 108 START 7A36 145 SUBR 7DC6 1201 448 676 698 1046 1057 1211 SUM 7A9A 250 323 351 356 455 526 677 682 701 715 731 735 758 763 957 1193 1209 SW1 7A9B 251 399 964 1004 SW11 7C71 789 326 809 935 1114 SW12 7B1F 395 327 459 816 891 SW15 7ABF 287 331 360 468 754 1012 1196 1204 SW16 7B20 396 367 469 550 SW2 7A9C 252 536 554 951 SW3 7A9D 253 522 557 954 SW4 7A9E 254 591 631 842 857 1101 1105 1128 SW45H 7C72 791 592 630 843 856 SW5 7A9F 255 1074 1145 SW6 7AA0 256 742 775 797 SW7 7AA1 257 897 902 917 928 947 SW8 7AA2 258 518 746 931 1015 1019 1024 SW9 7AA3 259 482 1078 TABC 7DA5 1151 321 874 1084 1087 1090 1164 TCON 7BBD 580 613 TCON1 7BC2 585 442 TEN 7AB6 278 352 TENC 7B1D 393 478 THREE 7AB4 276 295 297 TST 7B21 399 346 348 TST1 7B89 522 400 TTYPE 7BC3 586 446 TWO 7ABD 285 313 830 1085 V1S1 7BB9 576 594 632 VAB 7DA7 1153 1171 1173 VAB1 7DA8 1154 1170 1172 VAB2 7DB8 1181 1174 VENT 7A98 247 197 VENT1 7A6E 202 201 VIGG 7DA4 1150 309 1083 WALT 7DA3 1149 545 1111 1116 1120 1133 WW 7BAB 562 463 530 540 736 767 805 832 911 970 981 X 7B12 382 342 355 403 428 433 452 515 750 813 820 907 939 943 1007 1025 XENO 7B7F 510 499 XEX 7B17 387 420 XTYPE 7D42 1029 1039 XX 7A4D 166 165 Y 7C68 780 905 921 944 ZEBRA 7D25 997 989 ZR 7D71 1092 1082 ZX 7D48 1039 421
ibm/ibm1130-lib/dmsr2v12/kforph10_lst.txt · Last modified: 2023/08/06 13:34 by Site Administrator