ASCENT S1401 ENTRY S1401 EJECT ....................................................................... . ROUTINE TO READ CONTROL CARD AND SIMULATE LOAD CARD . START OR LOAD TAPE START ....................................................................... S1401 SB1 B0 .ZERO B1 RJ READF .GO READ THE CONTROL CARD SX6 2 SX7 B0 . CDREAD SA1 CARD+B1 .LOAD CARD CHARACTER SB1 B1+1 .STEP B1 SB2 X1 .PUT IN B2 SB3 55B .LOAD A BLANK EQ B2,B3,LDPHASE .HAVE WE ENCOUNTERED A BLANK SB3 = 24B .LOAD A T EQ B2,B3,TLOAD .IF T, THEN SET FLAG SB3 47B .LOAD * EQ B2,B3,TRACE .IF = *,SET SWITCH SB3 45B .LOAD + EQ B2,B3,IOSTOP .IF = +,SET FLAG SB3 10B .LOAD H EQ B2,B3,HALTING .IF = H,SET FLAG SB3 1 .LOAD 1 LT B2,B3,NOTA .SEE IF .LT. A SB3 8 .LOAD 8 GE B2,B3,NOTA .SEE IF .GE. H SA6 STOP+B2 .STORE A 1 IN SW(N) EQ CDREAD .GO GET NEXT CHARACTER NOTA SB3 33B .LOAD A 0 LT B2,B3,CDREAD .NOT A DIGIT,GO BACK SB4 45B .LOAD A + GE B2,B4,CDREAD .RETUN IF NOT DIGIT EQ B2,B3,ERRORC .0 NOT AN ALLOWED CODE SB3 42B .LOAD A 7 GE B2,B3,ERRORC .TAPES .NE.7,8,9 SB2 B2-27 .REDUCE DIGIT SA1 CARD+B1 .CHECK FOR HI OR LO DENSITY SX1 X1-14B .IS IT AN L FOR LO NZ X1,HIDENS .IF NOT,ASSUME HI DENSITY SX6 1 .SET LO SWITCH HIDENS SA1 SWG+B2 .CHECK FOR PREVIOUS DEFINITION NZ X1,ERRORT .DUPLICATE DEFINITION SA6 SWG+B2 .ELSE STORE 1 SX6 2 SB1 B1+1 .INCREMENT COLUMN POINTER EQ CDREAD .GO GET NEXT CHARACTER TLOAD SA6 TPLOAD .STORE 1 EQ CDREAD .CONTINUE SCAN TRACE SA6 TRAP .SET TRACE SWITCH EQ CDREAD .CONTINUE SCAN IOSTOP SA7 IOCK .SET IO CHECK STOP OFF EQ CDREAD .GO ON SCANNING HALTING SA6 STOP .SET HALT SW ON EQ CDREAD .RESUME SCAN LDPHASE SB1 CORE+80 .CLEAR OUT THE READ AREA SB2 CORE .SET TO CORE SB3 1 CLR SA7 B1 .ZERO 1-80 SB1 B1-B3 .DECREASE B1 NE B1,B2,CLR .SEE IF DONE MX7 1 .LOAD A WORD MARK SA7 B2+1 .SET WM IN 1 SA2 TPLOAD .LOAD SWITCH NZ X2,TPE ..NE. 0 THEN TAPE START SA0 B0 . RJ RD .GO READ A CARD SX6 CORE+1 .LOAD INITIAL ADDRESS SA6 CTRL .SET 1 = START ADDRESS EQ INIT .START EXECUTION TPE SB1 B2+1 .LOAD CORE+1 IN I-REGISTER SB7 B2+1 .LOAD CORE+1 IN B-REGISTER SX3 1 .SET TAPE NUMBER EQ TPSTRT .READ TAPE WITH WM/S INIT SA1 CTRL .LOAD THE STARTING ADDRESS SB1 X1 .PUT IT IN A B1 ICYCLE SB2 CORE+CORESIZ .LOAD CORE LIMIT SB4 CORE .LOAD BOTTOM OF CORE GE B4,B1,ERROR1 .IF ACDRESS .LE. ZERO LT B2,B1,ERROR1 .IF ADDRESS .GT. 7999, ERROR SA1 B1 .LOAD THE OPCODE PL X1,ERROR2 .SEE IF IT HAS A WORD MARK CK1 SB2 1 .LOAD 1 TO B2 SA2 = B1+B2 .FETCH CORE+CTRL+1 NG X2,IOOP5 .1CHARACTERINSTRUCTION SB2 = B2+B3 .STEP B2 SA2 = B1+B2 .FETCH CORE+CTRL+2 NG X2,IL2 .2 CHARACTER INSTRUCTION SB2 = B2+B3 .STEP B2 SA2 = B1+B2 .FETCH CORE+CTRL+3 NG X2,ERRORI .ERROR,NO 3 CHAR. INSTRUCTIONS SB2 = B2+B3 .STEP B2 SA2 = B1+B2 .FETCH CORE+CTRL+4 NG X2,IL4 .4 CHAR. INSTRUCTION SB2 = B2+B3 .STEP B2 SA3 = B1+B2 .LOAD CORE+CTRL+5 NG X3,IL5 .5 CHARACTER INSTRUCTION ZR X2,CKBRNCH .MAYBE A BRANCH INSTRUCTION CK6 SB2 = B2+B3 .STEP B2 SA2 = B1+B2 .LOAD CORE+CTRL+6 NG X2,ERRORI .ERROR,NO 6 CHAR. INSTR. SB2 = B2+B3 .STEP B2 SA2 = B1+B2 .LOAD CORE+CTRL+7 NG X2,IL7 .7 CHARACTER INSTRUCTION SA2 (40010000000000000013B).LOAD A 1401 *,* BX2 X1-X2 .SEE IF OPCODE = *,* ZR X2,IL7 .IF SO THEN NO WM IS OK SA2 (40010000000000000001B).LOAD A 1401 */* BX2 X1-X2 .SEE IF OPCODE = */* ZR X2,IL7 .IF SO , NO ERROR SB2 = B2+B3 .STEP B2 SA2 = B1+B2 .LOAD CORE+CTRL+8 NG X2,IL8 .8 CHARACTER INSTRUCTION EQ ERRORI .OTHERWISE INSTRUCTION ERROR CKBRNCH SA2 (40030000000000000002B) .LOAD A 1401 B WITH WM BX2 X1-X2 .CHECK OPCODE ZR X2,IL5 .IF = B THEN OK EQ CK6 .ELSE CONTINUE IL2 SA2 B1+B3 .LOAD D CHARACTER BX7 = X2 .TRANSMIT DCHAR. SA7 DMOD .STORE D MODIFIER EQ IOOP5 .GO ADD IT TO IREG IL4 SB1 = B1+B2 .ADD LENGTH TO I REGISTER RJ GETA .GET THE A-ADDRESS SB6 X7 .PUT IN A REGISTER EQ CKOP .GO LOOK AT OP IL5 SB4 B2-B3 .DECREMENT B2 TO B4 SA2 = B1+B4 .LOAD CORE + CTRL + 4 BX7 X2 .TRANSMIT DCHAR SA7 DMOD .SORE IT SA4 (00010000000000000014B) .LOAC A 1401 ( SA3 = B1+B3 .LOAD CORE+CTRL+1 BX3 X4-X3 .DOES 2ND CHAR = ( ZR X3,IOOP5 .IF NONZERO NOT AN I/O INSTR. SB1 = B1+B2 .ADD IT TO IREG RJ GETA .FETCH A-ADDRESS SB6 X7 .STOFE THE A ADDRESS EQ CKOP .GO LOOK AT OP IOOP5 SB1 = B1+B2 .ADD LENGTH TO I REGISTER EQ CKOP .GO LOOK AT OP IL7 SB2 7 .SET INSTRUCTION LENGTH IL7A SB1 = B1+B2 .ADD IT TO IREG RJ GETA .GET A-ADDRESS SB6 X7 .STORE THE A ADDRESS IL7B RJ GETB .GET B-ADDRESS SB7 X7 .STORE B ADDRESS EQ CKOP .GO LOOK AT OP IL8 SB4 B2-1 .DECREMENT B2 TO B4 SA2 B1+B4 .FETCH D CHARACTER BX7 X2 .TRANSMIT X2 SA7 DMOD .STORE IN DMOD SA3 B1+B3 .LOAD CORE+CTRL+1 SA4 (00010000000000000014B) .LOAD A ( BX3 X4-X3 .CHECK FOR ( NZ X3,IL7A .NOT AN I/O INSTRUCTION SB1 = B1+B2 .ADD IT TO IREG EQ IL7B .GO GET B ADDRESS CKOP LX1 1 .REMOVE THE WM BIT AX1 1 .BY SHIFTING IT OFF UX4 B0,X1 .GET COEFFICIENT AX1 44 .SHIFT ZONES DOWN IX1 X1+X4 .CONSTRUCT PACKED FORM SA1 OPTABLE+X1 .LOAD TABLE ADDRESS SB4 X1 .PUT IT IN A B REGISTER JP B4 .GO TO OPCODE ROUTINE EJECT ....................................................................... . G E T A . SUBROUTINE TO EVALUATE A-ADDRESS . ENTRY PARAMS . B1 = I-REGISTER . B2 = LENGTH . X0 = 1 . EXIT PARAMS . X7 = RELATIVE 6400 A-ADDRESS . REGISTERS USED . A2,A3,A7 . B1,B2,B4,B5 . X0,X2,X3,X7 . SUBROUTINES USED - GET . ....................................................................... GETA JP * .ENTRY POINT SA0 B0 .INDICATE A-ADDRESS ENTRY SB4 B1-B2 .LOAD I-ADDRESS SB4 = B4+3 .ADD 3 TO I-ADDR. GETAA RJ GET .EVALUATE ADDRESS SA7 TEMP1 .HOLD THE ADDRESS SX2 CORESIZ .LOAD CONSTANT SIZE OF CORE IX2 X2-X7 .GET DIFFERENCE NG X2,ERROR4 .NEGATIVE GIVE ADDRESS ERROR SA2 B4-B3 .LOAD 10S POSITION SA3 MASK1 .LOAD MASK BX2 X2*X3 .MASK OFF ZONES ZR X2,OVER .NO INDEXING AX2 48 .PUT IN UNITS POSITION SX2 X2-1 .SUBTRACT 1 ZR X2,INDEX1 .INDEXED BY 1 SX2 X2-1 .SUBTRACT 1 ZR X2,INDEX2 .INDEXED BY 2 SB4 CORE+99 .LOAD ADDRESS EQ GETXR .GO EVALUATE XR INDEX1 SB4 CORE+89 .LOAD X1 ADDRESS EQ GETXR .GO EVALUATE XR INDEX2 SB4 CORE+94 .LOAD X2 ADDRESS GETXR RJ GET .EVALUATE INDEX SA2 TEMP1 .LOAD ADDRESSS IX7 X2+X7 .ADD INDEXING OVER SX2 15999 .LOAD CONSTANT IX3 X2-X7 .GET DIFFERENCE NG X3,DECREAS .GO LOWER THE VALUE MIN16 SX2 CORESIZ .LOAD SIZE OF MACHINE IX3 X2-X7 .GET DIFFERENCE NG X3,ERROR4 .ERROR IF .GT. 7999 SX7 X7+CORE .GET CORE + ADDRESS SX0 A0 .LOAD INDICATOR ZR X0,GETA .CHECK ENTRY POINT EJECT ....................................................................... . G E T B . SUBROUTINE TO EVALUATE THE B-ADDRESS . ENTRY PARAMS . B3 = 1 . OTHER PARAMETERS SAME AS FOR GETA ....................................................................... GETB JP * .ENTRY POINT SA0 B3 .SET FLAG SB4 B1-B2 .GET I-ADDRESS SB4 B4+6 .SET TO I-ADDRESSS+6 EQ GETAA .GO PROCESS IT EJECT ....................................................................... . G E T . SUBROUTINE TO CONVERT A 3 CHARACTER 1401 ADDRESS TO . BINARY. THE AREA IS ASSUMED NOT TO BE INDEXED. . . ENTRY PARAMS . B4 = 6400 ADDRESS OF LOW ORDER POSITION OF 3 CHARACTERS . CONSTITUTING A 1401 ADDRESS . EXIT PARAMS . X7 = 6400 BINARY EQUIVALENT OF 1401 ADDRESS. ADDRESS IS NOT . RELOCATED. A FACTOR OF CORE MUST BE ADDED TO GET A LOCATION . IN PSEUDO STORAGE. . REGISTERS USED . A2,A3,A6 . B4,B5 . X2,X3,X4,X5,X6 . . SUBROUTINES CALLED - NONE ....................................................................... GET JP * SB5 B0 SA5 MASK1 SA3 B4 BX4 X3*X5 LX4 2 SA2 B4-2 BX0 X2*X5 IX0 X0+X4 AX0 48 BX4 X0 LX0 3 LX4 1 IX7 X0+X4 MX5 12 BX0 -X5*X2 SX6 X0-10 ZR X6,DO10 IX7 X0+X7 DO10 BX6 X7 LX7 3 LX6 1 IX7 X7+X6 SA2 B4-1 BX0 -X5*X2 SX6 X0-10 ZR X6,DO1 IX7 X0+X7 DO1 BX6 X7 LX7 3 LX6 1 IX7 X7+X6 BX0 -X5*X3 SX6 X0-10 ZR X6,GET IX7 X0+X7 EQ GET DECREAS SX7 X7-16000 .REDUCE BY 16000 EQ MIN16 .RETURN EJECT ....................................................................... . C W R O U T I N E . . ENTRY PARAMS . B2 = LENGTH OF INSTRUCTION . B3 = 1 . B6 = A-REGISTER . B7 = B-REGISTER . . REGISTERS USED . A2,A3,A6 . B2,B3,B4,B5,B6,B7 . X2,X3,X6 . . SUBROUTINES CALLED - DECRA,DECRB ....................................................................... CW SB5 B0 .SET CW FLAG MERGE EQ B2,B3,NORM .LENGTH = 1,CHAINING SB4 7 .LOAD CONSTANT EQ B2,B4,NORM .NORMAL CLEAR WM SB4 4 .LOAD 4 NE B2,B4,ERRORI .LENGTH .NE. 4 SB7 B6 .PUT A-ADDRESS IN B-ADDRESS NORM EQ B5,CWM .CW ENTRANCE MX3 1 .LOAD WORD MARK SA2 B6 .LOAD WORD MARK BX6 X2+X3 .OR IN WORD MARK SA6 B6 .PUT IT BACK SA2 B7 .LOAD B-FIEKD BX6 X2+X3 .OR IN WORD MARK SA6 B7 .STORE IT BACK EQ FIXREG .GO FIX THE REGISTERS CWM SA2 B6 .LOAD A FIELD LX2 1 .REMOVE THE WM AX2 1 . BX6 X2 .PUT IN X6 SA6 B6 .STORE IT BACK SA2 B7 .LOAD B-FIELD LX2 1 .REMOVE WM AX2 1 . BX6 X2 . SA6 B7 .STORE IT BACK FIXREG RJ DECRA .DECREASE A-REG BY 1 RJ DECRB .DECREASE B-REG BY 1 SX6 B6 .GET A-REG SA6 SAVEA .SAVE IT FOR SAR EQ ICYCLE .BACK FOR NEXT INSTRUCTION EJECT ....................................................................... . D E C R A . THIS ROUTINES RDEUCES THE 1401 A-REGISTER BY 1 . ENTRY PARAMS . B3 = 1 . B6 = A-REGISTER . SUBROUTINES CALLED - NONE ....................................................................... DECRA JP * .ENTRY POINT SB6 = B6-B3 .DECREASE A-REG BY 1 SB3 CORE .GET BASE ADDRESS LT B6,B3,ERROR4 .IS ADDRESS OUT OF BOUNDS SB3 1 .RESTORE 1 EQ DECRA .RETURN EJECT ....................................................................... . D E C R B . BO = 1 . B7 = B-REGISTER . SUBROUTINES CALLED - NONE ....................................................................... DECRB JP * .ENTRY POINT SB7 = B7-B3 .DECREASE B-REG BY 1 SB3 CORE .GET BASE ADDRESS LT B7,B3,ERROR4 .IS ADDRESS OUT OF BOUNDS SB3 1 .RESTORE 1 EQ DECRB .RETURN EJECT ....................................................................... . S W R O U T I N E . PARAMETERS ARE THE SAME AS C W ROUTINE ....................................................................... SW SB5 = B3 .SET SW FLAG EQ MERGE .ENTER FLOW OF CW EJECT ....................................................................... . M Z R O U T I N E . ENTRY PARAMS . B2 = LENGTH OF INSTRUCTION . B3 = 1 . B6 = AREGISTER . B7 = B-REGISTER . REGISTERS USED . B2,B3,B4,B5,B6,B7 . A2,A3,A4,A6 . X2,X3,X4,X6 . SUBROUTINES CALLED - DECRA,DECRB (INDIRECTLY) ....................................................................... MZ EQ B2,B3,MZ1 .ONLY OPCODE SB4 7 .LOAD 7 NE B2,B4,ERRORI .LENGTH .NE. 7,ERROR MZ1 SA2 B6 .LOAD A-FIELD SA3 B7 .LOAD B-FIELD SA4 MASK1 .LOAD THE MASK BX2 X2*X4 .REMOVE ALL BUT ZONES SA4 (40000000000000000017B) .LOAD MASK BX6 X3*X4 .MASK OFF ZONES BX6 X6+X2 .PUT IN ZONE BITS SA6 B7 .STORE IT BACK EQ FIXREG .REDUCE REGISTERS EJECT ....................................................................... . . M N R O U T I N E . PARAMETERS ARE THE SAME AS MZ ROUTINE ....................................................................... MN SA2 B6 .LOAD A-FIELD SA3 B7 .LOAD B-FIELD SA4 MASK2 .LOAD MASK BX3 X4*X3 .REMOVE NUMERIC BITS LX2 12 .TAKE WM AND ZONE AX2 12 .BITS OFF A-FIELD BX6 X2+X3 .CREATE WORD SA6 B7 .STORE IT BACK EQ FIXREG .GO REDUCE REGISTERS EJECT ....................................................................... . . C N V R T . ROUTINE TO CONVERT A BINARY NUMBER LESS THAN 16000 TO A . THREE CHARACTER 1401 ADDRESS IN ADDR1,ADDR2,ADDR3 . ENTRY PARAMS . B4 = NUMBER TO BE CONVERTED . REGISTERS USED . A0,A2,A6,A7 . B4,B5 . X2,X6,X7 . ....................................................................... CNVRT JP * .ENTRY POINT SX6 B0 .ZERO X6 SX7 B0 .ZERO X7 SX4 1 .LOAD 1 SX3 10 .LOAD 8-2 CONFIGURATION SB5 8000 .LOAD CONSTANT GE B4,B5,DOWN8 .B4.GE. 8000 FOUR SB5 4000 .LOAD CONSTANT GE B4,B5,DOWN4 .B4 .GE. 4000 TWO SB5 2000 .LOAD 2000 GE B4,B5,DOWN2 .B4 .GE. 2000 ONE SB5 1000 .LOAD 1000 GE B4,B5,DOWN1 . .GE. 1000 .... ADJUST1 LX6 48 .PUT ZONES IN RIGHT SPOT LX7 48 .DITTO SB5 100 .LOAD 100 ADJUST2 GE B4,B5,DOWN100 .IF .GE. 100 GO DCREASE SB5 X6 .GET NUMERIC PART NE B5,B0,STR1 .OK IF IT IS NONZERO BX6 X6+X3 .IF ZERO PUT IN 8-2 FORM STR1 SA6 ADDR1 .STORE 100S RESULT SX6 B0 .ZERO REGISTER SB5 10 .LOAD 10 ADJUST3 GE B4,B5,DOWN10 .GO DECREASE IF .GE. 10 SX2 B4 .PUT IN X-REGISTER IX7 X2+X7 .ADD IN NUMERIC SB5 X6 .GET NUMERIC PART NE B5,B0,STR2 .JUMP ON NONZERO BX6 X6+X3 .OTHERWISE CHANGE ZERO TO 8-2 STR2 SB5 X7 .LOAD NUMERIC PART NE B5,B0,STR3 .JUMP IF NO CONVERSION NEEDED BX7 X7+X3 .OR IN 8-2 FORM STR3 SA6 ADDR2 .STORE 10S RESULT SA7 ADDR3 .STORE 1S RESULT EQ CNVRT .RETURN DOWN8 SB4 = B4-B5 .DECREASE BY 8000 SX7 X7+2 .PUT IN B ZONE EQ FOUR .CONTINUE DOWN4 SB4 = B4-B5 .DECREASE BY 4000 SX7 X7+1 .PUT IN A ZONE EQ TWO .CONTINUE DOWN2 SB4 = B4-B5 .DECREASE BY 2000 SX6 X6+2 .PUT IN B ZONE EQ ONE .CONTINUE DOWN1 SB4 = B4-B5 .DECREASE BY 1000 SX6 X6+1 .PUT IN A ZONE EQ ADJUST1 .DONE WITH ZONE PART DOWN100 SB4 = B4-B5 .SUBTRACT 100 IX6 X6+X4 .ADD 1 TO NUMERIC EQ ADJUST2 .GO TRY AGAIN DOWN10 SB4 = B4-B5 .SUBTRACT 10 IX6 X6+X4 .ADD 1 TO NUMERIC EQ ADJUST3 .KEEP IT UP EJECT ....................................................................... . C S R O U T I N E . ENTRY PARAMS . B2 = LENGTH . B6 = A-REGISTER . B7 = B-REGISTER . REGISTERS USED . A0,A2,A3,A6,A7 . B2,B3,B4,B5,B6,B7 . SUBROUTINES CALLED - DECRB ....................................................................... CS SX0 B0 .ZERO BRANCH FLAG EQ B2,B3,CSALL .CHECK IL FOR 1 SB4 4 .LOAD CONSTANT 4 EQ B2,B4,CS4 .CHECK IL FOR 4 SB4 7 .LOAD CONSTANT 7 NE B2,B4,ERRORI .IF IL NOT 7,ERROR CS7 SX0 B3 .IF IL = 7, SET BRANCH FLAG EQ CSALL .GO TO CSALL CS4 SB7 B6 .A-REGISTER EQUAL B-REGISTER CSALL SB4 CORE .LOAD 1401 ZERO LOCATION SB5 100 .LOAD 100 CLOOP LT B7,B4,CRED .ARE WE OVER YET GE B4,B7,CLEARST .IS IT A HUNDRED POSITION SB4 B4+B5 .STEP BY A 100 EQ CLOOP CRED SB4 B4-B5 .TAKE AWAY 100 CLEARST SX6 B0 .GET ZERO FOR CLEARING SB5 CORE .SET STOP ADDRESS CSLOP SA6 B7 .STORE ZERO STARTING EQ B5,B7,CSPR .DO WE NEED WRAPAROUND ADDRESS SB7 B7-B3 .DECREASE CLEARING ADDRESS GE B7,B4,CSLOP .GOING DOWN CBRN NZ X0,TRA .BRANCH IF FLAG SET EQ SAVEREG .FIX UP REGS AND RETURN CSPR SB7 CORE+CORESIZ .LOAD CORE LIMIT EQ CBRN .GO SEE IF BRANCH EJECT ....................................................................... . ROUTINE TO SET REGISTERS FOR BRANCHES . ENTRY PARAMS . B1 = I-REGISTER . B6 = A-REGISTER . B7 = B-REGISTER ....................................................................... TRA SB7 = B1 .PUT I-ADDRESS IN B-REGISTER SB1 B6 .PUT BRANCH ADDRESS IN I-REG EQ SAVEREG .GO SAVE REGS AND RETURN EJECT ....................................................................... . R E A D R O U T I N E ....................................................................... RD JP * .ENTRY POINT SA1 LASTCD .LOAD INDICATOR NZ X1,ERRORE .IF ON NO MORE CARDS RJ READF .GO READ A CARD SB4 79 .LOAD 79 DECODE SA1 CARD+B4 .LOAD CARD CHARACTER SB5 X1 .PULL IN CHAR TO B5 SA1 INPTABL+B5 .PULL IN 140U EQUIVALENT SA2 CORE+1+B4 .LOAD 1401 LOCATION MX3 1 .LOAD MASK BX6 X2*X3 .SAVE ANY WORD MARK BX6 X1+X6 .OR IN WITH WORD MARK IF ANY SA6 CORE+1+B4 .STORE IT EQ B4,RD .SEE IF DONE SB4 B4-B3 .IF NOT DO NEXT CHAR EQ DECODE .GO DO NEXT EJECT ....................................................................... . P R I N T R O U T I N E ....................................................................... PRNTL JP * .ENTRY POINT SA1 CORE+200 .LOAD CORE+200 BX6 X1 .TRANSMIT TO X6 SA6 HOLD200 .SAVE IT SA1 CARRCON .LOAD CARRIAGE CONTROL BX6 X1 .TRANSMIT TO X6 SA6 CORE+200 .PUT IN CORE+200 SB4 132 .LOAD COUNT ENCODE SA1 CORE+200+B4 .LOAD CHARACTER SX2 17B .LOAD MASK BX4 X1*X2 .SAVE NUMERIC PART LX1 1 .REMOVE SIGN AX1 45 .SHIFT TO LOW ORDER BX1 X1+X4 .OR TOGETHER SA1 OUTTABL+X1 .LOAD DISPLAY CODE CHARACTER BX6 X1 .TRANSMIT CHARACTER SA6 PRINT+B4 .STORE CHARACTER EQ B4,ENCDONE .SEE IF DONE SB4 B4-B3 .DECREMENT B4 EQ ENCODE .CONTINUE ENCDONE RJ PRINTF .GO PRINT OUT RJ LCTR .GO COUNT LINES SA1 HOLD200 .RELOAD CELL 200 BX6 X1 . SA6 CORE+200 .STORE BACK IN CORE EQ PRNTL .RETURN EJECT ....................................................................... . LINE COUNTER ROUTINE . REGISTERS USED . A1,A6 . X1(X2,X6 . SUBROUTINES CALLED - NONE ....................................................................... LCTR JP * .ENTRY POINT SA1 LINECT .LOAD CTR SX1 X1+1 .ADD 1 TO CT SX2 X1-51 .IS CT = 51 ZR X2,ZERCT .IF SO ZERO LINE COUNT BX6 X1 .TRANSMIT IT SA6 LINECT .STORE COUNT EQ LCTR .RETURN ZERCT SX6 B0 .ZERO X6 SA6 LINECT .STORE ZERO EQ LCTR .RETURN EJECT ....................................................................... . R E A D B C D C A R D . REGISTERS USED . A1,A2 . B2,B3,B4,B7 . X1,X2 . SUBROUTINES CALLED-RCBIN,RD . ERROR EXITS-ERRORI,ERRORD ....................................................................... RCD EQ B2,B3,RCD1 .DOES LENGTH = 1 SB4 2 .LOAD 2 EQ B2,B4,RCD2 .CHECK FOR COL. BIN. RD. SB4 4 .LOAD 4 EQ B2,B4,RCD3 .READ AND BRANCH SB4 5 .LOAD 5 NE B2,B4,ERRORI .BAD LENGTH SA1 B1-B3 .LOAD D-CHARACTER SA2 (00030000000000000003B) .LOAD A C BX2 X1-X2 .LOGICAL DIFFERENCE NZ X2,ERRORD .BAD D-CHARACTER RJ RCBIN .GO READ BINARY EQ TRA .THEN BRANCH RCD3 RJ RD .GO READ BCD EQ TRA .AND BRANCH RCD2 SA1 B1-B3 .LOAD D-CHARACTER SA2 (00030000000000000003B) .LOAD A 1401 C BX2 X1-X2 .SEE IF WE HAVE A C NZ X2,ERRORD .IF NOT,ERROR RJ RCBIN .GO READ BINARY SB7 CORE+481 .PUT IN B-REGISTER EQ ICYCLE .GO TOICYCLE RCD1 RJ RD .GO READ BCD SB7 CORE+81 .FIX B-REGISTER EQ ICYCLE .GET NEXT INSTRUCTION ....................................................................... . W R R O U T I N E . REGISTERS USED . B2,B3,B4,B7 ....................................................................... WRD EQ B2,B3,WR1 .IS IT JUST A WR SB4 4 .LOAD 4 NE B2,B4,ERRORI .BAD IL LENGTH RJ PRNTL .GO PRINT RJ RD .READ A CARD EQ TRA .GO BRANCH WR1 RJ PRNTL .PRINT LINE RJ RD .READ A CARD SB7 CORE+81 .FIX B-REGISTER EQ ICYCLE .BACK TO ICYCLE EJECT ....................................................................... . W R O U T I N E . REGISTERS USED . A1 . B2,B3,B4,B7 . X1,X2 . SUBROUTINES CALLED -PRTWM,PRNTL . ERROR EXITS - ERRORI,ERRORD ....................................................................... PRT EQ B2,B3,PRT1 .DOES LENGTH = 3 SB4 2 .LOAD 2 EQ B2,B4,PRT2 .DOES LENGTH = 2 SB4 4 .LOAD 4 EQ B2,B4,PRT3 .DOES IL = 4 SB4 5 .LOAD 5 NE B2,B4,ERRORI .BAD INSTRUCTION LENGTH SA1 B1-B3 .LOAD D-CHARACTER SA2 (00030000000000000014B) .LOAD 12-4-8 EQUIVALENT BX2 X1-X2 .EXCLUSIVE OR NZ X2,ERRORD .BAD D-MODIFIER RJ PRTWM .GO PRINT WM EQ TRA .AND BRANCH PRT3 RJ PRNTL .GO PRINT EQ TRA .AND BRANCH PRT2 SA1 B1-B3 .LOAD D-CHARACTER SA2 (00030000000000000014B) .LOAD A 1401 12-4-8 EQUIVALENT BX2 X1-X2 .LOGICAL DIFFERENCE NZ X2,ERRORD .BAD D-CHARACTER RJ PRTWM .GO PRINT WMS SB7 CORE+333 .SIMULATE PRINT STORAGE EQ ICYCLE .BACK TO ICYCLE PRT1 RJ PRNTL .GO PRINT SB7 CORE+333 .SIMULATE PRINT STORAGE EQ ICYCLE .BACK TO ICYCLE EJECT ....................................................................... . B R A N C H R O U T I N E . REGISTERS USED . A1,A2,A3,A4,A6 . B2,B3,B4,B5,B7 . X1,X2,X3,X4,X5,X6 . SUBROUTINES CALLED - TRA . ERROR EXITS - ERRORI,ERRORD ....................................................................... B SB4 4 .LOAD 4 EQ B2,B4,TRA .SIMPLE TYPE OF BRANCH SB4 B4+B3 .GET 5 NE B2,B4,BR1 .IS LENGTH 5 SA2 B1-B3 .LOAD CHARACTER NZ X2,BTMR .NOT AN UNCONDITIONAL BRANCH SB1 B1-B3 .REDUCE I-REGISTER BY 1 EQ TRA .BRANCH BTMR BX3 X2 .SAVE D-MODIFIER AX3 48 .REMOVE NUMERIC AND POSITION ZR X3,NOZONE .SEE IF NO ZONES SX3 X3-1 .REDUCE BY 1 ZR X3,AZONE .AZONE ONLY SX3 X3-1 .REDUCE BY 1 ZR X3,BZONE .BZONE ONLY UX4 B0,X2 .GET NUMERIC SX5 X4-1 .SUBTRACT 1 ZR X5,YESA .IF ZERO THEN A SX5 X4-8 .SUBTRACT 7 NG X5,SSWTEST .SENSE SWITCH TEST SX5 X4-10 .SUBTRACT 10 NZ X5,ERRORD .IF .NE. 0 , BAD D-CHAR SA1 BADREAD .LOAD READ FLAG ZR X1,ICYCLE .IF OFF,NO BRANCH SX6 B0 .ZERO X6 SA6 BADREAD .RESET FLAG EQ TRA .GO BRANCH SSWTEST SA1 STOP+X4 .LOAD SENSE SWITCH ZR X1,ICYCLE .IF OFF NEXT INSTRUCTION EQ TRA .GO BRANCH YESA SA1 LASTCD .LOAD INDICATOR ZR X1,ICYCLE .IF OFF NEXT INSTRUCTION SA1 SWA .LOAD SWITCH A ZR X1,ICYCLE .NO A,NO BRANCH EQ TRA .GO AND BRANCH BZONE UX4 B0,X2 .GET NUMERIC SX5 X4-2 .SEE IF K ZR X5,EFTEST .IS IT AN EOF TEST SX5 X4-3 .SEE IF L ZR X5,BADTP .GO SEE IF TAPE ERROR SX5 X4-10 .SUBTRACT 10 NZ X5,ERRORD .IF .NE. 0,BAD D-CHAR EQ ICYCLE .CANT SIMULATE PUNCH CHECK EFTEST SA1 EOF .LOAD SWITCH ZR X1,ICYCLE .IF OFF NEXT INSTRUCTION SX6 B0 .GET ZERO SA6 EOF .TURN OFF INDICATOR EQ TRA .GO BRANCH BADTP SA1 TEROR .LOAD SWITCH ZR X1,ICYCLE .IF OFF NEXT INSTRUCTION SX6 B0 .GET ZERO SA6 TEROR .TURN OFF FLAG EQ TRA .GO BRANCH AZONE UX4 B0,X2 .GET NUMERIC SX5 X4-1 .SUBTRACT 1 ZR X5,UNEQT .GO TO UNEQUAL TEST SX5 X4-2 .SUBTRACT 2 ZR X5,EQT .GO TO EQUAL TEST SX5 X4-3 .SUBTRACT 3 ZR X5,LOTEST .GO TO LOW TEST SX5 X4-4 .SUBTRACT 4 ZR X5,HITEST .GO TO HIGH TEST (GAS) SX5 X4-10 .SUBTRACT 10 ZR X5,ICYCLE .GO BACK IF RECORD MARK SX5 X4-12 .SUBTRACT 12 ZR X5,ICYCLE .GO BACK IF ( SX5 X4-9 .IS IT Z NZ X5,ERRORD .IF NOT ERROR SA1 OVFLOW .LOAD INDICATOR ZR X1,ICYCLE .GET NEXT INSTR. IF OFF SX6 B0 .ZERO X6 SA6 OVFLOW .TURN IT OFF EQ TRA .GO BRANCH HITEST SA1 BGTA .LOAD B .GT. A INDICATOR ZR X1,ICYCLE .IF OFF NEXT INSTR. EQ TRA .IF NOT BRANCH LOTEST SA1 BLTA .LOAD B .LT. A INDICATOR ZR X1,ICYCLE .NEXT INSTRUCTION EQ TRA .ELSE BRANCH EQT SA1 BEQA .LOAD B .EQ. A ZR X1,ICYCLE .IF OFF THEN ICYCLE EQ TRA .ELSE BRANCH UNEQT SA1 BNEA .LOAD B .NE. A ZR X1,ICYCLE .IF OFF,ICYCLE EQ TRA .ELSE BRANCH NOZONE SX5 X2-9 .SUBTRACT 9 ZR X5,CHAN9 .CHANNEL 9 TEST SX5 X2-12 .SUBTRACT 12 NZ X5,ERRORD .BAD D-CHAR SA1 LINECT .GET LINECT SX1 X1-50 .SUBTRACT 50 ZR X1,TRA .IF = 50 THEN BRANCH EQ ICYCLE .ELSE NEXT INSTRUCTION CHAN9 SA1 LINECT .GET LINE COUNT SX1 X1-38 .SUBTRACT 38 ZR X1,TRA .IF = 38,BRANCH EQ ICYCLE .ELSE NEXT INSTRUCTION BR1 SB4 2 .LOAD 2 EQ B2,B4,ERRORI .BAD I-LENGTH SB4 7 .LOAD 7 EQ B2,B4,ERRORI .BAD I-LENGTH SA2 DMOD .GET D-CHARACTER LX2 1 .REMOVE WM AX2 1 . SA3 (00020000000000000002B) .LOAD K BX3 X2-X3 .EXCLUSIVE OR ZR X3,QUIRK1 .SIMULATE EOF OFF SA3 (00010000000000000011B) .LOAD Z BX3 X2-X3 .LOGICAL DIFFERENCE ZR X3,QUIRK2 .SIMULATE OVFLOW OFF BCE1 SA4 B7 .LOAD (B) LX4 1 .REMOVE WM AX4 1 . BX3 X2-X4 .LOGICAL DIFF OF (B) AND D-CHAR ZR X3,TRA .BRANCH IF EQUAL RJ DECRB .DOWN B-ADDRESS EQ ICYCLE .GET NEXT INSTRUCTION QUIRK1 SX6 B0 .ZERO X6 SA6 EOF .TURN OFF EOF INDICATOR EQ BCE1 .GO DO BCE QUIRK2 SX6 B0 .ZERO X6 SA6 OVFLOW .ZERO THE INDICATOR EQ BCE1 .GO DO THE BCE EJECT ....................................................................... . M L C R O U T I N E . ALSO HANDLES MBC AND MBD . REGISTERS USED . A2,A3,A4,A6 . B2,B3,B4,B6,B7 . X2,X3,X4,X6 . ENTRY PARAMS . B2 = LENGTH . B3 = 1 . B6 = A-REGISTER . B7 = B-REGISTER . SUBROUTINES USED - DECRA,DECRB ....................................................................... MLC EQ B2,B3,MLC1 .1 CHAR. CHAINING SB4 4 .LOAD 4 EQ B2,B4,MLC1 .LENGTH = 4 ... SB4 7 .LOAD 7 NE B2,B4,L8 .IF NOT 7 THEN PERHAPS 8 MLC1 SA2 B6 .LOAD A SA3 B7 .LOAD B NG X3,BWM .A-FIELD WM NG X2,AWM .B-FIELD WM BX6 X2 .TRANSMIT A WORD SA6 B7 .STORE IT RJ DECRA .REDUCE A RJ DECRB .REDUCE B EQ MLC1 .KEEP MOVING AWM BX6 X2 .TRANSMIT A-FIELD LX6 1 .REMOVE WM AX6 1 . SA6 B7 .STORE IT EQ MLC2 .FINISH UP BWM SA4 WMARK .LOAD WM BX6 X2+X4 .OR IN WORD MARK SA6 B7 .STORE THE WORD MLC2 RJ DECRA .REDUCE A RJ DECRB .REDUCE B SX6 B6 .GET A-REGISTER SA6 SAVEA .SAVE IT EQ ICYCLE .GO GET NEXT INSRUCTION L8 SB4 8 .LOAD 8 NE B2,B4,ERRORI .INSTR. LENGTH ERROR SB4 B1-B2 .GET I-ADDRESS SB4 B4+B3 .ADD 1 SA2 (00010000000000000014B) .LOAD 1401 ( SA3 B4 .GET SECOND CHARACTER BX2 X2-X3 .EXCLUSIVE OR ZR X2,TAPEIO .I/O INSTRUCTION SB4 B1-B3 .GET D-CHAR ADDRESS SA2 (00030000000000000001B) .1401A SA3 B4 .LOAD D-CHAR BX2 X2-X3 .EXCLUSIVE ORE ZR X2,MBD .IF 0,THEN MBD INSTRUCTION SA2 (00030000000000000002B) .1401 B BX2 X2-X3 .EXCLUSIVE OR NZ X2,ERRORD .IF 0,THEN MBC INSTRUCTION MBC SB4 CORE+2 .LOAD 2 LT B6,B4,ERROR4 .ERROR IF A-REG .LT. 2 ADCK SB4 CORE+100 .LOAD 100 LT B7,B4,ERROR4 .ERROR IF B-REG .LT. 100 SA2 B6 .LOAD A-WORD SA3 B7 .LOAD B-WORD NG X3,BFWM .SEE IF B-FIELD WM NG X2,AFWM .SEE IF A-FIELD WM BX6 X2 .TRANSMIT A-FIELD SA6 B7 .STORE IT RJ DECRA .DOWN A-REG SA2 B6 .LOAD A-WORD SA3 B7-100 .GET (B7-100) WORD NG X3,WMB .WORD MARK IN B-FIELD NG X2,WMA .WORD MARK A-FIELD BX6 X2 .TRANSMIT A-FIELD SA6 B7-100 .STORE IT BACK RJ DECRA .DOWN WITH A RJ DECRB .SAME TO B EQ ADCK .GO BACK AND CONTINUE AFWM BX6 X2 .PUT IN X6 LX6 1 .REMOVE WM AX6 1 .REMOVE WM SA6 B7 .STORE IT ETPT RJ DECRA .DOWN A-REG SB7 B7-100 .DOWN B-REG SAVEREG SX6 B6 .GET A-REG SA6 SAVEA .STORE IN SAVEA EQ ICYCLE .GO GET NEXT INSTRUCTION BFWM SA3 WMARK .LOAD WM BX6 X2+X3 .OR IN WM SA6 B7 .STORE IN B-FIELD EQ ETPT .GO SET REGISTERS WMA BX6 X2 .GET A-FIELD LX6 1 .REMOVE WM AX6 1 . SA6 B7-100 .STORE IT ENPT RJ DECRA .DOWN A-REG SB7 B7+99 .FIX B-REG EQ SAVEREG .GO SAVE REGISTERS WMB SA3 WMARK .LOA DWM BX6 X2+X3 .OR IN WM SA6 B7-100 .STORE IT EQ ENPT .GO FIX REGISTERS MBD SB4 CORE+2 .LOAD 2 LT B7,B4,ERROR4 .ERROR IF B-REG .LT. 2 APT SB4 CORE+100 .LOAD 100 LT B6,B4,ERROR4 .ERROR IF A-REG .LT. 100 SA2 B6 .LOAD A-WORD SA3 B7 .LOAD B-WORD NG X3,BB .B-FIELD WM NG X2,AA .A-FIELD BX6 X2 .TRANSMIT WORD LX6 1 .REMOVE WM AX6 1 . SA6 B7 .STORE WORD RJ DECRB .DOWN B-REGISTER SA2 B6-100 .LOAD (B6-100) SA3 B7 .LOAD B7 NG X3,CD .WORD MARK IN B-FIELD NG X2,DD .WORD MARK IN A FIELD BX6 X2 .TRANSMIT A FIELD LX6 1 .REMOVE SIGN BIT AX6 1 . SA6 B7 .STORE IT RJ DECRA .DOWN A RJ DECRB .DOWN B EQ APT .PERFORM NEXT CYCLE AA BX6 X2 .TRANSMIT X2 LX6 1 .REMOVE WM AX6 1 . SA6 B7 .STORE IT EPT RJ DECRB .DOWN B SB6 B6-100 .DOWN A BY 100 EPT1 SX6 B6 .GET A-REG SA6 SAVEA .SAVE IT EQ ICYCLE .NEXT INSTRUCTION BB SA3 WMARK .LOAD WM BX6 X2+X3 .OR IN WORD MARK SA6 B7 .STORE IT EQ EPT .CONTINUE MOVING CD SA3 WMARK BX6 X2+X3 .OR IT TO X2 SA6 B7 .STORE IT ENT RJ DECRB .DOWN B-REG SB6 B6+99 .UP A REG BY 99 EQ EPT1 .GO SAVE REGS DD BX6 X2 .TRANSMIT A-FIELD LX6 1 .REMOVE WM AX6 1 .REMOVE WM SA6 B7 .STORE IT EQ ENT .GO FIX REGS AND EXIT EJECT ....................................................................... . L C A R O U T I N E . ENTRY PARAMS . B1 = IREGISTER . B2 = LENGTH . B3 = 1 . B6 = A-REGISTER . B7 = B-REGISTER . REGISTERS USED . B1,B2,B3,B4,B6,B7 . A2,A6 . X2,X6 ....................................................................... LCA EQ B2,B3,LDA .LENGTH = 1 SB4 4 .LOAD 4 EQ B2,B4,LDA .LENGTH = 4 SB4 7 .LOAD 7 NE B2,B4,LCA8 .IF .NE. 7,MAYBE 8 LDA SA2 B6 .LOAD A-WORD BX6 X2 .TRANSMIT SA6 B7 .STORE IN B-LOCATION RJ DECRA .DOWN A BY 1 RJ DECRB .DOWN B BY 1 PL X2,LDA .IF NO WM THEN CONTINUE EQ SAVEREG .GO SAVE REGISTERS LCA8 SB4 8 .LOAD 8 NE B2,B4,ERRORI .IF .NE. 8,ERROR SB4 B1-B2 .GET I-REGISTER SA2 B4+B3 .LOAD 2ND CHARACTER SA3 (00010000000000000014B) .LOAD 1401 ( BX2 X2-X3 .EXCLUSIVE OR NZ X2,ERRORI .IF NON 0 THEN ERROR EQ TAPEIOW .TAPE I/O WITH WM/S EJECT ....................................................................... . P U N C H R O U T I N E . REGISTERS USED . A2,A3 . B2,B3,B4,B7 . X2,X3 . SUBROUTINES USED - PCBIN,PCBCD . ERROR EXITS - ERRORI,ERRORD ....................................................................... PCH EQ B2,B3,PDIR .DOES LENGTH = 1 SB4 2 .LOAD 2 EQ B2,B4,CBINP .SEE IF COL. BIN. PUNCH SB4 4 .LOAD 4 EQ B2,B4,PBRA .GO TO PUNCH AND BRANCH SB4 5 .LOAD 5 NE B2,B4,ERRORI .IF NOT 5,ERROR SA2 B1-B3 .LOAD D-CHAR SA3 (00030000000000000003B) .LOAD A C BX3 X2-X3 .SEE IF DCHAR IS A C NZ X3,ERRORD .IF NOT BAD DCHAR RJ PCBIN .GO PUNCH BINARY EQ TRA .THEN BRANCH PBRA RJ PCBCD .GO PUNCH BCD EQ TRA .THEN BRANCH CBINP SA2 B1-B3 .GET D-CHARACTER SA3 (00030000000000000003B) .LOAD A C BX3 X2-X3 .SEE IF DCHAR NZ X3,ERRORD .IF NOT , BAD DCHAR RJ PCBIN .GO PUNCH BINARY SB7 CORE+481 .FIX B-REGISTER EQ ICYCLE .GO GET NEXT INSTRUCTION PDIR RJ PCBCD .GO PUNCH BCD SB7 CORE+181 .SET B-REGISTER EQ ICYCLE .GO TO ICYCLE EJECT ....................................................................... . RP , WP , AND WRP ROUTINES . REGISTERS USED . B2(B3,B4,B7 . SUBROUTINES USED - RD,PCBCD , PRNTL,TRA . ERROR EXITS - ERRORI ....................................................................... RDP EQ B2,B3,RDP1 .DOES LENGTH = 1 SB4 4 .LOAD 4 NE B2,B4,ERRORI .BAD LENGTH RJ RD .GO READ A CARD RJ PCBCD .AND PUNCH BCD EQ TRA .THEN BRANCH RDP1 RJ RD .READ A CARD RJ PCBCD .AND PUNCH BCD SB7 CORE+181 .READJUST B-REGISTER EQ ICYCLE .GET NEXT INSTRUCTION WPC EQ B2,B3,WPC1 .LENGTH = 1 SB4 4 .LOAD 4 NE B2,B4,ERRORI .BAD LENGTH RJ PRNTL .GO PRINT A LINE RJ PCBCD .AND PUNCH A CARD EQ TRA .AND BRANCH WPC1 RJ PRNTL .PRINT A LINE RJ PCBCD .PUNCH CARD SB7 CORE+181 .RESET B-REG EQ ICYCLE .GET NEXT INSTR. WRP EQ B2,B3,WRP1 .GO TO WRP1 IF IL = 1 SB4 4 .LOAD 4 NE B2,B4,ERRORI .BAD ILENGTH RJ PRNTL .WRITE RJ RD .READ RJ PCBCD .PUNCH EQ TRA .AND BRANCH WRP1 RJ PRNTL .WRITE RJ RD .READ RJ PCBCD .PUNCH SB7 CORE+181 .SET B-REGISTER EQ ICYCLE .GET NEXT INSTRUCTION EJECT ....................................................................... . S A R - S B R . . ENTRY PARAMS . B2=LENGTH OF INSTRUCTION . B3=1 . B6=A-REGISTER . B7=B-REGISTER . . REGISTERS USED . A4,A5,A6 . B2,B3,B4,B5,B6,B7 . X2,X3,X6 . . SUBROUTINES CALLED - CNVRT ....................................................................... SAR EQ B2,B3,SAR4 .IF INSTRUCTION LENGTH 1 SB4 4 .LOAD 4 NE B2,B4,ERRORI .IF INST LENGTH NOT 4 SB7 B6 .SET B EQUAL TO A SAR4 SA2 SAVEA .GET A-REGISTER SB4 X2 .PUT IN B-REGISTER SB4 B4-CORE .REMOVE FACTOR EQ SABRE .BRANCH TO COMMON ROUTINE SBR EQ B2,B3,SBR1 .IF INSTRUCTION LENGTH 1 SB4 4 .LOAD 4 EQ B2,B4,SBR1 .IF INSTRUCTION LENGTH 4 SB4 7 .LOAD 7 NE B2,B4,ERRORI .IF INST LENGTH NOT 1,4,7 SBR1 SB4 B7-CORE .REMOVE CORE FACTOR SABRE RJ CNVRT .CONVERT B4 TO 3 DIGITS MX3 1 .GET MASK SA5 B6 .LOAD CONTENTS OF A ADDRESS SA4 ADDR3 .LOAD CONVERT UNITS DIGIT BX6 X4 .TRANSMIT PL X5,SABR2 .IF NOT WM IX6 X6+X3 .IF WM SET WM IN UNITS SABR2 SA6 B6 .STORE UNITS SA5 B6-1 .LOAD CONTENTS A ADDRESS-1 SA4 ADDR2 .LOAD CONVERT TENS DIGIT BX6 X4 .TRANSMIT PL X5,SABR3 .IF NOT WM IN TENS IX6 X6+X3 .IF WM ADD WM SABR3 SA6 B6-1 .STORE TENS SA5 B6-2 .LOAD CONTENTS A ADDRESS-2 SA4 ADDR1 .LOAD CONTENTS HUNDREDS DIFIT BX6 X4 .TRANSMIT PL X5,SABR4 .JUMP IF NO WM IX6 X6+X3 .SET WM IF NEEDED SA6 B6-2 .STORE HUNDREDS SABR4 SA6 B6-2 .STORE HUNDREDS SB4 CORE+4 .LOAD CORE+4 SB6 B6-3 .REDUCE A-ADDRESS BY 3 SX6 B6 .LOAD NEW A ADDRESS SA6 SAVEA .STORE IN SAVEA EQ ICYCLE . EJECT ....................................................................... . P A C K R O U T I N E . ENTRY PARAMS . B1 = 1 . B2 = FWA OF OUTPUT BUFFER . B5 = LWA OF PRTOUT BUFFER . REGISTER USED . A1,A2,A6 . B1,B2,B3,B4,B5, . X1,X2,X6 . SUBROUTINES CALLED - NONE ....................................................................... PACK JP * .ENTRY POINT SB3 10 .LOAD 10 SA6 B2-B1 .GET FWA-1 IN A6 SA1 PRINT-1 .LOAD ADDRESS TO A1 PACK1 SB4 B0 .ZERO B4 SX6 B0 .ZERO OUTPUT REGISTER PACK2 SA1 A1+B1 .LOAD A CHARACTER BX6 X1+X6 .PACK IT UP LX6 6 .SHIFT TO LOW ORDER SB4 B4+B1 .STEP CHAR COUNT LT B4,B3,PACK2 .ARE TEN PACKED SA6 A6+B1 .IF SO STORE THEN SB2 B2+B1 .STEP POINTER LT B2,B5,PACK1 .ARE WE DONE... SX6 B0 .ZERO X6 SA1 PRINT+130 .LOAD NEXT TO LAST CHARACTER SA2 PRINT+131 .LOAD LAST CHARACTER LX2 54 .POSITION LAST CHAR BX6 X1+X2 .OR TOGETHER SA6 B5 .STORE IT EQ PACK .RETURN EJECT ....................................................................... . ERROR ROUTINE . ALL ERROR EXITS COME HERE AND PUT OUT A MESSAGE . AND THEN TERMINATE. ....................................................................... ERROR5 SX7 ERR5 .SET POINTER SA0 ERR5+3 .SET SECOND POINTER EQ ERRMESG .GO OUTPUT MESSAGE ERROR1 SX7 ERR1 .POINTER SA0 ERR1+4 .SET 2ND POINTER EQ ERRMESG .GO TO ERROR MESAGE ERROR2 SX7 ERR2 .SET POINTER TO FWA SA0 ERR2+3 EQ ERRMESG .GO PRINT ERROR4 SX7 ERR4 .FWA POINTER SA0 ERR4+3 EQ ERRMESG .PRINT ERRORI SX7 ERRI .FWA SA0 ERRI+4 EQ ERRMESG .GO PRINT ERRORT SX7 ERRT .FWA SA0 ERRT+3 EQ ERRMESG .GO PRINT MESSAGE ERRORE SX7 ERRE .FWA SA0 ERRE+4 EQ ERRMESG .PRINT ERRORED SX7 ERR3 .LOAD FWA SA0 ERR3+3 EQ ERRMESG .GO PRINT IT ERRORD SX7 ERRD .LOAD FWA SA0 ERRD+3 EQ ERRMESG .GO PRINT ERRORC SX7 ERRC .FWA SA0 ERRC+3 EQ ERRMESG . ERRORA SX7 ERRA .LOAD FWA SA0 ERRA+4 EQ ERRMESG . ERRORL SX7 ERRL .FWA SA0 ERRL+4 EQ ERRMESG . ERRMESG SX6 B6 .STORE A REGISTER SA6 SAVEA . SX6 B7 .STORE IN LOC B-REGISTER SA6 ZONE . SX6 B1 .SAVE I-REGISTER SA6 LORDER . SB1 1 SX1 CPARAM .SET PARAMETERS RJ WRITE .WRITE ERROR MESSAGE SA1 LORDER .RESTORE REGISTERS SB1 X1 SA2 SAVEA SB6 X2 SA3 ZONE SB7 X3 RJ DMPREG .DUMP REGISTERS SX0 CORE-1 .BOTTOM LIMIT OF CORE DUMP SX6 MAXCOR .TOP LIMIT OF DUMP RJ CRDUMP .DUMP 1401 CORE RJ WEOF .TERMINATE JOB EJECT ....................................................................... . CORE DUMP ROUTINE . ....................................................................... CRDUMP JP * .ENTRY/EXIT LINE SB3 1 .RESET B3 TO 1 SA6 ZONE .STORE TOP LIMIT OF DUMP SX6 55B .BLANK FILL LAST 132 LOCATIONS LX6 54 . SA6 PRINT .CARRIAGE CONTROL SB4 32 .BLANK FILL LAST 32 POSITIONS CRDMP3 SB4 B4-B3 .DECREASE COUNT SA6 PRINT+101+B4 . NE B4,CRDMP3 . CRDMP0 SB4 100 .INITIALIZE TO DUMP 100 LOCNS. CRDMP1 SA1 X0+B4 .LOAD CHARACTER SX2 X1 .GET NUMERIC LX1 1 . AX1 45 .GET ZONES BX1 X1+X2 .OR TOGETHER SA1 OUTTABL+X1 .LOAD DISPLAY CODE BX6 X1 . SA6 PRINT+B4 .STORE CHARACTER SB4 B4-B3 .DECREASE COUNT EQ B4,CRDMP2 .ARE WE DONE EQ CRDMP1 . CRDMP2 BX7 X0 .SAVE X0 SA7 ASTAR . RJ PRINTF .PRINT THE LINE SA1 ASTAR . BX0 X1 .RESTORE X0 SA1 OUTTABL .LOAD A BLANK SA2 A1+B3 .AND A *1* BX6 X1 . BX7 X2 . SB4 100 . CRDMP4 SA1 X0+B4 .PRINT WORD MARKS SB4 B4-B3 .DECREASECOUNT NG X1,CRDMP5 .JUMP IF WM SA6 PRINT+1+B4 .ELSE STORE A BLANK EQ B4,CRDMP6 .ARE WE DONE EQ CRDMP4 .LOOP CRDMP5 SA7 PRINT+1+B4 .STORE A 1 NE B4,CRDMP4 .LOOP IF NOT COMPLETE CRDMP6 BX7 X0 . SA7 ASTAR . RJ PRINTF . SA1 ASTAR . SX0 X1+100 .DUMP NEXT 100 LOCATIONS SA1 ZONE .LOAD TOP LIMIT IX4 X0-X1 .IS IT EXCEEDED NG X4,CRDMP0 .LOOP TILL ALL CORE DUMPDE EQ CRDUMP .EXIT EJECT ....................................................................... . DUMP I, A, AND B REGISTERS IN DECIMAL . ....................................................................... DMPREG JP * ENTRY/EXIT LINE SB3 1 RESET B3 TO 1 SA1 BLANK BLANK PRINT LINE BX6 X1 SB4 10 DMPRG1 SB4 B4-B3 COUNT =COUNT-1 SA6 PRTOUT+B4 STORE BLANK NE B4,DMPRG1 LOOP MX6 0 SA6 PRTOUT+9 SET END OF LINE SB4 B1-CORE GET I-REGISTER RJ DECIMAL CONVERT TO DECIMAL DISPLAY CODE SA6 PRTOUT+2 SA2 ICON LOAD *I-REGISTER* BX6 X2 SA6 A6-B3 SB4 B6-CORE GET A-REGISTER RJ DECIMAL CONVERT SA6 PRTOUT+5 SA2 ACON LOAD *A-REGISTER* BX6 X2 SA6 A6-B3 SB4 B7-CORE GET B-REGISTER RJ DECIMAL CONVERT SA6 PRTOUT+8 SA2 BCON LOAD *B-REGISTER* BX6 X2 SA6 A6-B3 SX7 PRTOUT PARAMETERS SX1 CPARAM SA0 PRTOUT+10 SB1 1 RJ WRITE EQ DMPREG EXIT EJECT ....................................................................... . CONVERT FROM BINARY TO DECIMAL . . NUMBER TO BE CONVERTED IN B4 ON ENTRY . . ANSWER IN X6 IN DISPLAY CODE ON EXIT . ....................................................................... DECIMAL JP * . MX6 0 . SX5 B3 . SX4 33B . SB5 10000 . LT B4,B5,DEC1 . .LT. 10,000 ... SB4 B4-B5 . IX6 X4+X5 .CONVERT 10,000/S DIGIT TO DPC LX6 6 . DEC1 SB5 1000 .IS IT .LT. 1000 DEC1A LT B4,B5,DEC2 . SB4 B4-B5 . IX6 X6+X5 .ADD 1 EQ DEC1A .LOOP DEC2 ZR X6,DEC2A .SUPPRESS LEADING ZEROES IX6 X4+X6 .DISPLAY CODE LX6 6 . DEC2A SB5 100 . DEC2B LT B4,B5,DEC3 .IS IT .LT. 100 SB4 B4-B5 . IX6 X5+X6 .ADD 1 EQ DEC2B .LOOP DEC3 ZR X6,DEC3A .SUPPRESS LEADING ZEROES IX6 X4+X6 .DISPLAY CODE LX6 6 . DEC3A SB5 10 . DEC3B LT B4,B5,DEC4 . IS IT .LT. 10 SB4 B4-B5 . IX6 X5+X6 .ADD 1 EQ DEC3B .LOOP DEC4 ZR X6,DEC4A .SUPPRESS LEADING ZEROES IX6 X4+X6 .DISPLAY CODE LX6 6 . DEC4A SX3 X4+B4 .DISPLAY CODE IX6 X3+X6 .ADD IN UNITS SX2 55B .BLANK FILL SX3 77B .MASK LX2 54 . LX3 54 . DEC5 BX4 X3*X6 .GET A CHARACTER NZ X4,DECIMAL .NON-ZERO, THEN EXIT BX6 X2+X6 .ELSE OR IN A BLANK LX2 54 .SHIFT RIGHT LX3 54 . EQ DEC5 .LOOP EJECT ....................................................................... . READ AND UNPACK A BCD CARD,PACK AND WRITE A BCD LINE . THIS SAVES PROGRAM REGISTERS,CALLS THE READ OR PRINT PACKAGE . PACKS OR UNPACKS THE DATA,AND RESTORES PROGRAM REGISTERS. ....................................................................... READF JP * .ENTRY POINT SX6 B1 .SAVE REGISTERS SX7 B2 . SA6 K1 . SA7 K2 . SX6 B6 . SX7 B7 . SA6 K6 . SA7 K7 . SB1 1 . SX7 CARDIN SX1 BPARAM RJ READ .GET A CARD PL X6,EON .SEE IF EOF SX6 3 SA6 LASTCD .SET FLAG EON SB5 CARDIN .LOAD START ADDRESS SB2 CARDIN+8 .END ADDRESS RJ UNPACK .GO UNPACK SA2 K1 . SA3 K2 . SB1 X2 . SB2 X3 . SA2 K6 . SA3 K7 . SB6 X2 . SB7 X3 . SB3 1 . EQ READF .RETURN PRINTF JP * .ENTRYPOINT SX6 B1 .SAVE MY REGISTRS SX7 B2 . SA6 K1 . SA7 K2 . SX6 B6 . SX7 B7 . SA6 K6 . SA7 K7 . SB1 1 .LOAD PARAMETERS SB2 PRTOUT . SB5 PRTOUT+13 . RJ PACK .GO PACK UP THE DATA SX7 PRTOUT . SX1 CPARAM .MORE PARAMETERS SA0 PRTOUT+14 . RJ WRITE .GO PRINT OUT SA1 K1 .RELOAD REGISTERS SA2 K2 . SB1 X1 . SB2 X2 . SA1 K6 . SA2 K7 . SB6 X1 . SB7 X2 . SB3 1 . EQ PRINTF .RETURN EJECT READ CON 0 .ROUTINE TO MULTIBUFFER SEVERAL INPUT UNIT SB2 B0 . ON INPUT - X1=FWA OF CIO BUFFER ARGS SB3 8 . X7=FWA OF A SINGLE CARD BUFF SA2 BLANK . BX6 X2 . CLEAR SA6 X7+B2 .CLEAR SINGLE CARD BUFFER SB2 B2+B1 . LT B2 B3 CLEAR .***************************************** SB6 B0 . REGISTER SETUP - SB2 X7 . SX7 X1 . MOVE1 SA1 X7+B1 . B1 = 1 SA2 A1+B1 . B2 = FWA OF SINGLE CARD BUFFER SA3 A2+B1 . B3 = IN SA4 A3+B1 . B4 = OUT . B5 = LIMIT SA5 X7 . B6 = SINGLE CARD BUFFER INDEX SB3 X2 B7 = 7 SB4 X3 . SB5 X4 . X0 = 00000000000000000077B SX4 X1 . X4 = FIRST SX0 77B . X5 = BUFFER STATUS WORD SB7 7 . X7 = FWA OF CIO BUFFER ARGUMENTS .***************************************** MOVE2 NE B3,B4,MOVE3 .BRANCH IF OUT .NE .IN RJ READ1 .REQUEST CIO NG X6,READ .BRANCH IF EOR MOVE3 SA1 B4 .FETCH 10 CHARS FROM CIRCULAR BUFFER BX2 X0*X1 . ZR X2 SHORT .BRANCH IF LOW CHARACTER ZERO BX6 X1 . SA6 B2+B6 .STORE 10 CHARACTERS IN SINGLE BUFFER GE B6 B7 LAST2 .BRANCH IF 80 CHARACTERS DONE SB4 B4+B1 .OUT = OUT + 1 SB6 B6+B1 . LT B4 B5 MOVE2 .BRANCH IF OUT .LT. LIMIT SB4 X4 .SET OUT = FIRST EQ B0 B0 MOVE2 . . READ1 JP * SX6 B4 SA6 X7+3 READ1A SX2 B1 SX1 60B BX3 X2*X5 . NZ X3 READ2 .BRANCH IF LAST READ COMPLETE READ1B SA1 RCLCODE RJ CALL .REQUEST RECALL SA5 X7 .FETCH NEW BUFFER STATUS WORD SA1 X7+2 .FETCH NEW IN SB3 X1 .B3 = IN NE B3,B4,READ1 .BRANCH IF NOT EMPTY EQ READ1A READ2 BX3 X1*X5 . SX3 X3-20B . ZR X3 READ3 .BRANCH IF EOR ON LAST READ (IGNORE EOF) BX6 -X2*X5 . SA6 X7 . SA1 CIOCODE . IX1 X1+X7 . RJ CALL .REQUEST CIO READ EQ READ1B READ3 SX6 B4 . SA6 X7+3 .STORE OUT SX6 -1 EQ B0 B0 READ . LAST2 SA6 B2+B7 .STORE IN SINGLE CARD BUFFER LAST2A SB4 B4+B1 .OUT = OUT + 1 LT B4,B5,LAST2C .BRANCH IF OUT .LT. LIMIT SB4 X4 LAST2C NE B3,B4,LAST2D .BRANCH IF OUT .NE. IN RJ READ1 .REQUEST READ NG X6,READ .BRANCH IF EOR LAST2D SA1 B4 .GET NEXT 10 CHARACTERS BX1 X1*X0 NZ X1,LAST2A .BRANCH ON NO END OF LINE RDEXIT SB4 B4+B1 LT B4 B5 RDEXIT2 SB4 X4 RDEXIT2 SX1 B1 SX6 B4 SA6 X7+3 . SA2 X7 . BX3 X1*X2 . ZR X3 RDEXIT1 .BRANCH IF LAST READ NOT COMPLETE SX1 60B . BX3 X1*X2 . NZ X3 RDEXIT1 .BRANCH IF EOR OR EOF ON LAST READ SA1 CIOCODE . IX1 X1+X7 . SX2 B1 BX6 -X2*X5 . SA6 X7 RJ CALL .REQUEST CIO READ RDEXIT1 SX6 B0 .CLEAR EOR OR EOF FLAG EQ B0 B0 READ .** EXIT ** SHORT ZR X1 RDEXIT .IF CARD WAS SHORT, SUBSTITUTE BLANKS SX0 77B . FOR TRAILING ZEROS SX2 7777B . SHORT1 BX3 X1*X2 . NZ X3 OUT . LX2 6 . BX2 X2-X0 EQ B0 B0 SHORT1 . OUT SA3 BLANK . MX0 1 . BX2 -X0*X2 . AX2 6 . BX2 X2*X3 . IX6 X1+X2 . SA6 B2+B6 . EQ B0 B0 RDEXIT . EJECT WRITE CON 0 .MULTI-UNIT,MULTI-BUFFER WRITE ROUTINE SB3 B7 SB7 A0 SA0 B3 SB2 X7 .B2 = SINGLE CARD BUFFER INDEX SX7 X1 .X7 = FWA OF CIO BUFFER ARGUMENTS SA1 X1+B1 . SA2 A1+B1 . SA3 A2+B1 . SA4 A3+B1 . SA5 X7 .X5 = CIO BUFFER STATUS WORD SB3 X1-1 .B3 = FIRST-1 SB4 X2 .B4 = IN SB5 X3-1 .B5 = OUT-1 SB6 X4-1 .B6 = LIMIT-1 MOVEW SA1 B2 . BX6 X1 .TRANSFER 10 CHARACTERS TO THE CIR. BUFFER SA6 B4 . EQ B4 B5 WRITE1 .BRANCH IF IN = OUT-1 AND CARD NOT DONE EQ B4 B6 MOVEW2 .BRANCH IF IN = LIMIT-1 SB4 B4+B1 .IN = IN+1 MOVEW1 SB2 B2+B1 . LT B2 B7 MOVEW .BRANCH IF 80 CHARACTERS NOT TRANSFERED SX6 B4 . SA6 X7+2 . SB7 A0 EQ B0 B0 WRITE .*** EXIT *** MOVEW2 EQ B3 B5 WRITE1 .BRANCH IF OUT = FIRST SB4 B3+B1 .SET IN = FIRST EQ B0 B0 MOVEW1 . WRITE1 SX1 B1 . SX6 B4 . SA6 X7+2 . BX2 X1*X5 . ZR X2 WAITWR .BRANCH IF LAST WRITE NOT COMPLETE SA1 CIOCODE . SX2 -1 . BX6 X2*X5 . IX1 X1+X7 .REQUEST CIO WRITE SA6 X7 . RJ CALL . WAITWR SA1 RCLCODE . RJ CALL .REQUEST CIO RECALL SA5 X7 . SA1 X7+3 SB5 X1-1 EQ B0 B0 MOVEW . EJECT CALL CON 0 .MONITOR COMMUNICATIONS ROUTINE BX6 X1 . + SA1 1 . NZ X1 * . SA6 1 . NZ X1 * . EQ B0 B0 CALL . EJECT ....................................................................... . CALL RLT FOR A TAPE OPERATION . ....................................................................... TAPCALL JP * . SA6 TSTCT .SET OPERATION COMPLETE CELL SA1 TPCALL .LOAD THE CALL TO RLT SA2 RLTCELL .ADDR. OF COMMUNICATION AREA + SA4 X2 .CHECK FOR LAST OPERATION COMPLET NZ X4,* .LOOP ON NOT DONE BX6 X1 . SA6 X2 .CALL RLT + SA4 X2 .WAIT FOR ACCEPTANCE OF REQUEST NZ X4,* .LOOP IF NOT ACCEPTED SX6 MCALL .CHANGE COMMUNICATION AREA SA6 RLTCELL .AFTER THE FIRST CALL EQ TAPCALL .EXIT EJECT ....................................................................... . SET UP ARGUMENTS FOR CALLING RLT . . REGISTERS ON INPUT . . X3 = TAPE NUMBER , X0 = FUNCTION CODE , X1 = LWA IN BUFFER . . X5 = DENSITY . ....................................................................... SETARGS JP * . SX4 242033B .LOAD TP0 IX6 X3+X4 .GET FILE NAME BY ADDING TAPE NO. LX6 42 . BX6 X0+X6 .ADD IN FUNCTION CODE SA6 TAPARG .STORE FIRST ARGUMENT SX7 INBUF .FWA OF TAPE BUFFER LX7 42 . LX1 24 .LWA IN THE BUFFER BX7 X1+X7 . SX5 X5-1 .GET THE DENSITY LX5 18 . BX7 X5+X7 . SX4 TSTCT .ADDRESS OF STATUS WORD BX7 X4+X7 . SA7 TAPARG+1 .STORE 2ND ARGUMENT EQ SETARGS .EXIT EJECT .............................................................. . U N P A C K . .............................................................. . . ROUTINE TO UNPACK A CARD IMAGE (80 CHARACTERS) INTO THE . BUFFER, *CARD*, ONE CHARACTER PER WORD - RIGHT JUSTIFIED. . . ENTRY PARAMS - B5 = FWA OF PACKED CARD IMAGE . B1 = 1 . B2 = LWA+1 OF PACKED CARD IMAGE . . EXIT PARAMS - B1 = 1 . . REGS USED - X0,X1,X6, . A1,A6 . B1,B2,B3,B4,B5 . . SUBS USED - NONE . . UNPACK JP * . ENTRY/EXIT LINE MX0 6 . X6 = 77000000000000000000B SB3 10 . 10 CHARACTERS PER WORD SA6 CARD-1 . FWA-1 OF UNPACKED CARD UNPACK1 SB4 B0 . B4 = CHARACTER INDEX SA1 B5 . B5 = FWA OF PACKED CARD ON ENTRY UNPACK2 BX6 X0*X1 . EXTRACT TOP CHARACTER LX1 6 . MOVE NEXT CHARACTER UP LX6 6 . MOVE EXTRACTED CHARACTER TO LOW 6 BITS SA6 A6+B1 . STORE CHARACTER SB4 B4+B1 . BUMP CHARACTER INDEX LT B4 B3 UNPACK2 . BRANCH IF 10 CHARACTERS NOT DONE YET SB5 B5+B1 . BUMP WORD ADDRESS LT B5 B2 UNPACK1 . BRANCH IF 8 WORDS NOT DONE YET EQ B0 B0 UNPACK . EXIT WEOF CON 0 .ENTRY POINT , NO EXIT SA1 CPARAM .GET FIRST WORD SA3 PBUFF .GET FIRST PARAMETER MX2 48 .MASK BX1 X1*X2 .SAVE FILE NAME BX3 X2*X3 .SAVE FILE NAME SX2 34B .FILE MARK REQUEST IX6 X1+X2 .PUT IN REQUEST IX7 X3+X2 .PUT IN FILE MARK REQUEST SA6 CPARAM .STORE IN PARAMS SA7 PBUFF .PUT BACK IN PARAMETER BLOCK SA1 CCODE .LOAD CIO CODE RJ CALL .SEND CALL SA1 RCLCODE .GO INTO RECALL RJ CALL .SEND THE CODE SA1 PCODE .LOAD CIO CALL FOR PUNCH EOF RJ CALL .SEND REQUEST SA1 RCLCODE .LOAD RECALL CODE RJ CALL .GO INTO RECALL SA1 ENDCODE .LOAD ENDCODE BX6 X1 SA6 TAPARG+2 .RELEASE RLT RJ CALL PS .CEASE AND DESIST H RJ DMPREG .DUMP THE REGISTERS SX0 CORE-1 SX6 MAXCOR RJ CRDUMP RJ WEOF EJECT ....................................................................... . A D D R O U T I N E ....................................................................... A EQ B2,B3,AD1 .DOES IL = 1 SB4 4 .LOAD 4 EQ B2,B4,AD4 .SPECIAL IF IL = 4 SB4 7 .LOAD 7 NE B2,B4,ERRORI .BAD LENGTH AD1 SX3 B0 .ZERO SWITCH T3 SX6 B3 .LOAD 1 SA6 SHORTA .SET SWITCH ON SX7 B7 .GET B-ADDRESS SA7 LORDER .STORE IT SA1 B7 .LOAD (B) LX1 1 .REMOVE WM AX1 49 .AND POSITION ZONES BX7 X1 .TRANSMIT SA7 ORGZONE .SAVE THE ORIGINAL ZONES SX1 X1-2 .SUBTRACT 2 ZR X1,NEGATB .IF 0,THEN B IS NEGATIVE MINA SA1 B6 .LOAD (A) LX1 1 .REMOVE WM AX1 49 .AND POSITION ZONES SX1 X1-2 .SUBTRACT 2 ZR X1,NEGATA .IF 0,THEN A IS NEGATIVE MINB SX0 B0 .ZERO BORROW-CARRY REGISTER ZR X3,TRUEADD .SEE IF TRUE ADD SX3 X3-2 .SUBTRACT 2 ZR X3,TRUEADD .IF =2,THEN TRUE ADD COMPADD SA1 B6 .LOAD A-FIELD SA2 B7 .LOAD B FIELD SX5 17B .LOAD MASK BX3 X1*X5 .GET NUMERIC PART OF A BX4 X2*X5 .GET NUMERIC PART OF B SX5 X3-10 .SEE IF .GE. 10 NG X5,T9 .IF .LT. THAN 10,/K ZR X5,T91 .IF SO SET TO ZERO SX3 X3-8 .SUBTRACT 8 T9 SX5 X4-10 .SEE IF .GE. 10 NG X5,T10 .OK IF .LT. THAN 10 ZR X5,T92 .SEE IF 10 SX4 X4-8 .SUBTRACT 8 TO MAKE .LT. 10 T10 SX4 X4+10 .ADD 10 TO B-FIELD IX3 X4-X3 .SUBTRACT A FROM B IX3 X3-X0 .SUBTRACT ANY BORROWS SX4 X3-9 .SUBTRACT 9 ZR X4,T95 .JUMP IF EQUAL TO 9 PL X4,SETBOR .INDICATE NO BORROW T95 SX0 B3 .CONVERT 0 TO 8-2 T11 NZ X3,NORIG .CONVERT 0 TO 8-2 SX3 10 .CHANGE TO 8-2 NORIG BX6 X3 .STORE RESULT SA6 B7 . NG X2,RECOMP .WORD MARK B-FIELD ... NG X1,TA1 .WORD MARK A-FIELD RJ DECRA .REDUCE A RJ DECRB .REDUCE B EQ COMPADD .BACK TO MAIN CYCLE T91 SX3 B0 .ZERO X3 EQ T9 .RETURN T92 SX4 B0 .ZERO X4 EQ T10 .RETURN SETBOR SX3 X3-10 .DECREASE BY 10 SX0 B0 .ZERO BORROW EQ T11 .CONTINUE TA1 RJ DECRB .REDUCE B BY 1 SA2 B7 .LOAD B SX5 17B .LOAD MASK BX3 X2*X5 .GET NUMERIC ZR X0,T12 .DOES BORROW = 0 ZR X3,SET9 .IF ZERO OR TEN SX4 X3-10 .THEN SET IT TO 9 NG X4,ADX1 .OK IF .LT. 10 ZR X4,SET9 .IS IT 10 SX3 X3-8 .REDUCE BY 8 IF .GT. 10 ADX1 SX0 B0 .ZERO BORROW SX3 X3-1 .AND REDUCE NUMERIC BY 1 CK0 NZ X3,NORIG .CONTINUE TRANSFER SX3 10 .SET TO 10 IF ZERO EQ NORIG .FINISH B-FIELD SET9 SX3 9 .SET TO 9 EQ NORIG .CONTINUE TRANSFER T12 SX4 X3-11 .SUBTRACT 11 NG X4,CK0 .OK IF .LT. 10 SX3 X3-8 .ELSE DECREASE BY 8 EQ CK0 .GO TO CK0 RECOMP MX4 1 .PUT THE WM BACK BX6 X4+X6 . SA6 B7 . SA4 ORGZONE .LOAD ZONES ZR X4,MAK3 .SEE IF NONSTANDARD SX5 X4-1 .SUBTRACT 1 NZ X5,TB1 .SEE IF A-ZONE MAK3 SX4 3 .LOAD BA ZONE TB1 ZR X0,PH1 .ANY BORROWS SA5 LORDER .GET LOW ORDER ADDRESS SB7 X5 .PUT IN B7 SX5 B3 .GET 1 BX4 X4-X5 .COMPLEMENT ZONES LX4 48 .POSITION ZONES SA1 B7 .LOAD UNITS POSITION SA2 MASK3 BX3 X1*X2 .GET ZONES OUT OF WORD BX6 X3+X4 .REPLACE WITH COMPLEMENT ZONES SA6 B7 .STORE WORD BACK LBA SA1 B7 .LOAD B SX3 X1-10 .IS IT EQUAL TO 10... ZR X3,T14 .IF SO,LEAVE IT 10 SX6 X1 .GET NUMERIC PART SX3 10 .LOAD 10 IX3 X3-X6 .GET 10-DIGIT BX6 -X2*X1 .SAVE ZONES BX6 X3+X6 .OR IN ZONES WMCK NG X1,RERN .IS A WM IN B-FIELD ... SA6 B7 .STORE IN B RJ DECRB .REDUCE BY 1 SA1 B7 .LOAD (B) SX2 X1 .GET NUMERIC PORTION OF WORD SX3 X2-9 .SUBTRACT 9 ZR X3,ST10 .IF 9,SET TO 10 NG X3,LT9 .IF NG THEN .LT. 9 SX6 9 .ELSE = 10 , SET TO 9 EQ WMCK .GO CHECK WM ST10 SX6 10 .SET TO 10 EQ WMCK .SEE IF WM LT9 SX3 9 .LOAD 9 IX6 X3-X2 .GET 9-X2 EQ WMCK .GO LOOK FOR WM RERN MX3 1 .LOAD WORD MARK BX6 X6+X3 .OR IN WM SA6 B7 .STORE RESULT RJ DECRA .REDUCE RJ DECRB .REDUCE B SX6 B6 .GET A SA6 SAVEA .SAVE IT EQ ICYCLE .GET NEXT INSTRUCTION T14 NG X1,STF .WORD MARK IN B-FIELD ... RJ DECRB .DECREASE B-REGISTER EQ LBA .CONTINUE COMPLEMENT OPERATION PH1 SA5 LORDER .GET UNITS ADDRESS SA1 X5 .LOAD UNITS DIGIT SA2 MASK1 .LOAD MASK1 BX1 -X2*X1 .SAVE WM AND NUMERIC LX4 48 .SHFT ZONES BX6 X1+X4 .PUT IN ZONES SA6 X5 .STORE UNITS DIGIT STF RJ DECRA .DECREASE A-REGISTER RJ DECRB .DOWN B SX6 B6 .GET A-REGISTER SA6 SAVEA .SAVE IT EQ ICYCLE .RETURN TO ICYCLE AD4 SB7 B6 .SET B = A , ONE FIELD EQ AD1 .BACK TO TWO ADDR.CODE S SB4 4 .LOAD 4 EQ B2,B4,S4 .SEE IF IL=4 EQ B2,B3,S1 .IS LENGTH =1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .IS LENGTH 7 S1 SX3 B3 .SET CTR TO 1 EQ T3 .JOIN MAIN FLOW FOR ADD S4 SA1 B6 .LOAD A-FIELD SA2 MASK1 .LOAD MASK BX2 X1*X2 .GET ZONES AX2 48 .SHIFT RIGHT ZR X2,NONSTAN .SEEIF NONSTANDARD ZONES SX3 X2-1 .SUBTRACT 1 NZ X3,STAN .SEE IF A-ZONE NONSTAN SX2 3 .SET TO BA STAN LX2 48 .POSITION ZONES SZERO SX3 10 .GET 10 (8-2) BX6 X2+X3 .OR TOGETHER NG X1,STRM .DOES A FIELD HAVE WM SA6 B6 .STORE A-FIELD RJ DECRA .DECREASE A-REGISTER SA1 B6 .LOAD (A) SX2 B0 .ZERO ZONES EQ SZERO .CONTINUE STRM MX2 1 .GET WM BX6 X6+X2 .OR IT IN SA6 B6 .STORE IT RJ DECRA .REDUCE A SB7 B6 .PUT A IN B SX7 B6 .GET A SA7 SAVEA .SAVE IT EQ ICYCLE .CONTINUE WITH NEXT INSTR. NEGATB SX3 X3+B3 .ADD 1 TO SWITCH EQ MINA .RETURN T4 SX3 B0 .ZERO X3 EQ T41 .RETURN T42 SX4 B0 .ZERO X4 EQ T5 .RETURN NEGATA SX3 X3+B3 .ADD 1 TO SWITCH EQ MINB .RETURN SET10X SX3 X3-10 .SUBTRACT 10 SX0 B3 .SET CARRY TO 1 EQ T6 .RETURN TRUEADD SA1 B6 .LOAD A WORD SA2 B7 .LOAD B WORD SX5 17B .LOAD MASK BX3 X1*X5 .GET NUMERIC A BX4 X2*X5 .GET NUMERIC B SX5 X3-10 ..GT. 10... NG X5,T41 .OK IF .LT. 10 ZR X5,T4 .IF 10 SET TO 0 SX3 X3-8 .REDUCE BY 8 T41 SX5 X4-10 .IS B NUMERIC .GT. 10 NG X5,T5 .OK IF .LT. 10 ZR X5,T42 .IF 10 SET TO 0 SX4 X4-8 .REDUCE BY 8 T5 IX3 X3+X4 .ADD A TO B IX3 X3+X0 .ADD IN ANY CARRIES T8 SX4 X3-10 .SUBTRACT 10 PL X4,SET10X .IF .GT. 9,THEN CARRY SX0 B0 .ZERO CARRY COUNT T6 NZ X3,NOFIX .CHANGE 0 TO 8-2 SX3 10 .SET TO 8-2 NOFIX PL X2,NEINWM .NO WM NZ X0,FLOWOV .CHECK OVERFLOW T7 SA5 SHORTA .LOAD INDICATOR ZR X5,CLEANUP .THEN WE ARE DONE SA4 MASK1 . BX1 X1*X4 .REMOVE WM AND NUMERIC IX2 X1+X2 .ADD ZONES CLEANUP BX4 X2 .GET BFIELD LX4 1 .REMOVE WM AX4 49 .AND SHIFT ZONES SX5 3 .LOAD 3 IX5 X5-X4 .SUBTRACT ZONES PL X5,NOMOD . SX4 X4-4 .TAKE ZONES MODULO 4 NOMOD LX4 48 .REPOSITION ZONES BX7 X3+X4 .PUT ZONE AND NUMERIC TOGETHER MX3 1 .LOAD WM BX7 X3+X7 .OR IN WM SA7 B7 .STORE IT SA3 ORGZONE .RELOAD ORIGINAL ZONES LX3 48 .POSITION THEM SA4 LORDER .GET ADDRESS SB4 X4 .PUT IN BM SA4 B4 .LOAD THE WORD SA1 MASK3 .GET MASK BX4 X1*X4 .GET WM + NUMERIC BX7 X3+X4 .PUT IN ORIGINAL ZONE SA7 B4 .STORE IT BACK RJ DECRA .REDUCE A RJ DECRB .REDUCE B SX6 B6 .GET A-REG SA6 SAVEA .SAVE IT EQ ICYCLE .GET NEXT INSTRUCTION FLOWOV SX7 B3 .GET 1 SA7 OVFLOW .TURN ON INDICATOR BX4 X2 .GET B WORD LX4 1 .REMOVE WM AX4 1 . SA5 CON1 .LOAD CON1 IX4 X4+X5 .ADD 1 FOR OVERFLOW MX5 1 .GET MASK BX5 X2*X5 .GET WM IF ANY BX2 X4+X5 .PUT BACK IN X2 EQ T7 .CONTINUE NEINWM BX7 X3 .GET RESULT SA7 B7 .STORE IT NG X1,ASHRT .SHORT A-FIELD RJ DECRA .ELSE REDUCE A RJ DECRB .AND B EQ TRUEADD .ADD NEXT CELLS ASHRT RJ DECRB .REDUCE B BY 1 MX6 0 .ZERO OUT SHORTA SA6 SHORTA .SET FLAG SA2 B7 .LOAD B SX3 17B .MASK NUMERIC BX3 X3*X2 .REMOVE ZONES NZ X3,NBLTZ .TREAT BLANK AS ZERO SX3 12B .SET TO ZERO NBLTZ ZR X0,NOFIX .DONE IF NO CARRIES SA2 B7 .LOAD (B) BX4 X2 .GET COPY OF (B) LX4 1 .REMOVE WM AX4 1 . UX4 B0,X4 .GET NUMERIC SX5 X4-10 .SUBTRACT 10 NG X5,T21 .OK IF .LT. 10 ZR X5,T25 .IF = 8-2 TREAT AS 0 SX4 X4-8 .DECREASE BY 8 T21 IX3 X4+X0 .ADD IN CARRY EQ T8 .RETURN T25 SX3 B3 .ADD IN THE CARRY EQ T8 .RETURN EJECT ....................................................................... . COMPARE ROUTINE ....................................................................... C EQ B2,B3,C1 .IS LENGTH 1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .BAD LENGHT C1 SX7 B0 .ZERO X7 SA7 BLTA .RESET A .GT. B SA7 BGTA .RESET B .GT. A CGET SA1 B6 .LOAD (A) SA2 B7 .LOAD (B) SX0 17B .GET MASK BX3 X0*X1 .REMOVE WM AND ZONES BX4 X0*X2 .SAME FOR B SA5 MASK1 .LOAD MASKP BX0 X5*X1 .GET ZONES A BX6 X5*X2 .GET ZONES B AX0 44 .SHIFT ZONES A AX6 44 .SHIFT B ZONES IX3 X3+X0 .JOIN ZONES AND NUMERIC IX4 X4+X6 .SAME FOR B SA3 CTABLE+X3 .LOAD A EQUIVALENT SA4 CTABLE+X4 .LOAD B EQUIVALENT SB4 X3 .LOAD VALUE INTO B4 SB5 X4 .LOAD VALUE INTO B5 SX6 B3 .SET TO U LT B4,B5,BHI .SEE IF B .GT. A EQ B4,B5,C2 .ARE THEY EQUAL SA6 BLTA .SET B .LT. A ON SA7 BGTA .SET B.GT. A OFF C2 NG X2,C3 .WM IN B FIELD... PL X1,C4 .WM IN AFIELD SA6 BGTA .SET B .GT. A ON SA7 BLTA .RESET B .LT. A C3 SA3 BGTA .LOAD INDICATOR SA4 BLTA .DITTO NZ X3,C5 .IS B .GT. A ON NZ X4,C5 .OR B .LT. A SA6 BEQA .SET B=A AND SA7 BNEA .B .NE. A OFF C6 RJ DECRA .DECREMENT A RJ DECRB .DECREMENT B SX6 B6 .SAVE A-REG SA6 SAVEA .IN SAVEA EQ ICYCLE .NEXT INSTRUCTION C5 SA6 BNEA .SET B .NE. A SA7 BEQA .RESET B=A EQ C6 .FINISH UP C4 RJ DECRA .REDUCE A RJ DECRB .REDUCE B EQ CGET .DO NEXT CHARACTERS BHI SA6 BGTA .SET B.GT. A ON SA7 BLTA .RESET B .LT.A EQ C2 .RETURN EJECT ....................................................................... . MCM ROUTINE ....................................................................... MCM SB4 CORE+CORESIZ .GET MAX CORE ADDRESS EQ B2,B3,MCM1 .LENGTH = 1 SB5 7 .LOAD 7 NE B2,B5,ERRORI .ERROR IN INSTRUCTION LENGTH MCM1 SA1 B6 .LOAD A FIELD SA2 B7 .GET B FIELD MX0 1 .GET MASK BX4 -X0*X1 .REMOVE SIGN BIT BX2 X0*X2 .SAVE SIGN BIT BX6 X4+X2 .OR IN WM BIT SA6 B7 .STORE CHARACTER SA2 (00010000000000000012B) .RECORD MARK BX3 X4-X2 .SEE IF EQUAL ZR X3,MCMDONE .IF ZERO , YES BX2 X0+X2 .TRY WITH A WM BX3 X1-X2 .RECORD MARK+WM ZR X3,MCMDONE .IF ZERO THEN DONE SA2 (40030000000000000017B) .G/M + W/M BX3 X1-X2 .IS IT A GMWM ZR X3,MCMDONE .IS YES,DONE SB6 B6+B3 .STEP AREIGISTER SB7 B7+B3 .STEP B-REGISTER GE B6,B4,ERROR1 .SEE IF ADDRESS ERR GE B7,B4,ERROR1 .DITTO EQ MCM1 .CONTINUE MCMDONE SB6 B6+B3 .UP BY 1 SB7 B7+B3 .UP BY 1 GE B6,B4,ERROR1 .SEE IF ERROR GE B7,B4,ERROR1 .SEE IF ERROR SX6 B6 .SAVE A-REGISTER SA6 SAVEA . EQ ICYCLE .RETURN TO ICYCLE EJECT ....................................................................... . P U N C H B C D C A R D ....................................................................... PCBCD JP * .ENTRY/EXIT LINE SB4 79 .LOAD 79 PCDECOD SA1 CORE+101+B4 .LOAD PUNCH LOCATION SX2 17B .GET NUMERIC BX3 X1*X2 .PART OF LOCATION SA2 MASK1 .LOAD MASK BX4 X1*X2 .REMOVE ZONES AX4 44 .SHIFT RIGHT BX3 X3+X4 .PUT WITH NUMERIC SA4 OUTTABL+X3 .GET BINARY BX6 X4 .PUT INTO X6 SA6 CARD+B4 .PUT INTO OUTPUT BUFFER EQ B4,PACK5 .ARE 80 CHARACTERS DONE SB4 B4-B3 .IF NOT,CONTINUE EQ PCDECOD .THE OPERATION PACK5 SB4 79 .LOAD 79 TO B4 SX5 10 .LOAD 10 SB5 8 .AND 8 TO B5 PCK1 SX6 B0 .ZERO OUTPUT REGISTER SX4 B0 .ZERO THE COUNTER PCK2 SA1 CARD+B4 .LOAD A BYTE BX6 X1+X6 .OR IN THE BYTE LX6 54 .SHIFT IT DOWN SB4 B4-B3 .DECREASE POINTER SX4 X4+B3 .INCREMENT BYTE COUNTER IX0 X4-X5 .ARE FIVE PACKED YET NZ X0,PCK2 .CONTINUE,IF NOT LX6 6 .BACK UP 1 CHAR. SA6 PCHOUT-1+B5 .STORE THE PACKED WORD SB5 B5-B3 .DECREASE OUTPUT BUFFER POINTER NE B5,PCK1 .CONTINUE IF NOT DONE SX6 B1 .SAVE MY REGISTERS SX7 B2 . SA6 K1 . SA7 K2 . SX6 B6 . SX7 B7 . SA6 K6 . SA7 K7 . SB1 1 .LOAD PARAMETERS SX7 PCHOUT . SX1 PBUFF . SA0 PCHOUT+8 . RJ WRITE .PUT THE CARD IMAGE IN P80C SA1 K1 .RELOAD MY REGISTERS SA2 K2 . SB1 X1 . SB2 X2 . SA1 K6 . SA2 K7 . SB6 X1 . SB7 X2 . SB3 1 . EQ PCBCD .RETURN EJECT ....................................................................... . P U N C H B I N A R Y C A R D ....................................................................... PCBIN JP * .ENTRY/EXIT LINE SA1 PCBIN .LOAD EXIT LINE BX6 X1 . SA6 PCBCD .SET UP RETURN SB4 79 .LOAD 79 PCBSCN SA1 CORE+401+B4 .LOAD 401-480 SA2 CORE+501+B4 .LOAD 501-580 SX3 17B .GET NUMERIC MASK BX6 X2*X3 .GET NUMERIC 500S BX4 X1*X3 .GET NUMERIC 400S SA3 MASK1 .LOAD ZONE MASK BX7 X2*X3 .GET ZONE 500S BX5 X1*X3 .GET ZONE 400S BX6 X6+X7 .FORM 500S BX4 X4+X5 .FORM 400S LX4 6 .SHIFT TO FORM UPPER PART BX6 X4+X6 .FORM COMPLETE BYTE SA6 CARD+B4 .STORE THE BYTE SB4 B4-B3 .DECREASE B4 EQ B4,PCBSCN .CONTINUE IF NOT DONE EQ PACK5 .NOW GO PACK IT UP AND OUTPUT IT EJECT ....................................................................... . M C E R O U T I N E ....................................................................... MCE EQ B2,B3,MCE1 .IS IL=1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .BAD LENGTH MCE1 SA1 B6 .LOAD (A) NG X1,ERRORED .SHORT EDIT FIELD ERROR LX1 1 .GET ZONES AX1 49 . SA0 X1 .SAVE THEM SX0 B0 .ZERO BODY TRIGGER SA1 B6 .LOAD A-FIELD CHARACTER SX5 B0 .AND ZERO SUPPRESS SWITCH MCEA SA2 B7 .LOAD (B) BX7 X2 .SAVE B-CHARACTER LX2 1 .REMOVE WM AX2 1 .REMOVE WM ZR X2,MCEB .SEE IF BLANK SX3 12B .LOAD 1401 ZERO BX3 X2-X3 .EXCLUSIVE OR ZR X3,MCEB .PROCESS AS BLANK SA3 MASK1 .LOAD BA BITS BX3 X2-X3 .SEE IF A + SIGN ZR X3,MCECOM GO SET IT TO BLANK SA3 (00030000000000000003B).LOAD A C BX3 X2-X3 . ZR X3,MCESPN .JUMP IF = C SA3 (00020000000000000011B).CHECK FOR AN R BX3 X2-X3 . ZR X3,MCESPN .JUMP IF = TO R MX3 1 .LOAD A - SIGN AX3 10 . BX3 X2-X3 . ZR X3,MCESPN .JUMP ON - SIGN MCEBD RJ DECRB . PL X7,MCEA .IF NO WM,TAKE NEXT B-CYCLE EQ MCEFE . MCECOM MX6 0 .STORE A BLANK SA6 B7 .IN PLACE OF CHARACTER EQ MCEBD .AT B-ADDRESS MCESPN NZ X0,MCEBD .NO SIGN CONTROL IF BODY TRIG. ON SX4 A0-2 .IS ZONE OF A FIELD NEGATIVE ZR X4,MCEBD .STORE CHARACTER BACK IF - EQ MCECOM .BRANCH IF A-FIELD + MCEB ZR X0,BTOFF .IS IT FIRST DIGIT MX4 1 . BX6 -X4*X1 .MASK OFF WORD MARK PORTION SA6 B7 .STORE A-FIELD MCES SX4 10 .IS B-FIELD CHAR = 0 BX4 X2-X4 . NZ X4,NOEWM .JUMP IF NOT = 0 MX4 1 .SET THE WM TO SHOW BX6 X1+X4 .LIMIT OF ZERO SUPPRESSION SA6 B7 . SX5 B3 .TURN ZERO SUPPRESS ON RJ DECRB .DECREASE B-REGISTER EQ MCESTW . NOEWM RJ DECRB .DECREASE B-REGISTER NG X7,MCEFE .IS IT END OF CONTROL WORD MCESTW NG X1,MCAFW .IS A WM WITH THIS CHARACTER RJ DECRA .DECREASE A-REGISTER SA1 B6 .LOAD A EQ MCEA .GO TAKE B-CYCLE MCAFW MX0 0 .TURN OFF BODY TRIGGER SA2 B7 .LOAD B-FIELD BX7 X2 .SAVE B-CHARACTER LX2 1 .REMOVE WM AX2 1 . SA3 (00010000000000000013B).LOAD A , BX3 X2-X3 . ZR X3,MCECLR .CLEAR IF A , SA3 MASK1 .IS IT A + BX3 X2-X3 . ZR X3,MCECLR . MX3 1 .GENERATE A - SIGN AX3 10 . BX3 X2-X3 .IS IT A - SIGN ZR X3,MCECLR . BX6 X2 . SA6 B7 .STORE B-FIELD BACK EQ MCES . MCECLR MX6 0 .STORE A BLANK SA6 B7 . EQ MCES . MCEFE SA2 B7+B3 .LOAD STORED B-FIELD MX4 1 .REMOVE THE WM BX6 -X4*X2 . SA6 B7+B3 . NZ X5,RESCAN .TEST FOR REVERSE SCAN SX6 B6 .SAVE A-REGISTER SA6 SAVEA . EQ ICYCLE .TAKE INSTRUCTION CYCLE BTOFF SX4 17B .MASK FOR NUMERIC PART BX6 X1*X4 . SA6 B7 .STORE NUMERIC PART SX0 B3 .TURN ON BODY TRIGGER EQ MCES . RESCAN SB7 B7+B3 .INCREMENT B-REGISTER SA2 B7 .LOAD B-FIELD NZ X5,RESC1 .IS ZERO SUPPRESS ON SA4 MASK1 .CHECK FOR SIGNIF NUMERIC DIGIT BX3 X2*X4 . NZ X3,MCESD .ARE ZONES PRESENT MX4 1 .REMOVE WM BX3 -X4*X2 . SX4 B3 .LOAD 1 IX4 X3-X4 .IS IT .GE. 1 NG X4,MCESD . SX4 10 .IS IT .LE 9 IX4 X3-X4 . PL X4,MCESD . RESSTR MX4 1 . BX6 -X4*X2 .STORE B-DIGIT SA6 B7 . RESWMT PL X2,RESCAN .CONTINUE IF NO WM SX6 B6 .SAVE A-REG SA6 SAVEA . EQ ICYCLE . MCESD MX4 1 .REMOVE WM FROM B BX3 -X4*X2 . ZR X3,RESSTR .DOES B = BLANK SX4 10 .DOES B = 0 BX4 X3-X4 . ZR X4,RESSTR . SA4 (00010000000000000013B).LOAD A , BX4 X3-X4 .DOES B = , ZR X4,RESSTR . SX5 B3 .TURN ON ZERO SUPPRESS EQ RESSTR . RESC1 SA4 MASK1 .CHECK FOR SIGNIF DIGIT BX3 X2*X4 . NZ X3,MCERD .IF ZONES,THEN NOT SIG DIGIT MX4 1 .REMOVE WM BX3 -X4*X2 . SX4 B3 .LOAD 1 IX4 X3-X4 .IS IT .GE. 1 NG X4,MCERD . SX4 10 . IX4 X3-X4 .IS IT .LE. 9 PL X4,MCERD . MX5 0 .TURN OFF ZERO ZSUPPRESS EQ RESSTR . MCERD MX4 1 . BX3 -X4*X2 .REMOVE WM SX4 10 .DOES B=0 BX4 X3-X4 . ZR X4,MCECBT . SA4 (00010000000000000013B).LOAD A , BX4 X3-X4 . NZ X4,RESSTR . MCECBT MX6 0 .CLEAR B-CHARACTER SA6 B7 . EQ RESWMT . EJECT ....................................................................... . B B E R O U T I N E ....................................................................... BBE EQ B2,B3,BBT1 .DOES LENGTH = 1 SB4 8 .LOAD 8 NE B2,B4,ERRORI .DOES IL = 8 BBT1 SA2 B7 .LOAD B-FIELD SA3 DMOD .LOAD D-CHARACTER MX0 1 .GET MASK BX2 -X0*X2 .REMOVE WM X2 BX3 -X0*X3 .REMOVE WM X3 BX2 X2*X3 .FORM LOGICAL PRODUCT NZ X2,TRA .IF NONZERO THEN BIT MATCH RJ DECRB .ON NO MATCH,REDUCE B SX6 B6 .GET A-FIELD SA6 SAVEA .SAVE IT EQ ICYCLE .RETURN TO ICYLCE EJECT ....................................................................... . B W Z R O U T I N E ....................................................................... BWZ EQ B2,B3,BWZ1 .DOES IL=1 SB4 8 .LOAD 8 NE B2,B4,ERRORI .DOES IL=8 BWZ1 SA2 DMOD .LOAD DMOD SX3 17B .GET MASK BX3 X3*X2 .GET NUMERIC PART SB4 X3 .LOAD TO B EQ B4,B3,BW .OK IF 1 SB5 B3+B3 .LOAD 2 EQ B4,B5,BWZ2 .IS NUMERIC 2 SB5 B5+B3 .LOAD 3 NE B4,B5,ERRORD .BAD D-CHAR IF NOT 3 BWZ2 SA4 B7 .LOAD ( B) SA5 MASK1 .LOAD MASK BX3 X5*X2 .GET ZONES OF D CHARACTER BX0 X4*X5 .GET ZONE PART FOR COMPARISON BX5 X3-X0 .ARE ZONES IDENTICAL ZR X5,TRA .IF SO THEN BRANCH SX5 B3 .GET 1 BX5 X2*X5 .IS THERE A 1 BIT NZ X5,BWZ3 .IF SO(CHECK FOR WM BWZE RJ DECRB .ELSE TERMINATE SX6 B6 .THE EXECUTION OF SA6 SAVEA .THIS INSTRUCTION AND EQ ICYCLE .RETURN TO ICYCLE BW SX5 B3 .LOAD 1 IX5 X2-X5 .SUBTRACT 1 FROM DMOD NZ X5,ERRORD .BAD D-CHARACTER BWZ3 SA4 B7 .LOAD (B) NG X4,TRA .BRANCH ON WORD MARK EQ BWZE .GO TERMINATE EJECT ....................................................................... . P R T W M R O U T I N E . REGISTERS USED . A1,A2,A6,A7 . B3,B4,B5 . X1,X2,X6,X7 . SUBROUTINES CALLED - PRINTF,LCTR . ERROR EXITS - NONE ....................................................................... PRTWM JP * .ENTRY/EXIT LINE SA1 OUTTABL .LOAD A DPC BLANK SA2 OUTTABL+1 .AND A DPC 1 BX6 X1 .PUT BLANK IN X6 BX7 X2 .AND 1 IN X7 SA1 CORE+200 .GET STARTING ADDRESS SA6 PRINT .SET UP SINGLE SPACE OUTPUT LINE SB4 B3 .START B4 AT 1 SB5 133 .LOAD TEST VALUE TO B5 PRWM1 SA1 A1+B3 .LOAD PRINT LOCATION NG X1,WMYES .JUMP ON WORD MARK SA6 PRINT+B4 .STORE FOR OUTPUT SB4 B4+B3 .INCREMENT POINTERS NE B4,B5,PRWM1 .ARE 132 CHARACTERS DONE EQ PREND .GO PRINT THE LINE IF DONE WMYES SA7 PRINT+B4 .STORE A DPC 1 SB4 B4+B3 .INCREMENT POINTER NE B4,B5,PRWM1 .ARE 132 CHARACTERS DONE YET PREND RJ PRINTF .GO PRINT THE LINE RJ LCTR .ADD TO LINE COUNTER EQ PRTWM .RETURN EJECT ....................................................................... . M C S R O U T I N E . REGISTERS USED . A1,A2,A4,A6 . B2,B3,B4,B5,B7 . X1,X2,X3,X4,X6 . SUBROUTINES CALLED - NONE . ERROR EXITS - ERRORI ....................................................................... MCS EQ B2,B3,MCS1 .IS LENGTH 1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .BAD IL IF NOT 7 MCS1 SB5 B7 .SAVE B-ADDRESS MX4 1 .LOAD MASK SA1 B6 .REMOVE UNITS ZONE SX6 X1 .REMOVE WM AND ZONES SA6 B7 .STORE UNITS RJ DECRA . RJ DECRB . NG X1,MCSRS .TEST FOR ONE POSITION FIELD. MCSCN SA1 B6 .LOAD (A) BX6 -X4*X1 .REMOVE WM SA6 B7 .STORE IN B RJ DECRA .REDUCE A RJ DECRB .REDUCE B PL X1,MCSCN .CONTINUE MCSRS SB7 B7+B3 .INCREMENT B SA1 B7 .LOAD (B) ZR X1,MCET .JUMP ON BLANK SX2 12B .LOAD A ZERO BX3 X1-X2 .LOGICAL SUBTRACT ZR X3,BLNKIT .IF ZERO SET TO BLANK SA4 (00010000000000000013B).LOAD A , BX3 X1-X4 .EXCLUSIVE OR ZR X3,BLNKIT .IF , THEN SET TO BLANK SX2 9 .LOAD 9 IX3 X2-X1 .GET 9 - (B) NG X3,MCET .JUMP ON NONDIGIT MCTST EQ B5,B7,ZEZO .IS REVERSE SCAN DONE SB7 B7+B3 .INCREMENT B7 SA1 B7 .LOAD (B) ZR X1,MCTST .JUMP ON BLANK SA2 (00020000000000000000B).LOAD A - SIGN BX3 X1-X2 .LOGICAL SUBTRACT ZR X3,MCTST .JUMP IF A - SIGN SA4 (00010000000000000013B).LOAD A , BX3 X1-X4 .SUBTRACT FROM X1 ZR X3,MCTST .JUMP IF , SX2 12B .LOAD A ZERO IX3 X2-X1 .GET 0 - (B) PL X3,MCTST .JUMP IF DIGIT EQ MCET .GO SEE IF DONE BLNKIT SX6 B0 .SET X6 TO BLANK SA6 B7 .STORE IN B MCET EQ B5,B7,ZEZO .IS REVERSE SCAN DONE EQ MCSRS .NO, THEN CONTINUE ZEZO SB7 B7+B3 .INCREASE B-REGISTER SX6 B6 .SAVE A-REGISTER SA6 SAVEA . EQ ICYCLE .PROCESS NEXT INSTRUCTION EJECT ....................................................................... . M A R O U T I N E. ....................................................................... MA EQ B2,B3,MA1 .IS LENGTH = 1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .LENGTH ERROR MA1 SB4 B6 .PUT IN A ADDRESS RJ GET .CONVERT TO BINARY BX1 X7 .SAVE RESULT IN X1 SB4 B7 .PUT IN B ADDRESS RJ GET .CONVERT TO BINARY SB4 X1 .PUT A RESULT IN B4 SB4 X7+B4 .ADD IN B FIELD SB5 15999 .LOAD CONSTANT LT B5,B4,MADOWN .REDUCE IF .GT. 15999 MACNV SA1 B7 .LOAD ( B ) RJ CNVRT .CONVERT RESULT TO BCD SA2 ADDR1 .LOAD 100 S SA3 ADDR3 .LOAD UNITS SA4 B7-2 .LOAD 100 S OF RESULT MX5 1 .LOAD MASK BX6 X5*X1 .GET WM OFF UNITS LOCATION BX6 X6+X3 .OR IN RESULT OF MODIFICATION BX7 X5*X4 .DO SAME TO 100 S POSITION BX7 X2+X7 . SA6 B7 .STORE UNITS SA7 B7-2 .STORE 100 S SA2 ADDR2 .LOAD 10 S OF RESULT AREA SA4 B7-B3 .SAVE ANY WM OR ZONE PRESENT SA5 MASK2 . BX6 X5*X4 .SAVE ANY WORD MARK PRESENT BX6 X6+X2 .OR IT TO THE RESULT SA6 B7-B3 .STORE TEN S POSITION SB6 B6-3 .REDUCE THE A REGISTER SB4 CORE .GET ABSOLUTE BOTTOM GE B4,B6,ERROR4 .CHECK FOR ADDRESS ERROR MX5 12 .SAVE ZONE PART BX3 X5*X1 .OF ORIGINAL AND BX1 X5*X3 .FINAL RESULT BX3 X3-X1 .HAS IT CHANGED NZ X3,MODIF .IF SO SET B REG ACCORDINGLY SB7 B7-3 .ELSE REDUCE BY 3 MADER SB4 CORE .LOAD BASE ADDRESS GE B4,B7,ERROR4 .JUMP ON ERROR SX6 B6 .SAVE A REGISTER SA6 SAVEA . EQ ICYCLE .RETURN MADOWN SB4 B4-16000 .SUBTRACT 16000 EQ MACNV .GO CONVERT MODIF SB7 B7-B3 .REDUCE BY 1 EQ MADER .GO FINISH UP EJECT ....................................................................... . Z A R O U T I N E ....................................................................... ZA SB4 4 .LOAD 4 EQ B2,B4,ZA4 .LENGTH = 4 EQ B2,B3,ZA1 .LENGTH = 1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .BAD LENGTH ZA1 RJ STANZON .GO GET STANDARD ZONES ZACK SA2 B7 .LOAD B FIELD NG X2,ZATERM .TERMINATE IF B FIELD WM SA6 B7 .STORE IF NO WM NG X1,ZAFWM .IS THERE AN A FIELD WM RJ DECRA .DECREASE A RJ DECRB .DECREASE B SA1 B6 .LOAD (A) SX3 17B .MASK TO SAVE NUMERIC BX6 X1*X3 .REMOVE ZONES EQ ZACK .GO CHECK FOR WM ZAFWM SX6 12B .PUT 1401 ZERO IN X6 ZAFTWM RJ DECRB .REDUCE B-ADDRESS SA2 B7 .LOAD (B) NG X2,ZATERM .TERMINATE ON B FIELD WM SA6 B7 .STORE ZERO EQ ZAFTWM .CONTINUE SCAN ZATERM MX2 1 .GET A WORD MARK BX6 X2+X6 .OR IN TO ZERO SA6 B7 .STORE IT RJ DECRA .DECREASE A RJ DECRB .DECREASE B SX6 B6 .SAVE A SA6 SAVEA . EQ ICYCLE .RETURN ZA4 RJ STANZON .STANDARDISE ZONES SA2 MASK3 .LOAD MASK ZAST NG X1,ZA4END .END IF WM SA6 B6 .STORE IN A RJ DECRA .DECREMENT A SA1 B6 .LOAD (A) SA2 MASK3 .LOAD MASK BX6 X1*X2 .REMOVE ZONES EQ ZAST .CHECK FOR WM ZA4END SA6 B6 .STORE RJ DECRA .REDUCE A SB7 B6 .PUT A INTO B SX6 B6 .SAVE A REGISTER SA6 SAVEA . EQ ICYCLE .RETURN EJECT ....................................................................... . Z S R O U T I N E ....................................................................... ZS SB4 4 .LOAD 4 EQ B2,B4,ZS4 .LENGTH = 4 EQ B2,B3,ZS1 .LENGTH = 1 SB4 7 .LOAD 7 NE B2,B4,ERRORI .BAD LENGTH ZS1 RJ STANZON .STANDARDIZE ZONES AX3 48 .SHIFT ZONES RIGHT ZR X3,BAZS .JUMP IF NO ZONE SX4 X3-2 .IS IT A B ZONE ZR X4,BZNS .IF SO SET TO BA ZONE BAZS SA4 (00020000000000000000B).LOAD B ZONE BX6 X4+X5 .PUT IN INVERTED ZONE EQ ZACK .TREAT AS ZA BZNS SA4 MASK1 .LOAD BA ZONE BX6 X4+X5 .OR IN ZONE EQ ZACK .PROCESS REMAINDER AS ZA ZS4 RJ STANZON .STANDARDIZE ZONES AX3 48 .SHIFT ZONES RIGHT ZR X3,BAZS1 .SET TO B ZONE SX4 X3-2 .IS IT A B ZONE ZR X4,BZNS1 .SET TO BA ZONE BAZS1 SA4 (00020000000000000000B).LOAD B ZONE BX6 X4+X5 .PUT IN INVERTED ZONE EQ ZAST .PROCESS AS ZA (IL=4) BZNS1 SA4 MASK1 .LOAD BA ZONE BX6 X4+X5 .OR WITH REST OF WORD EQ ZAST .PROCESS AS ZA (IL=4) EJECT ....................................................................... . S T A N D A R D I Z E Z O N E S R O U T I N E ....................................................................... STANZON JP * .ENTRY/EXITLINE SA1 B6 .LOAD (A) SA2 MASK1 .LOAD MASK BX3 X1*X2 .SAVE ZONES AX3 48 .SHIFT ZR X3,ZAPL .SET TO BA IF NO ZONE SX4 X3-1 .SUBTRACT 1 ZR X4,ZAPL .IF -A- ZONE SET TO BA ZONE ZARET LX3 48 .RESTORE ZONES SX6 17B .MASK ZONES AND WORD MARKS BX5 X1*X6 BX6 X5+X3 .OR IN STANDARD ZONES EQ STANZON .RETURN ZAPL SX3 3 .LOAD BA ZONE EQ ZARET .RETURN EJECT ....................................................................... . TAPE READ ROUTINE (BCD) . ....................................................................... TAPEIO SA3 (00010000000000000004B).LOAD A U SA2 B4+B3 .LOAD THIRD CHARACTER BX4 X2-X3 .IS IT A U NZ X4,TAPEB .THEN BINARY TAPE SA3 A2+B3 .LOAD FOURTH CHARACTER ZR X3,ERRORC .TAPE=0,ERROR SX4 7 . IX4 X3-X4 . PL X4,ERRORC .TAPE .GT. 6 SA5 SWG+X3 .LOAD TAPE DEFINITION CELL ZR X5,TAPEDS .SIMULATE TAPE ON DISC SA4 (00020000000000000011B).LOAD A R SA2 B1-B3 LOAD D-CHARACTER BX4 X2-X4 . NZ X4,TAPEWR .THEN MAYBE A TAPE WRITE SX0 712B .BCD READ(ZERO FILL,NO EXIT) SX1 INBUF+TBLGTH-1 .BUFFER LENGTH RJ SETARGS .SET UP CALLING ARGUMENTS MX6 0 .ZERO WORD COUNT RJ TAPCALL .INITIATE THE OPERATION TPWAIT SA1 TSTCT .CHECK IF DONE ZR X1,TPWAIT . PL X1,TREADOK . SA2 (77777777777777777771B).TEST FOR AN EOF BX3 X2-X1 . ZR X3,EOFR . SA2 (77777777777777777753B).TEST FOR EOT BX3 X2-X1 . ZR X3,EOFR . SX6 B3 .SET TAPE ERROR FLAG SA6 TEROR . BX1 -X1 .COMPLEMENT COUNT EQ TREADOK . EOFR SX6 B3 . SA6 EOF .TURN ON EOF INDICATOR BX1 X6 .COUNT OT X1 MX6 4 .GENERATE AN EOF CHARACTER LX6 58 SA6 INBUF .STORE IT TREADOK SB4 CORE+CORESIZ+1 MX0 6 . SX7 INBUF .INITIAL ADDRESS SX1 X1+INBUF-1 .FINAL ADDRESS NXTWD SA2 X7 .LOAD A WORD IX3 X1-X7 .LAST WORD YET... ZR X3,LASTWD . SB2 10 .SET CHARACTER COUNT RJ MSTORT .STORE THIS WORD TO CORE SX7 X7+B3 .INCREMENT WORD POINTER EQ NXTWD .DO NEXT WORD LASTWD SB2 10 .PROCESS LAST WORD LWLP LX0 6 .CHECK CHARACTERS,RIGHT TO LEFT BX3 X2*X0 . NZ X3,PROCL .PROCESS LAST WORD SB2 B2-B3 .DECREASE COUNT EQ B2,GMSTR .IS WORD ALL ZERO EQ LWLP .CHECK NEXT CHARACTER PROCL MX0 6 .REGENERATE MASK RJ MSTORT .STORE CHARACTERS GMSTR SA3 (00030000000000000017B).GROUP MARK SA1 B7 .GET THE CHARACTER FROM STORAGE MX4 1 BX6 X4*X1 .SAVE THE WORD MARK BX6 X3+X6 .OR IN THE WORD MARK SA6 B7 .STORE THE GM IN 1401 CORE CORSTOP SB7 B7+B3 .INCREMENT B GE B7,B4,ERROR1 . EQ ICYCLE . MSTORT JP * .ENTRY/EXIT LINE TRANLT BX3 X0*X2 .MASK OFF CHARACTER LX3 6 . SA4 TPCODE+X3 .CONVERT CHARACTER BX6 X4 . SA5 B7 .CHECK 1401 CORE FOR GM-WM SA4 (40030000000000000017B). GROUP MARK + WORD MARK BX4 X4-X5 . ZR X4,CORSTOP .MOVE STOPPED BY CORE CHARACTER MX4 1 .SAVE WORD MARK BIT BX5 X4*X5 . BX6 X5+X6 .OR INTO CHARACTER SA6 B7 . SB7 B7+B3 .INCREMENT B-REGISTER GE B7,B4,ERROR1 .CHECK FOR CORE LIMIT LX2 6 .NEXT CHARACTER SB2 B2-B3 .DECREASE CHARACTER COUNT NE B2,TRANLT .LOOP TILL WORD DONE EQ MSTORT . EJECT ....................................................................... . TAPE WRITE ROUTINE (BCD) . ....................................................................... . TAPEWR SA4 (00010000000000000006B).IS IT A W BX4 X4-X2 NZ X4,ERRORD .BAD D-CHARACTER SB2 INBUF . SX7 10 .COUNTER SB4 INBUF+TBLGTH . SA2 MASK1 .GET MASK FOR ZONES SB5 CORE+CORESIZ+1 SA5 (40030000000000000017B).GM+WM MX6 0 . WCHAR SA1 B7 .LOAD A CHARACTER BX4 X1-X5 .IS IT A GM+WM ZR X4,ENDREC .IF SO,END OF RECORD BX0 X1*X2 .GET ZONES AX0 44 . SX1 X1 .GET NUMERIC PART BX1 X0+X1 .OR IN ZONES NZ X1,ENTCH .PUT CHARACTER IN WORD SX1 20B .SET TO BLANK (EXT. BCD) ENTCH BX6 X1+X6 .OR IN CHARACTER SX7 X7-1 .DECREASE CHARACTER COUNT ZR X7,WSTOR .STORE FULL WORD IF =0 LX6 6 .MOVE CHARACTER OVER INBR SB7 B7+B3 .INCREMENT B REGISTER GE B7,B5,ERROR1 .ADDRESSING ERROR EQ WCHAR .LOAD NEXT CHARACTER WSTOR SA6 B2 .STORE FULL WORD SB2 B2+B3 .INCREMENT BUFFER POINTER MX6 0 . SX7 10 .RESET COUNTER LT B2,B4,INBR .HAVE WE EXCEEDED BUFFER EQ ERRORL .*RECORD TOO LARGE* ENDREC SB7 B7+B3 .INCREMENT B-REGISTER GE B7,B5,ERROR1 .CHECK FOR ADDRESSING ERROR SX7 X7-1 BX4 X7 .MULTIPLY BY 6 TO GET SHIFT COUNT LX7 2 . LX4 1 . IX7 X4+X7 . SB5 X7 .LOAD SHIFT COUNT LX6 B5,X6 .POSITION LAST WORD SA6 B2 .STORE LAST WORD SA3 B1-5 .LOAD TAPE NUMBER SA5 SWG+X3 .GET DENSITY SETTING SX0 702B .BCD WRITE SX1 B2 .LAST WORD TO BE WRITTEN IN BUFF RJ SETARGS .SET UP ARGUMENTS SX7 B3 . RJ TAPCALL .CALL THE TAPE OPERATION WDLY SA1 TSTCT .CHECK FOR COMPLETE ZR X1,ICYCLE .LOOP TILL 0 OR - PL X1,WDLY .WAIT SA2 (77777777777777777753B).COMPLEMENT OF -T- BX3 X1-X2 . NZ X3,NOEOTW .NOT EOT FLAG SX6 B3 .SET EOF INDICATOR SA6 EOF . EQ ICYCLE .TAKE INSTRUCTION CYCLE NOEOTW SX6 B3 .SET TAPE ERROR SWITCH SA6 TEROR . EQ ICYCLE . EJECT . UNIT I/O OPERATIONS . ....................................................................... . BACKSPACE, REWIND, UNLOAD, WRITE TAPE MARK, SKIP BAD SPOT . ....................................................................... UIO SB4 5 .IS LENGTH =5 NE B2,B4,ERRORI .BAD INSTRUCTION LENGTH SA1 B1-3 .CHECK TAPE IDENTIFIER SA2 (00010000000000000004B).AGAINST *U* BX3 X1-X2 . NZ X3,ERRORC .ILLEGAL INSTRUCTION SA3 A1+B3 .CHECK TAPE NUMBER SX2 6 . ZR X3,ERRORC .BAD TAPE NUMBER IX1 X2-X3 .IS IT .LE. 6 NG X1,ERRORC .BAD NUMBER SA5 SWG+X3 .IS TAPE ON DISK ZR X5,UIODS . SA1 B1-B3 .GET D-MODIFIER SA2 (00030000000000000002B).IS IT A *B* BX3 X1-X2 . ZR X3,BKSPT .BACKSPACE TAPE SA2 (00020000000000000011B).IS IT AN *R* BX3 X1-X2 . ZR X3,RWDT .REWIND TAPE SA2 (00010000000000000004B).IS IT A *U* BX3 X1-X2 . ZR X3,UNLDT .UNLOAD TAPE SA2 (00020000000000000004B).IS IT AN *M* BX3 X1-X2 . ZR X3,WTMT .WRITE TAPE MARK SA2 (00030000000000000005B).IS IT AN *E* BX3 X1-X2 . ZR X3,SKPT .SKIP TAPE EQ ERRORD .BAD D-MODIFIER BKSPT SX0 742B .BACKSPACE COMMAND UIO1 SX1 INBUF+1 . SA3 A3 GET TAPE NUMBER RJ SETARGS .SET UP ARGUMENTS MX6 0 . RJ TAPCALL .INITIATE THE OPERATION UIO4 SA1 TSTCT .CHECK FOR OPERATION COMPLETE ZR X1,UIO4 .LOOP IF NOT DONE EQ ICYCLE .IF DONE,TAKE INSTRUCTION CYCLE RWDT SX0 752B .REWIND COMMAND EQ UIO1 . UNLDT SX0 762B .UNLOAD COMMAND EQ UIO1 . WTMT SX0 772B . UIO2 SX1 INBUF+1 . SA3 A3 GET TAPE NUMBER RJ SETARGS .SET UP ARGUMENTS SX6 B3 . RJ TAPCALL .INITIATE TAPE OPERATION UIO3 SA1 TSTCT .IS OPERATION COMPLETE ZR X1,ICYCLE .EXIT TO INSTRUCTION CYCLE IF DON PL X1,UIO3 .LOOP ON NOT COMPLETE SKPT SX0 774B .SKIP TAPE EQ UIO2 . UIODS EQ ICYCLE .NOT WRITTEN YET TAPEIOW SA4 (00010000000000000004B).LOAD A *U* SA3 A2+B3 .LOAD THE THIRD CHARACTER BX4 X4-X3 . NZ X4,ERRORI .*ILLEGAL INSTRUCTION* SA3 A3+B3 .LOAD THE TAPE NUMBER ZR X3,ERRORC .TAPE=0,ERROR SX4 7 . IX4 X3-X4 .IS TAPE NO. .GT. 6 PL X4,ERRORC .IF SO,ERROR MESSAGE TPSTRT SA5 SWG+X3 .LOAD TAPE DEFINITION CELL ZR X5,TWWDS .TAPE WITH WM ON DISC SA4 (00020000000000000011B).IS IT AN *R* SA1 B1-B3 .LOAD THE D-MODIFIER BX4 X1-X4 .AND SEE NZ X4,TAPEWW .IF NOT THEN GO TO TAPE WRITE SX0 712B .BCD READ SX1 INBUF+TBLGTH-1 .LWA OF BUFFER RJ SETARGS .SET UP CALLING ARGUMENTS MX6 0 . RJ TAPCALL .CALL THE TAPE ROUTINE TWDLY SA1 TSTCT .CHECK OPERATION COMPLETE ZR X1,TWDLY .LOOP ON INCOMPLETE PL X1,TWWOK .IF +, THEN NO ERRORS SX3 X1+6 .TEST FOR EOF ZR X3,TPIO1 .YES,EOF SX3 X1+24B .TEST FOR EOT SX6 B3 .ELSE TAPE ERROR SA6 TEROR . BX1 -X1 .COMPLEMENT COUNT EQ TWWOK .PROCESS THE RECORD TPIO1 SX6 B3 .TURN ON EOF SWITCH SA6 EOF . BX1 X6 .NUMBER OF CHARACTERS MX6 4 .GENERATE AN EOF CHARACTER LX6 58 SA6 INBUF .STORE THE CHARACTER TWWOK SB4 CORE+CORESIZ+1 MX6 0 . MX0 6 . SX7 INBUF .INITIAL ADDRESS SX1 X1+INBUF-1 .FINAL ADDRESS TWW1 SA2 X7 .LOAD A WORD IX3 X1-X7 .LAST WORD YET ZR X3,TWW6 .IF SO , HANDLE SPECIALLY SB2 10 .SET CHARACTER COUNT RJ LSTORT .STORE THE CHARACTERS SX7 X7+B3 .INCREMENT WORD POINTER EQ TWW1 .DO NEXT WORD TWW6 SB2 10 .PROCESS LAST WORD TWW7 LX0 6 .CHECK CHARACTER,RIGHT TO LEFT BX3 X2*X0 . NZ X3,TWW8 . SB2 B2-B3 .DECREASE COUNT EQ B2,TWW17 .IS THE WORD ALL ZERO EQ TWW7 .CHECK NEXT CHARACTER TWW8 MX0 6 . RJ LSTORT .STORE LAST WORD TWW17 MX6 0 SA6 B7 .CLEAR WHERE GM IS TO GO EQ GMSTR LSTORT JP * .ENTRY/EXIT LINE TWW4 BX3 X0*X2 .MASK OFF A CHARACTER LX3 6 . SX4 X3-35B .IS IT A WORD SEPARATOR CHAR. NZ X4,TWW2 .NOT A WM CHARACTER MX6 1 .PUT IN A WORD MARK EQ TWW5 .GET NEXT CHARACTER TWW2 SA4 TPCODE+X3 .LOAD A CHARACTER BX6 X4+X6 .OR IN POSSIBLE WORD MARK SA5 B7 .CHECK 1401 CORE FOR GM-WM SA4 (40030000000000000017B).GROUP MARK AND WORD MARK BX4 X4-X5 . ZR X4,CORSTOP .LOAD STOPPED BY CORE GM+WM SA6 B7 .ELSE STORE MX6 0 .CLEAR X6 SB7 B7+B3 .INCREMENT B REGISTER GE B7,B4,ERROR1 .CHECK FOR CORE LIMIT TWW5 LX2 6 .NEXT CHARACTER SB2 B2-B3 .DECREASE CHARACTER COUNT NE B2,TWW4 .LOOP TILL WORD DONE EQ LSTORT .EXIT IF DONE TWWDS EQ ICYCLE TAPEWW SA4 (00010000000000000006B).IS IT A *W* BX4 X4-X1 . NZ X4,ERRORD . SB2 INBUF .BEGINNING FWA OF INPUT BUFFER SX7 10 .INITIALIZE COUNT SB4 INBUF+TBLGTH .LWA OF BUFFER SA2 MASK1 .MASK FOR ZONES SB5 CORE+CORESIZ+1 SA5 (40030000000000000017B).GROUP MARK+WORD MARK MX6 0 . WCHARW SA1 B7 .LOAD A CHARACTER BX4 X1-X5 .IS IT A GM+WM ZR X4,ENDREC .IF SO,END OF RECORD BX0 X1*X2 .GET ZONES AX0 44 . BX1 -X2*X1 .SAVE WM AND NUMERIC BX1 X0+X1 .OR IN THE ZONES NG X1,WMON .CHECK FOR WM TAPEW1 NZ X1,ENTCHW .PUT CHARACTER INTO WORD SX1 20B .SET TO BLANK(EXT. BCD) ENTCHW BX6 X1+X6 .OR INTHE CHARACTER SX7 X7-1 .DECREASE CHARACTER COUNT ZR X7,WSTORW .STORE FULL WORD IF =0 LX6 6 .MOVE CHARACTER OVER INBRW SB7 B7+B3 .INCREMENT B-REGISTER GE B7,B5,ERROR1 .ADDRESSING ERROR EQ WCHARW .LOAD NEXT CHARACTER WSTORW SA6 B2 .STORE A FULL WORD SB2 B2+B3 .ADD 1 TO BUFFER POINTER MX6 0 . SX7 10 .RESET COUNTER LT B2,B4,INBRW .HAVE WE EXCEEDED THE BUFFER EQ ERRORL .*RECORD TOO LARGE* WMON SX3 35B .WM CHARACTER BX6 X3+X6 .OR IN THE CHARACTER SX7 X7-1 .DECREASE COUNT ZR X7,WMNXT .CHARACTER INTO NEXT WORD LX6 6 .LEFT SHIFT SX1 X1 .REMOVE THE WM EQ TAPEW1 .ENTER NORMAL FLOW WMNXT SA6 B2 .STORE FULL WORD SB2 B2+B3 .ADD 1 TO POINTER MX6 0 . SX7 10 .RESET COUNT SX1 X1 .REMOVE THE WM LT B2,B4,TAPEW1 .IS THE BUFFER FULL EQ ERRORL . CC SB4 2 EQ B2,B4,ICYCLE .NO CARRIAGE CONTROL SB4 5 .IS THIS ACCB INSTRUCTION NE B2,B4,ERRORI .ERROR INSTRUCTION LENGTH BAD EQ TRA .BRANCH SS SB4 2 EQ B2,B4,ICYCLE .NO SELECT STACKER SB4 5 . IS IT AN SSB INSTRUCTION NE B2,B4,ERRORI NO,THEN AN ERROR EQ TRA .BRANCH TAPEB EQ ICYCLE TAPEDS EQ ICYCLE D EQ ICYCLE M EQ ICYCLE RCBIN EQ ICYCLE MASK3 CON 40000000000000000017B SHORTA CON 0 ORGZONE CON 0 LORDER CON 0 CON1 CON 00010000000000000000B CORESIZ EQU 7999 OBUFF BSS 201 . BUFF BSS 201 . BUFF201 EQU BUFF+201 OBUFF21 EQU OBUFF+201 PCHOUT BSS 16 CDBUFF BSS 201 . CDBUFF1 EQU CDBUFF+201 PCODE VFD D18/CIO,N24/0,A18/PBUFF CTABLE CON 00 CON 55 CON 56 CON 57 CON 58 CON 59 CON 60 CON 61 CON 62 CON 63 CON 54 CON 20 CON 21 CON 22 CON 23 CON 24 CON 19 CON 13 CON 46 CON 47 CON 48 CON 49 CON 50 CON 51 CON 52 CON 53 CON 45 CON 14 CON 15 CON 16 CON 17 CON 18 CON 12 CON 36 CON 37 CON 38 CON 39 CON 40 CON 41 CON 42 CON 43 CON 44 CON 35 CON 07 CON 08 CON 09 CON 10 CON 11 CON 06 CON 26 CON 27 CON 28 CON 29 CON 30 CON 31 CON 32 CON 33 CON 34 CON 25 CON 01 CON 02 CON 03 CON 04 CON 05 PCHTABL CON 00000000000000000000B CON 04000000000000000000B CON 02000000000000000000B CON 01000000000000000000B CON 00400000000000000000B CON 00200000000000000000B CON 00100000000000000000B CON 00040000000000000000B CON 00020000000000000000B CON 00010000000000000000B CON 10000000000000000000B CON 01020000000000000000B CON 00420000000000000000B CON 00220000000000000000B CON 00120000000000000000B CON 00060000000000000000B CON 10000000000000000000B CON 14000000000000000000B CON 12000000000000000000B CON 11000000000000000000B CON 10400000000000000000B CON 10200000000000000000B CON 10100000000000000000B CON 10040000000000000000B CON 10020000000000000000B CON 10010000000000000000B CON 12020000000000000000B CON 11020000000000000000B CON 10420000000000000000B CON 10220000000000000000B CON 10120000000000000000B CON 10060000000000000000B CON 20000000000000000000B CON 24000000000000000000B CON 22000000000000000000B CON 21000000000000000000B CON 20400000000000000000B CON 20200000000000000000B CON 20100000000000000000B CON 20040000000000000000B CON 20020000000000000000B CON 20010000000000000000B CON 30000000000000000000B CON 21020000000000000000B CON 20420000000000000000B CON 20220000000000000000B CON 20120000000000000000B CON 20060000000000000000B CON 40000000000000000000B CON 44000000000000000000B CON 42000000000000000000B CON 41000000000000000000B CON 40400000000000000000B CON 40200000000000000000B CON 40100000000000000000B CON 40040000000000000000B CON 40020000000000000000B CON 40010000000000000000B CON 50000000000000000000B CON 41020000000000000000B CON 40420000000000000000B CON 40220000000000000000B CON 40120000000000000000B CON 40060000000000000000B CCODE VFD D18/CIO,N24/0,A18/CPARAM DMCODE VFD D18/DMP,N24/0,A18/ENDCON ENDCODE VFD D18/END,N42/0 PBUFF VFD D30/PUNCH,N12/0,N18/17B VFD N42/0,A18/CDBUFF VFD N42/0,A18/CDBUFF VFD N42/0,A18/CDBUFF VFD N42/0,A18/CDBUFF1 BPARAM VFD D30/INPUT,N12/0,N18/11B VFD N42/0,A18/BUFF VFD N42/0,A18/BUFF VFD N42/0,A18/BUFF VFD N42/0,A18/BUFF201 CPARAM VFD D36/OUTPUT,N6/0,N18/15B VFD N42/0,A18/OBUFF VFD N42/0,A18/OBUFF VFD N42/0,A18/OBUFF VFD N42/0,A18/OBUFF21 K1 CON 0 K2 CON 0 K6 CON 0 K7 CON 0 ERR1 DPC * ADDRESS .* DPC *GT. 7999 O* DPC *R .LT. 0* CON 0 ERR2 DPC * OP SHOULD* DPC * HAVE WM* CON 0 ERR3 DPC *SHORT EDIT* DPC * FIELD* CON 0 ERR4 DPC * ILLEGAL A* DPC *DDRESS* CON 0 ERR5 DPC * ILLEGAL O* DPC *P CODE* CON 0 ERRI DPC * ILLEGAL I* DPC *NSTRUCTION* DPC * LENGTH* CON 0 ERRT DPC * TAPE DOUB* DPC *LY DEFINED* CON 0 ERRE DPC * TRIED TO * DPC *READ PAST * DPC *LAST CARD* CON 0 ERRD DPC * BAD D-CHA* DPC *RACTER* CON 0 ERRC DPC * ILLEGAL T* DPC *APE NUMBER* CON 0 ERRA DPC * ADD ERROR* DPC * NUMERIC .* DPC *GT. 10* CON 0 ERRL DPC *TAPE RECORD TOO LONG* CON 0 MASK2 CON 40030000000000000000B MASK1 CON 00030000000000000000B WMARK CON 40000000000000000000B BLANK DPC 10 CIOCODE VFD D18/CIO,N42/0 RCLCODE VFD D18/RCL,N42/0 CARDIN BSS 9 TRASH CON 0 PRTOUT BSS 14 CARD BSS 80 PRINT BSS 133 LASTCD CON 0 LINECT CON 0 CARRCON CON 0 HOLD200 CON 0 OVFLOW CON 0 BGTA CON 0 BLTA CON 0 BEQA CON 0 BNEA CON 0 IOCK CON 0 TRAP CON 0 TPLOAD CON 0 BADREAD CON 0 EOF CON 0 TEROR CON 0 STOP CON 0 SWA CON 0 SWB CON 0 SWC CON 0 SWD CON 0 SWE CON 0 SWF CON 0 SWG CON 0 TAPE1 CON 0 TAPE2 CON 0 TAPE3 CON 0 TAPE4 CON 0 TAPE5 CON 0 TAPE6 CON 0 ILENGTH CON 0 OPCODE CON 0 ASTAR CON 0 BSTAR CON 0 SAVEA CON 0 CTRL CON 0 CORE BSSZ CORESIZ+1 SWITCH1 CON 0 SWITCH2 CON 0 TEMP1 CON 0 ZONE CON 0 DMOD CON 0 ADDR1 CON 0 ADDR2 CON 0 ADDR3 CON 0 TAPARG CON 0 CON 0 MCALL CON 0 TSTCT CON 0 TPCALL VFD D18/RLT,N24/0,A18/TAPARG TBLGTH EQU 1000 INBUF BSS TBLGTH RLTCELL CON 1 MAXCOR EQU CORE+CORESIZ ICON DPC *I-REGISTER* ACON DPC *A-REGISTER* BCON DPC *B-REGISTER* INPTABL CON 00000000000000000000B CON 00030000000000000001B CON 00030000000000000002B CON 00030000000000000003B CON 00030000000000000004B CON 00030000000000000005B CON 00030000000000000006B CON 00030000000000000007B CON 00030000000000000010B CON 00030000000000000011B CON 00020000000000000001B CON 00020000000000000002B CON 00020000000000000003B CON 00020000000000000004B CON 00020000000000000005B CON 00020000000000000006B CON 00020000000000000007B CON 00020000000000000010B CON 00020000000000000011B CON 00010000000000000002B CON 00010000000000000003B CON 00010000000000000004B CON 00010000000000000005B CON 00010000000000000006B CON 00010000000000000007B CON 00010000000000000010B CON 00010000000000000011B CON 00000000000000000012B CON 00000000000000000001B CON 00000000000000000002B CON 00000000000000000003B CON 00000000000000000004B CON 00000000000000000005B CON 00000000000000000006B CON 00000000000000000007B CON 00000000000000000010B CON 00000000000000000011B CON 00030000000000000000B CON 00020000000000000000B CON 00020000000000000014B CON 00010000000000000001B CON 00010000000000000014B CON 00030000000000000014B CON 00020000000000000013B CON 00000000000000000013B CON 00000000000000000000B CON 00010000000000000013B CON 00030000000000000013B CON 00010000000000000016B CON 00000000000000000017B CON 00010000000000000012B CON 00000000000000000012B CON 00000000000000000014B CON 00010000000000000015B CON 00020000000000000012B CON 00010000000000000017B CON 00020000000000000015B CON 00020000000000000016B CON 00030000000000000012B CON 00020000000000000017B CON 00000000000000000015B CON 00030000000000000015B CON 00030000000000000016B CON 00030000000000000017B OUTTABL CON 55000000000000000000B CON 34000000000000000000B CON 35000000000000000000B CON 36000000000000000000B CON 37000000000000000000B CON 40000000000000000000B CON 41000000000000000000B CON 42000000000000000000B CON 43000000000000000000B CON 44000000000000000000B CON 33000000000000000000B CON 54000000000000000000B CON 66000000000000000000B CON 63000000000000000000B CON 73000000000000000000B CON 65000000000000000000B CON 76000000000000000000B CON 50000000000000000000B CON 23000000000000000000B CON 24000000000000000000B CON 25000000000000000000B CON 26000000000000000000B CON 27000000000000000000B CON 30000000000000000000B CON 31000000000000000000B CON 32000000000000000000B CON 64000000000000000000B CON 56000000000000000000B CON 51000000000000000000B CON 7000000000000000000000B CON 74000000000000000000B CON 75000000000000000000B CON 46000000000000000000B CON 12000000000000000000B CON 13000000000000000000B CON 14000000000000000000B CON 15000000000000000000B CON 16000000000000000000B CON 17000000000000000000B CON 20000000000000000000B CON 21000000000000000000B CON 22000000000000000000B CON 46000000000000000000B CON 53000000000000000000B CON 47000000000000000000B CON 62000000000000000000B CON 77000000000000000000B CON 67000000000000000000B CON 45000000000000000000B CON 01000000000000000000B CON 02000000000000000000B CON 03000000000000000000B CON 04000000000000000000B CON 05000000000000000000B CON 06000000000000000000B CON 07000000000000000000B CON 10000000000000000000B CON 11000000000000000000B CON 45000000000000000000B CON 57000000000000000000B CON 52000000000000000000B CON 61000000000000000000B CON 72000000000000000000B CON 60000000000000000000B TPCODE CON 00010000000000000000B CON 00000000000000000001B CON 00000000000000000002B CON 00000000000000000003B CON 00000000000000000004B CON 00000000000000000005B CON 00000000000000000006B CON 00000000000000000007B CON 00000000000000000010B CON 00000000000000000011B CON 00000000000000000012B CON 00000000000000000013B CON 00000000000000000014B CON 00000000000000000015B CON 00000000000000000016B CON 00000000000000000017B CON 00000000000000000000B CON 00010000000000000001B CON 00010000000000000002B CON 00010000000000000003B CON 00010000000000000004B CON 00010000000000000005B CON 00010000000000000006B CON 00010000000000000007B CON 00010000000000000010B CON 00010000000000000011B CON 00010000000000000012B CON 00010000000000000013B CON 00010000000000000014B CON 00010000000000000015B CON 00010000000000000016B CON 00010000000000000017B CON 00020000000000000000B CON 00020000000000000001B CON 00020000000000000002B CON 00020000000000000003B CON 00020000000000000004B CON 00020000000000000005B CON 00020000000000000006B CON 00020000000000000007B CON 00020000000000000010B CON 00020000000000000011B CON 00020000000000000012B CON 00020000000000000013B CON 00020000000000000014B CON 00020000000000000015B CON 00020000000000000016B CON 00020000000000000017B CON 00030000000000000000B CON 00030000000000000001B CON 00030000000000000002B CON 00030000000000000003B CON 00030000000000000004B CON 00030000000000000005B CON 00030000000000000006B CON 00030000000000000007B CON 00030000000000000010B CON 00030000000000000011B CON 00030000000000000012B CON 00030000000000000013B CON 00030000000000000014B CON 00030000000000000015B CON 00030000000000000016B CON 00030000000000000017B OPTABLE VFD N42/0,A18/ERROR5 .(00) VFD N42/0,A18/RCD .R VFD N42/0,A18/PRT .W VFD N42/0,A18/WRD .WR VFD N42/0,A18/PCH .P VFD N42/0,A18/RDP .RP VFD N42/0,A18/WPC .WP VFD N42/0,A18/WRP .WRP VFD N42/0,A18/ICYCLE .SRF VFD N42/0,A18/ICYCLE .SPF VFD N42/0,A18/ERROR5 .(12) VFD N42/0,A18/MA .MA VFD N42/0,A18/M .M VFD N42/0,A18/ERROR5 .(15) VFD N42/0,A18/ERROR5 .(16) VFD N42/0,A18/ERROR5 .(17) VFD N42/0,A18/ERROR5 .(20) VFD N42/0,A18/CS ./ VFD N42/0,A18/S .S VFD N42/0,A18/ERROR5 .T(23) VFD N42/0,A18/UIO .U(UNIT CNTRL) VFD N42/0,A18/BWZ .BWZ VFD N42/0,A18/BBE .BBE VFD N42/0,A18/ERROR5 .(27)X VFD N42/0,A18/MZ .MZ VFD N42/0,A18/MCS .MCS VFD N42/0,A18/ERROR5 .(32) VFD N42/0,A18/SW .SW VFD N42/0,A18/D .D VFD N42/0,A18/ERROR5 .(35) VFD N42/0,A18/ERROR5 .(36) VFD N42/0,A18/ERROR5 .(37) VFD N42/0,A18/ERROR5 .(40) VFD N42/0,A18/ERROR5 .(41)J VFD N42/0,A18/SS .SS VFD N42/0,A18/LCA .LCA VFD N42/0,A18/MLC .MLC VFD N42/0,A18/SAVEREG .NOP VFD N42/0,A18/ERROR5 .(46)O VFD N42/0,A18/MCM .MCM VFD N42/0,A18/SAR .SAR VFD N42/0,A18/ERROR5 .(51)R VFD N42/0,A18/ZS .ZS VFD N42/0,A18/ERROR5 .(53)$ VFD N42/0,A18/ERROR5 .(54)* VFD N42/0,A18/ERROR5 .(55) VFD N42/0,A18/ERROR5 .(56) VFD N42/0,A18/ERROR5 .(57) VFD N42/0,A18/ERROR5 .(60)+ VFD N42/0,A18/A .ADD VFD N42/0,A18/B .B VFD N42/0,A18/C .C VFD N42/0,A18/MN .MN VFD N42/0,A18/MCE .MCE VFD N42/0,A18/CC .CC VFD N42/0,A18/ERROR5 .(67)G VFD N42/0,A18/SBR .SBR VFD N42/0,A18/ERROR5 .(71)I VFD N42/0,A18/ZA .ZA VFD N42/0,A18/H .H VFD N42/0,A18/CW .CW VFD N42/0,A18/ERROR5 .(75) VFD N42/0,A18/ERROR5 .(76) VFD N42/0,A18/ERROR5 .(77) ENDCON CON 0 END EQU **1+1 END S1401 (71)I