From ad4fcc278385d20f9503f2742e1d69ead0ae5dc4 Mon Sep 17 00:00:00 2001 From: moshix Date: Sat, 14 Oct 2017 17:33:30 +0300 Subject: [PATCH] IBM 1401 Emulator in BAL/360 --- a1401.txt | 2985 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2985 insertions(+) create mode 100644 a1401.txt diff --git a/a1401.txt b/a1401.txt new file mode 100644 index 0000000..24ddec9 --- /dev/null +++ b/a1401.txt @@ -0,0 +1,2985 @@ +//HERC01A JOB (BAL), +// '1401 EMULATOR', +// CLASS=A, +// MSGCLASS=H, +// TIME=1440,REGION=6M, +// MSGLEVEL=(1,1), +// USER=HERC01,PASSWORD=CUL8TR +//******************************************************************** +//* +//* Name: SYS2.JCLLIB(PRIMASM) +//* +//* Desc: Sieve of Eratosthenes programmed in Basic Assembler Language +//* All prime numbers up to the value entered via PARM.GO +//* are computed. +//* +//******************************************************************** +//A1401 EXEC ASMFCG,PARM.ASM=(OBJ,NODECK),MAC1='SYS2.MACLIB', +// REGION.GO=1228K,PARM.GO='/2000' +//**DDX DD DSN=HERC01.SIM1401, +//** VOL=SER=PUB001, +//** SPACE=(TRK,1), +//** DISP=(MOD,DELETE) +//**STEP2 EXEC PGM=IEBUPDTE,PARM=NEW,REGION=40K +//SYSPRINT DD SYSOUT=* +//**SYSUT2 DD DSN=HERC01.A1401, +//** VOL=SER=PUB001, +//** SPACE=(7200,40,RLSE), +//** DCB=(RECFM=FBS,BLKSIZE=7200,LRECL=80), +//** DISP=(NEW,CATLG) +//ASM.SYSIN DD * +* MODIFIED VERSION OF 360D-11.1.019 +* R.WEAVER, IBM-ARMONK NY, JUNE/JULY 1970 + SPACE +* L I M I T A T I O N S +* 1401 +* SUPPORTS EXPANDED PRINT EDIT ONLY +* ONLY THE FIRST 50 CHAR OF CONSOLE MSG'S ARE PRINTED +* JCL +* TAPEN DD'S MUST BE ASSIGNED TO TAPE UNITS, DISK CANNOT BE USED + SPACE +* PARM FORMAT IS 'ABCDEFGLLLX' +* WHERE +* A-G SENSE SWITCHES, N/F +* LLL LINES TO PRINT PER PAGE +* X PGM LOAD CARD OR TAPE, C/T + SPACE + SPACE +* THE FOLLOWING COMMENT BLOCK APPLIED TO THE ORIGINAL PROGRAM. +*********************************************************************** 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 + MACRO +&L MSG &M,&L2 + LCLC &A +&L BAL 4,WTO +&A SETC 'L''' + DC AL2(&A.&L2.-1) +&L2 DC C&M + MEND + SPACE + PRINT NOGEN 14010461 + START 0 00000100 + 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 +POS1 DC X'0' 00283500 +SAVB DS F 00283700 + 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'4' 00033600 + BE BL5BCH UNCONDITIONAL BRANCH 00033700 + CH 9,=H'8' 00033800 + BE BCE8 00033900 + CH 9,=H'1' 00034000 + BE BCE1A 00034100 + CH 9,=H'5' 00034200 + BH BL5BCH 00034300 + BL ILEGLN 00034400 + 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 +BL52 CLI PRTP12,1 00038400 + B BL5CKB 00038500 +BL5RER CLI RDRERR,1 00038600 + MVI RDRERR,0 00038700 + B BL5CKB 00038800 +BL5PER CLI PCHERR,1 00038900 + MVI PCHERR,0 00039000 +BL5P B NXTOP 00039100 +BL53 CLI PRTERR,1 Q/ PRINT ERROR 00039200 + MVI PRTERR,0 CLEAR ERROR INDICATOR 00039300 + B BL5CKB CHECK CONDITION CODE 00039400 +BL5CKB BNE NXTOP 00039500 +BL5BCH LA 6,1(10) 00039600 + B SETBCH SET CONDITIONS FOR BRANCH 00039700 +BCE8 CLI 4(10),0 Q/ IS FIFTH CHARACTER A BLANK 00039800 + BE BL5BCH YES, BRANCH 00039900 + LA 6,4(10) NO, TREAT AS BCE 00040000 + BAL 8,CVAD43 00040100 + LR 12,5 00040200 + LA 6,1(10) 00040300 + BAL 8,CVAD43 00040400 + LR 11,5 00040500 + MVC DCHAR,7(10) 00040600 +BCE1A MVC TEMP1(1),0(12) 00040700 + NI TEMP1,X'BF' 00040800 + CLC TEMP1,DCHAR COMPARE D CHARACTER TO CORE LOCATION 00040900 + BNE BCE1B 00041000 + LR 12,10 00041100 + AR 12,9 00041200 + ST 10,LSTBCH STORE LOCATION COUNTER BEFORE BRANCH 00041300 + LR 10,11 00041400 + LA 9,0 00041500 + B NXTOP 00041600 +BCE1B SH 12,=H'1' 00041700 + B NXTOP 00041800 +DCHARTBL DC A(BL5BCH),11A(NXTOP),A(BL52),4A(NXTOP),A(BL51,BL5S) 00041900 + DC A(BL5T,BL5U),4A(NXTOP),A(BL5Z,BL53),7A(NXTOP) 00042000 + DC A(BL5K,BL5L),3A(NXTOP),A(BL5P,NXTOP,BL5P,BL5PER) 00042100 + DC 6A(NXTOP),A(BL5A,BL5B,BL5C,BL5D,BL5E,BL5F,BL5G) 00042200 + DC 2A(NXTOP),A(BL5RER),5A(NXTOP) 00042300 + TITLE 'BRANCH ON WORD MARK / ZONE' 00042400 + USING BWZ,13 00042500 +BWZ CH 9,=H'1' 00042600 + BE BWZL1 00042700 + CH 9,=H'8' 00042800 + BNE ILEGLN 00042900 + LA 6,1(10) 00043000 + BAL 8,CVAD43 00043100 + LR 11,5 00043200 + LA 6,4(10) 00043300 + BAL 8,CVAD43 00043400 + LR 12,5 00043500 + MVC DCHAR(1),7(10) 00043600 +BWZL1 SH 12,=H'1' 00043700 + CLI DCHAR,X'01' 00043800 + BE BWZW 00043900 + CLI DCHAR,X'02' 00044000 + BE BWZ0 00044100 + CLI DCHAR,X'32' 00044200 + BE BWZBA 00044300 + CLI DCHAR,X'22' 00044400 + BE BWZB 00044500 + CLI DCHAR,X'12' 00044600 + BE BWZA 00044700 + CLI DCHAR,X'03' 00044800 + BE BWZW0 00044900 + CLI DCHAR,X'33' 00045000 + BE BWZWBA 00045100 + CLI DCHAR,X'23' 00045200 + BE BWZWB 00045300 + CLI DCHAR,X'13' 00045400 + BE BWZWA 00045500 + B ILEGOP 00045600 +BWZW TM 1(12),X'40' 00045700 + BO BWZBCH 00045800 + B NXTOP 00045900 +BWZ0 TM 1(12),X'30' 00046000 + BZ BWZBCH 00046100 + B NXTOP 00046200 +BWZBA TM 1(12),X'30' 00046300 + BO BWZBCH 00046400 + B NXTOP 00046500 +BWZB TM 1(12),X'20' 00046600 + BZ NXTOP 00046700 + TM 1(12),X'10' 00046800 + BO NXTOP 00046900 + B BWZBCH 00047000 +BWZA TM 1(12),X'20' 00047100 + BO NXTOP 00047200 + TM 1(12),X'10' 00047300 + BO BWZBCH 00047400 + B NXTOP 00047500 +BWZW0 TM 1(12),X'40' 00047600 + BO BWZBCH 00047700 + B BWZ0 00047800 +BWZWBA TM 1(12),X'40' 00047900 + BO BWZBCH 00048000 + B BWZBA 00048100 +BWZWB TM 1(12),X'40' 00048200 + BO BWZBCH 00048300 + B BWZB 00048400 +BWZWA TM 1(12),X'40' 00048500 + BO BWZBCH 00048600 + B BWZA 00048700 +BWZBCH ST 10,LSTBCH STORE LOCATION COUNTER BEFORE BRANCH 00048800 + LR 12,10 SET B-REG 00048900 + AR 12,9 * 00049000 + LR 10,11 SET LOCATION COUNTER FOR BRANCH 00049100 + LA 9,0 * 00049200 + B NXTOP 00049300 + TITLE 'COMPARE' 00049400 + USING C,13 00049500 +C CH 9,=H'1' 00049600 + BE CL1 00049700 + CH 9,=H'4' 00049800 + BE CL4 00049900 + CH 9,=H'7' 00050000 + BNE ILEGLN 00050100 + LA 6,4(10) 00050200 + BAL 8,CVAD43 00050300 + LR 12,5 00050400 + MVI TCPR,0 INITALIZE COMPARE RESULT TO EQUAL 14015045 +* (1401 RESETS WHEN B-ADDR LOADED) 14015046 +CL4 LA 6,1(10) CONVERT A-ADDR TO 360 FORMAT 00050500 + BAL 8,CVAD43 * 00050600 + LR 11,5 * 00050700 + CH 9,=H'4' Q/ IS INSTRUCTION 4 CHARACTERS 00050800 + BNE CL1 NO 00050900 + LR 12,11 YES, FORS 00051000 + LR 12,11 YES, FORCE B/ADDR = A/ADDR 00051100 +CL1 LA 4,0 14015130 + LA 0,1 00051400 +C1 SR 11,0 00051500 + SR 12,0 00051600 + TM 1(12),X'40' 00051700 + BO C2 00051800 + TM 1(11),X'40' 00051900 + BO C5 LONG B-FIELD 00052000 + LA 4,1(4) 00052100 + B C1 00052200 +C2 LR 5,11 00052300 + LR 6,12 00052400 + LA 4,1(4) 00052500 +C3 MVC TCR(1),1(6) 00052600 + MVC TCR+1(1),1(5) 00052700 + TR TCR(2),CPRTBL CONVERT DIGITS TO SORT SEQUENCE 00052800 + CLC TCR(1),TCR+1 00052900 + BH C5 00053000 + BL C6 00053100 + LA 5,1(5) 00053200 + LA 6,1(6) 00053300 + BCT 4,C3 00053400 +C4 CH 9,=H'1' 00053500 + BNE C4A 00053600 + CLI TCPR,0 00053700 + BE NXTOP 00053800 +C4A MVC CPR,TCPR 00053900 + B NXTOP 00054000 +C5 MVI TCPR,2 SET HIGH 00054100 + B C4 00054200 +C6 MVI TCPR,1 SET LOW 00054300 + B C4 00054400 +TCPR DC X'00' 00054500 +TCR DS CL2 00054600 +CPRTBL DC HL1'0,55,56,57,58,59,60,61,62,63,54,20,21,22,23,24' 00054700 + DC HL1'19,13,46,47,48,49,50,51,52,53,45,14,15,16,17,18' 00054800 + DC HL1'12,36,37,38,39,40,41,42,43,44,35,7,8,9,10,11' 00054900 + DC HL1'6,26,27,28,29,30,31,32,33,34,25,1,2,3,4,5' 00055000 + DC HL1'0,55,56,57,58,59,60,61,62,63,54,20,21,22,23,24' 00055100 + DC HL1'19,13,46,47,48,49,50,51,52,53,45,14,15,16,17,18' 00055200 + DC HL1'12,36,37,38,39,40,41,42,43,44,35,7,8,9,10,11' 00055300 + DC HL1'6,26,27,28,29,30,31,32,33,34,25,1,2,3,4,5' 00055400 + TITLE 'HALT' 00055500 + USING H,13 00055600 +H CH 9,=H'1' 00055700 + BE H1 00055800 + CH 9,=H'4' 00055900 + BE H1 00056000 + CH 9,=H'7' 00056100 + BNE ILEGLN 00056200 +H1 LR 5,10 CONVERT I ADDRESS 00056300 + BAL 8,H5 * 00056400 + MVC I003+12(6),HLTADARA MOVE I ADDR TO OUTPUT 06140 + MVC I003+21(6),=CL6' ' 06150 + MVC I003+30(6),=CL6' ' 06155 + CH 9,=H'7' Q/ IS THERE A B ADDRESS 00056700 + BL H2 NO 00056800 + LA 6,1(10) CONVERT 1401 ADDRESS 00056900 + BAL 8,CVAD43 * 00057000 + BAL 8,H5 * 00057100 + MVC I003+21(6),HLTADARA MOVE A ADDR TO OUTPUT 06210 + LA 6,4(10) CONVERT 1401 B ADDRESS 00057300 + BAL 8,CVAD43 * 00057400 + BAL 8,H5 * 00057500 + MVC I003+30(6),HLTADARA MOVE B ARRR YO OUTPUT + MSG 'I003 HALT I , A , B ',I003 + AIF ('&CONSOLE' EQ 'Y').HWTO2 +H2 B TERMINAT +.HWTO2 ANOP + CH 9,=H'4' 00057900 + BNE H3 00058000 + LA 6,1(10) 00058100 + BAL 8,CVAD43 00058200 + ST 5,ADR360 00058300 +H3 MVC RETURN,=A(H4) SET TO CONTINUE AFTER RESTART 00058400 + B WTORTN 00058500 +H4 CH 9,=H'4' Q/ BRANCH 00058600 + BNE NXTOP 00058700 + LR 12,10 00058800 + AR 12,9 00058900 + L 10,ADR360 00059000 + LA 9,0 00059100 + B NXTOP 00059200 +H5 SR 5,7 GET 1401 ADDRESS 00059300 + CVD 5,PAKT CONVERT TO DECIMAL 00059400 + UNPK HLTADARA(6),PAKT+5(3) UNPACK 1401 ADDRESS 00059500 + OI HLTADARA+5,X'F0' MAKE SIGN NUMERIC 00059600 + LA 1,HLTADARA BLANK LEADING ZEROS 00059700 +H6 CLI 0(1),C'0' * 00059800 + BCR 6,8 * 00059900 + MVI 0(1),X'40' * 00060000 + LA 1,1(1) * 00060100 + B H6 * 00060200 +HLTADARA DC CL6' ' 00060300 + TITLE 'CLEAR STORAGE' 00060400 + USING CS,13 00060500 +CS CH 9,=H'1' 00060600 + BE CSL1 00060700 + CH 9,=H'4' 00060800 + BE CSL4 00060900 + CH 9,=H'7' 00061000 + BL ILEGLN 00061100 + MVC HLDBCH(3),1(10) 00061200 + LA 6,4(10) 00061300 + B CSCOM 00061400 +CSL4 LA 6,1(10) 00061500 +CSCOM BAL 8,CVAD43 00061600 + LR 12,5 00061700 +CSL1 LR 3,12 00061800 + SR 3,7 SUBTRACT SIMULATED CORE BASE LOCATION 00061900 + LA 2,0 00062000 + D 2,=F'100' 00062100 + SR 12,2 00062200 + STC 2,CSL1A+1 00062300 +CSL1A XC 0(0,12),0(12) CLEAR CORE BLOCK 00062400 + CR 12,7 Q/ DID B-REG GO TO 0 00062500 + BNE CS2 NO 00062600 + L 12,=F'15999' 00062700 + AR 12,7 00062800 + B CS3 * 00062900 +CS2 SH 12,=H'1' SUBTRACT 1 FROM B-REG 00063000 +CS3 CH 9,=H'7' Q/ IS THERE A BRANCH 00063100 + BL NXTOP 00063200 + LA 6,HLDBCH 00063300 + B SETBCH 00063400 +HLDBCH DS CL3 00063500 + TITLE 'SET WORD MARK' 00063600 + USING SW,13 00063700 +SW CH 9,=H'6' 00063800 + BNL SWL7 00063900 + CH 9,=H'4' 00064000 + BE SWL4 00064100 + CH 9,=H'1' 00064200 + BE SWL1 00064300 + B ILEGLN 00064400 +SWL4 LA 6,1(10) 00064500 + BAL 8,CVAD43 00064600 + LR 11,5 00064700 + OI 0(11),X'40' 00064800 + SH 11,=H'1' 00064900 + LR 12,11 00065000 + B NXTOP 00065100 +SWL7 LA 6,1(10) 00065200 + BAL 8,CVAD43 00065300 + LR 11,5 00065400 + LA 6,4(10) 00065500 + BAL 8,CVAD43 00065600 + LR 12,5 00065700 +SWL1 OI 0(11),X'40' 00065800 + OI 0(12),X'40' 00065900 + SH 11,=H'1' 00066000 + SH 12,=H'1' 00066100 + CH 9,=H'7' 00066200 + BNH NXTOP 00066300 + LA 9,7 00066400 + B NXTOP 00066500 + TITLE 'CLEAR WORD MARK' 00066600 + USING CW,13 00066700 +CW CH 9,=H'6' 00066800 + BNL CWL7 00066900 + CH 9,=H'4' 00067000 + BE CWL4 00067100 + CH 9,=H'1' 00067200 + BE CWL1 00067300 + B ILEGLN 00067400 +CWL4 LA 6,1(10) 00067500 + BAL 8,CVAD43 00067600 + LR 11,5 00067700 + NI 0(11),X'BF' 00067800 + SH 11,=H'1' 00067900 + LR 12,11 00068000 + B NXTOP 00068100 +CWL7 LA 6,1(10) 00068200 + BAL 8,CVAD43 00068300 + LR 11,5 00068400 + LA 6,4(10) 00068500 + BAL 8,CVAD43 00068600 + LR 12,5 00068700 +CWL1 NI 0(11),X'BF' 00068800 + NI 0(12),X'BF' 00068900 + SH 11,=H'1' 00069000 + SH 12,=H'1' 00069100 + B NXTOP 00069200 + TITLE 'MOVE CHARACTERS TO A WORD MARK' 00069300 + USING MCW,13 00069400 +MCW CH 9,=H'7' 00069500 + BE MCWL7 00069600 + CH 9,=H'4' 00069700 + BE MCWL4 00069800 + CH 9,=H'1' 00069900 + BE MCWL1 00070000 + CH 9,=H'8' 00070100 + BE MCW8 00070200 + B ILEGLN 00070300 +MCWL7 LA 6,4(10) 00070400 + BAL 8,CVAD43 00070500 + LR 12,5 00070600 +MCWL4 LA 6,1(10) 00070700 + BAL 8,CVAD43 00070800 + LR 11,5 00070900 +MCWL1 LA 0,1 00071000 +MCWL1B MVC MCWL1A+1(1),0(11) 00071100 + NI MCWL1A+1,X'3F' 00071200 + NI 0(12),X'40' 00071300 +MCWL1A OI 0(12),0 00071400 + SR 11,0 00071500 + SR 12,0 00071600 + TM 1(11),X'40' 00071700 + BO NXTOP 00071800 + TM 1(12),X'40' 00071900 + BZ MCWL1B 00072000 + B NXTOP 00072100 +MCW8 MVC DCHAR(1),7(10) 00072200 + CLI DCHAR,X'29' 00072300 + BE RT 00072400 + CLI DCHAR,X'16' 00072500 + BE CHKCON + CLI DCHAR,X'31' 00072700 + BE MBD 00072800 + CLI DCHAR,X'32' 00072900 + BE MBD 00073000 + B ILEGOP 00073100 +CHKCON CLI 2(10),X'13' CHECK FOR T IN + BE CONSOLE M%T0XXXW INST + B WT +* 00073200 +* READ TAPE WITHOUT WORD MARKS 00073300 +* 00073400 + AIF ('&TAPE' EQ 'N').NOTRD +RT LA 6,4(10) CONVERT CORE LOCATION FOR TAPE READ 00073500 + BAL 8,CVAD43 * 00073600 + LR 12,5 * 00073700 + BAL 8,FNDRIV GET DEVICE ADDRESS 00073800 + MVI RTCCW,X'A3' SET PARITY IN MODE SET COMMAND 00073900 + MVI BCDTAP,1 * 00074000 + TM 2(10),X'14' * 00074100 + BO RT1 * 00074200 + MVI RTCCW,X'B3' * 00074300 + MVI BCDTAP,0 SET BINARY 00074400 +RT1 ST 3,TMDCB 00074500 + MVC TPCCW,=A(RTCCW) 00074600 + STM 13,15,MACREGSV SAVE MACRO REGS 00074700 + LA 6,MACREGSV SAVE ADDRESS TO XR 00074800 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00074900 + EXCP TMIOB 00075000 + LM 14,15,4(6) RESTORE REG 14 AND 15 00075100 + WAIT 1,ECB=TMECB WAIT FOR I/O 00075200 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00075300 + BAL 8,TPTEST 00075400 + BAL 8,FNDLNG FIND LENGTH OF B-FIELD 00075500 + LR 3,6 * 00075600 + L 1,TAPEAREA SET SENDING ADDRESS 00075700 + LH 5,SAVCSW+6 FIND NUMBER OF BYTES READ 00075800 + LH 4,=H'25000' * 00075900 + SR 4,5 * 00076000 + CR 3,4 USE SMALLER FIELD 00076100 + BNH RT3 * 00076200 + LR 3,4 * 00076300 +RT3 CH 3,=H'256' Q/ MORE THAN 256 BYTES 00076400 + BNH RT4 NO 00076500 + NC 0(256,12),WM256 YES, MOVE 256 BYTES 00076600 + CLI BCDTAP,1 * 00076700 + BNE RT3A * 00076800 + TR 0(256,1),TR4IBC * 00076900 +RT3A OC 0(256,12),0(1) * 00077000 + LA 1,256(1) * 00077100 + LA 12,256(12) * 00077200 + SH 3,=H'256' * 00077300 + B RT3 * 00077400 +RT4 SH 3,=H'1' MOVE REMAINING BYTES 00077500 + STC 3,RT5+1 * 00077600 + STC 3,RT6+1 * 00077700 + STC 3,RT7+1 * 00077800 +RT5 NC 0(0,12),WM256 * 00077900 + CLI BCDTAP,1 * 00078000 + BNE RT7 * 00078100 +RT6 TR 0(0,1),TR4IBC * 00078200 +RT7 OC 0(0,12),0(1) * 00078300 + AR 12,3 SET GROUP MARK AFTER DATA 00078400 + NI 1(12),X'40' * 00078500 + OI 1(12),X'3F' * 00078600 + LA 12,2(12) SET B-ADDRESS 00078700 + B NXTOP END OF TAPE READ INSTRUCTION 00078800 +* 00078900 +* WRITE TAPE WITHOUT WORD MARKS 00079000 +* 00079100 +WT LA 6,4(10) 00079200 + BAL 8,CVAD43 00079300 + LR 12,5 00079400 + BAL 8,FNDLNG 00079500 + STH 6,WTCCW2+6 STORE LENGTH IN CCW 00079600 + LR 4,12 00079700 + AR 12,6 SET B-ADDRESS 00079800 + LA 12,1(12) * 00079900 + L 3,TAPEAREA 00080000 + MVI WTCCW1,X'A3' SET BCD MODE 00080100 + MVI BCDTAP,1 * 00080200 + CLI 2(10),X'14' Q/ IS INSTRUCTION BCD 00080300 + BE WT1 YES 00080400 + MVI WTCCW1,X'B3' NO, SET BINARY MODE 00080500 + MVI BCDTAP,0 * 00080600 +WT1 CH 6,=H'256' 00080700 + BNH WT2 00080800 + MVC 0(256,3),0(4) 00080900 + CLI BCDTAP,1 Q/ BCD 00081000 + BNE WT1A NO 00081100 + TR 0(256,3),TRI4BC YES, CHANGE X'00' TO X'10' FOR TAPE 00081200 +WT1A LA 3,256(3) UP REG 3 BY 256 00081300 + LA 4,256(4) 00081400 + SH 6,=H'256' 00081500 + B WT1 00081600 +WT2 STC 6,WT3+1 00081700 + STC 6,WT4+1 00081800 +WT3 MVC 0(0,3),0(4) 00081900 + CLI BCDTAP,1 Q/ BCD 00082000 + BNE WT4A NO 00082100 +WT4 TR 0(0,3),TRI4BC YES, CHANGE X'00' TO X'10' FOR TAPE 00082200 +WT4A BAL 8,FNDRIV GET DEVICE ADDRESS 00082300 + ST 3,TMDCB 00082400 + MVC TPCCW,=A(WTCCW1) 00082500 + STM 13,15,MACREGSV SAVE MACRO REGS 00082600 + LA 6,MACREGSV SAVE ADDRESS TO XR 00082700 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00082800 + EXCP TMIOB 00082900 + LM 14,15,4(6) RESTORE REG 14 AND 15 00083000 + WAIT 1,ECB=TMECB WAIT FOR I/O 00083100 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00083200 + BAL 8,TPTEST 00083300 + B NXTOP 00083400 +.NOTRD ANOP + AIF ('&TAPE' EQ 'Y').RTOK +RT B ILEGOP +WT B ILEGOP +.RTOK ANOP + SPACE + AIF ('&MB' EQ 'N').NOMB +MBD LA 6,1(10) 00083500 + BAL 8,CVAD43 00083600 + LR 11,5 00083700 + LA 6,4(10) 00083800 + BAL 8,CVAD43 00083900 + LR 12,5 00084000 + LA 0,1 00084100 + LR 6,12 00084200 + SH 6,=H'100' 00084300 + CLI DCHAR,X'32' 00084400 + BE MBC 00084500 + LR 6,11 00084600 + SH 6,=H'100' 00084700 +MBD1 IC 3,0(11) 00084800 + STC 3,MBD2+1 00084900 + NI MBD2+1,X'BF' 00085000 + NI 0(12),X'40' 00085100 +MBD2 OI 0(12),0 00085200 + SR 12,0 00085300 + IC 3,0(6) 00085400 + STC 3,MBD3+1 00085500 + NI MBD3+1,X'BF' 00085600 + NI 0(12),X'40' 00085700 +MBD3 OI 0(12),0 00085800 + SR 12,0 00085900 + SR 11,0 00086000 + SR 6,0 00086100 + TM 1(6),X'40' 00086200 + BC 8,MBD1 00086300 + B NXTOP 00086400 +MBC IC 3,0(11) 00086500 + STC 3,MBC1+1 00086600 + NI MBC1+1,X'BF' 00086700 + NI 0(12),X'40' 00086800 +MBC1 OI 0(12),0 00086900 + SR 11,0 00087000 + IC 3,0(11) 00087100 + STC 3,MBC2+1 00087200 + NI MBC2+1,X'BF' 00087300 + NI 0(6),X'40' 00087400 +MBC2 OI 0(6),0 00087500 + SR 12,0 00087600 + SR 11,0 00087700 + SR 6,0 00087800 + TM 1(6),X'40' 00087900 + BO NXTOP 00088000 + TM 1(12),X'40' 00088100 + BZ MBC 00088200 + B NXTOP 00088300 +.NOMB AIF ('&MB' EQ 'Y').YESMB +MBD B ILEGOP +.YESMB ANOP + SPACE +CONSOLE CH 9,=H'8' + BNE ILEGLN + LA 6,4(10) + BAL 8,CVAD43 CONVERT B ADDR + LR 12,5 + TRT 0(50,5),TRGPWM 09630 + BC 6,CONSOLE1 + L 1,=F'49' 09650 + B CLRMSG +CONSOLE1 SR 1,5 +CLRMSG MVI CON,C' ' BLANK MSG AREA 09680 + MVC CON+1(49),CON 09690 + EX 1,MV 09600 + EX 1,TRAN 09610 + MSG ' ',CON 09740 + B NXTOP +TRAN TR CON(0),TRIE 09800 +MV MVC CON(0),0(12) 09810 + TITLE 'MOVE CHARACTERS AND SUPPRESS LEADING ZEROS' 00088400 + USING MCS,13 00088500 +MCS CH 9,=H'1' 00088600 + BE MCSL1 00088700 + CH 9,=H'7' 00088800 + BE MCSL7 00088900 + CH 9,=H'4' 00089000 + BNE ILEGLN 00089100 + LA 6,1(10) 00089200 + BAL 8,CVAD43 00089300 + LR 11,5 00089400 + LR 12,5 00089500 + B MCSL1 00089600 +MCSL7 LA 6,1(10) 00089700 + BAL 8,CVAD43 00089800 + LR 11,5 00089900 + LA 6,4(10) 00090000 + BAL 8,CVAD43 00090100 + LR 12,5 00090200 +MCSL1 LA 0,1 00090300 + MVI SUPRES,1 00090400 + IC 3,0(11) MOVE ONLY DIGIT OF FIRST CHARACTER 00090500 + STC 3,0(12) * 00090600 + NI 0(12),X'0F' * 00090700 + STC 3,TEMP1 SAVE A-CHARACTER 00090800 + OI 0(12),X'40' SET WORD MARK TO STOP REVERSE SCAN 00090900 + B MCSL1B 00091000 +MCSL1A IC 3,0(11) MOVE CHARACTER 00091100 + STC 3,0(12) * 00091200 + STC 3,TEMP1 SAVE A-CHARACTER 00091300 + NI 0(12),X'3F' * 00091400 +MCSL1B SR 11,0 00091500 + SR 12,0 00091600 + TM TEMP1,X'40' Q/ END OF A-FIELD 00091700 + BZ MCSL1A NO 00091800 + LA 12,1(12) YES 00091900 +MCSL1C MVC TEMP1(1),0(12) 00092000 + NI TEMP1,X'3F' 00092100 + CLI SUPRES,1 Q/ IS ZERO SUPPRESSION ON 00092200 + BE MCSL1G YES 00092300 + CLI TEMP1,X'0A' NO, IS IT SIGNIFICANT DIGIT,BLANK 0 00092400 + BNH MCSL1E YES 00092500 + CLI TEMP1,X'1B' Q/ COMMA 00092600 + BE MCSL1E YES 00092700 + CLI TEMP1,X'20' Q/ HYPHEN 00092800 + BE MCSL1E YES 00092900 + MVI SUPRES,1 TURN ON ZERO SUPRESSION 00093000 +MCSL1E TM 0(12),X'40' Q/ LAST DIGIT 00093100 + BO MCSL1F YES 00093200 + LA 12,1(12) NO, PROCESS NEXT DIGIT 00093300 + B MCSL1C * 00093400 +MCSL1F NI 0(12),X'BF' CLEAR WORD MARK 00093500 + LA 12,1(12) SET B-ADDRESS 00093600 + B NXTOP GET NEXT INSTRUCTION 00093700 +MCSL1G CLI 0(12),X'09' Q/ SIGNIFICANT DIGIT 00093800 + BH MCSL1H * 00093900 + CLI 0(12),X'00' * 00094000 + BE MCSL1H * 00094100 + MVI SUPRES,0 YES, TURN OFF ZERO SUPPRESSION 00094200 + B MCSL1E * 00094300 +MCSL1H CLI TEMP1,X'00' Q/ BLANK 00094400 + BE MCSL1I BLANK 00094500 + CLI TEMP1,X'0A' Q/ ZERO 00094600 + BE MCSL1I ZERO 00094700 + CLI TEMP1,X'1B' Q/ COMMA 00094800 + BNE MCSL1E NO 00094900 +MCSL1I NI 0(12),X'40' 00095000 + B MCSL1E 00095100 + TITLE 'MOVE NUMERIC' 00095200 + USING MN,13 00095300 +MN CH 9,=H'1' 00095400 + BE MNL1 00095500 + CH 9,=H'4' 00095600 + BE MNL4 00095700 + CH 9,=H'7' 00095800 + BNE ILEGLN 00095900 + LA 6,4(10) 00096000 + BAL 8,CVAD43 00096100 + LR 12,5 00096200 +MNL4 LA 6,1(10) 00096300 + BAL 8,CVAD43 00096400 + LR 11,5 00096500 + CH 9,=H'4' 00096600 + BNE MNL1 00096700 + LR 12,11 4 CHARACTERS, SET B ADR = A ADR 00096800 +MNL1 MVN 0(1,12),0(11) MOVE NUMERIC 00096900 + SH 11,=H'1' 00097000 + SH 12,=H'1' 00097100 + B NXTOP 00097200 + TITLE 'MOVE ZONE' 00097300 + USING MZ,13 00097400 +MZ CH 9,=H'1' 00097500 + BE MZL1 00097600 + CH 9,=H'7' 00097700 + BNE ILEGLN 00097800 + LA 6,1(10) 00097900 + BAL 8,CVAD43 00098000 + LR 11,5 00098100 + LA 6,4(10) 00098200 + BAL 8,CVAD43 00098300 + LR 12,5 00098400 +MZL1 IC 3,0(11) 00098500 + STC 3,MZL1A+1 00098600 + NI 0(12),X'CF' 00098700 + NI MZL1A+1,X'30' 00098800 +MZL1A OI 0(12),0 00098900 + SH 11,=H'1' 00099000 + SH 12,=H'1' 00099100 + B NXTOP 00099200 + TITLE 'LOAD CHARACTERS TO AN A-FIELD WORD MARK' 00099300 + USING LCA,13 00099400 +LCA CH 9,=H'7' 00099500 + BE LCAL7 00099600 + CH 9,=H'4' 00099700 + BE LCAL4 00099800 + CH 9,=H'1' 00099900 + BE LCAL1 00100000 + CH 9,=H'8' 00100100 + BE LCA8 00100200 + B ILEGLN 00100300 +LCAL7 LA 6,4(10) 00100400 + BAL 8,CVAD43 00100500 + LR 12,5 00100600 +LCAL4 LA 6,1(10) 00100700 + BAL 8,CVAD43 00100800 + LR 11,5 00100900 +LCAL1 LA 0,1 00101000 +LCAL1A IC 3,0(11) 00101100 + STC 3,0(12) 00101200 + SR 11,0 00101300 + SR 12,0 00101400 + TM 1(11),X'40' 00101500 + BZ LCAL1A 00101600 + B NXTOP 00101700 +LCA8 CLI 7(10),X'29' 00101800 + BE RTW 00101900 + CLI 7(10),X'16' 00102000 + BE WTW 00102100 + B ILEGOP 00102200 +* 00102300 +* READ TAPE WITH WORD MARKS 00102400 +* 00102500 + AIF ('&TAPE' EQ 'N').NOTWT +RTW LA 6,4(10) 00102600 + BAL 8,CVAD43 00102700 + LR 12,5 00102800 + BAL 8,FNDRIV 00102900 + MVI RTCCW,X'A3' LOAD MODE SET COMMAND 00103000 + ST 3,TMDCB 00103100 + MVC TPCCW,=A(RTCCW) 00103200 + STM 13,15,MACREGSV SAVE MACRO REGS 00103300 + LA 6,MACREGSV SAVE ADDRESS TO XR 00103400 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00103500 + EXCP TMIOB 00103600 + LM 14,15,4(6) RESTORE REG 14 AND 15 00103700 + WAIT 1,ECB=TMECB WAIT FOR I/O 00103800 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00103900 + BAL 8,TPTEST 00104000 + LH 3,SAVCSW+6 FIND NUMBER OF BYTES READ 00104100 + LH 4,=H'25000' * 00104200 + SR 4,3 00104300 + L 1,TAPEAREA SET SENDING ADDRESS 00104400 +RTW1 CLI 0(12),X'7F' Q/ GP MK - WD MK IN CORE 00104500 + BE RTW3 YES 00104600 + CLI 0(1),X'1D' Q/ WORD SEPARATOR 00104700 + BNE RTW2 NO 00104800 + LA 1,1(1) YES 00104900 + IC 3,0(1) 00105000 + STC 3,0(12) 00105100 + TR 0(1,12),TR4IBC 00105200 + OI 0(12),X'40' 00105300 + SH 4,=H'1' 00105400 + B RTW2A 00105500 +RTW2 IC 3,0(1) 00105600 + STC 3,0(12) 00105700 + TR 0(1,12),TR4IBC 00105800 +RTW2A LA 1,1(1) 00105900 + LA 12,1(12) 00106000 + BCT 4,RTW1 00106100 + CLI 0(12),X'7F' RECORD MOVED, IS GROUP MARK NEXT CHAR 00106200 + BE RTW3 YES, LEAVE IT ALONE 00106300 + MVI 0(12),X'3F' NO, MOVE IN A GROUP MARK 00106400 +RTW3 LA 12,1(12) SET B-ADDRESS 00106500 + B NXTOP 00106600 +* 00106700 +* WRITE TAPE WITH WORD MARKS 00106800 +* 00106900 +WTW LA 6,4(10) 00107000 + BAL 8,CVAD43 00107100 + LR 12,5 00107200 + L 1,TAPEAREA 00107300 + LR 2,12 00107400 +WTW1 TM 0(2),X'7F' Q/ GROUP MARK WORD MARK 00107500 + BO WTW3 YES, FIELD DONE 00107600 + TM 0(2),X'40' Q/ WORD MARK 00107700 + BZ WTW2 NO 00107800 + MVI 0(1),X'1D' YES, INSERT WORD SEPARATOR 00107900 + LA 1,1(1) * 00108000 +WTW2 MVC 0(1,1),0(2) 00108100 + TR 0(1,1),TRI4BC 00108200 + LA 1,1(1) 00108300 + LA 2,1(2) 00108400 + B WTW1 00108500 +WTW3 S 1,TAPEAREA 00108600 + STH 1,WTCCW2+6 00108700 + MVI WTCCW1,X'A3' 00108800 + BAL 8,FNDRIV 00108900 + ST 3,TMDCB 00109000 + MVC TPCCW,=A(WTCCW1) 00109100 + STM 13,15,MACREGSV SAVE MACRO REGS 00109200 + LA 6,MACREGSV SAVE ADDRESS TO XR 00109300 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00109400 + EXCP TMIOB 00109500 + LM 14,15,4(6) RESTORE REG 14 AND 15 00109600 + WAIT 1,ECB=TMECB WAIT FOR I/O 00109700 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00109800 + BAL 8,TPTEST 00109900 + LA 12,1(2) 00110000 + B NXTOP 00110100 +.NOTWT ANOP + AIF ('&TAPE' EQ 'Y').WTOK +RTW B ILEGOP +WTW B ILEGOP +.WTOK ANOP + TITLE 'MOVE CHARACTERS AND EDIT' 00110200 + USING MCE,13 00110300 +MCE CH 9,=H'7' Q/ IS LENGTH CORRECT 00110400 + BNE ILEGLN NO 00110500 + LA 6,1(10) YES, CONVERT ADDRESSES 00110600 + BAL 8,CVAD43 * 00110700 + LR 11,5 * 00110800 + LA 6,4(10) * 00110900 + BAL 8,CVAD43 * 00111000 + LR 12,5 * 00111100 + LA 0,1 00111200 + MVI AEND,0 CLEAR A-FIELD END INDICATOR 00111300 + MVI BODY,0 CLEAR BODY TRIGGER 00111400 + MVI SUPRES,0 CLEAR ZERO SUPPRESSION INDICATOR 00111500 + MVI FLOAT,0 CLEAR FLOATING DOLLAR SIGN INDICATOR 00111600 + MVI SIGDIG,0 CLEAR SIGNIFICANT DIGIT IND 00111700 + MVI ASTER,0 CLEAR ASTERISK PROTECTION IND 00111800 + MVI AMINUS,0 CLEAR A-FIELD MINUS INDICATOR 00111900 + MVI DECIMAL,0 DECIMAL POINT INDICATOR 00112000 + MVI FIRSTDOL,0 CLEAR $ INFIRST CHAR INDICATOR 00112100 + MVI SIGNDOL,0 CLEAR DOLLAR SIGN INDICATOR 00112200 + IC 2,0(11) Q/ A-FIELD MINUS 00112300 + N 2,=F'48' 00112400 + CH 2,=H'32' 00112500 + BNE MCE1 NO 00112600 + MVI AMINUS,1 YES,SET A-FIELD MINUS INDICATOR 00112700 +MCE1 IC 1,0(12) SAVE B-FIELD CHARACTER 00112800 + STC 1,TEMP1 * 00112900 + NI 0(12),X'3F' CLEAR WORD MARK 00113000 + CLI 0(12),X'3B' Q/ DECIMAL POINT 00113100 + BNE MCE1A NO 00113200 + MVI DECIMAL,1 YES,SET DECIMAL INDICATOR 00113300 + ST 12,DECADD STORE ADDRESS OF DECIMAL POINT 00113400 +MCE1A CLI 0(12),X'00' Q/ BLANK 00113500 + BE MCE6 YES 00113600 + CLI 0(12),X'0A' Q/ ZERO 00113700 + BE MCE6 YES 00113800 + CLI 0(12),X'30' Q/ AMPERSAND 00113900 + BE MCE3 YES 00114000 + CLI BODY,1 Q/ BODY TRIGGER ON 00114100 + BE MCE3A YES 00114200 + CLI 0(12),X'1B' Q/ COMMA 00114300 + BE MCE3 YES 00114400 + CLI 0(12),X'33' Q/ C 00114500 + BE MCE2 YES 00114600 + CLI 0(12),X'29' Q/ R 00114700 + BE MCE2 YES 00114800 + CLI 0(12),X'20' Q/ - 00114900 + BNE MCE3A NO 00115000 +MCE2 CLI AMINUS,1 Q/ A-FIELD MINUS 00115100 + BE MCE3A YES 00115200 +MCE3 MVI 0(12),X'00' MOVE BLANK TO B-FIELD 00115300 + SR 12,0 DECREMENT B-FIELD 00115400 + B MCE5 00115500 +MCE3A CLI 0(12),X'2C' Q/ * 00115600 + BNE MCE3B NO 00115700 + CLI BODY,1 Q/ BODY TRIGGER ON 00115800 + BNE MCE3B NO 00115900 + MVI ASTER,1 SET ASTERISK PRORECTION INDICATOR 00116000 + B MCE6 00116100 +MCE3B CLI 0(12),X'2B' Q/ DOLLAR SIGN 00116200 + BNE MCE5C NO 14021910 + MVI SIGNDOL,1 SET DOLLAR SIGN INDICATOR 14022020 + ST 12,DOLSIGN STORE ADDRESS OF DOLLAR SIGN 00117500 + TM 1(12),X'40' Q/ FLOATING DOLLAR SIGN 00117600 + BZ MCE5A 00117700 + MVI FLOAT,1 00117800 + MVC 0(1,12),0(11) 00117900 + B MCE4A 00118000 +MCE6 CLI AEND,1 Q/ HAS A-FIELD ALREADY ENDED 00118100 + BE MCE3 YES 00118200 + MVC 0(1,12),0(11) MOVE CHARACTER 00118300 + NI 0(12),X'3F' * 00118400 + CLI 0(12),X'00' BLANK 00118500 + BE MCE6A YES 00118600 + CLI 0(12),X'09' DIGIT 00118700 + BH MCE6A NO 00118800 + MVI SIGDIG,1 YES SET SIG DIGIT INDICATOR 00118900 +MCE6A CLI BODY,1 Q/ BODY TRIGGER ON 00119000 + CLI BODY,1 Q/ IS BODY TRIGGER ON 00119100 + BE MCE7 YES 00119200 + MVI BODY,1 NO 00119300 + ST 12,LASTDIG STORE ADDRESS OF LOW ORDER DIGIT 00119400 + NI 0(12),X'0F' REMOVE ZONE 00119500 +MCE7 TM TEMP1,X'0A' Q/ IS DIGIT ZERO 00119600 + BC 12,MCE4A NO 00119700 + TM TEMP1,X'35' 00119800 + BC 5,MCE4A NO 00119900 + OI 0(12),X'40' YES, SET ZERO SUPPRESSION WORD MARK 00120000 + ST 12,ZEROSUP STORE ZERO SUPPRESSION ADDRESS 00120100 + MVI SUPRES,1 SET ZERO SUPPRESSION INDICATOR 00120200 + B MCE4A INDICATOR 00120300 + SPACE +MCE5C SR 12,0 DECREMENT B-FIELD + B MCE5 +MCE4A SR 11,0 +MCE5A SR 12,0 + TM 1(11),X'40' Q/ END OF A-FIELD + BZ MCE5 NO + MVI AEND,1 YES, SET A-FIELD ENDED INDICATOR +MCE5 TM TEMP1,X'40' Q/ END OF B-FIELD + BZ MCE1 NO +* E N D O F 1 S T F O R W A R D S C A N + SPACE + CLI SUPRES,1 Q/ WAS THERE ZERO SUPPRESSION 14022320 + BNE NXTOP NO, GET NEXT INSTRUCTION 00120500 + MVI FIRST,1 SET FIRST CHARACTER OF SCAN INDICATOR 00120600 + LA 12,1(12) 00120700 + CLI 0(12),X'2B' DOLLAR SIGN 00120800 + BNE MCE8A 00120900 + MVI FIRSTDOL,1 YES 00121000 +MCE8A MVC TEMP1(1),0(12) SAVE CHARACTER 00121100 + NI 0(12),X'3F' CLEAR WORD MARK 00121200 + CLI 0(12),X'00' Q/ BLANK 00121300 + BE MCE9 YES 00121400 + CLI 0(12),X'0A' Q/ ZERO 00121500 + BE MCE11 YES 00121600 + CLI 0(12),X'09' Q/ SIGNIFICANT DIGIT 00121700 + BH MCE9 NO 00121800 + MVI SUPRES,0 TURN OFF ZERO SUPPRESSION 00121900 + MVI SIGDIG,1 SET SIGNIFICANT DIGIT INDICATOR 00122000 + B MCE10 00122100 +MCE9 CLI 0(12),X'1B' Q/ COMMA 00122200 + BE MCE11 YES 00122300 + CLI 0(12),X'20' Q/ - 00122400 + BNE MCE10C NO 14022530 + CLI FIRST,1 Q/ FIRST CHARACTER IN STRING 14022535 + BNE MCE10 NO 14022540 + CLI AMINUS,1 Q/ A-FIELD MINUS 14022550 + BE MCE10 14022560 + MVI 0(12),X'00' NO,BLANK MINUS SIGN 14022565 + B MCE10 14022570 + SPACE 14022575 +MCE10C CLC 0(2,12),=X'3329' Q/ CR SYMBOL 14022580 + BNE MCE10 NO 14022585 + CLI SUPRES,1 Q/ ZERO SUPPRESSION ON 14022590 + BNE MCE10 NO 14022595 + CLI FIRST,1 Q/ 1ST CHARACTER IN STRING 14022600 + BE MCE14 YES 14022605 + MVC 0(2,12),=C' ' NO,BLANK CR 14022610 + B MCE10 14022615 +MCE14 CLI AMINUS,1 Q/ A-FIELD MINUS 14022620 + BE MCE10A YES 14022625 + MVC 0(2,12),=C' ' NO,BLANK CR 14022630 + B MCE10 14022640 +MCE10A LA 12,1(12) 14022644 + B MCE10 14022645 + SPACE 14022650 +MCE11 CLI SUPRES,1 Q/ ZERO SUPPRESSION ON 00124100 + BNE MCE10 NO 00124200 + MVI 0(12),X'00' YES, BLANK CHARACTER 00124300 + CLI FIRST,1 Q/ FIRST CHARACTER IN STRING 00124400 + BE MCE12 YES 00124500 + CLI ASTER,1 Q/ ASTERISK PROTECTION ON 00124600 + BNE MCE10 NO 00124700 + MVI 0(12),X'2C' YES, INSERT ASTERISK 00124800 + B MCE10 00124900 +MCE12 CLI AMINUS,1 Q/ A-FIELD MINUS 00125000 + BE MCE10 YES 00125100 + MVI 0(12),X'00' NO,BLANK CHARACTER 00125200 + SPACE 14022810 +MCE10 LA 12,1(12) 14022880 + MVI FIRST,0 TURN OFF FIRST TIME INDICATOR 14022890 + TM TEMP1,X'40' Q/ W/RD MARK 14022900 + BNO MCE8A NO, PROCESS NEXT DIGIT 14022910 +* E N D O F R E V E R S E S C A N 14022920 + SPACE 14022930 +FLDOL CLI FLOAT,1 Q/ FLOATING DOLLAR SIGN 00126600 + BNE DECON NO, GO TO DECIMAL CONTR 00126700 +DOLLAR CLI 0(12),X'00' Q/ BLANK 00126800 + BNE MOVDOL NO,GO TO NEXT POSITION IN B-FIELD 00126900 + MVI 0(12),X'2B' MOVE DOLLAR SIGN INTO B-FIELD 00127000 + B DECON 00127100 +MOVDOL SR 12,0 DECREMENT B-FIELD 00127200 + B DOLLAR 00127300 +DECON CLI DECIMAL,1 IS DECIMAL CONTROL NEEDED 00127400 + BNE NXTOP NO 00127500 + CLI SIGDIG,1 Q/ SIGNIFICANT DIGIT 00127600 + BE NXTOP YES 14023050 + L 5,LASTDIG 14023120 + CLC DECADD,ZEROSUP 00128500 + BH MCE16A 00128600 + L 4,DECADD 00128700 + B MCE16B 00128800 +MCE16A L 4,ZEROSUP 00128900 +MCE16B SR 5,4 00129000 + AH 5,=H'1' 00129100 +MCE16D MVC 0(1,4),=X'00' 00129200 + AR 4,0 00129300 + BCT 5,MCE16D 00129400 + TM 1(12),X'40' Q/ FLOATING DOLLAR SIGN 00129500 + CLI SIGNDOL,1 Q/ DOLLAR SIGN 00129600 + BNE NXTOP NO 00129700 + CLI FIRSTDOL,1 Q/ DOLLAR SIGN OK 00129800 + BE NXTOP 00129900 + L 3,DOLSIGN NO 00130000 + MVI 0(3),X'00' BLANK DOLLAR SIGN 00130100 + B NXTOP 00130200 +ZEROSUP DS F ZERO SUPPRESSION ADDRESS 00130300 +DECADD DS F DECIMAL POINT ADDRESS 00130400 +DECIMAL DC X'00' DECIMAL INDICATOR 00130500 +FLOAT DC X'00' FLOATING DOLLAR SIGN INDICATOR 00130600 +FIRST DC X'00' FIRST CHARACTER OF SCAN INDICATOR 00130700 +AMINUS DC X'00' A-FIELD MINUS INDICATOR 00130800 +BODY DC X'00' BODY TRIGGER 00130900 +ASTER DC X'00' ASTERISK PROTECTION INDICATOR 00131000 +SIGDIG DC X'00' SIGNIFICANT DIGIT INDICATOR 00131100 +FIRSTDOL DC X'00' 00131200 +DOLSIGN DS F 00131300 +LASTDIG DS F ADDRESS OF LOW ORDER DIGIT 00131400 +SIGNDOL DC X'00' 00131500 + TITLE 'READ A CARD' 00131600 + USING R,13 00131700 +R CH 9,=H'1' 00131800 + BE RL1 00131900 + CH 9,=H'4' 00132000 + BE RL4 00132100 + B ILEGLN 00132200 +RL1 BAL 8,READ 00132300 + B NXTOP 00132400 +RL4 MVC ADR140(3),1(10) 00132500 + BAL 8,READ 00132600 + LA 6,ADR140 GET BRANCH ADDRESS 00132700 + B SETBCH SET CONDITIONS FOR BRANCH 00132800 + TITLE 'PUNCH A CARD' 00132900 + USING P,13 00133000 +P CH 9,=H'1' 00133100 + BE PL1 00133200 + CH 9,=H'4' 00133300 + BNE ILEGLN 00133400 + BAL 8,PUNCH 00133500 + LA 6,1(10) REFERENCE BRANCH ADDRESS 00133600 + B SETBCH SET CONDITIONS FOR BRANCH 00133700 +PL1 BAL 8,PUNCH 00133800 + B NXTOP 00133900 + TITLE 'READ AND PUNCH' 00134000 + USING RP,13 00134100 +RP CH 9,=H'1' 00134200 + BE RPL1 00134300 + CH 9,=H'4' 00134400 + BNE ILEGLN 00134500 + MVC ADR140(3),1(10) SAVE BRANCH ADDRESS 00134600 + BAL 8,READ 00134700 + BAL 8,PUNCH 00134800 + LA 6,ADR140 REFERENCE BRANCH ADDRESS 00134900 + B SETBCH SET CONDITIONS FOR BRANCH 00135000 +RPL1 BAL 8,READ 00135100 + BAL 8,PUNCH 00135200 + B NXTOP 00135300 + TITLE 'PRINT A LINE' 00135400 + USING W,13 00135500 +W CH 9,=H'1' 00135600 + BE WL1 00135700 + CH 9,=H'2' 00135800 + BE WM 00135900 + CH 9,=H'5' 00136000 + BE WM 00136100 + CH 9,=H'4' 00136200 + BNE ILEGLN 00136300 +WL4 BAL 8,WRITE 00136400 + LA 6,1(10) REFERENCE BRANCH ADDRESS 00136500 + B SETBCH SET CONDITIONS FOR BRANCH 00136600 +WL1 BAL 8,WRITE 00136700 + B NXTOP 00136800 +WM MVC DCHAR(1),1(10) 00136900 + CH 9,=H'2' 00137000 + BE WML2 00137100 + MVC DCHAR(1),4(10) 00137200 +WML2 CLI DCHAR,X'3C' Q. PRINT WM 00137500 + BE WML20A 00137600 + CLI DCHAR,X'12' Q. SPACE SUPPRESS 00137700 + BNE ILEGOP 00137800 + MVI PRNTBUFF,X'01' + CH 9,=H'5' 00137900 + BE WL4 00138000 + B WL1 00138100 +WML20A MVC PRNTBUFF+1(132),SIMCOR+201 MOVE WORD MARKS TO PRINT 00138200 + TR PRNTBUFF+1(132),TRWDMK * 00138300 + BAL 8,WRITEC 14770 + CH 9,=H'2' 00139100 + BE NXTOP 00139200 + LA 6,1(10) 00139300 + B SETBCH SET CONDITIONS FOR BRANCH 00139400 + TITLE 'READ AND PRINT' 00139500 + USING WR,13 00139600 +WR CH 9,=H'1' 00139700 + BE WRL1 00139800 + CH 9,=H'4' 00139900 + BNE ILEGLN 00140000 + MVC ADR140(3),1(10) SAVE BRANCH ADDRESS 00140100 + BAL 8,WRITE 00140200 + BAL 8,READ 00140300 + LA 6,ADR140 REFERENCE BRANCH ADDRESS 00140400 + B SETBCH SET CONDITIONS FOR BRANCH 00140500 +WRL1 BAL 8,WRITE 00140600 + BAL 8,READ 00140700 + B NXTOP 00140800 + TITLE 'PRINT AND PUNCH' 00140900 + USING WP,13 00141000 +WP CH 9,=H'1' 00141100 + BE WPL1 00141200 + CH 9,=H'4' 00141300 + BNE ILEGLN 00141400 + BAL 8,WRITE 00141500 + BAL 8,PUNCH 00141600 + LA 6,1(10) REFERENCE BRANCH ADDRESS 00141700 + B SETBCH SET CONDITIONS FOR BRANCH 00141800 +WPL1 BAL 8,WRITE 00141900 + BAL 8,PUNCH 00142000 + B NXTOP 00142100 + TITLE 'WRITE,READ, AND PUNCH' 00142200 + USING WRP,13 00142300 +WRP CH 9,=H'1' 00142400 + BE WRPL1 00142500 + CH 9,=H'4' 00142600 + BNE ILEGLN 00142700 + MVC ADR140(3),1(10) SAVE BRANCH ADDRESS 00142800 + BAL 8,WRITE 00142900 + BAL 8,READ 00143000 + BAL 8,PUNCH 00143100 + LA 6,ADR140 REFERENCE BRANCH ADDRESS 00143200 + B SETBCH SET CONDITIONS FOR BRANCH 00143300 +WRPL1 BAL 8,WRITE 00143400 + BAL 8,READ 00143500 + BAL 8,PUNCH 00143600 + B NXTOP 00143700 + TITLE 'SELECT STACKER' 00143800 + USING SS,13 00143900 +SS CH 9,=H'2' 00144000 + BE NXTOP 00144100 + CH 9,=H'5' 00144200 + BNE ILEGLN 00144300 + LA 6,1(10) 00144400 + B SETBCH 00144500 + TITLE 'CONTROL CARRIAGE' 00144600 + USING CC,13 00144700 +CC MVC DCHAR(1),1(10) 00144800 + CH 9,=H'2' 00144900 + BE CCL2 00145000 + CH 9,=H'5' 00145100 + BNE ILEGLN 00145200 + MVC DCHAR(1),4(10) 00145300 +CCL2 TM DCHAR,X'30' 00145400 + BZ CCIMSK 00145500 + BO CCAFSK 00145600 + TM DCHAR,X'20' 00145700 + BO CCIMSP 00145800 + IC 3,DCHAR 00145900 + N 3,=F'3' 00146000 + SLL 3,3 00146100 + O 3,=F'1' 00146200 + STC 3,PRNTBUFF 00146300 + B CCDONE 00146400 +CCIMSP IC 3,DCHAR 00146500 + N 3,=F'3' 00146600 + SLL 3,3 00146700 + STC 3,PRNTBUFF 00146800 + OI PRNTBUFF,X'03' 00146900 + B CCNOW 00147000 +CCAFSK IC 3,DCHAR 00147100 + N 3,=F'15' 00147200 + TM DCHAR,X'0F' 00147300 + BM CC1 00147400 + LA 3,10 00147500 +CC1 SLL 3,3 00147600 + STC 3,PRNTBUFF 00147700 + OI PRNTBUFF,X'81' 00147800 + B CCDONE 00147900 +CCIMSK IC 3,DCHAR 00148000 + TM DCHAR,X'0F' 00148100 + BM CC2 00148200 + LA 3,10 00148300 +CC2 N 3,=F'15' 00148400 + SLL 3,3 00148500 + O 3,=F'131' 00148600 + STC 3,PRNTBUFF 00148700 +CCNOW BAL 8,WRITEC 15810 +CCDONE CH 9,=H'2' 00149500 + BE NXTOP 00149600 + LA 6,1(10) 00149700 + B SETBCH 00149800 + TITLE 'MULTIPLY' 00154500 + USING M,13 00154600 +M CH 9,=H'7' 00154700 + BNE ILEGLN 00154800 + LA 6,1(10) 00154900 + BAL 8,CVAD43 00155000 + LR 11,5 00155100 + LA 6,4(10) 00155200 + BAL 8,CVAD43 00155300 + LR 12,5 00155400 + ST 12,MPYSAV SAVE UNITS ADDRESS OF PRODUCT 00155500 + LR 5,11 INTIALIZE PRODUCT AREA 00155600 + LR 6,12 * 00155700 +M1 MVI 0(6),X'0A' * 00155800 + TM 0(5),X'40' * 00155900 + BO M2 * 00156000 + SH 5,=H'1' * 00156100 + SH 6,=H'1' * 00156200 + B M1 * 00156300 +M2 SH 6,=H'2' * 00156400 + MVI 1(6),X'0A' * 00156500 + LA 1,0 COMPARE SIGNS 00156600 + LA 2,0 * 00156700 + TM 0(6),X'20' * 00156800 + BZ M3 * 00156900 + TM 0(6),X'10' * 00157000 + BO M3 * 00157100 + LA 1,1 * 00157200 +M3 TM 0(11),X'20' * 00157300 + BZ M4 * 00157400 + TM 0(11),X'10' * 00157500 + BO M4 * 00157600 + LA 2,1 * 00157700 +M4 MVI MINPRD,0 00157800 + CR 1,2 00157900 + BE M5 SIGNS EQUAL 00158000 + MVI MINPRD,1 SIGNS UNEQUAL 00158100 +M5 IC 1,0(6) 00158200 + N 1,=F'15' 00158300 + CH 1,=H'10' Q/ ZERO 00158400 + BNE *+6 NO 00158500 + SR 1,1 YES, CLEAR 00158600 +M6 LA 0,0 00158700 + LTR 1,1 Q/ IS MULTIPLICAND DIGIT ZERO 00158800 + BZ M9 00158900 + LR 5,12 SET REGISTERS FOR ADD 00159000 + LR 4,11 00159100 + LR 8,12 LOAD PRODUCT POINTER 00159200 +M7 IC 2,0(4) 00159300 + N 2,=F'15' 00159400 + CH 2,=H'10' Q/ ZERO 00159500 + BNE *+6 NO 00159600 + SR 2,2 YES, CLEAR 00159700 + IC 3,0(5) 00159800 + N 3,=F'15' 00159900 + CH 3,=H'10' Q/ ZERO 00160000 + BNE *+6 NO 00160100 + SR 3,3 YES, CLEAR IT 00160200 + AR 3,2 00160300 + AR 3,0 00160400 + LA 0,0 00160500 + CH 3,=H'9' 00160600 + BNH M8 00160700 + SH 3,=H'10' 00160800 + LA 0,1 00160900 +M8 STC 3,0(8) STORE RESULT 00161000 + CLI 0(8),X'00' Q/ RESULT ZERO 00161100 + BNE *+8 NO 00161200 + MVI 0(8),X'0A' YES, SET 8-2 BITS 00161300 + SH 4,=H'1' 00161400 + SH 5,=H'1' 00161500 + SH 8,=H'1' 00161600 + TM 1(4),X'40' 00161700 + BZ M7 00161800 + IC 3,0(5) ADD CARRY TO NEXT PRODUCT DIGIT 00161900 + CH 3,=H'10' Q/ ZERO 00162000 + BNE *+6 NO 00162100 + SR 3,3 YES, CLEAR 00162200 + AR 3,0 00162300 + STC 3,0(8) * 00162400 + CLI 0(8),X'00' Q/ RESULT ZERO 00162500 + BNE *+8 NO 00162600 + MVI 0(8),X'0A' YES, SET 8-2 BITS 00162700 + SH 1,=H'1' 00162800 + BC 6,M6 COUNT NOT ZERO, ADD NEXT DIGIT 00162900 +M9 SH 6,=H'1' 00163000 + NI 1(6),X'40' CLEAR LAST USED MULTIPLICAND DIGIT 00163100 + OI 1(6),X'0A' * 00163200 + TM 1(6),X'40' 00163300 + BO M10 00163400 + SH 12,=H'1' 00163500 + B M5 00163600 +M10 LR 11,4 00163700 + L 12,MPYSAV RELOAD UNITS ADDRESS OF PRODUCT 00163800 + OI 0(12),X'20' 00163900 + CLI MINPRD,1 00164000 + BE M11 00164100 + OI 0(12),X'30' 00164200 +M11 LR 12,6 00164300 + B NXTOP 00164400 +MINPRD DS C 00164500 +MPYSAV DS F 00164600 + TITLE 'DIVIDE' 00164700 + USING D,13 00164800 +D CH 9,=H'7' Q/ IS LENGTH ( BYTES 00164900 + BNE ILEGLN NO 00165000 + LA 6,1(10) YES, CONVERT ADDRESSES 00165100 + BAL 8,CVAD43 * 00165200 + LR 11,5 * 00165300 + LA 6,4(10) * 00165400 + BAL 8,CVAD43 * 00165500 + LR 12,5 * 00165600 + LA 0,1 SET REG TO 1 FOR + OR - 1 00165700 + LR 1,11 SCAN DIVISOR FOR LENGTH AND IS IT ZERO 00165800 + MVI TEMP1,0 * 00165900 + MVI TEMP2,0 * 00166000 +D1 MVN TEMP2,0(1) * 00166100 + CLI TEMP2,X'0A' * 00166200 + BE D1A * 00166300 + CLI TEMP2,X'00' * 00166400 + BE D1A * 00166500 + MVI TEMP1,1 * 00166600 +D1A SR 1,0 * 00166700 + TM 1(1),X'40' * 00166800 + BZ D1 * 00166900 + CLI TEMP1,0 Q/ IS DIVISOR ZERO 00167000 + BNE D2 NO, OK 00167100 + MVI OVRFLO,1 YES, SET OVERFLOW INDICATOR 00167200 + B NXTOP 00167300 +D2 LR 6,12 FIND HIGH ORDER QUOTIENT LOCATION 00167400 + AR 6,1 * 00167500 + SR 6,11 * 00167600 + SR 6,0 * 00167700 +D3 MVI TEMP1,0 PREPARE TO COMPARE DIVISOR + DVDND 00167800 + LR 1,11 00167900 + LR 2,12 00168000 +D4 IC 3,0(1) GET DIGITS 00168100 + IC 4,0(2) * 00168200 + N 3,=F'15' * 00168300 + N 4,=F'15' * 00168400 + CH 3,=H'10' Q/ ZERO 00168500 + BNE *+6 NO 00168600 + SR 3,3 YES, CLEAR IT 00168700 + CH 4,=H'10' Q/ ZERO 00168800 + BNE *+6 NO 00168900 + SR 4,4 YES, CLEAR 00169000 + CR 3,4 COMPARE 00169100 + BE D5 EQUAL, DO NOT CHANGE INDICATOR 00169200 + BH D4A A-DIGIT GREATER 00169300 + MVI TEMP1,0 A-DIGIT LESS 00169400 + B D5 * 00169500 +D4A MVI TEMP1,1 SET A GREATER THAN B 00169600 +D5 SR 1,0 DECREMENT FIELD POINTERS 00169700 + SR 2,0 * 00169800 + TM 1(1),X'40' Q/ END OF A-FIELD 00169900 + BZ D4 NO 00170000 + TM 0(2),X'0A' TEST 1 MORE DIVIDEND DIGIT 00170100 + BO D6 ZERO 00170200 + TM 0(2),X'0F' Q/ BLANK 00170300 + BZ D6 YES, TREAT SAME AS ZERO 00170400 + MVI TEMP1,0 1, DIVIDEND GREATER THAN DIVISOR 00170500 +D6 CLI TEMP1,1 Q/ IS DIVISOR TOO LARGE 00170600 + BE D10 YES 00170700 + LR 1,11 SET REGISTERS FOR COMPLEMENT ADD 00170800 + LR 2,12 * 00170900 + LA 8,1 SET CARRY 00171000 +D7 IC 5,0(2) GET B-FIELD DIGIT 00171100 + N 5,=F'15' * 00171200 + CH 5,=H'10' Q/ ZERO 00171300 + BNE *+6 NO 00171400 + SR 5,5 YES, CLEAR 00171500 + LA 4,9 GET COMPLEMENT OF A-FIELD DIGIT 00171600 + IC 3,0(1) * 00171700 + N 3,=F'15' * 00171800 + CH 3,=H'10' Q/ ZERO 00171900 + BNE *+6 NO 00172000 + SR 3,3 YES, CLEAR IT 00172100 + SR 4,3 * 00172200 + AR 5,4 ADD TO B-FIELD DIGIT 00172300 + AR 5,8 ADD CARRY 00172400 + LA 8,0 CLEAR CARRY 00172500 + CH 5,=H'9' Q/ RESULT GREATER THAN 9 00172600 + BNH D8 NO 00172700 + SH 5,=H'10' YES, SUBTRACT 10 FROM RESULT 00172800 + LA 8,1 SET CARRY 00172900 +D8 STC 5,D9+1 STORE RESULT 00173000 + NI 0(2),X'F0' * 00173100 + CLI D9+1,X'00' Q/ RESULT ZERO 00173200 + BNE D9 NO 00173300 + OI D9+1,X'0A' YES, SET 8-2 BITS 00173400 +D9 OI 0(2),0 * 00173500 + SR 2,0 DECREMENT A- AND B-ADDRESSES 00173600 + SR 1,0 * 00173700 + TM 1(1),X'40' Q/ END OF A-FIELD 00173800 + BZ D7 NO, PROCESS NEXT DIGIT 00173900 + IC 3,0(2) YES, ADD 1 MORE DIVIDEND DIGIT 00174000 + N 3,=F'15' * 00174100 + CH 3,=H'10' Q/ ZERO 00174200 + BNE *+6 NO 00174300 + SR 3,3 YES, CLEAR IT 00174400 + LA 3,9(3) * 00174500 + AR 3,8 * 00174600 + CH 3,=H'9' Q/ RESULT GREATER THAN 9 00174700 + BNH D9A NO 00174800 + SH 3,=H'10' YES, SUBTRACT 10 00174900 +D9A STC 3,0(2) STORE RESULT 00175000 + CLI 0(2),X'00' Q/ RESULT ZERO 00175100 + BNE *+8 NO 00175200 + MVI 0(2),X'0A' YES, SET 8-2 BITS 00175300 + IC 3,0(6) ADD 1 TO QUOTIENT DIGIT 00175400 + N 3,=F'15' * 00175500 + CH 3,=H'10' Q/ ZERO 00175600 + BNE *+6 NO 00175700 + SR 3,3 YES, CLEAR IT 00175800 + AR 3,0 * 00175900 + STC 3,TEMP1 STORE RESULT 00176000 + MVN 0(1,6),TEMP1 * 00176100 + B D3 00176200 +D10 TM 0(12),X'30' Q/ ZONE BITS 00176300 + BC 5,D11 YES, DIVIDE DONE 00176400 + AR 6,0 NO, UP REFERENCE TO NEXT DIGIT 00176500 + AR 12,0 * 00176600 + B D3 00176700 +D11 IC 2,0(11) COMPARE DIVISOR AND DIVIDEND SIGNS 00176800 + IC 3,0(12) * 00176900 + N 2,=F'48' * 00177000 + N 3,=F'48' * 00177100 + SRDL 2,4 * 00177200 + LA 4,SINTBL * 00177300 + IC 2,0(4,2) * 00177400 + IC 3,0(4,3) * 00177500 + OI 0(6),X'30' SET QUOTIENT PLUS 00177600 + CR 2,3 Q/ ARE SIGNS EQUAL 00177700 + BE D12 YES, LEAVE QUOTIENT PLUS 00177800 + NI 0(6),X'EF' UNEQUAL, SET QUOTIENT MINUS 00177900 +D12 LR 11,1 SET A- AND B-ADDRESSES 00178000 + SR 11,0 * 00178100 + LR 12,6 * 00178200 + B NXTOP 00178300 +SINTBL DC X'00000100' 00178400 + TITLE 'MODIFY ADDRESS' 00178500 + USING MA,13 00178600 +MA CH 9,=H'7' 00178700 + BE MA1 00178800 + CH 9,=H'1' 00178900 + BE MAL4 00179000 + CH 9,=H'4' 00179100 + BNE ILEGLN 00179200 +MA1 LA 6,1(10) 00179300 + BAL 8,CVAD43 00179400 + LR 11,5 00179500 + LR 12,11 00179600 + CH 9,=H'4' 00179700 + BE MAL4 00179800 + LA 6,4(10) 00179900 + BAL 8,CVAD43 00180000 + LR 12,5 00180100 +MAL4 SH 11,=H'3' 00180200 + SH 12,=H'3' 00180300 + LA 0,15 UNITS 00180400 + LA 1,0 * 00180500 + IC 2,3(11) * 00180600 + IC 3,3(12) * 00180700 + NR 2,0 * 00180800 + NR 3,0 * 00180900 + CH 2,=H'10' 00181000 + BNE *+6 00181100 + SR 2,2 00181200 + CH 3,=H'10' 00181300 + BNE *+6 00181400 + SR 3,3 00181500 + AR 3,2 * 00181600 + CH 3,=H'9' * 00181700 + BNH MAL4A * 00181800 + SH 3,=H'10' * 00181900 + LA 1,1 * 00182000 +MAL4A STC 3,MAL4B+1 * 00182100 + NI 3(12),X'70' * 00182200 + TM MAL4B+1,X'0F' 00182300 + BC 5,MAL4B 00182400 + OI MAL4B+1,X'0A' 00182500 +MAL4B OI 3(12),0 * 00182600 + IC 2,2(11) TENS 00182700 + IC 3,2(12) * 00182800 + NR 2,0 * 00182900 + NR 3,0 $ 00183000 + CH 2,=H'10' 00183100 + BNE *+6 00183200 + SR 2,2 00183300 + CH 3,=H'10' 00183400 + BNE *+6 00183500 + SR 3,3 00183600 + AR 3,2 * 00183700 + AR 3,1 * 00183800 + LA 1,0 * 00183900 + CH 3,=H'9' * 00184000 + BNH MAL4C * 00184100 + SH 3,=H'10' * 00184200 + LA 1,1 * 00184300 +MAL4C STC 3,MAL4D+1 * 00184400 + NI 2(12),X'70' SAVE B FLD INDEX AND WORD MARK BITS 00184500 + TM MAL4D+1,X'0F' 00184600 + BC 5,MAL4D 00184700 + OI MAL4D+1,X'0A' 00184800 +MAL4D OI 2(12),0 * 00184900 + IC 2,1(11) HUNDREDS 00185000 + IC 3,1(12) * 00185100 + NR 2,0 * 00185200 + NR 3,0 * 00185300 + CH 2,=H'10' 00185400 + BNE *+6 00185500 + SR 2,2 00185600 + CH 3,=H'10' 00185700 + BNE *+6 00185800 + SR 3,3 00185900 + AR 3,2 * 00186000 + AR 3,1 * 00186100 + LA 1,0 * 00186200 + CH 3,=H'9' * 00186300 + BNH MAL4E * 00186400 + SH 3,=H'10' * 00186500 + LA 1,16 * 00186600 +MAL4E STC 3,MAL4F+1 * 00186700 + NI 1(12),X'70' * 00186800 + TM MAL4F+1,X'0F' 00186900 + BC 5,MAL4F 00187000 + OI MAL4F+1,X'0A' 00187100 +MAL4F OI 1(12),0 * 00187200 + LA 0,48 THOUSANDS 00187300 + IC 2,1(11) * 00187400 + IC 3,1(12) * 00187500 + NR 2,0 * 00187600 + NR 3,0 * 00187700 + AR 3,2 * 00187800 + AR 3,1 * 00187900 + LA 1,0 * 00188000 + CH 3,=H'48' * 00188100 + BNH MAL4G * 00188200 + SH 3,=H'64' * 00188300 + LA 1,16 * 00188400 +MAL4G STC 3,MAL4H+1 * 00188500 + NI 1(12),X'4F' * 00188600 +MAL4H OI 1(12),0 * 00188700 + IC 2,3(11) FOUR THOUSANDS 00188800 + IC 3,3(12) * 00188900 + NR 2,0 * 00189000 + NR 3,0 * 00189100 + AR 3,2 * 00189200 + AR 3,1 * 00189300 + CH 3,=H'48' * 00189400 + BNH MAL4I * 00189500 + SH 3,=H'64' * 00189600 +MAL4I STC 3,MAL4J+1 * 00189700 + NI 3(12),X'4F' * 00189800 +MAL4J OI 3(12),0 * 00189900 + B NXTOP 00190000 + TITLE 'STORE A-ADDRESS REGISTER' 00190100 + USING SAR,13 00190200 +SAR CH 9,=H'4' 00190300 + BNE ILEGLN 00190400 + LR 12,11 00190500 + LA 6,1(10) 00190600 + BAL 8,CVAD43 00190700 + LR 11,5 00190800 + ST 12,ADR360 00190900 + BAL 8,CVAD34 00191000 + SH 11,=H'3' 00191100 + NC 1(3,11),=X'404040' 00191200 + OC 1(3,11),ADR140 00191300 + B NXTOP 00191400 + TITLE 'STORE B-ADDRESS REGISTER' 00191500 + USING SBR,13 00191600 +SBR CH 9,=H'4' 00191700 + BE SBRL4 00191800 + CH 9,=H'1' 00191900 + BE SBRL1 00192000 + CH 9,=H'7' 00192100 + BNE ILEGLN 00192200 + LA 6,4(10) 00192300 + BAL 8,CVAD43 00192400 + LR 12,5 00192500 +SBRL4 LA 6,1(10) 00192600 + BAL 8,CVAD43 00192700 + LR 11,5 00192800 + ST 12,ADR360 00192900 + BAL 8,CVAD34 00193000 +SBRL1 SH 11,=H'3' 00193100 + NC 1(3,11),=X'404040' 00193200 + OC 1(3,11),ADR140 00193300 + B NXTOP 00193400 + TITLE 'MOVE CHARACTERS TO RCD MARK OR GROUP MARK - WORD MARK' 00193500 + USING MCM,13 00193600 +MCM CH 9,=H'1' 00193700 + BE MCML1 00193800 + CH 9,=H'7' 00193900 + BNE ILEGLN 00194000 + LA 6,1(10) 00194100 + BAL 8,CVAD43 00194200 + LR 11,5 00194300 + LA 6,4(10) 00194400 + BAL 8,CVAD43 00194500 + LR 12,5 00194600 +MCML1 NI MCMSW+1,X'0F' 00194700 + LR 6,11 A-FIELD PTR 00194800 +MCMSCAN TRT 0(256,6),TRTGMWRM SCAN FOR GMWM - RM - RMWM 00194900 + BNZ MCMHIT 00195000 + LA 6,256(6) 00195100 + B MCMSCAN 00195200 +MCMHIT SR 1,11 COMPUTE RECORD LENGTH 00195300 + LA 1,1(1) BUMP FOR TERM CHAR 00195400 + CH 1,=H'256' TOTAL LENGTH GT 256 00195500 + BNH MCMDECR NO 00195600 + OI MCMSW+1,X'F0' YES - SET SW FOR MULTIPLE MOVES 00195700 + LR 3,1 00195800 +MCM256 LA 1,256 00195900 +MCMDECR BCTR 1,0 DECREMENT FOR EX INSTRUCTIONS 00196000 + EX 1,MCMCHMOV MOVE RECORD TO WORK AREA 00196100 + EX 1,MCMCHCLR CLEAR RECEIVING AREA EXCEPT WM 00196200 + EX 1,MCMWMCLR ELIMINATE WORD MARKS IN WORK AREA 00196300 + EX 1,MCMCHORC OR DATA BITS (BA8421) INTO REC AREA 00196400 + LA 1,1(1) 00196500 + AR 11,1 00196600 + AR 12,1 00196700 +MCMSW NOP MCMBUMP SW SET IF RECORD GT 256 BYTES 00196800 + B NXTOP TO NEXT 1401 INSTRUCTION 00196900 +MCMBUMP SR 3,1 COMPUTE BYTES REMAINING 00197000 + CH 3,=H'256' Q / BYTES REMAINING GT 256 00197100 + BH MCM256 YES 00197200 + LR 1,3 00197300 + NI MCMSW+1,X'0F' TURN OFF SWITCH 00197400 + B MCMDECR MOVE REMAINING BYTES 00197500 +* 00197600 +MCMCHCLR NC 0(0,12),WM256 00197700 +MCMCHMOV MVC WORK256(0),0(11) 00197800 +MCMWMCLR NC WORK256(0),STRIPWM 00197900 +MCMCHORC OC 0(0,12),WORK256 00198000 +* 00198100 +WORK256 DC CL256' ' 00198200 +TRTGMWRM DC 26X'00' MCM SCAN TABLE 00198300 + DC X'1A' RECORD MARK - A8 2 00198400 + DC 63X'00' 00198500 + DC X'5A' RECORD MARK WORD MARK - M A8 2 00198600 + DC 36X'00' W 00198700 + DC X'7F' GROUP MARK WORD MARK - MBA8421 00198800 + DC 128X'00' 00198900 +STRIPWM DC 256X'3F' 00199000 + TITLE 'BRANCH IF BIT EQUAL' 00199100 + USING BBE,13 00199200 +BBE CH 9,=H'1' 00199300 + BE BBEL1 00199400 + CH 9,=H'8' 00199500 + BNE ILEGLN 00199600 + LA 6,1(10) 00199700 + BAL 8,CVAD43 00199800 + LR 11,5 00199900 + LA 6,4(10) 00200000 + BAL 8,CVAD43 00200100 + LR 12,5 00200200 + MVC DCHAR(1),7(10) 00200300 + NI DCHAR,X'BF' 00200400 +BBEL1 SH 12,=H'1' 00200500 + MVC TEMP1,DCHAR 00200600 + NC TEMP1(1),1(12) 00200700 + BZ NXTOP 00200800 + LR 10,11 00200900 + LA 9,0 00201000 + B NXTOP 00201100 + PRINT ON + TITLE 'I N I T A L I Z E' +BEGIN SAVE (14,12) SAVE CONTROL PROGRAMS REGISTERS 00201300 + BALR 15,0 LOAD BASE REGISTERS 00201400 +SETBS1 L 14,BASE2 * 00201500 + ST 13,SAVEAREA+4 SAVE CONTROL PROGRAMS REGISTER 13 00201600 + LR 5,1 SAVE PARM ADDRESS + STM 13,15,MACREGSV SAVE MACRO REGS + LA 6,MACREGSV SAVE ADDRESS TO XR + LA 13,SAVEAREA GIVE OS OUR SAVE AREA + SPACE + AIF ('&TAPE' EQ 'Y').YESTO + OPEN (PRNTDCB,(OUTPUT),CARD,,PUNCHR,(OUTPUT), X + SYSPDCB,(OUTPUT)) +.YESTO ANOP + AIF ('&TAPE' EQ 'N').NOTO + OPEN (PRNTDCB,(OUTPUT),CARD,,PUNCHR,(OUTPUT), X + TAPEDCB0,,TAPEDCB1,,TAPEDCB2,,TAPEDCB3,,TAPEDCB4,, X + TAPEDCB5,, X + SYSPDCB,(OUTPUT)) +.NOTO ANOP + LM 13,15,0(6) + SPACE + EXTRACT TIOTADDR,FIELDS=TIOT + LM 13,15,0(6) + L 3,TIOTADDR + USING TIOT,3 + MVC SYSPBUFF+1(8),TIOCNJOB + MVC SYSPBUFF+10(8),TIOCSTP + SPACE + GETMAIN R,LV=16020 GET CORE FOR 1401 SIMULATED CORE + LM 13,15,0(6) RESTORE MACRO REGISTERS + LR 7,1 * + A 1,=F'15999' STORE UPPER LIMIT OF 1401 CORE + ST 1,SIMLIMIT * +CLR LA 2,SIMCOR + LA 3,64 +CLR1 XC 0(250,2),0(2) + LA 2,250(2) + BCT 3,CLR1 + L 1,=F'16010' + AR 1,7 + MVI 0(1),X'7F' + AIF ('&TAPE' EQ 'N').NOTA + LA 1,100 CLEAR + L 2,TAPEAREA TAPE +CLEAR XC 0(256,2),0(2) AREA + LA 2,256(2) + BCT 1,CLEAR +.NOTA ANOP + SPACE + MVI PRNTBUFF,X'8B' RESTORE PRINT FORM IMMEDIATELY + BAL 8,WRITEC * + BAL 8,READF READ FIRST CD OR SET EOF CARD + TITLE 'N O C O N S O L E C O M M A N D S U P P O R T' + AIF ('&CONSOLE' EQ 'Y').YESCNSL + AIF ('&TAPE' EQ 'N').QTL + CLI PARM+10,C'T' + BE TPLOAD +.QTL ANOP + B CDLOAD +WTORTN B TERMINAT + SPACE +.YESCNSL ANOP + TITLE 'C O N S O L E C O M M A N D S U P P O R T' + AIF ('&CONSOLE' EQ 'N').NOCONSL + SPACE +WTORTN XC RQSTIN,RQSTIN 00203400 + MVC OKWTOR+16(17),SYSPBUFF+1 + STM 13,15,MACREGSV SAVE MACRO REGS 00203600 + LA 6,MACREGSV SAVE ADDRESS TO XR 00203700 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00203800 +OKWTOR WTOR ' SIM1401 A002 OK', + RQSTIN,50,WTECB 00204000 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00204100 + MVC SYSPBUFF+1(50),RQSTIN + STM 13,15,MACREGSV + LA 13,SAVEAREA + LA 6,MACREGSV + PUT SYSPDCB,SYSPBUFF + LM 13,15,0(6) + MVC SYSPBUFF+27(58),=CL58' ' + SPACE +TESTA STM 13,15,MACREGSV SAVE MACRO REG 00204200 + LA 6,MACREGSV SAVE ADDRESS TO XR 00204300 + LA 13,SAVEAREA 00204400 + WAIT 1,ECB=WTECB WAIT FOR RESPONSE 00204500 + LM 13,15,0(6) RESTORE MACRO REG 00204600 + XC WTECB,WTECB CLEAR ECB 00204700 + SPACE + TR RQSTIN,TYPTBL 21610 + CLC RQSTIN(3),=C'SSS' 00208600 + BE SSIN 00208700 + CLC RQSTIN(3),=C'LDC' 00209000 + BE CDLOAD 00209100 + CLC RQSTIN(3),=C'SRS' 00209400 + BE STRST 00209500 + CLC RQSTIN(3),=C'STT' 00209600 + BE START 00209700 + CLC RQSTIN(3),=C'CLR' 00209800 + BE CLR 00209900 + CLC RQSTIN(3),=C'DIS' 00210000 + BE DIS 00210100 + CLC RQSTIN(3),=C'ALT' 00210200 + BE ALT 00210300 + CLC RQSTIN(3),=C'TRM' 00210800 + BE TERMINAT 00210900 + AIF ('&TAPE' EQ 'N').NOTCMD + CLC RQSTIN(3),=C'LDT' 00209200 + BE TPLOAD 00209300 + CLC RQSTIN(3),=C'WTM' 00210400 + BE WTMCMD 00210500 + CLC RQSTIN(3),=C'RWD' 00210600 + BE RWDCMD 00210700 +.NOTCMD ANOP +SNDILG XC RQSTIN,RQSTIN ZERO OUT REPLY AREA 00211000 + MSG 'A004 ILLEGAL ENTRY',A004 21790 + B WTORTN + SPACE +* THIS SECTION WILL SIMULATE THE START PUSHBUTTON. IF THE 00213000 +* OPERATOR COMMAND STT IS FOLLOWED BY AN ADDRESS, THE 1401 PROGRAM 00213100 +* WILL RESUME FROM THAT ADDRESS. HOWEVER, IF STT IS NOT FOLLOWED 00213200 +* BY ANYTHING, THE 1401 PROGRAM WILL RESUME FROM WHERE IT STOPPED. 00213300 +* 00213400 +START CLI OKSTT,1 00213500 + BNE START4 00213600 + LA 5,RQSTIN+3 Q/ IS THERE A START ADDRESS 00213700 + CLI 0(5),0 * 00213800 + BNE START1 YES, START FROM THERE 00213900 + L 8,RETURN 00214000 + BR 8 00214100 +START1 CLI 0(5),0 Q/ END OF MESSAGE 00214200 + BE START2 YES 00214300 + CLI 0(5),C'0' NO, IS IT NUMERIC 00214400 + BL SNDILG NO, ERROR 00214500 + LA 5,1(5) YES, TRY NEXT BYTE 00214600 + B START1 * 00214700 +START2 S 5,=A(RQSTIN+4) GET LENGTH - 1 00214800 + CH 5,=H'4' Q/ LENGTH GT 5 DIGITS 00214900 + BH SNDILG YES, ERROR 00215000 + STC 5,TEMP1 CONVERT TO BINARY 00215100 + MVN START3+1(1),TEMP1 * 00215200 +START3 PACK PAKT,RQSTIN+3(0) * 00215300 + CVB 4,PAKT * 00215400 + CH 4,=H'15999' Q/ ADDRESS GT 15999 00215500 + BH SNDILG YES, ERROR 00215600 + AR 4,7 NO, GO THERE 00215700 + LR 10,4 * 00215800 + LA 9,0 * 00215900 + B NXTOP * 00216000 +START4 XC RQSTIN,RQSTIN ZERO OUT REPLY AREA 00216100 + MSG 'A006 CANNOT START, NO PGM LOADED',A006 22180 + B WTORTN +* 00217000 +* THIS SECTION WILL SIMULATE THE START-RESET PUSHBUTTON. 00217100 +* 00217200 +STRST LR 6,10 00217300 + AR 6,9 00217400 + ST 6,ADR360 00217500 + MVI TPERR,0 00217600 + MVI TPEOF,0 00217700 + MVI OVRFLO,0 00217800 + MVI CPR,0 00217900 + B WTORTN 00218000 +* 00218100 +* THIS SECTION SIMULATES THE SETTING OF SENSE SWITCHES BY SETTING 00222200 +* INDICATORS IN CORE BASED UPON THE SSS INPUT COMMAND. THE 00222300 +* ROUTINES THAT SIMULATE THE BSS INSTRUCTIONS WILL TEST THESE 00222400 +* INDICATORS. 00222500 +* 00222600 +SSIN LA 6,RQSTIN+3 REFERENCE FIRST SENSE SWITCH 00222700 + XC TSSA(7),TSSA CLEAR TEMPORARY SENSE SWITCHES 00222800 + LA 5,8 SET TO SCAN 8 SETTINGS MAX 00222900 +SSIN1 CLI 0(6),0 Q/ DONE 00223000 + BE SSEND YES, MOVE THEM 00223100 + CLI 0(6),C'A' Q/ IS THIS SENSE SWITCH LEGAL 00223200 + BL SNDILG NO + CLI 0(6),C'G' 00223400 + BH SNDILG NO + IC 4,0(6) YES 00223600 + N 4,=F'7' SET TEMPORARY SENSE SWITCH 00223700 + LA 2,TSSA-1 * 00223800 + AR 2,4 * 00223900 + MVI 0(2),1 * 00224000 + LA 6,1(6) REFERENCE NEXT INPUT CHARACTER 00224100 + BCT 5,SSIN1 Q/ ARE THERE TOO MANY INPUT CHARACTERS 00224200 + B SNDILG YES +SSEND MVC SENSEA(7),TSSA 00224400 + B WTORTN +TSSA DS 7C TEMPORARY SENSE SWITCHES 00224600 +* 00237000 +* THIS SECTION WILL DISPLAY ON THE PRINTER THE HUNDREDS GROUP 00237100 +* OF 1401 CORE REFERENCED IN THE OPERATOR COMMAND DIS . 00237200 +* 00237300 +DIS LA 5,RQSTIN+3 00237400 +DIS1 CLI 0(5),X'00' 00237500 + BE DIS2 00237600 + CLI 0(5),C'0' 00237700 + BL SNDILG 00237800 + LA 5,1(5) 00237900 + B DIS1 00238000 +DIS2 LR 2,5 00238100 + SH 2,=H'2' 00238200 + CLC 0(2,2),=C'00' 00238300 + BNE SNDILG 00238400 + S 5,=A(RQSTIN+4) 00238500 + CH 5,=H'4' 00238600 + BH SNDILG 00238700 + STC 5,DIS3+1 00238800 + MVC DSMRKR+1(20),WM256 00238900 +DIS3 MVC DSMRKR+9(0),RQSTIN+3 MOVE ADDR FOR PRINTING 00239000 + STC 5,TEMP1 00239100 + MVN DIS4+1(1),TEMP1 00239200 +DIS4 PACK PAKT,RQSTIN+3(0) 00239300 + CVB 4,PAKT 00239400 + CH 4,=H'15900' 00239500 + BH SNDILG 00239600 + MVC PRNTBUFF(133),DSMRKR + BAL 8,WRITEC + AR 4,7 ADD IN ADDRESS OF 1401 SIMCORE 00239700 + MVC PRNTBUFF+1(20),WM256 00239900 + MVC PRNTBUFF+21(100),0(4) 00240000 + TR PRNTBUFF+21(100),TRIE CHANGE PRINT AREA TO EBCDIC 00240100 + MVC PRNTBUFF+121(11),WM256 * 00240200 + BAL 8,WRITEC 23040 + MVC PRNTBUFF+21(100),0(4) CHANGE WORD MARKS TO EBCDIC IS 00241000 + TR PRNTBUFF+21(100),TRWDMK * 00241100 + BAL 8,WRITEC 23130 + B WTORTN 00241400 +DSMRKR DC X'09',20X'40' 00241500 + DC C'0.......09........19........29........39........49.' 00241600 + DC C'.......59........69........79........89........99' 00241700 + DC C' ' 00241800 +* 00241900 +* THIS SECTION WILL MODIFY THE 1401 CORE LOCATION REFERENCED IN 00242000 +* THE OPERATOR COMMAND ALT . 00242100 +* 00242200 +ALT LA 6,RQSTIN+3 00242300 +ALT1 CLI 0(6),C',' 00242400 + BE ALT2 00242500 + CLI 0(6),C'0' 00242600 + BL SNDILG 00242700 + LA 6,1(6) 00242800 + B ALT1 00242900 +ALT2 LR 5,6 00243000 + S 5,=A(RQSTIN+4) 00243100 + CH 5,=H'4' 00243200 + BH SNDILG 00243300 + STC 5,TEMP1 00243400 + MVN ALT3+1(1),TEMP1 00243500 +ALT3 PACK PAKT,RQSTIN+3(0) 00243600 + CVB 4,PAKT 00243700 + CH 4,=H'15999' 00243800 + BH SNDILG 00243900 + AR 4,7 00244000 + MVC 0(1,4),1(6) 00244100 + TR 0(1,4),TREI 00244200 + CLI 2(6),C'M' 00244300 + BNE WTORTN 00244400 + OI 0(4),X'40' 00244500 + B WTORTN 00244600 + SPACE +RQSTIN DS CL50 00211800 +WTECB DC F'0' 00204900 +.NOCONSL ANOP + TITLE 'C O M M O N C O M M A N D S U P P O R T' +* THIS SECTION WILL SIMULATE THE 1402 CARD LOAD PUSHBUTTON. 00212000 +* 00212100 +CDLOAD XC SIMCOR+1(80),SIMCOR+1 00212200 + BAL 8,READ 00212300 + OI SIMCOR+1,X'40' 00212400 + LA 10,SIMCOR+1 00212500 + LA 9,0 00212600 + MVI OKSTT,1 00212700 + B NXTOP 00212800 + SPACE +* THIS ROUTINE OUTPUTS MESSAGES ON SYSPRINT AND CONSOLE, IF SUPPORTED +* CALL SEQUENCE IS +* BAL 4,WTO +* DC AL2(L'MSG-1) +*MSG DC 'MESSAGE' + SPACE +* THIS CAN BE GENERATED BY THE 'MSG' MACRO +* MSG 'MESSAGE ',MSG + SPACE +WTO SR 5,5 + IC 5,1(4) PICK UP LENGTH + CH 5,=H'57' + BNH WTOEX + LH 5,=H'57' +WTOEX EX 5,WTOMVC MOVE MESSAGE TO SYSPBUFF + AIF ('&CONSOLE' EQ 'N').WTONO2 + MVC WTOWTO+15(85),SYSPBUFF+1 MOVE TO WTO + STM 13,15,MACREGSV + LA 13,SAVEAREA + LA 6,MACREGSV + PRINT GEN +WTOWTO WTO ' X + ' + PRINT NOGEN + LM 13,15,0(6) +.WTONO2 ANOP + STM 13,15,MACREGSV + LA 13,SAVEAREA + LA 6,MACREGSV + PUT SYSPDCB,SYSPBUFF + LM 13,15,0(6) + MVC SYSPBUFF+27(58),=CL58' ' + LA 4,4(5,4) + N 4,=X'FFFFFFFE' + BR 4 +WTOMVC MVC SYSPBUFF+27(0),2(6) + SPACE +* THIS ROUTINE WILL TERMINATE THE SIMULATOR UPON THE OPERATOR +* ENTRY 'TRM'. + SPACE +TERMINAT LR 1,7 + STM 14,15,MACREGSV 23515 + LA 13,SAVEAREA + LA 6,MACREGSV 23525 + FREEMAIN R,LV=16020,A=(1) + LM 14,15,0(6) 23535 + CLOSE (PRNTDCB,,SYSPDCB,,PUNCHR,,CARD) + L 13,4(13) + RETURN (14,12) + TITLE 'ROUTINE TO BRANCH TO NEXT OPCODE PROCESSING ROUTINE' 00273800 +* BEFORE BRANCHING, SET THE B ADDRESS REGISTER TO THE ADDRESS OF 00250800 +* THE INSTRUCTION AFTER THE BRANCH, THEN SET THE INSTRUCTION 00250900 +* COUNTER TO THE BRANCH ADDRESS, AND BRANCH. 00251000 +* 00251100 +SETBCH BAL 8,CVAD43 CONVERT BRANCH ADDRESS 00251200 + LR 12,10 LOAD B ADDRESS 00251300 + AR 12,9 * 00251400 + ST 10,LSTBCH SAVE LAST BRANCHED FROM LOCATION 00251500 + LR 10,5 LOAD BRANCH ADDRESS 00251600 + LA 9,0 * 00251700 + SPACE +* THIS SECTION EXAMINES THE NEXT OPERATION CODE AND, BASED UPON IT, 00274000 +* BRANCHES TO THE PROPER ROUTINE TO PROCESS THE INSTRUCTION. 00274100 +* 00274200 +NXTOP AR 10,9 GET NEW OP CODE LOCATION 00274300 + TM 0(10),X'40' Q/ IS THERE A WORD MARK 00274400 + BZ ILEGOP NO 00274500 + LA 1,250(10) 00274600 + TRT 1(250,10),TRTB 00274700 + LR 9,1 00274800 + SR 9,10 00274900 + IC 2,0(10) GET OP CODE 00275000 + N 2,=F'63' ELIMINATE WORD MARK 00275100 + SLL 2,2 MULTIPLY BY 4 00275200 + L 13,BCHTBL(2) LOAD BASE OF PROCESSING ROUTINE 00275300 + BR 13 BRANCH TO OPCODE PROCESSING ROUTINE 00275400 +BCHTBL DC A(ILEGOP) 0 00275500 + DC A(R) 1 1 00275600 + DC A(W) 2 2 00275700 + DC A(WR) 3 3 00275800 + DC A(P) 4 4 00275900 + DC A(RP) 5 5 00276000 + DC A(WP) 6 6 00276100 + DC A(WRP) 7 7 00276200 + DC A(NXTOP) 10 8 00276300 + DC A(NXTOP) 11 9 00276400 + DC A(ILEGOP) 12 0 00276500 + DC A(MA) 13 = 00276600 + DC A(M) 14 @ 00276700 + DC A(ILEGOP) 15 00276800 + DC A(ILEGOP) 16 00276900 + DC A(ILEGOP) 17 TP MK 00277000 + DC A(ILEGOP) 20 A BIT 00277100 + DC A(CS) 21 / 00277200 + DC A(A) 22 S 00277300 + DC A(ILEGOP) 23 T 00277400 + AIF ('&TAPE' EQ 'Y').CUOK + DC A(ILEGOP) 24 U +.CUOK ANOP + AIF ('&TAPE' EQ 'N').NOTCU + DC A(CU) 24 U 00277500 +.NOTCU ANOP + DC A(BWZ) 25 V 00277600 + DC A(BBE) 26 W 00277700 + DC A(NXTOP) 27 X 00277800 + DC A(MZ) 30 Y 00277900 + DC A(MCS) 31 Z 00278000 + DC A(ILEGOP) 32 \ 00278100 + DC A(SW) 33 , 00278200 + DC A(D) 34 % 00278300 + DC A(ILEGOP) 35 WD SEP 00278400 + DC A(ILEGOP) 36 00278500 + DC A(ILEGOP) 37 00278600 + DC A(ILEGOP) 40 - 00278700 + DC A(ILEGOP) 41 J 00278800 + DC A(SS) 42 K 00278900 + DC A(LCA) 43 L 00279000 + DC A(MCW) 44 M 00279100 + DC A(NXTOP) 45 N 00279200 + DC A(ILEGOP) 46 O 00279300 + DC A(MCM) 47 P 00279400 + DC A(SAR) 50 Q 00279500 + DC A(ILEGOP) 51 R 00279600 + DC A(ZS) 52 -0 00279700 + DC A(ILEGOP) 53 $ 00279800 + DC A(ILEGOP) 54 * 00279900 + DC A(ILEGOP) 55 00280000 + DC A(ILEGOP) 56 00280100 + DC A(ILEGOP) 57 00280200 + DC A(ILEGOP) 60 + 00280300 + DC A(A) 61 A 00280400 + DC A(B) 62 B 00280500 + DC A(C) 63 C 00280600 + DC A(MN) 64 D 00280700 + DC A(MCE) 65 E 00280800 + DC A(CC) 66 F 00280900 + DC A(ILEGOP) 67 G 00281000 + DC A(SBR) 70 H 00281100 + DC A(ILEGOP) 71 I 00281200 + DC A(ZA) 72 +0 00281300 + DC A(H) 73 . 00281400 + DC A(CW) 74 00281500 + DC A(ILEGOP) 75 00281600 + DC A(ILEGOP) 76 00281700 + DC A(ILEGOP) 77 00281800 + SPACE +TRTB DC 64X'00',64X'F1',64X'00',64X'F1' 00291000 + TITLE 'ADDRESS CONVERSION SUBROUTINES' 00256500 +* SUBROUTINE TO CONVERT A 1401 ADDRESS TO A 360 ADDRESS 00256700 +* 00256800 +CVAD43 MVI IXTMP,0 00256900 + LR 5,7 LOAD SIMULATED CORE BASE INTO 5 00257000 +CVAD4A IC 3,0(6) 1000'S + 100'S 00257100 + N 3,=F'63' * 00257200 + SLL 3,1 * 00257300 + AH 5,TBHNTH(3) * 00257400 + IC 3,2(6) 4000'S + 1'S 00257500 + N 3,=F'63' * 00257600 + SLL 3,1 * 00257700 + AH 5,TBT4UN(3) * 00257800 + IC 3,1(6) 10'S 00257900 + N 3,=F'15' * 00258000 + SLL 3,1 * 00258100 + AH 5,TBTENS(3) * 00258200 + TM 1(6),X'30' Q/ INDEXING 00258300 + BE CVAD4D NO, DONE 00258400 + CLI IXTMP,1 Q/ SECOND TIME THROUGH 00258500 + BE CVAD4D YES, DONE 00258600 + MVI IXTMP,1 SET SECOND TIME INDICATOR 00258700 + TM 1(6),X'30' Q/ IX3 00258800 + BO CVAD4C IX3 00258900 + TM 1(6),X'20' 00259000 + BO CVAD4B IX2 00259100 + LA 6,SIMCOR+87 IX1 00259200 + B CVAD4A 00259300 +CVAD4B LA 6,SIMCOR+92 00259400 + B CVAD4A 00259500 +CVAD4C LA 6,SIMCOR+97 00259600 + B CVAD4A 00259700 +CVAD4D C 5,SIMLIMIT Q/ IS ADDRESS GREATER THAN 15999 00259800 + BCR 12,8 NO, DONE 00259900 + SH 5,=H'16000' YES, SUBTRACT 16000 00260000 + BR 8 00260100 +IXTMP DS C 00260400 +TBHNTH DC H'0,100,200,300,400,500,600,700,800,900' 00289200 + DC 6H'0' 00289300 + DC H'0,1100,1200,1300,1400,1500,1600,1700,1800,1900,1000' 00289400 + DC 5H'0' 00289500 + DC H'0,2100,2200,2300,2400,2500,2600,2700,2800,2900,2000' 00289600 + DC 5H'0' 00289700 + DC H'0,3100,3200,3300,3400,3500,3600,3700,3800,3900,3000' 00289800 + DC 5H'0' 00289900 +TBT4UN DC H'0,1,2,3,4,5,6,7,8,9' 00290000 + DC 6H'0' 00290100 + DC H'0,4001,4002,4003,4004,4005,4006,4007,4008,4009,4000' 00290200 + DC 5H'0' 00290300 + DC H'0,8001,8002,8003,8004,8005,8006,8007,8008,8009,8000' 00290400 + DC 5H'0' 00290500 + DC H'0,12001,12002,12003,12004,12005,12006,12007,12008' 00290600 + DC H'12009,12000,0,0,0,0,0' 00290700 +TBTENS DC H'0,10,20,30,40,50,60,70,80,90' 00290800 + DC 6H'0' 00290900 +* 00260700 +* SUBROUTINE TO CONVERT A 360 ADDRESS TO A 1401 ADDRESS 00260800 +* 00260900 +CVAD34 L 5,ADR360 00261000 + SR 5,7 SUBTRACT SIMULATED CORE BASE 00261100 + LA 4,0 4000'S ZONE 00261200 + D 4,=F'4000' * 00261300 + SLL 5,4 * 00261400 + LR 1,5 * 00261500 + LR 5,4 1000'S ZONE 00261600 + LA 4,0 * 00261700 + D 4,=F'1000' * 00261800 + SLL 5,4 * 00261900 + LR 2,5 * 00262000 + LR 5,4 100'S NUMERIC 00262100 + LA 4,0 * 00262200 + D 4,=F'100' * 00262300 + OR 5,2 * 00262400 + STC 5,ADR140 * 00262500 + LR 5,4 10'S NUMERIC 00262600 + LA 4,0 * 00262700 + D 4,=F'10' * 00262800 + STC 5,ADR140+1 * 00262900 + OR 4,1 * 00263000 + STC 4,ADR140+2 * 00263100 + TM ADR140,X'0F' Q/ IS HUNDREDS ZERO 00263200 + BC 5,CVAD3A NO 00263300 + OI ADR140,X'0A' YES, ADD 8-2 BITS 00263400 +CVAD3A TM ADR140+1,X'0F' Q/ IS TENS ZERO 00263500 + BC 5,CVAD3B NO 00263600 + OI ADR140+1,X'0A' YES, ADD 8-2 BITS 00263700 +CVAD3B TM ADR140+2,X'0F' Q/ IS UNITS ZERO 00263800 + BCR 5,8 NO, RETURN 00263900 + OI ADR140+2,X'0A' YES, ADD 8-2 BITS 00264000 + BR 8 RETURN 00264100 + TITLE 'ROUTINES TO HELP UNIT RECORD OPERATIONS' 00264200 +READ CLI CRDEOF,X'01' HAVE WE READ LAST CARD 00264900 + BNE READ2 BRANCH IF NO 00265000 + MSG 'I005 READ TRIED AFTER LAST CARD ',I005 25480 + B WTORTN 25530 +READ2 TR TMPARA(80),TREI CHANGE EBCDIC TO INTERNAL 1401 CODE 00265700 + NC SIMCOR+1(80),WM256 REMOVE CARD AREA INFO, KEEP WD MKS 00265800 + OC SIMCOR+1(80),TMPARA 00265900 + LA 12,SIMCOR+81 00266000 +READF STM 13,15,MACREGSV SAVE REGS 25640 + LA 6,MACREGSV SAVE ADDRESS TO XR 00266200 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00266300 + GET CARD,TMPARA READ CARD 00266400 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00266500 + NI SIMCOR,X'40' SET BA BITS IN LOC 0 AFTER READ 00266600 + OI SIMCOR,X'30' * 00266700 + BR 8 00266800 + SPACE 25715 +EOC LM 13,15,0(6) RESTORE SIMULATOR REGISTERS 00266900 + MVI CRDEOF,X'01' SET CARD EOF INDICATOR 00267000 + BR 8 00267100 + SPACE 25745 +WRITE MVC PRNTBUFF+1(132),SIMCOR+201 00267200 + TR PRNTBUFF+1(132),TRIE 00267300 +WRITEC STM 13,15,MACREGSV SAVE MACRO REG 25770 + LA 6,MACREGSV SAVE ADDRESS TO XR 00267500 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00267600 + PUT PRNTDCB,PRNTBUFF 00267700 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00267800 + TR PRNTBUFF(1),LINSKP CONVERT CONTROL CHAR TO LINE COUNT + CLI PRNTBUFF,X'FF' Q. SKIP TO CHANNEL + BE WRITEP YES, SET NEW PAGE + AP LINCUR,PRNTBUFF(1) + CP LINCUR,LINMAX + BL WRITED + MVI PRTP12,1 SET CH 12 INDICATOR + B WRITED +WRITEP SP LINCUR,LINCUR INIT NEW PAGE + MVI PRTP12,0 +WRITED MVI PRNTBUFF,X'09' SET SINGLE SPACE 25880 + LA 12,SIMCOR+333 SET B ADDRESS REGISTER 00268000 + BR 8 00268100 +LINSKP DC X'FF',P'0',7X'FF',P'1',X'FF',P'1',4X'FF' 25920 + DC X'FF',P'2',X'FF',P'2',5X'FF',P'3',X'FF',P'3',4X'FF' + DC 224X'FF' + SPACE 25845 +PUNCH MVC PCHARA,SIMCOR+101 CONVERT 1401 PUNCH AREA FOR OUTPUT 00268200 + TR PCHARA,TRIE * 00268300 + STM 13,15,MACREGSV SAVE MACRO REGS 00268400 + LA 6,MACREGSV SAVE ADDRESS TO XR 00268500 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00268600 + PUT PUNCHR,PCHARA 00268700 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00268800 + LA 12,SIMCOR+181 00268900 + NI SIMCOR+100,X'40' SET 82 BITS IN LOC 100 AFTER PUNCH 00269000 + OI SIMCOR+100,X'0A' * 00269100 + BR 8 00269200 + TITLE ' E R R O R S ' 25960 +ILEGOP MSG 'I008 ILLEGAL OP CODE',I008 26080 + B PANEL 00253000 + SPACE 14036305 +ILEGLN MSG 'I009 ILLEGAL LENGTH',I009 26150 + SPACE 26085 +PANEL LR 1,10 00253600 + SR 1,7 00253700 + CVD 1,PAKT 00253800 + UNPK PNLWTOR+04(6),PAKT+5(3) + MVZ PNLWTOR+09(1),=C'0' + MVC PNLWTOR+19(1),0(10) + NI PNLWTOR+19,X'BF' + TR PNLWTOR+19(1),TRIE + CVD 9,PAKT + UNPK PNLWTOR+33(6),PAKT+5(3) + MVZ PNLWTOR+38(1),=C'0' + MVI PNLWTOR+40,X'80' + MVC PNLWTOR+41(1),PNLWTOR+40 + CH 9,=H'8' + BH WTORPNL + LTR 3,9 + BZ WTORPNL + SH 3,=H'1' + STC 3,PANEL1+1 +PANEL1 MVC PNLWTOR+40(0),0(10) + TR PNLWTOR+40(8),TRIE +WTORPNL MSG ' I OP LENGTH INST X + ',PNLWTOR + B WTORTN + TITLE 'DATA CONVERSION TRANSLATE TABLES' 00289100 +TREI DC 64X'00' 00291100 + DC X'00000000000000000000003B3C3D3E3F' 00291200 + DC X'30000000000000000000002B2C2D2E2F' 00291300 + DC X'20110000000000000000001B1C1D1E1F' 00291400 + DC X'201100000000000000000A0B0C0D0E0F' 00291500 + DC 64X'00' 00291600 + DC X'3A313233343536373839000000000000' 00291700 + DC X'2A212223242526272829000000000000' 00291800 + DC X'1A001213141516171819000000000000' 00291900 + DC X'0A010203040506070809000000000000' 00292000 +TRIE DC X'40F1F2F3F4F5F6F7F8F9F07B7C7D7E7F' 00292100 + DC X'F061E2E3E4E5E6E7E8E9E06B6C6D6E6F' 00292200 + DC X'60D1D2D3D4D5D6D7D8D9D05B5C5D5E5F' 00292300 + DC X'50C1C2C3C4C5C6C7C8C9C04B4C4D4E4F' 00292400 + DC X'40F1F2F3F4F5F6F7F8F9F07B7C7D7E7F' 00292500 + DC X'F061E2E3E4E5E6E7E8E9E06B6C6D6E6F' 00292600 + DC X'60D1D2D3D4D5D6D7D8D9D05B5C5D5E5F' 00292700 + DC X'50C1C2C3C4C5C6C7C8C9C04B4C4D4E4F' 00292800 +TR4IBC DC 16AL1(*-TR4IBC) 00292900 + DC X'00' 00293000 + DC 47AL1(*-TR4IBC) 00293100 +TRI4BC DC X'10' 00293200 + DC 63AL1(*-TRI4BC) 00293300 + DC X'10' 00293400 + DC 63AL1(*-64-TRI4BC) 00293500 +TRWDMK DC 64X'40' 00293700 + DC 64C'1' 00293800 +TYPTBL DC 129AL1(*-TYPTBL) 00293900 + DC C'ABCDEFGHI' 00294000 + DC XL7'00' 00294100 + DC C'JKLMNOPQR' 00294200 + DC XL8'00' 00294300 + DC C'STUVWXYZ' 00294400 + DC 86AL1(*-TYPTBL) 00294500 + TITLE 'C O N S T A N T S && L I T E R A L S' +ADR360 DS F 00260200 +ADR140 DS CL3 00260300 +AEND DC X'0' 00283600 +BCDTAP DS C INDICATOR FOR BCD TAPE MODE 00284200 +CPR DC X'00' 00283100 +CRDEOF DC X'00' CARD END-OF-FILE INDICATOR 00283400 +DCHAR DS C 00283200 +LINCUR DC PL2'1' +LINMAX DC PL2'0' +LSTBCH DS F TO HOLD ADDRESS OF LAST BRANCH 00283300 +MACREGSV DS 18F 00285500 +ONOFF DC 213X'00',X'01',42X'00' +OKSTT DC X'00' +OVRFLO DC X'0' RESET WHEN TESTED 00283000 +PAKT DS D 00285000 + DS 0F 00285100 +PARM DS CL11 ABCDEFGLLLX +PCHARA DS CL80 PUNCH OUTPUT AREA 00284700 +PCHERR DC X'00' PUNCH ERROR INDICATOR 00284300 +PRNTBUFF DC X'09' 00285200 + DC CL132' ' 00285300 +PRTP12 DC X'0' 00282700 +PRTERR DC X'00' PRINTER ERROR INDICATOR 00284500 +RDRERR DC X'00' CARD READ ERROR INDICATOR 00284400 +RETURN DS F 00286600 +SAVEAREA DS 18F 00285400 +SAVCSW DS D 00285600 +SENSEA DC X'0' 00282000 +SENSEB DC X'0' 00282100 +SENSEC DC X'0' 00282200 +SENSED DC X'0' 00282300 +SENSEE DC X'0' 00282400 +SENSEF DC X'0' 00282500 +SENSEG DC X'0' 00282600 +SIMLIMIT DC F'0' UPPER LIMIT OF SIMULATED CORE 00283800 +SUPRES DC X'00' ZERO SUPPRESSION INDICATOR 00284000 +SYSPBUFF DC X'09' + DC CL85' SIM1401' 27250 +TEMP1 DS C 00260500 +TEMP2 DS C 00260600 +TIOTADDR DS A +TMPARA DS CL80 00284600 +TPEOF DC X'0' RESET WHEN TESTED 00282900 +TPERR DC X'0' 00282800 +TRGPWM DC 127X'00',X'7F',128X'00' +WM256 DC 256X'40' 00284900 + SPACE +PRNTDCB DCB MACRF=PM,DSORG=PS,DDNAME=WRITE,LRECL=133 00288600 +SYSPDCB DCB MACRF=PM,DSORG=PS,DDNAME=SYSPRINT,LRECL=133 +PUNCHR DCB MACRF=PM,DSORG=PS,RECFM=F,BLKSIZE=80,LRECL=80, X00288700 + DDNAME=CARDOUT 00288800 +CARD DCB MACRF=GM,DSORG=PS,RECFM=F,BLKSIZE=80,LRECL=80, X00288900 + DDNAME=CARDIN,EODAD=EOC 00289000 + SPACE + LTORG 00294700 + SPACE +SIMCOR DSECT 00294800 + DS CL16020 00294900 + CSECT + TITLE 'T A P E I / O S U P P O R T' + AIF ('&TAPE' EQ 'N').NOTAPE + AIF ('&CONSOLE' EQ 'N').RWD +* THIS SECTION SIMULATES THE LOAD TAPE PUSHBUTTON. 00218200 +* 00218300 +TPLOAD LA 10,=X'00000001' 00218400 + BAL 8,FNDRIV 00218500 + ST 3,TMDCB 00218600 + MVC TPCCW,=A(LDTCCW) 00218700 + MVI TMIOB,X'44' 00218800 + STM 13,15,MACREGSV SAVE MACRO REGS 00218900 + LA 6,MACREGSV SAVE ADDRESS TO XR 00219000 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00219100 + EXCP TMIOB 00219200 + LM 14,15,4(6) RESTORE REG 14 AND 15 00219300 + WAIT 1,ECB=TMECB WAIT FOR I/O 00219400 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00219500 + LH 1,TMIOB+14 LOAD BYTE COUNT FROM CSW 00219600 + LH 2,=H'20000' 00219700 + SR 2,1 00219800 + LA 3,SIMCOR+1 00219900 + L 1,TAPEAREA 00220000 +TPLD1 CLI 0(1),X'1D' 00220100 + BNE TPLD2 00220200 + LA 1,1(1) 00220300 + MVC 0(1,3),0(1) 00220400 + TR 0(1,3),TR4IBC 00220500 + OI 0(3),X'40' 00220600 + SH 2,=H'1' 00220700 + B TPLD3 00220800 +TPLD2 MVC 0(1,3),0(1) 00220900 + TR 0(1,3),TR4IBC 00221000 +TPLD3 LA 1,1(1) 00221100 + LA 3,1(3) 00221200 + BCT 2,TPLD1 00221300 + NI 0(3),X'40' 00221400 + OI 0(3),X'3F' 00221500 + LA 12,1(3) 00221600 + LA 10,SIMCOR+1 00221700 + LA 9,0 00221800 + MVI OKSTT,1 00221900 + B NXTOP 00222000 +* 00222100 +* THIS SECTION WILL WRITE A TAPE MARK ON THE TAPE DRIVE 00244800 +* SELECTED BY THE WTM COMMAND. 00244900 +* 00245000 +WTMCMD NI RQSTIN+3,X'0F' GET DEVICE ADDRESS 00245100 + LA 10,RQSTIN * 00245200 + BAL 8,FNDRIV * 00245300 + ST 3,TMDCB 00245400 + MVC TPCCW,=A(WTMCCW) 00245500 + STM 13,15,MACREGSV SAVE MACRO REGS 00245600 + LA 6,MACREGSV SAVE ADDRESS TO XR 00245700 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00245800 + EXCP TMIOB 00245900 + LM 14,15,4(6) RESTORE REG 14 AND 15 00246000 + WAIT 1,ECB=TMECB WAIT FOR I/O 00246100 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00246200 + B WTORTN 00246300 +* 00246400 +* THIS SECTION WILL REWIND THE TAPE SELECTED BY THE RWD COMMAND 00249200 +* 00249300 +RWDCMD NI RQSTIN+3,X'0F' GET DEVICE ADDRESS 00249400 + LA 10,RQSTIN * 00249500 + BAL 8,FNDRIV * 00249600 + ST 3,TMDCB 00249700 + MVC TPCCW,=A(RWDCCW) 00249800 + MVI TMIOB,X'04' 00249900 + STM 13,15,MACREGSV SAVE MACRO REGS 00250000 + LA 6,MACREGSV SAVE ADDRESS TO XR 00250100 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00250200 + EXCP TMIOB 00250300 + LM 14,15,4(6) RESTORE REG 14 AND 15 00250400 + WAIT 1,ECB=TMECB WAIT FOR I/O 00250500 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00250600 + B WTORTN 00250700 +.RWD ANOP + SPACE +FNDRIV IC 3,3(10) 14038090 + BCTR 3,0 SUBTRACT ONE 00271000 + N 3,=F'7' 14038110 + SLL 3,3 MULTIPLY LOGICAL DRIVE NUMBER BY 8 00271200 + A 3,=A(TAPADR) ADD BASE OF TAPE ADDRESS TABLE 00271300 + L 3,4(3) GET ACTUAL TAPE ADDRESS FROM TABLE 00271400 + USING IHADCB,3 + TM DCBOFLGS,X'10' + BNZ FNDRIV2 + SPACE 14036245 + MSG 'I007 UNDEFINED TAPE',I007 + B PANEL 00252400 + SPACE +FNDRIV2 MVI TMECB,0 CLEAR ECB BEFORE EXCP 00271500 + NI 0(3),X'3F' CLEAR DCB EXCEPTION BITS 00271600 + MVI TMIOB,X'42' SET IOB CMD CHAIN + UNRELATED BITS 00271700 + BR 8 00271800 + SPACE 14038185 +FNDLNG LR 6,12 00269400 +FNDLGA TRT 0(256,6),TRGPWM SCAN FOR GP MK - WD MK 00269500 + BC 6,FNDLGB FOUND 00269600 + LA 6,256(6) 00269700 + B FNDLGA 00269800 +FNDLGB LR 6,1 CALCULATE LENGTH 00269900 + SR 6,12 * 00270000 + BR 8 00270100 + SPACE 14038015 +TPTEST MVC SAVCSW+1(7),TPCSW SAVE CSW AFTER TAPE OPERATION 00271900 + TM SAVCSW+4,1 Q/ EOF 00272000 + BZ TPTIO1 00272100 + LH 4,=H'24999' 00272200 + STH 4,SAVCSW+6 00272300 + L 4,TAPEAREA PUT TAPE MARK CHARACTER IN TAPE AREA 00272400 + MVI 0(4),X'0F' * 00272500 + MVI TPEOF,1 00272600 +TPTIO1 MVI TPERR,0 00272700 + TM SAVCSW+4,2 Q/ TAPE ERROR 00272800 + BCR 8,8 00272900 + MVI TPERR,1 00273000 + BR 8 00273100 + SPACE 14038315 +CU CH 9,=H'5' 00150100 + BNE ILEGLN 00150200 + CLI 4(10),X'29' 00150300 + BE RWD 00150400 + CLI 4(10),X'24' 00150500 + BE WTM 00150600 + CLI 4(10),X'14' 00150700 + BE RWU 00150800 + CLI 4(10),X'32' 00150900 + BE BSP 00151000 + CLI 4(10),X'35' 00151100 + BE SKP 00151200 + B ILEGOP 00151300 +RWD MVI CUCCW,X'07' 00151400 + B CU1 00151500 +WTM MVI CUCCW,X'1F' 00151600 + B CU1 00151700 +BSP MVI CUCCW,X'27' 00151800 + B CU1 00151900 +SKP MVI CUCCW,X'17' 00152000 +CU1 BAL 8,FNDRIV 00152100 + ST 3,CUDCB 00152200 + MVI CUECB,0 00152300 + MVI CUIOB,X'42' SET COMMAND CHAIN + UNRELATED BITS 00152400 + STM 13,15,MACREGSV SAVE MACRO REGS 00152500 + LA 6,MACREGSV SAVE ADDRESS TO XR 00152600 + LA 13,SAVEAREA GIVE OS OUR SAVE AREA 00152700 + EXCP CUIOB 00152800 + LM 14,15,4(6) RESTORE REG 14 AND 15 00152900 + WAIT 1,ECB=CUECB 00153000 + LM 13,15,0(6) RESTORE MACRO REGISTERS 00153100 + B NXTOP 00153200 +RWU IC 2,3(10) GET 1401 DRIVE NUMBER 00153300 + N 2,=F'7' * 00153400 + BCTR 2,0 SUBTRACT 1 00153500 + SLL 2,3 REFERENCE TAPADR TABLE ENTRY 14025670 + L 4,TAPADR+4(2) GET DCB ADDRESS 00154000 + STM 14,15,MACREGSV SAVE BASE REGISTERS + LA 6,MACREGSV * 00273300 + LA 13,SAVEAREA * 00273400 + CLOSE ((4)) CLOSE THE DCB 00273500 + LM 14,15,0(6) 00273600 + B NXTOP 00273700 +CUCCWMS CCW X'63',0,X'60',1 MODE SET 00154300 +CUCCW CCW 0,0,X'20',1 00154400 +TMIOB DS 0D 00247800 + DC X'42' 00247900 + DC 4X'00' 00248000 + DC AL3(TMECB) 00248100 + DC X'00' 00248200 +TPCSW DC 7X'00' 00248300 +TPCCW DC XL4'00' ADDRESS OF CCW FOR TAPE OPERATION 00248400 +TMDCB DC XL4'00' DCB ADDRESS FOR TAPE DRIVE SELECTED 00248500 + DC 4X'00' 00248600 + DC 2X'00' 00248700 + DC 2X'00' 00248800 +TMECB DS 0F 00248900 + DC 4X'00' 00249000 +TAPEAREA DC A(SIMTAPE) ADDRESS OF TAPE I/O BUFFER + SPACE +WTCCW1 CCW X'63',1,X'60',1 00285800 +WTCCW2 CCW 1,SIMTAPE,X'20',0 +LDTCCW CCW X'63',0,X'60',1 00286000 +RTCCW CCW 0,0,X'60',1 READ TAPE 00286200 +RTCCW1 CCW 2,SIMTAPE,X'20',25000 +WTMCCW CCW X'1F',0,X'20',1 WRITE TAPE MARK 00286400 +RWDCCW CCW X'07',0,X'20',1 REWIND 00286500 +CUIOB DS 0D 00286700 + DC X'02' 00286800 + DC 4X'00' 00286900 + DC AL3(CUECB) 00287000 + DC 8X'00' 00287100 + DC AL4(CUCCWMS) 00287200 +CUDCB DC F'0' 00287300 + DC 8X'00' 00287400 +CUECB DC F'0' 00287500 +* 00287600 +* THIS TABLE EQUATES A 360 TAPE DRIVE TO A 1401 TAPE DRIVE AS A 00287700 +* RESULT OF A TAS ENTRY. 00287800 +* 00287900 +TAPADR DC A(0,TAPEDCB0) 00288000 + DC A(0,TAPEDCB1) 00288100 + DC A(0,TAPEDCB2) 00288200 + DC A(0,TAPEDCB3) 00288300 + DC A(0,TAPEDCB4) 00288400 + DC A(0,TAPEDCB5) 00288500 + LTORG +TAPEDCB0 DCB MACRF=(E),DSORG=PS,DEVD=TA,DDNAME=TAPE1 14035720 +TAPEDCB1 DCB MACRF=(E),DSORG=PS,DEVD=TA,DDNAME=TAPE2 14035730 +TAPEDCB2 DCB MACRF=(E),DSORG=PS,DEVD=TA,DDNAME=TAPE3 14035740 +TAPEDCB3 DCB MACRF=(E),DSORG=PS,DEVD=TA,DDNAME=TAPE4 14035750 +TAPEDCB4 DCB MACRF=(E),DSORG=PS,DEVD=TA,DDNAME=TAPE5 14035760 +TAPEDCB5 DCB MACRF=(E),DSORG=PS,DEVD=TA,DDNAME=TAPE6 14035770 +SIMTAPE DS CL25600 +.NOTAPE ANOP + TITLE 'S Y S T E M C O N T R O L B L O C K S' +TIOT DSECT +TIOCNJOB DS CL8 JOB +TIOCSTP DS CL8 PROC + DS CL8 PROC STEP +* F O R E A C H D D E N T R Y +TIOELNGH DS FL.8 + DS CL3 +TIOEDDNM DS CL8 DD NAME + DS CL4 +* F O R E A C H D E V I C E +TIOESTTB DS CL1 +TIOEFSRT DS AL.24 UCB ADDRESS + SPACE + DCBD DSORG=PS,DEVD=TA + SPACE +UCB DSECT + DS CL12 +UCBWGT DS CL1 +UCBNAME DS CL3 + END BEGIN +//** EXEC ASF *// +//**C.SYSIN DD DSN=HERC01.SIM1401,DISP=OLD *// +/*