$JOB COMMERCIAL CONVERSION ROUTINE 00000100 $EXECUTE IBJOB 00000150 $IBJOB GO,MAP,LOGIC,BASIC 00000200 $IBMAP CCR REF,NODECK,SYSMOD,MONSYM 00000300 * 00000400 * 00000500 * CALLING SEQUENCE TO COMML CONV ROUTINES 00000600 * 00000700 * TSX STOUT,4 00000800 * PFX1 DATA ADDRESS,MASK,PPPRD 00000900 * ... 00001000 * ... 00001100 * PFX2 FILE NAME,,CARRIAGE CONTROL 00001200 * 00001300 *PFX1 =PZE BINARY TO BCD MAXIMUM OF 18 EDITED CHARACTERS OUT 00001400 * MZE BCD TO BCD MAXIMUM OF ONE BCD WORD IN PLUS MASKI00001500 * PON BINARY TO OCTAL ALWAYS TWO FULL WORDS OUT 00001600 * 00001700 *MASK 1= ,AND. 2= ,.AND- 3= ,.AND* 4= ,.*AND- 5= $**,. 00001800 * 6= TO BE SPECIFIED BY THE USER 7= NO ZERO SUPPRESSION 00001900 * 0= NO MASK 00002000 * 00002100 *PPP =RIGHTMOST POSITION WITHIN 'COMMON' OF EDITED DATA 00002200 *R =NO OF POSITIONS TO LEFT OF UNITS WHERE HALF-ADJUST 5 IS ADDED 00002300 *D =NO OF DIGITS TO THE RIGHT OF THE DECIMAL IN EDITED FIELD 00002400 * 00002500 *PFX2 =MON NO OUTPUT BY STOUT, PTW STOUT IS TO USE JOBOU WHERE ADDRESS 00002600 * 0= PRINT 1= PUNCH DECREMENT IS JOBOU 00002700 * PREFIX CARRIAGE CONTROL CHARACTER 00002800 * MTW STOUT USES IOBS ADDRESS IS FILE NAME 00002900 * 00003000 * 00003100 * OUTPUT AREA OF THIS ROUTINE IS CALLED 'COMMON'. IT IS 22 WORDS 00003200 * IN LENGTH, TO HANDLE LONGER OUTPUT FORMATS THE USER MUST INCREASE 00003300 * THE LENGTH OF COMMON TO THAT REQUIRED BY HIS PROGRAM 00003400 * 00003500 * NOTE.... USER MUST DEFINE THE RIGHTMOST FIELD FIRST--- THE LEFTMOST 00003600 * FIELD LAST 00003700 * CONVERTED DATA WILL BE LOCATED IN (COMMON-1)+(PPP/6) 00003800 * 00003900 * 00004000 * IF CONVERSION IS BCD TO BCD THE DATA CANNOT EXCEED ONE BINARY WORD 00004100 * 00004200 * 00004300 * OBJECT PROGRAM MUST HAVE 00004400 * ENTRY ERRTN ROUTINE TO PROCESS ERROR IN CALLING SEQ 00004500 * EXTERN STOUT,COMMON 00004600 * 00004700 * 00004800 * 00004900 * IMPORTANT CONSTANT AND WORKING STORAGE AREAS WITHIN THIS ROUTINE 00005000 * 00005100 * LABEL DESCRIPTION 00005200 * 00005300 * COMMON 22 WORD OUTPUT AREA 00005400 * ROUNDS POSITION WHERE HALF ADJUST FIVE IS ADDED 00005500 * PRINTP CONTAINS RIGHTMOST PRINT POSITION 00005600 *U DECIML CONTAINS NUMBER OF CHARACTERS TO RIGHT OF DECIMAL 00005700 * EDIT SPECIFIES TYPE OF EDITING 00005800 * BINARY CONTAINS UNCONVERTED DATA 00005900 * 00006000 * BCD2 00006100 * BCD TWO WORDS WHICH CONTAIN DATA BEFORE EDITING 00006200 * 00006300 * OUT3 THESE THREE WORDS WILL 00006400 * OUT2 THE EDITED DATA WHICH WILL BE 00006500 * OUT1 STORED IN COMMON 00006600 * 00006700 * 00006800 ENTRY STOUT 00006900 ENTRY COMMON 00007000 * EXTERN ERRTN,JOBOU,JOBPP 00007100 STOUT SXA SAVE1,1 00007200 SXA SAVE2,2 00007300 SXA SAVE4A,4 00007400 * CLEAR OUTPUT AREA 00007500 SAVE4A AXT **,4 00007600 AXT 22,1 00007700 CAL =H 00007800 SLW COMMON+22,1 00007900 TIX *-1,1,1 00008000 * DISMANTLE CONTROL WORD 00008100 ST1 CLA 1,4 00008200 ANA =O077777000000 00008300 LGR 54 00008400 DVP =100 00008500 STQ PRINTP 00008600 TZE ST2 R AND D ARE ZERO 00008700 CAS =10 IF NOT ZERO COMPARE 00008800 TRA *+3 ACC GRTR THAN 10 GO AHEAD 00008900 TRA ST10 ROUND =1 NO DECIMAL 00009000 TRA ST210 ACC LESS THAN 10 NO ROUND 00009100 LGR 36 00009200 DVP =10 00009300 STQ ROUNDS 00009400 TZE ST2+1 NO DECIMAL 00009500 ST21 LGR 36 00009600 MPY =6 00009700 STQ DECIML 00009800 TRA ST25 00009900 ST2 STZ ROUNDS NO ROUNDING 00010000 STZ DECIML NO DECIMAL 00010100 TRA ST25 00010200 ST10 LGR 3 ROUND 1 POSITION 00010300 STO ROUND 00010400 TRA ST2+1 TO NO DECIMAL 00010500 ST210 STZ ROUNDS NO ROUNDING 00010600 TRA ST21 GO TO GET DECIMAL POSITION 00010700 ST25 LDQ 1,4 00010800 STQ CONTRO 00010900 ZAC 00011000 LGL 21 00011100 ANA =O7 00011200 STA EDIT STORE TYPE OF EDIT WORD 00011300 LGL 15 00011320 STA *+1 00011340 LDQ ** 00011400 STQ BINARY 00011500 TXI *+1,4,-1 00011600 SXA SAVE4,4 00011700 * 00011800 * DETERMINE TYPE OF CONVERSION 00011900 * 00012000 ZAC 00012100 LDQ CONTRO 00012200 LGL 3 00012300 TZE ROUND BINARY TO BCD 00012400 SUB =1 00012500 TZE BINOCT BINARY TO OCTAL 00012600 SUB =3 00012700 TZE ST3 BCD TO BCD 00012800 TRA TSTOUT 00012900 ST3 CAL BINARY 00013000 SLW BCD 00013100 CLA BCDS SSP 00013200 STO BCDS CAL =H 00013300 SLW BCD2 00013400 TRA EDITS 00013500 * 00013600 * BINARY TO BCD ROUTINE 00013700 * 00013800 * HALF ADJUSTING AND DROPPING 00013900 ROUNDS PZE 0 00014000 ROUND LAC ROUNDS,1 00014100 CLA HA,1 00014200 TZE HA2 00014300 ADD BINARY HALF ADJUST THE DATA 00014400 LGR 36 00014500 CLA DR,1 00014600 STO DIVSR 00014700 ZAC 00014800 DVP DIVSR DROP EXTRA POSITIONS 00014900 STQ BINARY 00015000 * 00015100 * CONVERT BINARY TO BCD 00015200 * 00015300 * DIVIDE BY 10 REMAINDER BECOMES BCD DIGIT 00015400 * 00015500 * SUBSTITUTE THE FOLLOWING INSTRUCTIONS 00015600 * IN PLACE OF ROUTINE HA2 IF CORE STORAGE IS LIMITED 00015700 * 00015800 * 00015900 *HA21 AXT 6,,2 00016000 * AXT 0,1 00016100 * ZAC 00016200 * DVP =10 00016300 * SAC BCD,1,5 00016400 * CLA *-1 00016500 * ADD =O1000000 00016600 * STD *-3 00016700 * TIX *-7,2,1 00016800 * AXT 1,1 00016900 * STQ BINARY 00017000 * CLA =5 00017100 * SAC *-8,,2 00017200 * LGL 36 00017300 * TNZ HA21 00017400 * 00017500 * 00017600 HA2 CLA BINARY DUMP BINARY WORD INTO BCD 00017700 STO BCDS IN ORDER TO SAVE THE SIGN 00017800 SSP SLW BINARY 00017900 STZ BCD2 ZERO SECOND BCD WORD 00018000 AXT 0,1 00018100 HA21 LDQ BINARY 00018200 ZAC 00018300 DVP =10 00018400 STO BCD,1 00018500 ZAC 00018600 DVP =10 00018700 ALS 6 ORS BCD,1 00018800 ZAC 00018900 DVP =10 00019000 ALS 12 ORS BCD,1 00019100 ZAC 00019200 DVP =10 00019300 ALS 18 ORS BCD,1 00019400 ZAC 00019500 DVP =10 00019600 ALS 24 ORS BCD,1 00019700 ZAC 00019800 DVP =10 00019900 ALS 30 ORS BCD,1 00020000 STQ BINARY 00020100 LGL 36 00020200 AXT 1,1 00020300 TNZ HA21 00020400 CLA EDIT ARE ZEROS TO BE 00020500 SUB =7 RETAINED 00020600 TZE EDITS YES GO TO EDITS 00020700 * 00020800 * 00020900 * TESTING FOR SIGNIFICANT DIGITS TO THE LEFT OF THE DECIMAL POINT 00021000 * 00021100 * 00021200 CLA BCD2 00021300 TNZ ZS THERE ARE DIGITS LEFT OF THE . 00021400 CLA DECIML 00021500 TZE ZS THERE IS NO . POINT 00021600 STA SHIFT4 SET UP LGR INSTRUCTION 00021700 LDQ =H GET BLANKS INTO THE MQ 00021800 CHS CHS OF NO. OF . PLACES 00021900 ADD =36 TEST FOR MAXIMUM NUMBER OF . 00022000 TZE EDITS POSITIONS IF SO GO TO EDITS 00022100 STA SHIFT5 OTHERWISE SET UP SECOND SHIFT 00022200 CAL BCD PUT DATA INTO AC 00022300 SHIFT4 LGR ** SHIFT RIGHT, PAST THE . 00022400 TNZ ZS TNZ IF THERE ARE DIGITS TO LEFT 00022500 CAL =H THERE ARE NONE SO PUT ZERO 00022600 SHIFT5 LGR ** SUPPRESSION INDICATOR IN THE MQ 00022700 STQ BCD AND STORE THE PREDEFINED DATA 00022800 LDQ =H 000229 STQ BCD2 00023000 TRA EDITS AND GO TO EDITING ROUTINE 00023100 * 00023200 * ZERO SUPPRESSION ROUTINE 00023300 * 00023400 ZS ZAC 00023500 AXT 2,4 NO OF WORDS TO BE TESTED 00023600 ZS1 AXT -6,2 SHIFT COUNTER 00023700 AXT 7,1 NO OF EXECUTIONS PER BCD WORD 00023800 LDQ BCD+1,4 00023900 SHIFT LGL 6 00024000 TXI *+1,2,6 INCREMENT SHIFT COUNTER 00024100 TNX GNXT,1,1 TEST TO SEE IF DONE WITH WORD 00024200 TZE SHIFT 00024300 LGR 6 NOT A ZERO SO STORE BLANKS 00024400 CAL =H 00024500 SXA *+1,2 NO OF POSITIONS OF BLANKS 00024600 LGR ** PUT BLANKS IN MQ 00024700 STQ BCD+1,4 STORE SUPPRESSED WORD 00024800 TRA EDITS 00024900 GNXT TXH STOBLK,4,1 00025000 TIX ZS1,4,1 IF INDEX REGISTER 1 EQUALS 1 00025100 CLA DECIML BOTH WORDS ARE ZERO 00025200 STA LGR1 STORE NO OF BITS TO BE 00025300 STA LGL1 SHIFTED TO OUTPUT A 00025400 ZAC FIELD OF ZEROS WITH 00025500 LGR1 LGR ** LEADING BLANKS 00025600 CAL =H 00025700 LGL1 LGL ** 00025800 SLW BCD 00025850 TRA EDITS 00025900 STOBLK CAL =H AN ENTIRE WORD 00026000 SLW BCD2 IS ZERO SO STORE 00026100 ZAC BLANKS IN BCD WORD 00026200 TRA GNXT+1 00026300 * 00026400 * EDITING ROUTINE 00026500 * 00026600 EDITS LAC EDIT,1 00026700 AXT 36,2 SHIFT COUNT 00026800 CLA M2 RESET SWITCH 00026900 STO E4 00027000 LDQ =H 00027100 TRA *+1,1 00027200 TRA E00 00027300 TRA E01 00027400 TRA E02 00027500 TRA E03 00027600 TRA E04 00027700 TRA E05 00027800 TRA E06 00027900 TRA E07 00028000 * 00028100 * 00028200 * E0X ROUTINES ESTABLISH THE NUMBER OF CHARACTERS TO BE INSERTED TO 00028300 * THE RIGHT OF THE NUMERIC DATA. THESE CHARACTERS ARE LOADED INTO THE 00028400 * (LEFT JUSTIFIED) AND INDEX REGISTER 2 IS SET TO A VALUE OF 36 MINUS T00028500 * NUMBER OF BITS INSERTED INTO THE MQ 00028600 * 00028700 * 00028800 * E00 NO EDIT WORD 00028900 TMTAD1 PZE OUT2,,BCD2 00029000 E00 CLA TMTAD1 00029100 PAX 0,1 SAVE DESTINATION PDX 0,2 SAVE FROM CLA 0,2 SLW 0,1 CLA 1,2 SLW 1,2 CLA BCDS TEST FOR MINUS DATA 00029300 TPL P 00029400 CAL BCD WORDS 00029500 ANA =O77 SAVE UNITS POSITION 00029600 TZE STMIZE TEST FOR A ZERO 00029700 CAL BCD NON-ZERO UNITS POSITION 00029800 ORA =O40 STORE MINUS 00029900 SLW BCD SIGN 00030000 TRA P 00030100 STMIZE CAL BCD UNITS POSITION IS ZERO SO 00030200 ANA =O7777777700 ORA =O52 STO BCD STORE MINUS ZERO 00030300 TRA P 00030400 * 00030500 * E01 EDIT WORD IS , S AND A . 00030600 E01 TRA E1 00030700 * 00030800 * E02 SAME AS E01 BUT WITH MINUS SIGN 00030900 E02 CLA BCDS 00031000 TPL *+1 LDQ =H- 00031100 E22 AXT 30,2 00031200 TRA E1 00031300 * 00031400 * E03 EDIT WORD IS , S . AND * TOTAL I.D. 00031500 E03 LDQ =H* 00031600 TRA E22 00031700 * 00031800 * E04 SAME AS E03 BUT WITH MINUS SIGN 00031900 E04 CLA BCDS 00032000 TPL *+1 LDQ =H-* 00032100 AXT 24,2 00032200 TRA E1 00032300 * 00032400 * E05 EDIT WORD IS $** , S AND . CHECK PROTECTION 00032500 E05 STL SWE1 00032600 TRA E1 00032700 * 00032800 * E06 USER MAY USE THIS ENTRY POINT 00032900 E06 TRA .LXRTN 00033000 * 00033100 *E07 TO RETAIN LEADING ZEROS 00033200 E07 TRA E00 00033300 * 00033400 * EDITING ROUTINE 00033500 * 00033600 * GET DECIMAL POSITION 00033700 E1 PXA 0,2 ADJUST EXISTING COUNT 00033800 SUB DECIML BY NO OF POSITIONS 00033900 PAX 0,2 FOR DECIMAL 00034000 AXT 0,1 OUTPUT WORD POSITION 00034100 AXT -1,4 00034200 CLA DECIML 00034300 STA SHIFT2 NO OF POSITIONS TO RIGHT OF . 00034400 CHS 00034500 ADD =36 00034600 STA SHIFT3 NO OF POS TO LEFT OF . 00034700 CAL BCD PICKUP DATA 00034800 SHIFT2 LGR ** SHIFT DECIMAL DATA OVER 00034900 STQ MQ SAVE THE MQ 00035000 LDQ BCD PICKUP DATA 00035100 CAL =O777777777777 GET END OF WORD TEST BITS 00035200 SHIFT3 LGL ** SHIFT OVER DATA TO LEFT OF . 00035300 LDQ MQ RESTORE THE MQ 00035400 ALS 6 SHIFT AC OVER 00035500 ORA =H00000. PUT IN DECIMAL 00035600 TXH *+2,2,0 00035700 TRA E51 00035800 E3 LGR 6 00035900 TXI *+1,2,-6 COUNT DECIMAL SHIFT 00036000 ORA =O770000000000 PUT IN LAST CHRCTR TEST BITS 00036100 * 00036200 * NOW MASK IN CHARACTERS OTHER THAN THE FIRST DECIMAL 00036300 * 00036400 TXH *+2,2,0 00036500 TRA E5 MQ IS FULL GO TO E5 00036600 E45 STO T ANA =O77 CAS =O77 TEST TO SEE IF ALL CHRCTRS 00036700 TRA *+2 HAVE BEEN SHIFTED IF SO 00036800 TRA E4 GO TO E4 00036900 CAS =O60 TEST FOR ZERO SUPPRESSION INDICATOR 00037000 TRA *+2 00037100 TRA E6 YES IT IS 00037200 TXI *+1,4,1 COUNT DIGITS MOVED 00037300 CAL T TXL E3,4,2 TO E3 IF IR4 NOT 3 00037400 AXT 0,4 00037500 ALS 6 00037600 ORA EW PUT IN NEXT EDIT CHARACTER A COMMA 00037700 LGR 6 COUNT ITS SHIFT 00037800 ORA =O770000000000 00037900 TXI *+1,2,-6 00038000 TXH E3,2,0 SEE IF IT FILLED MQ 00038100 TRA E5 Y ES IT DID 00038200 T BSS 1 * 00038300 * E4 GET SECOND WORD OR GET OUT OF EDIT 00038400 * 00038500 E4 CLA M1 00038600 STO *-1 00038700 TXI *+1,4,1 COUNT LAST CHARACTER MOVED 00038800 CAL BCD2 00038900 ANA =O770000000000 CAS =O600000000000 TEST FOR BLANKS IN 00039000 TRA *+2 SECOND BCD WORD (ZERO SUPPRESS) 00039100 TRA E6 IF SO GO TO E6 00039200 TNZ E3 00039300 TRA E6 00039400 CAL BCD2 * 00039500 * E5 STORE MQ IN OUTPUT AREA AND RESET COUNT IR2 00039600 * 00039700 E5 STQ OUT1,1 00039800 AXT 36,2 00039900 LDQ =H 00040000 TXI E45,1,1 00040100 E51 STQ OUT1,1 00040200 AXT 36,2 00040300 LDQ =H 00040400 TXI E3,1,1 00040500 * 00040600 * SWE1 IS USE TO HANDLE $** TO LEFT OF THE MSD 00040700 * 00040800 E6 TNZ SWE1 00040900 TRA E7 00041000 CAL =H 00041100 SXA *+1,2 PUT REMAINING PLACES TO SHIFT IN LGR 00041200 LGR ** SHIFT LAST DATA IN 00041300 STQ OUT1,1 STORE IN OUT WORD 00041400 TRA P 00041500 * 00041600 * E7 FOR $** 00041700 * 00041800 E7 STZ SWE1 00041900 AXT -1,4 00042000 CAL =H $** 00042100 TRA E3 00042200 * 00042300 * PRINT ROUTINE -PLACE WORDS IN DESIRE ARRANGEMENT FOR OUTPUTING 00042400 * 00042500 P LDQ PRINTP 00042600 SAVE4 AXT 0,4 00042700 ZAC 00042800 DVP =6 00042900 TZE PW PRINT POSITION IS EVEN WORD 00043000 * 00043100 * PRINT POSITION FALLS WITHIN A WORD 00043200 * 00043300 STO REM 00043400 LGL 36 00043500 PAC 0,1 PRINT WORD REL POS TO IR1 00043600 LDQ REM CONVERT REM 00043700 MPY =6 TO BITS 00043800 LGL 36 00043900 STA REM1 STO NO OF BITS IN REM1 00044000 CHS 00044100 ADD =36 00044200 STA RESULT 00044300 * 00044400 * GET OUTPUT WORD WHICH WILL BE PACKED 00044500 * 00044600 CAL COMMON,1 00044700 XEC RESULT SHIFT TO DESIRED PP 00044800 CAL OUT1 PUT IN OUTPUT 00044900 XEC REM1 SHIFT TO FILL MQ 00045000 STQ COMMON,1 00045100 XEC RESULT 00045200 CAL OUT2 00045300 XEC REM1 00045400 STQ COMMON-1,1 00045500 XEC RESULT 00045600 CAL OUT3 00045700 XEC REM1 00045800 STQ COMMON-2,1 00045900 TRA COMOUT 00046000 * 00046100 * ROUTINE TO FILL OUTPUT WITH EVEN WORDS 00046200 * 00046300 PW LGL 36 00046400 PAC 0,1 00046500 CAL OUT1 00046600 SLW COMMON-1,1 00046700 CAL OUT2 00046800 SLW COMMON-2,1 00046900 CAL OUT3 00047000 SLW COMMON-3,1 00047100 COMOUT CAL =H 00047200 SLW OUT2 00047300 SLW OUT3 00047400 TRA ST1 00047500 * 00047600 * BINOCT CONVERT BINARY TO OCTAL 00047700 * SUBSTITUTE THE FOLLOWING INSTRUCTIONS 00047800 * IN PLACE OF BINOCT IF CORE STORAGE IS LIMITED 00047900 *BINOCTAXT 6,1 00048000 * AXT 2,2 00048100 * ZAC 00048200 * LDQ BINARY 00048300 * ALS 3 00048400 * LGL 3 00048500 * TIX *-2,1,1 00048600 * SLW OUT2+2,2 00048700 * AXT 6,1 00048800 * TIX *-5,2,1 00048900 * TRA P 00049000 * 00049100 * 00049200 * 00049300 BINOCT LDQ BINARY 00049400 ZAC 00049500 LGL 3 00049600 ALS 3 00049700 LGL 3 00049800 ALS 3 00049900 LGL 3 00050000 ALS 3 00050100 LGL 3 00050200 ALS 3 00050300 LGL 3 00050400 ALS 3 00050500 LGL 3 00050600 SLW OUT2 00050700 ALS 3 00050800 LGL 3 00050900 ALS 3 00051000 LGL 3 00051100 ALS 3 00051200 LGL 3 00051300 ALS 3 00051400 LGL 3 00051500 ALS 3 00051600 LGL 3 00051700 ALS 3 00051800 LGL 3 00051900 SLW OUT1 00052000 TRA P 00052100 * 00052200 * TEST FOR OUTPUT 00052300 TSTOUT LDQ CONTRO 00052400 ZAC 00052500 LGL 3 00052600 SUB =2 00052700 TZE SJOBOU 00052800 SUB =3 00052900 TZE SAVE1 00053000 SUB =1 00053100 TZE IOBS 00053200 TRA ERRTN 00053300 * 00053400 * INTERFACE TO IOBS 00053500 * 00053600 IOBS CLA CONTRO 00053700 STA *+3 00053800 XEC STOUT+2 00053900 TSX .PUTL,4 00054000 PZE **,,COMMON 00054100 XEC SAVE4A 00054200 TRA SAVE1 00054300 * 00054400 * JOBOU INTERFACE 00054500 * 00054600 SJOBOU CLA CONTRO 00054700 ANA =O77777 00054800 TZE JPRINT 00054900 LDQ JPCH RQL 6 LGL 6 STQ JPCH 00055000 CALL JOBPP(JPCH) 00055100 TRA SAVE1 00055200 JPCH PZE COMMON 00055300 JPRINT LDQ CONTRO 00055400 LGL 21 00055500 LDQ BRLIST RQL 6 LGL 6 STQ BRLIST,,0 00055600 CALL JOBOU(PRLIST) 00055700 TRA SAVE1 00055800 PRLIST PZE 1 00055900 BRLIST PZE COMMON,0,22 00056000 * 00056100 * NO OUTPUT AND NORMAL RETURN 00056200 * 00056300 SAVE1 AXT 0,1 00056400 SAVE2 AXT 0,2 00056500 TRA 1,4 00056600 BSS 3 00056700 COMMON BSS 22 00056800 HA PZE 0 00056900 DEC 5,50,500,5000,50000,500000,5000000 00057000 DR DEC 1,10,100,1000,10000,100000,1000000,10000000 00057100 PRINTP PZE 0 00057200 DECIML PZE 0 00057300 EDIT PZE 0 00057400 BINARY PZE 0 00057500 CONTRO PZE 0 00057600 DIVSR PZE 0 00057700 BCD2 PZE 0 00057800 BCD PZE 0 00057900 EW BCI 1,00000, 00058000 M1 TRA E6 00058100 OUT3 BCI 1, 00058200 OUT2 PZE 0 00058300 OUT1 PZE 0 00058400 SWE1 PZE 0 00058500 M2 CLA M1 00058600 REM PZE 0 00058700 RESULT LGR * * 00058800 REM1 LGR ** 00058900 MQ PZE 00059000 BCDS PZE 0 00059100 END STOUT 00059200 $*JOB TEST COMMERCIAL CONVERSION ROUTINE 00000100 $*EXECUTE IBJOB $*IBJOB 00000200 $IBMAP TEST LIST,NODECK,SYSMOD,MONSYM 00000300 TFILE FILE OU,OU1,OUTPUT,BLOCK=16 00000400 ENTRY START 00000500 ENTRY ERRTN 00000600 * EXTERN STOUT,COMMON 00000700 Z EQU STOUT 00000800 * PUT OUT PAGE HEADING WITH A SKIP TO CHANNEL ONE 00000900 START AXT ,1 00001000 ERRTN TSX Z,4 00001100 MZE A+2,,01900 00001200 MZE A+1,,01300 00001300 MZE A,,00700 00001400 M1 PTW ,,1 00001500 * 00001600 * PUT OUT DECIMAL TEST DATA USING ALL MASK OPTIONS EXCEPT NUMBER 6 00001700 * 00001800 TSX Z,4 00001900 PZE F,7,07500 00002000 PZE F,5,06502 00002100 PZE G,4,05501 00002200 PZE F,3,04501 00002300 PZE G,2,03501 00002400 PZE F,1,02501 00002500 PZE F,0,01500 00002600 MZE C,,00700 00002700 M2 PTW ,,2 00002800 * 00002900 * PUT OUT BLANK LINE FOR EXTRA SPACING 00003000 * 00003100 TSX Z,4 00003200 M3 PTW ,,2 00003300 * 00003400 * PUT OUT BCD COPY OF WHAT OUTPUT SHOULD RESEMBLE 00003500 * 00003600 TSX Z,4 00003700 MZE M+1,,07500 00003800 MZE M,,06900 00003900 MZE P+1,,06500 00004000 MZE P,,05900 00004100 MZE L+1,,05500 00004200 MZE L,,04900 00004300 MZE K+1,,04500 00004400 MZE K,,03900 00004500 MZE J+1,,03500 00004600 MZE J,,02900 00004700 MZE I+1,,02500 00004800 MZE I,,01900 00004900 MZE H,,01500 00005000 MZE D,,00700 00005100 M4 PTW ,,2 00005200 * 00005300 * TEST BINARY TO OCTAL CONVERSION 00005400 * 00005500 TSX Z,4 00005600 MZE E+2,,01900 00005700 MZE E+1,,01300 00005800 MZE E,,00700 00005900 M5 PTW ,,2 00006000 TSX Z,4 00006100 PON Q,,02000 00006200 MZE C,,00700 00006300 M6 PTW 00006400 TSX Z,4 00006500 MZE R+1,,02000 00006600 MZE R,,01400 00006700 MZE D,,00700 00006800 M7 PTW 00006900 * 00007000 * TEST ROUNDING 00007100 * 00007200 TSX Z,4 00007300 MZE S+1,,01300 00007400 MZE S,,00700 00007500 M8 PTW ,,2 00007600 TSX Z,4 00007700 PZE O,1,02434 00007800 MZE C,,00700 00007900 M9 PTW 00008000 TSX Z,4 00008100 MZE N+1,,02400 00008200 MZE N,,01800 00008300 MZE D,,00700 00008400 M11 PTW 00008500 * 00008600 * TEST SIX POSITION DECIMAL ANSWERS 00008700 * 00008800 TSX Z,4 00008900 MZE W+3,,02400 00009000 MZE W+2,,01800 00009100 MZE W+1,,01200 00009200 MZE W,,00600 00009300 M16 PTW ,,2 00009400 TSX Z,4 00009500 PZE U,1,08006 00009600 MZE C,,07000 00009700 MZE V+1,,06000 00009800 MZE V,,05400 00009900 MZE D,,05000 00010000 M12 PTW ,,2 00010100 * 00010200 * TEST ACCURACY OF STOUT BY STARTING WITH VALUE OF 1 AND ADDING 00010300 * IT TO ITSELF 35 TIMES 00010400 * 00010500 TSX Z,4 00010600 MZE X+8,,06000 00010700 MZE X+7,,05400 00010800 MZE X+6,,04800 00010900 MZE X+5,,04200 00011000 MZE X+4,,03600 00011100 MZE X+3,,03000 00011200 MZE X+2,,02400 00011300 MZE X+1,,01800 00011400 MZE X,,01200 00011500 M13 PTW ,,2 00011600 TSX Z,4 00011700 M14 PTW ,,2 00011800 AXT 35,2 00011900 TSX Z,4 00012000 PZE Y,1,08002 00012100 M15 PTW 00012200 CLA Y 00012300 ADD Y 00012400 STO Y 00012500 TIX *-6,2,1 00012600 * 00012700 * END OF TEST 00012800 * 00012900 TSX Z,4 00013000 MZE T+1,,05600 00013100 MZE T,,05000 00013200 M10 PTW ,,1 00013300 TIX NEXT,1,1 00013400 AXT 2,1 00013500 CLA C1 00013600 STO M1 00013700 STO M2 00013800 STO M3 00013900 STO M4 00014000 STO M5 00014100 STO M6 00014200 STO M7 00014300 STO M8 00014400 STO M9 00014500 STO M10 00014600 STO M11 00014700 STO M12 00014800 STO M13 00014900 STO M14 00015000 STO M15 00015100 STO M16 00015200 CLA =1 00015300 STO Y 00015400 TRA START+1 00015500 NEXT CLA C2 00015600 STO C1 00015700 CLA C3 00015800 STO M10+1 00015900 TSX .OPEN,4 00016000 PON TFILE 00016100 TRA M10+2 00016200 A BCI 3,TEST STOUT ROUTINE 00016300 B BCI 3,BINARY TO DECIMAL 00016400 C BCI 1,STOUT 00016500 D BCI 1,SH/BE 00016600 E BCI 3,BINARY TO OCTAL 00016700 F DEC 12345 00016800 G DEC -12345 00016900 H BCI 1, 12345 00017000 I BCI 2, 1,234.5 00017100 J BCI 2, 1,234.5- 00017200 K BCI 2, 1,234.5* 00017300 L BCI 2, 1,234.5-* 00017400 M BCI 2,000000012345 00017500 N BCI 2, 2,050.0123 00017600 O DEC 20500122729 00017700 P BCI 2, $**123.45 00017800 Q DEC 2647 00017900 R BCI 2,000000005127 00018000 S BCI 2,ROUNDING 00018100 T BCI 2,END OF TEST 00018200 U DEC 123999495 00018300 V BCI 2, 123.999495 00018400 W BCI 4,TEST 6 DECIMAL PLACES 00018500 X BCI 9,TEST ACCURACY START WITH 1 AND DOUBLE 35 TIMES 00018600 Y DEC 1 00018700 C1 PTW 1 00018800 C2 MTW TFILE 00018900 C3 TRA .LXRTN 00019000 END START 00019100 $ENTRY START ~ $IBSYS $STOP