*SIM1401 START 0 00000100 *********************************************************************** * * * 1401 SIMULATOR AS MODIFIED BY TOM BROWN WRO AS OF 71182 * * * *********************************************************************** 00000200 * * 00000300 * * 00000400 * 1 4 0 1 S I M U L A T O R F O R S Y S T E M / 3 6 0 * 00000500 * * 00000600 * * 00000700 * * 00000800 * THIS PROGRAM WILL SIMULATE A 1401 ON A SYSTEM/360. THE * 00000900 * SYSTEM/360 MUST HAVE AT LEAST 65K, STANDARD INSTURCTION SET, ONE * 00001000 * 1052, ONE 2540, AND ONE PRINTER. THE 1401 FEATURES SUPPORTED ARE * 00001100 * ADVACED PROGRAMMING, SENSE SWITCHES, TAPES, MULTIPLY, DIVIDE, * 00001200 * 16K CORE, AND ALL STANDARD INSTRUCTIONS EXCEPT SELECT STACKER. * 00001300 * OPERATOR CONTROL IS THROUGH THE 1052, USING THE FOLLOWING ENTRIES * 00001400 * * 00001500 * * 00001600 * SRS - START RESET * 00001700 * STT - START * 00001800 * LDC - LOAD FROM CARDS * 00001900 * LDT - LOAD FROM TAPE * 00002000 * SSS - SET SENSE SWITCHES * 00002100 * TAS - TAPE ASSIGNMENT * 00002200 * CLR - CLEAR ALL 1401 CORE * 00002300 * DIS - DISPLAY 1401 CORE ON THE PRINTER * 00002400 * ALT - ALTER 1401 CORE * 00002500 * WTM - WRITE TAPE MARK * 00002600 * RWD - REWIND TAPE * 00002700 * TRM - TERMINATE THE SIMULATOR * 00002800 * * 00002900 * * 00003000 * * 00003100 * 16K BYTES ARE SET ASIDE FOR SIMULATED CORE, WITH EACH BYTE HAVING * 00003200 * THE FOLOWING FORMAT. * 00003300 * 360 BIT 1401 BIT * 00003400 * 0 UNUSED * 00003500 * 1 WORD MARK * 00003600 * 2 B * 00003700 * 3 A * 00003800 * 4 8 * 00003900 * 5 4 * 00004000 * 6 2 * 00004100 * 7 1 * 00004200 * * 00004300 * * 00004400 *********************************************************************** 00004500 EJECT 00004600 USING SETBS1,15 00004700 USING SETBS1+4096,14 00004800 USING SIMCOR,7 00004900 TITLE 'ADD' 00005000 USING A,13 00005100 A CH 9,=H'7' DETERMINE INSTRUCTION LENGTH 00005200 BE AL7 * 00005300 CH 9,=H'1' * 00005400 BE AL1 * 00005500 CH 9,=H'4' * 00005600 BNE ILEGLN * 00005700 LA 6,1(10) 4 CHARACTERS, SET A AND B EQUAL 00005800 BAL 8,CVAD43 * 00005900 LR 11,5 * 00006000 LR 12,11 * 00006100 B AL1 * 00006200 AL7 LA 6,1(10) CONVERT ADDRESSES 00006300 BAL 8,CVAD43 * 00006400 LR 11,5 * 00006500 LA 6,4(10) * 00006600 BAL 8,CVAD43 * 00006700 LR 12,5 * 00006800 AL1 MVI POS1,1 SET 1-POSITION INDICATOR 00006900 MVI AEND,0 CLEAR A-FIELD ENDED INDICATOR 00007000 LA 0,1 SET REGISTER FOR FAST SUBTRACTION 00007100 IC 4,0(10) GET OP CODE 00007200 SRDL 4,1 SAVE LOW ORDER BIT 00007300 IC 4,0(11) GET A-FIELD SIGN 00007400 SRL 4,4 * 00007500 SRDL 4,2 * 00007600 IC 4,0(12) GET B-FIELD SIGN 00007700 SRL 4,4 * 00007800 SLDL 4,3 TEST TABLE 00007900 N 4,=F'31' * 00008000 A 4,=A(TBTRCP) * 00008100 TM 0(4),X'1' * 00008200 BO AL1H COMPLEMENT ADD 00008300 * 00008400 * PERFORM TRUE ADD 00008500 * 00008600 MVI AL1C+1,X'70' SET TO KEEP SIGN 00008700 LA 1,0 CLEAR CARRY 00008800 AL1A IC 3,0(12) GET B-FIELD CHARACTER 00008900 LR 6,3 SAVE B-FIELD ZONE 00009000 N 3,=F'15' ISOLATE DIGIT 00009100 C 3,=F'11' Q/ IS DIGIT NUMERIC 00009200 BL *+8 YES 00009300 S 3,=F'8' NO, ELIMINATE 8 BIT 00009400 CH 3,=H'10' Q/ ZERO 00009500 BNE *+6 NO 00009600 SR 3,3 YES, CLEAR IT 00009700 CLI AEND,1 Q/ IS THERE STILL AN A-FIELD 00009800 BE AL1B NO 00009900 IC 4,0(11) YES, GET DIGIT 00010000 LR 5,4 * 00010100 N 4,=F'15' * 00010200 C 4,=F'11' Q/ IS DIGIT NUMERIC 00010300 BL *+8 YES 00010400 S 4,=F'8' NO, ELIMINATE 8 BIT 00010500 CH 4,=H'10' Q/ ZERO 00010600 BNE *+6 NO 00010700 SR 4,4 YES, CLEAR IT 00010800 AR 3,4 ADD A TO B 00010900 AL1B AR 3,1 ADD CARRY 00011000 LA 1,0 CLEAR CARRY 00011100 CH 3,=H'9' Q/ IS RESULT GREATER THAN 9 00011200 BNH AL1C NO, OK 00011300 SH 3,=H'10' YES, SUBTRACT 10 00011400 LA 1,1 SET CARRY 00011500 AL1C NI 0(12),X'00' STORE RESULT DIGIT 00011600 STC 3,AL1D+1 * 00011700 TM AL1D+1,X'0F' Q/ IS RESULT ZERO 00011800 BC 5,AL1D NO 00011900 OI AL1D+1,X'0A' YES, SET 8-2 BITS 00012000 AL1D OI 0(12),0 * 00012100 MVI AL1C+1,X'40' SET TO ELIMINATE ZONES 00012200 CLI AEND,1 Q/ HAS A-FIELD ALREADY ENDED 00012300 BE AL1E YES 00012400 SR 11,0 DECREMENT A-FIELD ADDRESS 00012500 TM 1(11),X'40' Q/ END OF A-FIELD 00012600 BZ AL1E NO 00012700 MVI AEND,1 YES, SET A-FIELD ENDED INDICATOR 00012800 AL1E SR 12,0 DECREMENT B-FIELD ADDRESS 00012900 TM 1(12),X'40' Q/ END OF B-FIELD 00013000 BO AL1F YES 00013100 MVI POS1,0 NO, TURN OFF 1-POSITION INDICATOR 00013200 CLI AEND,1 Q/ A-FIELD ENDED 00013300 BNE AL1A NO 00013400 SR 5,5 YES, CLEAR A-FIELD CHARACTER 00013500 B AL1A ADD NEXT POSITION 00013600 AL1F CLI POS1,1 Q/ WAS THIS A 1-POSITION FIELD 00013700 BE AL1G1 YES, DONE 00013800 N 5,=F'48' NO, ADD HIGH ORDER ZONES 00013900 N 6,=F'48' * 00014000 AR 5,6 * 00014100 SLL 1,4 ADD CARRY 00014200 AR 5,1 * 00014300 STC 5,AL1G+1 STORE NEW ZONE 00014400 NI AL1G+1,X'30' * 00014500 AL1G OI 1(12),0 * 00014600 AL1G1 LTR 1,1 Q/ WAS THERE A CARRY 00014700 BC 8,NXTOP NO 00014800 MVI OVRFLO,1 YES, SET OVERFLOW INDICATOR 00014900 B NXTOP 00015000 * 00015100 * PERFORM COMPLEMENT ADDITION 00015200 * 00015300 AL1H LA 1,1 SET CARRY 00015400 ST 12,SAVB SAVE B-FIELD UNITS ADDRESS 00015500 MVI AL1L+1,X'70' SET TO KEEP B-FIELD SIGN 00015600 IC 3,0(12) GET B-FIELD SIGN 00015700 N 3,=F'48' * 00015800 CH 3,=H'32' Q/ IS IT MINUS 00015900 BE AL1I YES 00016000 OI 0(12),X'30' NO, PUT PLUS SIGN IN STANDARD FORM 00016100 AL1I IC 2,0(12) GET B-FIELD DIGIT 00016200 N 2,=F'15' * 00016300 C 2,=F'11' Q/ IS DIGIT NUMERIC 00016400 BL *+8 YES 00016500 S 2,=F'8' NO, ELIMINATE 8 BIT 00016600 CH 2,=H'10' Q/ ZERO 00016700 BNE *+6 NO 00016800 SR 2,2 YES, CLEAR IT 00016900 LA 3,9 SET COMPLEMENT 00017000 CLI AEND,1 Q/ HAS A-FIELD PREVIOUSLY ENDED 00017100 BE AL1J YES 00017200 IC 4,0(11) NO, GET A-FIELD DIGIT 00017300 N 4,=F'15' * 00017400 C 4,=F'11' Q/ IS DIGIT NUMERIC 00017500 BL *+8 YES 00017600 S 4,=F'8' NO, ELIMINATE 8 BIT 00017700 CH 4,=H'10' Q/ ZERO 00017800 BNE *+6 NO 00017900 SR 4,4 YES, CLEAR IT 00018000 SR 3,4 COMPLEMENT A-FIELD DIGIT 00018100 AL1J AR 2,3 ADD COMPLEMENT TO B-FIELD DIGIT 00018200 AR 2,1 ADD CARRY 00018300 LA 1,0 CLEAR CARRY 00018400 CH 2,=H'9' Q/ RESULT GREATER THAN 9 00018500 BNH AL1K NO, OK 00018600 SH 2,=H'10' YES, SUBTRACT 10 00018700 LA 1,1 SET CARRY 00018800 AL1K STC 2,AL1M+1 STORE RESULT DIGIT 00018900 AL1L NI 0(12),0 * 00019000 TM AL1M+1,X'0F' Q/ IS RESULT ZERO 00019100 BC 5,AL1M NO 00019200 OI AL1M+1,X'0A' YES, SET 8-2 BITS 00019300 AL1M OI 0(12),0 * 00019400 MVI AL1L+1,X'40' SET TO ELIMINATE B-FIELD ZONES 00019500 CLI AEND,1 Q/ HAS A-FIELD ALREADY ENDED 00019600 BE AL1N YES 00019700 SR 11,0 NO, DECREMENT A-FIELD ADDRESS 00019800 TM 1(11),X'40' Q/ IS THIS THE END OF THE A-FIELD 00019900 BZ AL1N NO 00020000 MVI AEND,1 YES, SET A-FIELD ENDED INDICATOR 00020100 AL1N SR 12,0 DECREMENT B-FIELD ADDRESS 00020200 TM 1(12),X'40' Q/ IS THIS THE END OF THE B-FIELD 00020300 BO AL1O YES 00020400 MVI POS1,0 NO, CLEAR 1-POSITION INDICATOR 00020500 B AL1I 00020600 AL1O LTR 1,1 Q/ CARRY 00020700 BC 6,NXTOP YES, DONE 00020800 * 00020900 * PERFORM RECOMPLEMENT CYCLE 00021000 * 00021100 LA 1,1 SET CARRY 00021200 L 12,SAVB RESTORE B-FIELD UNITS ADDRESS 00021300 IC 2,0(12) GET B-FIELD SIGN 00021400 N 2,=F'48' * 00021500 NI 0(12),X'CF' SET SIGN TO MINUS 00021600 OI 0(12),X'20' * 00021700 CH 2,=H'32' Q/ WAS THE B-FIELD SIGN MINUS 00021800 BNE AL1P NO, LEAVE IT MINUS 00021900 OI 0(12),X'30' YES, SET IT PLUS 00022000 AL1P IC 3,0(12) GET B-FIELD DIGIT 00022100 N 3,=F'15' * 00022200 CH 3,=H'10' Q/ ZERO 00022300 BNE *+6 NO 00022400 SR 3,3 YES, CLEAR IT 00022500 LA 4,9 SET COMPLEMENT 00022600 SR 4,3 COMPLEMENT THE DIGIT 00022700 AR 4,1 ADD CARRY 00022800 LA 1,0 CLEAR CARRY 00022900 CH 4,=H'9' Q/ IS THE RESULT GREATER THAN 9 00023000 BNH AL1Q NO, OK 00023100 SH 4,=H'10' YES, SUBTRACT 10 00023200 LA 1,1 SET CARRY 00023300 AL1Q STC 4,AL1R+1 STORE RESULT 00023400 NI 0(12),X'70' * 00023500 TM AL1R+1,X'0F' Q/ IS RESULT ZERO 00023600 BC 5,AL1R NO 00023700 OI AL1R+1,X'0A' YES, SET 8-2 BITS 00023800 AL1R OI 0(12),0 * 00023900 SR 12,0 DECREMENT B-FIELD ADDRESS 00024000 TM 1(12),X'40' Q/ IS THIS THE END OF THE B-FIELD 00024100 BZ AL1P NO 00024200 B NXTOP YES 00024300 TBTRCP DC X'01000100000101000100010000010100' 00024400 DC X'00010001010000010100010000010100' 00024500 TITLE 'ZERO AND ADD' 00024600 USING ZA,13 00024700 ZA CH 9,=H'1' 00024800 BE ZAL1 00024900 CH 9,=H'7' 00025000 BE ZAL7 00025100 CH 9,=H'4' 00025200 BNE ILEGLN 00025300 ZAL7 LA 6,1(10) 00025400 BAL 8,CVAD43 00025500 LR 11,5 00025600 LR 12,5 00025700 CH 9,=H'4' 00025800 BE ZAL1 00025900 LA 6,4(10) 00026000 BAL 8,CVAD43 00026100 LR 12,5 00026200 ZAL1 LR 6,12 00026300 LR 5,11 00026400 LA 0,1 00026500 IC 3,0(11) SAVE LOW CHARACTER OF A-FIELD 00026600 STC 3,TEMP1 * 00026700 ZAL1A MVN 0(1,6),0(5) MOVE NUMERIC 00026800 NI 0(6),X'4F' ELIMINATE ZONE 00026900 SR 5,0 00027000 SR 6,0 00027100 TM 1(5),X'40' Q/ END OF A-FIELD 00027200 BO ZAL1E YES 00027300 TM 1(6),X'40' NO, END OF B-FIELD 00027400 BZ ZAL1A NO, MOVE NEXT DIGIT 00027500 ZAL1C OI 0(12),X'20' SET B-FIELD SIGN MINUS 00027600 NI TEMP1,X'30' Q/ IS A-FIELD MINUS 00027700 CLI TEMP1,X'20' * 00027800 BE ZAL1D YES 00027900 OI 0(12),X'30' NO, SET B-FIELD SIGN PLUS 00028000 ZAL1D LR 11,5 SET A-ADDRESS 00028100 LR 12,6 SET B-ADDRESS 00028200 B NXTOP 00028300 ZAL1E TM 1(6),X'40' ZERO B-FIELD BEYOND RANGE OF A-FIELD 00028400 BO ZAL1C * 00028500 NI 0(6),X'40' * 00028600 OI 0(6),X'0A' 00028700 SR 6,0 00028800 B ZAL1E * 00028900 TITLE 'ZERO AND SUBTRACT' 00029000 USING ZS,13 00029100 ZS CH 9,=H'7' 00029200 BE ZS1 00029300 CH 9,=H'1' 00029400 BE ZSL4 00029500 CH 9,=H'4' 00029600 BNE ILEGLN 00029700 ZS1 LA 6,1(10) 00029800 BAL 8,CVAD43 00029900 LR 11,5 00030000 LR 12,11 00030100 CH 9,=H'4' 00030200 BE ZSL4 00030300 LA 6,4(10) 00030400 BAL 8,CVAD43 00030500 LR 12,5 00030600 ZSL4 LR 5,11 00030700 LR 6,12 00030800 LA 0,1 SET ONE IN REG 0 FOR SUBTRACTING 00030900 IC 3,0(11) SAVE LOW CHARACTER OF A-FIELD 00031000 STC 3,TEMP1 * 00031100 ZSL4A MVN 0(1,6),0(5) MOVE NUMERIC 00031200 NI 0(6),X'4F' ELIMINATE ZONE 00031300 SR 5,0 DECREMENT A-ADDRESS 00031400 TM 1(5),X'40' 00031500 BO ZSL4F 00031600 SR 6,0 DECREMENT B-ADDRESS 00031700 TM 1(6),X'40' 00031800 BZ ZSL4A 00031900 ZSL4C OI 0(12),X'20' SET B-FIELD SIGN MINUS 00032000 NI TEMP1,X'30' Q/ WAS A-FIELD MINUS 00032100 CLI TEMP1,X'20' * 00032200 BNE ZSL4D LEAVE IT MINUS IF IT WAS PLUS 00032300 OI 0(12),X'30' MAKE B-FIELD PLUS 00032400 ZSL4D LR 11,5 00032500 LR 12,6 00032600 B NXTOP 00032700 ZSL4E NI 0(6),X'40' 00032800 OI 0(6),X'0A' 00032900 ZSL4F SR 6,0 00033000 TM 1(6),X'40' 00033100 BO ZSL4C 00033200 B ZSL4E 00033300 TITLE 'BRANCH, CONDITIONAL BRANCH, AND BRANCH ON CHARACTER' 00033400 USING B,13 00033500 B CH 9,=H'1' CHAINED BCE? BE BCE1A YES, GO CHECK IT CH 9,=H'4' UNCOND 4-POS BRANCH? BE BL5BCH YES, DO IT BL ILEGLN ILLEGAL LENGTH OF 2 OR 3 CLI 4(10),0 IS POS 5 BLANK? BE BL5BCH YES, UNCOND BRANCH CH 9,=H'7' CHAINED 7-POS BRANCH? BE BCE7 YES, GO CHECK IT CH 9,=H'8' 8-POS BCE? BE BCE8 YES, DO IT BH ILEGLN >8, NO GOOD CH 9,=H'5' 5-POS COND BRANCH? BNE ILEGLN NO, ILLEGAL 6-POS INST IC 3,4(10) GET D CHARACTER 00034500 N 3,=F'63' * 00034600 SLL 3,2 MULTIPLY BY 4 00034700 L 4,DCHARTBL(3) GET ADDRESS OF CONDITIONAL BRANCH RTN 00034800 BR 4 GO TO ROUTINE OF NXTOP 00034900 BL5A TM SENSEA,1 Q/ IS SENSE SWITCH A ON 00035000 BZ NXTOP NO, CANNOT BRANCH 00035100 TM CRDEOF,1 YES, IS READER EMPTY 00035200 BO BL5BCH YES, BRANCH 00035300 B NXTOP NO 00035400 BL5B CLI SENSEB,1 00035500 B BL5CKB 00035600 BL5C CLI SENSEC,1 00035700 B BL5CKB 00035800 BL5D CLI SENSED,1 00035900 B BL5CKB 00036000 BL5E CLI SENSEE,1 00036100 B BL5CKB 00036200 BL5F CLI SENSEF,1 00036300 B BL5CKB 00036400 BL5G CLI SENSEG,1 00036500 B BL5CKB 00036600 BL5K CLI TPEOF,1 00036700 MVI TPEOF,0 00036800 B BL5CKB 00036900 BL5L CLI TPERR,1 00037000 B BL5CKB 00037100 BL5S CLI CPR,0 00037200 B BL5CKB 00037300 BL5T CLI CPR,1 00037400 B BL5CKB 00037500 BL5U CLI CPR,2 00037600 B BL5CKB 00037700 BL51 CLI CPR,0 00037800 BE NXTOP 00037900 B BL5BCH 00038000 BL5Z CLI OVRFLO,1 00038100 MVI OVRFLO,0 00038200 B BL5CKB 00038300 BL59 CLI PRTP9,1 00038400 B BL5CKB 00038500 BL52 CLI PRTP12,1 00038600 B BL5CKB 00038700 BL5RER CLI RDRERR,1 00038800 MVI RDRERR,0 00038900 B BL5CKB 00039000 BL5PER CLI PCHERR,1 00039100 MVI PCHERR,0 00039200 BL5P B NXTOP 00039300 BL53 CLI PRTERR,1 Q/ PRINT ERROR 00039400 MVI PRTERR,0 CLEAR ERROR INDICATOR 00039500 B BL5CKB CHECK CONDITION CODE 00039600 BL5CKB BNE NXTOP 00039700 BL5BCH LA 6,1(10) 00039800 B SETBCH SET CONDITIONS FOR BRANCH 00039900 BCE8 MVC DCHAR,7(10) 00040800 BCE7 LA 6,4(10) NO, TREAT AS BCE 00040200 BAL 8,CVAD43 00040300 LR 12,5 00040400 LA 6,1(10) 00040500 BAL 8,CVAD43 00040600 LR 11,5 00040700 BCE1A MVC TEMP1(1),0(12) 00040900 NI TEMP1,X'BF' 00041000 CLC TEMP1,DCHAR COMPARE D CHARACTER TO CORE LOCATION 00041100 BNE BCE1B 00041200 LR 12,10 00041300 AR 12,9 00041400 ST 10,LSTBCH STORE LOCATION COUNTER BEFORE BRANCH 00041500 LR 10,11 00041600 LA 9,0 00041700 B NXTOP 00041800 BCE1B SH 12,=H'1' 00041900 B NXTOP 00042000 DCHARTBL DC A(BL5BCH),8A(NXTOP),A(BL59),2A(NXTOP),A(BL52) 00042100 DC 4A(NXTOP),A(BL51,BL5S) 00042200 DC A(BL5T,BL5U),4A(NXTOP),A(BL5Z,BL53),7A(NXTOP) 00042300 DC A(BL5K,BL5L),3A(NXTOP),A(BL5P,NXTOP,BL5P,BL5PER) 00042400 DC 6A(NXTOP),A(BL5A,BL5B,BL5C,BL5D,BL5E,BL5F,BL5G) 00042500 DC 2A(NXTOP),A(BL5RER),5A(NXTOP) 00042600 TITLE 'BRANCH ON WORD MARK / ZONE' 00042700 USING BWZ,13 00042800 BWZ CH 9,=H'1' 00042900 BE BWZL1 00043000 CH 9,=H'8' 00043100 BNE ILEGLN 00043200 LA 6,1(10) 00043300 BAL 8,CVAD43 00043400 LR 11,5 00043500 LA 6,4(10) 00043600 BAL 8,CVAD43 00043700 LR 12,5 00043800 MVC DCHAR(1),7(10) 00043900 BWZL1 SH 12,=H'1' 00044000 CLI DCHAR,X'01' 00044100 BE BWZW 00044200 CLI DCHAR,X'02' 00044300 BE BWZ0 00044400 CLI DCHAR,X'32' 00044500 BE BWZBA 00044600 CLI DCHAR,X'22' 00044700 BE BWZB 00044800 CLI DCHAR,X'12' 00044900 BE BWZA 00045000 CLI DCHAR,X'03' 00045100 BE BWZW0 00045200 CLI DCHAR,X'33' 00045300 BE BWZWBA 00045400 CLI DCHAR,X'23' 00045500 BE BWZWB 00045600 CLI DCHAR,X'13' 00045700 BE BWZWA 00045800 B ILEGOP 00045900 BWZW TM 1(12),X'40' 00046000 BO BWZBCH 00046100 B NXTOP 00046200 BWZ0 TM 1(12),X'30' 00046300 BZ BWZBCH 00046400 B NXTOP 00046500 BWZBA TM 1(12),X'30' 00046600 BO BWZBCH 00046700 B NXTOP 00046800 BWZB TM 1(12),X'20' 00046900 BZ NXTOP 00047000 TM 1(12),X'10' 00047100 BO NXTOP 00047200 B BWZBCH 00047300 BWZA TM 1(12),X'20' 00047400 BO NXTOP 00047500 TM 1(12),X'10' 00047600 BO BWZBCH 00047700 B NXTOP 00047800 BWZW0 TM 1(12),X'40' 00047900 BO BWZBCH 00048000 B BWZ0 00048100 BWZWBA TM 1(12),X'40' 00048200 BO BWZBCH 00048300 B BWZBA 00048400 BWZWB TM 1(12),X'40' 00048500 BO BWZBCH 00048600 B BWZB 00048700 BWZWA TM 1(12),X'40' 00048800 BO BWZBCH 00048900 B BWZA 00049000 BWZBCH ST 10,LSTBCH STORE LOCATION COUNTER BEFORE BRANCH 00049100 LR 12,10 SET B-REG 00049200 AR 12,9 * 00049300 LR 10,11 SET LOCATION COUNTER FOR BRANCH 00049400 LA 9,0 * 00049500 B NXTOP 00049600 TITLE 'COMPARE' 00049700 USING C,13 00049800 C CH 9,=H'1' 00049900 BE CL1 00050000 CH 9,=H'4' 00050100 BE CL4 00050200 CH 9,=H'7' 00050300 BNE ILEGLN 00050400 LA 6,4(10) 00050500 BAL 8,CVAD43 00050600 LR 12,5 00050700 CL4 LA 6,1(10) CONVERT A-ADDR TO 360 FORMAT 00050800 BAL 8,CVAD43 * 00050900 LR 11,5 * 00051000 CH 9,=H'4' Q/ IS INSTRUCTION 4 CHARACTERS 00051100 BNE CL1 NO 00051200 LR 12,11 YES, FORS 00051300 LR 12,11 YES, FORCE B/ADDR = A/ADDR 00051400 CL1 MVI TCPR,0 INITIALIZE COMPARE RESULT TO EQUAL 00051500 LA 4,0 00051600 LA 0,1 00051700 C1 SR 11,0 00051800 SR 12,0 00051900 TM 1(12),X'40' 00052000 BO C2 00052100 TM 1(11),X'40' 00052200 BO C5 LONG B-FIELD 00052300 LA 4,1(4) 00052400 B C1 00052500 C2 LR 5,11 00052600 LR 6,12 00052700 LA 4,1(4) 00052800 C3 MVC TCR(1),1(6) 00052900 MVC TCR+1(1),1(5) 00053000 TR TCR(2),CPRTBL CONVERT DIGITS TO SORT SEQUENCE 00053100 CLC TCR(1),TCR+1 00053200 BH C5 00053300 BL C6 00053400 LA 5,1(5) 00053500 LA 6,1(6) 00053600 BCT 4,C3 00053700 C4 CH 9,=H'1' 00053800 BNE C4A 00053900 CLI TCPR,0 00054000 BE NXTOP 00054100 C4A MVC CPR,TCPR 00054200 B NXTOP 00054300 C5 MVI TCPR,2 SET HIGH 00054400 B C4 00054500 C6 MVI TCPR,1 SET LOW 00054600 B C4 00054700 TCPR DC X'00' 00054800 TCR DS CL2 00054900 CPRTBL DC HL1'0,55,56,57,58,59,60,61,62,63,54,20,21,22,23,24' 00055000 DC HL1'19,13,46,47,48,49,50,51,52,53,45,14,15,16,17,18' 00055100 DC HL1'12,36,37,38,39,40,41,42,43,44,35,7,8,9,10,11' 00055200 DC HL1'6,26,27,28,29,30,31,32,33,34,25,1,2,3,4,5' 00055300 DC HL1'0,55,56,57,58,59,60,61,62,63,54,20,21,22,23,24' 00055400 DC HL1'19,13,46,47,48,49,50,51,52,53,45,14,15,16,17,18' 00055500 DC HL1'12,36,37,38,39,40,41,42,43,44,35,7,8,9,10,11' 00055600 DC HL1'6,26,27,28,29,30,31,32,33,34,25,1,2,3,4,5' 00055700 TITLE 'HALT' 00055800 USING H,13 00055900 H CH 9,=H'1' 00056000 BE H1 00056100 CH 9,=H'2' IS IT A 2-POS HALT? TAB 00056110 BE H1 YES, GO PROCESS TAB 00056120 CH 9,=H'4' 00056200 BE H1 00056300 CH 9,=H'7' 00056400 BNE ILEGLN 00056500 H1 LR 5,10 CONVERT I ADDRESS 00056600 AR 5,9 ADD LENGTH TO I - LOC TAB 00056610 BAL 8,H5 * 00056700 MVC HLTIAR,HLTADARA IAR TO SAVE AREA TAB 00056710 MVC HLTWTO+15(6),HLTADARA MOVE I ADDRESS TO OUTPUT 00056800 MVI HLTWTO+5,17 MOVE LENGTH TO WTO 00056900 CH 9,=H'2' 2-POS HALT? TAB 00057005 BL H2 NO, 1-POS IAR ONLY TAB 00057010 BH H1A > 2 POS - PRINT AAR & BAR TAB 00057015 MVI HLTWTO+23,C'D' 2-POS HALT - PRINT D-MOD TAB 00057020 MVC HLTWTO+25(1),1(10) D-MOD TO WTO TAB 00057025 TR HLTWTO+25(1),TRIE TRANS D-MOD TO EBCDIC TAB 00057030 MVI HLTWTO+5,22 SET WTO LENGTH TAB 00057035 B H2 GO PRINT THE MESSAGE TAB 00057040 H1A MVI HLTWTO+23,C'A' REPLACE THE A FOR 7-POS HLT TAB 00057045 BL H2 NO 00057100 LA 6,1(10) CONVERT 1401 ADDRESS 00057200 BAL 8,CVAD43 * 00057300 BAL 8,H5 * 00057400 MVC HLTWTO+24(6),HLTADARA MOVE A ADDRESS TO OUTPUT 00057500 LA 6,4(10) CONVERT 1401 B ADDRESS 00057600 BAL 8,CVAD43 * 00057700 BAL 8,H5 * 00057800 MVC HLTWTO+33(6),HLTADARA MOVE B ADDRESS TO OUTPUT 00057900 MVI HLTWTO+5,35 MOVE LENGTH TO WTO 00058000 H2 BAL 8,HALTWTO PRINT HALT ON TYPEWRITER 00058100 CH 9,=H'4' 00058200 BNE H3 00058300 LA 6,1(10) 00058400 BAL 8,CVAD43 00058500 ST 5,ADR360 00058600 H3 CLC HLTIAR,EOJIAR IS THIS EOJ? TAB 00058700 BE TERMINAT YES, GO END SIM1401 TAB 00058710 MVC RETURN,=A(H4) 00058720 B WTORTN 00058800 H4 CH 9,=H'4' Q/ BRANCH 00058900 BNE NXTOP 00059000 LR 12,10 00059100 AR 12,9 00059200 L 10,ADR360 00059300 LA 9,0 00059400 B NXTOP 00059500 H5 SR 5,7 GET 1401 ADDRESS 00059600 CVD 5,PAKT CONVERT TO DECIMAL 00059700 UNPK HLTADARA(6),PAKT+5(3) UNPACK 1401 ADDRESS 00059800 OI HLTADARA+5,X'F0' MAKE SIGN NUMERIC 00059900 LA 1,HLTADARA BLANK LEADING ZEROS 00060000 H6 CLI 0(1),C'0' * 00060100 BCR 6,8 * 00060200 MVI 0(1),X'40' * 00060300 LA 1,1(1) * 00060400 B H6 * 00060500 HLTADARA DC CL6' ' 00060600 EOJIAR DC CL6' ' EOJ IAR FROM PARM FIELD TAB 00060610 HLTIAR DC CL6' ' HALT IAR TAB 00060620 TITLE 'CLEAR STORAGE' 00060700 USING CS,13 00060800 CS CH 9,=H'1' 00060900 BE CSL1 00061000 CH 9,=H'4' 00061100 BE CSL4 00061200 CH 9,=H'7' 00061300 BL ILEGLN 00061400 MVC HLDBCH(3),1(10) 00061500 LA 6,4(10) 00061600 B CSCOM 00061700 CSL4 LA 6,1(10) 00061800 CSCOM BAL 8,CVAD43 00061900 LR 12,5 00062000 CSL1 LR 3,12 00062100 SR 3,7 SUBTRACT SIMULATED CORE BASE LOCATION 00062200 LA 2,0 00062300 D 2,=F'100' 00062400 SR 12,2 00062500 STC 2,CSL1A+1 00062600 CSL1A XC 0(0,12),0(12) CLEAR CORE BLOCK 00062700 CR 12,7 Q/ DID B-REG GO TO 0 00062800 BNE CS2 NO 00062900 L 12,=F'15999' 00063000 AR 12,7 00063100 B CS3 * 00063200 CS2 SH 12,=H'1' SUBTRACT 1 FROM B-REG 00063300 CS3 CH 9,=H'7' Q/ IS THERE A BRANCH 00063400 BL NXTOP 00063500 LA 6,HLDBCH 00063600 B SETBCH 00063700 HLDBCH DS CL3 00063800 TITLE 'SET WORD MARK' 00063900 USING SW,13 00064000 SW CH 9,=H'6' 00064100 BNL SWL7 00064200 CH 9,=H'4' 00064300 BE SWL4 00064400 CH 9,=H'1' 00064500 BE SWL1 00064600 B ILEGLN 00064700 SWL4 LA 6,1(10) 00064800 BAL 8,CVAD43 00064900 LR 11,5 00065000 OI 0(11),X'40' 00065100 SH 11,=H'1' 00065200 LR 12,11 00065300 B NXTOP 00065400 SWL7 LA 6,1(10) 00065500 BAL 8,CVAD43 00065600 LR 11,5 00065700 LA 6,4(10) 00065800 BAL 8,CVAD43 00065900 LR 12,5 00066000 SWL1 OI 0(11),X'40' 00066100 OI 0(12),X'40' 00066200 SH 11,=H'1' 00066300 SH 12,=H'1' 00066400 CH 9,=H'7' 00066500 BNH NXTOP 00066600 LA 9,7 00066700 B NXTOP 00066800 TITLE 'CLEAR WORD MARK' 00066900 USING CW,13 00067000 CW CH 9,=H'6' 00067100 BNL CWL7 00067200 CH 9,=H'4' 00067300 BE CWL4 00067400 CH 9,=H'1' 00067500 BE CWL1 00067600 B ILEGLN 00067700 CWL4 LA 6,1(10) 00067800 BAL 8,CVAD43 00067900 LR 11,5 00068000 NI 0(11),X'BF' 00068100 SH 11,=H'1' 00068200 LR 12,11 00068300 B NXTOP 00068400 CWL7 LA 6,1(10) 00068500 BAL 8,CVAD43 00068600 LR 11,5 00068700 LA 6,4(10) 00068800 BAL 8,CVAD43 00068900 LR 12,5 00069000 CWL1 NI 0(11),X'BF' 00069100 NI 0(12),X'BF' 00069200 SH 11,=H'1' 00069300 SH 12,=H'1' 00069400 B NXTOP 00069500 TITLE 'MOVE CHARACTERS TO A WORD MARK' 00069600 USING MCW,13 00069700 MCW CH 9,=H'7' 00069800 BE MCWL7 00069900 CH 9,=H'4' 00070000 BE MCWL4 00070100 CH 9,=H'1' 00070200 BE MCWL1 00070300 CH 9,=H'8' 00070400 BE MCW8 00070500 B ILEGLN 00070600 MCWL7 LA 6,4(10) 00070700 BAL 8,CVAD43 00070800 LR 12,5 00070900 MCWL4 LA 6,1(10) 00071000 BAL 8,CVAD43 00071100 LR 11,5 00071200 MCWL1 LA 0,1 00071300 MCWL1B MVC MCWL1A+1(1),0(11) 00071400 NI MCWL1A+1,X'3F' 00071500 NI 0(12),X'40' 00071600 MCWL1A OI 0(12),0 00071700 SR 11,0 00071800 SR 12,0 00071900 TM 1(11),X'40' 00072000 BO NXTOP 00072100 TM 1(12),X'40' 00072200 BZ MCWL1B 00072300 B NXTOP 00072400 MCW8 MVC DCHAR(1),7(10) 00072500 CLI DCHAR,X'29' 00072600 BE RT 00072700 CLI DCHAR,X'16' 00072800 BE WT 00072900 CLI DCHAR,X'31' 00073000 BE MBD 00073100 CLI DCHAR,X'32' 00073200 BE MBD 00073300 B ILEGOP 00073400 * 00073500 * READ TAPE WITHOUT WORD MARKS 00073600 * 00073700 RT LA 6,4(10) CONVERT CORE LOCATION FOR TAPE READ 00073800 BAL 8,CVAD43 * 00073900 LR 12,5 * 00074000 BAL 8,FNDRIV GET DEVICE ADDRESS 00074100 BAL 8,TSTOPEN 00074200 BAL 8,LOADMD 00074300 MVI BCDTAP,1 * 00074400 TM 2(10),X'14' * 00074500 BO RT1 * 00074600 BAL 8,BINMOD 00074700 MVI BCDTAP,0 SET BINARY 00074800 RT1 ST 3,TMDCB 00074900 MVC TPCCW,=A(RTCCW) 00075000 STM 13,15,MACREGSV SAVE MACRO REGS 00075100 LA 6,MACREGSV SAVE ADDRESS TO XR 00075200 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00075300 EXCP TMIOB 00075400 LM 14,15,4(6) RESTORE REG 14 AND 15 00075500 WAIT 1,ECB=TMECB WAIT FOR I/O 00075600 LM 13,15,0(6) RESTORE MACRO REGISTERS 00075700 BAL 8,TPTEST 00075800 BAL 8,FNDLNG FIND LENGTH OF B-FIELD 00075900 LR 3,6 * 00076000 L 1,TAPEAREA SET SENDING ADDRESS 00076100 LH 5,SAVCSW+6 FIND NUMBER OF BYTES READ 00076200 LH 4,=H'18000' * 00076300 SR 4,5 * 00076400 CR 3,4 USE SMALLER FIELD 00076500 BNH RT3 * 00076600 LR 3,4 * 00076700 RT3 CH 3,=H'256' Q/ MORE THAN 256 BYTES 00076800 BNH RT4 NO 00076900 NC 0(256,12),WM256 YES, MOVE 256 BYTES 00077000 CLI BCDTAP,1 * 00077100 BNE RT3A * 00077200 TR 0(256,1),TREI 00077300 RT3A OC 0(256,12),0(1) * 00077400 LA 1,256(1) * 00077500 LA 12,256(12) * 00077600 SH 3,=H'256' * 00077700 B RT3 * 00077800 RT4 SH 3,=H'1' MOVE REMAINING BYTES 00077900 STC 3,RT5+1 * 00078000 STC 3,RT6+1 * 00078100 STC 3,RT7+1 * 00078200 RT5 NC 0(0,12),WM256 * 00078300 CLI BCDTAP,1 * 00078400 BNE RT7 * 00078500 RT6 TR 0(0,1),TREI 00078600 RT7 OC 0(0,12),0(1) * 00078700 AR 12,3 SET GROUP MARK AFTER DATA 00078800 NI 1(12),X'40' * 00078900 OI 1(12),X'3F' * 00079000 LA 12,2(12) SET B-ADDRESS 00079100 B NXTOP END OF TAPE READ INSTRUCTION 00079200 * 00079300 * WRITE TAPE WITHOUT WORD MARKS 00079400 * 00079500 WT LA 6,4(10) 00079600 BAL 8,CVAD43 00079700 LR 12,5 00079800 BAL 8,FNDLNG 00079900 STH 6,WTCCW2+6 STORE LENGTH IN CCW 00080000 LR 4,12 00080100 AR 12,6 SET B-ADDRESS 00080200 LA 12,1(12) * 00080300 L 3,TAPEAREA 00080400 MVI BCDTAP,1 * 00080500 CLI 2(10),X'14' Q/ IS INSTRUCTION BCD 00080600 BE WT1 YES 00080700 MVI BCDTAP,0 * 00080800 WT1 CH 6,=H'256' 00080900 BNH WT2 00081000 MVC 0(256,3),0(4) 00081100 CLI BCDTAP,1 Q/ BCD 00081200 BNE WT1A NO 00081300 TR 0(256,3),TRIE YES, CHANGE X'00' TO X'10' FOR TAPE 00081400 WT1A LA 3,256(3) UP REG 3 BY 256 00081500 LA 4,256(4) 00081600 SH 6,=H'256' 00081700 B WT1 00081800 WT2 STC 6,WT3+1 00081900 STC 6,WT4+1 00082000 WT3 MVC 0(0,3),0(4) 00082100 CLI BCDTAP,1 Q/ BCD 00082200 BNE WT4A NO 00082300 WT4 TR 0(0,3),TRIE YES, CHANGE X'00' TO X'10' FOR TAPE 00082400 WT4A BAL 8,FNDRIV GET DEVICE ADDRESS 00082500 BAL 8,TSTOPEN 00082600 BAL 8,LOADMD 00082700 CLI 2(10),X'14' 00082800 BE WT1B 00082900 BAL 8,BINMOD 00083000 WT1B EQU * 00083100 ST 3,TMDCB 00083200 MVC TPCCW,=A(WTCCW1) 00083300 STM 13,15,MACREGSV SAVE MACRO REGS 00083400 LA 6,MACREGSV SAVE ADDRESS TO XR 00083500 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00083600 EXCP TMIOB 00083700 LM 14,15,4(6) RESTORE REG 14 AND 15 00083800 WAIT 1,ECB=TMECB WAIT FOR I/O 00083900 LM 13,15,0(6) RESTORE MACRO REGISTERS 00084000 BAL 8,TPTEST 00084100 B NXTOP 00084200 MBD LA 6,1(10) 00084300 BAL 8,CVAD43 00084400 LR 11,5 00084500 LA 6,4(10) 00084600 BAL 8,CVAD43 00084700 LR 12,5 00084800 LA 0,1 00084900 LR 6,12 00085000 SH 6,=H'100' 00085100 CLI DCHAR,X'32' 00085200 BE MBC 00085300 LR 6,11 00085400 SH 6,=H'100' 00085500 MBD1 IC 3,0(11) 00085600 STC 3,MBD2+1 00085700 NI MBD2+1,X'BF' 00085800 NI 0(12),X'40' 00085900 MBD2 OI 0(12),0 00086000 SR 12,0 00086100 IC 3,0(6) 00086200 STC 3,MBD3+1 00086300 NI MBD3+1,X'BF' 00086400 NI 0(12),X'40' 00086500 MBD3 OI 0(12),0 00086600 SR 12,0 00086700 SR 11,0 00086800 SR 6,0 00086900 TM 1(6),X'40' 00087000 BC 8,MBD1 00087100 B NXTOP 00087200 MBC IC 3,0(11) 00087300 STC 3,MBC1+1 00087400 NI MBC1+1,X'BF' 00087500 NI 0(12),X'40' 00087600 MBC1 OI 0(12),0 00087700 SR 11,0 00087800 IC 3,0(11) 00087900 STC 3,MBC2+1 00088000 NI MBC2+1,X'BF' 00088100 NI 0(6),X'40' 00088200 MBC2 OI 0(6),0 00088300 SR 12,0 00088400 SR 11,0 00088500 SR 6,0 00088600 TM 1(6),X'40' 00088700 BO NXTOP 00088800 TM 1(12),X'40' 00088900 BZ MBC 00089000 B NXTOP 00089100 TITLE 'MOVE CHARACTERS AND SUPPRESS LEADING ZEROS' 00089200 USING MCS,13 00089300 MCS CH 9,=H'1' 00089400 BE MCSL1 00089500 CH 9,=H'7' 00089600 BE MCSL7 00089700 CH 9,=H'4' 00089800 BNE ILEGLN 00089900 LA 6,1(10) 00090000 BAL 8,CVAD43 00090100 LR 11,5 00090200 LR 12,5 00090300 B MCSL1 00090400 MCSL7 LA 6,1(10) 00090500 BAL 8,CVAD43 00090600 LR 11,5 00090700 LA 6,4(10) 00090800 BAL 8,CVAD43 00090900 LR 12,5 00091000 MCSL1 LA 0,1 00091100 MVI SUPRES,1 00091200 IC 3,0(11) MOVE ONLY DIGIT OF FIRST CHARACTER 00091300 STC 3,0(12) * 00091400 NI 0(12),X'0F' * 00091500 STC 3,TEMP1 SAVE A-CHARACTER 00091600 OI 0(12),X'40' SET WORD MARK TO STOP REVERSE SCAN 00091700 B MCSL1B 00091800 MCSL1A IC 3,0(11) MOVE CHARACTER 00091900 STC 3,0(12) * 00092000 STC 3,TEMP1 SAVE A-CHARACTER 00092100 NI 0(12),X'3F' * 00092200 MCSL1B SR 11,0 00092300 SR 12,0 00092400 TM TEMP1,X'40' Q/ END OF A-FIELD 00092500 BZ MCSL1A NO 00092600 LA 12,1(12) YES 00092700 MCSL1C MVC TEMP1(1),0(12) 00092800 NI TEMP1,X'3F' 00092900 CLI SUPRES,1 Q/ IS ZERO SUPPRESSION ON 00093000 BE MCSL1G YES 00093100 CLI TEMP1,X'0A' NO, IS IT SIGNIFICANT DIGIT,BLANK 0 00093200 BNH MCSL1E YES 00093300 CLI TEMP1,X'1B' Q/ COMMA 00093400 BE MCSL1E YES 00093500 CLI TEMP1,X'20' Q/ HYPHEN 00093600 BE MCSL1E YES 00093700 MVI SUPRES,1 TURN ON ZERO SUPRESSION 00093800 MCSL1E TM 0(12),X'40' Q/ LAST DIGIT 00093900 BO MCSL1F YES 00094000 LA 12,1(12) NO, PROCESS NEXT DIGIT 00094100 B MCSL1C * 00094200 MCSL1F NI 0(12),X'BF' CLEAR WORD MARK 00094300 LA 12,1(12) SET B-ADDRESS 00094400 B NXTOP GET NEXT INSTRUCTION 00094500 MCSL1G CLI 0(12),X'09' Q/ SIGNIFICANT DIGIT 00094600 BH MCSL1H * 00094700 CLI 0(12),X'00' * 00094800 BE MCSL1H * 00094900 MVI SUPRES,0 YES, TURN OFF ZERO SUPPRESSION 00095000 B MCSL1E * 00095100 MCSL1H CLI TEMP1,X'00' Q/ BLANK 00095200 BE MCSL1I BLANK 00095300 CLI TEMP1,X'0A' Q/ ZERO 00095400 BE MCSL1I ZERO 00095500 CLI TEMP1,X'1B' Q/ COMMA 00095600 BNE MCSL1E NO 00095700 MCSL1I NI 0(12),X'40' 00095800 B MCSL1E 00095900 TITLE 'MOVE NUMERIC' 00096000 USING MN,13 00096100 MN CH 9,=H'1' 00096200 BE MNL1 00096300 CH 9,=H'4' 00096400 BE MNL4 00096500 CH 9,=H'7' 00096600 BNE ILEGLN 00096700 LA 6,4(10) 00096800 BAL 8,CVAD43 00096900 LR 12,5 00097000 MNL4 LA 6,1(10) 00097100 BAL 8,CVAD43 00097200 LR 11,5 00097300 CH 9,=H'4' 00097400 BNE MNL1 00097500 LR 12,11 4 CHARACTERS, SET B ADR = A ADR 00097600 MNL1 MVN 0(1,12),0(11) MOVE NUMERIC 00097700 SH 11,=H'1' 00097800 SH 12,=H'1' 00097900 B NXTOP 00098000 TITLE 'MOVE ZONE' 00098100 USING MZ,13 00098200 MZ CH 9,=H'1' 00098300 BE MZL1 00098400 CH 9,=H'7' 00098500 BNE ILEGLN 00098600 LA 6,1(10) 00098700 BAL 8,CVAD43 00098800 LR 11,5 00098900 LA 6,4(10) 00099000 BAL 8,CVAD43 00099100 LR 12,5 00099200 MZL1 IC 3,0(11) 00099300 STC 3,MZL1A+1 00099400 NI 0(12),X'CF' 00099500 NI MZL1A+1,X'30' 00099600 MZL1A OI 0(12),0 00099700 SH 11,=H'1' 00099800 SH 12,=H'1' 00099900 B NXTOP 00100000 TITLE 'LOAD CHARACTERS TO AN A-FIELD WORD MARK' 00100100 USING LCA,13 00100200 LCA CH 9,=H'7' 00100300 BE LCAL7 00100400 CH 9,=H'4' 00100500 BE LCAL4 00100600 CH 9,=H'1' 00100700 BE LCAL1 00100800 CH 9,=H'8' 00100900 BE LCA8 00101000 B ILEGLN 00101100 LCAL7 LA 6,4(10) 00101200 BAL 8,CVAD43 00101300 LR 12,5 00101400 LCAL4 LA 6,1(10) 00101500 BAL 8,CVAD43 00101600 LR 11,5 00101700 LCAL1 LA 0,1 00101800 LCAL1A IC 3,0(11) 00101900 STC 3,0(12) 00102000 SR 11,0 00102100 SR 12,0 00102200 TM 1(11),X'40' 00102300 BZ LCAL1A 00102400 B NXTOP 00102500 LCA8 CLI 7(10),X'29' 00102600 BE RTW 00102700 CLI 7(10),X'16' 00102800 BE WTW 00102900 B ILEGOP 00103000 * 00103100 * READ TAPE WITH WORD MARKS 00103200 * 00103300 RTW LA 6,4(10) 00103400 BAL 8,CVAD43 00103500 LR 12,5 00103600 BAL 8,FNDRIV 00103700 BAL 8,TSTOPEN 00103800 LA 8,LOADMD 00103900 BALR 8,8 00104000 ST 3,TMDCB 00104100 MVC TPCCW,=A(RTCCW) 00104200 STM 13,15,MACREGSV SAVE MACRO REGS 00104300 LA 6,MACREGSV SAVE ADDRESS TO XR 00104400 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00104500 EXCP TMIOB 00104600 LM 14,15,4(6) RESTORE REG 14 AND 15 00104700 WAIT 1,ECB=TMECB WAIT FOR I/O 00104800 LM 13,15,0(6) RESTORE MACRO REGISTERS 00104900 BAL 8,TPTEST 00105000 LH 3,SAVCSW+6 FIND NUMBER OF BYTES READ 00105100 LH 4,=H'18000' * 00105200 SR 4,3 00105300 L 1,TAPEAREA SET SENDING ADDRESS 00105400 RTW1 CLI 0(12),X'7F' Q/ GP MK - WD MK IN CORE 00105500 BE RTW3 YES 00105600 CLI 0(1),X'6D' Q/ WORD SEPARATOR 00105700 BNE RTW2 NO 00105800 LA 1,1(1) YES 00105900 IC 3,0(1) 00106000 STC 3,0(12) 00106100 TR 0(1,12),TREI 00106200 OI 0(12),X'40' 00106300 SH 4,=H'1' 00106400 B RTW2A 00106500 RTW2 IC 3,0(1) 00106600 STC 3,0(12) 00106700 TR 0(1,12),TREI 00106800 RTW2A LA 1,1(1) 00106900 LA 12,1(12) 00107000 BCT 4,RTW1 00107100 CLI 0(12),X'7F' RECORD MOVED, IS GROUP MARK NEXT CHAR 00107200 BE RTW3 YES, LEAVE IT ALONE 00107300 MVI 0(12),X'3F' NO, MOVE IN A GROUP MARK 00107400 RTW3 LA 12,1(12) SET B-ADDRESS 00107500 B NXTOP 00107600 * 00107700 * WRITE TAPE WITH WORD MARKS 00107800 * 00107900 WTW LA 6,4(10) 00108000 BAL 8,CVAD43 00108100 LR 12,5 00108200 L 1,TAPEAREA 00108300 LR 2,12 00108400 WTW1 TM 0(2),X'7F' Q/ GROUP MARK WORD MARK 00108500 BO WTW3 YES, FIELD DONE 00108600 TM 0(2),X'40' Q/ WORD MARK 00108700 BZ WTW2 NO 00108800 MVI 0(1),X'6D' YES, INSERT WORD SEPARATOR 00108900 LA 1,1(1) * 00109000 WTW2 MVC 0(1,1),0(2) 00109100 TR 0(1,1),TRIE 00109200 LA 1,1(1) 00109300 LA 2,1(2) 00109400 B WTW1 00109500 WTW3 S 1,TAPEAREA 00109600 STH 1,WTCCW2+6 00109700 BAL 8,FNDRIV 00109800 BAL 8,TSTOPEN 00109900 BAL 8,LOADMD 00110000 ST 3,TMDCB 00110100 MVC TPCCW,=A(WTCCW1) 00110200 STM 13,15,MACREGSV SAVE MACRO REGS 00110300 LA 6,MACREGSV SAVE ADDRESS TO XR 00110400 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00110500 EXCP TMIOB 00110600 LM 14,15,4(6) RESTORE REG 14 AND 15 00110700 WAIT 1,ECB=TMECB WAIT FOR I/O 00110800 LM 13,15,0(6) RESTORE MACRO REGISTERS 00110900 BAL 8,TPTEST 00111000 LA 12,1(2) 00111100 B NXTOP 00111200 TITLE 'MOVE CHARACTERS AND EDIT' 00111300 USING MCE,13 00111400 MCE CH 9,=H'7' Q/ IS LENGTH CORRECT 00111500 BNE ILEGLN NO 00111600 LA 6,1(10) YES, CONVERT ADDRESSES 00111700 BAL 8,CVAD43 * 00111800 LR 11,5 * 00111900 LA 6,4(10) * 00112000 BAL 8,CVAD43 * 00112100 LR 12,5 * 00112200 LA 0,1 00112300 MVI AEND,0 CLEAR A-FIELD END INDICATOR 00112400 MVI BODY,0 CLEAR BODY TRIGGER 00112500 MVI SUPRES,0 CLEAR ZERO SUPPRESSION INDICATOR 00112600 MVI FLOAT,0 CLEAR FLOATING DOLLAR SIGN INDICATOR 00112700 MVI SIGDIG,0 CLEAR SIGNIFICANT DIGIT IND 00112800 MVI ASTER,0 CLEAR ASTERISK PROTECTION IND 00112900 MVI AMINUS,0 CLEAR A-FIELD MINUS INDICATOR 00113000 MVI DECIMAL,0 DECIMAL POINT INDICATOR 00113100 MVI FIRSTDOL,0 CLEAR $ INFIRST CHAR INDICATOR 00113200 MVI SIGNDOL,0 CLEAR DOLLAR SIGN INDICATOR 00113300 IC 2,0(11) Q/ A-FIELD MINUS 00113400 N 2,=F'48' 00113500 CH 2,=H'32' 00113600 BNE MCE1 NO 00113700 MVI AMINUS,1 YES,SET A-FIELD MINUS INDICATOR 00113800 MCE1 IC 1,0(12) SAVE B-FIELD CHARACTER 00113900 STC 1,TEMP1 * 00114000 NI 0(12),X'3F' CLEAR WORD MARK 00114100 CLI 0(12),X'3B' Q/ DECIMAL POINT 00114200 BNE MCE1A NO 00114300 MVI DECIMAL,1 YES,SET DECIMAL INDICATOR 00114400 ST 12,DECADD STORE ADDRESS OF DECIMAL POINT 00114500 MCE1A CLI 0(12),X'00' Q/ BLANK 00114600 BE MCE6 YES 00114700 CLI 0(12),X'0A' Q/ ZERO 00114800 BE MCE6 YES 00114900 CLI 0(12),X'30' Q/ AMPERSAND 00115000 BE MCE3 YES 00115100 CLI BODY,1 Q/ BODY TRIGGER ON 00115200 BE MCE3A YES 00115300 CLI 0(12),X'1B' Q/ COMMA 00115400 BE MCE3 YES 00115500 CLI 0(12),X'33' Q/ C 00115600 BE MCE2 YES 00115700 CLI 0(12),X'29' Q/ R 00115800 BE MCE2 YES 00115900 CLI 0(12),X'20' Q/ - 00116000 BNE MCE3A NO 00116100 MCE2 CLI AMINUS,1 Q/ A-FIELD MINUS 00116200 BE MCE3A YES 00116300 MCE3 MVI 0(12),X'00' MOVE BLANK TO B-FIELD 00116400 SR 12,0 DECREMENT B-FIELD 00116500 B MCE5 00116600 MCE3A CLI 0(12),X'2C' Q/ * 00116700 BNE MCE3B NO 00116800 CLI BODY,1 Q/ BODY TRIGGER ON 00116900 BNE MCE3B NO 00117000 MVI ASTER,1 SET ASTERISK PRORECTION INDICATOR 00117100 B MCE6 00117200 MCE3B CLI 0(12),X'2B' Q/ DOLLAR SIGN 00117300 BE MCE5C YES 00117400 SR 12,0 DECREMENT B-FIELD 00117500 B MCE5 00117600 MCE4A SR 11,0 00117700 MCE5A SR 12,0 00117800 TM 1(11),X'40' Q/ END OF A-FIELD 00117900 BZ MCE5 NO 00118000 MVI AEND,1 YES, SET A-FIELD ENDED INDICATOR 00118100 MCE5 TM TEMP1,X'40' Q/ END OF B-FIELD 00118200 BZ MCE1 NO 00118300 B MCE8 YES 00118400 MCE5C MVI SIGNDOL,1 SET DOLLAR SIGN INDICATOR 00118500 ST 12,DOLSIGN STORE ADDRESS OF DOLLAR SIGN 00118600 TM 1(12),X'40' Q/ FLOATING DOLLAR SIGN 00118700 BZ MCE5A 00118800 MVI FLOAT,1 00118900 MVC 0(1,12),0(11) 00119000 B MCE4A 00119100 MCE6 CLI AEND,1 Q/ HAS A-FIELD ALREADY ENDED 00119200 BE MCE3 YES 00119300 MVC 0(1,12),0(11) MOVE CHARACTER 00119400 NI 0(12),X'3F' * 00119500 CLI 0(12),X'00' BLANK 00119600 BE MCE6A YES 00119700 CLI 0(12),X'09' DIGIT 00119800 BH MCE6A NO 00119900 MVI SIGDIG,1 YES SET SIG DIGIT INDICATOR 00120000 MCE6A CLI BODY,1 Q/ BODY TRIGGER ON 00120100 CLI BODY,1 Q/ IS BODY TRIGGER ON 00120200 BE MCE7 YES 00120300 MVI BODY,1 NO 00120400 ST 12,LASTDIG STORE ADDRESS OF LOW ORDER DIGIT 00120500 NI 0(12),X'0F' REMOVE ZONE 00120600 MCE7 TM TEMP1,X'0A' Q/ IS DIGIT ZERO 00120700 BC 12,MCE4A NO 00120800 TM TEMP1,X'35' 00120900 BC 5,MCE4A NO 00121000 OI 0(12),X'40' YES, SET ZERO SUPPRESSION WORD MARK 00121100 ST 12,ZEROSUP STORE ZERO SUPPRESSION ADDRESS 00121200 MVI SUPRES,1 SET ZERO SUPPRESSION INDICATOR 00121300 B MCE4A INDICATOR 00121400 MCE8 CLI SUPRES,1 Q/ WAS THERE ZERO SUPPRESSION 00121500 BNE NXTOP NO, GET NEXT INSTRUCTION 00121600 MVI FIRST,1 SET FIRST CHARACTER OF SCAN INDICATOR 00121700 LA 12,1(12) 00121800 CLI 0(12),X'2B' DOLLAR SIGN 00121900 BNE MCE8A 00122000 MVI FIRSTDOL,1 YES 00122100 MCE8A MVC TEMP1(1),0(12) SAVE CHARACTER 00122200 NI 0(12),X'3F' CLEAR WORD MARK 00122300 CLI 0(12),X'00' Q/ BLANK 00122400 BE MCE9 YES 00122500 CLI 0(12),X'0A' Q/ ZERO 00122600 BE MCE11 YES 00122700 CLI 0(12),X'09' Q/ SIGNIFICANT DIGIT 00122800 BH MCE9 NO 00122900 MVI SUPRES,0 TURN OFF ZERO SUPPRESSION 00123000 MVI SIGDIG,1 SET SIGNIFICANT DIGIT INDICATOR 00123100 B MCE10 00123200 MCE9 CLI 0(12),X'1B' Q/ COMMA 00123300 BE MCE11 YES 00123400 CLI 0(12),X'20' Q/ - 00123500 BE MCE10C YES 00123600 CLC 0(12),=X'3329' Q/ CR SYMBOL 00123700 BE MCE13 YES 00123800 CLI 0(12),X'3B' 00123900 BE MCE11 00124000 MVI SUPRES,1 TURN ON ZERO SUPPRESSION 00124100 MCE10 LA 12,1(12) 00124200 MVI FIRST,0 TURN OFF FIRST TIME INDICATOR 00124300 MCE10B TM TEMP1,X'40' Q/ W/RD MARK 00124400 BO FLDOL YES,TEST FOR FLOATING DOLLAR SIGN 00124500 B MCE8A NO, PROCESS NEXT DIGIT 00124600 MCE10C CLI FIRST,1 Q/ FIRST CHARACTER IN STRING 00124700 BE MCE10D YES 00124800 B MCE10 00124900 MCE10D CLI AMINUS,1 Q/ A-FIELD MINUS 00125000 BE MCE10 00125100 MVI 0(12),X'00' NO,BLANK MINUS SIGN 00125200 B MCE10 00125300 MCE11 CLI SUPRES,1 Q/ ZERO SUPPRESSION ON 00125400 BNE MCE10 NO 00125500 MVI 0(12),X'00' YES, BLANK CHARACTER 00125600 CLI FIRST,1 Q/ FIRST CHARACTER IN STRING 00125700 BE MCE12 YES 00125800 CLI ASTER,1 Q/ ASTERISK PROTECTION ON 00125900 BNE MCE10 NO 00126000 MVI 0(12),X'2C' YES, INSERT ASTERISK 00126100 B MCE10 00126200 MCE12 CLI AMINUS,1 Q/ A-FIELD MINUS 00126300 BE MCE10 YES 00126400 MVI 0(12),X'00' NO,BLANK CHARACTER 00126500 B MCE10 00126600 MCE13 CLI SUPRES,1 Q/ ZERO SUPPRESSION ON 00126700 BNE MCE10 NO 00126800 CLI FIRST,1 Q/ 1ST CHARACTER IN STRING 00126900 BE MCE14 YES 00127000 MVC 0(2,12),=C' ' NO,BLANK CR 00127100 B MCE10 00127200 MCE14 CLI AMINUS,1 Q/ A-FIELD MINUS 00127300 BE MCE10A YES 00127400 MVC 0(2,12),=C' ' NO,BLANK CR 00127500 B MCE10 00127600 MCE10A LA 12,1(12) 00127700 B MCE10 00127800 FLDOL CLI FLOAT,1 Q/ FLOATING DOLLAR SIGN 00127900 BNE DECON NO, GO TO DECIMAL CONTR 00128000 DOLLAR CLI 0(12),X'00' Q/ BLANK 00128100 BNE MOVDOL NO,GO TO NEXT POSITION IN B-FIELD 00128200 MVI 0(12),X'2B' MOVE DOLLAR SIGN INTO B-FIELD 00128300 B DECON 00128400 MOVDOL SR 12,0 DECREMENT B-FIELD 00128500 B DOLLAR 00128600 DECON CLI DECIMAL,1 IS DECIMAL CONTROL NEEDED 00128700 BNE NXTOP NO 00128800 CLI SIGDIG,1 Q/ SIGNIFICANT DIGIT 00128900 BNE MCE16 NO 00128900 L 3,DECADD TEST TENS POSITION 00129100 MCE16C CLI 1(3),X'00' FOR BLANK 00129200 BNE NXTOP NOT BLANK 00129300 MVI 1(3),X'0A' YES INSERT ZERO 00129400 LA 3,1(3) LOOP 00129500 B MCE16C 00129600 MCE16 L 5,LASTDIG 00129700 CLC DECADD,ZEROSUP 00129800 BH MCE16A 00129900 L 4,DECADD 00130000 B MCE16B 00130100 MCE16A L 4,ZEROSUP 00130200 MCE16B SR 5,4 00130300 AH 5,=H'1' 00130400 MCE16D MVC 0(1,4),=X'00' 00130500 AR 4,0 00130600 BCT 5,MCE16D 00130700 TM 1(12),X'40' Q/ FLOATING DOLLAR SIGN 00130800 CLI SIGNDOL,1 Q/ DOLLAR SIGN 00130900 BNE NXTOP NO 00131000 CLI FIRSTDOL,1 Q/ DOLLAR SIGN OK 00131100 BE NXTOP 00131200 L 3,DOLSIGN NO 00131300 MVI 0(3),X'00' BLANK DOLLAR SIGN 00131400 B NXTOP 00131500 ZEROSUP DS F ZERO SUPPRESSION ADDRESS 00131600 DECADD DS F DECIMAL POINT ADDRESS 00131700 DECIMAL DC X'00' DECIMAL INDICATOR 00131800 FLOAT DC X'00' FLOATING DOLLAR SIGN INDICATOR 00131900 FIRST DC X'00' FIRST CHARACTER OF SCAN INDICATOR 00132000 AMINUS DC X'00' A-FIELD MINUS INDICATOR 00132100 BODY DC X'00' BODY TRIGGER 00132200 ASTER DC X'00' ASTERISK PROTECTION INDICATOR 00132300 SIGDIG DC X'00' SIGNIFICANT DIGIT INDICATOR 00132400 FIRSTDOL DC X'00' 00132500 DOLSIGN DS F 00132600 LASTDIG DS F ADDRESS OF LOW ORDER DIGIT 00132700 SIGNDOL DC X'00' 00132800 TITLE 'READ A CARD' 00132900 USING R,13 00133000 R CH 9,=H'1' 00133100 BE RL1 00133200 CH 9,=H'4' 00133300 BE RL4 00133400 B ILEGLN 00133500 RL1 BAL 8,READ 00133600 B NXTOP 00133700 RL4 MVC ADR140(3),1(10) 00133800 BAL 8,READ 00133900 LA 6,ADR140 GET BRANCH ADDRESS 00134000 B SETBCH SET CONDITIONS FOR BRANCH 00134100 TITLE 'PUNCH A CARD' 00134200 USING P,13 00134300 P CH 9,=H'1' 00134400 BE PL1 00134500 CH 9,=H'4' 00134600 BNE ILEGLN 00134700 BAL 8,PUNCH 00134800 LA 6,1(10) REFERENCE BRANCH ADDRESS 00134900 B SETBCH SET CONDITIONS FOR BRANCH 00135000 PL1 BAL 8,PUNCH 00135100 B NXTOP 00135200 TITLE 'READ AND PUNCH' 00135300 USING RP,13 00135400 RP CH 9,=H'1' 00135500 BE RPL1 00135600 CH 9,=H'4' 00135700 BNE ILEGLN 00135800 MVC ADR140(3),1(10) SAVE BRANCH ADDRESS 00135900 BAL 8,READ 00136000 BAL 8,PUNCH 00136100 LA 6,ADR140 REFERENCE BRANCH ADDRESS 00136200 B SETBCH SET CONDITIONS FOR BRANCH 00136300 RPL1 BAL 8,READ 00136400 BAL 8,PUNCH 00136500 B NXTOP 00136600 TITLE 'PRINT A LINE' 00136700 USING W,13 00136800 W CH 9,=H'1' 00136900 BE WL1 00137000 CH 9,=H'2' 00137100 BE WM 00137200 CH 9,=H'5' 00137300 BE WM 00137400 CH 9,=H'4' 00137500 BNE ILEGLN 00137600 WL4 BAL 8,WRITE 00137700 LA 6,1(10) REFERENCE BRANCH ADDRESS 00137800 B SETBCH SET CONDITIONS FOR BRANCH 00137900 WL1 BAL 8,WRITE 00138000 B NXTOP 00138100 WM MVC DCHAR(1),1(10) 00138200 CH 9,=H'2' 00138300 BE WML2 00138400 MVC DCHAR(1),4(10) 00138500 WML2 STM 13,15,MACREGSV SAVE MACRO REGS 00138600 MVI PRTP12,0 CLEAR CHANNEL 12 INDICATOR 00138700 CLI DCHAR,X'3C' 00138800 BE WML20A 00138900 CLI DCHAR,X'12' 00139000 BNE ILEGOP 00139100 CH 9,=H'5' 00139200 BE WL4 00139300 B WL1 00139400 WML20A MVC PRNTBUFF+1(132),SIMCOR+201 MOVE WORD MARKS TO PRINT 00139500 TR PRNTBUFF+1(132),TRWDMK * 00139600 LA 3,PRNTDCB GET ADDR OF PRINT DCB TAB 00139610 BAL 5,UROPEN GO OPEN PRINTER TAB 00139620 STM 13,15,MACREGSV SAVE MACRO REGS 00139700 LA 6,MACREGSV SAVE ADDRESS TO XR 00139800 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00139900 MVI PRNTBUFF,X'09' SET CARRIAGE CONTROL 00140000 PUT PRNTDCB,PRNTBUFF WRITE WORD MARKS 00140100 LM 13,15,0(6) RESTORE MACRO REGISTERS 00140200 DUMPSW NOPR 4 RETURN TO DUMP ROUTINE 00140210 BAL 8,COUNTER 00140300 LA 12,SIMCOR+333 00140400 CH 9,=H'2' 00140500 BE NXTOP 00140600 LA 6,1(10) 00140700 B SETBCH SET CONDITIONS FOR BRANCH 00140800 TITLE 'READ AND PRINT' 00140900 USING WR,13 00141000 WR CH 9,=H'1' 00141100 BE WRL1 00141200 CH 9,=H'4' 00141300 BNE ILEGLN 00141400 MVC ADR140(3),1(10) SAVE BRANCH ADDRESS 00141500 BAL 8,WRITE 00141600 BAL 8,READ 00141700 LA 6,ADR140 REFERENCE BRANCH ADDRESS 00141800 B SETBCH SET CONDITIONS FOR BRANCH 00141900 WRL1 BAL 8,WRITE 00142000 BAL 8,READ 00142100 B NXTOP 00142200 TITLE 'PRINT AND PUNCH' 00142300 USING WP,13 00142400 WP CH 9,=H'1' 00142500 BE WPL1 00142600 CH 9,=H'4' 00142700 BNE ILEGLN 00142800 BAL 8,WRITE 00142900 BAL 8,PUNCH 00143000 LA 6,1(10) REFERENCE BRANCH ADDRESS 00143100 B SETBCH SET CONDITIONS FOR BRANCH 00143200 WPL1 BAL 8,WRITE 00143300 BAL 8,PUNCH 00143400 B NXTOP 00143500 TITLE 'WRITE,READ, AND PUNCH' 00143600 USING WRP,13 00143700 WRP CH 9,=H'1' 00143800 BE WRPL1 00143900 CH 9,=H'4' 00144000 BNE ILEGLN 00144100 MVC ADR140(3),1(10) SAVE BRANCH ADDRESS 00144200 BAL 8,WRITE 00144300 BAL 8,READ 00144400 BAL 8,PUNCH 00144500 LA 6,ADR140 REFERENCE BRANCH ADDRESS 00144600 B SETBCH SET CONDITIONS FOR BRANCH 00144700 WRPL1 BAL 8,WRITE 00144800 BAL 8,READ 00144900 BAL 8,PUNCH 00145000 B NXTOP 00145100 TITLE 'SELECT STACKER' 00145200 USING SS,13 00145300 SS CH 9,=H'2' 00145400 BE SSDG2 00145500 CH 9,=H'5' 00145600 BNE ILEGLN 00145700 SSDG4 CLI 4(10),X'04' 00145800 BE SSDG5 00145900 CLI 4(10),X'08' 00146000 BE SSDG6 00146100 SSDG7 EQU * 00146200 LA 6,1(10) 00146300 B SETBCH 00146400 SSDG2 CLI 1(10),X'04' 4 POCKET 00146500 BE SSDG1 YES 00146600 CLI 1(10),X'08' 8 POCKET 00146700 BE SSDG3 YES 00146800 B NXTOP 00146900 SSDG1 MVI PCHARAA,X'41' SELECT POCKET 4 00147000 B NXTOP 00147100 SSDG3 MVI PCHARAA,X'81' SELECT POCKET 8 00147200 B NXTOP 00147300 SSDG5 MVI PCHARAA,X'41' SELECT POCKET 4 00147400 B SSDG7 00147500 SSDG6 MVI PCHARAA,X'81' SELECT POCKET 8 00147600 B SSDG7 00147700 TITLE 'CONTROL CARRIAGE' 00147800 USING CC,13 00147900 CC MVC DCHAR(1),1(10) 00148000 CH 9,=H'2' 00148100 BE CCL2 00148200 CH 9,=H'5' 00148300 BNE ILEGLN 00148400 MVC DCHAR(1),4(10) 00148500 CCL2 TM DCHAR,X'30' 00148600 BZ CCIMSK 00148700 BO CCAFSK 00148800 TM DCHAR,X'20' 00148900 BO CCIMSP 00149000 IC 3,DCHAR 00149100 N 3,=F'3' 00149200 SLL 3,3 00149300 O 3,=F'1' 00149400 STC 3,PRNTBUFF 00149500 B CCDONE 00149600 CCIMSP IC 3,DCHAR 00149700 N 3,=F'3' 00149800 SLL 3,3 00149900 STC 3,PRNTBUFF 00150000 OI PRNTBUFF,X'03' 00150100 B CCNOW 00150200 CCAFSK IC 3,DCHAR 00150300 N 3,=F'15' 00150400 TM DCHAR,X'0F' 00150500 BM CC1 00150600 LA 3,10 00150700 CC1 SLL 3,3 00150800 STC 3,PRNTBUFF 00150900 OI PRNTBUFF,X'81' 00151000 B CCDONE 00151100 CCIMSK IC 3,DCHAR 00151200 CLI DCHAR,X'00' 00151300 BE NXTOP 00151400 TM DCHAR,X'0F' 00151500 BM CC2 00151600 LA 3,10 00151700 CC2 N 3,=F'15' 00151800 SLL 3,3 00151900 O 3,=F'131' 00152000 STC 3,PRNTBUFF 00152100 CCNOW EQU * NEXT 2 LINES ADDED TAB 00152200 LA 3,PRNTDCB GET ADDR OF PRINT DCB TAB 00152210 BAL 5,UROPEN GO OPEN THE PRINTER TAB 00152220 STM 13,15,MACREGSV SAVE MACRO REGS TAB 00152230 LA 6,MACREGSV SAVE ADDRESS TO XR 00152300 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00152400 PUT PRNTDCB,PRNTBUFF 00152500 LM 13,15,0(6) RESTORE MACRO REGISTERS 00152600 BAL 8,COUNTER 00152700 MVI PRNTBUFF,X'09' 00152800 * MVI PRTP12,0 CLEAR CHANNEL 12 INDICATOR 00152900 CCDONE CH 9,=H'2' 00153000 BE NXTOP 00153100 LA 6,1(10) 00153200 B SETBCH 00153300 TITLE 'TAPE CONTROL OPERATIONS' 00153400 USING CU,13 00153500 CU CH 9,=H'5' 00153600 BNE ILEGLN 00153700 CLI 4(10),X'29' 00153800 BE RWD 00153900 CLI 4(10),X'24' 00154000 BE WTM 00154100 CLI 4(10),X'14' 00154200 BE RWU 00154300 CLI 4(10),X'32' 00154400 BE BSP 00154500 CLI 4(10),X'35' 00154600 BE SKP 00154700 B ILEGOP 00154800 RWD MVI CUCCW,X'07' 00154900 B CU1 00155000 WTM MVI CUCCW,X'1F' 00155100 B CU1 00155200 BSP MVI CUCCW,X'27' 00155300 B CU1 00155400 SKP MVI CUCCW,X'17' 00155500 CU1 BAL 8,FNDRIV 00155600 ST 3,CUDCB 00155700 MVI CUECB,0 00155800 MVI CUIOB,X'42' SET COMMAND CHAIN + UNRELATED BITS 00155900 BAL 8,TSTOPEN 00156000 STM 13,15,MACREGSV SAVE MACRO REGS 00156100 LA 6,MACREGSV SAVE ADDRESS TO XR 00156200 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00156300 EXCP CUIOB 00156400 LM 14,15,4(6) RESTORE REG 14 AND 15 00156500 WAIT 1,ECB=CUECB 00156600 LM 13,15,0(6) RESTORE MACRO REGISTERS 00156700 B NXTOP 00156800 RWU IC 2,3(10) GET 1401 DRIVE NUMBER 00156900 N 2,=F'7' * 00157000 CLI 3(10),X'0A' 00157100 BNE RWUA 00157200 SR 2,2 00157300 RWUA EQU * 00157400 SLL 2,3 00157500 L 4,TAPADR+4(2) 00157600 B RWUCLOSE GO CLOSE 00157700 CUCCW CCW 0,0,X'60',1 CONTROL UNIT OP TAB 00157800 CCW X'03',0,X'20',1 CHAINED TO A NOP TAB 00157900 TITLE 'MULTIPLY' 00158000 USING M,13 00158100 M CH 9,=H'7' 00158200 BNE ILEGLN 00158300 LA 6,1(10) 00158400 BAL 8,CVAD43 00158500 LR 11,5 00158600 LA 6,4(10) 00158700 BAL 8,CVAD43 00158800 LR 12,5 00158900 ST 12,MPYSAV SAVE UNITS ADDRESS OF PRODUCT 00159000 LR 5,11 INTIALIZE PRODUCT AREA 00159100 LR 6,12 * 00159200 M1 MVI 0(6),X'0A' * 00159300 TM 0(5),X'40' * 00159400 BO M2 * 00159500 SH 5,=H'1' * 00159600 SH 6,=H'1' * 00159700 B M1 * 00159800 M2 SH 6,=H'2' * 00159900 MVI 1(6),X'0A' * 00160000 LA 1,0 COMPARE SIGNS 00160100 LA 2,0 * 00160200 TM 0(6),X'20' * 00160300 BZ M3 * 00160400 TM 0(6),X'10' * 00160500 BO M3 * 00160600 LA 1,1 * 00160700 M3 TM 0(11),X'20' * 00160800 BZ M4 * 00160900 TM 0(11),X'10' * 00161000 BO M4 * 00161100 LA 2,1 * 00161200 M4 MVI MINPRD,0 00161300 CR 1,2 00161400 BE M5 SIGNS EQUAL 00161500 MVI MINPRD,1 SIGNS UNEQUAL 00161600 M5 IC 1,0(6) 00161700 N 1,=F'15' 00161800 CH 1,=H'10' Q/ ZERO 00161900 BNE *+6 NO 00162000 SR 1,1 YES, CLEAR 00162100 M6 LA 0,0 00162200 LTR 1,1 Q/ IS MULTIPLICAND DIGIT ZERO 00162300 BZ M9 00162400 LR 5,12 SET REGISTERS FOR ADD 00162500 LR 4,11 00162600 LR 8,12 LOAD PRODUCT POINTER 00162700 M7 IC 2,0(4) 00162800 N 2,=F'15' 00162900 CH 2,=H'10' Q/ ZERO 00163000 BNE *+6 NO 00163100 SR 2,2 YES, CLEAR 00163200 IC 3,0(5) 00163300 N 3,=F'15' 00163400 CH 3,=H'10' Q/ ZERO 00163500 BNE *+6 NO 00163600 SR 3,3 YES, CLEAR IT 00163700 AR 3,2 00163800 AR 3,0 00163900 LA 0,0 00164000 CH 3,=H'9' 00164100 BNH M8 00164200 SH 3,=H'10' 00164300 LA 0,1 00164400 M8 STC 3,0(8) STORE RESULT 00164500 CLI 0(8),X'00' Q/ RESULT ZERO 00164600 BNE *+8 NO 00164700 MVI 0(8),X'0A' YES, SET 8-2 BITS 00164800 SH 4,=H'1' 00164900 SH 5,=H'1' 00165000 SH 8,=H'1' 00165100 TM 1(4),X'40' 00165200 BZ M7 00165300 IC 3,0(5) ADD CARRY TO NEXT PRODUCT DIGIT 00165400 CH 3,=H'10' Q/ ZERO 00165500 BNE *+6 NO 00165600 SR 3,3 YES, CLEAR 00165700 AR 3,0 00165800 STC 3,0(8) * 00165900 CLI 0(8),X'00' Q/ RESULT ZERO 00166000 BNE *+8 NO 00166100 MVI 0(8),X'0A' YES, SET 8-2 BITS 00166200 SH 1,=H'1' 00166300 BC 6,M6 COUNT NOT ZERO, ADD NEXT DIGIT 00166400 M9 SH 6,=H'1' 00166500 NI 1(6),X'40' CLEAR LAST USED MULTIPLICAND DIGIT 00166600 OI 1(6),X'0A' * 00166700 TM 1(6),X'40' 00166800 BO M10 00166900 SH 12,=H'1' 00167000 B M5 00167100 M10 LR 11,4 00167200 L 12,MPYSAV RELOAD UNITS ADDRESS OF PRODUCT 00167300 OI 0(12),X'20' 00167400 CLI MINPRD,1 00167500 BE M11 00167600 OI 0(12),X'30' 00167700 M11 LR 12,6 00167800 B NXTOP 00167900 MINPRD DS C 00168000 MPYSAV DS F 00168100 TITLE 'DIVIDE' 00168200 USING D,13 00168300 D CH 9,=H'7' Q/ IS LENGTH ( BYTES 00168400 BNE ILEGLN NO 00168500 LA 6,1(10) YES, CONVERT ADDRESSES 00168600 BAL 8,CVAD43 * 00168700 LR 11,5 * 00168800 LA 6,4(10) * 00168900 BAL 8,CVAD43 * 00169000 LR 12,5 * 00169100 LA 0,1 SET REG TO 1 FOR + OR - 1 00169200 LR 1,11 SCAN DIVISOR FOR LENGTH AND IS IT ZERO 00169300 MVI TEMP1,0 * 00169400 MVI TEMP2,0 * 00169500 D1 MVN TEMP2,0(1) * 00169600 CLI TEMP2,X'0A' * 00169700 BE D1A * 00169800 CLI TEMP2,X'00' * 00169900 BE D1A * 00170000 MVI TEMP1,1 * 00170100 D1A SR 1,0 * 00170200 TM 1(1),X'40' * 00170300 BZ D1 * 00170400 CLI TEMP1,0 Q/ IS DIVISOR ZERO 00170500 BNE D2 NO, OK 00170600 MVI OVRFLO,1 YES, SET OVERFLOW INDICATOR 00170700 B NXTOP 00170800 D2 LR 6,12 FIND HIGH ORDER QUOTIENT LOCATION 00170900 AR 6,1 * 00171000 SR 6,11 * 00171100 SR 6,0 * 00171200 D3 MVI TEMP1,0 PREPARE TO COMPARE DIVISOR + DVDND 00171300 LR 1,11 00171400 LR 2,12 00171500 D4 IC 3,0(1) GET DIGITS 00171600 IC 4,0(2) * 00171700 N 3,=F'15' * 00171800 N 4,=F'15' * 00171900 CH 3,=H'10' Q/ ZERO 00172000 BNE *+6 NO 00172100 SR 3,3 YES, CLEAR IT 00172200 CH 4,=H'10' Q/ ZERO 00172300 BNE *+6 NO 00172400 SR 4,4 YES, CLEAR 00172500 CR 3,4 COMPARE 00172600 BE D5 EQUAL, DO NOT CHANGE INDICATOR 00172700 BH D4A A-DIGIT GREATER 00172800 MVI TEMP1,0 A-DIGIT LESS 00172900 B D5 * 00173000 D4A MVI TEMP1,1 SET A GREATER THAN B 00173100 D5 SR 1,0 DECREMENT FIELD POINTERS 00173200 SR 2,0 * 00173300 TM 1(1),X'40' Q/ END OF A-FIELD 00173400 BZ D4 NO 00173500 TM 0(2),X'0A' TEST 1 MORE DIVIDEND DIGIT 00173600 BO D6 ZERO 00173700 TM 0(2),X'0F' Q/ BLANK 00173800 BZ D6 YES, TREAT SAME AS ZERO 00173900 MVI TEMP1,0 1, DIVIDEND GREATER THAN DIVISOR 00174000 D6 CLI TEMP1,1 Q/ IS DIVISOR TOO LARGE 00174100 BE D10 YES 00174200 LR 1,11 SET REGISTERS FOR COMPLEMENT ADD 00174300 LR 2,12 * 00174400 LA 8,1 SET CARRY 00174500 D7 IC 5,0(2) GET B-FIELD DIGIT 00174600 N 5,=F'15' * 00174700 CH 5,=H'10' Q/ ZERO 00174800 BNE *+6 NO 00174900 SR 5,5 YES, CLEAR 00175000 LA 4,9 GET COMPLEMENT OF A-FIELD DIGIT 00175100 IC 3,0(1) * 00175200 N 3,=F'15' * 00175300 CH 3,=H'10' Q/ ZERO 00175400 BNE *+6 NO 00175500 SR 3,3 YES, CLEAR IT 00175600 SR 4,3 * 00175700 AR 5,4 ADD TO B-FIELD DIGIT 00175800 AR 5,8 ADD CARRY 00175900 LA 8,0 CLEAR CARRY 00176000 CH 5,=H'9' Q/ RESULT GREATER THAN 9 00176100 BNH D8 NO 00176200 SH 5,=H'10' YES, SUBTRACT 10 FROM RESULT 00176300 LA 8,1 SET CARRY 00176400 D8 STC 5,D9+1 STORE RESULT 00176500 NI 0(2),X'F0' * 00176600 CLI D9+1,X'00' Q/ RESULT ZERO 00176700 BNE D9 NO 00176800 OI D9+1,X'0A' YES, SET 8-2 BITS 00176900 D9 OI 0(2),0 * 00177000 SR 2,0 DECREMENT A- AND B-ADDRESSES 00177100 SR 1,0 * 00177200 TM 1(1),X'40' Q/ END OF A-FIELD 00177300 BZ D7 NO, PROCESS NEXT DIGIT 00177400 IC 3,0(2) YES, ADD 1 MORE DIVIDEND DIGIT 00177500 N 3,=F'15' * 00177600 CH 3,=H'10' Q/ ZERO 00177700 BNE *+6 NO 00177800 SR 3,3 YES, CLEAR IT 00177900 LA 3,9(3) * 00178000 AR 3,8 * 00178100 CH 3,=H'9' Q/ RESULT GREATER THAN 9 00178200 BNH D9A NO 00178300 SH 3,=H'10' YES, SUBTRACT 10 00178400 D9A STC 3,0(2) STORE RESULT 00178500 CLI 0(2),X'00' Q/ RESULT ZERO 00178600 BNE *+8 NO 00178700 MVI 0(2),X'0A' YES, SET 8-2 BITS 00178800 IC 3,0(6) ADD 1 TO QUOTIENT DIGIT 00178900 N 3,=F'15' * 00179000 CH 3,=H'10' Q/ ZERO 00179100 BNE *+6 NO 00179200 SR 3,3 YES, CLEAR IT 00179300 AR 3,0 * 00179400 STC 3,TEMP1 STORE RESULT 00179500 MVN 0(1,6),TEMP1 * 00179600 B D3 00179700 D10 TM 0(12),X'30' Q/ ZONE BITS 00179800 BC 5,D11 YES, DIVIDE DONE 00179900 AR 6,0 NO, UP REFERENCE TO NEXT DIGIT 00180000 AR 12,0 * 00180100 B D3 00180200 D11 IC 2,0(11) COMPARE DIVISOR AND DIVIDEND SIGNS 00180300 IC 3,0(12) * 00180400 N 2,=F'48' * 00180500 N 3,=F'48' * 00180600 SRDL 2,4 * 00180700 LA 4,SINTBL * 00180800 IC 2,0(4,2) * 00180900 IC 3,0(4,3) * 00181000 OI 0(6),X'30' SET QUOTIENT PLUS 00181100 CR 2,3 Q/ ARE SIGNS EQUAL 00181200 BE D12 YES, LEAVE QUOTIENT PLUS 00181300 NI 0(6),X'EF' UNEQUAL, SET QUOTIENT MINUS 00181400 D12 LR 11,1 SET A- AND B-ADDRESSES 00181500 SR 11,0 * 00181600 LR 12,6 * 00181700 B NXTOP 00181800 SINTBL DC X'00000100' 00181900 TITLE 'MODIFY ADDRESS' 00182000 USING MA,13 00182100 MA CH 9,=H'7' 00182200 BE MA1 00182300 CH 9,=H'1' 00182400 BE MAL4 00182500 CH 9,=H'4' 00182600 BNE ILEGLN 00182700 MA1 LA 6,1(10) 00182800 BAL 8,CVAD43 00182900 LR 11,5 00183000 LR 12,11 00183100 CH 9,=H'4' 00183200 BE MAL4 00183300 LA 6,4(10) 00183400 BAL 8,CVAD43 00183500 LR 12,5 00183600 MAL4 SH 11,=H'3' 00183700 SH 12,=H'3' 00183800 LA 0,15 UNITS 00183900 LA 1,0 * 00184000 IC 2,3(11) * 00184100 IC 3,3(12) * 00184200 NR 2,0 * 00184300 NR 3,0 * 00184400 CH 2,=H'10' 00184500 BNE *+6 00184600 SR 2,2 00184700 CH 3,=H'10' 00184800 BNE *+6 00184900 SR 3,3 00185000 AR 3,2 * 00185100 CH 3,=H'9' * 00185200 BNH MAL4A * 00185300 SH 3,=H'10' * 00185400 LA 1,1 * 00185500 MAL4A STC 3,MAL4B+1 * 00185600 NI 3(12),X'70' * 00185700 TM MAL4B+1,X'0F' 00185800 BC 5,MAL4B 00185900 OI MAL4B+1,X'0A' 00186000 MAL4B OI 3(12),0 * 00186100 IC 2,2(11) TENS 00186200 IC 3,2(12) * 00186300 NR 2,0 * 00186400 NR 3,0 $ 00186500 CH 2,=H'10' 00186600 BNE *+6 00186700 SR 2,2 00186800 CH 3,=H'10' 00186900 BNE *+6 00187000 SR 3,3 00187100 AR 3,2 * 00187200 AR 3,1 * 00187300 LA 1,0 * 00187400 CH 3,=H'9' * 00187500 BNH MAL4C * 00187600 SH 3,=H'10' * 00187700 LA 1,1 * 00187800 MAL4C STC 3,MAL4D+1 * 00187900 NI 2(12),X'70' SAVE B FLD INDEX AND WORD MARK BITS 00188000 TM MAL4D+1,X'0F' 00188100 BC 5,MAL4D 00188200 OI MAL4D+1,X'0A' 00188300 MAL4D OI 2(12),0 * 00188400 IC 2,1(11) HUNDREDS 00188500 IC 3,1(12) * 00188600 NR 2,0 * 00188700 NR 3,0 * 00188800 CH 2,=H'10' 00188900 BNE *+6 00189000 SR 2,2 00189100 CH 3,=H'10' 00189200 BNE *+6 00189300 SR 3,3 00189400 AR 3,2 * 00189500 AR 3,1 * 00189600 LA 1,0 * 00189700 CH 3,=H'9' * 00189800 BNH MAL4E * 00189900 SH 3,=H'10' * 00190000 LA 1,16 * 00190100 MAL4E STC 3,MAL4F+1 * 00190200 NI 1(12),X'70' * 00190300 TM MAL4F+1,X'0F' 00190400 BC 5,MAL4F 00190500 OI MAL4F+1,X'0A' 00190600 MAL4F OI 1(12),0 * 00190700 LA 0,48 THOUSANDS 00190800 IC 2,1(11) * 00190900 IC 3,1(12) * 00191000 NR 2,0 * 00191100 NR 3,0 * 00191200 AR 3,2 * 00191300 AR 3,1 * 00191400 LA 1,0 * 00191500 CH 3,=H'48' * 00191600 BNH MAL4G * 00191700 SH 3,=H'64' * 00191800 LA 1,16 * 00191900 MAL4G STC 3,MAL4H+1 * 00192000 NI 1(12),X'4F' * 00192100 MAL4H OI 1(12),0 * 00192200 IC 2,3(11) FOUR THOUSANDS 00192300 IC 3,3(12) * 00192400 NR 2,0 * 00192500 NR 3,0 * 00192600 AR 3,2 * 00192700 AR 3,1 * 00192800 CH 3,=H'48' * 00192900 BNH MAL4I * 00193000 SH 3,=H'64' * 00193100 MAL4I STC 3,MAL4J+1 * 00193200 NI 3(12),X'4F' * 00193300 MAL4J OI 3(12),0 * 00193400 B NXTOP 00193500 TITLE 'STORE A-ADDRESS REGISTER' 00193600 USING SAR,13 00193700 SAR CH 9,=H'4' 00193800 BNE ILEGLN 00193900 LR 12,11 00194000 LA 6,1(10) 00194100 BAL 8,CVAD43 00194200 LR 11,5 00194300 ST 12,ADR360 00194400 BAL 8,CVAD34 00194500 SH 11,=H'3' 00194600 NC 1(3,11),=X'404040' 00194700 OC 1(3,11),ADR140 00194800 B NXTOP 00194900 TITLE 'STORE B-ADDRESS REGISTER' 00195000 USING SBR,13 00195100 SBR CH 9,=H'4' 00195200 BE SBRL4 00195300 CH 9,=H'1' 00195400 BE SBRL1 00195500 CH 9,=H'7' 00195600 BNE ILEGLN 00195700 LA 6,4(10) 00195800 BAL 8,CVAD43 00195900 LR 12,5 00196000 SBRL4 LA 6,1(10) 00196100 BAL 8,CVAD43 00196200 LR 11,5 00196300 ST 12,ADR360 00196400 BAL 8,CVAD34 00196500 SBRL1 SH 11,=H'3' 00196600 NC 1(3,11),=X'404040' 00196700 OC 1(3,11),ADR140 00196800 B NXTOP 00196900 TITLE 'MOVE CHARACTERS TO RCD MARK OR GROUP MARK - WORD MARK' 00197000 USING MCM,13 00197100 MCM CH 9,=H'1' 00197200 BE MCML1 00197300 CH 9,=H'7' 00197400 BNE ILEGLN 00197500 LA 6,1(10) 00197600 BAL 8,CVAD43 00197700 LR 11,5 00197800 LA 6,4(10) 00197900 BAL 8,CVAD43 00198000 LR 12,5 00198100 MCML1 NI MCMSW+1,X'0F' 00198200 LR 6,11 A-FIELD PTR 00198300 MCMSCAN TRT 0(256,6),TRTGMWRM SCAN FOR GMWM - RM - RMWM 00198400 BNZ MCMHIT 00198500 LA 6,256(6) 00198600 B MCMSCAN 00198700 MCMHIT SR 1,11 COMPUTE RECORD LENGTH 00198800 LA 1,1(1) BUMP FOR TERM CHAR 00198900 CH 1,=H'256' TOTAL LENGTH GT 256 00199000 BNH MCMDECR NO 00199100 OI MCMSW+1,X'F0' YES - SET SW FOR MULTIPLE MOVES 00199200 LR 3,1 00199300 MCM256 LA 1,256 00199400 MCMDECR BCTR 1,0 DECREMENT FOR EX INSTRUCTIONS 00199500 EX 1,MCMCHMOV MOVE RECORD TO WORK AREA 00199600 EX 1,MCMCHCLR CLEAR RECEIVING AREA EXCEPT WM 00199700 EX 1,MCMWMCLR ELIMINATE WORD MARKS IN WORK AREA 00199800 EX 1,MCMCHORC OR DATA BITS (BA8421) INTO REC AREA 00199900 LA 1,1(1) 00200000 AR 11,1 00200100 AR 12,1 00200200 MCMSW NOP MCMBUMP SW SET IF RECORD GT 256 BYTES 00200300 B NXTOP TO NEXT 1401 INSTRUCTION 00200400 MCMBUMP SR 3,1 COMPUTE BYTES REMAINING 00200500 CH 3,=H'256' Q / BYTES REMAINING GT 256 00200600 BH MCM256 YES 00200700 LR 1,3 00200800 NI MCMSW+1,X'0F' TURN OFF SWITCH 00200900 B MCMDECR MOVE REMAINING BYTES 00201000 * 00201100 MCMCHCLR NC 0(0,12),WM256 00201200 MCMCHMOV MVC WORK256(0),0(11) 00201300 MCMWMCLR NC WORK256(0),STRIPWM 00201400 MCMCHORC OC 0(0,12),WORK256 00201500 * 00201600 WORK256 DC CL256' ' 00201700 TRTGMWRM DC 26X'00' MCM SCAN TABLE 00201800 DC X'1A' RECORD MARK - A8 2 00201900 DC 63X'00' 00202000 DC X'5A' RECORD MARK WORD MARK - M A8 2 00202100 DC 36X'00' W 00202200 DC X'7F' GROUP MARK WORD MARK - MBA8421 00202300 DC 128X'00' 00202400 STRIPWM DC 256X'3F' 00202500 TITLE 'BRANCH IF BIT EQUAL' 00202600 USING BBE,13 00202700 BBE CH 9,=H'1' 00202800 BE BBEL1 00202900 CH 9,=H'8' 00203000 BNE ILEGLN 00203100 LA 6,1(10) 00203200 BAL 8,CVAD43 00203300 LR 11,5 00203400 LA 6,4(10) 00203500 BAL 8,CVAD43 00203600 LR 12,5 00203700 MVC DCHAR(1),7(10) 00203800 NI DCHAR,X'BF' 00203900 BBEL1 SH 12,=H'1' 00204000 MVC TEMP1,DCHAR 00204100 NC TEMP1(1),1(12) 00204200 BZ NXTOP 00204300 LR 10,11 00204400 LA 9,0 00204500 B NXTOP 00204600 TITLE ' ' 00204700 BEGIN SAVE (14,12) SAVE CONTROL PROGRAMS REGISTERS 00204800 ENTRY BEGIN ENTRY POINT TAB 00204810 BALR 15,0 LOAD BASE REGISTERS 00204900 SETBS1 L 14,BASE2 * 00205000 ST 13,SAVEAREA+4 SAVE CONTROL PROGRAMS REGISTER 13 00205100 STM 14,15,MACREGSV 00205200 LA 13,SAVEAREA 00205300 LA 6,MACREGSV 00205400 L 1,0(1) GET PARM FIELD POINTER TAB 00205410 LH 2,0(1) GET PARM FIELD LENGTH TAB 00205420 LTR 2,2 IS PARM FIELD LENGTH ZERO? TAB 00205430 BZ GETCORE YES, NO PARM FIELD PRESENT TAB 00205440 BCTR 2,0 PARM LENGTH LESS ONE TAB 00205450 L 3,=A(EOJIAR+5) LOW ORDER OF EOJIAR TAB 00205455 SR 3,2 NO, EOJIAR - PARM LENGTH - 1 TAB 00205460 EX 2,MOVEPARM MOVE PARM TO EOJIAR TAB 00205470 B GETCORE TO CONTINUE INIT TAB 00205475 MOVEPARM MVC 0(0,3),2(1) MOVE PARM TO EOJIAR TAB 00205480 GETCORE EQU * CONTINUE WITH INIT TAB 00205485 GETMAIN R,LV=16020 GET CORE FOR 1401 SIMULATED CORE 00205500 LM 14,15,0(6) 00205600 LR 7,1 * 00205700 A 1,=F'15999' STORE UPPER LIMIT OF 1401 CORE 00205800 ST 1,SIMLIMIT * 00205900 GETMAIN R,LV=18000 GET CORE FOR TAPE I/O BUFFER 00206000 LM 14,15,0(6) 00206100 ST 1,TAPEAREA * 00206200 MVC WTCCW2+1(3),TAPEAREA+1 00206300 MVC RTCCW1+1(3),TAPEAREA+1 00206400 MVC LDTCCW1+1(3),TAPEAREA+1 00206500 XC SIMCOR+201,SIMCOR 00206600 B BGN1 00206700 BASE2 DC A(SETBS1+4096) 00206800 * 00206900 WTORTN XC RQSTIN,RQSTIN 00207000 MVC OKWTOR+27(8),JOBNAME MOVE JOBNAME TO WTOR 00207100 STM 13,15,MACREGSV SAVE MACRO REGS 00207200 LA 6,MACREGSV SAVE ADDRESS TO XR 00207300 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00207400 OKWTOR TM MOD,X'FF' 00207500 BO CHGRDCD 00207600 WTOR 'OK ',RQSTIN,50,WTECB 00207700 CHGA LM 13,15,0(6) RESTORE MACRO REGISTERS 00207800 TESTA STM 13,15,MACREGSV SAVE MACRO REG 00207900 TM MOD,X'FF' 00208000 BO TRANS 00208100 LA 6,MACREGSV SAVE ADDRESS TO XR 00208200 LA 13,SAVEAREA 00208300 TESTAA WAIT 1,ECB=WTECB WAIT FOR RESPONSE 00208400 LM 13,15,0(6) RESTORE MACRO REG 00208500 XC WTECB,WTECB CLEAR ECB 00208600 B TRANS 00208700 CHGRDCD CLC TMPARA(4),=C'CCTL' 00208800 BNE DGCC7 00208900 CLI TMPARA+9,X'7D' 00209000 BNE DGCC2 00209100 XC CARTAB(66),CARTAB 00209200 L 3,=A(CARTAB) 00209300 DGCC10 L 1,=A(TMPARA+10) 00209400 LA 2,70 00209500 DGCC5 CLI 0(1),X'7D' 00209600 BE DGCC3 00209700 CLI 0(1),C' ' 00209800 BE DGCC4 00209900 MVC 0(1,3),0(1) 00210000 DGCC4 LA 1,1(1) 00210100 LA 3,1(3) 00210200 BCT 2,DGCC5 00210300 B DGCC2 00210400 DGCC3 STM 13,15,MACREGSV 00210500 ST 3,DGEND 00210600 MVC DGCUR,=A(CARTAB) 00210700 LA 6,MACREGSV 00210800 LA 13,SAVEAREA 00210900 GET CARD,TMPARA 00211000 LM 13,15,0(6) 00211100 CLC TMPARA(5),=C'CCTL2' 00211200 BNE DGCC7 00211300 L 3,DGEND 00211400 B DGCC10 00211500 DGCC2 STM 13,15,MACREGSV 00211600 LA 6,MACREGSV 00211700 LA 13,SAVEAREA 00211800 WTO 'INVALID CCTL CARD,RESUBMIT' 00211900 LM 13,15,0(6) 00212000 DGCC7 EQU * 00212100 MVC RQSTIN,TMPARA 00212200 GET CARD,TMPARA 00212300 LM 13,15,0(6) 00212400 B CHGA 00212500 MOD DC X'FF' 00212600 WTECB DC F'0' 00212700 BGN1 STM 13,15,MACREGSV SAVE MACRO REGS 00212800 LA 6,MACREGSV SAVE ADDRESS TO XR 00212900 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00213000 OPEN (CARD) OPEN CARD INPUT DCB ONLY TAB 00213100 LM 13,15,0(6) RESTORE MACRO REGISTERS 00213200 MVI PRNTBUFF,X'8B' RESTORE PRINT FORM IMMEDIATELY 00213300 BAL 8,WRITE * 00213400 LA 8,BGN2 00213500 STM 13,15,MACREGSV SAVE MACRO REGS 00213600 LA 6,MACREGSV SAVE ADDRESS TO XR 00213700 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00213800 GET CARD,TMPARA READ CARD 00213900 LM 13,15,0(6) RESTORE MACRO REGISTERS 00214000 LA 1,76 CLEAR 00214100 L 2,TAPEAREA TAPE 00214200 CLEAR XC 0(100,2),0(2) AREA 00214300 LA 2,100(2) 00214400 BCT 1,CLEAR 00214500 BGN2 L 1,=F'16010' 00214600 AR 1,7 00214700 MVI 0(1),X'7F' 00214800 LA 8,16 ADDR OF CVT PTR IN 8 TAB 00214900 L 8,0(8) ADDR OF CVT IN 8 TAB 00214910 L 8,0(8) ADDR OF TCB WORDS IN 8 TAB 00215000 L 8,4(8) ADDR OF TCB IN 8 TAB 00215100 L 8,12(8) ADDR OF TIOT IN 8 00215200 MVC JOBNAME,0(8) 00215300 B WTORTN 00215400 TRANS TR RQSTIN,TYPTBL 00215500 CLC RQSTIN(3),=C'SSS' 00215600 BE SSIN 00215700 CLC RQSTIN(3),=C'LDC' 00215800 BE CDLOAD 00215900 CLC RQSTIN(3),=C'LDT' 00216000 BE TPLOAD 00216100 CLC RQSTIN(3),=C'SRS' 00216200 BE STRST 00216300 CLC RQSTIN(3),=C'STT' 00216400 BE START 00216500 CLC RQSTIN(3),=C'CLR' 00216600 BE CLR 00216700 CLC RQSTIN(3),=C'DIS' 00216800 BE DIS 00216900 CLC RQSTIN(3),=C'ALT' 00217000 BE ALT 00217100 CLC RQSTIN(3),=C'WTM' 00217200 BE WTMCMD 00217300 CLC RQSTIN(3),=C'RWD' 00217400 BE RWDCMD 00217500 CLC RQSTIN(3),=C'TRM' 00217600 BE TERMINAT 00217700 CLC RQSTIN(3),=C'DMP' 00217710 BE DUMPCORE 00217720 SNDILG XC RQSTIN,RQSTIN ZERO OUT REPLY AREA 00217800 STM 13,15,MACREGSV SAVE MACRO REG 00217900 LA 6,MACREGSV SAVE ADDRESS TO XR 00218000 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00218100 WTOR 'ILLEGAL ENTRY',RQSTIN,50,WTECB 00218200 LM 13,15,0(6) RESTORE MACRO REGISTERS 00218300 B TESTAA 00218400 RQSTIN DS CL50 00218500 * 00218600 * THIS SECTION WILL SIMULATE THE 1402 CARD LOAD PUSHBUTTON. 00218700 * 00218800 CDLOAD XC SIMCOR+1(80),SIMCOR+1 00218900 MVI MOD,X'00' 00219000 BAL 8,READ 00219100 OI SIMCOR+1,X'40' 00219200 LA 10,SIMCOR+1 00219300 LA 9,0 00219400 MVI OKSTT,1 00219500 B NXTOP 00219600 * 00219700 * THIS SECTION WILL SIMULATE THE START PUSHBUTTON. IF THE 00219800 * OPERATOR COMMAND STT IS FOLLOWED BY AN ADDRESS, THE 1401 PROGRAM 00219900 * WILL RESUME FROM THAT ADDRESS. HOWEVER, IF STT IS NOT FOLLOWED 00220000 * BY ANYTHING, THE 1401 PROGRAM WILL RESUME FROM WHERE IT STOPPED. 00220100 * 00220200 START CLI OKSTT,1 00220300 BNE START4 00220400 LA 5,RQSTIN+3 Q/ IS THERE A START ADDRESS 00220500 CLI 0(5),0 * 00220600 BNE START1 YES, START FROM THERE 00220700 L 8,RETURN 00220800 BR 8 00220900 START1 CLI 0(5),0 Q/ END OF MESSAGE 00221000 BE START2 YES 00221100 CLI 0(5),C'0' NO, IS IT NUMERIC 00221200 BL SNDILG NO, ERROR 00221300 LA 5,1(5) YES, TRY NEXT BYTE 00221400 B START1 * 00221500 START2 S 5,=A(RQSTIN+4) GET LENGTH - 1 00221600 CH 5,=H'4' Q/ LENGTH GT 5 DIGITS 00221700 BH SNDILG YES, ERROR 00221800 STC 5,TEMP1 CONVERT TO BINARY 00221900 MVN START3+1(1),TEMP1 * 00222000 START3 PACK PAKT,RQSTIN+3(0) * 00222100 CVB 4,PAKT * 00222200 CH 4,=H'15999' Q/ ADDRESS GT 15999 00222300 BH SNDILG YES, ERROR 00222400 AR 4,7 NO, GO THERE 00222500 LR 10,4 * 00222600 LA 9,0 * 00222700 B NXTOP * 00222800 START4 XC RQSTIN,RQSTIN ZERO OUT REPLY AREA 00222900 STM 13,15,MACREGSV SAVE MACRO REG 00223000 LA 6,MACREGSV SAVE ADDRESS TO XR 00223100 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00223200 WTOR 'CANNOT START,NO PGM LOADED',RQSTIN,50,WTECB 00223300 LM 13,15,0(6) RESTORE MACRO REGISTERS 00223400 B TESTAA 00223500 OKSTT DC X'00' 00223600 * 00223700 * THIS SECTION WILL SIMULATE THE START-RESET PUSHBUTTON. 00223800 * 00223900 STRST LR 6,10 00224000 AR 6,9 00224100 ST 6,ADR360 00224200 MVI TPERR,0 00224300 MVI TPEOF,0 00224400 MVI OVRFLO,0 00224500 MVI CPR,0 00224600 L 8,RETURN LOAD ADDRESS FOR START TAB 00224700 BR 8 GO DO START TAB 00224710 * 00224800 * THIS SECTION SIMULATES THE LOAD TAPE PUSHBUTTON. 00224900 * 00225000 TPLOAD LA 10,=X'00000001' 00225100 MVI MOD,X'00' 00225200 BAL 8,FNDRIV 00225300 ST 3,TMDCB 00225400 BAL 8,TSTOPEN 00225500 BAL 8,LOADMD 00225600 MVC TPCCW,=A(LDTCCW) 00225700 MVI TMIOB,X'44' 00225800 STM 13,15,MACREGSV SAVE MACRO REGS 00225900 LA 6,MACREGSV SAVE ADDRESS TO XR 00226000 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00226100 EXCP TMIOB 00226200 LM 14,15,4(6) RESTORE REG 14 AND 15 00226300 WAIT 1,ECB=TMECB WAIT FOR I/O 00226400 LM 13,15,0(6) RESTORE MACRO REGISTERS 00226500 LH 1,TMIOB+14 LOAD BYTE COUNT FROM CSW 00226600 LH 2,=H'18000' 00226700 SR 2,1 00226800 LA 3,SIMCOR+1 00226900 L 1,TAPEAREA 00227000 TPLD1 CLI 0(1),X'6D' 00227100 BNE TPLD2 00227200 LA 1,1(1) 00227300 MVC 0(1,3),0(1) 00227400 TR 0(1,3),TREI 00227500 OI 0(3),X'40' 00227600 SH 2,=H'1' 00227700 B TPLD3 00227800 TPLD2 MVC 0(1,3),0(1) 00227900 TR 0(1,3),TREI 00228000 TPLD3 LA 1,1(1) 00228100 LA 3,1(3) 00228200 BCT 2,TPLD1 00228300 NI 0(3),X'40' 00228400 OI 0(3),X'3F' 00228500 LA 12,1(3) 00228600 LA 10,SIMCOR+1 00228700 LA 9,0 00228800 MVI OKSTT,1 00228900 B NXTOP 00229000 * 00229100 * THIS SECTION SIMULATES THE SETTING OF SENSE SWITCHES BY SETTING 00229200 * INDICATORS IN CORE BASED UPON THE SSS INPUT COMMAND. THE 00229300 * ROUTINES THAT SIMULATE THE BSS INSTRUCTIONS WILL TEST THESE 00229400 * INDICATORS. 00229500 * 00229600 SSIN LA 6,RQSTIN+3 REFERENCE FIRST SENSE SWITCH 00229700 XC TSSA(7),TSSA CLEAR TEMPORARY SENSE SWITCHES 00229800 LA 5,8 SET TO SCAN 8 SETTINGS MAX 00229900 SSIN1 CLI 0(6),0 Q/ DONE 00230000 BE SSEND YES, MOVE THEM 00230100 CLI 0(6),C'A' Q/ IS THIS SENSE SWITCH LEGAL 00230200 BL SNDILG NO 00230300 CLI 0(6),C'G' 00230400 BH SNDILG NO 00230500 IC 4,0(6) YES 00230600 N 4,=F'7' SET TEMPORARY SENSE SWITCH 00230700 LA 2,TSSA-1 * 00230800 AR 2,4 * 00230900 MVI 0(2),1 * 00231000 LA 6,1(6) REFERENCE NEXT INPUT CHARACTER 00231100 BCT 5,SSIN1 Q/ ARE THERE TOO MANY INPUT CHARACTERS 00231200 B SNDILG YES 00231300 SSEND MVC SENSEA(7),TSSA 00231400 B WTORTN 00231500 TSSA DS 7C TEMPORARY SENSE SWITCHES 00231600 * 00231700 * THIS SECTION WILL SET THE TAPE TABLE WITH THE 1401-360 EQUIVALANT 00231800 * TAPE DRIVE NUMBERS BASED UPON THE TAS OPERATOR COMMAND. THE 00231900 * TAPE INSTRUCTION ROUTINES WILL SEARCH THIS TABLE TO DETERMINE 00232000 * WHICH DRIVE TO USE. 00232100 DS 0F 00232200 TPTBL DC XL4'E3D7F00A' 00232300 DC XL4'E3D7F101' 00232400 DC XL4'E3D7F202' 00232500 DC XL4'E3D7F303' 00232600 DC XL4'E3D7F404' 00232700 DC XL4'E3D7F505' 00232800 DC XL4'E3D7F606' 00232900 DC XL4'E3D7F707' 00233000 DC XL4'E3D7F808' 00233100 DC XL4'E3D7F909' 00233200 SAVE5 DC F'0' 00233300 SAVEDD DC F'0' 00233400 DDLEN DC H'0' 00233500 * THIS SECTION WILL CLEAR ALL 1401 CORE UPON ENTRY OF THE OPERATOR 00233600 * COMMAND CLR. 00233700 * 00233800 CLR LA 2,SIMCOR 00233900 LA 3,64 00234000 CLR1 XC 0(250,2),0(2) 00234100 LA 2,250(2) 00234200 BCT 3,CLR1 00234300 MVI OKSTT,0 00234400 B WTORTN 00234500 * 00234600 * THIS SECTION WILL DISPLAY ON THE PRINTER THE HUNDREDS GROUP 00234700 * OF 1401 CORE REFERENCED IN THE OPERATOR COMMAND DIS . 00234800 * 00234900 DIS LA 5,RQSTIN+3 00235000 DIS1 CLI 0(5),X'00' 00235100 BE DIS2 00235200 CLI 0(5),C'0' 00235300 BL SNDILG 00235400 LA 5,1(5) 00235500 B DIS1 00235600 DIS2 LR 2,5 00235700 SH 2,=H'2' 00235800 CLC 0(2,2),=C'00' 00235900 BNE SNDILG 00236000 S 5,=A(RQSTIN+4) 00236100 CH 5,=H'4' 00236200 BH SNDILG 00236300 STC 5,DIS3+1 00236400 MVC DSMRKR+1(20),WM256 00236500 DIS3 MVC DSMRKR+9(0),RQSTIN+3 MOVE ADDR FOR PRINTING 00236600 STC 5,TEMP1 00236700 MVN DIS4+1(1),TEMP1 00236800 DIS4 PACK PAKT,RQSTIN+3(0) 00236900 CVB 4,PAKT 00237000 CH 4,=H'15900' 00237100 BH SNDILG 00237200 AR 4,7 ADD IN ADDRESS OF 1401 SIMCORE 00237300 MVI PRNTBUFF,X'09' SET CARRIAGE CONTROL 00237400 MVC PRNTBUFF+1(20),WM256 00237500 MVC PRNTBUFF+21(100),0(4) 00237600 TR PRNTBUFF+21(100),TRIE CHANGE PRINT AREA TO EBCDIC 00237700 MVC PRNTBUFF+121(11),WM256 * 00237800 STM 13,15,MACREGSV SAVE BASE REGISTERS 00237900 LA 6,MACREGSV * 00238000 LA 13,SAVEAREA LOAD SAVE AREA 00238100 MVC DISPMSG+4(100),DSMRKR+21 00238200 LA 1,DISPMSG 00238300 SVC 35 00238400 LM 14,15,4(6) 00238500 MVC DISPMSG+4(100),PRNTBUFF+21 00238600 LA 1,DISPMSG 00238700 SVC 35 00238800 LM 14,15,4(6) 00238900 MVC PRNTBUFF+21(100),0(4) CHANGE WORD MARKS TO EBCDIC IS 00239000 TR PRNTBUFF+21(100),TRWDMK * 00239100 MVC DISPMSG+4(100),PRNTBUFF+21 00239200 LA 1,DISPMSG 00239300 SVC 35 00239400 LM 13,15,0(6) RESTORE MACRO REGISTERS 00239500 B WTORTN 00239600 CNOP 0,4 00239700 DISPMSG DC AL2(ENDISP-*) MESSAGE LENGTH 00239800 DC X'0000' 00239900 DC 100X'40' 00240000 ENDISP EQU * 00240100 DSMRKR DC X'09',20X'40' 00240200 DC C'0.......09........19........29........39........49.' 00240300 DC C'.......59........69........79........89........99' 00240400 DC C' ' 00240500 * 00240600 * THIS SECTION WILL MODIFY THE 1401 CORE LOCATION REFERENCED IN 00240700 * THE OPERATOR COMMAND ALT . 00240800 * 00240900 ALT LA 6,RQSTIN+3 00241000 ALT1 CLI 0(6),C',' 00241100 BE ALT2 00241200 CLI 0(6),C'0' 00241300 BL SNDILG 00241400 LA 6,1(6) 00241500 B ALT1 00241600 ALT2 LR 5,6 00241700 S 5,=A(RQSTIN+4) 00241800 CH 5,=H'4' 00241900 BH SNDILG 00242000 STC 5,TEMP1 00242100 MVN ALT3+1(1),TEMP1 00242200 ALT3 PACK PAKT,RQSTIN+3(0) 00242300 CVB 4,PAKT 00242400 CH 4,=H'15999' 00242500 BH SNDILG 00242600 AR 4,7 00242700 LA 6,1(6) BUMP TO DATA TAB 00242710 ALT4 CLI 0(6),0 END OF DATA? TAB 00242800 BE WTORTN YES, GO GET NEXT COMMAND TAB 00242900 MVI 0(4),0 CLEAR 1401 CHAR TAB 00242910 CLI 0(6),C'_' NO, CHECK FOR WORK MARK TAB 00243000 BNE ALT4A NO WM, GO MOVE CHAR TAB 00243100 MVI 0(4),X'40' WM REQ, SET WM IN 1401 CORE TAB 00243200 LA 6,1(6) BUMP TO CHAR TO BE MOVED TAB 00243300 ALT4A TR 0(1,6),TREI TRANS CHAR TO 1401 CODE TAB 00243310 OC 0(1,4),0(6) INSERT CHAR IN 1401 CORE TAB 00243320 LA 6,1(6) BUMP TO NEXT CHAR IN REQ TAB 00243330 LA 4,1(4) BUMP TO NEXT CHAR IN 1401 TAB 00243340 B ALT4 LOOP TO CHECK NEXT CHAR TAB 00243350 * 00243400 * THIS SECTION WILL WRITE A TAPE MARK ON THE TAPE DRIVE 00243500 * SELECTED BY THE WTM COMMAND. 00243600 * 00243700 WTMCMD NI RQSTIN+3,X'0F' GET DEVICE ADDRESS 00243800 LA 10,RQSTIN * 00243900 BAL 8,FNDRIV * 00244000 ST 3,TMDCB 00244100 BAL 8,TSTOPEN 00244200 BAL 8,LOADMD 00244300 MVC TPCCW,=A(WTMCCW) 00244400 STM 13,15,MACREGSV SAVE MACRO REGS 00244500 LA 6,MACREGSV SAVE ADDRESS TO XR 00244600 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00244700 EXCP TMIOB 00244800 LM 14,15,4(6) RESTORE REG 14 AND 15 00244900 WAIT 1,ECB=TMECB WAIT FOR I/O 00245000 LM 13,15,0(6) RESTORE MACRO REGISTERS 00245100 B WTORTN 00245200 * 00245300 * THIS ROUTINE WILL TERMINATE THE SIMULATOR UPON THE OPERATOR 00245400 * ENTRY 'TRM'. 00245500 * 00245600 TERMINAT STM 13,15,MACREGSV 00245700 LA 13,SAVEAREA 00245800 LA 6,MACREGSV 00245900 CLOSE PRNTDCB 00246000 LM 14,15,4(6) 00246100 TM PUNCHR+48,X'10' IS PUNCH OPEN? TAB 00246110 BZ EXIT NO, GO EXIT TAB 00246120 PUT PUNCHR,PCHARAA 00246200 EXIT L 13,4(13) POINT TO SAVE AREA TAB 00246300 RETURN (14,12),RC=0 RETURN WITH RC=0 TAB 00246400 DUMPCORE L 13,=A(W) USING W,13 OI DUMPSW+1,X'F0' SET DUMP SWITCH BAL 2,DUMP DUMP 201 - 332 MVC 201(100,7),0(7) MVC SIMCOR+310(6),=X'0A002000909' 0 - 99 BAL 2,DUMP DUMP 000 - 099 MVC 201(101,7),100(7) MVC SIMCOR+310(9),=X'010A0A002000020A01' 100 - 201 BAL 2,DUMP DUMP 100 - 201 MVC DUMPADR,=H'300' SET UP LOCATION COUNTER DUMPLOOP LH 1,DUMPADR GET DUMP ADDRESS CH 1,=H'16000' ARE WE AT END OF 1401 CORE? BNL DUMPDONE YES, EXIT AR 1,7 ADD 1401 BASE ADDRESS MVC 201(100,7),0(1) MOVE 100 POS TO PRINT AREA SR 1,7 SUBTRACT 1401 BASE ADDRESS CVD 1,DUMPSAV2 ADDR TO DECIMAL UNPK SIMCOR+310(5),DUMPSAV2 OI SIMCOR+314,X'F0' REMOVE SIGN TR SIMCOR+310(5),TREI TRANS TO 1401 CODE LA 1,100(1) BUMP TO NEXT BAND STH 1,DUMPADR STORE ADDR OF NEXT BAND BAL 2,DUMP B DUMPLOOP DUMPDONE NI DUMPSW+1,X'0F' TURN OFF DUMP SWITCH STM 13,15,MACREGSV SAVE REGS LA 6,MACREGSV SAVE ADDR OF SAVE AREA LA 13,SAVEAREA GET ADDRESS OF SAVE AREA TRUNC PRNTDCB FORCE WRITE FOR LAST BLOCK LM 13,15,0(6) RESTORE REGS B WTORTN EXIT DUMP LA 9,1 LENGTH OF 1401 INST LA 10,DUMPOP ADDR OF 1401 OP CODE LA 4,DUMPCLR LOAD RETURN ADDRESS ST 2,DUMPSAV2 SAVE LINK REG 2 B W BRANCH TO WRITE ROUTINE DUMPCLR XC 201(132,7),210(7) CLEAR 1401 PRINT AREA L 2,DUMPSAV2 LOAD RETURN REG 2 BR 2 DUMPOP DC X'42423C7B' _2_2<_. 1401 INSTS FOR DUMP DUMPADR DC H'0' DUMPSAV2 DS D DROP 13 TMIOB DS 0D 00247500 DC X'42' 00247600 DC 4X'00' 00247700 DC AL3(TMECB) 00247800 DC X'00' 00247900 TPCSW DC 7X'00' 00248000 TPCCW DC XL4'00' ADDRESS OF CCW FOR TAPE OPERATION 00248100 TMDCB DC XL4'00' DCB ADDRESS FOR TAPE DRIVE SELECTED 00248200 DC 4X'00' 00248300 DC 2X'00' 00248400 DC 2X'00' 00248500 TMECB DS 0F 00248600 DC 4X'00' 00248700 * 00248800 * THIS SECTION WILL REWIND THE TAPE SELECTED BY THE RWD COMMAND 00248900 * 00249000 RWDCMD NI RQSTIN+3,X'0F' GET DEVICE ADDRESS 00249100 LA 10,RQSTIN * 00249200 BAL 8,FNDRIV * 00249300 ST 3,TMDCB 00249400 BAL 8,TSTOPEN 00249500 BAL 8,LOADMD 00249600 MVC TPCCW,=A(RWDCCW) 00249700 MVI TMIOB,X'04' 00249800 STM 13,15,MACREGSV SAVE MACRO REGS 00249900 LA 6,MACREGSV SAVE ADDRESS TO XR 00250000 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00250100 EXCP TMIOB 00250200 LM 14,15,4(6) RESTORE REG 14 AND 15 00250300 WAIT 1,ECB=TMECB WAIT FOR I/O 00250400 LM 13,15,0(6) RESTORE MACRO REGISTERS 00250500 B WTORTN 00250600 * BEFORE BRANCHING, SET THE B ADDRESS REGISTER TO THE ADDRESS OF 00250700 * THE INSTRUCTION AFTER THE BRANCH, THEN SET THE INSTRUCTION 00250800 * COUNTER TO THE BRANCH ADDRESS, AND BRANCH. 00250900 * 00251000 SETBCH BAL 8,CVAD43 CONVERT BRANCH ADDRESS 00251100 LR 12,10 LOAD B ADDRESS 00251200 AR 12,9 * 00251300 ST 10,LSTBCH SAVE LAST BRANCHED FROM LOCATION 00251400 LR 10,5 LOAD BRANCH ADDRESS 00251500 LA 9,0 * 00251600 B NXTOP GO TO BRANCH ADDRESS FOR NXT INSTR. 00251700 ILEGTAPE STM 13,15,MACREGSV SAVE REGISTERS 00251800 LA 6,MACREGSV * 00251900 LA 13,SAVEAREA * 00252000 WTO 'UNDEFINED TAPE' 00252100 LM 13,15,0(6) 00252200 B PANEL 00252300 ILEGOP STM 13,15,MACREGSV SAVE MACRO REGS 00252400 LA 6,MACREGSV SAVE ADDRESS TO XR 00252500 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00252600 WTO 'ILLEGAL OP CODE' 00252700 LM 13,15,0(6) RESTORE MACRO REGISTERS 00252800 B PANEL 00252900 ILEGLN STM 13,15,MACREGSV SAVE MACRO REGS 00253000 LA 6,MACREGSV SAVE ADDRESS TO XR 00253100 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00253200 WTO 'ILLEGAL LENGTH' 00253300 LM 13,15,0(6) RESTORE MACRO REGISTERS 00253400 PANEL LR 1,10 00253500 SR 1,7 00253600 CVD 1,PAKT 00253700 UNPK PNLWTOR+19(6),PAKT+5(3) 00253800 MVZ PNLWTOR+24(1),=C'0' 00253900 MVC PNLWTOR+34(1),0(10) 00254000 NI PNLWTOR+34,X'BF' 00254100 TR PNLWTOR+34(1),TRIE 00254200 CVD 9,PAKT 00254300 UNPK PNLWTOR+48(6),PAKT+5(3) 00254400 MVZ PNLWTOR+53(1),=C'0' 00254500 MVI PNLWTOR+65,X'80' 00254600 MVC PNLWTOR+66(1),PNLWTOR+65 00254700 CH 9,=H'8' 00254800 BH WTORPNL 00254900 LTR 3,9 00255000 BZ WTORPNL 00255100 SH 3,=H'1' 00255200 STC 3,PANEL1+1 00255300 PANEL1 MVC PNLWTOR+65(0),0(10) 00255400 TR PNLWTOR+65(8),TRIE 00255500 WTORPNL XC RQSTIN,RQSTIN ZERO OUT REPLY AREA 00255600 STM 13,15,MACREGSV SAVE MACRO REG 00255700 LA 6,MACREGSV SAVE ADDRESS TO XR 00255800 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00255900 PNLWTOR WTOR ' I OP LENGTH INST X00256000 ',RQSTIN,50,WTECB 00256100 LM 13,15,0(6) RESTORE MACRO REGISTERS 00256200 B TESTAA 00256300 TITLE 'ADDRESS CONVERSION SUBROUTINES' 00256400 * 00256500 * SUBROUTINE TO CONVERT A 1401 ADDRESS TO A 360 ADDRESS 00256600 * 00256700 CVAD43 MVI IXTMP,0 00256800 LR 5,7 LOAD SIMULATED CORE BASE INTO 5 00256900 CVAD4A IC 3,0(6) 1000'S + 100'S 00257000 N 3,=F'63' * 00257100 SLL 3,1 * 00257200 AH 5,TBHNTH(3) * 00257300 IC 3,2(6) 4000'S + 1'S 00257400 N 3,=F'63' * 00257500 SLL 3,1 * 00257600 AH 5,TBT4UN(3) * 00257700 IC 3,1(6) 10'S 00257800 N 3,=F'15' * 00257900 SLL 3,1 * 00258000 AH 5,TBTENS(3) * 00258100 TM 1(6),X'30' Q/ INDEXING 00258200 BE CVAD4D NO, DONE 00258300 CLI IXTMP,1 Q/ SECOND TIME THROUGH 00258400 BE CVAD4D YES, DONE 00258500 MVI IXTMP,1 SET SECOND TIME INDICATOR 00258600 TM 1(6),X'30' Q/ IX3 00258700 BO CVAD4C IX3 00258800 TM 1(6),X'20' 00258900 BO CVAD4B IX2 00259000 LA 6,SIMCOR+87 IX1 00259100 B CVAD4A 00259200 CVAD4B LA 6,SIMCOR+92 00259300 B CVAD4A 00259400 CVAD4C LA 6,SIMCOR+97 00259500 B CVAD4A 00259600 CVAD4D C 5,SIMLIMIT Q/ IS ADDRESS GREATER THAN 15999 00259700 BCR 12,8 NO, DONE 00259800 SH 5,=H'16000' YES, SUBTRACT 16000 00259900 BR 8 00260000 ADR360 DS F 00260100 ADR140 DS CL3 00260200 IXTMP DS C 00260300 TEMP1 DS C 00260400 TEMP2 DS C 00260500 * 00260600 * SUBROUTINE TO CONVERT A 360 ADDRESS TO A 1401 ADDRESS 00260700 * 00260800 CVAD34 L 5,ADR360 00260900 SR 5,7 SUBTRACT SIMULATED CORE BASE 00261000 LA 4,0 4000'S ZONE 00261100 D 4,=F'4000' * 00261200 SLL 5,4 * 00261300 LR 1,5 * 00261400 LR 5,4 1000'S ZONE 00261500 LA 4,0 * 00261600 D 4,=F'1000' * 00261700 SLL 5,4 * 00261800 LR 2,5 * 00261900 LR 5,4 100'S NUMERIC 00262000 LA 4,0 * 00262100 D 4,=F'100' * 00262200 OR 5,2 * 00262300 STC 5,ADR140 * 00262400 LR 5,4 10'S NUMERIC 00262500 LA 4,0 * 00262600 D 4,=F'10' * 00262700 STC 5,ADR140+1 * 00262800 OR 4,1 * 00262900 STC 4,ADR140+2 * 00263000 TM ADR140,X'0F' Q/ IS HUNDREDS ZERO 00263100 BC 5,CVAD3A NO 00263200 OI ADR140,X'0A' YES, ADD 8-2 BITS 00263300 CVAD3A TM ADR140+1,X'0F' Q/ IS TENS ZERO 00263400 BC 5,CVAD3B NO 00263500 OI ADR140+1,X'0A' YES, ADD 8-2 BITS 00263600 CVAD3B TM ADR140+2,X'0F' Q/ IS UNITS ZERO 00263700 BCR 5,8 NO, RETURN 00263800 OI ADR140+2,X'0A' YES, ADD 8-2 BITS 00263900 BR 8 RETURN 00264000 TITLE 'ROUTINES TO HELP UNIT RECORD OPERATIONS' 00264100 HALTWTO STM 13,15,MACREGSV SAVE BASE REGISTERS 00264200 LA 6,MACREGSV SAVE ADDRESS TO XR 00264300 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00264400 HLTWTO WTO 'HALT I , A , B ' 00264500 LM 13,15,0(6) RESTORE MACRO REGISTERS 00264600 BR 8 RETURN TO HALT ROUTINE 00264700 READ CLI CRDEOF,X'01' HAVE WE READ LAST CARD 00264800 BNE READ2 BRANCH IF NO 00264900 STM 13,15,MACREGSV SAVE MACRO REGS 00265000 LA 6,MACREGSV SAVE ADDRESS TO XR 00265100 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00265200 WTO 'READ TRIED AFTER LAST CARD' 00265300 LM 13,15,0(6) RESTORE MACRO REGISTERS 00265400 B PANEL TAB 71110 00265500 READ2 TR TMPARA(80),TREI CHANGE EBCDIC TO INTERNAL 1401 CODE 00265600 NC SIMCOR+1(80),WM256 REMOVE CARD AREA INFO, KEEP WD MKS 00265700 OC SIMCOR+1(80),TMPARA 00265800 LA 12,SIMCOR+81 00265900 STM 13,15,MACREGSV SAVE MACRO REGS 00266000 LA 6,MACREGSV SAVE ADDRESS TO XR 00266100 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00266200 GET CARD,TMPARA READ CARD 00266300 LM 13,15,0(6) RESTORE MACRO REGISTERS 00266400 NI SIMCOR,X'40' SET BA BITS IN LOC 0 AFTER READ 00266500 OI SIMCOR,X'30' * 00266600 BR 8 00266700 EOC LM 13,15,0(6) RESTORE SIMULATOR REGISTERS 00266800 MVI CRDEOF,X'01' SET CARD EOF INDICATOR 00266900 BR 8 00267000 WRITE LA 3,PRNTDCB GET ADDR OF PRINT DCB TAB 00267100 BAL 5,UROPEN GO CHECK FOR OPEN TAB 00267110 MVC PRNTBUFF+1(132),SIMCOR+201 TAB 00267120 TR PRNTBUFF+1(132),TRIE 00267200 STM 13,15,MACREGSV SAVE MACRO REG 00267300 LA 6,MACREGSV SAVE ADDRESS TO XR 00267400 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00267500 PUT PRNTDCB,PRNTBUFF 00267600 LM 13,15,0(6) RESTORE MACRO REGISTERS 00267700 COUNTER STM 7,8,DGSAVE 00267800 TM PRNTBUFF,X'80' IS IT SKIP TO CHAN 00267900 BO DG1 YES 00268000 CLI PRNTBUFF,X'01' IS IT NO AUTO SPACE 00268100 BE DGEXIT 00268200 XR 7,7 00268300 IC 7,PRNTBUFF 00268400 SRL 7,3 00268500 L 8,DGCUR 00268600 DG11 BCTR 7,0 SUBT ON FROM NO. OF SPACES 00268700 LTR 7,7 IS NO. OF SPACES LESS THAN ZERO 00268800 BM DG4 YES-CLEAN UP AND EXIT 00268900 LA 8,1(8) 00269000 C 8,DGEND IS NO. OF SPACES LESS THAN ZERO 00269100 BH DG10 YES-CLEAN UP AND EXIT 00269200 DG14 CLI 0(8),X'00' NO PUNCH IN CARRIAGE TAPE 00269300 BE DG11 BLANK-KEEP TRYING 00269400 MVI PRTP9,X'00' NOW BLANK 00269500 MVI PRTP12,X'00' 00269600 CLI 0(8),X'F9' IS IT NINE PUNCH 00269700 BE DG12 YES 00269800 CLI 0(8),X'50' IS IT 12 PUNCH 00269900 BE DG13 YES 00270000 B DG11 NO-LOOK FOR NEXT PUNCH 00270100 DG10 L 8,=A(CARTAB) POINT TO FRONT OF TABLE 00270200 B DG14 00270300 DG12 MVI PRTP9,X'01' SET CHAN 9 SWITCH 00270400 B DG11 00270500 DG13 MVI PRTP12,X'01' SET CHAN 12 SWITCH 00270600 B DG11 00270700 DG1 CLI PRNTBUFF,X'C9' CHAN 9 AFTER 00270800 BE DG2 00270900 CLI PRNTBUFF,X'CB' CHAN 9 IMMED 00271000 BE DG2 00271100 CLI PRNTBUFF,X'E1' CHAN 12 AFTER 00271200 BE DG3 00271300 CLI PRNTBUFF,X'E3' CHAN 12 IMMED 00271400 BE DG3 00271500 MVI PRTP12,X'00' CLEAR 12 00271600 MVI PRTP9,X'00' CLEAR 9 00271700 XR 7,7 00271800 IC 7,PRNTBUFF 00271900 SRL 7,3 00272000 N 7,=F'15' 00272100 O 7,=F'240' 00272200 C 7,=F'249' 00272300 BH DG8 00272400 STC 7,DG6+1 00272500 B DG7 00272600 DG8 C 7,=F'250' 00272700 BE DG9 00272800 MVI DG6+1,X'60' 00272900 B DG7 00273000 DG9 MVI DG6+1,X'F0' 00273100 B DG7 00273200 DG2 MVI PRTP9,X'01' CHAN 9 SIGNAL 00273300 MVI PRTP12,X'00' 00273400 MVI DG6+1,X'F9' 00273500 DG7 XR 7,7 00273600 L 8,DGCUR 00273700 DG6 CLI 0(8),X'FF' LOOK FOR CHAN 00273800 BE DG4 00273900 LA 7,1(7) 00274000 C 7,=F'138' 00274100 BH DGERROR 00274200 LA 8,1(8) 00274300 C 8,DGEND 00274400 BH DG5 00274500 B DG6 00274600 DG5 L 8,=A(CARTAB) 00274700 B DG6 00274800 DG3 MVI PRTP12,X'01' 00274900 MVI PRTP9,X'00' 00275000 MVI DG6+1,X'50' 00275100 B DG7 00275200 DG4 ST 8,DGCUR 00275300 DGEXIT LM 7,8,DGSAVE 00275400 MVI PRNTBUFF,X'09' RESTORE SINGLE SPACE AFTER PRINT 00275500 XC PRNTBUFF+1,PRNTBUFF+1 00275600 LA 12,SIMCOR+333 SET B ADDRESS REGISTER 00275700 BR 8 00275800 DGEND DC A(CARTAB+65) 00275900 DGCUR DC A(CARTAB) 00276000 CARTAB DC XL6'0000000000F1' 00276100 DC 53X'00' 00276200 DC X'50' 00276300 DC 78X'00' 00276400 ENDCRTP EQU * 00276500 DGSAVE DC 2F'0' 00276600 DGERROR STM 13,15,MACREGSV 00276700 LA 6,MACREGSV 00276800 LA 13,SAVEAREA 00276900 MVC DG20+45(1),DG6+1 00277000 DG20 WTO 'UNABLE TO FIND CARRIAGE CONTROL CHAR ' 00277100 LM 13,15,0(6) 00277200 B TERMINAT 00277300 PUNCH LA 3,PUNCHR GET ADDR OF PUNCH DCB TAB 00277400 BAL 5,UROPEN GO CHECK FOR OPEN TAB 00277410 MVC PCHARA,SIMCOR+101 CONVRT 1401 PCH AREA FOR OUTPUT TAB 00277420 TR PCHARA,TRIE * 00277500 STM 13,15,MACREGSV SAVE MACRO REGS 00277600 LA 6,MACREGSV SAVE ADDRESS TO XR 00277700 LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00277800 PUT PUNCHR,PCHARA 00277900 LM 13,15,0(6) RESTORE MACRO REGISTERS 00278000 LA 12,SIMCOR+181 00278100 MVC PCHAR1,PCHARA 00278200 MVI PCHARAA,X'01' 00278300 NI SIMCOR+100,X'40' SET 82 BITS IN LOC 100 AFTER PUNCH 00278400 OI SIMCOR+100,X'0A' * 00278500 BR 8 00278600 BINMOD EQU * 00278700 LOADMD BR 8 00278800 TSTOPEN EQU * 00278900 TM 48(3),X'10' 00279000 BO 0(8) 00279100 STM 13,15,MACREGSV 00279200 LA 6,MACREGSV 00279300 LA 13,SAVEAREA 00279400 OPEN ((3),INPUT) 00279500 LM 13,15,0(6) 00279600 TM 48(3),X'10' IS DCB OPEN NOW? TAB 00279700 BCR 1,8 YES, RETURN TO CALLER TAB 00279705 ABEND 1000,DUMP NO, DCB DID NOT OPEN, ABEND TAB 00279710 * 00279715 UROPEN TM 48(3),X'10' IS THE DCB OPEN? TAB 00279720 BCR 1,5 YES, EXIT TAB 00279725 STM 13,15,MACREGSV SAVE REGS FOR MACRO TAB 00279730 LA 6,MACREGSV SAVE ADDR OF SAVE AREA TAB 00279735 LA 13,SAVEAREA GET ADDR OF NEW SAVE AREA TAB 00279740 OPEN ((3),OUTPUT) OPEN U/R OUTPUT TAB 00279745 LM 13,15,0(6) RELOAD BASE REGS TAB 00279750 TM 48(3),X'10' DID THE DCB OPEN OK? TAB 00279755 BCR 1,5 YES, EXIT TAB 00279760 ABEND 1001,DUMP NO, DCB NOT OPEN, ABEND TAB 00279765 TITLE 'ROUTINES TO HELP TAPE OPERATIONS' 00279800 FNDLNG LR 6,12 00279900 FNDLGA TRT 0(256,6),TRGPWM SCAN FOR GP MK - WD MK 00280000 BC 6,FNDLGB FOUND 00280100 LA 6,256(6) 00280200 B FNDLGA 00280300 FNDLGB LR 6,1 CALCULATE LENGTH 00280400 SR 6,12 * 00280500 BR 8 00280600 FNDRIV LA 3,10 00280700 LA 4,TPTBL 00280800 FNDRV1 CLC 3(1,10),3(4) 00280900 BE FNDRV2 00281000 LA 4,4(4) 00281100 BCT 3,FNDRV1 00281200 B ILEGTAPE TAPE NOT DEFINED, SEND ERROR MESSAGE 00281300 FNDRV2 LA 6,10 00281400 SR 6,3 00281500 LR 3,6 00281600 SLL 3,3 MULTIPLY LOGICAL DRIVE NUMBER BY 8 00281700 A 3,=A(TAPADR) ADD BASE OF TAPE ADDRESS TABLE 00281800 L 3,4(3) GET ACTUAL TAPE ADDRESS FROM TABLE 00281900 MVI TMECB,0 CLEAR ECB BEFORE EXCP 00282000 NI 0(3),X'3F' CLEAR DCB EXCEPTION BITS 00282100 MVI TMIOB,X'42' SET IOB CMD CHAIN + UNRELATED BITS 00282200 BR 8 00282300 TPTEST MVC SAVCSW+1(7),TPCSW SAVE CSW AFTER TAPE OPERATION 00282400 CLI TMECB,X'7F' 00282500 BE TPTIO3 00282600 MVI TPERR,1 00282700 TPTIO3 EQU * 00282800 TM SAVCSW+4,1 Q/ EOF 00282900 BZ TPTIO1 00283000 LH 4,=H'17999' 00283100 STH 4,SAVCSW+6 00283200 L 4,TAPEAREA PUT TAPE MARK CHARACTER IN TAPE AREA 00283300 MVI 0(4),X'0F' * 00283400 MVI TPEOF,1 00283500 TPTIO1 MVI TPERR,0 00283600 TM SAVCSW+4,2 Q/ TAPE ERROR 00283700 BCR 8,8 00283800 TPTIO2 MVI TPERR,1 00283900 BR 8 00284000 RWUCLOSE STM 14,15,MACREGSV SAVE BASE REGISTERS 00284100 LA 6,MACREGSV * 00284200 LA 13,SAVEAREA * 00284300 CLOSE ((4)) CLOSE THE DCB 00284400 LM 14,15,0(6) 00284500 B NXTOP 00284600 TITLE 'ROUTINE TO BRANCH TO NEXT OPCODE PROCESSING ROUTINE' 00284700 * 00284800 * THIS SECTION EXAMINES THE NEXT OPERATION CODE AND, BASED UPON IT, 00284900 * BRANCHES TO THE PROPER ROUTINE TO PROCESS THE INSTRUCTION. 00285000 * 00285100 NXTOP AR 10,9 GET NEW OP CODE LOCATION 00285200 TM 0(10),X'40' Q/ IS THERE A WORD MARK 00285300 BZ ILEGOP NO 00285400 LA 1,250(10) 00285500 TRT 1(250,10),TRTB 00285600 LR 9,1 00285700 SR 9,10 00285800 IC 2,0(10) GET OP CODE 00285900 N 2,=F'63' ELIMINATE WORD MARK 00286000 SLL 2,2 MULTIPLY BY 4 00286100 L 13,BCHTBL(2) LOAD BASE OF PROCESSING ROUTINE 00286200 BR 13 BRANCH TO OPCODE PROCESSING ROUTINE 00286300 BCHTBL DC A(ILEGOP) 0 00286400 DC A(R) 1 1 00286500 DC A(W) 2 2 00286600 DC A(WR) 3 3 00286700 DC A(P) 4 4 00286800 DC A(RP) 5 5 00286900 DC A(WP) 6 6 00287000 DC A(WRP) 7 7 00287100 DC A(NXTOP) 10 8 00287200 DC A(NXTOP) 11 9 00287300 DC A(ILEGOP) 12 0 00287400 DC A(MA) 13 = 00287500 DC A(M) 14 @ 00287600 DC A(ILEGOP) 15 00287700 DC A(ILEGOP) 16 00287800 DC A(ILEGOP) 17 TP MK 00287900 DC A(ILEGOP) 20 A BIT 00288000 DC A(CS) 21 / 00288100 DC A(A) 22 S 00288200 DC A(ILEGOP) 23 T 00288300 DC A(CU) 24 U 00288400 DC A(BWZ) 25 V 00288500 DC A(BBE) 26 W 00288600 DC A(NXTOP) 27 X 00288700 DC A(MZ) 30 Y 00288800 DC A(MCS) 31 Z 00288900 DC A(ILEGOP) 32 00289000 DC A(SW) 33 , 00289100 DC A(D) 34 % 00289200 DC A(ILEGOP) 35 WD SEP 00289300 DC A(ILEGOP) 36 00289400 DC A(ILEGOP) 37 00289500 DC A(ILEGOP) 40 - 00289600 DC A(ILEGOP) 41 J 00289700 DC A(SS) 42 K 00289800 DC A(LCA) 43 L 00289900 DC A(MCW) 44 M 00290000 DC A(NXTOP) 45 N 00290100 DC A(ILEGOP) 46 O 00290200 DC A(MCM) 47 P 00290300 DC A(SAR) 50 Q 00290400 DC A(ILEGOP) 51 R 00290500 DC A(ZS) 52 -0 00290600 DC A(ILEGOP) 53 $ 00290700 DC A(ILEGOP) 54 * 00290800 DC A(ILEGOP) 55 00290900 DC A(ILEGOP) 56 00291000 DC A(ILEGOP) 57 00291100 DC A(ILEGOP) 60 + 00291200 DC A(A) 61 A 00291300 DC A(B) 62 B 00291400 DC A(C) 63 C 00291500 DC A(MN) 64 D 00291600 DC A(MCE) 65 E 00291700 DC A(CC) 66 F 00291800 DC A(ILEGOP) 67 G 00291900 DC A(SBR) 70 H 00292000 DC A(ILEGOP) 71 I 00292100 DC A(ZA) 72 +0 00292200 DC A(H) 73 . 00292300 DC A(CW) 74 00292400 DC A(ILEGOP) 75 00292500 DC A(ILEGOP) 76 00292600 DC A(ILEGOP) 77 00292700 TITLE ' ' 00292800 SENSEA DC X'0' 00292900 SENSEB DC X'0' 00293000 SENSEC DC X'0' 00293100 SENSED DC X'0' 00293200 SENSEE DC X'0' 00293300 SENSEF DC X'0' 00293400 SENSEG DC X'0' 00293500 PRTP9 DC X'0' 00293600 PRTP12 DC X'0' 00293700 TPERR DC X'0' 00293800 TPEOF DC X'0' RESET WHEN TESTED 00293900 OVRFLO DC X'0' RESET WHEN TESTED 00294000 CPR DC X'00' 00294100 DCHAR DS C 00294200 LSTBCH DS F TO HOLD ADDRESS OF LAST BRANCH 00294300 CRDEOF DC X'00' CARD END-OF-FILE INDICATOR 00294400 POS1 DC X'0' 00294500 AEND DC X'0' 00294600 SAVB DS F 00294700 SIMLIMIT DC F'0' UPPER LIMIT OF SIMULATED CORE 00294800 TAPEAREA DC F'0' ADDRESS OF TAPE I/O BUFFER 00294900 SUPRES DC X'00' ZERO SUPPRESSION INDICATOR 00295000 RQSTND DC X'00' INDICATOR FOR OPERATOR REQUESTS 00295100 BCDTAP DS C INDICATOR FOR BCD TAPE MODE 00295200 PCHERR DC X'00' PUNCH ERROR INDICATOR 00295300 RDRERR DC X'00' CARD READ ERROR INDICATOR 00295400 PRTERR DC X'00' PRINTER ERROR INDICATOR 00295500 TMPARA DS CL80 00295600 PCHARAA DC X'01' NORMAL STACKER SELECT 00295700 PCHAR1 DC CL80' ' 00295800 PCHARA DS CL80 PUNCH OUTPUT AREA 00295900 JOBNAME DC CL8' ' 00296000 WM256 DC 256X'40' 00296100 PAKT DS D 00296200 DS 0F 00296300 PRNTBUFF DC X'09' 00296400 DC CL132' ' 00296500 SAVEAREA DS 18F 00296600 MACREGSV DS 18F 00296700 SAVCSW DS D 00296800 TITLE 'CHANNEL COMMAND WORDS' 00296900 WTCCW1 CCW X'03',1,X'60',1 00297000 WTCCW2 CCW 1,0,X'20',0 00297100 LDTCCW CCW X'03',0,X'60',1 00297200 LDTCCW1 CCW 2,0,X'20',18000 00297300 RTCCW CCW X'03',0,X'60',1 READ TAPE 00297400 RTCCW1 CCW 2,0,X'20',18000 00297500 WTMCCW CCW X'1F',0,X'20',1 WRITE TAPE MARK 00297600 RWDCCW CCW X'07',0,X'20',1 REWIND 00297700 RETURN DS F 00297800 CUIOB DS 0D 00297900 DC X'02' 00298000 DC 4X'00' 00298100 DC AL3(CUECB) 00298200 DC 8X'00' 00298300 DC AL4(CUCCW) ADDR OF CCW CHAIN FOR CU OPS TAB 00298400 CUDCB DC F'0' 00298500 DC 8X'00' 00298600 CUECB DC F'0' 00298700 * 00298800 * THIS TABLE EQUATES A 360 TAPE DRIVE TO A 1401 TAPE DRIVE AS A 00298900 * RESULT OF A TAS ENTRY. 00299000 * 00299100 TAPADR DC A(0,TAPEDCB0) 00299200 DC A(0,TAPEDCB1) 00299300 DC A(0,TAPEDCB2) 00299400 DC A(0,TAPEDCB3) 00299500 DC A(0,TAPEDCB4) 00299600 DC A(0,TAPEDCB5) 00299700 DC A(0,TAPEDCB6) 00299800 DC A(0,TAPEDCB7) 00299900 DC A(0,TAPEDCB8) 00300000 DC A(0,TAPEDCB9) 00300100 ORG TAPADR+1 00300200 DC CL3'TP0' 00300300 ORG TAPADR+9 00300400 DC CL3'TP1' 00300500 ORG TAPADR+17 00300600 DC CL3'TP2' 00300700 ORG TAPADR+25 00300800 DC CL3'TP3' 00300900 ORG TAPADR+33 00301000 DC CL3'TP4' 00301100 ORG TAPADR+41 00301200 DC CL3'TP5' 00301300 ORG TAPADR+49 00301400 DC CL3'TP6' 00301500 ORG TAPADR+57 00301600 DC CL3'TP7' 00301700 ORG TAPADR+65 00301800 DC CL3'TP8' 00301900 ORG TAPADR+73 00302000 DC CL3'TP9' 00302100 ORG TAPADR+82 00302200 PRNTDCB DCB MACRF=PM,DSORG=PS,DDNAME=WRITE,LRECL=133,RECFM=FBM, C00302300 EXLST=MURLIST 00302305 * DCB EXIT ROUTINE ADDED BY T BROWN WRO 71061 00302310 MURLIST DC X'85' END OF LIST, DCB EXIT ENTRY 00302315 DC AL3(MUREXIT) ADDR OF DCB EXIT ROUTINE 00302320 USING *,15 R 15 IS BASE FOR THIS ROUTINE 00302325 MUREXIT LH 3,62(1) GET DCB BLKSIZE 00302330 LH 4,82(1) GET DCB LRECL 00302335 LTR 3,3 IS BLKSIZE ZERO? 00302340 BZ SETBLK YES, GO SET BLKSIZE = LRECL 00302345 SR 2,2 NO, ZERO R2 FOR REMAINDER 00302350 DR 2,4 DIVIDE BLKSIZE BY LRECL 00302355 LTR 2,2 ZERO REMAINDER? 00302360 BCR 8,14 YES,EXIT TO OPEN 00302365 BCR 8,14 YES, EXIT TO OPEN 00302370 SETBLK STH 4,62(1) NO, SET BLKSIZE = LRECL 00302375 BR 14 EXIT TO OPEN 00302380 USING SETBS1,15 00302385 PUNCHR DCB MACRF=PM,DSORG=PS,RECFM=FBM,LRECL=81,DDNAME=CARDOUT, X00302400 EXLST=MURLIST TAB 00302500 CARD DCB MACRF=GM,DSORG=PS,RECFM=FB,LRECL=80, X00302600 DDNAME=CARDIN,EODAD=EOC 00302700 TITLE 'DATA CONVERSION TRANSLATE TABLES' 00302800 TBHNTH DC H'0,100,200,300,400,500,600,700,800,900' 00302900 DC 6H'0' 00303000 DC H'0,1100,1200,1300,1400,1500,1600,1700,1800,1900,1000' 00303100 DC 5H'0' 00303200 DC H'0,2100,2200,2300,2400,2500,2600,2700,2800,2900,2000' 00303300 DC 5H'0' 00303400 DC H'0,3100,3200,3300,3400,3500,3600,3700,3800,3900,3000' 00303500 DC 5H'0' 00303600 TBT4UN DC H'0,1,2,3,4,5,6,7,8,9' 00303700 DC 6H'0' 00303800 DC H'0,4001,4002,4003,4004,4005,4006,4007,4008,4009,4000' 00303900 DC 5H'0' 00304000 DC H'0,8001,8002,8003,8004,8005,8006,8007,8008,8009,8000' 00304100 DC 5H'0' 00304200 DC H'0,12001,12002,12003,12004,12005,12006,12007,12008' 00304300 DC H'12009,12000,0,0,0,0,0' 00304400 TBTENS DC H'0,10,20,30,40,50,60,70,80,90' 00304500 DC 6H'0' 00304600 TRTB DC 64X'00',64X'F1',64X'00',64X'F1' 00304700 TREI DC 64X'00' 00304800 DC X'00000000000000000000003B3C3D3E3F' 00304900 DC X'30000000000000000000002B2C2D2E2F' 00305000 DC X'20110000000000000000001B1C1D1E1F' 00305100 DC X'201100000000000000000A0B0C0D0E0F' 00305200 DC 64X'00' 00305300 DC X'3A313233343536373839000000000000' 00305400 DC X'2A212223242526272829000000000000' 00305500 DC X'1A001213141516171819000000000000' 00305600 DC X'0A010203040506070809000000000000' 00305700 TRIE DC X'40F1F2F3F4F5F6F7F8F9F07B7C7D7E7F' 00305800 DC X'F061E2E3E4E5E6E7E8E9E06B6C6D6E6F' 00305900 DC X'60D1D2D3D4D5D6D7D8D9D05B5C5D5E5F' 00306000 DC X'50C1C2C3C4C5C6C7C8C9C04B4C4D4E4F' 00306100 DC X'40F1F2F3F4F5F6F7F8F9F07B7C7D7E7F' 00306200 DC X'F061E2E3E4E5E6E7E8E9E06B6C6D6E6F' 00306300 DC X'60D1D2D3D4D5D6D7D8D9D05B5C5D5E5F' 00306400 DC X'50C1C2C3C4C5C6C7C8C9C04B4C4D4E4F' 00306500 TR4IBC DC 16AL1(*-TR4IBC) 00306600 DC X'00' 00306700 DC 47AL1(*-TR4IBC) 00306800 TRI4BC DC X'10' 00306900 DC 63AL1(*-TRI4BC) 00307000 DC X'10' 00307100 DC 63AL1(*-64-TRI4BC) 00307200 TRGPWM DC 127X'00',X'7F',128X'00' 00307300 TRWDMK DC 64X'40' 00307400 DC 64C'1' 00307500 TYPTBL DC 129AL1(*-TYPTBL) 00307600 DC C'ABCDEFGHI' 00307700 DC XL7'00' 00307800 DC C'JKLMNOPQR' 00307900 DC XL8'00' 00308000 DC C'STUVWXYZ' 00308100 DC 86AL1(*-TYPTBL) 00308200 ORG TYPTBL+63 00308300 DC XL3'00' 00308400 ORG TYPTBL+256 00308500 TITLE 'LITERALS' 00308600 LTORG 00308700 TITLE 'TAPE DCBS' TAPEDCB0 DCB MACRF=(E),DSORG=PS,DDNAME=TP0 00246500 TAPEDCB1 DCB MACRF=(E),DSORG=PS,DDNAME=TP1 00246600 TAPEDCB2 DCB MACRF=(E),DSORG=PS,DDNAME=TP2 00246700 TAPEDCB3 DCB MACRF=(E),DSORG=PS,DDNAME=TP3 00246800 TAPEDCB4 DCB MACRF=(E),DSORG=PS,DDNAME=TP4 00246900 TAPEDCB5 DCB MACRF=(E),DSORG=PS,DDNAME=TP5 00247000 TAPEDCB6 DCB MACRF=(E),DSORG=PS,DDNAME=TP6 00247100 TAPEDCB7 DCB MACRF=(E),DSORG=PS,DDNAME=TP7 00247200 TAPEDCB8 DCB MACRF=(E),DSORG=PS,DDNAME=TP8 00247300 TAPEDCB9 DCB MACRF=(E),DSORG=PS,DDNAME=TP9 00247400 SIMCOR DSECT 00308800 DS CL16020 00308900 END BEGIN 00309000