*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