10.07.2015 Views

1130 Commercial Subroutine Package - All about the IBM 1130 ...

1130 Commercial Subroutine Package - All about the IBM 1130 ...

1130 Commercial Subroutine Package - All about the IBM 1130 ...

SHOW MORE
SHOW LESS

You also want an ePaper? Increase the reach of your titles

YUMPU automatically turns print PDFs into web optimized ePapers that Google loves.

aApplication ProgramH20-0241-3<strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong>(<strong>1130</strong>-SE-25X), Version 3Program Reference ManualThe <strong>IBM</strong> <strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong> is for <strong>IBM</strong><strong>1130</strong> users with a knowledge of FORTRAN. The package isnot intended to make FORTRAN a complete commerciallanguage, but to supply commercial capability to users of<strong>IBM</strong> <strong>1130</strong> FORTRAN.This manual is a combined user's, operator's, and systemmanual.Kristofer Sweger


Fourth EditionThis edition, H20-0241-3, is a major revision obsoleting H20-0241-2.A form is provided at <strong>the</strong> back of this publication for reader's comments.If <strong>the</strong> form has been removed, comments may be addressed to <strong>IBM</strong> Corporation,Technical Publications Department, 112 East Post Road, White Plains, N.Y. 10601CI International Business Machines Corporation 1966, 1967, 1968


CONTENTSIntroduction 1Use of <strong>the</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong> 3Machine Requirements 4Special Considerations--Arithmetic 5Special Considerations--Input/Output 6FORTRAN Format I/O 6CSP Overlapped I/O 6Data Formats Used 7Al Format 7A2 Format 8A3 Format 8Dl Format 8D4 Format 9Format Requirements 11Detailed Descriptions 12ADD 13AlA3 15A1DEC 18A3A1 21CARRY 24DECA1 26DIV 28DPACK 31DUNPK 34


EDIT o • I 4 36FILL 41GET 42I COMP 45IOND 47KE YBD 48MOVE 50MPY 52NCOMP 54NSIGN 56NZ ONE 58PACK 60PRINT 62PUNCH 64PUT 66P1403 68P1442 70READ 73R2501 76SKIP 79STACKSUBS1403TYPER81828486UNPAC 89WHOLE 91


Sample Problems 93Problem 1 93Problem 2 104Problem 3 116Flowcharts 124Listings 152Appendix 190Core <strong>All</strong>ocation 190EBCDIC Characters and Decimal Equivalents 192Timing Data 193Programmer's Reference Card 195Operating Instructions 197Halt Listing 198Bibliography 199


INTRODUCTIONThe <strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong> has been written to facilitate <strong>the</strong> use ofFORTRAN in basic commercial programming. Included in <strong>the</strong> package are <strong>the</strong> followingitems:• The GET routine, which allows <strong>the</strong> programmer to decode input records after <strong>the</strong>yhave been read. This eliminates <strong>the</strong> common FORTRAN-associated problem thatoccurs when input cards enter <strong>the</strong> system in an unknown sequence. Input recordsthat vary in this way may be read with <strong>the</strong> Al format and converted to real numbers(using GET) after <strong>the</strong> program has determined which type record was just read.• An editing routine, EDIT, for <strong>the</strong> preparation of output in special formats. WithEDIT it is possible to insert commas, supply leading blanks, float dollar signs,display a CR symbol after negative numbers, etc. EDIT is especially useful in <strong>the</strong>preparation of invoices, checks, and o<strong>the</strong>r commercial documents.• Code conversion routines for data manipulation and more efficient data packing:GET - Al format to RealPUT - Real to Al formatPACK - Al to A2 formatUNPAC - A2 to Al formatA1A3 - Al to A3 formatA3A1 - A3 to Al formatDPACK - Dl to D4 formatDUNPK - D4 to D1 formatA1DEC - Al to decimal formatDECA1 - Decimal to Al format• A variable-length decimal arithmetic package. In this system, all arithmetic is donewith integer or decimal numbers, with field lengths chosen by <strong>the</strong> user. This subsetof <strong>the</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong> includes routines for variable-length decimaladd (ADD), subtract (SUB), multiply (MPY), divide (DIV), compare (ICOMP), andsign test (NSIGN).Use of this system eliminates two of <strong>the</strong> arithmetic problems associated withFORTRAN: <strong>the</strong> accuracy problem (<strong>the</strong> inexact representation of fractions) and <strong>the</strong>magnitude problem (extended precision values limited to nine digits, etc.).• <strong>Subroutine</strong>s for improved speed and control of I/O devices. By taking advantage of<strong>the</strong> <strong>1130</strong>'s cycle-stealing capability, <strong>the</strong> overlapped I/O routines can substantiallyspeed <strong>the</strong> throughput rates of many jobs. <strong>Subroutine</strong>s are supplied for <strong>the</strong><strong>IBM</strong> 1442 Card Read Punch<strong>IBM</strong> 1442-5 Card Punch<strong>IBM</strong> 2501 Card Reader<strong>IBM</strong> 1132 Printer<strong>IBM</strong> 1403 PrinterConsole KeyboardConsole Typewriter-1-1.1.1.1111111111$11111E HHIcilil 1111111111n 11111 1111111111111111111111111 1111111111111111111111111


In addition to input/output, subroutines are supplied for control of <strong>the</strong> 1132 and 1403carriage and <strong>the</strong> 1442 stacker select mechanism.• Several utility routines for common tasks:NCOMP for comparing two variable-length alphameric (Al) fieldsMOVE for moving data from one area to ano<strong>the</strong>rFILL to fill an area with a specified valueWHOLE to truncate <strong>the</strong> fractional portion of a real numberNZONE for testing and modifying zone punches


USE OF THE COMMERCIAL SUBROUTINE PACKAGECSP is modular in design -- <strong>the</strong> user may use whichever routines he needs and ignore <strong>the</strong>o<strong>the</strong>rs.The routines may be assembled on any 4K card <strong>1130</strong> system, but an 8K system will probablybe required for any extensive usage. The desired subroutines may be inserted in <strong>the</strong>FORTRAN execute deck (card systems) or stored in <strong>the</strong> <strong>Subroutine</strong> Library on <strong>the</strong> diskcartridge. In addition, some of <strong>the</strong> CSP routines use certain parts of <strong>the</strong> <strong>IBM</strong> <strong>1130</strong> <strong>Subroutine</strong>Library. (See "Core <strong>All</strong>ocation" in <strong>the</strong> Appendix.)<strong>All</strong> of <strong>the</strong> routines are written in <strong>the</strong> <strong>1130</strong> Assembler Language.The control statement*ONE WORD INTEGERSmust be used in programs that call any of <strong>the</strong> <strong>Commercial</strong> subroutines.The control statement*EXTENDED PRECISIONmust be used in any program that calls <strong>the</strong> GET or PUT subprograms. The o<strong>the</strong>r CSProutines are independent of <strong>the</strong> real number precision.In general, CSP will operate under ei<strong>the</strong>r Version 1 or Version 2 of <strong>the</strong> <strong>1130</strong> Disk MonitorSystem. The exceptions are P1403, 51403, P1442, and R2501, which use subroutinessupplied only with Version 2 (see <strong>the</strong> detailed descriptions for more particulars).The use of <strong>the</strong> overlapped I/O portion of CSP is an "ei<strong>the</strong>r/or" proposition. For nondiskI/O, <strong>the</strong> programmer must choose ei<strong>the</strong>r <strong>the</strong> CSP overlapped routines or <strong>the</strong> standardFORTRAN routines. The two systems cannot be intermixed within <strong>the</strong> same program.Note <strong>the</strong> emphasis on nondisk. This exclusion does not apply to disk I/O, which maybe used regardless which of <strong>the</strong> two systems is selected.Use of <strong>the</strong> overlapped I/O routines also excludes <strong>the</strong> employment of <strong>the</strong> TRACE featureof FORTRAN, since it used portions of <strong>the</strong> FORTRAN package for output.A


SPECIAL CONSIDERATIONS — ARITHMETICReal arithmetic. When using CSP, remember that <strong>the</strong> standard FORTRAN limitationsapply to all real numbers.Extended precision numbers should not exceed ± 1,000,000,000. (or 9 digits).Fractions must be avoided if exact results are desired. <strong>All</strong> critical arithmetic should bedone with whole numbers. For example, <strong>the</strong> extension40.75 hours x $2.225 per hourshould be carried out as4075. hundredths of hours x 2225. mills per hourIf this is not done, precision errors may appear in <strong>the</strong> results.Decimal arithmetic. If <strong>the</strong> nine-digit or fractional limitations of FORTRAN prove burdensome,<strong>the</strong> Decimal Arithmetic package may be used. In this system, all arithmetic isdone with whole numbers (no fractions), and <strong>the</strong> number of digits in each variable ischosen by <strong>the</strong> user.A number in decimal format may be as long as desired; <strong>the</strong>re is no practical limit tofield length.


SPECIAL CONSIDERATIONS — INPUT/OUTPUTFORTRAN FORMAT I/OIn general, CSP works with arrays in Al format -- one alphameric character per word.For those routines that operate on o<strong>the</strong>r formats, conversion routines are supplied toease <strong>the</strong> translation between Al and <strong>the</strong> o<strong>the</strong>r format.In this area, however, one complication may occur: <strong>the</strong> use of zone punches. In manycommercial applications, it is customary to X-punch <strong>the</strong> units position of a credit or negativefield. Because <strong>the</strong> 11-0 Hollerith combination is not recognized by <strong>the</strong> conversionroutines used with FORTRAN READs, it is necessary, when keypunching, to omit <strong>the</strong> 0-punch when an 11-punch is present in <strong>the</strong> same column. This is not a problem with <strong>1130</strong>-produced cards that later serve as input to subsequent runs. No control X-punches, inany positions, will be recognized when <strong>the</strong> underpunched digit is a zero. "Not recognized"means that <strong>the</strong> character position is replaced with a blank. This is <strong>the</strong> case for both inputand output when standard FORTRAN READs and WRITE s are used.A 12-punch is not recognized by <strong>the</strong> conversion routines with FORTRAN when <strong>the</strong> underpuncheddigit is a zero. Therefore, a plus zero (12-0 Hollerith) will be expressed asonly a 0-punch. For this reason, plus fields should be left =zoned ra<strong>the</strong>r than 12-punchedin <strong>the</strong> units position.When <strong>the</strong> input routines supplied with this package are used, this problem does not exist.<strong>All</strong> zone punches are recognized and are treated properly.CSP OVERLAPPED I/OThe CSP overlapped I/O routines have been provided to take advantage of <strong>the</strong> cyclestealingcapability of <strong>the</strong> <strong>1130</strong>. Because many allow processing to be resumed before <strong>the</strong>I/O is finished, <strong>the</strong>ir use will increase <strong>the</strong> throughput rates of many programs.The table below summarizes <strong>the</strong> overlap capabilities of <strong>the</strong> routines:This deviceCard reader (1442 or 2501)Card punchConsole keyboardConsole printerPrinter (1132 or 1403)is overlapped with this functionConversion from card code to Al formatnothing (not overlapped)nothing (not overlapped)anything but <strong>the</strong> console keyboardanythingThe CSP I/O routines also permit <strong>the</strong> reading and punching of <strong>the</strong> 11-0 and 12-0 punches,both of which must be avoided with standard FORTRAN I/O.


The use of <strong>the</strong> overlapped I/O portion of CSP is an "ei<strong>the</strong>r/or" proposition. For nondiskI/O, <strong>the</strong> programmer must choose ei<strong>the</strong>r <strong>the</strong> CSP overlapped routines or <strong>the</strong> standardFORTRAN routines. The two systems cannot be intermixed within <strong>the</strong> same program.Note <strong>the</strong> emphasis on nondisk. This exclusion does not apply to disk I/O, which may beused regardless which of <strong>the</strong> two systems is selected.Use of <strong>the</strong> overlapped I/O routines also excludes <strong>the</strong> employment of <strong>the</strong> TRACE featureof FORTRAN, since it uses portions of <strong>the</strong> FORTRAN package for output.The following routines are included in <strong>the</strong> CSP I/O group:READ PRINT TYPERPUNCH SKIP KEYBDR2501 P1403 STACKP1442 S1403If any of <strong>the</strong>se routines are used, standard FORTRAN READ and WRITE commands maynot appear in <strong>the</strong> same program.When using Version 1 of <strong>the</strong> <strong>1130</strong> Disk Monitor System, <strong>the</strong> programmer must place <strong>the</strong>statementCALL IONDbefore any STOP or PAUSE statement. This will ensure that all pending I/O interruptshave been serviced before <strong>the</strong> CPU stops or pauses. IOND should not be called if Version2 of <strong>the</strong> Monitor is in use.P1403, S1403, P1442, and R2501 use parts of <strong>the</strong> subroutine library supplied with Version2 of <strong>the</strong> <strong>1130</strong> Disk Monitor System. If <strong>the</strong>y are to be used with a Version 1 Monitor, <strong>the</strong>Version 2 subroutines must be loaded onto <strong>the</strong> Version 1 disk. See <strong>the</strong> detailed descriptionsof P1403, 51403, P1442, and R2501 for more particulars.DATA FORMATS USEDAlthough most of <strong>the</strong> CSP routines are oriented toward use of <strong>the</strong> Al format, several newformats have been introduced. In addition, several of <strong>the</strong> standard formats must be consideredin a different light.Al FORMATAl format consists of one character per 16-bit word, left-justified:characterblankbits 0 78 15


The right-hand eight bits should always contain <strong>the</strong> blank character, which is 01000000 inbinary. This blank will always be inserted by <strong>the</strong> CSP routines and <strong>the</strong> standard FORTRANAl format.The sign of an Al field is assumed to be carried as an 11- or 12-punch over <strong>the</strong> rightmostcharacter. An 11-punch is taken to signify a negative field; a 12-punch (or no-zone punch)signifies a positive field.A2 FORMATA2 format consists of two characters per word:charactercharacterbits 0 78 15A3 FORMATAlthough A3 format exists in standard FORTRAN terminology, its use in this manual hasa different connotation. Here, A3 format means that one word contains three characters.This can be done only by using a unique coding scheme. The user supplies a table of 40characters. Then, <strong>the</strong> A1A3 and A3A1 subroutines may be used to translate from Al toA3 format and vice versa.The A3 format cannot be pictured graphically, since <strong>the</strong> three characters are combinedas a single integer or binary number.The A3 format permits highly efficient packing of alphabetic data and may be used to saveconsiderable space on <strong>the</strong> disk.Note, however, that only 40 characters may be used. This may not be enough for someapplications. For example, if <strong>the</strong> characters chosen were A through Z, 0 through 9, <strong>the</strong>blank, comma, period, and dash, 40 would probably be ample for a name and addressfile. It would not be sufficient for a product description file that also required slashes,dollar signs, etc.Dl FORMATD1 format consists of one digit per word, right-justified. Because <strong>the</strong> decimal arithmeticroutines operate on data in this format, Dl format is also called decimal format.D1 format is as follows:00000000 0000 digitbits 0 7 8 15


A decimal field is stored in an array in Dl format. The sign of <strong>the</strong> field will be carriedwith <strong>the</strong> rightmost digit. For example, <strong>the</strong> six-digit field 001968 could be placed in <strong>the</strong>12th through 17th position in <strong>the</strong> NUMBR array:NUMBR (12) = 0NUMBR (13) = 0NUMBR (14) = 1NUMBR (15) = 9NUMBR (16) = 6NUMBR (17) = 8The same field, if it were negative, would be written as 001968, and <strong>the</strong> sign would bereflected in <strong>the</strong> rightmost digit:NUMBR (12) = 0NUMBR (13) = 0NUMBR (14) = 1NUMBR (15) = 9NUMBR (16) = 6NUMBR (17)= -9Note that NUMBR (17) is -9 ra<strong>the</strong>r than -8; this must be done because <strong>the</strong> <strong>1130</strong> cannotrepresent a negative zero. The following scheme is used with negative numbers:If <strong>the</strong> sign of <strong>the</strong> field isnegative and <strong>the</strong> rightmost The rightmost D1 digitdigit is a will be carried as a0 -11 -22 -33 -44 -55 -66 -77 -88 -99 -10Usually, this need not concern <strong>the</strong> programmer, since <strong>the</strong> A1DEC and DECA1 routineswill automatically implement <strong>the</strong> special coding of negative fields. Setting up negativeconstants, though, must be handled properly by <strong>the</strong> programmer.


D4 FORMATD4 format consists in general of four decimal digits per word, with each digit occupyingfour bits of <strong>the</strong> word. However, since <strong>the</strong> sign digit (<strong>the</strong> rightmost one) carries <strong>the</strong> sign,it is handled separately, and is placed by itself in <strong>the</strong> last word of <strong>the</strong> D4 field. This isbest illustrated by showing several examples:first wordsecond wordThe five-digit1 2 3 4 +5number+12345 0001 0010 0011 0100 0000 0000 0000 0101first wordsecond wordthird wordThe six-digit1 2 3 4 5 F F F +6number+123456 0001 0010 0011 0100 0101 1111 1111 1111 0000 0000 0000 0110first word second word third wordThe seven-digit 1 2 3 4 5 6 F F +7number+1234567 0001 0010 0011 0100 0101 0110 1111 1111 0000 0000 0000 0111The filler consists of four 1 bits, <strong>the</strong> hexadecimal F. A more detailed description of D4format may be found with <strong>the</strong> description of <strong>the</strong> DPACK routine.


FORMAT REQUIREMENTSThe requirements for each subroutine are as follows:<strong>Subroutine</strong>Format ofData beforeProcessingFormat ofData afterProcessing<strong>Subroutine</strong>Format ofData beforeProcessingFormat ofData afterProcessingADD D1 format Dl formatA1A3 Al format A3 formatA1DEC Al format Dl formatA3A1 A3 format Al formatCARRY D1 format Dl formatDECAL Dl format Al formatDIV Dl format Dl formatDPACK Dl format D4 formatDUNPK D4 format Dl formatEDIT Al format Al formatFILL Any integer Same as(Al, A2, Dl, FILLetc.)characterGET Al format Real variable(extendedprecision)ICOMP Dl format Greater than,equal to, orless than zeroNSIGN DI format IntegervariableNZONE Al.format IntegervariablePACK Al format A2 formatPRINT Al format Al formatPUNCH Al format Al formatPUT Real variable Al format(extendedprecision)P1403 Al format Al formatP1442 Al format Al formatREAD Al format Al formatR2501 Al format Al formatSKIPDecimalconstantNoneSTACK None NoneSUB DI format DI formatIOND None NoneKEYBD Al format Al formatS1403DecimalconstantNoneMOVE Any integer Same as(Al, A2, Dl, beforeetc.)MOVEMPY Dl format D1 formatNCOMP Al format Greater than,equal to, orless than zeroTYPER Al format Al formatUNPAC A2 format Al formatWHOLE Real variable Real variable(any(anyprecision) precision)


ADD DETAILED DESCRIPTIONSA1A3A1DEC This section gives <strong>the</strong> general format and a description of each routine. Each descriptionA3A1 contains format, function, parameter description, detailed description, example, errors,CARRY and remarks. The function describes <strong>the</strong> capabilities of <strong>the</strong> routine. The parameterDECA1 description explains in detail how <strong>the</strong> parameters, variables, and constants should be setDIV up. The detailed description tells exactly what <strong>the</strong> subroutine does and how it should beDPACK used. Examples are given as an aid to <strong>the</strong> programmer. Certain specification and inputDUNPK errors may occur when using <strong>the</strong> package, and <strong>the</strong>se are explained. The remarks sectionEDIT describes some peculiarities of <strong>the</strong> routine. Fur<strong>the</strong>r information may be obtained fromFILL <strong>the</strong> flowcharts and listings.GETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE


ADDFormat: CALL ADD(JCARD, J, JLAST, KCARD, K, KLAST, NER)Function: Sums two arbitrary-length decimal data fields, placing <strong>the</strong> result in <strong>the</strong>second data field.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array which is added, <strong>the</strong> addend. The data mustbe stored in JCARD in decimal format, one digit per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first digit to be added (<strong>the</strong> left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last digit to beadded (<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> augend, <strong>the</strong> array which is added to. It will contain<strong>the</strong> result in decimal format, one digit per word.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first digit of KCARD (<strong>the</strong> left-hand end of a field).KLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to K. This is <strong>the</strong> position of <strong>the</strong> last character ofKCARD (<strong>the</strong> right-hand end of a field).NER - An integer variable. Upon completion of <strong>the</strong> subroutine, this variableindicates whe<strong>the</strong>r arithmetic overflow occurred.Detailed description: The corresponding digits, by place value, of JCARD and KCARD,are summed and placed back in KCARD. This operation is from left to right, with bothfields being right-adjusted. Next, all carries are set in order. If overflow occurred,it is indicated by NER being equal to KLAST. NER must be initialized and reset by <strong>the</strong>user. More detailed information may be found in <strong>the</strong> ADD flowchart and listing.–4- ADDA1A3A1DECA3A1CARRYDE CA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-13-1,1 iiii III om .....MirmumnotHollum...mn. momommommonmonnommonmownomnorr,-


Example: DIMENSION IGRND(12),ITEM(6)N=0CALL ADD(ITEM, 1,6, IGRND, 1,12, N)Before:IGRND 000713665203 ITEM 102342Position 1 10 Position 1 5After:N=0IGRND 000713767545I 1 1ITEM is unchanged.Position 1 5 10N=0The numeric data field ITEM, in decimal format, is ADDed to<strong>the</strong> numeric data field IGRND, also in decimal format. Notethat <strong>the</strong> fields are both right-justified. The error indicator,N, is <strong>the</strong> same, since <strong>the</strong>re is no overflow out of <strong>the</strong> high-orderdigit (left-hand end) of <strong>the</strong> IGRND field.Errors: If <strong>the</strong> KCARD field is not large enough to contain <strong>the</strong> sum, that is, if <strong>the</strong>re is acarry out of <strong>the</strong> high-order digit, <strong>the</strong> error indicator, NER, will be set equal to KLAST,and <strong>the</strong> KCARD field will be filled with 9s.If <strong>the</strong> JCARD field is longer than <strong>the</strong> KCARD field, nothing will be done and <strong>the</strong> error indicatorwill be equal to KLAST.Remarks: Conversion from EBCDIC to decimal is necessary before using this subroutine.This may be accomplished with <strong>the</strong> A1DEC subroutine.The length of <strong>the</strong> JCARD and KCARD fields is arbitrary, up to <strong>the</strong> maximum spaceavailable.Note that <strong>the</strong> error indicator is not reset by this subroutine. It is <strong>the</strong> responsibility of <strong>the</strong>user to initialize, test, and reset <strong>the</strong> error indicator.


A1A3Format: CALL A1A3(JCARD, J, JLAST, KCARD, K, ICHAR)Function: To convert from Al format (one character per word) to A3 format (threecharacters per word).Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> field to be converted. Originally,this field must be in Al format, one character per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be converted (<strong>the</strong> lefthandend of a field).JLAST An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> last character of JCARD to be converted (<strong>the</strong> righthandend of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array into which <strong>the</strong> data is converted, in A3format, three characters per word.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first element of KCARD to receive <strong>the</strong> convertedcharacters (<strong>the</strong> left-hand end of a field).ICHAR - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains a table used in <strong>the</strong> conversion.Detailed description: Three characters in Al format are taken, one at a time, from <strong>the</strong>JCARD array. The relative position of each character is found in <strong>the</strong> table ICHAR.Then <strong>the</strong>se three relative positions are used to form an A3 integer as follows:ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEA3 INTEGER=(N1-20)* 1600+(N2*40)+N3where N1 is <strong>the</strong> relative position of <strong>the</strong> first character in <strong>the</strong> ICHAR array, etc. TheA3 integer is <strong>the</strong>n placed in <strong>the</strong> KCARD array, and <strong>the</strong> next group of three Al charactersis packed, and so on. Note that <strong>the</strong> relative position runs from 0 to 39, not 1 to 40.-15-111111111111.11111111111111111111111111111111111111111 111111111111111111111111111111111111111111111111111111111111111111111111111 1 111111 11111111111111111111.11111.111.1111111111.1.1.111111111111111111111111111.11111110.7


Example: Set up ICHAR as follows:DIMENSION ICHAR(40)READ(2, 1) ICHAR1 FORMAT (40A1)orDIMENSION ICHAR(40)CALL READ(ICHAR, 1, 40, N)The card to be read is:ftt lf 5 2 f 0 2 t 5 3 t 0 3 1' 5 40Content ETAOINbSHRDLUCMFWYP0123456789VBGKQJXZ , . &Card column 1 5 10Relative position 0 4 9 14 19 24 29 34 39It is <strong>the</strong> user's responsibility to create <strong>the</strong> ICHAR array. It must always contain40 characters.A1A3 may be used as follows:DIMENSION JCARD(21), KCARD(10),ICHAR(40)CALL A1A3(JCARD, 1, 21, KCARD, 1, ICHAR)Before:JCARD CUSTOMER NAME IS HEREft f t fPosition 1 5 10 15 20KCARD 0123456789fftPosition 1 5 10ICHAR is as above.After:JCARD is <strong>the</strong> same.ICHAR is <strong>the</strong> same.KCARD -10713 -30266 -31634 -23906 -31756 -20552 -31640 7 8 9... fPosition 1 2 3 4 5 6 7 8 9 10„.......... .....--,RepresentsCUS TOM,-.A.....ER6 NAM ............. ,...^—, ,-........,E6I S6H EREThe large negative numbers at each of <strong>the</strong> first seven positions reflect A3 integers(three Al characters).


Errors: If a character does not appear in ICHAR, and does appear in JCARD, it will becoded as a blank.Remarks: It is <strong>the</strong> user's responsibility to create <strong>the</strong> ICHAR array. It must alwayscontain 40 characters. The arrangement shown in <strong>the</strong> example is, in general, <strong>the</strong> best,since <strong>the</strong> characters appear in <strong>the</strong> order of <strong>the</strong>ir most frequent occurrence, and thisarrangement includes those characters (A-Z, 0-9, blank, comma, period, and ampersand)commonly found in alphabetic files (names and addresses, etc.). The user may, however,place any 40 characters in <strong>the</strong> ICHAR array, in any order.If <strong>the</strong> field to be compressed consists primarily of numbers, for example, <strong>the</strong>y should beplaced first in <strong>the</strong> ICHAR array.Note that <strong>the</strong> A3 format discussed here is a special one and is not <strong>the</strong> same as <strong>the</strong>FORTRAN A3 format.


ADD A1DECA1A3A1DEC -4— Format: CALL A1DEC(JCARD,J,JLAST,NER)A3A1CARRY Function: Converts a field from Al format, one digit per word, to decimal format,DECA1 right-justified, one digit per word.DIVDPACK Parameter description:DUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEJCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> name of <strong>the</strong> field that will be converted. Originally,this field must be in Al format, one character per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be converted (<strong>the</strong> lefthandend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be converted (<strong>the</strong> right-hand end of a field).NER - An integer variable. This variable will be equal to <strong>the</strong> position of <strong>the</strong>last invalid (nonnumeric or nonblank) character encountered, except for<strong>the</strong> JLAST position, which may contain a sign.Detailed description: The subroutine operates from left to right. Each character ischecked for validity (digit or blank). Blanks are changed to zeros. If a character isinvalid, <strong>the</strong> error indicator, NER, is set equal to <strong>the</strong> position of <strong>the</strong> character. If <strong>the</strong>character is valid, it is converted to decimal format and right-justified using <strong>the</strong> formulaDecimal digit = (character+4032)/256When all characters have been converted, <strong>the</strong> decimal field is signed. More detailedinformation may be found in <strong>the</strong> A1DEC flowchart and listing.


Example: DIMENSION IFLD(20)N=0CALL A1DEC(IFLD,7,17,N)Before:IFLD7,17AbBbCbDbEbFbbbbbbbbb0b7b1b3b6b6bAEbNbDbPosition5 10 15 20N=0After: 7,17IFLD AbBbCbDbEbFb00000713661EbNbDbPosition 1 5 10 15 20N=0Before execution, <strong>the</strong> field is shown in Al format, <strong>the</strong> character followed by a blank.Therefore, <strong>the</strong> field to be converted isbbbb071366JAfter execution, <strong>the</strong> field has been converted, as is evident. There were no invalidcharacters in <strong>the</strong> field, since N is <strong>the</strong> same.Errors: If an invalid character (nonnumeric or nonblank) is encountered, <strong>the</strong> errorindicator is set equal to <strong>the</strong> position of that character, and processing of <strong>the</strong> fieldcontinues.Remarks: When <strong>the</strong> error indicator has been set, <strong>the</strong> character indicated is <strong>the</strong> lastinvalid character. There may be' o<strong>the</strong>r invalid characters in <strong>the</strong> field, occurring to<strong>the</strong> left of <strong>the</strong> character noted.


Zone punches are used, at times, to indicate conditions (switches). These zones can beremoved with <strong>the</strong> NZONE subroutine. Following is an error routine to correct errorsof this type:Main Line1 CALL A1DEC(IFLD,J,JLAST,N)IF(N) 2,2,32 Continue Main Line3 Error RoutineCALL NZONE(IFLD,N,4,N1)N1= 0CALL A1DEC(IFLD,N,N,N1)IF(N1) 5,5,44 STOP 9995 CALL DECA1(IFLD,J,JLAST,N)N=0GO TO 1When an error of this type occurs, N will be greater than zero. Control would go tostatement 3. Using <strong>the</strong> NZONE routine, <strong>the</strong> zone is removed (if not a special character).The invalid character is now converted with <strong>the</strong> A1DEC routine. If <strong>the</strong> character is stillinvalid, control goes to statement 4 and <strong>the</strong> program will STOP. If <strong>the</strong> character is nowvalid, it has been converted and control goes to statement 5. However, <strong>the</strong>re may havebeen o<strong>the</strong>r invalid characters. Therefore, at statement 5 <strong>the</strong> field is converted back toAl format and control returns to statement 1, where <strong>the</strong> field is again converted fromAl format to decimal format. This process continues until a truly invalid character(special character) is encountered, or until <strong>the</strong> field is converted with no errors.Note that <strong>the</strong> error indicator is not reset by this subroutine. It is <strong>the</strong> responsibilityof <strong>the</strong> user to initialize and reset <strong>the</strong> error indicator.


A3A1Format: CALL A3A1(JCARD, J, JLAST, KCARD, K, ICHAR)Function: To convert from A3 format (three characters per word) as created by <strong>the</strong>A1A3 subroutine to Al format (one character per word).Parameter description:JCARD – The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> field to be converted. Originally,this field must be in A3 format, three characters per word.J - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first element of JCARD to be converted (<strong>the</strong>left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> last element of JCARD to be converted (<strong>the</strong>right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array into which <strong>the</strong> data is converted, in Alformat, one character per word.KAn integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first element of KCARD to receive <strong>the</strong> convertedcharacters (<strong>the</strong> left-hand end of a field).ICHAR - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains a table used in <strong>the</strong> conversion.Detailed description: A3 integers are taken, one at a time, from <strong>the</strong> JCARD array. Eachis decoded into <strong>the</strong> three numbers of which it is composed, as follows:ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEN1={ (A3 INTEGER/1600) + 20 if <strong>the</strong> A3 integer is positive((A3 INTEGER + 32000)/1600) if <strong>the</strong> A3 integer is negative }N2=(A3 INTEGER-(N1-20)*1600)/40N3=A3 INTEGER-(N1-20)*1600-(N2*40)The resulting integers, N1, N2, N3, are <strong>the</strong>n used to locate <strong>the</strong>ir corresponding Alcharacters in <strong>the</strong> ICHAR array. Each Al character is <strong>the</strong>n placed in <strong>the</strong> KCARD array.Note that each element of JCARD requires three elements in KCARD.


Example: Set up ICHAR as follows:DIMENSION ICHAR(40)READ(2, 1) ICHAR1 FORMAT (40A1)orDIMENSION ICHAR(40)CALL READ(ICHAR, 1, 40, N)The card to be read is:Content ETAOINbSHRDLUCMFWYP0123456789VBGKQJXZ,.&Card t t t It t t fcolumn1 5 10 15 20 25 30 35 40Relativeposition0 4 9 14 19 24 29 34 39It is <strong>the</strong> user's responsibility to create <strong>the</strong> ICHAR array. It must always contain 40characters.A3A1 may be used as follows:DIMENSION JCARD(21), KCARD(30), ICHAR(40)CALL A3A1(JCARD, 1, 8, KCARD, 1, ICHAR)Before: JCARD -30076 -20556 -20547 -26800 -15765 -23397 -17038 -30237f 4Position 1 5KCARD 012345678901234567890123456789ft t ff t fPosition 1 5 10 15 20 25 30ICHAR is as above.After:JCARD is <strong>the</strong> same.ICHAR is <strong>the</strong> same.KCARD THIS IS CODED INFORMATIO456789t f fPosition 1 5 10 15 20 25 30


Errors: If JLAST is less than J, one element will be decoded into three characters.Remarks: It is <strong>the</strong> user's responsibility to create <strong>the</strong> ICHAR array. It must always contain40 characters. The arrangement shown in <strong>the</strong> example is, in general, <strong>the</strong> best,since it is in <strong>the</strong> order of <strong>the</strong> most frequent occurrence of <strong>the</strong> letters of <strong>the</strong> alphabet.Note that <strong>the</strong> A3 format discussed here is a special one, and is not <strong>the</strong> same as <strong>the</strong>FORTRAN A3 format.


ADD CARRYA1A3AIDE C Format: CALL CARRY(JCARD,J,JLAST ,KARRY)A3A1CARRY--Function: Resolve all carries within <strong>the</strong> specified field and indicate any high-orderDECA1 carry out of <strong>the</strong> field. This routine will not normally be called by <strong>the</strong> user.DIVDPACK Parameter description:DUNPKEDIT JCARD - The name of a one-dimensional integer array defined in a DIMENSIONFILL statement. This is <strong>the</strong> field that will be interrogated for carries. TheGET data must be in decimal format.ICOMPIOND J - An integer constant, an integer expression, or an integer variable.KEYBD This is <strong>the</strong> position of <strong>the</strong> first digit of JCARD (<strong>the</strong> left-hand end of aMOVE field).MPYNCOMPJLAST - An integer constant, an integer expression, or an integer variable,NSIGNgreater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last characterNZONEof JCARD (<strong>the</strong> right-hand end of a field).PACKPRINTKARRY - An integer variable. This variable will contain any carry out of <strong>the</strong>PUNCHhigh-order position of <strong>the</strong> JCARD field. If <strong>the</strong>re is no carry, KARRYPUTP1403will be set to zero.P1442Detailed description: The routine operates from right to left, examining <strong>the</strong> low-orderREADR2501digit first. The digit being examined is divided by ten. Since only integers are used,SKIP<strong>the</strong> quotient of this division is <strong>the</strong> carry in that digit. Ten times <strong>the</strong> carry is subtractedSTACK from <strong>the</strong> digit. If <strong>the</strong> digit is now negative, ten is added to <strong>the</strong> digit and one is sub-SUB ttacted from <strong>the</strong> carry. At this point, or if <strong>the</strong> resultant digit was positive, <strong>the</strong> nextS1403 digit to <strong>the</strong> left is examined. First, <strong>the</strong> carry from <strong>the</strong> previous digit is added to thisTYPER digit. Then <strong>the</strong> process for <strong>the</strong> first digit, starting with division by ten, is carried out.UNPAC When all digits have been examined, from JCARD(JLAST) to JCARD(J) inclusive, <strong>the</strong>WHOLE final carry is set and <strong>the</strong> routine terminates. More detailed information may be foundin <strong>the</strong> CARRY flowchart and listing.


Example: DIMENSION NUMB(10)Before:CALL CARRY(NUMB,1,10,N)NUMB 0 72 612f, 5 1 8 1 1IPosition 1 2 3 4 5 6 7 8 9 10N=22After:NUMB 0723350211I IPosition 1 5 10N=0After an arithmetic operation <strong>the</strong> condition of <strong>the</strong> NUMB field is as shown at "Before".The third, fifth and eighth positions appear as shown, because multiple arithmeticoperations have generated <strong>the</strong>m. The object of <strong>the</strong> CARRY routine is to resolve thistype of problem.Notice that a 1 has been borrowed from <strong>the</strong> seventh position to resolve <strong>the</strong> -8 condition.Similarly, a 3 has been borrowed from <strong>the</strong> fourth position, and <strong>the</strong> 7 from 72 has goneinto <strong>the</strong> second position.Errors: NoneRemarks: This routine is used by <strong>the</strong> o<strong>the</strong>r routines in this package as a service routine.In general, <strong>the</strong> user need not call this routine, since all carries are resolved by <strong>the</strong>arithmetic routines <strong>the</strong>mselves (ADD, SUB, MPY, DIV).


ADDA1A3A1DECA3A1CARRYDECA1-4---DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLEDECALFormat: CALL DECA1(JCARD,J,JLAST,NER)Function: Converts a field from decimal format, right-justified, one digit per word, toAl format, one character per word.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> name of <strong>the</strong> field that will be converted. Originally,this field must be in decimal format, one digit per word.J - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first digit of JCARD to be converted (<strong>the</strong>left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last characterof JCARD to be converted (<strong>the</strong> right-hand end of a field).NER - An integer variable. This variable will be equal to <strong>the</strong> position of <strong>the</strong>last digit of JCARD which was negative or greater than 9, except for <strong>the</strong>JLAST position, which can be negative (sign).Detailed description: The subroutine operates from left to right. First <strong>the</strong> sign is determined.Then each digit, starting with JCARD(J), is converted to Al format using <strong>the</strong>formulaCharacter = 256 * (decimal digit) - 4032When all digits have been converted, <strong>the</strong> field is signed. More detailed informationmay be found in <strong>the</strong> DECAL flowchart and listing.


Example: DIMENSION IFLD(20)N=0CALL DECA1(IFLD,7,17,N)Before: 7,17IFLD AbBbCbDbEbFb00000713661EbNbDb1 1Position 1 5 10 15 20N=0After: 7,17IFLD AbBbCbDbEbFb0b0b0b0b0b7b1b3b6b6bJbEbNbDb1Position 1 5 10 15 20N=0Before execution <strong>the</strong> field is shown in decimal format. The field to be converted is00000713661After execution, <strong>the</strong> field has been converted to Al format, as is evident, <strong>the</strong> characterfollowed by a blank. There were no invalid digits in <strong>the</strong> field, since N is <strong>the</strong> same.Errors: If an invalid digit (not 0 to 9, inclusive) is encountered, <strong>the</strong> error indicator isset equal to <strong>the</strong> position of that character, and processing of <strong>the</strong> field continues.Remarks: When <strong>the</strong> error indicator indicates an error, <strong>the</strong> digit indicated is <strong>the</strong> lastinvalid digit. There may be o<strong>the</strong>r invalid digits in <strong>the</strong> field, occurring to <strong>the</strong> left of <strong>the</strong>digit noted.These errors should not occur, since <strong>the</strong> arithmetic routines (ADD, SUB, MPY, andDIV) will resolve carries. However, if this does happen, <strong>the</strong> user's program shouldindicate (possibly by STOPing) that this has occurred.Note that <strong>the</strong> error indicator is not reset by this subroutine. It is <strong>the</strong> responsibility of<strong>the</strong> user to initialize and reset <strong>the</strong> error indicator.


ADD DIVA1A3A 1DE C Format: CALL DIV(JCARD,J,JLAST ,KCARD,K,K LAST ,NER)A3A1Function: Divides one arbitrary-length decimal data field by ano<strong>the</strong>r, placing <strong>the</strong>CARRYquotient and remainder in <strong>the</strong> dividend.DECA1DIV *–Parameter description:DPACKJCARD - The name of a one-dimensional integer array defined in a DIMENSIONDITNPKstatement. This array is <strong>the</strong> divisor. The data must be stored inEDITJCARD in decimal format, one digit per word.FILLGET J - An integer constant, an integer expression, or an integer variable.ICOMP This is <strong>the</strong> position of <strong>the</strong> first digit of <strong>the</strong> divisor (<strong>the</strong> left-hand end ofIOND a field).-KEYBDMOVEJLAST - An integer constant, an integer expression, or an integer variable,MPYgreater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last digit of <strong>the</strong>NCOMP divisor (<strong>the</strong> right-hand end of a field).NSIGN KCARD - The name of a one-dimensional integer array defined in a DIMENSIONNZONE statement. This array, <strong>the</strong> dividend, will contain <strong>the</strong> quotient and <strong>the</strong>PACK remainder, extended to <strong>the</strong> left, in decimal format, one digit per word.PRINTPUNCH K - An integer constant, an integer expression, or an integer variable.PUT This is <strong>the</strong> position of <strong>the</strong> first digit of <strong>the</strong> dividend (<strong>the</strong> left-hand endP1403 of a field).P1442KLAST - An integer constant, an integer expression, or an integer variable,READgreater than or equal to K. This is <strong>the</strong> position of <strong>the</strong> last digit ofR2501<strong>the</strong> dividend (<strong>the</strong> right-hand end of a field). This is also <strong>the</strong> positionSKIPof <strong>the</strong> last digit of <strong>the</strong> remainder.STACKSUB NER - An integer variable. Upon completion of <strong>the</strong> subroutine, this variableS1403 indicates whe<strong>the</strong>r division by zero was attempted, or whe<strong>the</strong>r <strong>the</strong>TYPER KCARD field is not long enough.UNPACWHOLE Detailed description: First <strong>the</strong> signs are cleared from both fields and saved. Then <strong>the</strong>KCARD field is extended to <strong>the</strong> left <strong>the</strong> length of <strong>the</strong> JCARD field (JLAST-J+1), andfilled with zeros. If <strong>the</strong> KCARD field will be extended below KCARD(1), NER will be setequal to KLAST and <strong>the</strong> routine will be terminated. Next, <strong>the</strong> JCARD field is scanned tofind <strong>the</strong> high-order significant digit. If no digit is found, <strong>the</strong> error indicator NER is setto KLAST, and <strong>the</strong> result is <strong>the</strong> same as <strong>the</strong> input. When a digit is found, <strong>the</strong> divisionbegins. It is done by <strong>the</strong> method of trial divisors:1. The high-order digit of <strong>the</strong> divisor is used as <strong>the</strong> trial divisor.2. The trial divisor is divided into <strong>the</strong> next high-order digit of <strong>the</strong> dividend to generatea digit of <strong>the</strong> quotient.3. The digit of <strong>the</strong> quotient is multiplied by <strong>the</strong> trial divisor.4. This product is subtracted from <strong>the</strong> corresponding number of digits in <strong>the</strong> highorderportion of <strong>the</strong> dividend.


5. As long as <strong>the</strong> result is positive, <strong>the</strong> quotient digit is <strong>the</strong> next digit in <strong>the</strong> quotient.A return is made to step 2.6. When <strong>the</strong> result is negative, <strong>the</strong> product from step 3 is added back to <strong>the</strong> dividend,1 is subtracted from <strong>the</strong> quotient digit, and <strong>the</strong> new quotient digit is placed in <strong>the</strong>quotient as <strong>the</strong> next digit. Finally, <strong>the</strong> signs are generated for <strong>the</strong> quotient andremainder and <strong>the</strong> sign is replaced on <strong>the</strong> divisor.The quotient will be located in <strong>the</strong> KCARD field. The subscript of <strong>the</strong> first digit of <strong>the</strong>quotient will be K-(JLAST-J+1), and <strong>the</strong> subscript of <strong>the</strong> last digit of <strong>the</strong> quotient will beKLAST-(JLAST-J+1).The remainder will also be located in <strong>the</strong> KCARD field. The subscript of <strong>the</strong> first digitof <strong>the</strong> remainder will be KLAST-JLAST+J, and <strong>the</strong> subscript of <strong>the</strong> last digit of <strong>the</strong> remainderwill be KLAST.KCARD QUOTIENT REMAINDERt ftA K BA is <strong>the</strong> position whose subscript is K-(JLAST-J+1).K is <strong>the</strong> first position of <strong>the</strong> dividend, defined earlier.B is <strong>the</strong> position whose subscript is KLAST-(JLAST-J+1).C is <strong>the</strong> position whose subscript is KLAST-(JLAST-J).Dis <strong>the</strong> position whose subscript is KLAST.More detailed information may be found in <strong>the</strong> DIV flowchart and listing.Example:Before:DIMENSION IDVSR(5),IDVND(15)N=0CALL DIV(IDVSR,1,5,IDVND,6,15,N)IDVSR 00982 IDVND ABCDE0007136673IIIPosition 1 5 Position 1 5 10 15fCAfter:N=0IDVSR is unchanged. IDVND 000000726700479lPosition 1 5 10 15


The numeric data field IDVND has been divided by <strong>the</strong> numeric data field IDVSR, <strong>the</strong>quotient and remainder being placed in IDVND. Note that <strong>the</strong> IDVND field has beenextended to <strong>the</strong> left <strong>the</strong> length of <strong>the</strong> IDVSR field, five positions.Errors: If division by zero is attempted, <strong>the</strong> only action is that KCARD is extended andfilled with zeros. The error indicator indicates that division by zero was attempted(NER=KLAST).If <strong>the</strong>re is not enough room to extend <strong>the</strong> KCARD field to <strong>the</strong> left, NER will again be setequal to KLAST, and <strong>the</strong> routine will terminate. None of <strong>the</strong> fields involved will bemodified.Remarks: Conversion from EBCDIC to decimal is necessary before using this subroutine.This may be accomplished with <strong>the</strong> AlDEC subroutine.The length of <strong>the</strong> JCARD and KCARD fields is arbitrary, up to <strong>the</strong> maximum spaceavailable.The arithmetic performed is decimal arithmetic, using whole numbers only. No decimalpoint alignment is allowed. For this reason numbers should have an assumed decimalpoint at <strong>the</strong> right-hand end.Space must always be provided in <strong>the</strong> KCARD field for expansion. The first position of<strong>the</strong> dividend, K, must be at least JLAST-J+1 positions from <strong>the</strong> beginning of KCARD„For example, if JCARD is seven positions, 1 through 7, <strong>the</strong> dividend in KCARD muststart at least seven positions (7-1+1=7) from <strong>the</strong> beginning of KCARD. This would haveK equal to 8.


DPACKFormat: CALL DPACK(JCARD, J, JLAST, KCARD, K)Function: Information in Dl format, one digit per word, is packed into D4 format, fourdigits per word.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> data to be packed, in Dl format, onedigit per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be packed (<strong>the</strong> left-handend of a field).JLAST - An integer constant, an integer expression, or an integer variable greaterthan J. This is <strong>the</strong> position of <strong>the</strong> last character of JCARD to be packed(<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array into which <strong>the</strong> data is packed, in D4 format,four digits per word.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first element of KCARD to receive <strong>the</strong> packed characters(<strong>the</strong> left-hand end of a field).Detailed description: Initially, <strong>the</strong> field to be packed (<strong>the</strong> JCARD array) is in D1 format.This consists of one digit per word, right-justified (occupying <strong>the</strong> rightmost four bits of<strong>the</strong> word). The sign of <strong>the</strong> field is carried with <strong>the</strong> rightmost or low-order digit.The operation of <strong>the</strong> DPACK subroutine is as follows: Starting at JCARD(J), and workingfrom left to right, each four-bit digit of <strong>the</strong> JCARD array is placed into four bits of <strong>the</strong>KCARD array, four to <strong>the</strong> word, starting at KCARD(K). When JCARD(JLAST) is encountered,it is assumed to be <strong>the</strong> last Dl digit, and to carry <strong>the</strong> sign of <strong>the</strong> field. TheDPACK routine <strong>the</strong>n places JCARD(JLAST), unpacked, in its entirety, intoKCARD(JJLAST-J+7)/4), <strong>the</strong> last position in <strong>the</strong> KCARD array.Any unused space in <strong>the</strong> preceding KCARD word is <strong>the</strong>n filled with 1 bits. This bitarrangement or format will be called D4 format.For example, suppose a seven-position JCARD array is to be packed, and it contains 1,2, 3, 4, 5, 6, 7:JCARD(1) = 1JCARD(2) = 2JCARD(3) = 3JCARD(4) = 4ADDA lA 3A1DECA3A1CARRYDECA1DIV--0-DPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-31-1,11.11.11.111111M MWFIRRIPPP AIRCIWII Rimn "III


JCARD(5) = 5JCARD(6) = 6JCARD(7) = 7JCARD(1) through JCARD(4) will be placed in KCARD(1) as 0001 0010 0011 0100.JCARD(5) and JCARD(6) will be placed in KCARD(2) as 0101 0110 0000 0000.JCARD(7) will be placed, without conversion, in KCARD(3) as 0000 0000 0000 0111.Then <strong>the</strong> two unused four-bit areas in KCARD(2) will be filled with l's as 0101 01101111 1111.More detailed information may be found in <strong>the</strong> DPACK/DUNPK flowchart and listing.The table below may be used to determine <strong>the</strong> number of words required for a field afterit is packed. For example, a twelve-digit decimal field will be packed into a four-wordfield:• First word: 1st, 2nd, 3rd, and 4th digits• Second word: 5th, 6th, 7th and 8th digits• Third word: 9th, 10th, and 11th digits, plus four 1 bits (filler)• Fourth word: 12th digit carrying <strong>the</strong> sign of <strong>the</strong> field.Field Length Field Length Field LengthBeforePackingAfterPackingBeforePackingAfterPackingBeforePackingAfterPacking2 2 18 6 34 103 2 19 6 35 104 2 20 6 36 105 2 21 6 37 106 3 22 7 38 117 3 23 7 39 118 3 24 7 40 119 3 25 7 41 1110 4 26 8 42 1211 4 27 8 43 1212 4 28 8 44 1213 4 29 8 45 1214 5 30 9 46 1315 5 31 9 47 1316 5 32 9 48 1317 5 33 9 49 13


Example: DIMENSION IUNPK(26), IPAKD(26)CALL DPACK(IUNPK, 1, 10, IPAKD, 1)Before:IUNPK 123456789123I IPosition 1 5 10IPAKD ABCDEFGHIJI IPosition 1 5 10After:IUNPK is <strong>the</strong> same.IPAKD 1234 5678 9FFF 0001 EFGHIJt t t 111 t1 2 3 4 56 10PositionErrors: NoneRemarks: If JLAST is less than or equal to J, only one character of JCARD will bepacked, and it will be treated as <strong>the</strong> sign. A multiple of four characters in JCARD willalways be packed into KCARD. An equation for how much space is required, in elements,in KCARD is:Space in KCARD - JLAST-J+74This result is rounded down at all times.


ADD DUNPKA1A3A1DEC Format:A3A1CARRY Function:DE CA 1DIVDPACK Parameter description:DUNPK-4-EDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLECALL DUNPK(JCARD, J, JLAST, KCARD, K)Information in D4 format, four digits per word, is unpacked into Dl format,one digit per word.JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> data to be unpacked, in D4 format,four digits per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first element of JCARD to be unpacked (<strong>the</strong> left-handend of a field).JLAST - An integer constant, an integer expression, or an integer variable greaterthan J. This is <strong>the</strong> position of <strong>the</strong> last element of JCARD to be unpacked,(<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array into which <strong>the</strong> data is unpacked, in Dl format,one digit per word.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first element of KCARD to receive <strong>the</strong> unpackedcharacters (<strong>the</strong> left-hand end of a field).Detailed description: See <strong>the</strong> detailed description of DPACK for an explanation of <strong>the</strong> Dland D4 formats.The JCARD field, in packed (D4) format, will be unpacked (converted to D1 format) andplaced in <strong>the</strong> KCARD field. Starting at JCARD(J), moving from left to right, each fourbitdigit is placed in <strong>the</strong> rightmost four bits of a word in <strong>the</strong> KCARD array, starting atKCARD(K).Filler bits (four l's) are recognized as such and are ignored.JCARD(JLAST), <strong>the</strong> last word to be converted, is not altered, but is moved toKCARD(KLAST). KLAST cannot be calculated exactly at this point, but KLAST-K+1will be <strong>the</strong> same as JLAST-J+1 when <strong>the</strong> field was originally packed. In o<strong>the</strong>r words,field lengths will not be changed by a DPACK and subsequent DUNPK.The maximum value of KLAST can be calculated as4*(JLAST-J)+1However, it may be one, two, or three fewer positions in length.


More detailed information may be found in <strong>the</strong> DPACK/DUNPK flowchart and listing.Example: DIMENSION IUNPK(26),IPAKD(26)CALL DUNPK(IPAKD, 1, 3, IUNPK, 1)Before:IPAKD 1234 5678 0003 IUNPK FbIbLbLbbblbNbbbTbHbIbSb....„., ,...,„—• ,—...—1 1 I IPosition Position 1 5 10After:IPAKD is <strong>the</strong> same.IUNPK 123456783HbIbSbI I IPosition 1 5 10Errors: NoneRemarks: If JLAST is less than or equal to J, only <strong>the</strong> first element of JCARD, JCARD(J)will be unpacked and it will be treated as <strong>the</strong> sign.


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDIT"4"'"FILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEEDITFormat: CALL EDIT(JCARD, J, JLAST, KCARD, K, KLAST)Function: Edits data from one array into ano<strong>the</strong>r array, which contains <strong>the</strong> edit mask.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> data to be edited, called <strong>the</strong> sourcefield, one character per word, in Al format.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be edited (<strong>the</strong> left-handend of a field).JLAST - An integer constant, an integer expression, or an integer variable, greaterthan or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character of JCARD tobe edited (<strong>the</strong> right-hand end of a field).KCARD The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array into which data is edited; it contains <strong>the</strong> editmask before editing begins, stored one character per word, in Al format,and is called <strong>the</strong> mask field.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of <strong>the</strong> edit mask (<strong>the</strong> left-hand end ofa field).KLAST - An integer constant, an integer expression, or an integer variable, greaterthan K. This is <strong>the</strong> position of <strong>the</strong> last character of <strong>the</strong> edit mask (<strong>the</strong>right-hand end of a field).Detailed description: The following table gives <strong>the</strong> control characters for editing, <strong>the</strong>characters used to make up <strong>the</strong> mask, and <strong>the</strong>ir respective functions:Control CharacterFunctionb (blank) This character is replaced by a character from <strong>the</strong>source field.0 (zero) This character indicates zero suppression and is replacedby a character from <strong>the</strong> source field. The position of thischaracter indicates <strong>the</strong> rightmost limit of zero suppression(see description of operation below). Blanks areinserted in <strong>the</strong> high-order nonsignificant positions of<strong>the</strong> field.


Control Character Function. (decimal point), (comma)CR (credit)This character remains in <strong>the</strong> mask field where placed. However,if zero suppression is requested, it will be removed ifit is to <strong>the</strong> left of <strong>the</strong> last character to be zero-suppressed.This character remains in <strong>the</strong> mask field where placed.However, if zero suppression is requested, it will beremoved if it is to <strong>the</strong> left of <strong>the</strong> last character to bezero-suppressed.These two characters can be placed in <strong>the</strong> two rightmostpositions of <strong>the</strong> mask field. They are undisturbed if <strong>the</strong>source field is negative. (If <strong>the</strong> source field is positive,<strong>the</strong> characters C and R are blanked out. ) In editingoperations, a negative source field is indicated by an11-zone over <strong>the</strong> rightmost character. Whe<strong>the</strong>r CR isblanked out or not, no data will be edited into <strong>the</strong>sepositions when CR is present, but ra<strong>the</strong>r into <strong>the</strong> editcharacters to <strong>the</strong> left.The letters C and R may be used in <strong>the</strong> remainder of<strong>the</strong> edit mask, where <strong>the</strong>y will be treated as normalalphabetic characters, without being subject to signcontrol.Only <strong>the</strong> R character is checked, so <strong>the</strong> C character maybe any legal character, and it will be treated asdescribed.- (minus) This character is handled similarly to CR in <strong>the</strong>rightmost position of <strong>the</strong> mask field.* (asterisk)$ (floating dollarsign)This character operates <strong>the</strong> same as <strong>the</strong> 0 (zero) forzero suppression, except that asterisks ra<strong>the</strong>r thanblanks are inserted in <strong>the</strong> high-order nonsignificantpositions of <strong>the</strong> field, providing asterisk checkprotection.This character has <strong>the</strong> same effect as <strong>the</strong> 0 (zero) forzero suppression, except that a $ is inserted to <strong>the</strong> leftof <strong>the</strong> first significant character found, or to <strong>the</strong> leftof <strong>the</strong> position that stopped <strong>the</strong> zero suppression.The operation of <strong>the</strong> edit routine may be described in five steps:1. Characters are placed in <strong>the</strong> mask field from <strong>the</strong> source field, moving from rightto left. The characters 0 (zero), b (blank), * (asterisk) and $ (dollar sign) are replacedwith characters from <strong>the</strong> source field. No o<strong>the</strong>r characters in <strong>the</strong> maskfield are disturbed.


2. If all characters in <strong>the</strong> source field have not been placed in <strong>the</strong> mask field before <strong>the</strong>end of <strong>the</strong> mask field is encountered, <strong>the</strong> whole mask is set to asterisks and editingis terminated.3. CR (credit) and - (minus) in <strong>the</strong> rightmost positions of <strong>the</strong> mask field are blanked if<strong>the</strong> source field is positive (does not have an 11-zone over <strong>the</strong> rightmost character).4. The zero suppression scan starts at <strong>the</strong> left end of <strong>the</strong> mask field and proceeds leftto right, replacing zeros (0), blanks (b's), decimal points (.), and commas (,). Thelast position replaced will occur where <strong>the</strong> zero suppression character was located,or one position to <strong>the</strong> left of where a significant character, not zero (0), blank (b),decimal point (. ), or comma (,), occurs. If <strong>the</strong> zero suppression character was anasterisk (*), <strong>the</strong> replacement character is an asterisk. O<strong>the</strong>rwise, <strong>the</strong> replacementcharacter is a b (blank).5. If <strong>the</strong> zero suppression character was a dollar sign ($), a dollar sign is placed in <strong>the</strong>last replaced position in <strong>the</strong> zero suppression scan.In order for <strong>the</strong> edit routine to work correctly and as described, five rules must befollowed in creating <strong>the</strong> mask field:1. There must be at least as many b's (blanks) in <strong>the</strong> mask field as characters in <strong>the</strong>source field.2. If <strong>the</strong> mask field contains zero (0), asterisk (*), or dollar sign ($), zero suppressionwill be used and <strong>the</strong> first character in <strong>the</strong> mask field must be a b (blank).3. The mask field must not contain more than one of <strong>the</strong> following, which may appearonly once:0 (zero)* (asterisk)$ (dollar sign)4. If <strong>the</strong> rightmost character in <strong>the</strong> mask field is an R, <strong>the</strong> next character to <strong>the</strong> leftshouldbe a C, in order to edit with CR (credit). Both characters will be blanked if<strong>the</strong> source field is positive. If <strong>the</strong> rightmost character in <strong>the</strong> mask field is - (minus),it will be blanked if <strong>the</strong> source field is positive.5. <strong>All</strong> numeric, alphabetic, and special characters may be used in <strong>the</strong> mask field. <strong>All</strong>characters that do not have special meaning will be left in <strong>the</strong>ir original position in<strong>the</strong> mask field during <strong>the</strong> edit.More detailed information may be found in <strong>the</strong> EDIT flowchart and listing.


Example: There are three common methods for creating a mask field such as b,b14.bbCR:Method 1 Method 2DIMENSION MASK(10)1 FORMAT(10A1)IN=2READ(IN, 1)MASKDIMENSION MASK(10)MASK(1)=16448MASK(2)=27456MASK(3)=16448MASK(4)=16448MASK(5)=23360MASK(6)=19264MASK(7)=16448MASK(8)=16448MASK(9)=-15552MASK(10)=-9920DIMENSION MASK(10)Method 3DATA MASKPb', ', I , 93', tb ? ,'$ 1 , t . I,Method 1 creates <strong>the</strong> mask by reading it from a card. Method 2 creates <strong>the</strong> mask withFORTRAN arithmetic statements, setting each position of <strong>the</strong> mask to <strong>the</strong> desired character.It uses <strong>the</strong> decimal equivalents of <strong>the</strong> various EBCDIC codes, as listed in <strong>the</strong>APPENDIX. Method 3, using <strong>the</strong> DATA statement, is by far <strong>the</strong> shortest and simplest.Note that each character requires a word of core storage, regardless of <strong>the</strong> methodemployed.


The table of examples below illustrates how <strong>the</strong> EDIT routine works:Source Field Mask FieldResult00123D bb, bb$. bbCR bbb$12.34bb00123M bb, bb$. bbCR bbb$12.34CR00123M bb, bbS. bb- bbb$12.34-00123D bb, bbS. bb- bbb$12.34b46426723 b, bbb, bb$. bbCR b$464,267.23bb00200P b, bb*. bbCR ***20.07CR082267139 bbb-bb-bbbb 082-26-713901234567 bbbbS. bb CR **********0AB1234 bbbbb$. bbCR b$AB12.34bb-12345 bb, bb$. bb- $-,123,45bBecause <strong>the</strong> mask field is destroyed after each use, it is advisable to move <strong>the</strong> maskfield to <strong>the</strong> output area and perform <strong>the</strong> edit function in <strong>the</strong> output area.Errors: If <strong>the</strong> number of characters in <strong>the</strong> source field is greater than <strong>the</strong> number ofblanks in <strong>the</strong> mask field, <strong>the</strong> mask field is filled with asterisks(*).


FILLFormat: CALL FILL(JCARD,J,JLAST,NCH)Function: Fills an area with a specified character.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> area to be filled.J - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first character of JCARD to be filled (<strong>the</strong>left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be filled (<strong>the</strong> right-hand end of a field).NCH - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> code for <strong>the</strong> fill character. The Appendix contains a list of thosecodes corresponding to <strong>the</strong> EBCDIC character set; however, NCH maybe any integer.Detailed description: The area of JCARD, starting with J and ending with JLAST, isfilled with <strong>the</strong> character equivalent to <strong>the</strong> NCH code, one character per word. Moredetailed information may be found in <strong>the</strong> FILL flowchart and listing.Example: CALL FILL (IPRNT,3,10,16448)Fill <strong>the</strong> area IPRNT from positions 3 through 10 with blanks. In o<strong>the</strong>r words, clear <strong>the</strong>area.IPRNT:Before: ABCDEFGHIJKLMNOPQRSb..After: ABb bbbb bbbKLMNOPQRSb...ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDIT—)P- FILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEPosition 1 5 10 15 20Errors: None.-41-1.1....,■.1....10.1114.10iivuorcci,HEHHHH11111111 1 11 111111111111111111111111111111111111111111111111111111111111111111111111111111111,"-


ADDAlA3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGET '4-ICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEGETFormat: GET (JCARD, J, JLAST, SHIFT)Function: Extracts a data field from an array, and converts it to a real number. Thisis a function subprogram.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> data to be retrieved, stored onedigit per word, in Al format.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be retrieved (<strong>the</strong> lefthandend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be retrieved (<strong>the</strong> right-hand end of a field).SHIFT - A real constant, a real expression, or a real variable. If decimal placesare required, SHIFT is equal to 10 -d, d being <strong>the</strong> number of decimalplaces. When SHIFT is used as a scale factor, SHIFT is 10 d, d being <strong>the</strong>number of zeros. If a card contains 12345 and <strong>the</strong> value of SHIFT is0.0001, <strong>the</strong> result will be 1.2345. The result will be 123450. if a value10.0 is assigned to SHIFT.Detailed description: Using <strong>the</strong> formulaBINARY DIGIT = (EBCDIC CODE + 4032) / 256<strong>the</strong> real digits are retrieved. Each binary digit is shifted left and summed, resulting ina whole number decimal. The sum is multiplied by SHIFT to locate <strong>the</strong> decimal point.The result is <strong>the</strong>n placed in <strong>the</strong> real variable GET. If <strong>the</strong>re are blanks in <strong>the</strong> data field,<strong>the</strong>y are treated as zeros. If a nonnumeric character, o<strong>the</strong>r than blank, appears in anyposition o<strong>the</strong>r than <strong>the</strong> low-order position, <strong>the</strong> variable containing <strong>the</strong> result is zero.If a special character, o<strong>the</strong>r than <strong>the</strong> - (minus), appears in <strong>the</strong> low-order position, <strong>the</strong>resulting variable is set to zero.For input and for output <strong>the</strong> sign must be placed over <strong>the</strong> low-order position as an11-punch for minus and a 12 or no overpunch for plus. If <strong>the</strong> low-order position is zeroand <strong>the</strong> number is negative, <strong>the</strong> column must contain only an 11-punch. (The zero mustnot be punched when FORTRAN I/O is used.) If <strong>the</strong> low-order position is zero and <strong>the</strong>number is positive, <strong>the</strong> column must contain only <strong>the</strong> zero punch. (The 12 row must notbe punched when FORTRAN I/O is used.)More detailed information may be found in <strong>the</strong> GET flowchart and listing.


Example 1: DIMENSION INCRD(80)B=GET(INCRD,1,5,0.001)Before: INCRD 0123456b...B = 0.0IPosition 1 5After: INCRD is <strong>the</strong> same.Example 2:Before:B = 1.234 (Approximately, since a fraction is present)A = GET (INCRD, 1,6,1.0) + GET (INCRD, 7,12,1.0)+ GET (INCRD, 13,18,1.0) + GET (INCRD, 19,24,1.0)+ GET (INCRD, 25,30,1.0) + GET (INCRD, 31,36,1.0)+ GET (INCRD, 37,42,1.0) + GET (INCRD, 43,48,1.0)INCRD 001221000070145035700357161111724368 120001270124Position 1 61218243036 4248A=0.0After: INCRD is <strong>the</strong> sameA = 2122287. (Exactly, since no fractions were generated)The above example sums <strong>the</strong> six-digit fields found in <strong>the</strong> first 48 columns of a card.Each data field has two decimal places. Any arithmetic operation can be performedwith GET 0 as an operand.


Errors: If a nonnumeric character, o<strong>the</strong>r than blank, appears in a position o<strong>the</strong>r than<strong>the</strong> low-order position, <strong>the</strong> result is set to zero.If a special character o<strong>the</strong>r than - (minus) appears in <strong>the</strong> low-order position, <strong>the</strong> resultis set to zero.Remarks: The GET routine is a function subprogram. As such, it is used in an arithmeticexpression as shown in <strong>the</strong> example.When using standard FORTRAN I/O, and <strong>the</strong> digit in <strong>the</strong> units position is a zero, a minussign is shown as an 11-punch only; a plus is shown as a zero-punch only.In most cases <strong>the</strong> value of SHIFT should be 1. 0, placing <strong>the</strong> decimal point at <strong>the</strong> righthandend of <strong>the</strong> number. (For dollars and cents calculations, <strong>the</strong> result of <strong>the</strong> GET wouldbe in cents.) This will eliminate precision errors from <strong>the</strong> calculations. The decimalpoint may be replaced (moved to <strong>the</strong> left) with <strong>the</strong> EDIT routine for output.If GET (or PUT) is used, <strong>the</strong> calling program must use extended precision.


ICOMPFormat: ICOMP (JCARD,J,JLAST,KCARD,K,KLAST)Function: Two variable-length decimal format data fields are compared. The resultis set to a negative number, zero, or a positive number. This is a function subprogram.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> first data field to be compared, onedigit per word, in decimal format.J - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first character of JCARD to be compared(<strong>the</strong> left-hand end of a field).JLAST - An integer constant; an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last characterof JCARD to be compared (<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> second data field to be compared,one digit per word, in decimal format. If <strong>the</strong> fields are unequal inlength, <strong>the</strong> KCARD field must be <strong>the</strong> longer field.K - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first character of KCARD to be compared(<strong>the</strong> left-hand end of a field).KLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to K. This is <strong>the</strong> position of <strong>the</strong> last characterof KCARD to be compared (<strong>the</strong> right-hand end of a field).Detailed description: Since <strong>the</strong> fields are assumed to be right-justified, <strong>the</strong> firstoperation is to examine <strong>the</strong> length of each field. If KCARD is longer than JCARD, <strong>the</strong>leading digits of KCARD are examined. If any one of <strong>the</strong>m is greater than zero <strong>the</strong>result (ICOMP) is <strong>the</strong> opposite sign of KCARD. If <strong>the</strong>y are all zero, or if <strong>the</strong> lengthsare equal, corresponding digits are compared. The routine operates from left to right.The routine terminates when KCARD is longer than JCARD and a nonzero digit appearsin <strong>the</strong> high-order of KCARD, when JCARD and KCARD do not match, or when all digitsin JCARD and KCARD are equal. The following table shows <strong>the</strong> value of ICOMP,depending on <strong>the</strong> relation of <strong>the</strong> JCARD field to <strong>the</strong> KCARD field:ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEICOMP Relation- (minus) JCARD is less than KCARD0 (zero) JCARD is equal to KCARD+ (plus) JCARD is greater than KCARD-45-I I '''' OM' 111NR 1,1 " '


More detailed information may be found in <strong>the</strong> ICOMP flowchart and listing.Example: DIMENSION ITOT(10),ICTL(10)IF (ICOMP(ICTL,1,10,ITOT,1,10)) 1,2,1The control total is compared to <strong>the</strong> total calculated. Control goes to statement 1 if <strong>the</strong>totals do not match (<strong>the</strong> calculated total is greater than or less than <strong>the</strong> control total).Control goes to statement 2 if <strong>the</strong> calculated total is equal to <strong>the</strong> control total. The fieldscompared are not changed.ITOT 0007136673ICTL 0007136688ICOMP after is positive.Errors: No errors are detected. However, <strong>the</strong> JCARD field must not be longer than <strong>the</strong>KCARD field.Remarks: ICOMP is a function subprogram and as such should be used in an arithmeticexpression.If JLAST is less than J, or KLAST is less than K, <strong>the</strong> result is unpredictable.


IONDFormat: CALL IONDFunction: Checks for I/O interrupts and loops until no I/O interrupts are pending.This subroutine should not be used in conjunction with Version 2 of <strong>the</strong> <strong>1130</strong> Disk MonitorSystem. It is unneeded; besides, it may not operate correctly. It (IOND) is requiredonly for programs operating under control of Version 1 of <strong>the</strong> Monitor.Detailed description: The routine checks <strong>the</strong> Interrupt Service <strong>Subroutine</strong> Counter to seewhe<strong>the</strong>r any I/O interrupts are pending. If <strong>the</strong> counter is not zero, <strong>the</strong> routine continuesto check it until it becomes zero. Then <strong>the</strong> routine returns control to <strong>the</strong> user. Moredetailed information may be found in <strong>the</strong> IOND flowchart and listing.Example: CALL IONDPAUSE 777The two statements shown will wait until all I/O interrupts have been serviced. Then <strong>the</strong>program will PAUSE. If an I/O interrupt is pending, and IOND is not used before aPAUSE, <strong>the</strong> program will not PAUSE.Errors: NoneRemarks: This statement must always be used before a STOP or PAUSE statement.It may also be helpful in debugging programs. Sometimes, with more than one eventgoing on at <strong>the</strong> same time (PRINTing and processing) during debugging, difficulties can beencountered. The user may not be able to easily find <strong>the</strong> cause of trouble. The use ofIOND after each I/O statement will ensure that only one I/O operation is going on at anygiven time.ADDA1A3A1DECA3A1CARRYDE CA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE


ADD KEYBDA1A3A1DEC Format: CALL KEYBD(JCARD,J,JLAST)A3A1CARRY Function: Reads characters from <strong>the</strong> keyboard.DECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBD-4-MOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEParameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array will contain <strong>the</strong> keyed information when readingis finished. The information will be in Al format, one character perword.J - An integer constant, an integer expression, or an integer variable.This is <strong>the</strong> position of <strong>the</strong> first word of JCARD into which a characterwill be keyed (<strong>the</strong> left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last word ofJCARD into which a character will be keyed (<strong>the</strong> right-hand end of aDetailed description: The keyboard is read and <strong>the</strong> information being read is printed on<strong>the</strong> console printer. When <strong>the</strong> specified number of characters have been read, or whenEOF is encountered, <strong>the</strong> reading terminates. The characters read are converted fromkeyboard codes to EBCDIC and placed in Al format, one character per word. Control isnow returned to <strong>the</strong> user. More detailed information may be found in <strong>the</strong> TYPER/KEYBD flowchart and listing.Example: DIMENSION INPUT(30)Before:CALL KEYBD(INPUT,1,27)INPUT ABCDEFGHLTKLMNOPQRSTUVWXYZ0123After:Position 1 5 10 15 20 25 30INPUT THE CUSTOMER NAME GOES HERE123Position 1 51 1 1 1 110 15 20 25 30The array INPUT, from INPUT(1) to INPUT(27), has been filledwith information read from <strong>the</strong> keyboard.


Errors: The following WAITs may occur:WAIT (loc) Accumulator (hex) Action41 2xxO Ready <strong>the</strong> keyboard.41 2xxl Internal subroutine error.Rerun job. If error persists, verifythat <strong>the</strong> subroutine deck is accurateusing <strong>the</strong> listing in this manual. If <strong>the</strong>deck is <strong>the</strong> same, contact your local<strong>IBM</strong> representative. Save all output.Only 60 characters at a time may be read from <strong>the</strong> keyboard.If more than 60 characters are specified (JLAST-J+1 is greater than 60), only60 characters will be read.Remarks: The characters asterisked in Appendix D of <strong>IBM</strong> <strong>1130</strong> <strong>Subroutine</strong> Library(C26-5929) will be entered into core storage and printed. <strong>All</strong> o<strong>the</strong>r characters willbe entered into core storage but will not be printed.If this subroutine is used, all o<strong>the</strong>r I/O must use commercial routines.


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVE -4-MPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEMOVEFormat: CALL MOVE(JCARD,J,JLAST,KCARD,K)Function: Moves data from one array to ano<strong>the</strong>r array.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array from which data is moved. The data maybe stored in JCARD in any format, one character per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be moved (<strong>the</strong> left-handend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be moved (<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array to which data is moved, one character perword.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of KCARD to which data will bemoved (<strong>the</strong> left-hand end of a field).Detailed description: Characters are moved, left to right, from <strong>the</strong> sending field,• JCARD, starting with JCARD(J) and ending with JCARD(JLAST), to <strong>the</strong> receiving fieldKCARD, starting with KCARD(K). More detailed information may be found in <strong>the</strong> MOVEflowchart and listing.


Example: DIMENSION INPUT(80),IOUT(120)L=20K=14CALL MOVE(INPUT,6,L,IOUT,K)Before:INPUT IOUTbbbb12ABC45ZYXPQR999Ab... bbbbbb1bb77b6ABCDEFGHIJKLMNOPb...1 1 1 1 I 1Position 1 5 10 15 20 Position 1 5 10 15 20 25 30After:INPUT is <strong>the</strong> same. IOUTbbbbbblbb77b62ABC45ZYXPQR999Pb...PositionI I I I5 10 15 20 25 30The field in <strong>the</strong> array INPUT, starting at INPUT(6) and ending at INPUT(20), is movedto <strong>the</strong> field in <strong>the</strong> array IOUT, starting at IOUT(14). A total of 15 characters are moved.Errors: None-51-umm i lii1111111111111.ii,1111 11 1111111 1 1111111111.1.,i1.111111 111111 111111 11111111 1111111111111111111111


ADD MPYAlA3A 1DEC Format: CALL MPY(JCARD,J,JLAST,KCARD,K,KLAST,NER)A3A1CARRY Function: Multiplies two arbitrary-length decimal data fields, placing <strong>the</strong> product in <strong>the</strong>DECA1 second data field.DIVDPACK Parameter description:DUNPKEDIT JCARD - The name of a one-dimensional integer array defined in a DIMENSIONFILL statement. This array is <strong>the</strong> multiplier. The data must be stored inGET JCARD in decimal format, one digit per word.ICOMPIOND J - An integer constant, an integer expression, or an integer variable. ThisKEYBDis <strong>the</strong> position of <strong>the</strong> first digit that will multiply (<strong>the</strong> left-hand end of aMOVEfield).MPYNCOMPJLAST - An integer constant, an integer expression, or an integer variable,NSIGNgreater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last digit to m.ul-NZONEtiply (<strong>the</strong> right-hand end of a field).PACKPRINTKCARD - The name of a one-dimensional integer array defined in a DIMENSIONPUNCHstatement. This array, <strong>the</strong> multiplicand, will contain <strong>the</strong> product, ex-PUTP1403tended to <strong>the</strong> left, in decimal format, one digit per word.P1442READ K - An integer constant, an integer expression, or an integer variable. ThisR2501 is <strong>the</strong> position of <strong>the</strong> first digit of <strong>the</strong> multiplicand (<strong>the</strong> left-hand end of aSKIP field).STACKSUB KLAST - An integer constant, an integer expression, or an integer variable,S1403 greater than or equal to K. This is <strong>the</strong> position of <strong>the</strong> last character ofTYPER <strong>the</strong> product and <strong>the</strong> multiplicand (<strong>the</strong> right-hand end of a field).UNPACWHOLE NER - An integer variable. This variable will indicate whe<strong>the</strong>r <strong>the</strong> KCARDfield is not long enough.Detailed description: First <strong>the</strong> signs are cleared from both fields and saved. Then <strong>the</strong>KCARD field is extended to <strong>the</strong> left <strong>the</strong> length of <strong>the</strong> JCARD field (JLAST-J+1) and filledwith zeros. If <strong>the</strong> KCARD field will be extended below KCARD (1), NER will be setequal to KLAST and <strong>the</strong> routine will be terminated. Next, <strong>the</strong> JCARD field is scanned tofind <strong>the</strong> high-order significant digit. If no digit is found, <strong>the</strong> result is set to zero. Whena digit is found, <strong>the</strong> actual multiplication begins. The significant digits in <strong>the</strong> JCARDfield are multiplied by <strong>the</strong> digits in <strong>the</strong> KCARD field, one at a time, starting withKCARD(K) and ending with KCARD(KLAST). The preliminary results are summed,shifting after each preliminary multiplication to give <strong>the</strong> correct place value to <strong>the</strong> preliminaryresults. Finally, <strong>the</strong> correct sign is generated for <strong>the</strong> result, in KCARD, and<strong>the</strong> sign of JCARD is restored. More detailed information may be found in <strong>the</strong> MPYflowchart and listing.


Example: DIMENSION MPLR(5),MCAND(15)N=0CALL MPY(MPLR,1,5,MCAND,6,15,N)Before:MPLR 00982 MCAND ABCDE0007136673PositionAfter:N=01 5lPosition 1 5 10 15MPLR is unchanged.N=0MCAND 000007008212886Position 1 5 10 15The numeric data fields MPLR, and MCAND are multiplied, <strong>the</strong> result being placed inMCAND. Note that <strong>the</strong> MCAND field has been extended to <strong>the</strong> left <strong>the</strong> length of <strong>the</strong>MPLR field, five positions, and that N has not been changed.Errors: If <strong>the</strong>re is not enough room to extend <strong>the</strong> KCARD field to <strong>the</strong> left, NER will beset equal to KLAST, and <strong>the</strong> routine will terminate.Remarks: Conversion from EBCDIC to decimal is necessary before using this subroutine.This may be accomplished with <strong>the</strong> A1DEC subroutine. The length of <strong>the</strong> JCARD andKCARD fields is arbitrary, up to <strong>the</strong> maximum space available.The arithmetic performed is decimal arithmetic, using whole numbers only.Space must always be provided in <strong>the</strong> KCARD field for expansion. The first position of<strong>the</strong> multiplicand, K, must be at least JLAST-J+1 positions from <strong>the</strong> beginning ofKCARD. For example, if JCARD is 7 positions, 1 through 7, <strong>the</strong>n <strong>the</strong> multiplicand,in KCARD, must start at least seven positions (7-1+1=7) from <strong>the</strong> beginning of KCARD.This would have K equal to 8.The product, located in <strong>the</strong> KCARD field, will begin at position K-(JLAST-J+1) ofKCARD, and end at position KLAST of KCARD.-53-1,1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111.111111111 HMI


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMP-4—NSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLENCOMPFormat: NCOMP(JCARD,J,JLAST,KCARD,K)Function: Two variable-length data fields are compared, and <strong>the</strong> result is set to a negativenumber, zero, or a positive number. This is a function subprogram.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> first data field to be compared, onecharacter per word, in Al format.- An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be compared (<strong>the</strong> lefthandend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be compared (<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional, integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> second data field to be compared,one character per word, in Al format.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of KCARD to be compared (<strong>the</strong> lefthandend of a field).Detailed description: Corresponding characters of JCARD and KCARD are comparedlogically, starting with JCARD(J) and KCARD(K). The routine operates from left toright. The routine terminates when JCARD and KCARD do not match, or when <strong>the</strong> characterat JCARD(JLAST) has been compared. The following table shows <strong>the</strong> value ofNCOMP, depending on <strong>the</strong> relation of <strong>the</strong> JCARD field to <strong>the</strong> KCARD field:NCOMPRelation- (minus) JCARD is less than KCARD0 (zero) JCARD is equal to KCARD+ (plus) JCARD is greater than KCARDMore detailed information may be found in <strong>the</strong> NCOMP flowchart and listing.


Example: DIMENSION IN(80), MASTR(80)IF (NCOMP(IN,1,20,MASTR,1))1,2,3The field on <strong>the</strong> input card starting in column 1 and ending in column 20 is comparedwith <strong>the</strong> master field. Control goes to statement 1 if <strong>the</strong> input card is less than <strong>the</strong> Inastercard. Control goes to statement 2 if <strong>the</strong> input card equals <strong>the</strong> master card. Controlgoes to statement 3 if <strong>the</strong> input card is greater than <strong>the</strong> master card. The fields comparedare not changed.INMASTR1234567bbbbbbbABCDEF1234567bbbbbbbABCDEFNCOMP after is zeroErrors: NoneRemarks: The collating sequence in ascending order is as follows:A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9,blanici.,


ADD NSIGNA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGN ••••-NZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLEFormat: CALL NSIGN(JCARD,J,NEWS,NOLDS)Function: Interrogate <strong>the</strong> sign and return with a code as to what <strong>the</strong> sign is. Also,modify <strong>the</strong> sign as specified.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> digit to be interrogated or modified,in decimal (Dl) format.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> digit to be interrogated or modified.NEWS - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> code specifying <strong>the</strong> desired modification of <strong>the</strong> sign.NOLDS - An integer variable. Upon completion of <strong>the</strong> routine, this variable contains<strong>the</strong> code specifying what <strong>the</strong> sign was.Detailed description: The sign is retrieved and NOLDS is set as in <strong>the</strong> table below:NOLDS isWhen <strong>the</strong> sign was+1 positive-1 negativeThen a new sign is inserted, specified by NEWS, as shown in <strong>the</strong> table below:NEWS+1 positiveSign0 opposite of old sign–1 negativeNOLDSno changeMore detailed information may be found in <strong>the</strong> NSIGN flowchart and listing.


Example: DIMENSION INUMB(9)CALL NSIGN(TNUMB, 9,0,N)Before: N=0, INUMB(9)=7After: N=1, INUMB(9)= -7Errors: NoneRemarks: The digit processed must be in decimal (D1) format. If it is not, <strong>the</strong> resultsare meaningless.-57-' 111.M111111.111•11111111


ADD NZONEA1A3A 1DEC Format: CALL N ZONE (JCARD,J,NEW Z,NOLDZ)A3A1CARRY Function: Interrogate <strong>the</strong> zone and return with a code as to what <strong>the</strong> zone is. Also,DECA1 modify <strong>the</strong> zone as specified.DIVDPACK Parameter description:DUNPKEDIT JCARD - The name of a one-dimensional integer array defined in a DIMENSIONFILL statement. This array contains <strong>the</strong> character to be interrogated orGET modified, in Al format.ICOMPIONDJ - An integer constant, an integer expression, or an integer variable. ThisKEYBDis <strong>the</strong> position of <strong>the</strong> character in JCARD to be interrogated or modified.MOVEMPYNEWZ - An integer constant, an integer expression, or an integer variable. ThisNCOMPis <strong>the</strong> code specifying <strong>the</strong> modification of <strong>the</strong> zone.NSIGNNZONE--PACKNOLDZ - An integer variable. This variable contains <strong>the</strong> code specifying what <strong>the</strong>PRINTzone was.PUNCHPUT Detailed description: The zone is retrieved and NOLDZ is set as in <strong>the</strong> table below:P1403P1442 NOLDZ is When <strong>the</strong> character wasREADR2501 1 A-ISKIPSTACK 2 J-RSUBS14033 S- ZTYPERUNPAC 4 0-9WHOLEmore than 4 specialThen a new zone is inserted, specified by NEWZ, as shown in <strong>the</strong> table below:NEW Z Character1 12 zone2 11 zone3 0 zone4 no zonemore than 4 no change


When a special character is <strong>the</strong> original character, <strong>the</strong> zone will not be changed. Moredetailed information may be found in <strong>the</strong> NZONE flowchart and listing.Example: DIMENSION IN(80)CALL NZONE(IN,1,2,J)Before: J = 0IN(1) = a B (a 12,2 punch)After: J = 1IN(1) = a K (an 11,2 punch)Errors: NoneRemarks: The minus sign or dash (-, an 11-punch) is treated as if it were a negativezero, not as a special character. This is <strong>the</strong> only exception.The only modification performed on an input minus sign is that it may be transformed toa digit zero with no zone (a positive zero).-59-rr- r rrr, 11 1 111 ',En! rl I II I I I I I /111.■..17-


ADD PACKA1A3AlDEC Format: CALL PACK(JCARD,J,JLAST,KCARD,K)A3A1CARRY Function: Information in Al format, one character per word, is PACKed into A2 format,DECA1 two characters per word.DIVDPACK Parameter description:DUNPKEDIT JCARD - The name of a one-dimensional integer array defined in a DIMENSIONFILL statement. This is <strong>the</strong> input array, containing <strong>the</strong> data in Al format,GET one character per word.ICOMPIOND J - An integer constant, an integer expression, or an integer variable. ThisKEYBD is <strong>the</strong> position of <strong>the</strong> first character of JCARD to be PACKed (<strong>the</strong> left-MOVEhand end of a field).MPYNCOMPJLAST - An integer constant, an integer expression, or an integer variable,NSIGNgreater than J. This is <strong>the</strong> position of <strong>the</strong> last character of JCARD toNZONEbe PACKed (<strong>the</strong> right-hand end of a field).PACK -4—PRINTKCARD - The name of a one-dimensional integer array defined in a DIMENSIONPUNCHPUTstatement. This is <strong>the</strong> array into which <strong>the</strong> data is PACKed, in A2 format,two characters per word.P1403P1442READ K - An integer constant, an integer expression, or an integer variable. ThisR2501 is <strong>the</strong> position of <strong>the</strong> first element of KCARD to receive <strong>the</strong> PACKedSKIP characters (<strong>the</strong> left-hand end of a field).STACKSUB Detailed description: The characters in <strong>the</strong> JCARD array are taken in pairs, startingS1403 with JCARD(J), and PACKed toge<strong>the</strong>r into one element of KCARD, starting withTYPER KCARD(K). Since <strong>the</strong> characters are taken in pairs, an even number of characters willUNPAC always be PACKed. If necessary, <strong>the</strong> character at JCARD(JLAST+1) will be used inWHOLE order to make <strong>the</strong> last data PACKed a pair. More detailed information may be found in<strong>the</strong> PACK/UNPAC flowchart and listing.


[Example: DIMENSION IUNPK(26),IPAKD(26)CALL PACK(IUNPK,1,25,IPAKD,1)Before:IUNPK AbBbCbDbEbFbGbHblbJbKbLbMbNbObPbQbRbSbTbUbVbWbXbYbZb115 I IPosition 1 10 15 20 25IPAKD Oblb2b3b4b5b6b7b8b9bOblb2b3b4b5b6b7b8b9bOblb2b3b4b5bPosition1 5 1 15 20 25After:IUNPK is <strong>the</strong> same.IPAKD ABCDEFGHIJKLMNOPQRSTUVWXYZ3b4b5b6b7b8b9b0b1b2b3b4b5bPosition 1 5 10 15 20 25Note that each two characters shown above represent one element of <strong>the</strong> array.Also, after IUNPK has been PACKed, <strong>the</strong> twenty-sixth character, Z, has beenPACKed since 25 characters were specified (between J and JLAST).Errors: NoneRemarks: If JLAST is less than or equal to J, <strong>the</strong> first two characters of JCARD will bePACKed. An even number of characters in JCARD will always be PACKed into KCARD.An equation for how much space is required, in elements, in KCARD isSpace in KCARD -JLAST-J+2 ]2This result is rounded down at all times.-61-1 1 1 U 111 111 1111 11 111 -1.111,111111 I RIMINIR. 11119,1l. II


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINT •—PUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEPRINTFormat: CALL PRINT(JCARD,J,JLAST,NER)Function: The printing of one line on <strong>the</strong> <strong>IBM</strong> 1132 Printer is initiated, and controlis returned to <strong>the</strong> user.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> information to be printed, on <strong>the</strong><strong>IBM</strong> 1132 Printer, in Al format, one character per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be printed (<strong>the</strong> lefthandend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be printed (<strong>the</strong> right-hand end of a field).NER - An integer variable. This variable indicates carriage tape channel conditionsthat have occurred in printing.Detailed description: When <strong>the</strong> previous print operation is finished, if a print operationwas going on, <strong>the</strong> routine begins. The characters to be printed are packed and reversed.Since <strong>the</strong> characters are taken in pairs, an even number of characters is required. Ifnecessary, <strong>the</strong> character at JCARD(JLAST+1) will be used to get an even number. Thenprinting is initiated and control is returned to <strong>the</strong> user. When printing is finished, <strong>the</strong>printer spaces one line and <strong>the</strong> indicator, NER, is set as follows:NER iswhen3 Channel 9 has been encountered4 Channel 12 has been encounteredIf channel 9 or channel 12 is not encountered, <strong>the</strong> indicator is not set.If a WAIT occurs at location 41, one of <strong>the</strong> following conditions exists:ConditionPrinter not ready or end of forms.Internal subroutine error. Rerun job. Iferror persists, verify that <strong>the</strong> subroutinedeck is accurate, using <strong>the</strong> listing in thismanual. If <strong>the</strong> deck is <strong>the</strong> same, contactyour local <strong>IBM</strong> representative. Save all output.Accumulator (hex)6xx06xxl


<strong>All</strong> of <strong>the</strong> above WAITS require operator intervention.Only one line can be printed at a time (JLAST-J+1 must be less than or equal to 120).More detailed information may be found in <strong>the</strong> PRINT/SKIP flowchart and listing.Example: DIMENSION IOUT(120)N=0CALL PRINT(IOUT,1,120,N)IF(N-3) 1,2,32 Channel 9 routine3 Channel 12 routine1 Normal processingThe line in IOUT, from IbUT(1) through IOUT(120), is printed. The indicator is testedto see whe<strong>the</strong>r (1) <strong>the</strong> line was printed at channel 9 or (2) <strong>the</strong> line was printed at channel12. Appropriate action will be taken.Notice that <strong>the</strong> test of <strong>the</strong> indicator is made after printing. The test should always beperformed in this way to see where <strong>the</strong> line has just been printed. If <strong>the</strong> indicator wasset, <strong>the</strong> line was printed at channel 9 or channel 12.Errors: If JLAST is less than J, only one character will be printed. If more than 120characters are specified (JLAST-J+1 is greater than 120), only 120 characters will beprinted.Remarks: After each line is printed, <strong>the</strong> condition indicator should be checked for <strong>the</strong>channel 9 or channel 12 indication. In doing this <strong>the</strong> same variable should always be usedfor <strong>the</strong> indicator.The indicator is not reset by <strong>the</strong> subroutine. It is <strong>the</strong> responsibility of <strong>the</strong> user to initializeand reset this indicator.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong>exception of disk, which must always use FORTRAN I/O.luncol Holmum1131311113,mmommomplumuomprougull ■11■••■■•••■•clopropplR,F.Hquocmuiiiimrpromou 1 I I e+a I, I ll I' 1,11. •-63-


ADDAlA3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCH-0-PUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLEPUNCHFormat: CALL PUNCH(JCARD,J,JLAST,NER)Function: Punches a card on <strong>the</strong> <strong>IBM</strong> 1442, Model 6 or 7. See <strong>Subroutine</strong> P1442 forpunching on <strong>the</strong> 1442 Model 5.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> characters to be punched into a card,in Al format, one character per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be punched (<strong>the</strong> lefthandend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be punched (<strong>the</strong> right-hand end of a field).NER - An integer variable. This variable indicates any conditions that haveoccurred in punching a card, and <strong>the</strong> nature of <strong>the</strong>se conditions.Detailed description: The characters to be punched are converted from EBCDIC to cardcodes, one at a time. When all characters have been converted, <strong>the</strong> punching operationis initiated. If an error occurs during <strong>the</strong> operation, <strong>the</strong> condition indicator is set, and<strong>the</strong> operation is continued. The possible values of <strong>the</strong> condition indicator and <strong>the</strong>ir meaningare listed below:NER is01whenLast card condition.Feed or punch check.Operator interventionrequired.If a WAIT occurs at location 41, one of <strong>the</strong> following conditions exists:Punch not ready.ConditionsInternal subroutine error. Rerun job.If error persists, verify that <strong>the</strong> subroutinedeck is accurate, using <strong>the</strong>listing in this manual. If <strong>the</strong> deck is<strong>the</strong> same, contact your <strong>IBM</strong> representative.Save all output.Accumulator (hex)lxx0lxxl<strong>All</strong> of <strong>the</strong> above WAITs require operator intervention.


Only one card can be punched at a time (JLAST-J+1 must be less than or equal to 80).More detailed information may be found in <strong>the</strong> READ/PUNCH flowchart and listing.Example: DIMENSION IOTPT(80)N=-1CALL PUNCH(IOTPT,1,80,N)Before:IOTPT NAME...ADDRESS...AMOUNTI I IPosition 1 20 60After:N=-1IOTPT is <strong>the</strong> same.N=0The information in IOTPT, from IOTPT(1) to IOTPT(80), has been punched into a card.Since N=0, <strong>the</strong> information was punched correctly, and <strong>the</strong> card punched into was <strong>the</strong>last card.Errors: If a punch or feed check occurs, <strong>the</strong> condition indicator will be set equal to 1.If an internal error occurs, <strong>the</strong> system will WAIT as specified above.If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 characters,one card, will be punched.Remarks: After each card is punched, <strong>the</strong> condition indicator should be checked for <strong>the</strong>last card indication. This will occur only after <strong>the</strong> last card has physically beenpunched.The condition indicator is not reset by <strong>the</strong> subroutine. It is <strong>the</strong> responsibility of <strong>the</strong> userto initialize and reset this indicator.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.


ADD PUTAlA3AlDEC Format: CALL PUT(JCARD,J,JLAST,VAR,ADJST,N)A3A1CARRY Function: Converts <strong>the</strong> whole portion of a real variable, VAR, to an EBCDIC integerDECA1 number, half-adjusting as specified, and places <strong>the</strong> result, after decimalDIV point alignment, in an array. An 11-zone is placed over <strong>the</strong> low-order,DPACK rightmost position in <strong>the</strong> array if VAR is negative.DUNPKEDITFILL Parameter description:GETICOMP JCARD - The name of a one-dimensional integer array defined in a DIMENSIONIOND statement. This array will contain <strong>the</strong> result of <strong>the</strong> PUT routine,KEYBD EBCDIC coded information, in Al format, one digit per word.MOVEMPY J - An integer constant, an integer expression, or an integer variable. ThisNCOMP is <strong>the</strong> first position of JCARD to be filled with <strong>the</strong> result (<strong>the</strong> left-handNSIGN end of a field).NZONEPACK JLAST - An integer constant, an integer expression, or an integer variable,PRINT greater than or equal to J. This is <strong>the</strong> last position to be filled with <strong>the</strong>PUNCH result (<strong>the</strong> right-hand end of a field).PUT -*--P1403 VAR - A real constant, a real expression, or a real variable. This is <strong>the</strong> num-P1442 ber whose whole portion will be PUT.READR2501 ADJST - A real constant, a real expression, or a real variable. This is added toSKIP <strong>the</strong> variable, VAR, as a half-adjustment factor.STACKSUB N - An integer constant, an integer expression, or an integer variable. ThisS1403 specifies <strong>the</strong> number of digits to truncate from <strong>the</strong> right-hand end of <strong>the</strong>TYPERnumber, VAR.UNPACWHOLE Detailed description: First, <strong>the</strong> half-adjustment factor is added to <strong>the</strong> real variable,VAR. Then, each digit is retrieved using <strong>the</strong> formulaEBCDIC DIGIT = 256 (BINARY DIGIT) - 4032and placed in <strong>the</strong> output area. Each binary digit is retrieved by subtracting <strong>the</strong> digitsalready retrieved from VAR and multiplying by 10. The next digit is <strong>the</strong>n retrieved andplaced in <strong>the</strong> output area. More detailed information may be found in <strong>the</strong> PUT flowchartand listing.


Example: DIMENSION IPRNT(120)CALL PUT(IPRNT, 1,12, A, 5.0,1)Before:A = 1234567.IPRNT ABCDEFGHIJKLMNOPQRSbPosition 1 5 10 15 20After:A = 1234567.IPRNT 000000123457MNOPQRSb4 I 4 4Position 1 5 10 15 20Errors: NoneRemarks: If <strong>the</strong> receiving field, JCARD, is not large enough to hold all of <strong>the</strong> output,only <strong>the</strong> low-order digits are placed.If JLAST is less than or equal to J, only one digit will be PUT.It is necessary for <strong>the</strong> programmer to use <strong>the</strong> ADJST parameter in every PUT. Forexample, assume that <strong>the</strong> number to be PUT is 123.00. Because <strong>the</strong> <strong>IBM</strong> <strong>1130</strong> is a binarymachine, <strong>the</strong> number may be represented in core storage as 122.999....If this number isPUT with ADJST equal to zero, <strong>the</strong> result will be 122. However, with ADJST equal to0.5, <strong>the</strong> preliminary result is 123.499; when PUT, <strong>the</strong> result is 123. The value of ADJSTshould be a 5 in <strong>the</strong> decimal position one to <strong>the</strong> right of <strong>the</strong> low-order digit to be PUT.The last two factors, ADJST and N, form a logical pair, and should usually appear asei<strong>the</strong>r:ADJSTN.5 and 0or 5. and 1or 50. and 2or 500. and 3etc.etc.ADJST should never be less than .5, since this will introduce fraction inaccuracies.From this it follows that N should never be negative.If PUT (or GET) is used, <strong>the</strong> calling program must use extended precision.


ADD P1403A1A3AlDECA3A1 Format: CALL P1403(JCARD, J, JLAST, NER)CARRYDECA1 Function: The printing of one line on <strong>the</strong> <strong>IBM</strong> 1403 Printer, Model 6 or 7, is initiated,DIVand control is returned to <strong>the</strong> user.DPACKDUNPK Parameter description:EDITFILLJCARD - The name of a one-dimensional integer array defined in a DIMENSIONGETstatement. This array contains <strong>the</strong> information to be printed, on <strong>the</strong>ICOMP<strong>IBM</strong> 1403 Printer, in Al format, one character per word.IONDKEYBDJ - An integer constant, an integer expression, or an integer variable. ThisMOVEis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be printed (<strong>the</strong> left-handMPYend of a field).NCOMPNSIGN JLAST - An integer constant, an integer expression, or an integer variable,NZONEgreater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofPACKJCARD to be printed (<strong>the</strong> right-hand end of a field).PRINTPUNCHNER - An integer variable. This variable indicates carriage control tape condi-PUTtions that have occurred in printing.P1403 .4-P Detailed description: When <strong>the</strong> previous print operation is finished, if a print operationREAD was going on, <strong>the</strong> routine begins. The characters to be printed are converted to 1403R2501 Printer codes and reversed so as to match <strong>the</strong> 1403 buffer mechanism. Since <strong>the</strong> char-SKIP acters are taken in pairs, an even number of characters is required. If necessary, <strong>the</strong>STACK character at JCARD(JLAST+1) will be used to get an even number. Printing is <strong>the</strong>nSUB initiated and control is returned to <strong>the</strong> user. When printing is finished, <strong>the</strong> printer spacesS1403 one line and <strong>the</strong> indicator, NER, is set as follows:TYPERUNPACWHOLENER is when3 Channel 9 has been encountered4 Channel 12 has been encounteredIf nei<strong>the</strong>r channel 9 nor channel 12 is encountered, <strong>the</strong> indicator is not set. If a WAIToccurs at location 41, one of <strong>the</strong> following conditions exists:ConditionsPrinter not ready or end of forms.Internal subroutine error. Rerun job. If error persists,verify that <strong>the</strong> subroutine deck is accurate, using <strong>the</strong> listingin this manual. If <strong>the</strong> deck is <strong>the</strong> same, contact your local<strong>IBM</strong> representative. Save all output.Accumulator (hex)90009001<strong>All</strong> of <strong>the</strong> above WAITs require operator intervention.


Only one line can be printed at a time (JLAST-J+1 must be less than or equal to 120).More detailed information may be found in <strong>the</strong> P1403 flowchart and listing.Example: DIMENSION IOUT(120)N=0CALL P 1403(IOUT , 1,120 , N)IF(N-3)1,2,32 Channel 9 routine3 Channel 12 routine1 Normal processingThe line in IOUT, from IOUT(1) through IOUT(120), is printed. The indicator is testedto see whe<strong>the</strong>r (1) <strong>the</strong> line was printed at channel 9 or (2) <strong>the</strong> line was printed at channel12. Appropriate action will be taken.Notice that <strong>the</strong> test of <strong>the</strong> indicator is made after printing. The test should always beperformed in this way to see where <strong>the</strong> line has just been printed. If <strong>the</strong> indicator wasset, <strong>the</strong> line was printed at channel 9 or channel 12.Errors: If JLAST is less than J, two characters will be printed. If more than 120 charactersare specified (JLAST-J+1 is greater than 120), only 120 characters will be printed.Remarks: After each line is printed, <strong>the</strong> condition indicator should be checked for <strong>the</strong>channel 9 or channel 12 indication. In doing this, <strong>the</strong> same variable should always beused for <strong>the</strong> indicator.The indicator is not reset by <strong>the</strong> subroutine. It is <strong>the</strong> responsibility of <strong>the</strong> user toinitialize and reset this indicator.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong>exception of disk, which must always use FORTRAN I/O.This CSP subroutine uses three subprograms that are part of <strong>the</strong> Disk Monitor Version 2subroutine library. If P1403 is to be used with Version 1 of <strong>the</strong> Monitor, ZIPCO, EBPT3,and PRNT3 must be loaded onto <strong>the</strong> Version 1 disk cartridge.-69-11111111111I111111111111111111111IIII111111111111111•11111111III I


ADD P 1442A1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442 -*—READR2501SKIPSTACKSUB51403TYPERUNPACWHOLEFormat: CALL P1442(JCARD, J, JLAST, NER)Function: Punches a card on <strong>the</strong> <strong>IBM</strong> 1442, Model 5, 6, or 7.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This array contains <strong>the</strong> characters to be punched into a card,in Al format, one character per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first character of JCARD to be punched (<strong>the</strong> left-handend of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofJCARD to be punched (<strong>the</strong> right-hand end of a field).NER - An integer variable. This variable indicates any conditions that haveoccurred in punching a card, and <strong>the</strong> nature of <strong>the</strong>se conditions.Detailed description: The characters to be punched are converted from EBCDIC to cardcodes, one at a time. When all characters have been converted, <strong>the</strong> punching operationis initiated. If an error occurs during <strong>the</strong> operation, <strong>the</strong> condition indicator is set, and<strong>the</strong> operation is continued. The possible values of <strong>the</strong> condition indicator and <strong>the</strong>irmeaning are listed below:NER iswhen0 Last card condition.1 Feed or punch check. Operator intervention required.If a WAIT occurs at location 41, one of <strong>the</strong> following conditions exists:ConditionsAccumulator (hex)Punch not ready.Internal subroutine error. Rerun job. If error persists,verify that <strong>the</strong> subroutine deck is accurate, using <strong>the</strong> listingin this manual. If <strong>the</strong> deck is <strong>the</strong> same, contact your <strong>IBM</strong>representative. Save all output.lxx0lxxl<strong>All</strong> of <strong>the</strong> above WAITs require operator intervention.


Only one card can be punched at a time (JLAST-J+1 must be less than or equal to 80).More detailed information may be found in <strong>the</strong> P1442 flowchart and listing.Example: DIMENSION IOTPT(80)N = -1CALL P1442(10TPT,1,80,N)Before:IOTPT NAME. . . ADDRESS. .. AMOUNTPosition1 20 60N = -1After:IOTPT is <strong>the</strong> same.N = 0The information in IOTPT, from IOTPT(1) to IOTPT(80), has been punched into a card.Since N = 0, <strong>the</strong> information was punched correctly, and <strong>the</strong> card punched into was <strong>the</strong>last card.Errors: If a punch or feed check occurs, <strong>the</strong> condition indicator will be set equal to 1.If an internal error occurs, <strong>the</strong> system will WAIT as specified above.If JLAST is less than J, only one character will be punched.If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80characters, one card, will be punched.Remarks: After each card is punched, <strong>the</strong> condition indicator may be checked for <strong>the</strong>last-card indication. This will occur only after <strong>the</strong> last card has physically beenpunched.9The condition indicator is not reset by <strong>the</strong> subroutine. It is <strong>the</strong> responsibility of <strong>the</strong>user to initialize and reset this indicator.-71-1.11■11111.11111 NM. I


If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.If a program contains no calls to <strong>the</strong> READ subroutine, this routine (P1442) may be usedto punch cards on <strong>the</strong> 1442, Model 6 or 7, at a considerable savings in core storage.This is due to <strong>the</strong> fact that READ and PUNCH are two different entry points to <strong>the</strong> samesubroutine. A call to one or both will cause <strong>the</strong> READ/PUNCH routine to be added to<strong>the</strong> core load. P1442 is smaller in size, since it is basically <strong>the</strong> PUNCH portion of <strong>the</strong>READ/PUNCH routine. A program may not CALL both READ/PUNCH and P1442; <strong>the</strong>Monitor will refuse to load two I/O routines that service <strong>the</strong> same device. To feed <strong>the</strong>first card, a P1442 CALL may be issued, punching 80 blanks.This CSP subroutine uses part of <strong>the</strong> Disk Monitor Version 2 subroutine library. IfP1442 is to be used with Version 1 of <strong>the</strong> Monitor, PNCH1 must be loaded onto <strong>the</strong>Version 1 disk cartridge.


READFormat: CALL READ(JCARD,J,JLAST,NER)Function: Reads a card from <strong>the</strong> <strong>IBM</strong> 1442, Model 6 or 7, only, overlapping <strong>the</strong> conversionfrom card codes to EBCDIC.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. A card will be read into this array, in Al format, one characterper word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first word of JCARD into which a character willbe read (<strong>the</strong> left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable,greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last word ofJCARD into which a character will be read (<strong>the</strong> right-hand end of afield).NER - An integer variable. This variable indicates any conditions that have occurredin reading a card, and <strong>the</strong> nature of <strong>the</strong>se conditions.Detailed description: A card read operation is started. While <strong>the</strong> card is being read,<strong>the</strong> characters, one at a time, are converted from card codes to EBCDIC. If an erroroccurs during <strong>the</strong> operation, <strong>the</strong> condition indicator is set, and <strong>the</strong> operation continues.The possible values of <strong>the</strong> condition indicator and <strong>the</strong>ir meaning are listed below:NER is when0 Last card condition.1 Feed or read check.Operator interventionrequired.ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEIf a WAIT occurs at location 41, one of <strong>the</strong> following conditions exists:ConditionsReader not ready.Internal subroutine error. Rerun job.If error persists, verify that <strong>the</strong> subroutinedeck is accurate, using <strong>the</strong>listing in this manual. If <strong>the</strong> deck is<strong>the</strong> same, contact your <strong>IBM</strong> representative.Save all output.Accumulator (hex)lxx0lxxl-73-11111111111■1 I 1. 11111 r • MI',


<strong>All</strong> of <strong>the</strong> above WAITs require operator intervention.Only one card can be read at a time (JLAST-J+1 must be less than or equal to 80). Moredetailed information may be found in <strong>the</strong> READ/PUNCH flowchart and listing.Example: DIMENSION INPUT(160)Before:N1=-1CALL READ(INPUT,1,80,N1)N2=-1CALL READ(INPUT,81,160,N2)INPUT 000000... 0000000000Position 1 5 155 160N1=-1N2=-1After:INPUT THISItIS THEINAME...ISECONDIt ICARD...1 IPosition 1 5 10 15 80 81 85 90 160N1=-1N2=-1From <strong>the</strong> user's viewpoint <strong>the</strong> next card is read into <strong>the</strong> INPUT array (1-80). N1 is notone of <strong>the</strong> indicated values, so <strong>the</strong> first read was successful. The next card is read into<strong>the</strong> INPUT array (81-160). N2 is not one of <strong>the</strong> indicated values, so <strong>the</strong> second read wasalso successful.Errors: If a read or feed check occurs, <strong>the</strong> condition indicator will be set equal to 1. Ifan internal error occurs, <strong>the</strong> system will WAIT as specified above.If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 characters,one card, will be read.


Remarks: After each card read, <strong>the</strong> condition indicator may be checked for <strong>the</strong> lastcard indication. This will occur only after <strong>the</strong> last card has physically been read intocore storage.The condition indicator is not reset by <strong>the</strong> subroutine. It is <strong>the</strong> responsibility of <strong>the</strong>user to initialize and reset this indicator.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.Note that <strong>the</strong> READ subroutine will not detect Monitor // control cards, as opposed to<strong>the</strong> standard FORTRAN READ, which exits when such a card is encountered.


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLER2501Format: CALL R2501(JCARD, J, JLAST, NER)Function: Reads a card from <strong>the</strong> <strong>IBM</strong> 2501, Model Al or A2 only, overlapping <strong>the</strong> conversionfrom card codes to EBCDIC.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. A card will be read into this array, in Al format, one characterper word. This array should always be 80 words in length.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first word of JCARD into which a character will beread (<strong>the</strong> left-hand end of a field).JLAST - An integer constant, an integer expression, or an integer variable, greaterthan or equal to J. This is <strong>the</strong> position of <strong>the</strong> last word of JCARD intowhich a character will be read (<strong>the</strong> right-hand end of a field).NER - An integer variable. This variable indicates any conditions that have occurredin reading a card, and <strong>the</strong> nature of <strong>the</strong>se conditions.Detailed description: A card read operation is started. While <strong>the</strong> card is being read,<strong>the</strong> characters, one at a time, are converted from card codes to EBCDIC. If an erroroccurs during <strong>the</strong> operation, <strong>the</strong> condition indicator is set, and <strong>the</strong> operation continues.The possible values of <strong>the</strong> condition indicator and <strong>the</strong>ir meaning are listed below:NER is0 Last card condition.when1 Feed or read check. Operator interventionrequired.If a WAIT occurs at location 41, one of <strong>the</strong> following conditions exists:Reader not ready.ConditionsInternal subroutine error. Rerun job. Iferror persists, verify that <strong>the</strong> subroutinedeck is accurate, using <strong>the</strong> listing in thismanual. If <strong>the</strong> deck is <strong>the</strong> same, contactyour <strong>IBM</strong> representative. Save all output.Accumulator (hex)lxx0lxxi<strong>All</strong> of <strong>the</strong> above WAITs require operator intervention.


Only one card can be read at a time (JLAST-J+i must be less than or equal to 80). Moredetailed information may be found in <strong>the</strong> R2501 flowchart and listing.Example: DIMENSION INPUT(160)Before:N1=-1CALL R2501 (INPUT, 1,80, N1)N2=-1CALL R2501(INPUT,81,160,N2)INPUT 000000.. . 00000000001t I IPosition 1 5 155 160N1=-1N2=-1After:INPUT THISbISbTHEbNAME...SECONDbCARDII 1111 IPosition 1 5 10 15 80 81 85 90 160N1=-1N2=-1The first card is read into <strong>the</strong> INPUT array (1-80). N1 is not one of <strong>the</strong> indicated values,so <strong>the</strong> first read was successful. The next card is read into <strong>the</strong> INPUT array (81-160).N2 is not one of <strong>the</strong> indicated values, so <strong>the</strong> second read was also successful.Errors: If a read or feed check occurs, <strong>the</strong> condition indicator will be set equal to 1.If an internal error occurs, <strong>the</strong> system will WAIT as specified above.If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 characters,one card, will be read.-77-11111111111 1111.1111.., 1 141110.1•11.1111111111111 11111111111.0 111INIRIM,H.44.0..


Remarks: After each card read, <strong>the</strong> condition indicator may be checked for <strong>the</strong> lastcardindication. This will occur only after <strong>the</strong> last card has physically been read intocore storage.The condition indicator is not reset by <strong>the</strong> subroutine. It is <strong>the</strong> responsibility of <strong>the</strong> userto initialize and reset this indicator.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.Note that <strong>the</strong> R2501 routine does not detect Monitor 1/ control cards, as opposed to <strong>the</strong>standard FORTRAN READ, which exits when such a card is encountered.This CSP subroutine uses part of <strong>the</strong> Disk Monitor Version 2 subroutine library. IfR2501 is to be used with Version 1 of <strong>the</strong> Monitor, READ1 must be loaded onto <strong>the</strong>Version 1 disk cartridge.


SKIPADDA1A3Format: CALL SKIP(N)A1DECA3A1Function: Execute <strong>the</strong> requested control function on <strong>the</strong> <strong>IBM</strong> 1132 Printer CARRYDECA1Parameter description:DIVDPACKN - An integer constant, an integer expression, or an integer variable. The DUNPKvalue of this variable corresponds to an available control function. EDITFILLDetailed description: If <strong>the</strong> printer is busy, <strong>the</strong> subroutine WAITs. O<strong>the</strong>rwise, or when GET<strong>the</strong> printer finishes, <strong>the</strong> routine executes <strong>the</strong> requested function and returns control to ICOMP<strong>the</strong> calling program. The control functions and <strong>the</strong>ir values are as follows: IONDKEYBDFunctionValue MOVEMPYImmediate skip to channel 112544 NCOMPNSIGNImmediate skip to channel 212800 NZONEPACKImmediate skip to channel 313056 PRINTPUNCHImmediate skip to channel 413312 PUTP1403Immediate skip to channel 513568 P1442READImmediate skip to channel 613824 R2501SKIPImmediate skip to channel 914592 STACKSUBImmediate skip to channel 12 15360 51403TYPERImmediate space of 1 space15616 UNPACWHOLEImmediate space of 2 spaces15872Immediate space of 3 spacesSuppress space after printing161280Normal spacing is one space after printing.Example: NUMBR=12544CALL SKIP(NUMBR)The carriage skips until a punch in channel 1 of <strong>the</strong> carriage control tape is encountered(normally this is at <strong>the</strong> top of a page).-79-11111 lIrrurn I Pi, iiilliii.iIIIIIIIIIIIIIIII111,1,1111111,1-minNIVIIIIIMIIMMIP1111111.0111111.11111110111111.111111.11.1.1111111.11.0111111•1111•11MNIIMIIPIPAINVIRM,


Errors: Only <strong>the</strong> codes mentioned above can be used. The use of anything else will resultin ei<strong>the</strong>r no movement of <strong>the</strong> carriage or a WAIT at location 41 with 6xxl in <strong>the</strong>accumulator (hex).Remarks: When space suppression after printing is executed, it is reset to single-spaceafter printing. If <strong>the</strong> user wishes to continue suppression, he must reissue <strong>the</strong> suppressioncommand.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.


STACKFormat: CALL STACK,Example: A card has been read. The sum of <strong>the</strong> four-digit numbers in columns 10-13and 20-23 is punched in columns 1-5. If <strong>the</strong> sum is negative, <strong>the</strong> card should be selectedinto <strong>the</strong> alternate stacker. A program to solve <strong>the</strong> problem follows:Errors: NoneFORTRAN Statement1 FORMAT(9X,I4,6X,I4)2 FORMAT(I5)10=23 READ(10,1)I1,I213=11+12IF(13)4,5,54 CALL STACK5 WRITE (10,2)13GO TO 3ENDMeaningDescription of <strong>the</strong> input data.Description of <strong>the</strong> output data.Input unit number.Input statement.Sum.Is <strong>the</strong> sum negative?Yes — select <strong>the</strong> card.No — punch.Process <strong>the</strong> next card.ADDA1A3A1DECA3A1Function: Selects <strong>the</strong> alternate stacker on <strong>the</strong> <strong>IBM</strong> 1442, Model 6 or 7, only for <strong>the</strong> next CARRYcard to go through <strong>the</strong> punch station. More detailed information may be found DECA1in <strong>the</strong> STACK flowchart and listing. DIVRemarks: If <strong>the</strong> card reader is in a not-ready state (last card) and <strong>the</strong> card just read isto be stacker-selected, <strong>the</strong> card reader will not accept <strong>the</strong> stacker select command. Theuser should place a blank card after <strong>the</strong> card designating last card to his program. Thiswill prevent <strong>the</strong> card reader from becoming not ready and will allow <strong>the</strong> card to bestacker-selected.DPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIP'41•' STACKSUBS1403TYPERUNPACWHOLE


ADD SUBA1A3AlDEC Format: CALL SUB(JCARD,J,JLAST,KCARD,K,KLAST,NER)A3A1CARRY Function: Subtracts one arbitrary-length decimal data field from ano<strong>the</strong>r arbitrary-DECA1 length decimal data field, placing <strong>the</strong> result in <strong>the</strong> second data field.DIVDPACK Parameter description:DUNPKEDIT JCARD - The name of a one-dimensional integer array defined in a DIMENSIONFILL statement. This is <strong>the</strong> array that is subtracted, <strong>the</strong> subtrahend. TheGET data must be stored in JCARD in decimal format, one digit per word.ICOMPIOND J - An integer constant, an integer expression, or an integer variable. ThisKEYBD is <strong>the</strong> position of <strong>the</strong> first digit to be subtracted (<strong>the</strong> left-hand end of aMOVE field).MPYNCOMP JLAST - An integer constant, an integer expression, or an integer variable,NSIGN greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last digit to beNZONE subtracted (<strong>the</strong> right-hand end of a field).PACKPRINT KCARD - The name of a one-dimensional integer array defined in a DIMENSIONPUNCH statement. This array, <strong>the</strong> minuend, is subtracted from, and will con-PUT tain <strong>the</strong> result in decimal format, one digit per word.P1403P1442 K - An integer constant, an integer expression, or an integer variable. ThisREAD is <strong>the</strong> position of <strong>the</strong> first digit of KCARD (<strong>the</strong> left-hand end of <strong>the</strong> field).R2501SKIP KLAST - An integer constant, an integer expression, or an integer variable,STACK greater than or equal to K. This is <strong>the</strong> position of <strong>the</strong> last character ofSUB -4- KCARD (<strong>the</strong> right-hand end of a field).S1403TYPER NER - An integer variable. Upon completion of <strong>the</strong> subroutine, this variableUNPAC will indicate whe<strong>the</strong>r arithmetic overflow occurred.WHOLEDetailed description: The sign of <strong>the</strong> JCARD field is reversed and <strong>the</strong>n <strong>the</strong> JCARD andKCARD fields are ADDed using <strong>the</strong> ADD subroutine. More detailed information may befound in <strong>the</strong> SUB flowchart and listing.


Example: DIMENSION IGRND(12), ITEM(6)Before:N=0CALL SUB(ITEM,1,6,IGRND,1,12,N)IGRND 000713665203 ITEM 102342it t itPosition 1 5 10 Position 1 5After:N=0IGRND 000713767545 ITEM is unchanged.Position 1 5 10N=0The numeric data field ITEM, in decimal format, is SUBtracted from <strong>the</strong> numeric datafield IGRND, also in decimal format. Note that <strong>the</strong> fields are both right-justified. Inthis case, since <strong>the</strong> ITEM field is negative, and <strong>the</strong> operation to be performed is subtraction,<strong>the</strong> ITEM field is added to <strong>the</strong> IGRND field. The error indicator, N, is <strong>the</strong>same, since <strong>the</strong>re is no overflow out of <strong>the</strong> high-order digit, left-hand end, of <strong>the</strong>IGRND field.Errors: If <strong>the</strong> KCARD field is not large enough to contain <strong>the</strong> sum (that is, if <strong>the</strong>re is acarry out of <strong>the</strong> high-order digit), <strong>the</strong> error indicator, NER, will be set equal to KLAST.If <strong>the</strong> JCARD field is longer than <strong>the</strong> KCARD field, nothing will be done and <strong>the</strong> errorindicator will be equal to KLAST.Remarks: See <strong>the</strong> remarks for <strong>the</strong> ADD subroutine.


ADD 51403A1A3A1DECA3A1 Format: CALL S1403(N)CARRYDECA1 Function: Execute <strong>the</strong> requested control function on <strong>the</strong> <strong>IBM</strong> 1403 Printer, Model 6 orDIV 7, only.DPACKDUNPK Parameter description:EDITFILL N - An integer constant, an integer expression, or an integer variable. The valueGET of this variable corresponds to an available control function.ICOMPIOND Detailed description: If <strong>the</strong> printer is busy, <strong>the</strong> subroutine WAITs. O<strong>the</strong>rwise, or whenKEYBD <strong>the</strong> printer finishes, <strong>the</strong> routine executes <strong>the</strong> requested function and returns control toMOVE <strong>the</strong> calling program. The control functions and <strong>the</strong>ir values are as follows:MPYNCOMP Function ValueNSIGNN2ONEImmediate skip to channel 1 12544PACKPRINTImmediate skip to channel 2 12800PUNCHPUTImmediate skip to channel 3 13056P1403P1442 Immediate skip to channel 4 13312READR2501 Immediate skip to channel 5 13568SKIPSTACK Immediate skip to channel 6 13824SUBS1403 -4— Immediate skip to channel 7 14080TYPERUNPAC Immediate skip to channel 8 14336WHOLEImmediate skip to channel 9 14592Immediate skip to channel 10 14848Immediate skip to channel 11 15104Immediate skip to channel 12 15360Immediate space of 1 space 15616Immediate space of 2 spaces 15872Immediate space of 3 spaces 16128Suppress space after printing 0Normal spacing is one space after printing.


Example: NUMBR=12544CALL S1403(NUMBR)The carriage skips until a punch in channel 1 of <strong>the</strong> carriage control tape is encountered.(Normally this is at <strong>the</strong> top of a page.)Errors: Only <strong>the</strong> codes mentioned above can be used. The use of anything else will resultin ei<strong>the</strong>r no movement of <strong>the</strong> carriage or a WAIT at location 41 with 6xx1 in <strong>the</strong>accumulator (hex).Remarks: When space suppression after printing is executed, it is reset to single-spaceafter printing. If <strong>the</strong> user wishes to continue suppression, he must give <strong>the</strong> suppressioncommand again.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.This CSP subroutine uses three subprograms that are part of <strong>the</strong> Disk Monitor Version 2subroutine library. If 51403 is to be used with Version 1 of <strong>the</strong> Monitor, ZIPCO, EBPT3,and PRNT3 must be loaded onto <strong>the</strong> Version 1 disk cartridge.-85-I RN11.1,1,111111,,,IIIIIM111.1■1111110•■■


ADD TYPERA1A3A1DEC Format: CALL TYPER(JCARD,J,JLAST)A3A1CARRY Function: The typing on <strong>the</strong> console printer is initiated, and control is returned to <strong>the</strong>DECA1 user.DNDPACK Parameter description:DUNPKEDIT JCARD - The name of a one-dimensional integer array defined in a DIMENSIONFILL statement. This array contains <strong>the</strong> characters to be printed on <strong>the</strong> con-GET sole printer, in Al format, one character per word.ICOMPIOND J - An integer constant, an integer expression, or an integer variable. ThisKEYBD is <strong>the</strong> position of <strong>the</strong> first character of JCARD to be printed (<strong>the</strong> left-MOVE hand end of a field).MPYNCOMP JLAST - An integer constant, an integer variable, or an integer expression,NSIGN greater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last character ofNZONE JCARD to be printed (<strong>the</strong> right-hand end of a field).PACKPRINT Detailed description: The characters to be printed are converted from EBCDIC to con-PUNCH sole printer codes and are packed. Since <strong>the</strong> characters are taken in pairs, an evenPUT number of characters is required. If necessary, <strong>the</strong> character at JCARD(JLAST+1) willP1403 be used to get an even number. Then <strong>the</strong> print operation is started. While printing is inP1442 progress, control is returned to <strong>the</strong> user's program.READR2501 More detailed information may be found in <strong>the</strong> TYPER/KEYBD flowchart and listing.SKIPSTACK Example: DIMENSION IOTPT(120)SUBS1403CALL TYPER(IOTPT,1,120)TYPER .g.-UNPAC Before:WHOLEIOTPT QUANTITY. . . ITEM. . . PRICE. . . AMOUNTPosition 1 5 20 80 120After:IOTPT is <strong>the</strong> same. The line is being printed.The printing of <strong>the</strong> line, specified in IOTPT, is initiated on <strong>the</strong> console printer, and controlreturns to <strong>the</strong> user's program.


Errors: If a WAIT occurs at location 41, one of <strong>the</strong> following conditions exists:Condition Accumulator (hex)Console printer is not ready. 2xx0Make it ready and continue.Internal subroutine error. Rerunjob. If error persists, verifythat <strong>the</strong> subroutine deck is accurate,using <strong>the</strong> listing in this manual.If <strong>the</strong> deck is <strong>the</strong> same, contactyour local <strong>IBM</strong> representative.Save all output.2xxlIf JLAST is less than J, two characters will be printed. If more than 120 characters arespecified (JLAST-J+1 is greater than 120), only 120 characters will be printed.Remarks: The asterisked characters in Appendix D of <strong>IBM</strong> <strong>1130</strong> <strong>Subroutine</strong> Library(C26-5925) are legal. No o<strong>the</strong>r characters will be printed.If this subroutine is used, any o<strong>the</strong>r I/O must use commercial subroutines, with <strong>the</strong> exceptionof disk, which must always use FORTRAN I/O.Control functions can be used on <strong>the</strong> console printer. The following table indicates <strong>the</strong>available control functions and <strong>the</strong> decimal constant required for each function:FunctionDecimal constantTabulate 1344Shift to black 5184Carrier return 5440Backspace 5696Line feed 9536Shift to red 13632•The decimal constant corresponding to a particular function must be placed in <strong>the</strong> outputarea (JCARD). The function will take place when its position in <strong>the</strong> output area isprinted.


Example: JCARD(1)=5440JCARD(21)=1344JCARD(30)=5440JCARD(51)=5440JCARD (82)=5440CALL TYPER (JCARD,1,101)The above coding will carrier-return to a new line, <strong>the</strong>n print characters 2-20 of JCARD,tab to <strong>the</strong> next tab stop; print characters 22-29, carrier return, print characters 31-50,carrier return, print characters 52-81, carrier return, and finally print characters83-101.


UNPACFormat: CALL UNPAC(JCARD,J,JLAST,KCARD,K)Function: Information in A2 format, two characters per word, is UNPACked into Alformat, one character per word.Parameter description:JCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> input array, containing <strong>the</strong> data in A2 format,two characters per word.J - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first element of JCARD to be UNPACked (<strong>the</strong> lefthandend of a field).JLAST - An integer constant, an integer expression, or an integer variablegreater than or equal to J. This is <strong>the</strong> position of <strong>the</strong> last element ofJCARD to be UNPACked (<strong>the</strong> right-hand end of a field).KCARD - The name of a one-dimensional integer array defined in a DIMENSIONstatement. This is <strong>the</strong> array into which <strong>the</strong> data is UNPACked, in Alformat, one character per word.K - An integer constant, an integer expression, or an integer variable. Thisis <strong>the</strong> position of <strong>the</strong> first element of KCARD to receive <strong>the</strong> UNPACkedcharacters (<strong>the</strong> left-hand end of a field).Detailed description: The characters in <strong>the</strong> JCARD array (A2) are UNPACked left toright, starting with JCARD(J), and placed in <strong>the</strong> KCARD array (Al), starting withKCARD(K). Each element of JCARD, when UNPACked, will require two elements ofKCARD. More detailed information may be found in <strong>the</strong> PACK/UNPAC flowchart andlisting.ADDA 1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-89-!!! !!!!! i I! ! 1141 , 111 !"II III 1 1 1 1 111 Ru! Rp ! ! •ffIfifflf


Example: DIMENSION IUNPK(26),IPAKD(26)CALL UNPAC (IPAKD,1,13, IUNPK, 1)Before:IPAKD THISbINFORMATIONbWILLbUNPACKEDbbbbbbbbbbbbbbbbbbbbbbPosition 10 15 20 25IUNPK FblbLbLbbbIbNbbbTbHbIbSbbbAbRbEbAbbbbbbbbbbbbbbbbbbbPosition 1 5 10 15 20 25After:IPAKD is <strong>the</strong> same.IUNPK TbHblbSbbblbNbFbObRbMbAbTblbObNbbbWbibLbLbbbUbNbPbAbPosition 1 5 10 15 20 25Note that each two characters shown above represent one element of <strong>the</strong> array.Errors: NoneRemarks: If JLAST is less than or equal to J, only <strong>the</strong> first element of JCARD,JCARD(J)will be UNPACked into <strong>the</strong> first two elements of KCARD. An even number of characterswill always be UNPACked into KCARD. An equation for how much space is required, inelements, in KCARD isSpace in KCARD = 2 (JLAST-J+1)-90-IMF


WHOLEFormat: WHOLE (EXPRS)Function: Truncates <strong>the</strong> fractional portion of a real expression.Parameter description:EXPRS - A real expression. This is <strong>the</strong> expression that is truncated (<strong>the</strong> fractionalpart is made zero).Detailed description: The result of <strong>the</strong> expression is shifted right until <strong>the</strong> fractionalportion has been shifted off. Then <strong>the</strong> result is shifted left to give <strong>the</strong> original resultwith a zero fraction.Example: A=WHOLE(. 5)Before:After:A=0.0B=71234.99A=7123.000B=71234.99The expression, (. l*B+. 5), has been evaluated, and <strong>the</strong> fractional portion has been dropped.Errors: NoneRemarks: The argument, EXPRS, must always be a real expression. If <strong>the</strong> purpose isto simply truncate <strong>the</strong> fraction from a number A, <strong>the</strong> expression must be (1.0*A).If a single variable is used as an argument, <strong>the</strong> results of WHOLE are unpredictable.In o<strong>the</strong>r words, this will not work:A=WHOLE(B)ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPAC--0- WHOLE-91-


Note that <strong>the</strong> WHOLE function truncates <strong>the</strong> value of <strong>the</strong> argument or expression within<strong>the</strong> paren<strong>the</strong>ses; it does not round off before truncation. For this reason, <strong>the</strong> user mustbe careful when working with fractional numbers. For example, ifandX = 1570000.Y = WHOLE (X* .001)Y will equal 1569.000 ra<strong>the</strong>r than 1570.000. This occurs because <strong>the</strong> multiplication by.001 yielded 1569.999 ra<strong>the</strong>r than 1570.000.To avoid such a possibility, <strong>the</strong> argument for WHOLE should be half-adjusted by <strong>the</strong> user:Y = WHOLE (X*. 001+0.5)before it is sent to WHOLE to be truncated.


SAMPLE PROBLEMSPROBLEM 1This program has been written to exercise many of <strong>the</strong> routines. A card is read and acode on that card initiates <strong>the</strong> operation of <strong>the</strong> specified routine. The card image isprinted before execution of <strong>the</strong> routine, <strong>the</strong> resulting variable is printed and <strong>the</strong> cardimage is printed after execution of <strong>the</strong> routine.Switch settings are as follows:InputDeviceOutputDeviceSwitches0 1 21442 console printer down down down1442 1132 up down down- 1442 1403 up up down2501 console printer down down up2501 1132 up down up2501 1403 up up upMake sure that <strong>the</strong> switches are set properly before <strong>the</strong> program begins.After processing is completed, sample problem 1 will STOP with 1111 displayed in <strong>the</strong>accumulator. Press START to continue.A general purpose *IOCS card*IOCS(CARD,1132 PRINTER, TYPEWRITER)has been supplied with <strong>the</strong> sample problem. If this does not match <strong>the</strong> <strong>1130</strong> configurationto be used, a new *IOCS card will be required.-93-III . 11 III HI. ,m•p 111 10.111pH1111=11.0.MIN MUM


Sample Problem 1: Source Program// FOR CSP25940•• SAMPLE PROBLEM 1CSP25950• NAME SMPL1 CSP25960•10CSICARC1,1132 PRINTER,TYPEWRITER/CSP25970• ONE WORD INTEGIRS CSP25980• EXTENDED PRECISION C5P25990• LIST ALL CSP26000C-----GENERAL PURPOSE <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE TEST PROGRAM. CSP26010DIMENSION NCAR01801. NAMES15.13/CSP260201 FORMAT 180A11 CSP260302 FORMAT 1110. 4F10.0. F10.3) CSP260403 FORMAT 130HONOW TESTING <strong>1130</strong> CSP ROUTINE •5A1,16H WITH PARAMETERS,C5P26050X4F10.5, F10.3ICSP260604 FORMAT (13H CARD BEFORE•.80A11 CSP260705 FORMAT 113H CARD AFTER •,80A11 CSP260806 FORMATI1H .513.2X•12HCARD AFTER • .1X.80A11 CSP260907 FORMAT(1140.4XolOHINDICATORSOX.12HCARD BEFORE••1X.80A11 CSP261008 FORMAT (10H ANSWER IS, F20.31 CSP26110C-----DEFINE UNIT NUMBERS OF I/O DEVICES.CSP26120CALL DATSW(04,N)CSP26130CALL DATSW(114/CSP26140CALL DATSW(2101.1CSP26150NREAD•61111/0+2CSP26160NWRIT•21111/14)+2*(1/M1+1CSP26170READ (NREA0,11 NAMESCSP2618010 READ (NREAD,21 N. Vlo V2• V3o V4, VAR CSP26190IF (NI 98,98,99CSP2620098 STOP 1111 CSP2621099 WRITE INWRIT.31 INAMES(1•41. 1.1.51• Vlo V2. V3. V4o VAR CSP26220N1•//1CSP26230N2•1/2CSP26240N3•Y3CSP26250N4.1/4CSP26260NVAR•VARCSP26270NER1•0CSP26280NER2•0CSP26290NER300CSP26300NER4.0CSP26310NER5n0CSP26320READ (NREADol/ NCARDCSP26330IF(N-71 2162142CSP2634021 WRITE(NWRIT,41 NCARD CSP26350C-----GO TO <strong>1130</strong> CSP ROUTINECSP26360GO TO (11.12013.14.15.160171. NCSP26370C-----COMP ROUTINECSP2638011 ANS.NCOMPINCARD,N1.N2eNCARDIN31 C5P26390GO TO 19CSP26400C-----MOVE ROUTINECSP2641012 CALL MOVE(NCARDoN1•N2oNCARDoN3) CSP26420GO TO 20CSP26430C .... NZONE ROUTINE CSP2644013 CALL N2ONEINCARD.NleN2oN31 CSP26450ANS.N3CSP26460GO TO 19CSP26470C-----EDIT ROUTINECSP2648014 CALL EDITINCARD.N1•N2oNCARDIN3oN41 CSP26490-94-


111 um 11IPMEMCPIPIPP111111.11 11111SAMPLE PROBLEM 1 PAGE 02GO TO 20CSP26500C-----GET ROUTINECSP2651015 ANS•GETINCARD01.142013) CSP26520GO TO 19CSP26530C-----PUT ROUTINECSP2654016 CALL PUTINCARD01.142.VAR.V3.1441 CSP26550GO TO 20CSP26560C-----FILL ROUTINECSP2657017 CALL FILLINCARD.N1.N2IINVARI CSP26580GO TO 20CSP2659019 WRITE 1NWRIT.81 ANS CSP2660020 WRITE INWRIT.5/ NCARD CSP26610GO TO 10CSP2662022 WRITEINWRIT.7) NCARD CSP26630C A1DEC ROUTIIECSP26640CALL AlDECINCARDIN1.N2.NER1)CSP26650CALL AlDECINCARD•N3044.NER21CSP26660N.N..7CSP26670GO TO (23.24625.26.27.28)1ACSP26680C ADD ROUTINEC5P2669023 CALL ADDINCARD.N102.NCARD.N3.N4.NER31 CSP26700GO TO 29CSP26710C SUB ROUTINECSP2672024 CALL SUBINCARD0102.NCARD.N3.N4.NER3) CSP26730GO TO 29CSP26740C MPY ROUTINECS02675025 CALL MPYINCARD.N102.NCARD.N3.N4.NER3) CSP26760GO TO 29CSP26770C DIV ROUTINECSP2678026 CALL DIVINCARD.NloN2.NCARD IoN3.N4.NER31 CSP26790GO TO 29CSP26800C ICOMP ROUTINECSP2681027 NER3•1COMPCNCARD.NI.N2oNCARD.N3oN4/ CSP26820GO TO 29CSP26830C NSIGN ROUTINECSP2684028 CALL NSIGNINCARD.N1OVAR.NER31 CSP26850C.....DECA1 ROUTINECSP2686029 CALL DECAlINCARD.NloN2oNER41 CSP26870IFIN..31 33.32.30CSP2688030 IFIN..41 33.31.33 CSP2689031 JSPAN.N2..N1 CSP26900KSPAN.N4-N3CSP26910KSTRT.N3. JSPAN .. 1CSP26920N3-N4-JSPANCSP26930CALL DECAlINCARD.KSTRT,N3 . 111NER5/CSP26940GO TO 33CSP2695032 N3•N3•N2+N1.1 CSP2696033 CALL DECAlINCARD.N3.N4oNER5I CSP26970WRITE(NWRIT.61 NERIoNER2.NER3.NER4.NER5.NCARD CSP26980GO TO 10CSP26990ENDCSP27000VARIABLE ALLOCATIONSVI .0000 V2 .0003 V3 •0006 V4 .0009 VAR .000C ANS .000F NCARD.0064 NAMES-00A5 N •00A6 M .00A7L -00A8 NREAD.00A9 NWRIT•00AA I •00A8 N1 .00AC N2 -GOAD N3 •00AE N4 • 00AF NVAR .0080 NER1 •0081NER2 .0082 NER3 .0083 NER4 •0084 NER5 .0085 JSPAN.0086 KSPAN.0087 KSTRT-0088STATEMENT ALLOCATIONS1 .00C4 2 •0007 3 •OOCC 4 .00E8 5 .00F6 6 .0101 7 .0111 8 .0126 10 .0177 98 .018A99 .018C 21 .01E8 11 .O1FA 12 •0206 13 •020F 14 .021C 15 •0226 16 .0230 17 .023A 19 .024220 .0248 22 .0251 23 •0274 24 .027F 25 .028A 26 .0295 27 •02A0 28 •02AC 29 .0282 30 •02C031 •02C6 32 .02EE 33 .008FEATURES SUPPORTEDONE WORD INTEGERSEXTENDED PRECISIONIOCSCALLED SUBPROGRAMSDATSW NCOMP MOVE NZONE EDIT GET PUT FILL A1DEC ADD SUB MPY DIV ICUMP NSIGNDECA1 ELD ESTO IFIX FLOAT WRTYZ SRED SWRT SCOMP SFIO SIOAI SIQIX 510F 6101 SUBSCSTOP CAROL PRNTZINTEGER CONSTANTS0•008A 1.0088 2•008C 6.0080 1111.008E 5.008F 7.0000 3•00C1 4.00C2 4369.00C3CORE REQUIREMENTS FOR SMPL1COMMON 0 VARIA130:6 186 PROGRAM 600END OF COMPILATION-95-' -SPY fff gArgrultunwr,wrrprrpro ,r "P' I I PI I, 1■■ I ∎


Sample Problem 1: Output// KEG C5P27010NOW TESTING <strong>1130</strong> CSP ROUTINE NCOMP WITH PARAMETERS 1.00000 10.00000 11.00000 0.00000 0.000CARD BEFORE•ABCDEFGHIJKLMNOPORST2C5P27040ANSWER IS -272.000CARD AFTER 6ABCDEFGHIJKLMNOPORST2CSP27040NOW TESTING <strong>1130</strong> CSP ROUTINE NCOMP WITH PARAMETERS 1.00000 10.00000 11.00000 0.00000 0.000CARD BEFORE•BC80 F BCBD F4CSP27060ANSWER IS 0.000CARD AFTER •BCBD F BCBD F4C5P27060NOW TESTING <strong>1130</strong> CSP ROUTINE NCOMP WITH PARAMETERS 20.00000 25.00000 30.00000 0.00000 0.000CARD BEFORE• JKLMN CBAFG6CSP27080ANSWER IS 224.000CARD AFTER • JKLMN CBAFG6CSP27080NOW TESTING <strong>1130</strong> CSP ROUTINE MOVE WITH PARAMETERS 1.00000 5.00000 20.00000 0.00000 0.000CARD BEFORE•ABCDEBCSP27100CARD AFTER 6ABCDE ASCU8CSP27100NOW TESTING <strong>1130</strong> CSP ROUTINE MOVE WITH PARAMETERS 40.00000 49.00000 1.00000 0.00000 0.000CARD BEFORE. 9876543210 10CSP27120CARD AFTER .9876543210 9876543210 10CSP27120NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 10.00000 5.00000 0.00000 0.00000 0.000CARD BEFORE. A12CSP27140ANSWER IS 1.000CARD AFTER • A12CSP27140NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 10.00000 5.00000 0.00000 0.00000 0.000CARD BEFORE. I14CSP27160ANSWER IS 1.000CARD AFTER • I14CSP27160NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 20.00000 5.00000 0.00000 0.00000 0.000CARD BEFORE. 016CSP27180ANSWER IS 4.000 0CARD AFTER •16CSP271110NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 20.00000 5.00000 0.00000 0.00000 0.000CARD BEFORE. 918CSP27200ANSWER IS 4.000 9CARD AFTER •18CSP27200NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 30.00000 5.00000 0.00000 0.00000 0.000CARD BEFORE. .1 20CSP27220ANSWER IS 2.000CARD AFTER • J 20CSP27220NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 30.00000 5.00000 0.00000 0.00000 0.000CARD BEFORE. R 22CSP27240ANSWER IS 2.000CARD AFTER • R 22CSP27240NOW TESTING <strong>1130</strong> CSP ROUTINE NZONE WITH PARAMETERS 10.00000 1.00000 0.00000 0.00000 0.000CARD BEFORE. A24CSP27260ANSWER IS 1.000-96-


CARD AFTER •1234567NOW TESTING <strong>1130</strong> CSP ROUTINE EDIT WITH PARAMETERSCARD BEFORE•00005MCRCARD AFTER .00005M00.54CR1.00000 6.00000 10.0000048C5P2750030.00000 0.00050CSP2752050CSP27520NOW TESTING <strong>1130</strong> CSP ROUTINECARD BEFORE. 5MCARD AFTER • 5MEDIT WITH PARAMETERS.0 • •1.00000 6.00000 20.0000029.00000 0.00052C5P2754052C5P27540NOW TESTING <strong>1130</strong> CSP ROUTINE GETCARD BEFORE•12345ANSWER IS 123.449CARD AFTER •12345WITH PARAMETERS1.00000 5.00000 0.010000.00000 0.00054C5P2756054C5P27560NOW TESTING <strong>1130</strong> CSP ROUTINE GETCARD BEFORE•1234NANSWER IS -123.449CARD AFTER .1234NWITH PARAMETERS1.00000 5.00000 0.010000.00000 0.00056C5P2758056C5P27580NOW TESTING <strong>1130</strong> CSP ROUTINE GETCARD BEFORE.1 3 5 7ANSWER IS 1010.506CARD AFTER •1 3 5 7WITH PARAMETERS1.00000 7.00000 0.001000.00000 0.00058C5P276005BC5P27600NOW TESTING <strong>1130</strong> CSP ROUTINE GETCARD BEFORE•12AB4ANSWER IS 0.000CARD AFTER .12AB4WITH PARAMETERS1.00000 5.00000 1.000000.00000 0.0006005P276206005P27620NOW TESTING <strong>1130</strong> CSP ROUTINE GETCARD BEFORE•1230•ANSWER IS -12300.000CARD AFTER .1230•WITH PARAMETERS1.00000 5.00000 1.000000.00000 0.00062C5P2764062C5P27640NOW TESTING <strong>1130</strong> CSP ROUTINE GETCARD BEFORE.425ANSWER IS 0.001CARD AFTER .123WITH PARAMETERS1.00000 3.00000 0.000010.00000 0.00064C5P2766064C5P27660NOW TESTING <strong>1130</strong> CSP ROUTINE PUTCARD BEFORE.CARD AFTER .12345WITH PARAMETERS1.00000 5.00000 0.500000.00000 12345.00066CSP2768066C5P27680NOW TESTING <strong>1130</strong> CSP ROUTINE PUTCARD BEFORE.CARD AFTER .89WITH PARAMETERS1.00000 2.00000 5.000001.00000 12890.00068C5P2770068CSP27700NOW TESTING <strong>1130</strong> CSP ROUTINE PUTCARD BEFORE.CARD AFTER • 01235WITH PARAMETERS11.00000 15.00000 5.000001.00000 12345.00070CSP277207005P27720NOW TESTING <strong>1130</strong> CSP ROUTINE PUTCARD BEFORE.CARD AFTER • 0000340WITH PARAMETERS10.00000 16.00000 50.000002.00000-34567.00072C5P2774072CSP27740NOW TESTING <strong>1130</strong> CSP ROUTINE PUTWITH PARAMETERS10.00000 17.00000 5.000001.00000 -16.000CARD AFTER • A24C5P27260NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE• 1ANSWER IS 4.000CARD AFTER • AWITHPARAMETERS10.00000 1.00000 0.000000.00000 0.00026CSP2728026CSP27280NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE.ANSWER IS 2.000CARD AFTER • AWITHPARAMETERS10.00000 1.00000 0.000000.00000 0.00028C5P2730028CSP27300NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE.ANSWER IS 1.000CARD AFTER • 9WITH PARAMETERS20.00000 4.00000 0.000000.00000 0.0003005P2732030CSP27320NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE. 9ANSWER 15 4.000CARD AFTER •WITH PARAMETERS20.00000 2.00000 0.000000.00000 U.00032C5P2734032C5P27340NOW TESTING <strong>1130</strong> CSP ROUTINECARD BEFORE.ANSWER IS 2.000CARD AFTER •NZONERWITH PARAMETERS20.00000 3.00000 0.000000.00000 0.00034CSP2736034CSP27360NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE.ANSWER IS 1.000CARO AFTER •WITHPARAMETERSDU30.00000 3.00000 0.000000.00000 0.00036C5P2738036C5P27380NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE.ANSWER. IS 4.000CARD AFTER •WITHPARAMETERS430.00000 2.00000 0.000000.00000 0.00038C5P2740038CSP27400NOW TESTING <strong>1130</strong> CSP ROUTINE NZONECARD BEFORE.ANSWER IS 2.000CARD AFTER •WITHPARAMETERSM430.00000 4.00000 0.000000.00000 0.0004005P274204005P27420NOW TESTING <strong>1130</strong> CSP ROUTINE EDIT WITH PARAMETERS 1.00000 6.00000 20.00000 30.00000 0.000CARD BEFORE•123456 o S. CR 42CSP27440CARD AFTER :123456 11,234.56 42C5P27440NOW TESTING <strong>1130</strong> CSP ROUTINE EDIT WITH PARAMETERS 1.00000 6.00000 20.00000 30.00000 0.000CARD BEFORE•02343K o S. CR 44C5P27460CARD AFTER •02343K 1234.32CR 44C5P27460NOW TESTING <strong>1130</strong> CSP ROUTINE EDIT WITH PARAMETERS 1.00000 6.00000 20.00000 29.00000 0.000CARD BEFORE.00343 • S. • 46C5P27480CARD AFTER 000343.. S34.30• 46C5P27480NOW TESTING <strong>1130</strong> CSP ROUTINE EDIT WITH PARAMETERS 1.00000 7.00000 21.00000 28.00000 0.000CARD BEFORE.1234567 • S• 48C5P27500■■■•■■=■••• .1111.11 •PRiel.Re MR MR .91RI 1 .111141.,-97-


-ARD BEFORE.74CSP27760CARD AFTER • 0000000K 74CSP27760NOW TESTING <strong>1130</strong> CSP ROUTINE FILL WITH PARAMETERS 1.00000 10.00000 0.00000 0.00000 16440.000CARD BEFORE.ABCDE FGHIJK76CSP27780CARD AFTER • K 76CSP27780NOW TESTING <strong>1130</strong> CSP ROUTINE FILL WITH PARAMETERS 20.00000 25.00000 0.00000 0.00000 23360.000CARD BEFORE. ABCDEFGH 78CSP27800CARD AFTER - ASSSSSSH 78C5P27800NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 24 2048 C5P27820O 0 0 0 0 CARD AFTER • 00024 02072 C5P27020NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 24 2048 CSP27840O 0 0 0 0 CARD AFTER 2 00024 02024 CSP2704UNOW TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 24 2048 C5P27260O 0 0 0 0 CARD AFTER • 00024 U000048992 C4P27860NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 24 2048 CSP27680O 0 0 0 0 CARD AFTER • 00024 0008500008 C5P27880NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 24 2048 CSP27900O 0 0 0 CARD A • TER • 00024 02048 CSP27900NOW TESTING <strong>1130</strong> CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 1.000INDICATORS CARD BEFORE- 65 CSP27920O 0 1 0 0 CARD AFTER • 65 CSP27920NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERS 31.00000 35.00000 66.00000 70.1)0000 0.000INDICATORS CARD BEFORE- 99 2048 CSP279400 0 0 0 0 CARD AFTER - 00099 02147 CSP27940NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 99 2048 C5P27960O 0 0 0 0 CARD AFTER • 00099 01949 CSP27960NOW TESTING <strong>1130</strong> CAP ROUTINE MPY WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORS CARD BEFORE. 99 2048 CSP27980O 0 0 0 0 CARD AFTER 2 00099 U000202392 C5P27980NOW TESTING <strong>1130</strong>CSP ROUTINE DIV WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 99CARD AFTER • 000992048 C5P280000002000068 CSP28000NOW TESTING <strong>1130</strong>CSP ROUTINE ICOMP WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000INDICATORSO 0 -9 0 0CARD BEFORE. 99CARD AFTER • 000992048 CSP2802002048 CSP28020NOW TESTING <strong>1130</strong>INDICATORSO 0 1 0 0NOW TESTING <strong>1130</strong>CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 -1.000CARD BEFORE. 54CARD AFTER • N4CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000CSP28040C5P28040INDICATORS CARD BUORE• 12345678901234567890 123456789012345678901234567890 CSP28060O 0 0 0 0 CARD AFTER 2 12345678901234567890 123456789024691357802449135780 CSP28060NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000INDICATORS CARD BEFORE• 12345678901234567890 123456789012345678901234567890 C5P28080O 0 0 0 0 CARD AFTER 12345678901234567890 123456789000000000000000000000 CSP28080NOW TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.10000 70.00000 0.000OINDICATORS CARD BEFORE. 12345678901234567890 123456789012345678901234567890 CSP281000 0 0 0 CARD AFTER • 1234567890123456789001234567908123456790812345679111111101111111110100 CSP28100NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 U.000OINDICATORS CARD BEFORE- 12345678901234567890 123456789012345678901234567890 C0P281200 0 0 0 CARD AFTER - 1234567890123456789000000000000000000001000000000000000000001234567890 CSP28120NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00100 41.10000 70.00000 0.000INDICATORS CARD BEFORE. 12345678901234567890 123456789012345678901234567890 CSP28140O 0 -1 0 0 CARD AFTER • 12345678901234567890 123456789012345678901234567890 C5P28140NOW TESTING <strong>1130</strong> CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 0.000INDICATORS CARD BEFORE. 32C5P28160O 0 1 0 0 CARD AFTER • L2 CSP28160NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.10000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789 .. 123456789012345678901234567890 CSP28180O 0 0 0 0 CARD AFTER 2 1234567890123456789- 123456789000000000000000000000 CSP28180NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.30000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789.. 123456789012345678901234567890 C5P28400O 0 0 0 0 CARD AFTER 1234567890123456789 123456789024691357802469135780 C5P28200NON TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000OINDICATORS CARD BEFORE. 1234567890123456189 .. 123456789012345678901234567890 C5P282200 0 0 0 CARD AFTER • 1234567890123456789■0123456790812345679081234567911111110111111111010m C5P28220NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000OINDICATORS CARD BEFORE. 1234567890123456789 .. 123456789012345678901234567890 CSP282400 0 0 0 CARD AFTER - 1234567890123456789 ■00000000000000000001000000000 .■ 00000000001234567890 C5P28240NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000-98-


INDICATORS CARD BEFORE. 1234567890123456789 .. 123456789012345678901234567890 CSP28260O 0 0 0 CARD AFTER • 1234567890123456789 .. 123456789012345678901234567890 CSP28260NOW TESTING <strong>1130</strong> CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 1.000INDICATORS CARD BEFORE. ONCSP28280O 0 -1 0 0 CARD AFTER • 6N CSP28280NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000INDICATORS CARD BEFORE. 12345678901234567890 12345678901234567890123456789.. CSP28300O 0 0 0 0 CARD AFTER • 12345678901234567890 12345678900000000000000000000.. CSP28300NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000INDICATORS CARD BEFORE. 12345678901234567890 12345678901234567890123456789 .. CSP28320O 0 0 0 0 CARD AFTER • 12345678901234567890 12345678902469135780246913578 ., CSP28320NOW TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000INDICATORS CARD BEFORE. 12345678901234567890 12345678901234567890123456789-O 0 0 0 0 CARD AFTER • 123456789012345678900123456790812345679081234567911111110111111111010..CSP 28340C5P28340NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000OINDICATORS CARD BEFORE. 12345678901234567890 12345678901234567890123456789-0 0 0 0 CARD AFTER • 1234567890123456789000000000000000000001000000000■0000000000123456789..CSP28360C5P28360NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERSINDICATORS CARD BEFORE. 12345678901234567890O 0 0 0 0 CARD AFTER • 12345678901234567890NOW TESTING <strong>1130</strong> CSP ROUTINE NSIGN WITH PARAMETERS1.00000 20.00000 41.00000 70.00000 0.00012345678901234567890123456789 .. CSP2838012345678901234567890123456789 .. CSP283801.00000 1.00000 2.00000 2.00000 -1.000OINDICATORS CARD BEFORE. NM0 -1 0 0 CARD AFTER • NMCSP28400CSP28400NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERSINDICATORS CARD BEFORE. 1234567890123456789 -O 0 0 0 0 CARD AFTER • 1234567890123456789..NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERSINDICATORS CARD BEFORE. 1234567890123456789-O 0 0 0 0 CARD AFTER • 1234567890123456789..NOW TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS1.00000 20.00000 41.00000 70.00000 0.00012345678901234567890123456789 .. CSP2842012345678902469135780246913578 CSP284201.00000 20.00000 41.00000 70.00000 0.00012345678901234567890123456789 .. CSP2844012345678900000000000000000000 .. CSP284401.00000 20.00000 41.00000 70.00000 0.000ONOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789..12345678901234567890123456789 .. CSP28480O0 0 0 0 CARD AFTER • 1234567890123456789 .. 0000000000000000000100000000000000000000123456789 . CSP28480NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000INDICATORSO 0 0 0 0NOW TESTING <strong>1130</strong>CARD BEFORE. 1234567890123456789CARD AFTER • 1234567890123456789..CSP ROUTINE NSIGN WITH PARAMETERS12345678901234567890123456789- CSP2850012345678901234567890123456789 CSP285001.00000 1.00000 2.00000 2.00000 0.000INDICATORSO 0 -1 0 0CARD BEFORE. MLCARD AFTER 4LC5P28520CSP28520NOW TESTING <strong>1130</strong>CSP ROUTINE ADD WITH PARAMETERS1.00000 20.00000 51.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 12345678901234567890CARD AFTER • 1234567890123456789012345678901234567890 CSP2854024691357802469135780 CSP28540NOW TESTING <strong>1130</strong>CSP ROUTINE SUB WITH PARAMETERS1.00000 20.00000 51.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 12345678901234567890CARD AFTER • 1234567890123456789012345678901234567890 CSP2856000000000000000000000 CSP28560NOW TESTING <strong>1130</strong>CSP ROUTINE MPY WITH PARAMETERS1.00000 20.00000 51.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 12345678901234567890CARD AFTER • 1234567890123456789012345678901234567890 CSP285800123456790812345679111111101111111110100 CSP28580NOW TESTING <strong>1130</strong>CSP ROUTINE DIV WITH PARAMETERS1.00000 20.00000 51.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 12345678901234567890CARD AFTER • 1234567890123456789012345678901234567890 CSP286000000000000000000000100000000000000000000 CSP28600NOW TESTING <strong>1130</strong>CSP ROUTINE ICOMP WITH PARAMETERS1.00000 20.00000 51.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 12345678901234567890CARD AFTER • 1234567890123456789012345678901234567890 CSP2862012345678901234567890 CSP28620NOW TESTING <strong>1130</strong>CSP ROUTINE NSIGN WITH PARAMETERS1.00000 1.00000 2.00000 2.00000 1.000INDICATORSO 0 0 0CARD BEFORE. -0CARD AFTER • 00CSP28640CSP28640NOW TESTING <strong>1130</strong>CSP ROUTINE ADD WITH PARAMETERS1.00000 20.00000 51.00000 70.00000 0.000INDICATORSO 0 0 0 0CARD BEFORE. 1234567890123456789CARD AFTER • 1234567890123456789..12345678901234567890 CSP2866000000000000000000000 CSP28660NOW TESTING <strong>1130</strong>INDICATORSO 0 0 0 0NOW TESTING <strong>1130</strong>INDICATORSO 0 0 0 0CSP ROUTINE SUB WITH PARAMETERSCARD BEFORE. 1234567890123456789CARD AFTER • 1234567890123456789■CSP ROUTINE MPY WITH PARAMETERSCARD BEFORE. 1234567890123456789CARD AFTER • 1234567890123456789..1.00000 20.00000 51.00000 70.00000 0.00012345678901234567890 CSP2868024691357802469135780 CSP286801. 00000 20.00000 51.00000 70.00000 0.00012345678901234567890 CSP28700012345679081234567911111110111111111010 . CSP28700INDICATORS CARD BEFORE. 1234567890123456789-12345678901234567890123456789 .. CSP284600 0 0 0 CARD AFTER 1234567890123456789■ O1234567908123456790812345679111111101111111110100 CSP28460-99-II FYI Mill111111•11111111P 101 10 I III MP imipqmpipmcapriminquimilimiipiiimoomummimorimcmcn. IIllllll p l ummum II 11111 HI.


NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789-12345678901234567890 CSP287200 0 0 0 0 CARD AFTER • 1234567890123456789.. 0000000000000000000J00000000000000000000 CSP28720NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE- 1234567890123456789-12345678901234567890 CSP287400 0••• 0 0 CARD AFTER • 1234567890123456789■ 12345678901234567890 CSP28740NOW TESTING <strong>1130</strong> CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 -1.000INDICATORS CARD BEFORE. 0C5P287600 0 0 0 CARD AFTER • -0 CSP28760NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 123456789012345678901234567890123456789■ CSP287800 0 0 0 0 CARD AFTER • 12345678901234567890 0000000000000000000* CSP28780NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 123456789012345678901234567890123456789- CSP288000 0 0 0 0 CARD AFTER • 12345678901234567890 2469135780246913578 .. CSP28800NOW TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 123456789012345678901234567890123456789 .. CSP288200 0 0 0 0 CARD AFTER • 12345678901234567890 01234567908123456791111/110111111111010- CSP28820NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 123456789012345678901234567890123456789 .. CSP288400 0 0 0 0 CARD AFTER • 12345678901234567890 0000000000000000000J0000000000000000000 CSP28840NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 123456789012345678901234567890123456789- CSP288600 0••• 0 0 CARD AFTER • 12345678901234567890 1234567890123456789 C5P28860NOW TESTING <strong>1130</strong> CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 0.000INDICATORS CARD BEFORE. -0CSP288800 0 0 0 CARD A. TER • 00 CSP28880NOW TESTING <strong>1130</strong> CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789-1234567890123456789 .. CSP289000 0 0 0 0 CARD AFTER • 1234567890123456789.. 2469135780246913578- C5P28900NOW TESTING <strong>1130</strong> CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789-1234567890123456789 .. CSP289200 0 0 0 0 CARD AFTER • 1234567890123456789.. 0000000000000000000 .. CSP28920NOW TESTING <strong>1130</strong> CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789..1234567890123456789 .. CSP289400 0 0 0 0 CARD AFTER • 1234567890123456789- 0123456790812345679111111101111111110100 C5P28940NOW TESTING <strong>1130</strong> CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 1234567890123456789-1234567890123456789- CSP289600 0 0 0 0 CARD AFTER • 1234567890123456789 000000000000000000U10UU0000000000000000 .. CSP28960NOW TESTING <strong>1130</strong> CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000INDICATORS CARD BEFORE. 12345678901234567891234567890123456789 .. CSP289800 0 0 0 0 CARD AFTER • 1234567890123456789- 1234567890123456789 .. CSP28980-100-


Sample Problem 1: Data Input Listing// XEONCOMPMOVE N2ONEEDIT GET1 1ABCDEFGMIJKLMNOPORSTPUT FILL ADD SUB MPY DIV ICOMPNSIGN10 11C5P27010CSP27020105P270302CSP270401 1 10 11 3C5P27050BC8D F BCBD F 4C5P270601 20 25 30 5C5P27070JKLMN CBAFG 6C5P270802 1 5 20 7CSP27090ABCDE8C5P271002 40 49 1 9C5P271109876543210 1005P271203 10 5 11CSP27130A12C5P271403 10 5 13CSP27150I14C5P271603 20 5 15C5P271700 16C5P271803 20 5 17C5P271909 18CSP272003 30 5 19CSP27210J20CSP272203 30 5 21CSP27230R22C5P272403 10 1 23C5P27250A24C5P272603 10 1 25CSP272701 26C5P272803 10 1 27CSP27290J28C5P273003 20 4 29C5P27310I30CSP273203 20 2 31CSP273309 32C5P273403 20 3 33CSP27350R34CSP273603 30 3 35C5P27370D36C5P273803 30 2 37CSP273904 38CSP274003 30 4 39C5P27410/4 40CSP274204 1 6 20 30 41CSP27430123456 • S. CR 42CSP274404 1 6 20 30 43CSP2745002343K • S. CR 44CSP274604 1 6 20 29 45CSP2747000343 — • Se 46CSP274804 1 7 21 28 47CSP274901234567 • S. 48CSP275004 1 6 10 30 49C5P2751000005M ir4 • CR 5005P275204 1 6 20 29 5105P27530SM •0 • .. 52CSP275405 1 5 .01 53C5P2755012345 54CSP275605 1 5 .01 55C5P275701234N56C5P275805 1 7 .001 57CSP275901 3 5 7 58C5P27600-101-


5 1 5 1. 59CSP2761012A8460CSP276205 1 5 1. 6105P276301230- 62CSP276405 1 3 .00001 63C5P27650123 64CSP276606 1 5 0.5 0 12345. 65CSP2767066CSP276806 1 2 5.0 1 12890. 67C5P2769068C5P277006 11 15 5.0 1 12345. 69CSP2771070CSP277206 10 16 50.0 2 -34567. 71CSP2773072CSP277406 10 17 5.0 1 -16. 73CSP2775074CSP277607 1 10 16448. 75CSP27770ASCDEFGHIJK76CSP277807 20 25 23360. 77CSP27790ABCDEFGH78C5P2780008 31 35 66 70 CSP2781024 2048 C5P2782009 31 35 66 70 CSP2783024 2048 CSP2784010 31 35 66 70 CSP27115024 2048 C5P2786011 31 35 66 70 CSP2787024 2048 CSP2788012 31 35 66 70 C5P2789024 2048 CSP2790013 1 1 2 2 1. C5P2791065 CSP2792008 31 35 66 70 CSP2793099 2048 C5P2794009 31 35 66 70 CSP2795099 2048 CSP2796010 31 35 66 70 CSP2797099 2048 CSP2798011 31 35 66 70 CSP2799099 2048 CSP2800012 31 35 66 70 C592801099 2048 C592802013 1 1 2 2 -1. CSP2803054 0592804008 01 20 41 70 CSP2805012345678901234567890 123456789012345678901234567890 0592806009 01 20 41 70 0592807012345678901234567890 123456789012345678901234567890 CSP2808010 01 20 41 70 CSP2809012345678901234567890 123456789012345678901234567890 CSP2810011 01 20 41 70 CSP2811012345678901234567890 123456789012345678901234567890 0592812012 01 20 41 70 CSP2813012345678901234567890 123456789012345678901234567890 0592814013 1 1 2 2 0592815032 0592816008 01 20 41 70 05928170-102-


1234567890123456789 4123456789012345678901234567890 C5P2818009 01 20 41 70 C5P281901234567890123456789- 123456789012345678901234567890 CSP2820010 01 20 41 70 C5P282101234567890123456789- 123456789012345678901234567890 C5P2822011 01 20 41 70 C9P282301234567890123456789 .. 123456789012345678901234567890 CSP2824012 01 20 41 70 CSP282501234567890123456789 .. 123456789012345676901234567890 CSP2826013 1 1 2 2 1. CSP28270ONC5P2828008 01 20 41 70 C5P2829012345678901234567890 12345678901234567890123456789- CSP2830009 01 20 41 70 CSP2831012345678901234567890 12345678901234567890123456789- C5P2832010 01 20 41 70 CSP2833012345678901234567890 12345678901234567890123456789- CSP2834011 01 20 41 70 C5P2835012345678901234567890 12345678901234567890123456789- CSP2836012 01 20 41 70 C592837012345678901234567890 12345678901234567890123456789- C5P2838013 1 1 2 2 -1. C5P28390NMC592840008 01 20 41 70 CSP284101234567890123456789- 12345678901234567890123456789- CSP2842009 01 20 41 70 C59284301234567890123456789 412345678901234567890123456789- C5P2844010 01 20 41 70 CSP2845012345671390123456789 412345678901234567890123456789- 1592646011 01 20 41 70 CSP284701234567890123456789- 12345678901234567890123456789- C592840012 01 20 41 70 C5P284901234567890123456789 412345678901234567890123456789- C592850013 1 1 2 2 CSP28510MLCSP2852008 01 20 51 70 C5P2853012345678901234567890 12345678901234567890 C 592854009 01 20 51 70 CSP2855012345678901234567890 12345678901234567890 CSP2856010 01 20 51 70 CSP2857012345678901234567890 12345678901234567890 C5P2858011 01 20 51 70 C5P2859012345678901234567890 12345678901234567890 C5P2860012 01 20 51 70 CSP2861012345678901234567890 12345678901234567890 C5P2862013 1 1 2 2 1. C59211630-0 CSP2864008 01 20 51 70 C5P286501234567890123456'89-12345678901234567890 CSP2866009 01 20 51 70 C5P286701234567890123456789- 12345678901234567890 C5P2868010 01 20 51 70 C5P286901234567890123456789 412345678'901234567890 C5P2870011 01 20 51 70 C5P207101234567890123456789 412345670901234567890 CSP2872012 01 20 51 70 CSP287301234567890123456789412345678901234567890 CSP2874013 1 1 2 2 -1. C5P28750-0 C5P2876008 01 20 51 70 C592077012345678901234567890 1234567890123456789- CSP2878009 01 20 51 70 CSP2879012345678901234567890 1234567890123456789- C5P2880010 01 20 51 70 CSP2881012345678901234567890 12345678901234567894 C5P2882011 01 20 51 70 CSP2883012345678901234567890 12345678901234567894 CSP2884012 01 20 51 70 CSP2885012345678901234567890 1234567890123456789- CSP2886013 1 1 2 2 CSP28870-0 C592088008 01 20 51 70 C5P288901234567890123456789 41234567890123456789- C5P2890009 01 20 51 70 C5P289101234567890123456789- 1234567890123456789- C5P2892010 01 20 51 70 CSP289301234567890123456789- 12345678901234567894 C5P2894011 01 20 51 70 C59209501234567890123456789 41234567890123456789- C592E196012 01 20 51 70 C592139701234567890123456789- 1234567890123456789- C5P28980CSP28990-103-


PROBLEM 2The purpose of this program is to create invoices. The input deck is as follows:ISTOP New nameand balancemaster cardInput deckDetailed description of individual customer deckEach customer has <strong>the</strong> old master name and balance card, followed by <strong>the</strong> transactioncards, followed by a blank master name and balance card. The invoice is printed as in<strong>the</strong> example, and a new master name and balance card image is printed on <strong>the</strong> consoleprinter. Then <strong>the</strong> next customer is processed until <strong>the</strong> stop code card is reached(ISTOP in cc 1-5). In an actual situation <strong>the</strong> new card image would be punched andstacker-selected. Then, as input to <strong>the</strong> next run of <strong>the</strong> program, a new input deckwould have to be prepared.Switch settings are <strong>the</strong> same as for sample problem 1, except that output cannot bedirected toward <strong>the</strong> console printer.InputDeviceOutputDeviceSwitches0 1 21442 1132 up down down1442 1403 up up down2501 1132 up down up2501 1403 up up upMake sure that <strong>the</strong> switches are set properly before <strong>the</strong> program begins.After processing is completed, sample problem 2 will STOP with 0111 displayed in <strong>the</strong>accumulator. Press START to continue.Note: Sample Problem 2 cannot be executed if Version 1 of <strong>the</strong> Monitor is being used.-104-


Sample Problem 2: Detailed Description1. Read all constant information and determine output unit (1132 or 1403).2. Initialize error indicators.a. J=2b. I=0, L=0, M=03. Read <strong>the</strong> first card. It should be a master card.4. Is <strong>the</strong> card read in 3 <strong>the</strong> last card?No — 5 Yes — 645. Is <strong>the</strong> card read in 3 above a master card?No 72 Yes — 66. Go to <strong>the</strong> top of a new page.7. Clear <strong>the</strong> print area.8. Print <strong>the</strong> customer name.9. Move <strong>the</strong> edit mark to <strong>the</strong> work area.10. Edit <strong>the</strong> previous balance.11. Print <strong>the</strong> customer street address.12. Move <strong>the</strong> words PREVIOUS BALANCE to <strong>the</strong> print area.13. Move <strong>the</strong> work area to <strong>the</strong> print area.14. Print <strong>the</strong> customer city, state, and zip code.15. Skip 3 lines.16. Print <strong>the</strong> column headings.17. Print <strong>the</strong> print area.18. Clear <strong>the</strong> print area.19. Convert <strong>the</strong> previous balance from Al format to decimal format.


20. Is <strong>the</strong> conversion in 19 correct?No — 66 Yes — 2121. Set <strong>the</strong> total (ISUM) equal to <strong>the</strong> previous balance.22. Set up <strong>the</strong> output area for <strong>the</strong> new master card.23. Read a card.24. Is <strong>the</strong> card read at 23 <strong>the</strong> last card?No — 25 Yes — 6425. Is <strong>the</strong> card read at 23 a master card?No — 26 Yes — 5226. Is <strong>the</strong> card read at 23 a transaction card?No — 49 Yes — 2727. Is <strong>the</strong> card read at 23 for <strong>the</strong> same customer being processed?No — 49 Yes — 2828. Move <strong>the</strong> item name to <strong>the</strong> print area.29. Move <strong>the</strong> edit mask to <strong>the</strong> print area for dollar amount.30. Move <strong>the</strong> edit mask to <strong>the</strong> print area for quantity.31. Edit <strong>the</strong> quantity.32. Edit <strong>the</strong> dollar amount.33. Print <strong>the</strong> detail line assembled in 28 through 32.34. Has channel 12 on <strong>the</strong> carriage tape been encountered?No — 35 Yes — 4635. Convert <strong>the</strong> dollar amount from Al format to decimal format.36. Is <strong>the</strong> conversion in 35 correct?No — 40 Yes — 3737. Add <strong>the</strong> dollar amount to ISUM.


38. Did overflow occur in <strong>the</strong> addition in 37?No — 23 Yes — 3939. STOP and display 777.40. Make <strong>the</strong> character in error a digit.41. Try to convert only <strong>the</strong> character in error.42. Is <strong>the</strong> conversion in 41 correct?No — 43 Yes — 4443. STOP and display 666.44. Convert <strong>the</strong> entire field back to Al format.45. Go to 35.46. Go to <strong>the</strong> top of a new page.47. Print <strong>the</strong> headings.48. Go to 35.49. Type ERROR on <strong>the</strong> console printer.50. Type <strong>the</strong> card read on <strong>the</strong> console printer.51. Go to 23.52. Convert <strong>the</strong> total (ISUM) from decimal format to Al format.53. Is <strong>the</strong> conversion in 52 correct?No — 54 Yes — 5554. STOP and display 555.55. Clear <strong>the</strong> print area.56. Move <strong>the</strong> edit mask to <strong>the</strong> print area.57. Edit <strong>the</strong> total (ISUM).58. Place <strong>the</strong> unedited total (ISUM) in <strong>the</strong> new master card.59. Type <strong>the</strong> new master card image on <strong>the</strong> console printer.


60. Move <strong>the</strong> word TOTAL to <strong>the</strong> print area.61. Skip 2 lines.62. Print <strong>the</strong> print area, <strong>the</strong> total line.63. Go to 2b.64. Type END OF JOB.65. STOP and display 111.66. Make <strong>the</strong> character in error a digit.67. Try to convert only <strong>the</strong> character in error.68. Is <strong>the</strong> conversion in 67 correct?No — 69 Yes — 7069. STOP and display 444.70. Convert <strong>the</strong> entire field back to Al format.71. Go to 19.72. Type ERROR on <strong>the</strong> console printer.73. Type <strong>the</strong> card read on <strong>the</strong> console printer.74. Go to 2b.Card FormatsB B cM City 1 8 Carda Customer Name Street AddressState Balance a A a Seq.sZoneii n rNo.tii lie 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 3 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9r I 5 3 4 5I 11 1121112I3144111711IIN21222324252$27252123,132333435513735311154142434445454741415051$153545351575151110115213145$511111111707172737475/11777171032 BraCustomer Name Item Name TotalAmt.Qty. Blank J anIc8. 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9I 2 3 4 1 II 7 I II011121314151117I1131321222324152122211211233132233425313731311K41424344454474141505157535455555751512051$2531455N57510X71/2137415787175/110sPCardSeq.No.-108-


CHART 52 <strong>1130</strong> COMMERCIAL SAMPLE PROBLEM 2START• •• 83 •• •INITIALIZE • ••• READ HEADINGS •AND CONSTANTS••0..0• •• 02• READ A •CARD• •••••X......... ..• TYPE• YES .. ..END OF JOB X••LAST CARD ..• it. ...... ,....• NO• READ A •CARD• •••••X..... 4........•..4. • • • •.... NO .4. •.. TRANSACTION ..• TYPE NEW •X.. MASTER CARD... CARD ..X.. .1.MASTER CARD.. .. ..• IMAGE •.....0 0. .411•YES ..10X:X.... X X.. • IS 11...TRANSACTION.. NO •TYPE ERROR AND • PRINT ••.NAME EQUAL TO..... CARD IMAGE•. MASTER .. •TOTAL• LINE ••.NAME .....YESX• PRINT DETAIL •LINE• •ic00.0 041•B3 • • 02 • •*0.0 O...B .• e.NOHALTMASTER CARO• e.°. .• •••YES• T...•IS REPLACED BYTOTAL E AMT•• PRINT NAME •AND ADDRESS••TYPE ERROR AND • • PRINT HEADING •CARD IMAGE •.... AND PREVIOUS• • •CE BALAN •• •• 02 •• •XTOTALIS REPLACED BYPREVIOUS• BALANCE-109-IN• ,....••••••■•■• “IIERIMPREEIMIRIM


Sample Problem 2: Source Program// FOR CSP29000•• SAMPLE PROBLEM 2CSP29030• NAME SMPL2 CSP29020• LIST ALL CSP29030• ONE WORD INTEGIiS CSP29040• EXTENDED PRECISION CSP29050THE INPUT IS MADE UP OF A MASTER CARD FOLLOWED BY THE TRANSACTION CSP29060C CARDS FOR EACH CUSTOMER. WE WANT TO PRINT AN INVOICE AND PRINT A CSP29070C NEW MASTER CARD FOR EACH CUSTOMER.CSP29080DIMENSION INCRD(82)0LMASKI13/.1PRNTI791.10TCD(801.ISTOP(5). CSP29090IIHEADI801. IPRV81161.170715/1,IWK113).1SUMI8IIIEROR16/.IE0J1101 CSP29100CALL DATSW 12.N2)CSP29110CALL DATSW1103/CSP29120GO TO 128.21).N2CSP2913027 CALL READIIE0.1.1.10.J1 CSP29140CALL READIIEROR.1.6.JICSP29150CALL READIIMASK.1.13.J/CSP29160CALL READIIPRVB.1116.J/CSP29170CALL READIIHEAD.1.72.J)CSP29180CALL READIIMEAD.73.80.J/CSP29190CALL READ) ISTOP.1.5,11CSP29200CALL REAOIITOT.1.5.J)CSP29210GO TO 55CSP2922028 CALL R2501(1E0.1.1.1011J) CSP29230CALL R2501IIEROR.1.6,JICALL R2501IIMASK.1.13.JI:IP.2: :::CALL R2501IIPRV8.1.16.J/CSP29260CALL R2501IIHEAD.1,72.JICSP29270CALL R2501IIHEAD03.80.J)CSP29280CALL R2501(ISTOP.1.5.JICSP29290CALL R250111707.1.5.JICSP2930055 J•2 CSP29310INCRDI811.16448CSP29320INCRD(821.5440CSP293301 1.0 CSP29340L*0 CSP29350M*0 CSP29360GO TO )30.29/012CSP2937029 CALL READI INCRD.1.80.J1 CSP29380GO TO 59CSP2939030 CALL R25011INCRD.1.50,J/ CSP2940059 IFI./1/ 22.2.2 CSP294102 IFINCOMPIINCRD.1.5.ISTOP.11/ 3.22.3 CSP294203 CALL NZONEIINCRD.70.5A1 CSP29430IFIK ■ 1I 26,4,26CSP294404 GO TO 134.33/ 013 CSP2945033 CALL SKIP)12544) CSP29460GO TO 60CSP2947034 CALL S1403112544I CSP2948060 CALL FILLIIPRNT.1.79.16448/ CSP29490GO TO (36,35/.N3CSP2950035 CALL PRINTIINCRD.1.20.11 C5P29510GO TO 61CSP2952036 CALL P1403(INCR0.1.20.1I CSP2953061 CALL MOVEIIMASK.1.13.IWK.11 CSP29540CALL EDITIINCRD.61.68.IWK.1.131CSP29550-110-


SAMPLE PROBLEM 2 PAGE 02GO TO 138071.03CSP2956037 CALL PRINTIINCRD.21.40.11 CSP29570GO TO 62CSP2938038 CALL P14031INCRO.21.40.11 CSP2959062 CALL MOVEIIPRVB.1.16.1PRNT.23) CSP29600CALL MOVE(IMK.1.13111PRNT.67)CSP29610GO TO (41.39),N3CSP2962039 CALL PRINTIINCR0041.60.1) C5P29630CALL SKIPII6128)CSP29640CALL PRINTIIMEAD.1.80.11CSP29650CALL PRINTIIPRNT.I.79.11CSP29660GO TO 63C5P2967041 CALL P1403IINCRD.41.60.1) CSP29680CALL 514031161281CSP29690CALL P1403(IMEAD.1.00.1)CSP29700CALL P140311PRNT.1.79.11CSP2971063 CALL FILLIIPRNT.1.79.16440I CSP2972040 CALL AlDECIINCRO.61.68.0 CSP29730IFIL/ 5.5 0 23CSP297405 CALL MOVECINCRD.61.60.1SUM.11 CSP29750CALL MOVE(INCRD.1.80.10TCD.11CSP297606 GO TO (32.311.02 CSP2977031 CALL READIINCR0.1.80.J) CSP29780GO TO 64CSP2979032 CALL R2501(INCRD.1.80.J) CSP2980064 IFIJ.1) 22.7.7 CSP298107 CALL NZONE(INCR000115,K) CSP29820IFIP. 1) 18.19.8CSP290308 IFIK■2I 18,9.18 CSP290409 IFINCOMPIINCRD.1.20.10TC0.1)1 18,10.18 CSP2985010 CALL MOVEIINCRD.21.40.IPRNT.23) CSP29860CALL MOVEIIMASK.1.13.1PRNT.671CSP29870CALL MOVEIIMASK.3.8.1PRNT.71CSP29880IPRNTI121. ■4032CSP29890CALL EDITIINCRD.49.52.IPRNT.7.121CSP29900CALL EDITIINCR0.41.48.1PRNT.67.79)CSP29910GO T0149,48)0*CSP2992048 CALL PRINTIIPRNT.1.79.11 CSP29930GO TO 65CSP2994049 CALL P1403IIPRNT.1.79.11 CSP2995065 IFII.31 11.11.17 CSP2996011 CALL AlDECIINCR0.41.48.0 CSP29970WO 12.12.14CSP2990012 CALL ADDIINCRD,41.48.1SUM.1:8.M) CSP29990!FIN) 13.6.13 CSP3000013 CALL IOND CSP30010STOP 777CSP3002014 CALL NZONE(INCRD.L.4.011 CSP3003001 • 0 CSP30040CALL AlDECIINCRD.L.L.N1)CSP30050IFIN11 16.16.15CSP3006015 CALL IOND CSP30070STOP 666CSP3008016 CALL DECAIIINCRD.41.480LI CSP30090SAMPLE PROBLEM 2 PAGE 03L.0 CSP30100GO TO 11CSP3011017 GO TO (31.501.03 CSP3012050 CALL SK)P112544) CSP30130CALL PRINTIIMEAD.1.00.11CSP30140GO TO 66CSP3015051 CALL S1403112544) CSP30160CALL P1403IIMEA0.1.80.1)CSP3017066 1.0 CSP30180GO TO 11CSP3019018 CALL TYPERIIEROR.1.51 CSP30200CALL TYPERIINCR0.1.821CSP30210GO TO 6CSP3022019 CALL DECA1IISUM.1.8.L) CSP30230Hill 20.21.20CSP3024020 CALL IOND CSP30250STOP 555CSP3026021 CALL FILLCIPRNT.1.79.164481 CSP30270CALL MOVEIIMASK.1.13.IPRNT.67)CSP30280CALL EDITIISUM.1.0.1PRNT.67.791CSP30290CALL MOVEIISUM.1.800TCD.611CSP30300CALL TYPERIIOTC0.1.80)CSP30310CALL MOVEIITOT.1.5.1PRNT.231CSP30320GO TO (55,541.03CSP3033054 CALL SKIP)15872) CSP30340CALL PRINTIIPRNT.1.79.1,CSP30350GO TO 67CSP3036055 CALL $1403115872) CSP30370CALL P140311PRNT.1.79.1)CSP3030067 CALL TYPERI1NCRD.81.821 CSP30390GO TO 1CSP3040022 CALL TYPER(IEOJ.1.10) CSP30410CALL IONDCSP30420STOP 111CSP3043023 CALL NIONEIINCRO.L.4.01) C5P3044001 . 0 CSP30450CALL AlDECIINCRD.L.L.N1)CSP30460IF(1411 25.25.24CSP3047024 CALL IOND CSP30480STOP 444C5P3049025 CALL DECA1lINCRD.61.68.1.1 CSP30500L.0 CSP30510GO TO 40CSP3052026 CALL TYPERIIEROR.I.5) CSP30530CALL TYPERIINCRD.1.821CSP30540GO TO 1CSP30550ENDCSP30560VARIABLE ALLOCATIONSINCR0.0051 IMASK•005E IPRNT.00AD 107C0.00F0 ISTOP.0102 IMEAD.0152 IPRVB.0162 1TOT .0167 11.K. .0174 ISOM .017CIEROR.0182 IE0J .018C N2 .0180 N3 .010E J .018F I .0190 L •0191 M .0192 K .0193 NI .0194STATEMENT ALLOCATIONS27 .0106 28 .0208 58 .0238 1 -0248 29 .025A 30 •0262 59 .0268 2 .026E 3 "277 4 .0283Rm1111/111111 lumor.97 grr""'Wflif, lig 7,-. ^ IAPRO91@N 'I' , PM' 71TIMPIPMNV IR NM ,vsamwmw....M"Pe'


SAMPLE PROBLEM 2 PAGE 0433 •0289 34 .028E 60 •0291 35 •0290 36 •02A5 61 •02A8 37 m02C0 38 •02C8 62 •02CE 39 •02E241 •02F9 63 .030E 40 •0314 5 •031E 6 .032C 31 .0332 32 •033A 64 •0340 7 .0346 8 •03549 •035A 10 •0363 48 •0395 49 m0390 65 •03A3 11 m03A9 12 .0383 13 •0300 14 m03C4 15 .030816 m03DC 17 m03E8 50 •03EE 51 •03F9 66 •0402 18 •0408 19 •0414 20 •041E 21 •0422 54 m045055 •0458 67 .0464 22 •04611 23 .0474 24 m0488 25 .048C 26 •0498FEATURES SUPPORTEDONE WORD INTEGERSEXTENDED PRECISIONCALLED SUBPROGRAMSDATSW READ R2501 NCOMP NZONE SKIP 51403 FILL PRINT P1403 MOVE EDIT A1DEC ADD IONDDECA1 TYPER STOPINTEGER CONSTANTS2.0198 1.0199 10.019A 6.0198 13.019C 16.0190 72.019E 73.019E 80•01A0 5.01A116448.01A2 5440m01A3 0•01A4 70m01A5 12544m01A6 79•01A7 20.01A8 61•01A9 68.O1AA 21.01AB40m01AC 23.01AD 67m01AE 41.01AF 60.0180 16128.0181 3.0182 8.0183 7.01134 4032.018549=0186 52.0187 12.0188 48.0189 777.018A 4.0188 666.O1BC 02.0180 555.018E 15872.018F81.01C0 111.0101 444m01C2 1911•01C3 1638m01C4 1365m0105 273m0106 1092•01C7CORE REQUIREMENTS FOR SMPL2COMMON 0 VARIABLES 408 PROGRAM 780END OF COMPILATION// XE0CSP30570-112-


Sample Problem 2: Invoice OutputDAVES MARKET1997 WASHINGTON ST.NEWTOWN. MASS. 02158OTT NAMEAMTPREVIOUS BALANCE $111.298 SUGAR ■ BAGS $21.0211 CHICKEN SOUP ■ CASES $38.7610 TOMATO SOUP ■ CASES $30.118 SUGAR RETURNED $21.02CR6 COOKIES - CASES $45.2117 GINGER ALE ■ CASES $52.3717 ROOT BEER ■ CASES $52.3717 ORANGE ADE ■ CASES $52.3717 CREME SODA ■ CASES $52.3717 CHERRY SODA ■ CASES $52.3717 SODA WATER ■ CASES $52.3725 DOG FOOD ■ CASES $101.2625 CAT FOOD ■ CASES $101.2610 SOAP POWDER ■ CASES $72.8910 DETERGENT ■ CASES $72.8912 HAM ■ TINS $36.7512 HAM ■ LOAF $33.7512 SALAMI $33.7512 BOLOGNA $33.7512 CORNED BEEF $33.7512 ROAST BEEF $33.751.000 BREAD ■ LOAF $150.004,000 ROLLS $150.00200 MILK ■ QUARTS $57.42100 MILK ■ HALF GALS $57.4250 MILK ■ GALS $57.42100 POTATOES ■ BAGS $11.23100 TOMATOES ■ LOOSE $11.23100 CARROTS ■ BUNCHES $11.2310 DETERGENT - CASES $72.8912 HAM - TINS $36.7512 HAM ■ LOAF $33.7512 SALAMI $33.7512 BOLOGNA $33.7512 CORNED BEEF $33.7512 ROAST BEEF $33.751.000 BREAD ■ LOAF $150.004.000 ROLLS $150.00200 MILK ■ QUARTS $57.4250 MILK ■ GALS $57.42100 MILK ■ HALF GALS $57.42100 POTATOES - BAGS $11.23100 TOMATOES ■ LOOSE $11.23100 CARROTS ■ BUNCHES $11.2310 DETERGENT ■ CASES $72.8912 HAM ■ TINS $36.751,000 BREAD ■ LOAF $150.00OTY NAMEAMT4.000 ROLLS $150.00200 MILK QUARTS $57.42100 MILK - HALF GALS $57.4250 MILK GALS $57.42100 POTATOES BAGS $11.23100 TOMATOES LOOSE $11.23100 CARROTS BUNCHES $11.2310 DETERGENT CASES $72.8912 HAM - TINS $36.7512 HAM LOAF $33.7512 SALAMI $33.7512 BOLOGNA $33.7512 CORNED BEEF $33.7512 ROAST BEEF $33.751.000 BREAD - LOAF $150.004.000 ROLLS $150.00200 MILK QUARTS $57.42100 MILK HALF GALS $57.42100 MILK HALF GALS $57.42100 POTATOES BAGS $11.23100 TOMATOES LOOSE $11.23100 CARROTS BUNCHES $11.2310 DETERGENT CASES $72.8912 HAM TINS $36.75TOTAL $3,893.25STANDISH MOTORS10 WATER STREETPLYMOUTH. MASS.02296OTT NAMEPREVIOUS BALANCE20 AIR CLEANERS CASES6 GREASE - BARRELS20 TIRES 650 K 1350 TIRES 750 K 1450 TIRES 800 K 14100 GASOLINE CAPSAMT$2.356.36$200.03$165.24$260.385900.53$1.012.00$99.68TOTAL$4,994.22-113-


Sample Problem 2: Console Printer Log and New Master Card ListingERROR THIS IS A DELI BERATE ERRORERROR DAVE MARKETJ CSP30660THIS CARD IS A DELIBERATE MISTAKE J CSP30600DAVES MARKETERROR STANDISH MOTORSTANDISH MOTORS1997 WASHINGTON ST. NEWTOWN, MASS. 0215800389325 A CSP30670THIS CARD IS NOT CORRECT ABCDEFGHIJKLMNUPQRSTUVJ CSP3147010 WATER STREET PLYMOUTH, MASS.0229600499422 A C5P31410END OF JOBrt-114-


Sample Problem 2: Data Input Listing// XEOEND OF JOBERRORo S. CRPREVIOUS BALANCEC5P30570CSP90580CSP30590CSP30600CSP30610CITY NAME CSP30620AMTCSP30630ISTOPCSP30640TOTALCSP30650THIS IS A DELIBERATE ERROR J CSP30660DAVES MARKET 1997 WASHINGTON ST. NEWTOWNs-MASS. 0215800011129 A CSP30670DAVE MARKET THIS CARD IS A DELIBERATE MISTAKE J CSP30680DAVES MARKET SUGAR ■ BAGS 000021020008 J CSP30690DAVES MARKET CHICKEN SOUP .. CASES000038760011 J CSP30700DAVES MARKET TOMATO SOUP ■ CASES 000030110010 J CSP30710DAVES MARKET SUGAR RETURNED 000021010008 J CSP30720DAVES MARKET COOKIES - CASES 000045210006 J CSP30730DAVES MARKET GINGER ALE ■ CASES 000052370017 J CSP30740DAVES MARKET ROOT BEER CASES 000052370017 J CSP30750DAVES MARKET ORANGE ADE ■ CASES 000052370017 J CSP30760DAVES MARKET CREME SODA CASES 000052970017 J CSP30770DAVES MARKET CHERRY SODA CASES 000052370017 J CSP30780DAVES MARKET SODA WATER ■ CASES 000052370017 J CSP30790DAM MARKET DOG FOOD CASES 000101260025 J CSP30800DAVES MARKET CAT FOOD .. CASES 000101260025 J CSP30810DAVES MARKET SOAP POWDER ■ CASES 000072890010 J CSP90820DAVES MARKET DETERGENT .. CASES 000072890010 J CSP30830DAVES MARKET HAM .. TINS 000036750012 J CSP30840DAVES MARKET HAM LOAF 000033750012 J CSP30850DAVES MARKET SALAMI 000033750012 J CSP30860DAVES MARKET BOLOGNA 000033750012 J CSP30870RAVES MARKET CORNED BEEF 000033750012 J CSP30880DAVES MARKET ROAST BEEF 000033750012 J CSP30890DAVES MARKET BREAD ■ LOAF 000150001000 J CSP30900DAVES MARKET ROLLS 000150004000 J CSP30910DAVES MARKET MILK QUARTS 000057420200 J CSP30920DAVES MARKET MILK .. HALF GALS 000057420100 J CSP30930DAVES MARKET MILK ■ GALS 000057420050 J CSP30940DAVES MARKET POTATOES BAGS 000011230100 J CSP30950DAVES MARKET TOMATOES •• LOOSE 000011290100 J CSP30960DAVES MARKET CARROTS BUNCHES 000011230100 J CSP30970DAVES MARKET DETERGENT CASES 000072890010 J CSP30980DAVES MARKET HAM TINS 000036750012 J CSP30990DAVES MARKET HAM .. LOAF 000033750012 J CSP31000DAVES MARKET SALAMI 000033750012 J C5P31010DAVES MARKET BOLOGNA 000033750012 J CSP31020DAVES MARKET CORNED BEEF 000033750012 J CSP31030DAVES MARKET ROAST BEEF 000033750012 J CSP31040DAVES MARKET BREAD ■ LOAF 000150001000 J CSP31050DAVES MARKET ROLLS 000150004000 J CSP91060DAVES MARKET MILK QUARTS 000057420200 J CSP31070DAVES MARKET MILK GALS 000057420050 J CSP31080DAVES MARKET MILK HALF GALS 000057420100 J CSP31090DAVES MARKET POTATOES .. BAGS 000011230100 J CSP31100DAVES MARKET TOMATOES ■ LOOSE 000011230100 J CSP31110DAVES MARKET CARROTS - BUNCHES 000011230100 J CSP31120DAVES MARKET DETERGENT — CASES 000072890010 J C5P3<strong>1130</strong>DAVES MARKET HAM ■ TINS 000036750012 J CSP31140DAVES MARKET BREAD .. LOAF 000150001000 J CSP31150DAVES MARKET ROLLS 000150004000 J CSP31160DAVES MARKET MILK QUARTS 000057420200 J CSP31170DAVES MARKET MILK ■ HALF GALS 000057420100 J CSP91180DAVES MARKET MILK GALS 000057420050 J CSP31190DAVES MARKET POTATOES BAGS 000011230100 J CSP31200DAVES MARKET TOMATOES LOOSE 000011230100 J C5P31210DAVES MARKET CARROTS BUNCHES 000011230100 J CSP31220DAVES MARKET DETERGENT CASES 000072890010 J CSP31230DAVES MARKET MAM TINS 000036750012 J CSP31240DAVES MARKET HAM — LOAF 000033750012 J CSP31250DAVES MARKET SALAMI 000033750012 J CSP31260DAVES MARKET BOLOGNA 000033750012 J CSP31270DAVES MARKET CORNED BEEF 000033750012 J CSP31280DAVES MARKET ROAST BEEF 000033750012 J CSP31290DAVES MARKET BREAD ■ LOAF 000150001000 J CSP31300DAVES MARKET ROLLS 000150004000 J CSP31310DAVES MARKET MILK QUARTS 000057420200 J CSP31920DAVES MARKET MILK .. HALF GALS 000057420100 J CSP31330DAVES MARKET MILK .. HALF GALS 000057420100 J CSP31340DAVES MARKET POTATOES .- BAGS 000011230100 J CSP31350DAVES MARKET TOMATOES LOOSE 000011230100 J CSP31360DAVES MARKET CARROTS .. BUNCHES 000011230100 J CSP31370DAVES MARKET DETERGENT CASES 000072890010 J CSP31380DAVES MARKET MAM ■ TINS 000036750012 J CSP31390A CSP31400STANDISH MOTORS 10 WATER STREET PLYMOUTH, MASS.0229600235636 A CSP31410STANDISH MOTORS AIR CLEANERS CASES000200030020 J CSP31420STANDISH MOTORS GREASE .. BARRELS 000165240006 J CSP31430STANDISH MOTORS TIRES 650 X 13 000260380020 J CSP31440STANDISH MOTORS TIRES 750 X 14 000900530050 J CSP31450STANDISH MOTORS TIRES .. 800 X 14 001012000050 J CSP31460STANDISH MOTOR THIS CARD IS NOT CORRECT ABCDEFGHIJKLMNOPQRSTUVJ CSP31470STANDISH MOTORS GAS')LINE CAPS 000099680100 J CSP31480A CSP31490ISTOPCSP31500-115-i......X1.01011.111111111111.11111.11...H.11111.111.1111 14 .1111111111111. I 111 III 11


PROBLEM 3The purpose of this program is to print a payroll register and punch a new year-to-datecard for each employee. The input deck is as follows:Input deckEmployee deckThe year-to-date and current cards are read and processed. The payroll register isprinted as in <strong>the</strong> example, and a new year-to-date card image is printed on <strong>the</strong> consoleprinter. Then <strong>the</strong> next employee is processed.As is shown, <strong>the</strong> order of <strong>the</strong> year-to-date card and current card is not known before<strong>the</strong> cards are read.Switch settings are as follows:InputDeviceOutputDeviceSwitches0 1 21442 console printer down down down1442 1132 up down down1442 1403 up up down2501 console printer down down up2501 1132 up down up2501 1403 up up upMake sure that <strong>the</strong> switches are set properly before <strong>the</strong> program begins.After processing is completed, sample problem 3 will STOP with 3333 displayed in <strong>the</strong>accumulator. Press START to continue.A general purpose *IOCS card has been supplied with <strong>the</strong> sample problem. If this doesnot match <strong>the</strong> <strong>1130</strong> configuration to be used, a new *IOCS card will be required.*IOCS (CARD, 1132 PRINTER, TYPEWRITER)116


Sample Problem 3: Detailed Description1. Determine <strong>the</strong> output unit from <strong>the</strong> data switches.Console printer, 1132 Printer, or 1403 Printer2. Read <strong>the</strong> edit mask.3. Read a card.4. Is <strong>the</strong> card read in (3) blank?Yes — 18 No — 55. Is <strong>the</strong> card read in (3) a year-to-date card?Yes — 11 No — 66. Is <strong>the</strong> card read in (3) a current card?Yes — 8 No — 77. Stop.8. Move <strong>the</strong> employee number to storage (JEMP).9. Extract <strong>the</strong> number of hours worked (HRS).10. Go to (3).11. Move <strong>the</strong> department number to storage (IDEP).12. Move <strong>the</strong> employee number to storage (TEMP).13. Move <strong>the</strong> employee name to storage (INM).14. Move <strong>the</strong> Social Security number to storage (ISS).15. Move <strong>the</strong> pay rate to storage (IRT).16. Move <strong>the</strong> year-to-date gross to storage (IYTD).17. Go to (3).18. Are IEMP and JEMP <strong>the</strong> same?Yes — 19 No — 2419. Current amount (CURR) is set equal to HRS times pay rate.-117-FINFIANIP1.11111111111411111111111111111111111 H111111111111111111111111


20. New year-to-date is set equal to CURB +IYTD.21. Print a new year-to-date card image on <strong>the</strong> console printer.22. Print <strong>the</strong> payroll register line as in <strong>the</strong> example.23. Go to (3).24. Halt. If start is pushed, go to (3).Card Formats12yTDCarre p o.Nt•B EBC B CSocial1p °Employee Namea Security Pa y YTDBlanka •n No.Rate Grossd ° a_Spk No.ke ;99999999999999999999999999999999999999999999999999999999999999999999999999999999N II Il 13145411515535255353$ B 515711355135 3233$ 35513751354741 47 43 44 4244474744 1011 515354535457515147114743445147474744757572 737473 II 57 7171118 3B1 e ItCEmployee Namea p rBlank d a Sn t. IIk No; P99990999999999999999999999999999999999999999999999999999999999999999999999999999123411/ostannumounionnannnannammununxvuncaonwoomaammusuummunsomunmussynawinnunlenninE Nm o.p.CardSeq.No.CardSeq.No.NewYTBlank0 99999999999999999999999999999999999999999999999999999999999999999999919999999999I234147sonnuumsnumnionanananntsmmunmus p xnemanuem p aummumumusnonsoonumuutouse nnummennms0 when New YTDCode . I when year-to-date2 when current99999999999999999999999999999999999999999999999999999999999999999999999999999999I 22222 7lowitunmniumlonannunannmovnumxsumnamanuaavaammuumnsmunsomummamvuunnnnumnnnnmc iio aae kCPCardSeq.No.-118-


CHART S3 <strong>1130</strong> COMMERCIAL SAMPLE PROBLEM 3• START•XDETERMINE •OUTPUTUNIT • •x• READ EDIT •MASK•• NZERO•IS REPLACED BYNZERO C 1•4.4too•03 0.. ..• • Xg oo* i• READ ACARD•.0NO • IS NZERO 0.EQUAL TO•. .••. .*• YES.0 o.YES 0• IS CODE 0.EQUAL TOI . 0 01,0. .0•NO• IDEP .IS REPLACED BY DEPARTMENT • NUMBER •.• ...41 4.•NO •. IS IEMP o. • NZERO...... EQUAL TO .0 •IS REPLACED BY•I. JEMP .• 00. .. •• .4.*YESIEMP• IS REPLACED BY• EMPLOYEE NUMBERX•CURIA IS CODE •. YES •IS REPLACED BYI. EQUAL TOHRS • IRT o . 1 .•• • •.o..••NO•ii1(.•.•... o.TYPE• THE EMP. NOS. • ••IS• REPLACED YTO BY•.... IS ...• CODE IS •. YESDO NOT MATCHI. • EQUAL TO .0...• • CURR E ITTD 0. 2 ••• • •. ..•HO••IS REPLACED BY• EMPLOYEE NAMES•• JEMP .• • ISS*IS REPLAED C BYoIS REPLACED*EMPLOY EE NUMBER•SECURITY• • NUMBER*ERROR — HALT • •TYPE A NEW GE••**• D3 •• CARD IMAGE • ••ERROR — HALT •• ••• HRS IR TIII REPLACED BYIS REPLACED by• HOURS WORKEDPAY RATE•PRINT• DETAIL LINE •• •IYTOIS REPLACED BYYEAR—TO—DATEGROSS.4.641111.• 03 •• •• • • •-119-"""..."..XPI.Xn,,'"7••••■••••••11•1


Sample Problem 3: Source Program// JOBCSP31510/1. FOR CSP31520• NAME SP3 CSP31530•10CS(CARD.1132 PRINTER.TYPEWRITERICSP31540• ONE WORD INTEGERS CSP31550• EXTENDED PRECISION CSP31560• LISP ALL CSP31570DIMENSION MASKI12).1N1691.1DEP(2).1EMPI31.1NM(201.1SS19).IRT(4). CSP315801 ITTD(71.JEMP13).NYTD(7).1CURI61.KCURRI121.KOTTD112)11KNYTD(12) CSP315901 FORMAT I69A1.11) CSP316002 FORMAT (12A1) CSP3161020 FORMAT .2A1.1X.23A1112X.20A1.21X.1H1.3X0HCSP I CSP3162030 FORMAT I1H .2A1.2X.3A1.2X.20A1.5X.3112A1.2X)) CSP3I630CALL DATSW(0.I)CSP31640CALL DATSWIleM)CSP31650CALL DATSWI2.0CSP31660NREAD.6•(1/0+2CSP31670NWRIT.2•I1/II+2•11/M)+1CSP3I680READ (NREAD.21 MASKCSP3169015 READ INREADol) IN.ICD CSP31700IF (lCD) 6.10.6CSP317106 NZERO.0 CSP31720GO TO (7.81. ICDCSP31730C THIS IS THE YEAR TO DATE PROCESSINGC5P317407 CALL MOVE IIN.1.2.1DEPe1) CSP31750CALL MOVE IIN,4.6.1EMPo1lCSP31760CALL MOVE IIN.7.2611INM111/CSP31770CALL MOVE IIN.29.37.1SSo11CSP31780CALL MOVE (IN.38.41.1RT.11C5P3I790CALL MOVE IIN.421148111YTO.1)CSP31800GO TO 15CSP31010C THIS IS CURRENT PERIOD PROCESSINGCSP318208 CALL MOVE IIN.1.3.JEMPo1l CSP31890HRS.GET IIN.28.30.100.0)CSP31840GO TO 15CSP3185010 NZERO • NZERO • 1 CSP31860IF INZERO • II 100.100.101CSP311170101 _STOP 3333 CSP31880100 IF (NCOMPIIEMP.1113.JEMP.1)) 99.11.99 CSP3189011 CURR.IHRSIIGETIIRT.1.4 1110.0)+500.0)/1000.0 CSP31900YTO•CURR+GET IITTD.1.7.10.0)CSP31910CALL PUT INYTD.1.7.YTD.5.01,11CSP31920WRITE 11.201 IDEPolEMP.INM.ISSIIIRT.NYTDC5P31930CALL PUT IICUR.1.6.CURR.5.0.1)CSP31940CALL MOVE IMASK111.1211KCURR.1)CSP31950CALL MOVE (MASK.1.12.KOYTD.1)CSP31960CALL MOVE IMASK.1.1211KNYTD.1)CSP31970CALL EDIT IICUR.1.6,KCURR.1.121CSP31980CALL EDIT IlYTD.1.7.KOYTD.1.12,CSP31990CALL EDIT INYTD.1.7.KNYTD.11,12)CSP32000WRITE INWRIT$301 IDEP.IEMP.INMAOYTDACURRANYTD CSP32010GO TO 15CSP32020C THIS IS AN ERROR. THE EMP NOS DO NOT MATCH. CSP3203099 WRITE (1,401 CSP3204040 FORMAT 1 . THE EMP NOS DO NOT MATCH. I ) CSP32050GO TO 15CSP32060SAMPLE PROBLEM 3 PAGE 02ENDCSP32070VARIABLE ALLOCATIONSHRS . .0000 CURR .0003 YTD .0006 MASK .0017 IN .005C IDEP .005E IEMP .0061 INM .0075 ISS .007E IRT .0082IYTD .0089 JEMP .008C NYTD .0093 ICUR .0099 KCURR.00A5 KOYTD•0081 KNYTD.00BD I •00BE M •00EIF L .0000NREAD.00C1 NWRIT.00C2 ICD .00C3 NZERO.00C4STATEMENT ALLOCATIONS1 .00E8 2 •00EC 20 • 00EF 30 •0103 40 .0114 15 •016C 6 .0178 7 .0182 8 .O1AE 10 •018F101 •01C13 100 .O1CD 11 .0106 99 .0259FEATURES SUPPORTEDONE WORD INTEGERSEXTENDED PRECISIONIOCSCALLED SUBPROGRAMSDATSW MOVE GET NCOMP PUT EDIT EADD EMPY EDIV ELD ESTO WRTYZ SRED SWRT SCOMPSFIO SIOAI 5101 STOP CAROL VRNT2REAL CONSTANTS.100000000E 03.0006 .100000000E 02.00C9 .500000000E 03.00CC .100000000E 04.00CF .500000000E 01.0002INTEGER CONSTANTS0.0005 1.0006 2.0007 6.0008 4.00D9 7.000A 26.000B 29.000C 37.000D 38.00DE41.00DF 42.00E0 48.00E1 3•00E2 28.00E3 30.00E4 3333.00E5 12.00E6 13107.00E7CORE REQUIREMENTS FOR SP3COMMON 0 VARIABLES 198 PROGRAM 410END OF COMPILATION-120-


Sample Problem 3: Payroll Register Output// XECI C5P3208001 101 NALNIUO o J $7,453.06 $198.91 $7.651.9752 201 ONINOREO, N $3,52407 $143.82 $3,668.1976 676 NEDAII, R $10.060.60 $297.27 $10.357.8776 689 NEDUOL. R $10.060.60 $297.27 $10.357.8701 253 NROM o J $9,555.62 $279.65 $54835,27-121-!NM I1111111111 1-1 r 11A11, MP PRF


Sample Problem 3: Console Printer Error Log and New Year-to-Date Card Image01 101NALNIUQ, J 79856643205420765197 1 CSP52 2010MINOREG, M 01332567804230366819 1 CSP76 676NEDAB, R 01423306008101035787 1 CSP76 689NEDUOL, R 79860379408101035787 1 CSPTHE EMP NOS DO NOT MATCH.01 253NROH, J 95462305707620983527 1 CSPe:-122-


Sample Problem 3: Data Input Listing// SEG CSP32080. S. CR CSP3209001 101NALN1182 . J 79856643209420745306 1 CSP32100101NALNIU0 • J 01367 2 CSP321100 CSP321802010MINOREG• M 52340 2 CSP3213052 2010M1NOREG• M 01332567804230352437 1 CSP321400 CSP3215076 676NEDAB• R 01423306008101006060 1 CSP3216067668048• R 76367 2 CSP321700 CSP32180689NEDUOL t R 76367 2 CSP3219076 689NEDUOL. R 79860379408101006060 1 CSP322000 CSP3221099 9990NATNOM J 99999999901160511122 1 CSP322200990NATN0M . J 994009 2 CSP322300 CSP3224001 253NRON • J 95462305707620955562 1 CSP32250253NR0N . J 01367 2 C5P322600 CSP32270CSP32280-123-


FLOWCHARTSADDCHART AD <strong>1130</strong> COMMERCIAL ADD/SUB SUBROUTINEA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEAA**At********* ****A2********** * ** START SUB * * START AuD A* 4 *********•**►*** ass A»**********.. ........ ......... xXX****Aoi********** *****82********** *****B3*X********* *****B4*********** SET UP AN * • *CLEAR AND SAVE * AKCARCIKLASTI IS* A **INSTRUCTION TO * *SIGNS ON JCARD * * REPLACED BY * * RESTORE SIGNS *A CHANGE JCARD A * AND KCARD A *KCARDIKLASTI & * A ON JCARD AND ** SIGN A FIELDS KNOW * * KCARD FIELDS * * * A * A ****************** ***************** ***************** *****************X*****c2*********** CALCULATE THE **OPERATION-LSIGNA*15 REPLACED BY A• JSIGN A KSIGN *A***A*************X***AAD2********** ****4,03*********** KNCW IS A *A REPLACED BY A AKCAPOIKNOWI IS AAKLAST - JLAST &A *REPLACED NY N -** J A A KCARDIKNOWI •* A * A***********4*A*** *******••********A****R2*X**************F3A*****A***A A SA JNOW IS A A KSIGN IS AREPLACED BY J * REPLACED B y AA A A -KSIGN* A A**********4.****** 04** ** **Mem*.X*****02***********KCARDIKNOw/ IS *A REPLACED BY ** LSIGN ** JCARDIJNOWI & A* KcARDIKNOWI A********************* AA A4 A* A*A**AA4 A.A.LCw .* KNOW IS A. HIA COMPARED TO .A..A. ZERO .**. .5A. .4,A EDE*****c34, ******** X• A ****C4***** AA KNOW IS A *A RFPLACED BY K • * EXIT0 A AA ********************************X. 5 . .A.E2 A.ER A. * * ***Ey **** 8 **a*****v .5 .. .* A. A* A YES .5 IS KNOW A. .5 IS KNOW A. YES A KNOW IS A* CS AX....A. LESS THAN K .* A. LESS THAN .*, 04, REPLACED BY As A A. .* A. KLAST . ,I A KNOW & I **AA* A. .* A. .* AA. .A A. .5 ***•*************A NUA NO4.****85***********FILL•• KCAR)AK,• KLAST.9 •*********************A A* C5 5.0********•0*********•ANER IS REPLACED*BY KLAST******************X:****H1*********: A****H2*******•**A5, JNOW IS * A KNOW IS *5 REPLACED ay A A REPLACED BY AA JNOW & 1 • A KNOW & 1 ** A A A***************** *****************XA.J2 A.NU . **IGREPEr .S.. * 5. THANA . JLAST .* .*A. .5A. .*A YESX*****K2****•******LARRYXKtM14614:***************:-124-


CHART Al <strong>1130</strong> COMMERCIALNO IS JTEST • •. YESLESS THAN0. —4032 .••.•A1DEC SUBROUTINESTART• NZONE •JCARD,JLAST, • 4.JSIGN • •• W•IS REPLACED 8Y ••••JTIS REPL ESTACED BY• JCARIOUNOW6X.4...0.YES .• . IS JTEST •. •. NOLESS THAN•. ZERO 0.0. .•a...*XX.0 •.NO IS JTESTAN EBCDIC .00. BLANK .•0. .0•45• NER • JTEST•IS REPLACED BY •IS REPLACED BYJNOW •AN EBCDIC ZERO• • •• JCARDLINOW0 ••IS REPLACED BY ••XJTEST40326/8• 256 ••ADDA 1A3I AlDECA3A1CARRYDE CA 1DIVDPACKDUN PKEDITFILLGETICO MPION DKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE0..0.•IS JNOW • YES • JNOW •LESS THAN ISIS REPLACED BY•. JLAST • JNOW E 1 • 0 . .0 *NO.• JCARD*JLASTR • YES .• IS JSIGN •.•IS REPLACED BY •X EQUAL TO .0•— JCARDXJLAST6-1• 0. 2 .0•0. .•'AEIXEXIT-125-lompoPIPPRPOIRIM1111.4•CRIP.1111■ 111 u mffilim■ wowI'W ^i it AXIS alp p.1,1,1111141,1,1 opospoli11,11 I NFINP'' IP! 111110 01 1 1 111114 111111 P Pr, 111'1,1'111'


ADDA1A3A 1 DECA3A1CARRYDE CA 1DIVDPA CKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN Z ONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHO LECHART A3***•A1*•**•****a a•oSTART A1A3*********************81•********** SIT SWITCH AT a* J1 TO ALA3 ****** ***mass***.X•*****L1**********aLAttiartf2, *AND 3 •*******•**************01**********Xa ADDRESSES OF * JCARDIJ) AID *• KCARDIKI •**********************E1*********** CACULATE H 0:wigH LTEPIC TAR E******** ***** ass******F1*X********** LOAD INDEX **REGISTER L WIT**THE ADDRESS OF H** KCARDIKI•** ********* ************G1**********• LUAU INDEX **REGISTER 2 WITH*• THE WIUTH OF *JCARD*** ******* ********•**•* H1 *.X•*4. *******H1 5 ****** *0*LUAD TH ACCUMULATOR ** WITH THE NEXT•JCARD CHARACTER*o ****** **********.5J1 S.*.1.!!**.*SWIRHIIIA3**.*• *,.. .► .••**• •* NO•A5 *a*•*.s..KI *.S..* 5 IS •*. NO5. INTEGER ,0...*.NEGATIVE .* -S. .55.* * YES :*►••• E2s•****<strong>1130</strong> COMMERCIAL A1A3 SUBROUTINE****62********** START A3A1 *•****•**********:****B2*L******:* SET SWITCH ATO*01 TO A3A1 0:***************:*****c2***********DIVIDE BY LSO(' •******** ********X*****02*******►*** ADD 20 TO GET *.•.*THE FIRST VALUE*******************0*5*E2 •...* * .*********B2**********• ADD 32CC: TO *ADJUST FOR ANEGATIVE * INTEGER ****►*••***************F2**** **•*** •• CIVIDE BY 16CC 0TO THE * FIRST VALUE ******************Xoo*••G2••********• SAVE FIRST *• VALUE*********** ***** 0*****H2***.***** **DIVIDE BY 4C TO*• *GET THE VAL UESECOND ******************X**•**J2**** ■*****•* SAVE SECOND *VALUE•***••R2•***X*USE THIRD VAUE**A4 SUBSCRI PT L TO*• LOOKUP THIRD •...* CHARACTER ••***••*•*•*••****3**********STCRE THIRC CHARACTER •* **************•*******se,*********** USE SECOND VALUE AS *• SUBSCRIPT TO O LOCKUP EECCNC * CHARACTER ***************•*******c3*********** STCRE SECOND ** CHARACTER *************•*********03***********USE FIRST VALUE**as SUBSCRIPT TO** Immo g lasT a CHARACTER ******************X*****Bs*** ****** *• STCRE FIRST ** CHARACTER *• •*************►********F3 * X **** ******DECREMENT INDEX**RESISTER 1 RY 3******************••**II *A4* ***a*•*****A4**********USE SRCONC ** CHARACTER TO •*SEARCH TABLE TO**GET THE NUMBER **•****************•***B4*•********X*SUM THIS NUMBER**WITH THE THIRD **NUMBER AND SAVE** THE RESULT a**********************c4**********USE FIRST * CHARACTER TO **SEARCH TABLE TO**GET THE NUMBER ******************X*****04***********SUM*THIS NUMBER*WITH T HE **PREVIOUS SUM TO**GET THE RESULT•********** MI***B4**********STE • RESUL O T RE IN TH THE * KCARD FIELD *************••********F4***********DECREMENT INDEX**REGISTER 2 EY I*••***************X*****G?* ******** **•**G*•***•****** * * **DECREMENT INCEX* *DECREMENT INDEX*•REGISTER 2 BY 1• *REGISTER 2 ev 1** * * *• * * ********* ******* 0* *********************x s **H4**...sr*•. . XHI *. •****H4******•**•.* *. NO .• IS *. LOAD THE ...*. FIELD WIDTH .5 ACCUMULATOR . S. 2ERC .* WITH A BLANK *. .* * *; a. 0. ***•***************** ■ YES* *•HI$s********J3******•*** ***** J4**********X* SAVE THE *• RESTORE INDEX **ACCUMULATOR THE**REGISTERS 2.** SECONDAND 3 *• CHARACTER ** * ********************R3********** *• EXIT * ••**X***** K4**** ***** *LOAD THE * ACCUMULATOR • WITH A BLANK ****** ************•*55** * A5 ***a*aaaaay*********** SAVE THE a*ACCUMULATOR AS THE FIRST * CHARACTER ****.x.***.00xsos*w***•*85***********JECRENEIT INDEX**REGISTER 2 BY I• •*****************C5 * *5..* a.YES .* IS *...... FIELD WIDTH .0• *. ZERO .*S. .*; o. .*•*** * NO*H4 *•*********05***•**•**•LCAD THE ACCUMULATOR ** WITH THE XT •*JCARC CHARACTER****************•******Es*** ******* SAVE THE •*ACCUMULATOR THE►SECOND* CHARACTER ***********************F5*** • ********DECREMENT INDEX**REGISTER 2 BY 1*•***•****.*.G5 *..* 0.YES•* . IS 5.FIELD WIDTH ► .0S.S.ZERO .5*. .*.5* NU.X*****Hs**********XLOA THE ACCUMULATOR ** WITH THE NEXT a•JCARO CHARACTER* ►***********J5*****X****** USE THE *ACCUMULATOR TO •*SEARCH TABLE TO*•GET THE NUMBER ►•************K5SAVE THIS NUMBER FOR LATER ACCUMULATION ************* •******-126-


CHART CA <strong>1130</strong> COMMERCIAL SUBROUTINE ADDA1A3A1DECA3A1'CARRY IDECA1STARTDIVDPACKDUNPKEDITFILLGETICOMPIOND• • .• .• •. KEYBD• NCARY • JNUW•IS REPLACED BY .15 REPLACED BY0 •JNOW - I• ••• JNOW •IS REPLACED BY • •JJESTIS REPLACED BYJCARD2JNOWDNCARY'. Y ESNU IS JNOW'' *.LESS THAN• . J•..•.••. .•*YES• LARRY*IS REPLACED BY •• NCARY•MOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUTNCARY •IS REPLACED BY • EXITP1403JTEST / 10 •JTESTIS REPLACED BYP1442READR2501SKIPJTEST - 1U • STACKNCARYSUBS1403.•NO IS JIESILESS THAN .•ZEROXTYPERUNPACWHOLEJTESTIS REPLACED BYJTEST C 10NCARYIS REPLACED BYNCARY - 1XJCARDIJNONDIS REPLACED BYREPLACE-127-RR I OWN, I RIMIN MINN Ill I,IMPP■111/0.1111.....mmur 110■11■Mli II I 111 -.“..


ADDA1A3A1DECA3A1CARRYIDEC<strong>All</strong>DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLECHART DE<strong>1130</strong> COMMERCIAL DECA1 SUBROUTINESTART••• JSIGN*IS REPLACED BY ....4 • •NO • IS 0.JCARDXJLASTo•..NEGATIVEX•YES• • JSIGN •15 REPLACED BY 2• •• JCARDULASTo •IS REPLACED BY ••-JCARDMAST6-1.• •X• JNOW•IS REPLACED BY•• JTEST •OS REPLACED BYJCARDXJNOW6 • •.•IS JTESTo. YES• LESS THAN orZERO•NOIS▪ JTEST•NO •LESS THAN0. 10*YES• R•IS REPLACED BYJNOW•• JCARDUNDWa •15 REPLACED BY 256 • JTEST - • 4032 •iX..... ...•• NZONE •• JNOW • YES ....IS JNOW •. •. NO•IS REPLACED • •BY •71 LESS THANX. JCARD,JLAST, K. EXITJNOW C I •. JLAST .. JSIGN,JNOW •• • . .. •.. ...♦-128-


CHART DIX.0.YES KLAST 0.KSTRT-JSPAN .0..NEGATIVE•0N0NO .0 IS •.KLOW .0•.POSITIVE••YES•FILLKCARD,KLOW.KSTRT.0JFRSTIS REPLACED BYSTART••CLEAR AND SAVE• SIGNS ON•JCARD AND KCARD• FIELDSJSPANIS REPLACED BYJLAST - J&I• JHIGH••IS REPLACED BY•• JCARDZJERSToKPUTIS REPLACED BYKLOWJLAST - JFRSTKSTOPIS REPLACED BYKLAST & JFRST- JLAST - 1JNOWIS REPLACED WYJFRSTKCAADXKNOwnIS REPLACED NYK:AIDZKNOwu -MULT •JCAR•JNOWoKNOWIS REPLACED AYKNOW E 1KSTRT• KM • JNOw • YES .. •• IS JNOW ..IS REPLACED BY IS REPLACED BY • •IS REPLACED BY .1• LESS THAN ..K - 1 • • KSTRT • •JNOW & 1 .. JLAST ..• • .••N O.... .• • . •• El •... • E3 ...• ••••• x• • • • • •...X X X.. ..• •. • • MULT.. IS •. YES • KLOW •IS REPLACED BY0•JCARMIERSTo...... ....IS REPLACED NY • •i10 • KCARDUND •••PLISITIVE .• . • K - JSPAN •GKCARDXKM&IBB/.. .5 JHIGH▪ . .•.NO ..... • • wee.. • A3 • • •. • • El •X..•••• • • .X•.......• ..... JFRST'.. • •. 4. IS yes • JFRST • • NQUO.. LESS THAN ..... X.IS REPLACED BY • •15 REPLACED BY•. JLAST •• • JFRST & I • PULT0. . 40 • • • op".O. .. • •.NO• A5 • ....x<strong>1130</strong> COMMERCIAL DIV SUBAOUTINF0 • NSIGN• NER•I5 REPLACED BY • • KCARD.KLAST - •• KLAST • • JSPAN.JSIGN • •• • • KSIGN,KNOW •X•. • •• • • •.. .., •.. IS MULT 0• YES • KNOW0.GREATER THAN X.IS REPLACED NY• ZERO .• X • KM C 1.. .• ••NO•• GARRY •• • KZARD.KM. •• KNOW-1,KNUW •••N3IS KNOW• LESS THAN0. ZERO•YES•• K:4ND1KM0•IS REPLACED BY• KCAROUMA G• 10 • KNOWADDA 1A3A 1DECA3A1CARRYDE CA1DIVDPACKDUN PKEDITFILLGETICO MPIONDKEY BDMOVEMPYN CO MPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TY PERUNPACWHOLEXXNSIGNJCARC.JLAST.JSIGN.JNOW• KCARDUPUTo•1S REPLACED BY• NQUO•* 0.•• MOLT•IS REPLACED NY• 1•XNSIGNKCARD.KLAST.KSIGN KNOWEXIT•• KPUT• IS REPLACED BY• KPUT C 1•X..... .NO 0• IS KM 0. YESLESS THAN• KSTOP•...•• •• E3 •• •• • • •••• KMX IS REPLACED BY• KM C 1••• NQUOIS REPLACED 5Y• NOUO - 1•—129—


ADDA 1A3A 1DECA 3A1CARRYDECA 1DIVDPACKDUNPKEDIT1FILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLECHART EDSTARTNZONENZONEJCARD,JLAST.• 4.NSIGN• NDUMP•1S REPLACED BYEBCDIC BLANK• 816448.• PDNEY ••IS REPLACED BYEBCDIC BLANK • •• NZRSP•1S REPLACED BY•• KNOW .15 REPLACED BY KLAST • •JNOW • IS REPLACED BY JLAST • •• • ••• •• HI• ••17•• KTEST*IS REPLACED BY• KCARDKKNOWB.0 IS KIEV NO4. NEGATIVE .4".•YES<strong>1130</strong> COMMERCIAL EDIT SUBROUTINE..00 0..0• • • •B3 • •84 •• •0000••••iS0.01 .o.... •34• 0. •26• .0 4..• IS KTEST S• YES KTEST NO .• IS KNOW .... EQUAL TO ...... .IS REPLACED BY • ..... LESS THAN .4.. 16448 0. •JCARDKJNOwo 0. K 0.. 0 .... ..ii i •. ..•NO 0.000.0. •YESH2 • •• HI •X.0 013. 9. 4ONE NZ 027"YES 0. IS KTEST 0. KCARDUNOwn •" 0.. EQUAL TO .. •IS REPLACED BY . NZONE .. 23616 .0 KTEST JCAREWLAST. 0. .4• • • NSIGN.KTEST •.. 0.•NO.0..14. 4.• IS KTEST 4. NO0. EQUAL TO23360•15•NDUMPIS REPLACED BYKTESTMONEYIS REPLACED BYKTESTX•YESKXJNOWIS REPLACED BYJNOW - 1•FILL •2104NO .• IS 0.NZRSP • FILL•.POSITIVE .4 KCARDoK, • KLAST.23616 •*YES0.5..0 IS YES• KTEST .....•.NEGATIVE•NO• •.19. •36• 0.NZRSP YES • IS KTESTIS REPLACED BY EQUAL TO .4KNOW • 16448•NO••••• • H2 0.. •• •• ..... 41..0 0200 4. 0. 412 .1. 4..▪. IS JNOW 0 . YES YES .0 IS 41.0. LESS) THAN ......X KTEST 0•.. COMMA 0..• ••.. ..41. *NO •.10. • •" X. B3• •...ES•33• 0.IS KTEST 4. NO..00. • EQUAL TO0. -4032 .4.01•25.• NZRSP•IS REPLACED BYKNOW - I•XX01,IS JNOW • YESLESS THAN .....J•NU.• ••" X. K4 • •X ••••.4.NO ...1S.MSTe.o.EQUAL TO 0.4. -4032 .4.••45•• • •• K3 ••.32• o o.0• IS (TEST NO4. EQUAL TO .....24640.0* YES• 35 •K4 • •••••0. •29• o.▪ • IS NSIGV 4. YES0. EQUAL TO2 .0•,10.2• KTE0ST•I5 REPLACED BYCARDULASTa•4.NO .4 ISKTEST .••.NEGATIVE•YES•31• 41..0 IS NOKTEST0 . R•.4YES• .6.•KC4RDULAST-164IS REPLACED BY• 16448• •G5• ••5• • K:ARDXKLASTo ••IS REPLACED uY 16448 • •X XX•3••.NO .• IS • NZRSP" ...GREATER THAN .0•. 0 .0•YES• EILL •22••FILLKCARDoK.• NZRSP.NDUMP.." •11•• • KNOW• .304K3 4....X.15 REPLACED BY S EXIT• KNOW - 1 •"I" •I.0• "• 84 • . 900• KCARLANZRSPa....IS REPLACED BYMONEY•-130-


CHART DU<strong>1130</strong> COMMERCIAL DUNPK SUBROUTINEX*****81►*►****•*******B2*********** SET SWITCH AT * SET SWITCH AT *• K2 TO DUNPK * K2 TO DPACK *• •** **a* ******* ******** **►**************X****►c2******►*** C3 0.** SAVE INDEX * YES .•.* IS IT *.*.*REGISTERS I AND* ...0. FILLER .** 2 a 0. .4* .****************** *. .*• NO*****02************CREATE ADDRESS •* OF JCARDIJI •*•*4►**•**************E2**********•*CREATE ADDRESS •* OF KCAROIKI *•*****E3**********•DFCREPENT INDEX**REGISTER I BY 1.*•******►►*********** ......xX**••*m2*********► *****F3*********** **CREATE ADDRESS * *DECREMENT INDEX**OF JCARDULASTI* *REGISTER 2 EY 1** 4 ** * ****************** *II** 5 505 4 0 it 00 505X .****G2******** 03 0.* LOAD INDEX * .* *.*REGISTER 1 WITH* .* IS *. NO* ADDRESSIK OF I * *.*COUNT ZFRO .00... ** KCARD.*• *. .4***************** 0. .0• YES***** ** H2 *.X• • X****X00** ***** a * ** A3 * 45 a * a ***** a***.XXA3 *.*****A5********•*****Al ***** **** ****A2********* .5 0. **** . SHIFT AND *• * * .5 IS THIS *. YES 0 • * ROTATE TO PUT *START DUNPK • 4 START DPACK * *.JCARDIJLASTI .0....X* C4 • * DIGIT IN LOW *• * * 4 *. .* * ORDER OF THE **************• ************* *. .0 ***a * EXTENSION **. .► *•**************•• NOx*****83*********** **RICK UP A DIGIT** OF THE WORD ** ** *********•*************E3*********** ** STCRE IT IN *KCARD******* ******** **00.84 *. B5. * •*..* S. .5 *.NO 00 IS *. YES .5 IS THIS ....... FILLER .*X. * JCARDULAST1 .0*. NEEDED .. *. .5*. .**. . .. *• .YES a NOx►****c4********** *****cs*********** PuT IN 5*DECREMENT INDEX*a• AMOUNT OF * *REGISTER 2 BY 1** FILLER * .* a ***********a******* **********************D4*X********* 04..*.* * .* *.* STORE PACKED 4 .* IS 5. NO* DATA IN KCARD * *. COUNT ZERO .0...* *. .** *. .5:*********** ****** *. .5* YESXx*****E4********** *****E5*********** * **DECREMENT INDEX* * STORE PACKED **REGISTER 1 EY 1* • DATA IN KCARD ** * * ** * . ***►**•*********** ►****•***********X*****F4* *********** F5** *******•* a ** PICK UP TFE * *DECREMENT INDEX** SIGN OF JCARO *REGISTER 1 BY 1*o * . * * ****►*►*********** *****************55**** G4 *.x* ******G44s»aarisa0* STORE TH E **ACCUMULATOR IN *(CARD* ************•*****X*****m2********•******mA*****►***** LOAD THE * ** ACCUMULATOR * * RESTORE INCEX ** WITH THE NEXT • *REGISTERS 1 AND**JCARD CHARACTER* 2 *O * C,*SI,* 41,a. 41. 4* ******••••••*•••*****•••ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEX***** J2*********** LOAD INDEX **REGISTER 2 WITH*4*********** ******x****J**•*•**►**a ** ExIT ** ******* *********.►.K2 ►.►•.*00 0.* • YES .* IS *.• A3 *X....*. SWITCH .*► * 0. DUNPK .►**** 0. .*S. .** NO♦***• *• AS •► •444*-131-u Ili 1 111111111111111111111 1111111111111111111111111.11111.11111111,11,11â 1311,MM. m•


ADDA 1A3A 'DECA 3A1CARRYDE CA1DIVDPA CKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TY PERITNPA CWHO LECHART FL <strong>1130</strong> COMMERCIAL FILL SUBROUTINESTARTX•JNOW •IS REPLACED BY •••X•JCARDXJNOWa •IS REPLACED BY •NCH ••JNOWIS REPLACED BYJNOW E I,•X0. IS JNOW NO•.GREATER THAN 0s...JLASTEXIT•YES-132-


CHART GTSTARTX• NZONE •NZONEJCARD.JLAST. • 4.NSIGN •X• GET •I REPLACED BY •0.0• •X• JNOW •IS REPLACED BY •• •XX-JTEST IS REPLACED BY JCARDYJNOWn ••YES IS JTESTNEGATIVE•NOIS JTESTA BLANK*. .o•TES•X• JTEST ••IS REPLACE ZERO • •<strong>1130</strong> COMMERCIAL GET FUNCTION•NO• GETX•IS REPLACED BYX 0.0•JNOWX IS REPLACED BY• • JNOW 6 1•NOIS JNOW *......GREATER THANJLAST .*•. •YES• GET•IS REPLACED BYSHIFT • GET•NZONENZONEJCARD,ILAST,• NSIGN,JTESTX.•.• IS NSIGN YESEQUAL TU*. 2*. .•NOXSEXIT• GET•IS REPLACED BY• MINUS GETADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEX' X* IS JTEST '• YES• LESS THAN .• .....•.AN EOCOIC.0•.ZERO .••NO• T ••IS REPLACED BY•I0•GET6tJTESTE • 40320/256 •-133-IIImmOMMI•MM. MORR I 11


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITCHART IC <strong>1130</strong> COMMERCIAL ICOMP FUNCTIONSTARTFILL •CLEAR AND SAVE • SIGNS ON ••.ICARD AND (CARD.GET • FIELDS •I ICOMP IIONDxS• KNOW•IS REPLACED BY•KSTRT E 1•• JHASH•IS REPLACED BY• ZERO•KEYBD • •• KSTRT MOVE REPLACED BY (LAST E J - • JLAST - 1 •MPYNCOMPNSIGNXNZONE IS K YE SPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEo.GREATER THANKSTRT•NOICOMP• IS REPLACED BY• -KSIGNKNOW• IS REPLACED BY••.IS. NUKCARDUNOWD•.POSITIVE .4•YES• KNOW....IS REPLACED BYKNOW E 1•.:YES .:YES.IS KNOW NO IS KSTRTX•...LEn • TAIAN...•••• LESS THANJLAST. •NO• KSTRT•IS REPLACED BY••• JHASH*IS REPLACED BYJ HASH• JCARDU STRTo• ICOMP•IS REPLACED BY.JCARDUSTRTB• KCARDZKNOwo••;•• KSTRT •IS ICOMP NO•IS REPLACED BY EQUAL TOKSTRT E 1 • ZERO .9••YES•X• KNOWIS REPLACED BYKNOW E 1•XIS ••. NU...KS1341 • JSIGN.....•.LESS THAN.••.ZERO 0.•YES• RESTORE SIGNS ON ••JCARD AND KCARD•• FIELDS •NU .•IS JSIGN •.....KSIGN • JHASH.••.NEGATIVE•YESEXIT• ICUMP•IS REPLACED BY•X• ICUMP ...IIS REPLACED BY JSIGN • ICOMP • •-134-


SCHART 10STARTxxYES AN..X.. INTERRUPTS •4.. PENDING.NOEXIT<strong>1130</strong> COMMERCIAL IOND SUBROUTINEADDA1A3A 1 DE CA3A1CARRYDE CA 1DIVDPA CKDUNPKEDITFILLGETICO MPIONDKEYBDMOVEMPYN COMPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442REA DR2501SKIPSTACKSUBS1403TYPERUNPA CWHO LE-135-I- I MI PPM !UMW


CHART MVADD<strong>1130</strong> COMMERCIAL MOVE SUBROUTINEA 1A 3A 'DECA 3A 1CARRYDE CA1STARTDIVDPA CKDUNPKEDITJNOW•IS REPLACED BYFILL •GETICOMPXIONDKNOWKEYBD •IS REPLACED BYK JNOW — JMOVE•MPYNCOMPNSIGN•KCAROUNOW0 •• JNOW*IS REPLACED BY • •* IS REPLACED BY •N ZONE • JCARDtJNOw0• JNOW E t ••PACK•PRINTPUNCHPU . IS JNOW YESo. • LESS THAN*. JLASTP140• . • • . •. •NOP1442READR2501SKIPEXITSTACKSUBS1403TYPERUN P A CWHO LE4•-136-


CHART MPSTART<strong>1130</strong> COMMERCIAL MPY SUBROUTINE• •• • KSTRT •X.IS REPLACED BY •• • K - JLAST a J •• -1 •NO IS KSTRTGREATER THAN .•ZEROX• YES• •• NER • •CLEAR AND SAVE ••IS REPLACED BY • • SIGNS ON •••KLAST .JCARD AND KCARD.• • FIELDS ••• KM•IS REPLACED BY••• MULT•IS REPLACED BY• KCARDIKM.•X•• KM....IS REPLACED BY• KM G I•ADDA 1A3A 1DECA3A 1CARRYDECA 1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGN.•• .. .. ....N ZONEPACKX ... .:Y• ES• FILL •...•IS MULT I• ND .... IS KM ....• KCARD.KSTRT. • •.0REATER THAN ' . X.. LESS THAN..0 K-I,0 .,. ZERO -. X .. KLAST ..• .,. .. .• .•. .. ■.. .•.YES •40 PRINT• PUNCH•x z i PUT• • • CARRY •KCARDXKMn•IS REPLACED BY • •IS REPLACED BY • • K:ARD.KSTRT. • j • ZERO • KLAST.KNOw •• JFRST • P1403. .P1442REA DxxR2501.••..•.xSKIP• •• NSIGN •.. IS . YES • KNOW •0.JCARMERSTn•IS REPLACED BY • • K:ARD.KLASTr • STACK..POSITIVE .4. • xm Y JFRST • .jSIGN • KSIiO4. •.. .• • - JLAST • • KNOW•. .•SUB.140;,S1403• ••••... iK • J2 • TYPER. .• •. •. • •••• UNPAC• REPLACED •JFRST•. .• •WHO LE.• IS JFRST •'. YES • JFRST • • JNOW.. LESS THAN .. X.IS REPLACED BY.11 BY0. JLAST .0 • JFRST E 1•. .••NOaFILLKCARD.K1KLAST.0 •X• KCARDZKNOWn ••IS REPLACED BY •• MULT • •• JCARDISJNOWn y •• KCAROKKNOWn •• ▪ •• J2• •* 11.0XNSIGNJCARD.JLAST. •JSIGN,JNOW •XEXIT• •• JNOW • KNOW ••IS REPLACED BY • •IS REPLACED BY •• JNOW C I •• KNOW C 1 •• ••••••0YES .0 IS JNOW 0. 40• LESS THAN0. JLAST .0-137-


ADDCHART CO <strong>1130</strong> COMMERCIAL NCOMP FUNCTIONA lA 3AIDE CA 3A 1CARRYDE CA 1DIVSTARTDPA CKDUNPKEDITFILL •• JNOWGETICO MPION DKEYBD•IS REPLACED BY•••• KNOWMOVE •IS REPLACED BY• K JNOW - J•MPYI NCOMP INSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPA CWHO LE•• NCOMP•IS REPLACED BY •• JCARDXJNOW./8RCARDUNOWB/B•.•.*NU IS NCOMP...•. EQUAL TO .•ZERO .*X•YES•••• JNOW•IS REPLACED BY• JNOW 6 1•SX.*.•IS JNOW NO•.OREATER THANJLAST .•.**YESXX•EXIT ••-138-


CHART NS <strong>1130</strong> COMMERCIAL NSIGN SUBROUTINEADDA lA 3A 1DECA3A1CARRYSTART DECA 1DIVDPACKDUNPK• •• NOLDS •EDIT*IS REPLACED BY •1• • FILLGETICOMPIOND• •• JIM •NO ..'Is TEST.0.- 'viesKEYBD*IS REPLACED BY • JCARDXJa •• MOVE•• HOLDS• IS REPLACED BY• -1•X••X..•..* *.LOW ..NMS•JTET HI...*. IS COMPARED .0...•. TO•.ZERO .•• •EOL.0.• ZERO**.A8MPYNCOMPNSIGN1N ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEX• •• JTEST •*IS REPLACED BY •-JTEST 1 ••.16•• JCAROXJa•IS REPLACED BY• JTEST•AEXIT-139-


ADDA 1A3A 1DECA3A1CARRYDE CA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNI NZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLECHART NZSTART• JTEST•IS REPLACED BY• JCARDEJa•.11........4.0 •• IS 4• 0. NO ... IS JTEST 0. 0. YES • NOLDZJTEST • X EQUAL TO X IS REPLACED BY•.NEGATIVE .4 •.24640 X-..•24. ... 0. ... •.4*YES*NC•• •••••.4..4 4..0.4 IS JTEST 4. . NOf. EQUAL TO AN S . 00. EBCDIC .0.•.2E110 404. .4YES.4.4 4.NU .4 IS NEMZ. 4 4.EQUAL TO .02 .04. .• i;S• NOLDZ• JCARDEJa •IS REPLACED BY•IS REPLACED BY • 5 E EJTEST -24640 • 4096a/4096• %EBCDIC - n ••X• NOLDZ•IS REPLACED BY4•<strong>1130</strong> COMMERCIAL NZONE SUBROUTINEgo.NU .4 . IS NOLDZ •.4.LESS THAN5 .0. .4*YES;.•..4 4.NO .0 IS NEMZ 0.• LESS THAN .0•. 5 .00. .44.*YES.4...0.4 .. IS NEW2 .. ... NO4. EQUAL TO .0...4. .4YES• JTEST•IS REPLACED BY-2 122 4• EEB:UI C I I-0.X• REPLACED BY•JTEST G 4096 ••2NEMZ - NOLDZaXEXIT-140-


CHART PU<strong>1130</strong> COMMERCIAL PACK/UNPAC SUBROUTINE• •• START UNPAC • START PACK •• • • ••• SET SWITCH AT SET SWITCH ATB4 TOUNPAC • PAD PACK•SAVEINDEX REGISTERCREATE ADDRESSOF JCARDXJaCREATE ADDRESSOF KCARD%Ka••CREATE ADDRESS•OF JCARD%JLASTD•• LOAD INDEX•REGISTER I WITH• ADDRESS OF• KCARD%Ko•• SHIFT HIGH ••ORDER CHARACTER•.TO LOW ORDER OF.• EXTENTION ••• LOAD ACCUM.• WITH NEXT• .1CARD CHARACTER•• ROTATE ACCUM.• AND EXTENTION•8 TO CREATE A2• FORMAT••84 0.YES IS *. NOSWITCHPACK .••'STORE ACCUM. IN• KCARD USING•INDEX REGISTER1••DECREMENT INDEX• REGISTER 1 BY1•XseNO HAS.....JCARDULASTo es•.BEEN DONE..e..YESX• SHIFT LOW•ORDE1 CHARACTER• TO EXTENTIUN••REPOSITION THE• 413H ORDER• CHARACTER• PLACE EBCDIC•BLANK, HEX 40,•IN LOW ORDER OFACCUMULATOR••STORE ACCUM. IN• KCARD USING• INDEX REGISTER• 1•••DECREMENT INDEX• REGISTER 1 BY•ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN ZONEPACK IPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERjUNPACIWHOLELOAD ACCUM.• WITH NEXT•JCARD CHARACTER•CREATERETURNADDRESS.SHIFT CHARACTER• IN EXTENTION• TO HIGH ORDER•OF ACCUMULATOR•RESTORE INDEXREGISTER 1• PLACE EBCDIC•BLANK, HEX 40,...•IN LOW ORDER OF• ACCUMULATOR•EXIT-141-mowRai H-nw IT 1 1 1 11 11.'11


ADDA 1A3A 1DECA3A1CARRYDECA 1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501!SKIP!STACKSUBS1403TYPERUNPACWHOLECHART PS• •••PRINT ••<strong>1130</strong> COMMERCIAL PRINT/SKIP SUBROUTINE• • O• • • •• START PRINT • • START SKIP •• • • ••••YES•IS..X.. PRINTER .•BUSY os•SET UP •ADDRESSES FOR •JCARD ••• REVERSE AND• PACK JCARD••NOX• RNTI G2•.2000, AREA, ERROR.•••X•• RESTORE INDEX••REGISTER 1•NO .• IS o.SUPPRESSION .0•.REQUESTED.•o. .••YES••••X• • PRNT1 • •SAVE INDEX • • CHANGE PRNT1REGISTER 1•• •SKIP REQUESTED • •CALL, 010, 2000, AT TO• • 2 G2• • • •EXIT-142-


CHART PT<strong>1130</strong> COMMERCIAL PUT SUBROUTINESTART•••IS REPLACED BY ••ABSZVARn6A0JST • TRUNCATED •X.0.0 6 0.N....GREATER THAN 0....ZERO. .41YESXJNOWIS REPLACED BYONEDIGSIS REPLACED BYDIGS / 10.0TRUNCATEDXJNOWIS REPLACED BYJLASTOIGTIS REPLACED BYDIGS / 10.0TRUNCATED• JCARDXJNOWn•IS REPLACED BY•256 • IFIXXDIGS• -10.0 DIGTo- •4032• •• DIGS •'IS REPLACED BY •• DIGT •• •• •• JNOW • YES ....IS JNOW....•I5 REPLACED BY •X GREATER THAN.0o JNEW — 1 • o. J 0.• • ... .•o. ..NOX.o.NU 0 IS VARLESS THAN .0ZERO 0..0*YESADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE.• ..0• JNOW • YES .0.•IS JNOW 0.•IS REPLACED BY •X• LESS THAN 0.• JNOW 6 1 • •. N .•• 4.. 01*•AO••• NZONE• JCARDJLAST, •• 2,JNOWEXIT-143-WW! WW I I ' AI D 11111'1.1.1 11 1 WM 1111111 1r WA WM!.


<strong>1130</strong> COMMERCIAL CHART P1P1403 SUBROUTINEADDA 1A3A 1DE CA3A 1CARRYDE CA1DIVDPA CKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE****(42********* ****04*********• * SSTART P1403 a• START S14,:3 a *a a*************** ********************C2********** C4* **.• e .a a.SAVE INDEX a AO .* IS A.REGISTER 1 * a SUPPRESSION .** a *.REQUESTEC.*a * a. .*ass************** a. .*a YESX*****02********** *****03********** *****04***********PRNT1 a *a SET UP a a- * CHANGE PRNI3 aADDRESSES FOR * * :CAgii020i,i.J0 ** JCARJ a •SKIP REQUESTED a I. a a a a0******004.***kita 4**************** * ***** ***********X*****E2**********a REVERSE AND ** PACK JCARD**********************E2**********CONVERT I/O a AREA FROM a*EBLOIC TO 1403 CODE *a a*****************. .G2 a..a a.YES .* IS a....a. PRINTER .a*. BUSY .*a. .aa. .a* NO*****H2**********aPRNT3*2000,AREA,ERROR* a4*************40)******j2**********a S RESTORE INDEX * REGISTER 1•aa ******************XX****K1*********EXIT ****************


11111•111011MI■IIMINII IYxl1S1 INI.111111111111111■11111 I I I .1 1.I....A.■■ I I I-9ti-******* *********** 11X3 aa********** Ole***x***SO ** ***** ***••a a* a* I b31515321 aa X3ONI 3a3153a ******* **** Eras***X53Aa' "a'aa' 0345INI3's*• 9NIA3Nna **••SI a' 3Na's kH"*"arl OHMD vaNnuacuu,COVESHas)I D NUSdIMSI 09 MIavauZVVT clCOMciIndHONflci&KM clNO WIalsIOZNNOISNclikODNAciiAla AOIATswamCINOIciWODIZapTIMnaaxdNnaND VcIlaAI CII voaaAuuvoVCVDaaTvCV' V(ICI Vaaaaaasemaaaa••a a3 p vor 3Sa3A3N* a**********E9*****asaaa•amaaaparaaaaboulp343110.J.::.20*IH3Nd***********Ei*****C,i4.404,*1,04,4,4***40.t amp3r *• Nna 53553000V aan 135 aa a**********E3*****asaaaatasaaaaas saa a* I 2;3151915a X3ONI ISIS a•**********E9*************•******aa 14411 1aV15*********0/****a piiinoaans 155Id1VIDU3WW0) OSTI td 18VH0


ADDCHART RP <strong>1130</strong> COMMERCIAL READ/PUNCH SUBROUTINEA 1A3A 1DECA3A1•START READ • • •CARRYDECA 1DIVDPACKDUNPKEDITFILLGETICOMPION DKEYBDMOVEMPYNCOMPNSIGNNZONEPACK• START PUNCH •SAVE INDEX SAVE INDEXREGISTER I • REGISTER L•SET P ADDRESSE U S FOR •JCARD•• CARDI •.1000.AREA.ERROR.• •XT P• ADDRESSES FOR• JCARD•REVERSEJCARDPRINT • SPEED • • SPEED0010,AREACI. 0011,• JCARDBJLASTo, •JCARDULAST0,.CHARACTER COUNT.AREAS1.COUNTI PUNCH ^PUTP1403P1442I READIR2501SKIPSTACKSUB51403TYPERUNPACWHOLEYESXERRORS•X•REVERSE •JCARD • ••NO.READING..X.. OR PUNCHING ..XxX• CARD1 ••2000.AREA.ERROR•• •YESRESTORE INDEXREGISTER 1EXIT-146-1 III II II I 1111111 111111111111111111


CHART R2<strong>1130</strong> COMMERCIAL R2501 SUBROUTINE■***A3********** ** START R25'1 ** ******** ***** ********E3*********** SAVE INDEX ** REGISTER 1 **♦*****************45* *c3s********** ** SET UP ** ADDRESSES FCR *♦ JCARD * ***********************02*********** FILL THE I/0 **AREA WITH ONES ** ***********************E3* *********READI *4-- **1 O ' ,* REA.ERRCR*:***************:*****X.3***********SPE ED *• !• ".."1"ARFACI, ** JCARC , IJLAST1, **CHARACTER CCUWT*4*** 4* 8* *88*** ii*e?'`•G1 5.YES .* ANY 4.ERRORS .5•* *.*.**NOADDA 1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READIR25011SKIPSTACKSUBS1403TYPERUNPACWHOLEX*****1-3***********• REVERSE JCARC ** ******************XX.*.J3. *..5 *.NC .* READING *....*. FINISHED .5*. .*5. .** YESX*****x3***************x4********** RESTORE INDEX * ** REGISTER 1 * X* EXIT** ***************4*** *****•*******-147-WAPIRAPIN WPMPXX.,1111


ADDCHART ST <strong>1130</strong> COMMERCIAL STACK SUBROUTINEA 1A3A 1 DE CA 3A 1CARRYDE CA 1DIVDPACKDUNPKEDITFILLGETSTARTICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZ ONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIP(STACKSUBS1403TYPERITNPA CWHO LE• SELECT THE •ALTERNATE• STACKER •EXIT-148-


CHART SU <strong>1130</strong> COMMERCIAL SUB SUBROUTINEADDA1A3A1DECA3A 1CARRYDE CA 1DIVDPACKDUNPKEDIT: START :FILLGETICOMPIOND• NSIGNKEYBDJCARD.JLAST. • ChJSIGN •MOVEMPYNCOMPNSIGN• ADD ••JCARD.J.JLAST. •N ZONEe l/CARD I K KLAST.I ••ERNPACKPRINTPUNCH• NSIGN • PUT• JCARD I JLAST. •• 0../SIGN • P1403EXIT :• •P1442READR2501SKIPSTACKSUBS1403TYPERUNPA CWHO LE-149-


ADDA 1A3A 1DECA3A1CARRYDECA 1DIVDPACKDUNPKEDITFILLGETICOMPION DKEYBDIMOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLECHART TK<strong>1130</strong> COMMERCIAL TYPER/KEYBD SUBROUTINE• • •• START TYPER• • START KEYBD •• • •SAVE INDEXREGISTER 1X xYES.* IS..X•. TYPEWRITERBUSY .••10• •SSAVE INDEX• REGISTER I•XXIS *. YES• KEYBOARD .•X..BUSY*•AtiT UP SET UPADDRESSES FOR • ADDRESSES FORJCARD JCARD• • •XX••MAKE CHARACTER• MAKE CHARACTER•COUNT SIXTY IF•COUNT SIXTY IFIT IS NOT• L ALREADY• ALREADY• TYPEDREVERSE ANDPACK JCARD • I0002AREA• •• EBPRT • *.IS NOCOCIO.AREAEI, • • KEYBOARD .•X..• AREAE12 .••CHARACTER COUNT.• YES•• TYPED • SPEED •• 2000,AREA • • 0010.AREAEI. •• JCARDEJLAST0, • • • COUNT/2 •XRESTORE INDEX REGISTER 1 ••XREVERSE JCARD • ••EXIT-150-


1CHART WHSET RESULT EQUAL TO •ZERO<strong>1130</strong> COMMERCIAL %HOLE FUNCTIONADDA 1A3A 1DE CA 3A1• STARTCARRY•DE CA 1DIVDPACKX• DUNPK• CALCULATE THE ••AMOUNT TO SHIFI•• RIGHTEDITFILLGET6. ICO MPIOND• •06 61.• IS 61. YES•. AMOUNTm. ZERO ••06 KEYBD•NO•MOVE•MPY06 *.NCOMP46.YES 0, IS o.NUMBER ALL 06•FRACTIONAL.•NSIGN.•66. 06•.10N ZONEPACK•XPRINTSHIFT RIGHT PUNCHTO DROP •FRACTIONAL PART. • PUTP1403P1442READSHIFT LEFT • TO F ILL WITH ZER OS •R2501• • •SKIPSTACKXSUBS1403STORE RESULTTY PERUNPACX XWHO LEEXIT-151-


LISTINGSADDA1A3A1DECA3A1CARRYDECA1DN// JOB// ASM• NAME ADDIID)•• ADD/SUB SUBROUTINES FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE IID)• LIST0008 01104000 ENT ADD ADD SUBROUTINE ENTRY POINT• CALL ADDIJCARD,J,JLASTACARD.KALASTIINERI• THE FIELD JCARDIJI THROUGH• JCARDIJLAST) IS ADDED TO THE• FIELD KCARDIKI THROUGH• KCARDIKLASTI.0000 22902000 ENT SUB SUBTRACT SUBROUTINE ENTRY POINT• CALL SUBIJCARD.J.JLASTACARD.K.KLAST.NER)• THE FIELD JCARDIJ) THROUGH• JCARDIJLASTI IS SUBTRACTED FROM• THE FIELD KCARDIK) THROUGHC5P00010CSP00020CSP00030C5P00040CSP000SOCSP00060CSP00070CSP00080CSP00090CSP00100CSP00110CSP00120CSP00130CSP00140CSP00150CSP00160•DPACKKCARDIKLASTI. CSP001700000 0 0000 SUB DC 'I.++ ARGUMENT ADDRESS COMES IN HERE. CSP001800001 0 COFELD SUB PICK UP ARGUMENT ADDRESS.CSP00190DUNPK 0002 0 0005STO ADD STORE IT AT ADD.CSPOO2000003 0 0002LD IHFS LOAD THE INSTRUCTION TO CHANGE CSP00210EDIT 0004 0 0028STO SWIT SIGN OF JCARD FOR SUBTRACT. CSP002200005 0 7005 MDX ADD+3 START COMPUTING. CSP00230FILL0006 0 FOSE IHFS FOR X HFFFF■SWIT■ 1 CHANGE SIGN OF SUBTRHND CSP002400007 0 7002 MDX MDX 46+2 SKIP OVER NEXT INSTRUCTION. CSP002500008 0 0000ADD DC •+ ARGUMENT ADDRESS COMES iN HERE. CSP00260GET0009 0 COFDLD MD* LOAD SKIP OVER INSTRUCTION. CSP00270000A 0 D022STO SWIT STORE IT AT SWIT.CSP00280ICOMP 0008 0 6970STX 1 SAVE1+1 SAVE IRlsCSP00290000C 01 65800008LOX 11 ADD PUT ARGUMENT ADDRESS IN IR1 CSP00300IOND 000E 0 C100LD 1 0 GET JCARD ADDRESSCSP00310000F 00 95800002 S 11 2 SUBTRACT JLAST VALUE CSP00320KEYBD0041 0 D049STO 00+1 PLACE ADDRESS FOR ADD OR SUBTR C5P003300012 0 8004A ONE+1 ADD CONSTANT OF ONECSP003400013 0 D017STO JPLUS+1 CREATE JCARDIJLASTI ADDRESS CSP00350MOVE 0014 00 C5800002LD 11 2 GET JLAST VALUECSP003600016 00 95800001 ONE S II 1 SUBTRACT J VALUECSP00370MPY0018 0 80FEA ONE+1 ADD CONSTANT OF ONECSP003800019 0 4808BSC + SKIP IF POSITIVECSP00390NCOMP 001A 0 COFCLD ONE+1 NEGATIVE OR ZERO-HAKE COUNT 1 CSP004000018 0 0038 STO COUNT+1 STORE JCARD LENGTH CSP00410001C 0 C103LO 1 3 GET KCARD ADDRESSCSP00420NSIGN001D 0 D044STO Kum PLACE IN CALLING SEQUENCE OF CSP00430001E 0 D062STO KCRD2 CARRY AND FILL SUBROUTINES CSP00440NZONE 001F 00 93800003S 11 5 SUBTRACT KLAST VALUECSP004500021 0 0037STO KCRD3+1 PLACE LOAD ADDR FOR ADD/SUB C5P00460PACK 0022 0 DO3ASTO KCII04+1 PLACE STORE ADDR FOR RESULT CSP004700023 0 004F STO KCRDS+1 PLACE SUBTRACT ADDRESS AND CSP00480PRINT0024 0 0050STO KCRD6+1 STORE ADDR FOR NEG CARRY CSP004900025 0 80F1A ONE+1 ADD CONSTANT OF ONECSP00$000026 0 D044STO KCRD7+1 PLACE ADDR FOR SIGN CHANGE CSP00510PUNCH 0027 0 0010STO KPLUS+1 PLACE ADDR OF SIGN OF KCARD CSP005200028 0 0106LD 1 6 GET NER ADDRESSCSP00530PUT0029 0 DOSESTO ERA+1 SAVE NER ADDRESSCSP00540• CLEAR AND SAVE SIGNS ON JCARD CSP00550P1403 • AND KCARD FIELDS. CSP00560002A 00 C4000000 JPLUS LD L •...• GET SIGN OF JCARD CSP00570P1442READR2501SKIPSTACKSUBS1403TYPERUNPA CWHOLE-152-


PAGE 2002C 0 D070 STO JSIGN SAVE SIGN OF JCARD CSP00580A1A3002D 0 7002 SWIT MDX •6.2 SKIP ON ADO-CHANGE SIGN ON SUBT CSP00590002E 01 04000026STO I JPLUS*1 STORE CHANGED SIGN OF JCARD CSP00600A 1 DEC0030 01 4C100037BSC L KPLUS.- DETERMINE SIGN OF JCARDCSP006100033 ca 04800026STO I JPLUS+1 STORE IT POSITIVECSP006300032 0 F069EOR HFFFF NEGATIVE - MAKE POSITIVECSP00620A3A 10035 01 74010041 MDX L OP.1 CHANGE OPERATION - SEE OP 6 OPR CSP006400037 00 C4000000 KPLUS LD L •..• GET SIGN OF KCARD' CSP00650 CARRY0039 0 0064003C 0 FOSFSTO KSIGN SAVE SIGN OF KCARDEOR HFFFF NEGATIVE ■ MAKE POSITIVECSP00660CSP00680003A 01 4C100041BSC L OP.- DETERMINE SIGN OF KCARDCSP00670DECA 1005D 01 D4800038003F 01 74010041STO I KPLUS+1 STORE IT POSITIVEMDX L OP.1 CHANGE OPERATION - SEE OP 6 OPRCSP00690CSP00700DIV• CALCULATE THE OPERATION.CSP00110• INITIALLY THIS IS FOR ADD. IT CSP00720DPA CK• CAN BE CHANGED UP TO TWO TIMES. CSP00730• AGAIN TO ADD• SEE OPR.CSP00750• FIRST TO SUBTRACT AND THEN BACK C5P00740DUNPK0042 0 0017STO DO STORE IT AT DOCSP007700041 0 C062OP LD OPR PICK UP OPERATIONCSP00760EDIT0043 0 C063LD OPO RESET THE PICK UP INSTRCTN TO + CSP007800044 0 DOFCSTO OP WITH INSTRUCTION AT OPOCSP00790FILL0045 0 C104 LD 1 4 GET ADDRESS OF K CSP008000046 0 DO1C STO K1 STORE IT AT K1 FOR CARRY SUBRTN CSP00810 GET0047 0 003A STO K2 AND AT K2 FOR FILL SUBROUTINE CSP00820• DETERMINE IF JCARD IS LONGER CSP00830ICO MP• THAN KCARD. KLAST+JLAST+J.KNOW CSP00840• IS COMPARED TO K. IF KNOW IS CSP00850• GREATER THAN OR EQUAL TO K GO CSP00860ION D• TO KLAS3 FOR ERROR.CSP008700048 00 C5800005LD 11 5 GET KLAST VALUECSP00880KEYBD004B 00 95800004 5 11 4 SUBTRACT K VALUE CSP00900MOVE004D 0 0021 STO COMP+1 SAVE FOR CMPLMNT ON NEG CARRY CSP00910S 11 2 SUBTRACT JLAST VALUECSP00920MPY004E 00 958000020050 00 85800001A 11 1 ADD J VALUECSP00930004A 0 0036 STO KLAS3+1 SAVE IT TO INDICATE ERROR CSP008900052 01 4C2800A0BSC L RETADI*2 IS JCARD LONGER THAN KCARD CSP009400054 0 7107MO% 1 7 NO-OK-MOVE OVER SEVEN ARGUMENTS CSP00950NCOMP0055 0 6928 SIX 1 DONE1+1 CREATE RETURN ADDRESSCSP00960• SETUP JNOWCSP00970NSIGN0056 00 65000000•COUNT LDX LI •-• LOAD JCARD LENGTH TO IR1JCAREHJNOW)CSP00980CSP01000• KCARDIKNOWPACARDIKNOW + OR - CSP00990N ZONE0058 00 C5000000 KCRD3 LD LI •-• LOAD KCARDIKNOWICSP01010005A 00 85000000 DO A LI •-• ADD OR SUBTRACT JCARDIJNOW/ CSP01020PACK005C 00 05000000• KNOW-KNOW+1 AND SEE IF JNOW ISKCRD4 STO LI •-• STORE RESULT IN KCARDIKNOW)CSP01040CSP01030• GREATER THAN JLAST. IF NOT, CSP01050• JNOW4JNOW*1 AND GO BACK FOR CSP01060• MORE.CSP01070005E 0 71FF005F 0 70F8MDX 1 -1 DECREMENT IR1MDX KCRD3 GO BACK FOR MORECSP01080CSP01090• RESOLVE CARRIES GENERATEDCSP01100• DURING OPERATION.CSP011100060 30 03059668 AGAIN CALL CARRY GO TO CARRY SUBROUTINE CSP01120ADDPRINTPUNCHPUTP1403P1442REA DR2501SKIPSTACKSUBS1403TYPERUNPA CWHO LE-153—II I NOW I I II....11.141.4i1P.U.014,■1111m.


ADDA1A3PAGE 30062 0 0000KCRDI DC II. KCARD ADDRESSCSP0<strong>1130</strong>0063 0 0000K1 DC•..• K ADDRESSCSP011400064 1 0087 KLAS1 DC KLAS3+1 KLAST ADDRESS CSP011500065 1 0008 DC ADD ADDRESS TO HOLD ANY CARRYCSP01160A1DEC•LET KNOW BE ANY RESULTING CARRY CSP01170•IF NEGATIVE, COMPLIMENT AND C5P01180A3A1•CHANGE THE SIGN OF KCARD. IF CSP01190• ZERO. ALL DONE. IF POSITIVE. CSP01200CARRY• OVERFLOW ERROR.CSP012100066 01 4C18008A BSC L FIN,.... CHECK FOR ZERO-YES GO TO FIN CSP01220DECA10068 01 4C100080 BSC L ERR9.- NO-CHECK FOR OVERFLOW-YES ERR9 CSP01230006A 00 84000000 KCRD7 A L • .0• COMPLIMENT-ADD CARRY TO LOW CSP01240006C 01 D4800068 STO I KCRD7+1 ORDER AND STORE IT BACKCSP01250DIV•COMPLIMENT ■ SUBTRACT EACHCSP01260•DIGIT FROM 9 AND CHANGE THE CSP01270DPACK•SIGN OF KCARD.CSP01280006E 00 65000000 COMP LDX LI •• LOAD IRS WITH LENGTH OF KCARD C5P01290DUNPK 0070 0 7101MDX 1 1 ADD 1 TO GET THE TRUE LENGTH CSP013000071 0 CO2E LD NINE LOAD A NINE. CSP013100072 00 95000000 KCRD5 5 LI •...•EDITSUBTRACT KCARDIKNOW/ CSP013200074 00 D5000000 KCRD6 STO LI •• PUT BACK IN KCARDIKNOWI CSP01330• SEE IF KNOW IS GREATER THAN CSP01340FILL • KLAST. IF NOT, KNOW•KNOw+1 CSP013500076 0 TIFFMDX 1 -1 DECREMENT IRSCSP01860GET0077 0 7CF9MDX COMP+3 GO BACK FOR MORECSP013700078 0 0026LD KSIGNCSP01380ICOMP 0079 0 FOFAEOR KCRD6CSP01390007A 0 D024 STO KSIGN SET SIGN OF KCARD CSP01400IOND0078 0 70E4 MDX AGAIN CHECK AGAIN FOR CARRIES CSP01410007C 00 65000000 SAVES LOX LI •• RESTORE IRS CSP01420007E 00 4C000000 DONEI BSC L •-• RETURN TO CALLING PROGRAMKEYBDCSP01430•ERROR .. ERROR ■ OVERFLOW- - CSP014400080 30 062534C0 ERR9 CALL FILL FILL KCARD WITH NINES.CSP01450MOVE0082 0 0000KCRD2 DC•..• ADDRESS OF KCARDCSP014600083 0 0000K2 DC •► ADDRESS OF KCSP01470MPY0084 1 0087KLAS2 DC KLAS3+1 ADDRESS KLASTC5P014800085 1 00A0 DC NINE FILL CHARACTER CSP01490NCOMP0086 00 65000000 KLAS3 LDX LI •• PICK UP KLAST VALUE CSP015000088 00'60000000 ERA SIX LI •-• STORE VALUE AT NER C$P01510C5P01520• RESTORE SIGNS ON JCARD ANDNSIGN • KCARD FIELDS008A 0 C013FIN LD JS1GN PICK UP SIGN OF JCARDNZONE 0088 01 D4800028STO I JPLUS+1 AND RESTORE IT008D 0 C011LD KSIGN PICK UP SIGN OF KCARDPACK008E 01 4C280095BSC L NEG.+2 CHECK FOR PLUS OR MINUSCSP01530CSP01540C5P01550CSP01560CSP015700090 01 C4800038 LO I KPLUS+1 PLUS-GET NEW SIGN AND CSP01580PRINT0092 01 4C280099 BSC L REVI+Z REVERSE IT IF NEGATIVE CSP015900094 0 70E7 MDX SAVE1 POSITIVE -ALL DONE-GO TO EXIT CSP016000095 01 C4800038 NEG LD I KPLUS+1 MINUS-GET NEW SIGN ANDCSP016100097 01 4C28007CBSC L SAVE111+2 GO TO EXIT IF NOT NEGATIVE C5P016200099 0 F003REV EOR HFFFF REVERSE THE SIGNCSP01630009A 01 D4800038STO I KPLUS+1 STORE IT BACKCSP01640009C 0 70DFMDX SAVE1 ALL DONE-GO TO EXITCSP01650009D 0 FFFFHFFFF DC /FFFF CONSTANT OF ALL BINARY ONES CSP01660009E 0 0000 JSIGN DC •-• SIGN OF JCARD CSP01670PUNCHPUTP1403P1442READR2501SKIPSTACKSUB PAGE 451403 009F 0 0000 KSIGN DC •.■• SIGN OF KCARD CSP0168000A0 0 0009 NINE DC 9 CONSTANT OF NINE CSP0169000A1 0 7107 RETAD MDXTYPER1 7 MOVE OVER SEVEN ARGUMENTS CSP0170000A2 0 69DC STX 1 DONE1+1 CREATE RETURN ADDRESS C5P0171000A3 01 4C000086BSC L KLAS3 GO TO KLAS3UNPACCSP0172000A5 00 85000000 OPR A LI •.• ADD FOR ADD OR SUBTRACT OPERATN C$P0173000A7ORG OPR+1 RESET THE ADDRESS COUNTERCSP01740WHOLE 00A6 00 950000005 LI •■• SUBTR FOR ADD OR SUBTR OPRATN CSP0175000A8 ORG OPR+2 RESET THE ADDRESS COUNTER C5P0176000A7 00 85000000 A LI ••• ADD FOR ADD OR SUBTRACT OPERATN CSP0177000A9 ORG OPR+3 RESET THE ADDRESS COUNTER CSP0178000A8 0 C063 OPO LD X OPR-OP-1 FOR RESETING THE 1NSTRCTN C5P01790• AT OP TO ITS INITIAL STATE CSP01800OOAA END CSP01810NO ERRORS IN ABOVE ASSEMBLY.// DUPCSP01820'STORE WS WA ADD3418 000CCSP01830


ADDA lA 3A 1DECA3A1CARRYDE CA 1C5P01960DIVDPACKDUN PKEDITFILLGETICO MPIONDKEYBDMOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUT0032 80I6 A D20 ADJUST FIRST VALUE CSP02390 P14030033 DOD2 HOLD STO A3A1 SAVE FIRST CHARACTER VALUE CSP02400P1442READR2501SKIPSTACKSUBS1403TY PERUNPACWHOLECSP01840// ASM** A1A3/A3A1 SUBROUTINES FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101 C5P018501101 CSP01860* NAME A1A3CSP01870• LIST0000 01C41CCO ENT A1A3 AlA3 SUBROUTINE ENTRY POINT CSP01880* CALL AlA31JCARD.J.JLAST.KCARD.KIPICHA R 1CSP01890• THE WORDS JCARDIJ) THROUGHCSP01900• JCARDIJLAST/ IN Al FORMAT ARECSP01910CRAMMED INTO KCARD IN A3 FORMAT. CSP019200006 OICCIC40ENT A3A1 A3A1 SUBROUTINE ENTRY POINT CSP01930* CALL ASAIWCARD,J.JLAST.KCARDIIKIIICHAR1 CSP01940* THE WORDS JCARDIJI THROUGHCSP01950* JCARDWLASTI IN A9 FORMAT ARE* UNCRAMMED INTO KCARD IN Al FORMAT. CSP019700000 0000A1A3 DC 'I..* ARGUMENT ADDRESS COMES IN HERE C5P019800001 0002LD SW1 LOAD BRANCH TO ELSECSP019900002 DO2ASTO SWTCH STORE BRANCH AT SWITCHC5P020000003 7007MDX START START COMPUTINGCSP020100004 7021SW1 MDX X ELSE-SWTCH-1 BRANCH TO ELSECSP020200005 7000 SW2 MD% X 0 NOP INSTRUCTION CSP020300006 0000A3A1 DC *-* ARGUMENT ADDRESS COMES IN HERE CSP020400007 COFELD A3A1 PICK UP ARGUMENT ADDRESS AND CSP020500008 DOF7STO A1A3 STORE IT IN A1A3CSP020600009 COFBLD SW2 LOAD NOP INSTRUCTIONCSP02070000A D022STO SWTCH STORE NOP AT SWITCHCSP02080000E1 6965START STX 1 SAVE1+1 SAVE IR1CSP02090000C 6A66 ST% 2 5AVE2+1 SAVE IR2 CSP02100000D 6B67STX 3 SAVE3+1 SAVE IR3CSP02110000E 1 65800000LDX II AOA3 PUT ARGUMENT ADDRESS IN IR1 CSP021200010 C100LD 1 0 GET JCARD ADDRESSCSP021300011 0 95800002S 11 2 SUBTRACT JLAST VALUECSP021400013 0018STO JCARD+1 CREATE JCARDIJ/ ADDRESS CSP021500014 DO3FSTO OVR1+1 STORE JCARD(J) ADDRESSC5P021600015 D044 STO OVR2+1 STORE JCARDIJI ADDRESS CSP021700016 C103LD 1 3 GET KCARD ADDRESSCSP021800017 8006A ONE+1 ADD CONSTANT OF 1CSP021900018 0 95800004S 11 4 SUBTRACT K VALUECSP02200001A DOODSTO KCARD+1 CREATE KCARDIK/ ADDRESS CSP0221000113 0 C5800002LO 11 2 GET JLAST VALUECSP02220001D 0 95800001 ONE S Ii 1 SUBTRACT J VALUECSP02230a OO1F 80FE A ONE+1 ADD CONSTANT OF 1 CSP022400020 D009STO CNT+l CREATE FIELD WIDTHCSP022500021 C105LD 1 5 GET !CHAR ADDRESSC5P022600022 9028S 040 SUBTRACT CONSTANT OF 40CSP022700029 D060STO TABLE+1 CREATE TABLE END ADDRESS CSP022800024 D066STO TCODE+1 STORE TABLE END ADDRESS CSP02290e0025 7106MD% 1 6 ADJUST OVER 6 ARGUMENTSC5P023000026 6950STX 1 DONE1+1 CREATE RETURN ADDRESSCSP023100027 0 65000000 KCARD LOX LI *-* PUT KCARD ADDRESS IN IR1CSP023200029 0 66000000 CNT LDX L2 4.." PUT FIELD WIDTH IN IR2 CSP023300026 0 C6000000 JCARD LD L2 *-* PICK UP JCARDIJ/C5P02340002D 7000SWTCH MD% X 0 SWITCH BETWEEN CRAM AND UNCMCSP02350002E 1 4C280047BSC L MINUS.+Z TEST SIGN OF INTEGERCSP023600030 1890SRT 16 SHIFT INTEGER TO EXTENSIONCSP023700031 A818 D D1600 DIVIDE BY 1600 CSP02380-155-


ADD PAGE 20024 0A 1A31810 SRA 16 ZERO ACCUMULATOR CSP024100035 0 A815 D 040 DIVIDE BY 40 CSP024200036 0 DOC9STO A1A3 SAVE SECOND CHARACTER VALUEAIDE CCSP024300037 0 1090SLT 16 SHIFT THIRD CHAR VALUE TO ACCUM CSP024400030 01 4400007EBSI L DECOD DECODE THIRD CHARACTERCSP02450A 3A 1003A 0 D1FESTO 1 -2 STORE THIRD CHARACTERCSP024600038 0 COC4 LD ALAS GET SECOND CHARACTER CSP02470CARRY 003C 01 4400007E BSI L DECOD DECODE SECOND CHARACTER CSP02480003E 0 D1FF STO 1 -1 STORE SECOND CHARACTER CSP02490003F 0 COCOLDDE CA1A3A1 GET FIRST CHARACTERC5P025000040 01 4400007E851 L DECOD DECODE FIRST CHARACTERCSP025100042 0 0100STO 1 0 STORE FIRST CHARACTERCSP02520DIV0043 0 71FDMD% 1 -3 DECREMENT Al OUT ARRAYC5P02530DPACK 0045 0 70E5 MDX JCARD FIELDWIDTHIS NOTZERO CSP025500044 0 72FF MOX 2 -1 DECREMENT FI ELO W IDTHC5P02540DUNPK0046 0 7029 MDX SAVE] GO TO RESTORE AND RETURN CSP025600047 0 8004 MINUS A D32K ADJUST FOR NEGATIVE INTEGER C5P025700048 0 1890 SRT 16 SHIFT INTEGER TO EXTENSION CSP02580EDIT004A 0 70E8MD% HOLD GO TO GET THE REMAINING INTEGERS CSP026000049 0 A803D 01600 DIVIDE BY 1600CSP02590FILL0048 0 0028 040 DC 40 CONST ANT OF 40CSP02610004C 0 7000 032K DC 32000CONSTANT OF32000 C5P02620GET CSP02640004F 0 DOB6 ELSE STO A3A1 STORE FIRST Al CHARACTER CSP026500050 0 72FFMDX 2 -1 DECREMENT FIELD WIDTHCSP02660ICOMP0051 0 7001MDX OVR1 GO TO GET NEXT CHARACTERCSP026700040 0 0640004E 0 0014D1600 DC020 DC1600 CONSTANT OF 1600 C5P0263020 CONSTANT OF 200052 0 7025MDX FILL1 LAST CHARACTER-WILL WITH BLANK CSP02680IOND0053 00 C6000000 OVR1 LD L2 *-* GET SECOND CHARACTER CSP02690KEYBD 0056 0 72FF MDX 2 -1DECREMENTFIELDWIDTH CSP027100055 0 DOAA STO A LAS STORE SECOND CHARACTERCSP02700MOVE0057 0 7001 MD% OVR2 GO TO GET NEXT CHARACTER CSP027200038 0 7021MDX FILL2 LAST CHARACTER-FILL BLANK CSP027300059 00 C6000000 OVR2 LD L2 •.* GET THIRD CHARACTER CSP02740005B 01 44000087 RET BSI L CODE CODE CHARACTER TO NUMBER CSP02750MPY0050 0 DOCASTO KCARDS1 SAVE NUMBR OF THIRD CHARACTER CSP02760005E 0 COA1 LO AlA3 GET SECOND CHARACTERCSP02770N COMP 005F 01 44000007 BSI L CODE CODESECONDCHARACTER CSP02780NSIGN0061 0 AOE9 M 040 MULTIPLY BY 40 AND CSP027900062 0 1090 SLT 16 SHIFT TO ACCUMULATOR C5P028000063 0 80C4 A KCARD+1 ADD NUM/MR(1141RM AND CSP028100064 0 DOC3STO KCARD+1 SAVE REsULTING INTEGER CSP02820N ZONE 0065 0 COAOLD A3A1 GET FIRST CHARACTER CSP028300066 44000087 BSI L CODE CODE FIRS T CHARACTER CSP02840PACK0068 01 90E5S020 SUBTRACT 20CSP02850PRINT0069 0 AOE3 M D1600 MULTIPLY BY 1600 CSP0060006A 0 1090 SLY 16 SHIFT TO ACCUMULATOR CSP02870PUNCH006C 0 0100STO 1 0 STORE IN AS ARRAY CSP02890006D 0 71FFMDX 1 -1 NEXT WORD IN A3 ARRAY C5P02900006B 0 8OBC A KCARD+1 ADD IN PREVIOUS RESULT CSP02880006E 0 72FFMDX 2 -1 DECREMENT FIELD WIDTH CSP02910PUT006F 0 7088MD% JCARD GET MORE Al CHARACTERS CSP029200070 00 65000000 SAVE1 LDX LI 46-4 RESTORE IRI C5P02930P1403 0072 00 66000000 SAVE2 LOX L2 *.* RESTORE IR2 CSP029400074 00 67000000 SAVES LOX L3 •-* RESTORE IRS CSP02950P1442READR2501SKIPSTACKSUBS1403PAGE 30076 00 4C000000 DONE1 BSC L *.-* RETURN TO CALLING PROGRAM CSP02960TV 0078 0 C004 FILLI LD H4040 FILL WITH TWO BLANKS CSP029700079 0 0006 STO ALAS STORE SECOND CHARACTER BLANK C5P02980007A 0 C002FILL2 LD H4040 FILL WITH ONE BLANKSP02990UNPAC 0078 0 7201MDX 2 I SET IR1 TO 1 CSP03000C007C 0 70DE MD% RET GO TO CODE ROUT I NECSP03010WHO LE 007D 0 4040 H4040 D /4040CONSTANT OF AlBLANK CSP03020007E 0 0000 DECOD DC •-* DECODE RETURN ADDRESS GOES HERE CSP03030007F 0 809E A ONE+1 ADD ONE TO NUMBER GIVING CSP030400080 0 0001 STO PLACE+1 SUBSCRIPT OF TABLE AND SAVE CSP030500081 00 67000000 PLACE LOX L3 '-* LOAD IRS WITH SUBSCRIPT OF TABLE CSP030600083 00 C7000000 TABLE LD L3 4*,-* GET Al CHARACTER CSP030700085 01 400007E BSC I DECOD RETURN CSP030800087 0 0000 CODE DC •-* CODE RETURN ADDRESS GOES HERE CSP030900088 0 00F5 STO DECOD SAVE THE CHARACTER TO BE CODED CSP031000089 0 6328 LDX 3 40 LOAD IRS WITH THE TABLE LENGTH-40 CSP03110008A 00 C7000000 TCODE LD L3 •-* LOAD CHARACTER FROM ICHAR ARRAY OP03120008C 0 FOF1 FOR DECO. ZERO ACCUMULATOR IF MATCH CSP031300080 01 4C200094 BSC L OUT.Z GO TO PUT IF NOT ZERO CSP03140000F 0 6BEE AWAY STX 3 DECOD SAVE SUBSCRIPT OF MATCH C5P031500090 0 COED LD DECOD LOAD SUBSCRIPT C5P031600091 0 908C S ONE+1 SUBTRACT ONE GIVING NUMBER C5P031700092 01 4C000007 BSC I CODE RETURN CSP031800094 0 73FF OUT MDX 3 -1 DECREMENT THROUGH THE TABLE-ICHAR CSP031900095 0 70F4 MDX TCODE GO TRY AGAIN CSP032000096 0 COE6 LD H4040 NOT IN THE TABLE - LOAD A BLANK CSP032100097 0 70F0 MDX CODE+1 GO BACK TO CODE THE BLANK•••• C5P032200098 END CSP03230NO ERRORS IN ABOVE ASSEMBLY.// OUP*STORE WS UA ALAS3332 000ACSP03240C5P03250-156-


ADDA1A3// ASMCSP03260•• A1DEC SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101 CSP09270• NAME A1DEC(101 CSP03280• LISTCSP032900001 01C44143 ENT A1DEC A1DEC SUBROUTINE ENTRY POINT CSP03300A1DEC• CALL A1DECIJCARD.J.JLAST.NER1 CSP03310•THE WORDS JCARDW/ THROUGH CSP09320A3A1JCARD(JLAST) ARE CONVERTED FROM C5P03330•Al FORMAT TO Dl FORMAT AND THE CSP03340•ORIGINAL DATA IS REPLACED BY THE CSP03350CARRY•CONVERTED DATA. CSP033600000 0 0004FOUR DC 4 CONSTANT OF FOUR CSP03370 DE CA 10001 0 0000 A1DEC DC •• ARGUMENT ADDRESS COMES IN HERE CSP033800002 0 6941 STX 1 SAVE1+1 SAVE IR1 CSP03390DIV0003 01 65800001 LDX 11 A1DEC PUT ARGUMENT ADDRESS IN IR1 CSP0340000050006 0 C100LD 1 0 GET JCARD ADDRESS CSP034100 0017STO JCRD1 SETUP JCARD ADDRESS FOR NZONE CSP03420DPACK00070009 00 95800002 TWO S Il 2 SUBTRACT JLAST VALUE CSP034300 00113STO PICK+1 PLACE LOAD ADDRESS FOR CONVRS CSP03440DUNPK000A 0 002C STO PUT+1 PLACE STORE ADDRESS FOR CONVRS CSP034500008000C 00 8007A ONE+1 ADD CONSTANT OF ONE CSP034600033STO LAST+1 PLACE ADDRESS OF SIGN POSITON CSP03470EDIT0000000E 0 C102LD 1 2 GET JLAST ADDRESS CSP034800 0010STO JLAS1 SETUP JLAST ADDRESS FOR NZONE C5P03490FILL000F 01 C480001FLD I JLAS1 GET JLAST VALUE AND CSP035000011 0 DOEFSTO A1DEC SAVE IT AT A1DEC CSP03510GET0012 00 95800001 ONE S Il 1 SUBTRACT J VALUE CSP035200014 0 BOFE A ONE+1 ADO CONSTANT OF ONE CSP03530 ICOMP0015 0 4808 BSC + CHECK FIELD WIDTH CSP0354000160017 0 COFCLD ONE+1 ZERO OR NEGATIVE-MAKE IT ONE CSP035500 0005STO COUNT+1 OK-SAVE WIDTH IN COUNT CSP03560IOND00180019 0 C103LD 1 3 GET NER ADDRESS CSP035700 D016STO ERA+1 SAVE IT CSP03580 KEYBD001A 0 7104 MD% 1 4 MOVE OVER FOUR ARGUMENTS CSP035900018 0 692A STX 1 DONE1+1 CREATE RETURN ADDRESS CSP03600 MOVE• REMOVE AND SAVE THE SIGN CSP03610001C001E 30 15A56545CALL NZONE REMOVE THE ZONE OVER LOW ORDER CSP036200 0000JCRD1 DC •• ADDRESS OF JCARD C5P03630MPY001F0020 0 0000JLAS1 DC •• ADDRESS OF JLAST CSP036401 0000DC FOUR ADDRESS OF CONSTANT OF FOUR CSP03650NCOMP0021 1 001E DC JCRD1 ADDRESS OF OLD ZONE CSP03660• JNOW.J CSP03670 NSIGN0022 00 65000000 COUNT LDX L1 •w• LOAD IR1 WITH FIELD WIDTH CSP03680• JTEST•JCARDIJNOW CSP036900024 00 C5000000 PICK LD LI •• PICK UP JCARDIJNOW) AND CSP03700NZONE00260028 01 4C100032BSC L POS.- CHECK IT AGAINST ZERO CSP037100 901ES ZERO NEGATIVE-IS IT LESS THAN CSP03720PACK0029 01 4C100035 BSC L OK.- AN EBCDIC ZERO CSP03730•NER•JNOW CSP03740 PRINT0028 0 69F7 ERR STX 1 COUNT+1 YES ERROR CSP03750002C 0 COD4 LD A1DEC COMPUTE THE SUBSCRIPT CSP03760 PUNCH002D 0 90F5 S COUNT+1 OF THIS CHARACTER IN CSP03770002E 0002F 00 0400000080E4A 00E+1 THE ARRAY AND CSP03780ERA STO L •-• STORE THE SUBSCRIPT AT NER CSP03790PUT00310032 0 7006MDX MORE GO GET THE NEXT CHARACTER CSP038000 9015POS S BLANK NOT NEGATIVE IS IT AN CSP03810P14030033 01 4C2000219 BSC L ERR.2 EBCDIC BLANK CSP03820P1442REA DR2501SKIPSTACKSUBPAGE 2S1403• JTEST • 4032 IS NOW IN ACCUM CSP03830SHIFT 8 IS SAME AS DIVIDE BY 256 CSP038408 EITHER BLANK OR DIGIT PUT CSP03850 TYPE R0035 0 1808•OK SRA0036 00 05000000 PUT STO•Ll •• THE FOUR BITS OF DECIMAL BACK CSP03860SEE IF JNOW IS LESS THAN JLAST. CSP03870UNPA C• IF YES, JNOW4JNOW+1 AND GO BACK CSP03880• FOR MORE. IF NO. SET UP THE CSP03890• SIGN. CSP03900WHO LE0038 0 TIFF MORE MDX 1 -. 1 DECREMENT THE FIELD WIDTH CSP039100039 0 70EA MDX PICK GO BACK FOR MORE CSP03920• WAS THE ORIGINAL SIGN INDICATION CSP03930• TWO. IF NOT, ALL DONE. IF YES CSP03940• MAKE THE SIGN NEGATIVE. CSP03950• JCAROULAST)*JCAROWLASTI 1 CSP03960003A 0 COE3 LD JCRD1 PICK UP THE OLD ZONE AND CSP039700038 0 9000 S TWO+1 CHECK IT AGAINST TWO CSP03980003C 01 4C200043 BSC L SAVEla IF NO MATCH GO TO EXIT CSP03990009E 0 9004 S ONE+1 IF MATCH. MAKE THE C5PO4000003F 00 F4000000 LAST FOR L •• SIGN NEGATIVEILOW ORDER) AND CSPO40100041 01 04800040 STO I LAST+1 STORE IT BACK CSPO4020• EXIT CSPO40300043 00 65000000 SAVE1 LDX0045 00 4C000000 DONE1 BSCLI •-• RESTORE IR1 CSPO4040L 0• RETURN TO CALLING PROGRAM CSPO40500047 0 F040 ZERO DC /F040 CONSTANT OF EBCDIC ZERO CSPO40600048 0 4040 BLANK DC /4040 CONSTANT OF EBCDIC BLANK CSPO4070004A END CSPO4080NO ERRORS IN ABOVE ASSEMBLY.// DUP•STORE WS UA A1DEC393C 0003CSPO4090CSPO4100-157-


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLE// ASMCSPO4110►• CARRY SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID) CSPO4120• NAME CARRY (10) CSPO4130• LISTC5PO41400000 03059668 ENT CARRY CARRY SUBROUTINE ENTRY POINT CSPO4150• CALL CARRYIJCARDWoJLAST.KARRY) CSPO4160• THE WORDS JCARDIJI THROUGH CSPO4170• JCARDWLAST) ARE CHECKED TO SEE CSPO4180• THAT THEY ARE BETWEEN ZERO AND GSPO4190• NINE. IF THEY ARE NOT, THE CSPO4200• UNITS DIGIT REMAINS AND THE TENS C5PO4210• DIGIT IS TREATED AS A CARRY TO CSPO4220• THE NEXT WORD. CSPO42300000 0 0000 CARRY DC •...• ARGUMENT ADDRESS COMES IN HERE CSPO42400001 0 6930 SIX 1 SAVE1+1 SAVE IR1 CSPO42500002 01 65800000 LOX 11 CARRY PUT ARGUMENT ADDRESS IN IR1 CSPO42600004 0 C100 LD 1 0 GET JCARD ADDRESS CSPO42700005 00 95800002 S Il 2 SUBTRACT JLAST VALUE CSPO42800007 0 8004 A ONE+1 ADD CONSTANT OF ONE CSPO42900008 0 D011 STO SRCE+1 CREATE JCARD(JLAST) ADDRESS CSPO43000009 00 C5800002 LD Il 2 GET JLAST VALUE CSPO43100008 00 95800001 ONE S 11 1 SUBTRACT J VALUE CSPO4320000D 0 80FE A ONE+1 ADD CONSTANT OF ONE C5PO4330000E 0 4808 BSC + CHECK FIELD WIDTH CSPO4340000F 0 COFC LD ONE+1 ZERO OR NEGATIVE-MAKE IT ONE CSPO43500010 0 D007 STO COUNT+1 OK —SAVE WIDTH IN COUNT CSPO43600011 0 C103 LO 1 3 GET KARRY ADDRESS CSPO43700012 0 DO1D STO OVF+1 AND SAVE IT CSPO43800013 0 7104 MDX 1 4 MOVE OVER FOUR ARGUMENTS CSPO43900014 0 691E STX 1 DONE1+1 CREATE RETURN ADDRESS CSPO44000015 0 JOAO SLT 32 CLEAR THE ACCUMULATOR AND EXTEN CSPO4410• LET CARRY BE THE SAME AS NCARY CSPO44200016 0 DOES STO CARRY SET NCARY TO ZERO CSPO44300017 00 65000000 COUNT LDX Ll •■• LOAD IR1 WITH THE FIELD WIDTH CSPO4440• THE NEXT INSTRUCTION STARTS OUT CSPO4450• BY PICKING UP JCARD(JLASTI. CSPO4460• THE SUBSCRIPT IS DECREMENTED BY CSPO4470• THE INSTRUCTION AFTER POSZ. CSPO4450• THE CALCULATIONS ARE.. CSPO4490• JTEST.JCARD1JNOW)+NCARY CSPO4500• NCARY•JTEST/10 CSPO4510• JTEST•JTES.N10•NCARY CSPO45200019 00 C4000000 SRCE LD L •• PICK UP JCARD1JNOW) CSPO453000111 0 80E4 A CARRY ADD THE PREVIOUS CARRY TO IT CSPO4540001C 0 1890 SRT 16 SHIFT THE ACCUM TO THE EXTENTON CSPO4550001D 0 A817 D TEN DIVIDE BY TEN AND CSPO4560001E 0 DOE1 STO CARRY STORE THE QUOTIENT AT NCARY C5PO4570• THE QUOTIENT IS THE GENERATED CSPO4580• • CARRY. CSPO4590001F 0 1090 SLT 16 PUT REMAINDER IN ACCUMULATOR AN CSPO46000020 01 4C100028 BSC L POSZ, — CHECK TO SEE IF NEGATIVE —NO .. CSPO4610• GO TO POSZ CSPO46200022 0 8012 A TEN YES COMPLIMENT BY ADDING TEN CSPO46300023 0 1890 SRT 16 STORE TEMPORARILY IN EXTENTION CSPO46400024 0 CODB LD CARRY LOAD NCARY CSPO46500025 0 90E6 S ONE+1 AND SUBTRACT CSPO46600026 0 DOD9 STO CARRY ONE FROM IT C5PO4670PAGE 2JCARD(JNOW).JTEST CSPO46800027 0 1090 SLT 16 SHIFT COMPLIMENTED REMAINDER CSPO4690• BACK TO ACCUMULATOR CSPO47000028 01 0480001A POSZ STO I SRCE+1 AND STORE IN RESULT CSPO4710• JNOW•JNOW1 CSPO4720002A 01 7401001A MD% L SRCE+1.1 GO TO NEXT DIGIT OF JCARD CSPO4730IF JNOW IS LESS THAN J. ALL CSPO4740DONE. OTHERWISE, GET THE NEXT CSPO4750DIGIT.CSPO4760002C 0 71FF MDX 1 • 1 DECREMENT THE FIELD WIDTH CSPO4770002D 0 70E8 MDX SRCE GO BACK FOR NEXT DIGIT C5PO4780• KARRY•NCARY CSPO4790002E 0 COD1 LD CARRY ALL DONE PICK UP ANY CSPO4800002F 00 04000000 OVF STO L •—• GENERATED CARRY AND STORE IT CSPO4810• AR KARRY. EXIT CSPO48200031 00 65000000 SAVE1 LDX Ll •• RESTORE IR1 CSPO48300033 00 4C000000 DONE1 BSC L •► RETURN TO CALLING PROGRAM CSPO48400035 0 000A TEN DC 10 CONSTANT OF TEN CSPO48500036 END CSPO4860NO ERRORS IN ABOVE ASSEMBLY.// OUP CSPO4870►STORE WS UA CARRY3341 0004CSPO4880-158-


szt// ASMCSPO4890•• DECAL SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 110) CSPO4900• NAME DECAL(ID) CSPO4910A lA 3• LISTCSPO49200000 04143071 ENT DECAL DECAL SUBROUTINE ENTRY POINT CSPO4930CALL DECAMJCARD,J.JLASTMER) CSPO4940A IDE C41.THE WORDS JCARD(J) THROUGH CSPO4950•JCARDULAST1 ARE CONVERTED FROM CSPO4960A3A1• 01 FORMAT TO Al FORMAT AND THE CSPO4970• ORIGINAL DATA IS REPLACED BY THE CSPO4980CARRYDE CA 1DIV0006 00 95800002 TWO 5 11 2 SUBTRACT JLAST VALUE CSP05050 DPACK0008 0 D020 STO PICK+1 PLACE LOAD ADDRESS FOR CONVRSN CSP05060PUT+1 PLACE STORE ADDRESS FOR CONVRSN CSP05070DUN PKEDITFILL0011 00 93800001 ONE S II 1 SUBTRACT J VALUE CSP05140GET0013 0 BOFEA ONE+1 ADD CONSTANT OF ONE CSP051500014 0 4808BSC + CHECK FIELD WIDTH CSP051600015 0 COFCLD ONE+1 NEGATIVE OR ZERO —MAKE IT ONE CSP05170ICO MPION D0019 0 7104 MDX 1 4 MOVE OVER FOUR ARGUMENTS CSP05210KEYBD001A 0 6928 STX 1 DONEI+1 CREATE RETURN ADDRESS CSP05220•CHECK THE SIGN OF JCARD. IF CSP05230MOVEMPYNCO MPNSIGNNZONE0025 0 00F6 GO STO TEST+1.STORE ACCUMULATOR TO SAVE SIGN CSP05340•JNOW4J CSP05350 PACK0026 00 65000000 COUNT LOX LI •-• LOAD IR1 WITH FIELD WIDTH CSP05360•JTEST-JCARD(JNOW) CSPOS3700028 00 C5000000 PICKPRINTLD LI •,-• PICK UP JCARDIJNOWI CSP05380002A 01 4C100033 BSC L OK.- AND CHECK IT AGAINST ZERO CSP05390•NER-JNOW CSPOS400 PUNCH002C 0 69FAERR STX 1 COUNT+1 LESS THAN - ERROR CSP05410002D 0 COD2LD DECAL CALCULATE THE SUBSCRIPT CSP05420PUT002E 0 90F8 S COUNT+1 OF THIS DIGIT CSP05430002F 0 80E2A ONE+1 AND STORECSP054400030P140300 D4000000 ERA STO L •• IT AT NER CSP05450000000010009 0000A 0000C0016••001F002100D030800700NEGATIVE. SET JSIGN 4 2. AND MAKE CSP05240JSIGN=40000006942STOAC102D010CSP05260CO27F026CONVERTED DATA. CSPO4990DCSTXONE+1 ADD CONSTANT OF ONE CSP05080STOLDNEG FOR•..•1 SAVE1+1 SAVE IR1COUNT+I OK-SAVE WIDTH IN COUNT CSP05180FOUR NO - LOAD FOURCSP05300HFFFF YES ■ CHANGE SIGN TO POSITIVE CSP05310CSP05010C5P0529000020008 00000 00017•0018 0000200022010010D0320IT POSITIVE. OTHERWISE, SET CSP05250C4000000001DECAI65800000STOSTOC103TEST LO7004048000ICARGUMENT ADDRESS COMES IN HERE CSP05000LOX7E51+1 CREATE JCARD(JLAST) ADDRESS CSP05090JLAS1 SETUP JLAST ADDRESS FOR NZONE CSP05110LDL •-• GET JCARDIJLASTI CSP05270MDXSTOIl DECAL PUT ARGUMENT ADDRESS IN IRI CSP050201 3 GET NER ADDRESS CSP05190GO SKIP OVER NEGATIVE PROCESSINGI TEST+1 RESTORE SIGN AS POSITIVE CSPOS3200004 0000E00180010 010024C1000104(2800210LD(4800040D018BSCCOE21 0 GET JCARD ADDRESS CSP05030LOLDSTOL NEG.+2 CHECK FOR NEGATIVE CSP05280LD1 2 GET JLAST ADDRESS CSP05100I JLAS1 GET JLAST VALUE AND CSP05120ERA+1 SAVE ITTWO+1 LOAD TWOCSP05200CSP053300005 0001000390STODOEFJCRD1 SETUP JCARD ADDRESS FOR NZONE CSP05040STO DECAL SAVE IT AT DECAL CSP05130ADDP1442REA DR2501SKIPSTACKPAGE 20032 0 7008 MDX MORE GET NEXT DIGIT CSP05460S14030033 0 9015 OK S TEN NOT LESS ■ COMPARE IT TO CSP054700034 01 4C10002C BSC L ERR. — CONSTANT OF TEN —NOT LESS GO TO CSP05480•ERR CSP05490TYPER0037 0 1008SLA 8 SHIFT THE FOUR BITS OF DECIMAL CSP055100036 0 8012ATEN LESS ■ ADD TEN BACK CSP05500UNPAC0038 0 E811OR ZERO IN PLACE AND CREATE Al CSP055200039 00 05000000 PUT STO LI •..• CHARACTER —STORE IN JCARDIJNOW) CSP05530• SEE IF JNOW IS LESS THAN JLAST. CSP05540WHOLE• IF YES, JNOW•JNOW+1 AND GO BACK CSP05550• IF NO. SETUP THE SIGN CSP05560FOR MORE.0038 0 71FF MORE MDX 1 — 1 DECREMENT THE FIELD WIDTH CSP05570003C 0 70E8 MDX PICK GO BACK FOR MORE CSP05580003D 30 156456545 CALL NZONE NZONE ROUTINE TO PLACE SIGN CSP05590003F 0 0000 JCRD1 DC •• ADDRESS OF JCARD CSP056000040 0 0000 JLAS1 DC •■• ADDRESS OF JLAST CSP056100041 1 001C DC TEST+1 ADDRESS OF SIGN INDICATOR TO CSP05620• USE CSP056300042 1 003F DC JCRD1 ADDRESS OF SIGN INDICATOR FOR CSP05640• OLD SIGN C5P05650• EXIT CSP056600043 00 65000000 SAVEI LDX LI •• RESTORE IRI CSP05670® 0043 00 4C000000 DONE1 BSC L U..• RETURN TO CALLING PROGRAM CSP056800047 0 0004 FOUR DC 4 CONSTANT OF FOUR CSP056900048 0 FFFF HFFFF DC /FFFF CONSTANT OF ALL BINARY ONES CSP057000049 0 000A TEN DC 10 CONSTANT OF TEN CSP05710004A 0 F040 ZERO DC /F040 CONSTANT OF EBCDIC ZERO CSP05720004C END CSP05730NO ERRORS IN ABOVE ASSEMBLY.SUBI/ OUP•STORE WS UA DECAL3345 0006CSP05740CSP05750-159-


ADDA1A3A1DEC/Y ASH•• DIV SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID)CSP05760CSP05770• NAME DIV• LIST(ID) CSP05780CSP057900000 04265000 ENT DIV DIVIDE SUBROUTINE ENTRY POINT• CALL DIV(JCARD.J.JLAST.KCARD.K.KLAST.NER)CSP05800CSP05810A3A1• THE WORDS JCARD1J) THROUGH CSP05820• JCARD(JLASTI ARE DIVIDED INTO C5P05830• THE WORDS KCAREICKI THROUGH CSP05840CARRY••I/CARL:III/LAST). THE KCARD FIELDIS EXTENDED TO THE LEFT ANDCSP05850CSP05860•CONTAINS THE QUOTIENT ANDCSP051170DECA1•REMAINDER.CSP058800000 0000 DIV DC •—• ARGUMENT ADDRESS COMES IN HERE CSP05890DIV 0001 6970 SIX 1 SAVE1+1 SAVE IR1 CSP059000002 6A71 ST% 2 SAVE2+1 SAVE IR2 CSP059100003 6872SIX 3 SAVE3+1 SAVE /R3CSP05920DPACK0004 1 65800000LDX 11 DIV PUT ARGUMENT ADDRESS IN IR1 CSP059300006 C100LD 1 0 GET JCARD ADDRESSDUNPK 0007 0 95800002S 11 2 SUBTRACT JLAST VALUECSP05940CSP059500009 DO4CSTO SRCH*1 STORE END OF JCARD ADDRESSEDIT000A 1 040000ADSTO L MULT1*1 FOR SEARCH AND MULTIPLICATIONCSP05960C5P05970000C 8004 A ONE+1 ADD CONSTANT OF ONE CSP05980FILL0000 D011STO SGNJ+1 CREATE JCARD(JLAST) ADDRESS CSP05990•JSPAN•JLAST—J+1CSP06000GET000E00100 C58000020 95800001TWOONELD 11 2 GET JLAST VALUES II 1 SUBTRACT J VALUECSP06010CSP06020ICOMP00120013BOFE4808A ONE+1 ADD CONSTANT OF ONEBSC + CHECK FIELD WIDTHCSP06030CSP060400014 COFC LD ONE+1 NEGATIVE OR ZERO—MAKE IT ONE CSP06050IOND 0015 DOSE STO SRCHT+1 STORE COUNT FOR SEARCH CSP060600016 C103 LD 1 3 GET KCARD ADDRESS CSP060700017 0037STO KCRD1 SAVE FOR FILLCSP06080KEYBD0018 0 95800005S 11 5 SUBTRACT KLAST VALUECSP06090001A 80F6A 014E61 ADD CONSTANT OF ONECSP06100MOVE 0018 DOORSTO SGNK+1 CREATE KCARDIKLAST) ADDRESS CSP06110001C 7107MDX 1 7 MOVE OVER SEVEN ARGUMENTSCSP06120MPY001D 695AST% 1 DONE1+1 CREATE RETURN ADDRESSCSP06130• CLEAR AND SAVE THE SIGNS ON THE CSP06140• JCARD AND THE KCARD FIELDSCSP06150NCOMP001E 0 C4000000 SGNJ LD L *** PICKUP THE SIGN OF JCARDCSP061600020 DODFSTO DIV SAVE IT IN DIVCSP06170NSIGN 0021 1 4C100027BSC L JPLUS. — IF NOT NEGATIVE —GO TO JPLUS CSP061800023 F039EOR HFFFF+1 NEGATIVE —MAKE IT POSITIVE CSP06190NZONE 0024 1 0480001ESTO I SGNJ+1 PUT BACK IN JCARDIJLASTICSP062000026 CO36 LD HFFFF+1 LOAD A MINUS ONE CSP06210PACK 0027 1890 JPLUS SRT 16 SAVE IN EXTENSION CSP062200028 0 C4000000 SGNK LD L •—• PICKUP THE SIGN OF KCARD CSP06230002A 004FSTO KSIGN SAVE IT IN KSIGNCSP06240PRINT0028 1 4C100033BSC L KPLUSs .. IF NOT NEGATIVE—GO TO KPLUS CSP062500020 FO2FEOR HFFFF+1 NEGATIVE-MAKE IT POSITIVE CSP06260PUNCH 002E 1 04800029STO I SGNK+1 PUT BACK IN KCARDIKLAST)CSP062700030 1090SLT 16 GET SIGN OF JCARDCSP06280PUT0031 F028EOR HFFFF+1 CHANGE ITCSP062900032 7001 MD% OVRK SKIP NEXT INSTRUCTION CSP06300P1403 0033 1090KPLUS SLT 16 GET SIGN OF JCARDCSP063100034 D046OVRK STO OSIGN STORE FOR SIGN OF QUOTIENT CSP06320P1442READR2501SKIPSTACKSUBS1403TYPERUNPA CWHOLE-160-


PAGE 2ADD• KSTRT-K-1 CSP06330 A1A3•A MFFFF411 SUBTRACT CONSTANT OF ONE CSP06350STO KSTRT SAVE IN KSTRT CSP06360A1DECKLOW•11■JSPAN CSP06370A ONE+1 GET VALUE OF K CSP06380A3A15 SRCMT+I SUBTRACT JSPAN CSP063905TO KLOW SAVE IN KLOW CSP06600CARRYSTO TMP SAVE ITCSP06420DECA1CALCULATE THE ADDRESS OF THE CSP06430•SIGN OF THE QUOTIENT CSP06640LD KCRD1 GET KCARD ADDRESS CSP06450DIVSIMP SUBTRACT KLAST VALUE CSP06460A SRCHT+1 ADD JSPAN CSP06470DPACK0035 00 CSBOFFFD LD Il -3 GET VALUE OF K C5P063400037 0 80250038 0 D0400039 0 8007003A 0 90190038 0 D041003C 00 CSBOFFFE MTWO LD II -2 GET KLAST VALUE CSP06410003E 0 0040003F 0 COOF0040 0 903E0041 0 80120042 0 80CE A ONE+1 ADD CONSTANT OF ONE CSP064800043 01 040000DF STO L OUOT+1 STORE ADDR OF SIGN OF QUOTIENT CSP06490 DUNPK• IS KLAST-KSTRT—JSPAN NEGATIVE CSP065000045 0 CO39LD TMP LOAD KLAST VALUE C5P065100046 0 90325 KSTRT SUBTRACT KSTRT C5P06520EDIT0047 0 900C5 SRCHT+1 SUBTRACT JSPAN CSP065300048 01 4C2B005BBSC L ERRo+2 IF NEGATIVE-GO TO ERROR CSP06540FILL• IS KLOW POSITIVE C5P06550004A 0 CO32 LD KLOW OK-GET KLOW VALUE CSP06560 GET0048 01 40080058 BSC L ERR,* IF NOT POSITIVE•GO TO ERROR CSP06570FILL THE EXTENSION OF KCARD WITH C5P06580•ZEROES C5P06590ICOMP004D 30 062534C0CALL FILL OK-FILL EXTENSION WITH ZEROES CSP06600004F 0 0000KCRD1 DC•..• ADDRESS OF KCARD CSP06610IOND0050 I 0070DC KLOW ADDRESS OF LEFT END OF EXTENSION CSP066200051 1 0079DC KSTRT ADDRESS OF RGHT END OF EXTENSOR CSP06630KEYBD0052 1 007C DC ZIP ADDRESS OF CONSTANT OF ZERO CSP06640•JFRST•JCSP066500053 00 66000000 SRCHT LDX L2 •+• LOAD IR2 WITH JCARD COUNT CSP06660MOVE0055 00 C6000000 SRCM LO L2 •• PICKUP JCARDIJFRSTI CSP06670•IS JCARDIJFRSTI POSITIVE CSP06680MPY0057 01 4C300010 BSC L HIT. —Z IF POSITIVE-GO TO MIT CSP06690•SEE IF JFRST IS LESS THAN JLAST. C$P06700NCOMPIF TES, JFRST•JFR5T+1 AND GO CSP06710•BACK FOR MORE. IF NO. ERROR. CSP06720NSIGN0059 0 72FFMDX 2 — 1 DECREMENT IR2 CSP06730005A 0 70FAMDX SRCH GO BACK FOR MORE CSP06740•ERROR ■ NER•CLAST CSP06750.NZONE00513 0 0023ERR LO TMP PICKUP KLAST VALUE C5P06760005C 00 058OFFFF HFFFF STO Il -1 AND STORE IN HER CSP06770PACK• REPLACE JCARD SIGN CSP06780005E 0 COA1 FINER LO DIV PICKUP ,JCARD SIGN AND CSP06790 PRINT005F 01 0480001F STO I SONJ+1 PUT IT BACK C5P06800•REPLACE KCARD SIGN CSP068100061 0 0018LD KSIGN PICKUP KCARD SIGN CSP06820PUNCH0062 01 4C28006CBSC L KNEG.+Z IF NEGATIVE —GO TO KNEG CSP06<strong>1130</strong>0064 01 C4800029LD I SGNK+1 NOT NEGATIVE-PICKUP NEW SIGN CSP06840PUT0066 01 4C100071BSC L SAVE1.- IF NOT NEGATIVE-GO TO EXIT CSP068500068 0 FOF4BCK1 FOR MFFFF+1 NEGATIVE-CHANGE SIGN AND CSP06860P14030069 01 04800029 STO I SGNK+l PUT INTO KCARDIKLASTI CSP06870P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-161-


ADD PAGE 3AlA3A1DEC0068006C0017005C4800029MDXKNEG LDSAVE1 GO TO EXITI SGNK+1 NEGATIVE-PICKUP NEW SIGNCSP06880CSP06890006E 01 40280071BSC L SAVE1,+2 IF NEGATIVE-GO TO EXITCSP069000070 0 70F7MD% BCK1 NOT NEGATIVE-GO TO BCK1CSP06910• EXIT CSP06920A3A1 0071 00 65000000 SAVE1 LOX LI •-• RESTORE IR1 CSP069300073 00 66000000 SAVE2 LOX L2 •-• RESTORE IR2 CSP069400075 00 67000000 SAVES LDX L3 •-• RESTORE IR3CSP06950CARRY 0077 00 4C000000 DONE1 BSC L •-• RETURN TO CALLING PROGRAMCSP069600079 0 0000KSTRT DC •-• ONE LESS THAN KCSP06970DECA1 007A 0 0000KSIGN DC •-• SIGN OF KCARDCSP069800078 0 0000 ()SIGN DC •-• SIGN OF QUOTIENT CSP06990DIV 007C 0 0000 ZIP DC 0 CONSTANT OF ZERO CSP070000070 0 0000 KLOW DC •-• SUBSCRIPT OF LEFTMOST POSITION CSP07010•OF EXTENSION OF KCARDCSP07020DPACK007E 0 000ATEN DC10 CONSTANT OF TENCSP07030007F 0 0000 TMP DC •-• TEMPORARY STORAGECSP07040DUNPK•JHIGH•JCARDIORSTICSP07050EDIT0080 0 DOD3 HIT STO SRCHT+1 SAVE FIRST SIGNIFICANT DIGIT CSP07060• KPUT•KLOW+JLAST-JFRST CSP07070FILL0081 0 6A28 STX 2 JLOOP+1 GET THE VALUE OF JLAST-JFRST CSP070800082 0 COCCLD KCRD1 GET KCARD ADDRESSCSP070900083 0 0O3ESTO KCRD2 SAVE FOR CARRYCSP071000084 0 90F8SKLOW SUBTRACT KLOW VALUECSP07110GET0085 0 9024$JLOOP+1 SUBTRACT JLAST-JFRST VALUE CSP071200086 0 9086S MTWO+1 ADD CONSTANT OF TWOCSP07130ICOMP 0087 0 DONESTO PUT2+1 SAVE ADDRESS FOR STORINGCSP07140• KSTOP•KLAST+JFRST-JLAST-1 CSP07150IOND 0088 0 COF6 LD TMP GET KLAST VALUE CSP071600089 0 9020 JLOOP+1 SUBTRACT JLAST,IFRST VALUE CSP07170008A 0 9002S HFFFF+1 ADD CONSTANT OF ONECSP07180KEYBD0088 0 DOCASTO SRCH61 SAVE VALUE FOR COMPLIMENTING CSP07190008C 0 90ECS KSTRT SUBTRACT KSTRT VALUECSP07200MOVE0080 0 D008STO LOOPM+1 SAVE COUNT AT LOOPM+1CSP07210008E 0 CO33LD KCRD2 GET KCARD ADDRESSCSP07220MPY008F 0 90EFSTMP SUBTRACT KLAST VALUECSP07230NCOMP0090 0 8019 A JLOOP6I ADD JLAST-JFRST VALUE CSP072400091 0 D009 STO DIVI61 SAVE FOR MOLT. BY TEN CSP072500092 0 D038 STO DIV561 SAVE FOR ADD OF 10•KNOW CSP07260NSIGN0094 0 8008A HFFFF+1 SUBTRACT CONSTANT OF ONE CSP072800093 0 D039STO DIV681 SAVE FOR STORE OF 10•KNOW CSP072700095 0 D009STO DIV261 SAVE FOR ADD INTO MULTCSP07290NZONE 0096 0 DO1ASTO DIV361 SAVE FOR SUBTRACTION FROM CSP073000097 0 0018 STO DIV461 SAVE FOR STORE SUBTRACTED FROM CSP07310PACK • KM•KSTRT CSP073200098 00 65000000 LOOPM LDX LI •-• LOAD IRI WITH COUNT CSP07330•MULT*110•KCARDIKM1+KCARDIKM+11) CSP07340PRINT•DIVIDED BY JHIGHCSP07350009A 00 C5000000 DIV1 LD LI •-• PICKUP KCARDIKMICSP07360PUNCH 009C 0 AOE1MTEN MULTIPLY BY TENCSP07370009D 0 1090SLT 16 REPOSITION PRODUCTCSP07380PUT009E 00 85000000 DIV2 A LI •-• ADD IN KCARD(KM+11CSP0739000A0 0 1890 SRI 16 REPOSITION FOR DIVISION CSP0740000A1 0P1403A882DSRCHT+1 DIVIDE BY JHIGHCSP0741000A2 0 DODASTO KLOW SAVE IN KLOW(MULTICSP07420P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLE-162-


PAGE 4ADDA1A3•NOUO-MULTCSP0743000A3 0 DOD5STO KSTRT SAVE IN KSTRTINQUOI CSP07440•IS MULT GREATER THAN ZERO C5P0745000A4 O1 4COBOOD4BSC L PUT,* IF MULT NOT POSITIVE-GO TO PUT CSP07460A1DEC• KNOOKM+1 CSP0747000A6 0 6901 ADBCK STX 1 KNOW+I POSITIVE-GET KM+I AND CSP07480A3A100A7 00 67000000 KNOW LOX L3 •..• PUT IT IN IR3 CSP07490•JNOW.JFRSTCSP07500CARRY00A9 00 66000000 JLOOP LD% L2 'I..* RELOAD IR2 WITH REMAINING JCARD CSP0751000A8 0 1810SRA 16 CLEAR ACCUMULATOR CSP07520•KCARD(KNOWI•KCARDIKNOW1 CSP07530DECA1• MULT•JCAROWNOW/ CSP07540OOAC 00 96000000 MULTI S L2 •...• LOAD NEGATIVE JCAROWNOWI CSP07550 DIVOOAF 0 1090 SLT 16 REPOSITION PRODUCT CSP07570DPACK0080 00 87000000 DIV3 A L3 •...• ADD IN KCARDIKNOWI CSP0758000B2 00 07000000 DIV4 STO L3 •..• STORE AT KCARDIKNOWI CSP07590•KNOW.KNOW+1 CSP07600 DUNPKOOAE 0 AOCE M KLOW MULTIPLY BY MULT CSP075600084 0 73FFMDX 3 -1 DECREMENT IRS CSP076100085 0 7000MDX • NOP CSP07620 EDIT• IS JNOW LESS THAN JLAST. IF YES CSP07630•JNOW.JNOW+1 AND GO BACK FOR MORE CSP07640FILL•IF NO. RESOLVE CARRIES. CSP076500086 72FFMDX 2 -1 DECREMENT IR2 CSP07660GET0087 70F3MD% JLOOP+2 NOT DONE-GO BACK FOR MORE CSP076700088 69EFSTX 1 KNOW+1 DONE-CALCULATE CSP076800089 CO9CLD SRCH61 THE VALUE OF CSP07690ICOMP008A 90ED S0008 DOEC STO KNOW+1 BY COMPLIMENTING COUNT CSP07710 IONDOOBC 6BDC STX 3 LOOPM+I CALCULATE THE CSP0772000BD C098LD SRCHIrrl VALUE OF KM CSP07730KEYBDOOBE 90DAS LOOPM+1 BY COMPLIMENTING THE CSP07740KNOW+1 KNOW-1 CSP07700008F DOD9 STO LOOPM+1 OTHER COUNT CSP07750•RESOLVE CARRIES IN THIS RESULT CSP07760MOVE0000 0 03059668 CALL CARRY RESOLVE CARRIES CSP0777000C2 0000 KCR02 DC •.• ADDRESS OF KCARD CSP07780 MPY00C3 00AB DC KNOW+1 ADDRESS OF KM CSP077900004 0099DC LOOPM+1 ADDRESS OF KNOW-1 CSP07800NCOMP0005 00A8DC KNOW+1 ADDRESS OF GENERATED CARRY CSP07610•IS KNOW LESS THAN ZERO C59078200006 1 4C100004NSIGNBSC L PUT.- IF NOT NEGATIVE-GO TO PUT CSP07030•KCAROMMI.KCARDIKM1+10•KNOW CSP0711400008 A085MTEN NEGATIVE-MULTIPLY CARRY BY TEN CSP07650NZONE0 DIV5 LI ADD IN KCARDIKNOWI CSP07870 PACK0000 0 05000000 DIVE STO LI •-• STORE AT KCARDIKNOWI CSP07860•MULT•-1CSP071190OOCE COKELD HFFFF+1 LOAD A MINUS ONE CSP07900PRINT00C9OOCA109085000000SLTA16 REPOSITION PRODUCT CSP07860••OOCF DOAD STO KLOW STORE IN MULT CSP07910•NOUO-NOUO-1 CSP07920 PUNCH0000 COAB LD KSTRT LOAD THE VALUE OF NOUO CSP079300001 8068 A HFFFF+1 SUBTRACT CONSTANT OF ONE CSP079400002 DOA6 STO KSTRT STORE IN NQUO CSP07950PUT0003 7002 MD% ADBCK GO TO ADD OVERDRAW BACK CSP07960•KCARDIKPUT/•NOU0 CSP07970PAGE 50004 0 COA4PUT LD KSTRT LOAD NQUO C51,079800005 00 04000000 PUT2 STO L •■• STORE AT KCARDtKPUTI CSP07990•KPUT.KPUT+1CSP080000007 01 74FFOOD6MDX L PUT2+1.-1 MODIFY KCAROMPUT/ ADDRESS CSP08010•SEE IF KM IS LESS THAN KSTOP. CSPO8020•IF YES, KI.I.KM+1 AND GO BACK FOR CSP08030• MORE. IF NO. PLACE ALL SIGNS. CSP0110400009 0 71FFMD% 1 -1 DECREMENT IR1 CSPOB050OODA 0 70BFMDX DIV1 NOT DONE-GO BACK FOR MORE CSP08060• PUT SIGN ON QUOTIENT CSP0807000DB 0 C09F LD OSIGN DONE-PICKUP SIGN OF QUOTIENT CSP080110000C 01 4C2800E0 BSC L NEG.+Z IF NEGATIVE-GO TO NEG CSP08090OODE 00 C4000000 QUOT LD L •-• NOT NEGATIVE-PICKUP ACTUAL SIGN CSP0810000E0 01 4C10005E BSC L FINER... IF NOT NEGATIVE-GO TO OTHERS CSP0811000E2 01 F4000050 BCK2 FOR00E4 01 0480000F STOL HFFFF+1 NEGATIVE-CHANGE SIGN CSP081201 QUOT+1 PUT SIGN ON QUOTIENT cspomo00E6 01 4000005E BSC L FINER. GO TO REPLACE OTHER SIGNS CSP0814000E8 01 C48000DF NEG LD I OUOT+1 NEGATIVE-PICKUP ACTUAL SIGN CSP08150OOEA 01 4C28005E BSC L FINER.+2 IF NEGATIVE-GO TO OTHER SIGN CSP011160OOEC 0 TORS MDX BCK2 GO TO CHANGE SIGN CSPOBI70OGEE END CSP001110NO ERRORS IN ABOVE ASSEMBLY.P1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE// OUP•STORE WS UA DIV334B GOOFCSP08190CSP08200-163-WM, . 'mew 11.1•117


ADDA1A3// ASM** DPACK/DUNPK SUBROUTINES FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 11D)CSP08210CSP08220• NAME DUNPK(ID) CSP08230* LISTCSP08240A1DEC0000 04915502 ENT DUNPK DUNPK SUBROUTINE ENTRY POINT CSP08250• CALL DUNPK(JCARDoJtJLASToKCARD,K) CSP08260•THE WORDS JCARDIJ) THROUGHCSP08270A3A1*JCAROULASTI IN D4 FORMAT ARECSP08280• UNPACKED INTO KCARD IN DI FORMAT. CSP08290CARRY 0006 045C1002ENT DPACK ()PACK SUBROUTINE ENTRY POINT CSP08300*CALL DPACKIJCARD,JIJLASTACARD.K) CSP08310DECA1*THE WORDS JCARD1J) THROUGHCSP08320DIV* JCARD1JLAST) IN DI FORMAT ARE PACKED CSP083300000 0000•DUNPKINTO KCARD IN D4 FORMAT.DC *..* ARGUMENT ADDRESS COMES IN HERECSP08340CSP08350DPACK 0002 D020STO SWTCH STORE NOP AT SWITCHCSP083700001 0003LD 5W2 LOAD NOP INSTRUCTIONCSP083600003 7007MD% START COMPUTINGCSP083800004 7027 SW1 MDX X ELSE-SWTCH-1 BRANCH TO ELSECSP083900005 7000SW2 MD% X 0 NOP INSTRUCTIONCSP084000006 0000DPACK DC •* ARGUMENT ADDRESS COMES IN HERE CSP084100007 COFELD DPACK PICK UP ARGUMENT ADDRESSCSP08420DUNPKEDITFILLGET00080009D0F7COFASTO DUNPK AND STORE IT IN DUNPKLD SW1 LOAD BRANCH TO ELSECSP08430CSP08440000A 0018STO SWTCH STORE BRANCH AT SWITCHCSP084500008 6952 START STX 1 SAVE1+1 SAVE IR1CSP08460000C 6A53 STX 2 SAVE2+1 SAVE IR2 CSPOB470ICOMP 0000 1 65800000 LOX Il DUNPK PUT ARGUMENT ADDRESS IN IR1 CSP08480000F C100 LD 1 0 GET JCARD ADDRESS CSP084900010 8001A ONE+1 ADD CONSTANT OF 1CSP08500IOND0011 0 95800001 ONE S 11 1 SUBTRACT J VALUECSP08510KEYBD 0013 DOORSTO JCARD+1 CREATE JCARDIA ADDRESSCSP085200014 C103LD 1 3 GET KCARD ADDRESSCSP085300015 80FCA ONE+1 ADD CONSTANT OF 1CSP08540MOVE0 FOUR0016 95800004 S 11 4 SUBTRACT K VALUECSP08550MPY0018 D006 STO KCARD+1 CREATE KCARD1K) ADDRESS CSP085600019 C100 LD 1 0 GET JCARD ADDRESS CSP08570001A 80F7 A ONE+1 ADD CONSTANT OF 1 CSPOS5800016 0 95800002S 11 2 SUBTRACT JLAST VALUECSP08590NCOMP 001D DOE8STO DPACK CREATE JCARDWLASI) ADDRESS CSP08600001E 0 65000000 KCARD LDX LI *—* PUT KCARD ADDRESS IN IR1CSP08610NSIGN 0020 0 C4000000 JCARD LD L 41...* PICK UP JCARD(J)CSP086200022 6204 LDX 2 4 LOAD IR2 WITH 4, DIGITS/WORD CSP08630NZONE 0023 7000 SWTCH MDX X 0 SWITCH BETWEEN DPACK AND DUNPK CSP086400024 1890 SRI 16 TEMPORARILY SAVE ACCUM IN EXTNTN CSP08650* CHECK FOR JCARD1JLAST1CSP08660PACK0025 COFBLD JCARD+1 PICK UP CURRENT JCARD ADDR CSP006700026 90DFS DPACK SUBTRACT JCARDWLAST)CSP08680PRINT 0027 1 4C080059BSC L ALL0011+ IF ZERO. ALL DONE ALLDO CSP086900029 1810AGAIN SRA 16 NOT DONE — CLEAR ACCUMULATOR CSP08700PUNCH 002A 1084SLT 4 GET FIRST DIGIT OF WORDCSP08710PUT0028 FOOA FOR HOOOF IS IT FILLER CSP08720002C 1 4C180031BSC L NEXT.+ — YES — GO TO NEXTCSP08730002E F007FOR HOOOF NO — RESTORE TO ORIGINALCSP08740002E D100STO 1 0 STORE IN KCARDCSP08750P14030030 71FFMDX 1 — 1 GO TO NEXT WORD OF KCARDCSP087600031 72FF NEXT MDX 2 — 1 DECREMENT DIGITS/WORD CSP08770P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLEPAGE 20032 0 70F6 MOX AGAIN MORE IN THIS WORD — GO BACK CSP087800033 01 74FF0021MD% L JCARD+11,1 THIS WORD DONECSP08790*GET NEXT WORD IN JCARDCSP088000035 0 70EAMDX JCARD GO BACKCSP088100036 0 000F HOOOF DC /000F CONSTANT OF 15 TO DETECT FILLER CSP088200037 01 74010021 EN MDX L JCARD+1,1 BACK UP JCARD FOR SIGN CSP088300039 0 6AE5SIX 2 KCARD+1 IF DIGITS/WORD IS FOUR,CSP08840003A 0 COE4 LD KCARD+1 ALL DONE EXCEPT FOR SIGN CSP088500038 0 90DB S FOUR+1 SUBTRACT FOUR FROM DIGITS/WORD CSP08860003C 01 4C180046 BSC L LASTg+-. IF ZERO ALL DONE ■ GO LAST CSP08870003E 0 1884 SRT 4 NOT DONE TAKE OUT SIGN C5P08880003F 0 CO23 BACK LD HF000 PUT IN FILLER CSP088900040 0 180C RTE 28 SET FILLER IN LOW ORDER OF EXTN CSP089000041 0 72FF MD% 2 — 1 DECREMENT DIGITS/WORD CSP089100042 0 70FC MD% BACK MORE .. GO BACK C5P089200043 0 1090 SLT 16 DONE .. PUT EXTENSION IN ACCUM CSP089300044 0 D100 STO 1 0 STORE IN KCARD CSP089400045 0 71FF MDX 1 -. I GET NEXT WORD OF KCARD FOR SIGN CSP089500046 01 C4800021 LAST LD I JCARD+1 PICK UP SIGN OF JCARD CSP089600048 0 7011 MDX ALLDO+1 GO TO INSTRUCTION AFTER ALLDO CSP089700049 01 C4800021 OVR LD I JCARD+1 PICK UP NEXT JCARD DIGIT CSP089000046 0 100C ELSE SLA 12 PUT DIGIT IN HIGH ORDER OF ACC CSP08990004C 0 18DC RTE 28 SET DIGIT IN LOW ORDER OF EXTN CSP09000004D 01 74FF0021 MD% L JCARD+10 ■ 1 GET NEXT JCARD WORD CSP09010* CHECK FOR JCARDWLAST) CSP09020004F 0 0001 LD JCARD+1 PICK UP CURRENT JCARD ADDR CSP090300050 0 9085 S DPACK SUBTRACT JCARD1JLAST) CSP090400051 01 4C280037 BSC L EN.+Z IF ZERO,ALL DONE ■ GO TO EN CSP090500053 0 72FF MD% 2 — 1 NOT DONE-DECREMENT DIGITS/WORD CSP090600054 0 70F4 MDX OVR GO BACK FOR NEXT DIGIT CSP090700055 0 1090 SLT 16 WORD FULL —PUT EXTN IN ACCUM CSP090800056 0 D100 STO 1 0 STORE IN KCARD CSP090900057 0 71FF MDX 1 .. I GET NEXT KCARD WORD CSP091000058 0 7007 MDX JCARD GO BACK CSP091100059 0 1090 ALLDO SLT 16 DONE-PUT EXTENSION IN ACCUMULTR CSP09120005A 0 D100 STO 1 0 STORE SIGN IN KCARD CSP091300056 01 74050000 MDX L DUNPK,5 CREATE RETURN ADDRESS CSP091400050 00 65000000 SAVE1 LDX LI •.. RESTORE IR1 CSP09150005F 00 66000000 SAVE2 LDX L2 if .* RESTORE IR2 CSP091600061 01 4C800000 BSC I DUNPK RETURN TO CALLING PROGRAM CSP091700063 0 F000 HF000 DC /F000 CONSTANT OF 15 FOR FILLER CSP091800064 END CSP09190NO ERRORS IN ABOVE ASSEMBLY.


CSP09200// OUPADD•STORE WS UA DUNPK CSP09210A 1A3335A 0007A 1 DE CA 3A1CARRYDE CA 1DIV// ASMC5P09220DPACK•• EDIT SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID/• NAME EDIT IID) CSP09230CSP09240DUNPK• LISTCSP092500000 051098(0 ENT EDIT EDIT SUBROUTINE ENTRY POINT CSP09260EDIT• CALL EDITUCARD.JtJLASTACARD.K.KLAST) CSP09270• THE WORDS JCARDIJI THROUGHCSP09280• JCARDIJLAST/ ARE EDITED UNDER CSP09290FILL• CONTROL OF THE MASK AT WORDS CSP09300• KCARDIKI THROUGH KCARDIKLAST/ CSP09310GET• AND THE RESULT IS AT KCARDIK/ CSP09320• THROUGH KCARDIKLAST/•CSP093300000 0000 EDIT DC •+• ARGUMENT ADDRESS COMES IN HERE CSP09340ICO MP0001 696D STX 1 SAVE1+1 SAVE IR1CSP093500002 SASE STX 2 SAVE2+1 SAVE IR2CSP09360ION D0003 1 65800000 LOX /1 EDIT PUT ARGUMENT ADDRESS IN IR1 CSP093700005 C100 LD 1 0 GET JCARD ADDRESSCSP09380KEYBD0006 D028 STO JCRD1 SAVE JCARD ADDRESS FOR NZONE CSP093900007 DO7C STO JCRD2 SAVE JCARD ADDRESS FOR NZONE CSP09400MOVE0008 0 95800002 S II 2 SUBTRACT JLAST VALUE CSP09410000A 8007 A ONE+1 ADD CONSTANT OF ONEC5P094200008 D050 STO JCARD+1 CREATE JCARD(JLAST) ADDRESS CSP09430MPY000C C102 TWO LD 1 2 GET JLAST ADDRESSCSP094400000 D025 STO JLAS1 SAVE JLAST ADDRESS FOR NZONE CSP09450NCOMP000E 0076 STO JLAS2 SAVE JLAST ADDRESS FOR NZONE C5P09460000F 0 C5800002 LD 11 2 GET JLAST VALUE CSP09470NSIGN0011 0 95800001 ONE S 11 1 SUBTRACT J VALUE CSP094800013 BOFE A ONE+1 ADD CONSTANT OF ONECSP094900014 4808 BSC + CHECK FIELD WIDTHCSP09500NZONE0015 COFC LD ONE+1 NEGATIVE OR ZERO-MAKE IT ONE CSP095100016 D026 STO LDXJ+1 SAVE FIELD WIDTHCSP09520PACK0017 C104 LD 1 4 GET K ADDRESSCSP095300018 D076 STO K1 SAVE K ADDRESS FOR FILLCSP09540PRINT0019 1 040000(0 STO L K2 SAVE K ADDRESS FOR FILL CSP09550001B C105 LD 1 5 GET KLAST ADDRESSCSP09560001C 0073 STO KLASI SAVE KLAST ADDRESS FOR FILL CSP09570PUNCH001D C103 LD 1 3 GET KCARD ADDRESSCSP09580001E D06F STO KCRD1 SAVE KCARD ADDRESS FOR FILL CSP09590PUT001F 1 0400000F STO L KCRD2 SAVE KCARD ADDRESS FOR FILL CSP096000021 0 95800005 S Il 5 SUBTRACT KLAST VALUEC5P09610P14030023 80EE A ONE+1 ADD CONSTANT OF ONE CSP096200024 DOTA 5T0 KCARD+1 CREATE KCARDIKLAST, ADDRESS CSP09630P14420025 DOTE STO KCR03+1 CREATE KCARDIKLASTI ADDRESS CSP096400026 0 C5800005 LD 11 5 GET JLAST VALUECSP096S00028 0 95800004 FOUR S 11 4 SUBTRACT J VALUECSP09660READ002A 80E7 A ONE+1 ADD CONSTANT OF ONECSP096700028 4808 BSC + CHECK FIELD WIDTHC5P09680R2501002C COES LD ONE+1 NEGATIVE OR ZERO-MAKE IT ONE C5P096900020 DOOD STO LDXK+1 SAVE FIELD WIDTH CSP09700 SKIP002E 7106 MDX 1 6 MOVE OVER SIX ARGUMENTS CSP09710002F 6943 STX 1 DONE1+1 CREATE RETURN ADDRESSCSP09720• REMOVE AND SAVE THE JCARD ZONE CSP09730STACK0030 0 15A56545 CALL NZONE NZONE TO REMOVE SIGNCSP097400032 0000 JCRD1 DC •■• ADDRESS OF JCARDCSP09750SUB0033 0000 JLAS1 DC •+• ADDRESS OF JLASTCSP097600034 0029 DC FOUR+1 ADDRESS OF A FOURCSP09770S14030035 0009 DC NSIGN ADDRESS OF OLD SIGN INDICATOR CSP09780TYPERUNPACWHOLE-165-


ADD PAGE 2A1A3A1DEC••Noumia•16448MONEY-16448CSP09790CSP098000036 0 CBSCLDD BLANK LOAD TWO BLANKSCSP098100037 0 085CSTD MONEY STORE IN MONEY AND NDUMPCSP09820•NZRSP•0CSP09830A3A1 0038 0 1810SRA 16 CLEAR THE ACCUMULATORCSP098400039 0 D050 STO NZRSP SET NZRSP EQUAL TO ZERO CSP09850•KNOW=KLASTCARRY 003A 00 65000000 LDXK LDX L1 •-• LOAD IR1 WITH KCARD COUNTCSP09860CSP09870DECA1•JNOW*JLASTCSP09880003C 00 66000000 LDXJ LOX L2 •-• LOAD 1R2 WITH JCARD COUNTCSP09890DIVL 003E 00 C4000000LO •-• PICKUP KCARDIKNOWICSP09910•KCARDKTESTuKCARDIKNOW1CSP09900DPACKBSC L POSZo- IS IT NEGATIVE-NO-GO TO P052CSP09930CSP099400040 0 DOFA STO LDXK+1 AND SAVE IT TEMPORARILY CSP09920•IS KTEST NEGATIVE0041 01 4C100047DUNPK 0043 0 9052•IS KTEST EQUAL TO AN EBCDIC ZERO CSP099505 ZERO YES-CHECK AGAINST EBCDIC ZERO CSP099600044 01 4C20007EEDIT 0046 0 700FMDX ZRSP IF EQUAL-GO TO ZRSPCSP09980BSC L NEXT. IF NOT EQUAL-GO TO NEXTCSP09970• IS KTEST EQUAL TO 16448 CSP099900047 0 9048 POSZFILLS BLANK NOT NEGATIVE-CHECK AGAINST EBCD CSP100000048 01 4C180057 BSC L SRCE.+- BLANK-EQUAL-GO TO SRCE CSP10010004A 0 COFOLD LDXK+1 NOT EQUAL-PICKUP KTESTCSP10020GET•IS KTEST EQUAL TO 23616CSP100300048 0 904DS DLRSG IS IT A DOLLAR SIGNCSP10040ICOMP 004C 01 4C180054BSC L MNY.+- YES-GO TO MNYCSP10050004E 0 COECLD LIUK+1 NO-PICKUP KTESTCSP10060IOND•IS KTEST EQUAL TO 23360CSP10070KEYBD004F 0 9048 S AST IS IT AN ASTERISK CSP100800050 0 4820BSC Z YES-SKIP NEXT INSTRUCTION CSP100900051 0 702CMDX NEXT NO-GO TO NEXTCSP10100NDUMP-KTESTCSP10110MOVE 0052 0 COE8LD LDXK+1 PICKUP KTEST ANDCSP10120•0053 0 0041 STO NDUMP STORE IT IN NDUMPCSP10130MPY•MONEY•KTESTCSP101400054 0 COE6 MNY LD LOXK+1 PICKUP KTEST AND CSP101500055 0NCOMPD03E STO MONEY STORE IT IN MONEY CSP10160• NZRSP•GNOW CSP101700056 0 6940 ZRSP STX 1 NZRSP SAVE KNOW IN NZRSPCSP10180NSIGN•SEE IF JNOW IS LESS THAN J. IF CSP10190■YES, GO TO NEXT. IF NO. GO TO CSP10200NZONE•JCARD.CSP102100057 0 6AA8SRCE STX 2 EDIT GET IR1 ANDCSP10220PACK 0058 0 COATLD EDIT LOAD ITS VALUECSP10230PRINT0059 01 4C08007E BSC L NEXT,+ IF NOT POSITIVE-GO TO NEXT CSP10240•KTEST.JCARDIJNOWCSP10250•KCARDIKNOWI•KTESTCSP10260CSP10270PUNCHKCARD+1 STORE IT IN KCARD/KNOWI CSP102800058 00 C40000000050 01 D480003FJCARD LDSTOL •+• POSITIVE-PICKUP JCARD(JNOWI ANDI005F 0 DODDSTO LDXJ+1 STORE VI KTESTCSP10290PUT•JNOW+JNOW+1CSP103000060 0 72FF MDX 2 -1 DECREMENT IR2 CSP10310P14030061 0 7000 MDX • NOp CSP103200062 01 7401005C MDX L JCARD+111 MODIFY JCARD ADDRESS TO CSP10330P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-166-


0064 0 CO320065 01 4C08007EPAGE 3ADD* JNOW-1 C5P10340A1A3* IS NZRSP POSITIVE CSP10350LD NZRSP PICKUP NZRSP ANDCSP1036085C L NEXTO. IF NOT POSITIVE-GO TO NEXT CSP10370A 1 DEC•IS KTEST NEGATIVECSP10380LD 1DXJ+1 POSITIVE-PICKUP KTESTCSP10390 A3A 10067 0 CODS0068 01 4C100074 BSC L OVER,. IF NOT NEGATIVE-GO TO OVER CSP10400006A 0 9028 S ZERO NEGATIVE-CHECK AGAINST ZERO CSP10410CARRY0066 01 4C18007E BSC L NEXT...- EQUAL-GO TO NEXT CSP104200060 0 700D MD% SETAG NOT EQUAL-GO TO SETAGCSP10430•EXITC5P10440DE CA1006E 00 65000000 SAVE1 LDX LI •-* RESTORE IR1CSP104500070 00 66000000 SAVE2 LD% L2 •.* RESTORE IR2CSP10460DIV0072 00 4C000000 DONE1 BSC L *-* RETURN TO CALLING PROGRAMCSPI0470•IS KTEST EQUAL TO BLANKCSP10480DPACK0074 0 901E OVER S BLANK CHECK KTEST AGAINST BLANK CSPI04900075 01 4C18007E BSC L NEXT.... IF EQUAL-GO TO NEXTCSP10500IS KTEST EQUAL TO COMMACSP10510DUNPK0077 0 COGSLO LDXJ+1 NOT EQUAL-CHECK KTESTCSP105200078 0 9021S COMMA AGAINST A COMMACSP10530EDIT0079 01 4C18007E BSC L NEXT.+- EQUAL-GO TO NEXTCSP10540•NZRSP-KNOW-1CSP10550FILL0076 0 6918 SETAG ST% 1 NZRSP NOT EQUAL-SET NZRSP EQUAL TO CSP10560007C 01 74FF0097 MD% L NZRSP.-1 KCARD COUNT MINUS ONE CSP10570 GETKNOW-KNOW-1 CSP10580•SEE IF KNOW IS LESS THAN K. IF CSP10590*YES, PUT JCARD ZONE BACK. IF NO CSP10600ICO MP•GO BACK FOR MORE.CSPI0610007E 01 7401003F NEXT MDX L KCARD+1,1 MODIFY KCARD ADDRESS TO CSP10620IOND• KNOW-1 CSP106300080 0 71FF MDX 1 . 1 DECREMENT IR1 CSPI0640KEYBD0081 0 70BC MD% KCARD GO BACK FOR MORE CSP10650PUT JCARD ZONE BACKCSP106600082 30 15A56545 CALL NZONE RESTORE JCARD ZONECSP10670MOVE0084 0 0000JCRD2 DC*..• ADDRESS OF JCARDCSP106800085 0 0000JLAS2 DC *-* ADDRESS OF JLASTCSP10690MPY0086 1 00C9 DC NSIGN ADDRESS OF NEW SIGN INDICATOR CSP107000087 1 000 DC EDIT DUMMY CSP10710 NCOMP• SEE IF JNOW IS LESS THAN J. IF CSP10720• YES. GO TO OK. IF NO, FILL WITH CSP10730ASTERISKS AND EXITCSP10740NSIGN0088 0 6AA9STX 2 JCRD1 GET THE CONTENTS OFCSP107500089 0 COA8LD JCRD1 IR2 AND CHECKCSP10760NZONE008A 01 4C08009FBSC L OK.* IF NOT POSITIVE-GO TO OKCSP10770008C 30 062334C0CALL FILL POSITIVE-ERROR-JCARD TOO LONG C5P10780PACK• FILL KCARD WITH ASTERISKS CSPI0790008E 0 0000KCRD1 DC 'h.* ADDRESS OF KCARDCSP10800008F 0 0000K1 DC •.*PRINTADDRESS OF KCSP108100090 0 0000KLAS1 DC •.• ADDRESS OF KLASTCSP108200091 1 0098DC AST ADDRESS OF FILL CHARACTERCSP10830PUNCH0092 0 7008MD% SAVE1 GO TO EXITCSP108400093 0 4040BLANK DC /4040 CONSTANT OF EBCDIC BLANKCSP10850PUT0094 0 0000 MONEY DC 4.* FILL FOR FLOATING S CSP108600095 0 0000 NDUMP DC • IF FILL FOR ANY SUPPRESSION C5P10870 P14030096 0 F040 ZERO DC /F040 CONSTANT OF EBCDIC ZERO CSP10880P1442REA DR2501SKIPPAGE 4STACK0097 0 0000 NZRSP DC •..* HOW FAR TO ZERO SUPPRESS CSP10890 SUB0098 0 3C40 AST DC /5C40 CONSTANT OF ASTERISK CSP109000099 0 5840 DLRSG DC /5840 CONSTANT OF DOLLAR SIGN CSP10910S1403009A 0 6840 COMMA DC /6840 CONSTANT OF COMMA CSP109200098 0 6040MINUS DC /6040 CONSTANT OF MINUS SIGNCSP10930TYPER009C 0 D940009D 0 0001009E 0 0002R DC /D940 CONSTANT OF LETTER RCSP10940ONE2 pc1 CONSTANT OF ONECSP10950TWO2 DC2 CONSTANT OF TWOCSP10960• IS NSIGN EQUAL TO TWO CSP10970UNPAC009F 0 CO29 OK LD NSIGN PICKUP THE ORIGINAL ZONE CSP1098000A0 0 90FD S TWO2 INDICATOR AND CHECK AGAINST TWO CSP10990WHOLE00A1 01 4C180086 BSC L NEG.+- EQUAL-GO TO NEG CSP11000• KTEST•KCARDIKLA5T) CSP1101000A3 00 C4000000 KCRD3 LD L •.* NOT EQUAL-PICKUP KCARDIKLAST1 CSP1102000A5 0 90F5 S MINUS AND CHECK AGAINST MINUS SIGN CSP1103000A6 01 40180083 BSC L L020.. IF EQUAL-GO TO LD2 CSP1104000A8 0 80F2 A MINUS NOT EQUAL-GET KTEST AND CHECK CSP1105000A9 0 90F2 S R AGAINST LETTER R CSP11060OOAA 01 4C200066 BSC L NEG.Z IF NOT EQUAL-GO TO NEG CSP11070OOAC 01 740100A4 MD% L KCRD3+1,1 EQUAL-GET ADDRESS OF CSP11080• KCARDIKLAST.1I CSP11090• KCARDIKLAST..11.16448 CSP11100OOAE 0 COE4 LD BLANK PICKUP A BLANK CSP11110OOAF 01 048000A4 STO I KCRD3+1 STORE AT KCARDIKLAST ■ 11 CSP111200081 01 74FF00A4 MDX L KCRD3+1...1 GET ADDR OF KCARDIKLASTS CSP1<strong>1130</strong>* KCARDIKLAST/*16448 CSP111400083 0 CODF LD2 LD BLANK PICKUP A BLANK CSP111500084 01 048000A4 STO I KCRD3+1 STORE AT KCARDIKLAST) CSP11160• IS NZRSP GREATER THAN ZERO CSP111700086 0 COED NEG LD NZRSP GET NZRSP AND CSP111800087 01 4000006E BSC L SAVE)... IF NOT POSITIVE-EXIT CSP111900069 01 8480008F A I K1 POSITIVE-CALCULATE SUBSCRIPT OF CSP112000088 0 90E1 S ONE2 LAST POSITION TO BE ZERO CSP11210008C 0 DOE7 STO KCRO3i1 SUPPRESSED-END OF FILL AREA CSP11220• ZERO SUPPRESS CSP1123000BD 30 062834C0 CALL FILL FILL ROUTINE TO ZERO SUPPRESS CSP11240008F 0 0000 KCRD2 DC *-* ADDRESS OF KCARD CSP112500000 0 0000 K2 DC *-* ADDRESS OF K CSP1126000C1 1 00A4 DC KCRD3+1 ADDRESS OF END OF FILL AREA CSP1I27000C2 1 0095 DC NDUMP ADDRESS OF FILL CHARACTER CSP1I280• KCARDINIRSP/•MONEY CSP1129000C3 0 COFB LD KCRD2 GET KCARD ADDRESS CSP<strong>1130</strong>000C4 0 900F S KCRD3+1 SUBTRACT LAST FILL VALUE CSP113100005 0 BOD7 A ONE2 ADD CONSTANT OF ONE CSP113200006 0 4002 STO STOK+1 CREATE KCARDINZRSP/ ADDRESS CSP113300007 0 COCC LD MONEY PICKUP MONEY VALUE CSP113400008 00 04000000 STOK STO L *..• STORE FOR SUPPRESSION C5P1135000C9 NSIGN ECU STOK+1 TO SAVE CORE STORAGE CSP11360COCA 0 70A3 MDX SAVE1 GO TO EXIT CSP1137000CC END CSP11380NO ERRORS IN ABOVE ASSEMBLY.-167-


ADDA1A3A1DECA3A1CARRYDECA1DIV// DUP CSP11390•STORE WS UA EDITCSP114003361 0000DPACK// ASM CSP11410•• FILL SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 110) C5P11420DUNPK • NAME FILL 110/ 05P11430EDIT• LISTCSP114400000 06253400 ENT FILL FILL SUBROUTINE ENTRY POINT CSP11450FILL• CALL FILLIJCARD.J.JLASTACIO CSP11460• THE WORDS JCARDIJ) THROUGH CSP11470• JCARD1JLAST1 ARE FILLED WITH THE CSP11480• CHARACTER AT LOCATION NCH. CSP11490GET0000 0 0000 FILL DC •..• ARGUMENT ADDRESS COMES IN HERE CSP115000001 0 6919 STX 1 SAVE1+1 SAVE IR1CSP11510ICOMP 0002 01 65800000 LDX 11 FILL PUT ARGUMENT ADDRESS IN IRS CSP115200004 0 C100 LD 1 0 GET JCARD ADDRESS 05P11530IOND 0005 00 95800002 5 11 2 SUBTRACT VALUE OF .JLAST 05P115400007 0 DOOF STO ST0+1 CREATE ADDRESS OF JCARD1JLAST/ CSP11550KEYBDNoe 00 05800002 LD 11 2 GET VALUE-OF JLASTCSP11560000A 00 95800001 ONE S II 1 SUBTRACT VALUE OF JCSP11570000C 0 ROPE A ONE+1 ADD CONSTANT OF ONECSP11580MOVE 0000 0 4808 BSC + CHECK FIELD WIDTHCSP11590000E 0 COFC LD ONE+1 NEGATIVE OR ZERO MAKE IT ONE CSP11600MPY 000F 0 0005 STO LDX+1 OK ■ STORE FIELD WIDTH IN LOX CSP116100010 00 05800003 LD II 3 GET FILL CHARACTER ■ NCH CSP116200012 0 7104 MDX 1 4 MOVE OVER FOUR ARGUMENTSCSP11630NCOMP0013 0 6909 STX 1 DONE1+I CREATE RETURN ADDRESSCSP11640• JNOW-JCSP11650NSIGN 0014 00 65000000 LOX LOX Ll •■• LOAD IRS WITH FIELD WIDTHCSP11660• JCARD1JNOW1■NCHCSP11670NZONE 0016 00 05000000 STO STO LI •■• STORE FILL CHAR AT JCARD(JNOWI CSP11680PACK• SEE IF JNOW IS LESS THAN JLAST. CSP11690• IF YES, JNOW■JNOW+1 AND GO BACK CSP11700• FOR MORE. IF NO. EXIT.CSP117100018 0 71FF MDX 1 — 1 DECREMENT FIELD WIDTHCSP11720PRINT0019 0 70FC MDX STO NOT DONE GO BACK FOR MORE CSP11730• EXITCSP11740001A 00 65000000 SAVES LDX LI 'F..* DONE RESTORE IR1CSP11750001C 00 4C000000 DONES BSC L •■• RETURN TO CALLING PROGRAMCSP11760001EENDCSPI1770PUNCHPUTP1403P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLENO ERRORS IN ABOVE ASSEMBLY./I OUP CSPI1780•STORE WS UA FILL3361 0003CSP1I790Aas,-168-


ASMCSPI1800ADD*• GET SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101 CSP11810• NAME GET(ID) CSP11820A1A3• LISTCSP118300000 07163000 ENT GET GET SUBROUTINE ENTRY POINTCSPI1840GETIJCARD.J.JLAST,SHIFT)CSP11850A1DEC• THE WORDS JCARDIJ, THROUGHCSP11860JCAROWLASTI ARE CONVERTED TO A CSP11870A3A1REAL NUMBER AND MULTIPLIED BY CSP11880•SHIFT TO PLACE THE DECIMAL POINT CSP11890CARRY0000 0 0000 GET DC I..* ARGUMENT ADDRESS COMES IN MERE CSP119000001 0 6948STX 1 FIN+1 SAVE IR1CSP11910DECA10002 01 65800000LOX 11 GET PUT ARGUMENT ADDRESS IN IR1 CSP119200004 0 C100LD 1 0 GET JCARD ADDRESSCSP119300005 0 0013STO JCRD1 STORE FOR NZONE AT JCRD1CSP11940DIV0006 0 DO3CSTO JCRD3 STORE FOR NZONE AT JCRD3CSP119500007 00 95800002 TWO S Il 2 SUBTRACT JLAST VALUECSP11960DPACK0009 0 0018STO JCRD2+1 CREATE JCARDIJLAST) ADDRESS CSP11970000A 0 C103LO 1 3 GET SHIFT ADDRESS ANDCSP11980DUNPK0008 0 D033 STO SHIFT STORE FOR MULTIPLY TO PLACE • CSP11990000C 00 C5800002LD Il 2 GET JLAST VALUE ANDCSP12000000E 0 DOF1STO GET SAVE FOR NZONECSP12010EDIT000F 00 95800001 ONE S Il 1 SUBTRACT J VALUECSP120200011 0 80FEA ONE+1 ADD CONSTANT OF ONECSP12030FILL0012 0 4808BSC + CHECK FIELD WIDTHCSP120400013 0 COFCLD ONE+1 NEGATIVE OR ZERO-MAKE IT ONE CSP12050GET0014 0 DOGE STO CNT+1 OK-SAVE FIELD WIDTH AT COUNT CSP120600015 0 7104MDX 1 4 MOVE OVER FOUR ARGUMENTSCSP12070ICOMP0016 0 6938SIX 1 DONE1+1 CREATE RETURN ADDRESSCSP12080*MAKE THE FIELD POSITIVE AND CSP12090•SAVE THE ORIGINAL SIGNCSP12100IOND0017 30 15A56545CALL NZONE NZONE TO CLEAR ORIGINAL SIGN CSP121100019 0 0000JCRD1 DC 41+• ADDRESS OF JCARDCSP12120KEYBD001A 1 0000 DC GET ADDRESS OF JLAST CSP121300018 1 0050DC FOUR ADDRESS OF CONSTANT OF FOUR CSP12140MOVE001C 1 0019DC JCRD1 ADDRESS OF OLD SIGN INDICATOR CSP121500010 0 18A0SRT 32 CLEAR ACCUMULATOR AND EXTENSION CSP12160001E 0 DB7ESTD 3 126 CLEAR MANTISSA OF FACCSP12170MPY001F 0 D370 STO 3 125 CLEAR CHARACTERISTIC OF FAC CSP12180•LET GET AND ANS BE EQUIVALENT CSP12190NCOMP0020 20 058A3580 LIBF ESTO STORE THE CONTENTS OF FAC CSP122000021 1 005A DC ANS AT GET CSP1221Q•NSIGNJNOW.J CSP122200022 00 65000000 CNT LOX LI • +46 LOAD IR1 WITH THE FIELD WIDTH C5P12230*JTEST.JCARDIJNOWICSP12240NZONE0024 00 05000000 JCRD2 LD LI 11+• PICKUP JCARDUNOW)CSP122500026 01 4C28002CBSC L MAYBE.+Z IS JTEST NEGATIVE-YES-MAYBE CSP12260PACK0028 0 9028S BLANK NO - IS JTEST EQUAL TO ANCSP122700029 01 4C200053BSC L ERRIPZ EBCDIC BLANK NO - GO TO ERR CSP12280PRINT0028 0 CO26 LD ZERO YES - REPLACE BLANK WITH ZERO CSP12290002C 0 9025MAYBE S ZERO IS JTEST LESS THAN AN EBCDIC CSP12300002D 01 4C280053BSC L ERROZ ZERO - YES - GO TO ERRCSP12310PUNCHJTEST+4032 IN ACCUMULATORCSP12320GET.10•GET+1JTEST+40321/256 CSP12330PUT• SHIFT 8 IS SAME AS DIVIDE BY 256 CSP12340002F 0 1808 SRA 8 NO SHIFT 4 BIT DIGIT TO LOW CSP12350 P14030030 20 06406063 LIBF FLOAT ORDER OF ACC AND MAKE REAL CSP12360P1442READR2501SKIPSTACKSUBPAGE 20031 20 058A3580 LIBF ESTO STORE REAL DIGIT CSP12370 S14030032 1 0057DC TEMP IN TEMPORARY STORAGECSP123800033 20 054C4000LIBF ELD LOAD FAC WITHCSP12390TYPER0034 1 005A DC ANS GET CSP124000035 20 05517A00LIBF EMPY MULTIPLY GETCSP124100036 1 0050DCUNPACETEN BT TENCSP124200037 20 15599500LIBF NORM NORMALIZE THE PRODUCTCSP124300038 20 05044100LIBF EADD ADD TEMPORARY STORAGECSP12440WHOLE0039 1 0057 DC TEMP TO FAC CSP12450003A 20 058A3560 LIBF ESTO STORE RESULT CSP124600038 1 005A DC ANS IN GET CSP12470* SEE IF JNOW IS LESS THAN JLAST. CSP12480• IF YES, JNOW.JNOW+1 AND GO BACK CSP12490• FOR MORE. IF NO, PLACE DECIMAL CSP12500• POINT. CSP12910003C 0 71FF MD% 1 +1 DECREMENT FIELD WIDTH CSP125200030 0 70E6 MD% JCRD2 NOT DONE-GET NEXT DIGIT CSP12530GET.SHIFT*GETCSP12540003E 20 05517A00 LIBF EMPY DONE-MULTIPLY BY SHIFT TO PLACE CSP12550003E 0 0000 SHIFT DC *-* ADDRESS OF SHIFT---DECIMAL POINT CSP125600040 20 15599500 LIBF NORM NORMALIZE THE RESULT CSPI2570• REPLACE SIGN OF JCARD CSP125800041 30 15A56545 CALL NZONE RESTORE ORIGINAL JCARD SIGN CSP125900043 0 0000 J0103 DC *..* ADDRESS OF JCARD CSP126000044 1 0000 DC GET ADDRESS OF JLAST CSPI26100045 1 0019 DC JCRD1 ADDRESS OF ORIG. SIGN INDICATOR CSP126200046 1 0043 DC JCRD3 DUMMY CSP12630• IF INDICATOR EQUALS 2. CSP12640GET--GET. OTHERWISE, EXIT C5P126500047 0 0001 LD JCRD1 LOAD OLD SIGN AND SEE IF IT CSPI26600048 0 908F S TWO+1 WAS NEGATIVE CSP126700049 01 4C20004C BSC L FIN. IF YESIPREVERSE SIGN-NO-EXIT CSP12680• GET--GET CSP126900048 20 22559000 LIBF SNR REVERSE THE SIGN OF THE RESULT CSP12700• EXIT CSP12710004C 00 65000000 FIN LOX LI *+* RESTORE IR1 CSP12720004E 00 4C000000 DONE1 BSC L *-* RETURN TO CALLING PROGRAM CSP127300050 0 0004 FOUR DC 4 CONSTANT OF FOUR CSP127400051 0 4040 BLANK DC /4040 CONSTANT OF EBCDIC BLANK CSP127500052 0 F040 ZERO DC /F040 CONSTANT OF EBCDIC ZERO CSP127600053 0 10A0 ERR SLT 32 CLEAR ACCUMULATOR AND EXTENSION CSP127700054 0 DB7E STD 3 126 CLEAR MANTISSA OF FAC CSP127800055 0 0310 STO 3 125 CLEAR CHARACTERISTIC OF FAC CSP127900056 0 70E5 MDX FIN GO TO EXIT CSP128000057 0003 TEMP BSS 3 TEMPORARY STORAGE CSPI2810005A 0003 ANS BSS 3 TEMPORARY STORAGE CSPI28200050 84 50000000 ETEN 'WIC 10.0 CONSTANT OF 10.0 !TEN) CSPI28300060 END CSP12840NO ERRORS IN ABOVE ASSEMBLY.-169-


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE// OUP CSP12850•STORE WS UA GET3371 0007CSP12860/I ASM CSP12870•• ICOMP SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101 CSP12880• NAME ICOMP 1101 CSP12890• LIST CSP129000000 09006517 ENT ICOMP ICOMP SUBROUTINE ENTRY POINT CSP12910• ICOMPWCARD.J.JLASTACARD.K.KLASTI CSP12920• THE WORDS JCARDIJ1 THROUGH CSP12930• JCARDIJLASTI ARE COMPARED TO THE CSP12940• WORDS KCARDIK/ THROUGH CSP12950• KCARD1KLAST/. CSP129600000 0 0000 ICOMP DC •■• ARGUMENT ADDRESS COMES INHERE CSP129700001 0 6972 STX 1 SAVE1+1 SAVE IRO CSP129800002 01 65800000 LOX II ICOMP PUT ARGUMENT ADDRESS IN IR1 CSP129900004 0 C100 LD 1 0 GET JCARD ADDRESS CSP130000005 00 95800002 5 Il 2 SUBTRACT JLAST VALUE CSP130100007 0 0048 STO JPIC1+1 STORE JCARDULAST/ FOR JHASH CSP130200000 0 DO4A STO JPIC2+1 STORE JCARDIJLAST/ FOR ICOMP CSP130300009 0 800A A ONE+1 ADD CONSTANT OF ONE CSP13040000A 0 DOOF STO SGNJ+1 CREATE ADDRESS OF JCARD1JLASTI CSP13050000B 0 C103 LD 1 3 GET KCARD ADDRESS CSP13060000C 00 95800005 S 11 5 SUBTRACT KLAST VALUE CSP13070000E 0 0046 STO KPIC2+1 STORE KCARDIKLAST/ FOR ICOMP CSP13080000F 0 8004 A ONE+1 ADD CONSTANT OF ONE CSP130900010 0 0011 STO SGNK+1 CREATE ADDRESS OF KCARNKLASTI CSP131000011 00 C5800002 TWO LD 11 2 GET VALUE OF JLAST CSP131100013 00 95800001 ONE S Il 1 SUBTRACT VALUE OF J C5P131200015 0 UWE A ONE+1 ADD CONSTANT OF ONE CSP131300016 0 4808 BSC • CHECK FIELD WIDTH CSP131400017 0 COFC LD ONE+1 NEGATIVE OR ZERO-MAKE IT ONE CSP131500018 0 0035 STO CNTC0+1 SAVE FIELD WIDTH IN COMP CNT CSP13160• CLEAR AND SAVE THE SIGNS ON THE CSP13170• JCARD AND THE KCARD FIELDS CSP131800019 00 C4000000 SGNJ LD L •..• PICKUP THE SIGN OF JCARD CSP131900018 0 DOH STO JSIGN SAVE IT CSP13200001C 01 4C100021 BSC L SGNK.- IS IT NEG-NO-LOOK AT KCARD CSP13210001E 0 FOOF EOR MFFFF +1 YES-MAKE IT POSITIVE AND CSP13220001F 01 0480001A STO 1 SGNJ+1 CHANGE JCARD FIELD SIGN CSP132300021 00 C4000000 SGNK LD L •■• PICKUP THE SIGN OF KCARD CSP132400023 0 0054 STO KSIGN SAVE IT CSP132500024 01 4C100029 BSC L CHCK.- IS IT NEG-NO-GO TO CHCK CSP132600026 0 F007 EOR HFFFF+1 YES-MAKE IT POSITIVE AND CSP132700027 01 D4800022 STO I SGNK+1 CHANGE THE KCARD FIELD SIGN CSP132800029 0 7106 CHCK MDX 1 6 MOVE OVER SIX ARGUMENTS C5P13290002A 0 6940 STX 1 DONE1+1 CREATE RETURN ADDRESS CSP13300• K IS COMPARED TO CSP13310• KSTRT•KLAST+J■JLAST■1 CSP133200028 00 C58OFFFE LD 11 -2 PICKUP THE VALUE OF K CSP133300020 00 958OFFFF HFFFF S Il -1 SUBTRACT THE VALUE OF KLAST CSP13340002F 00 958OFFFB S 11 -5 SUBTRACT THE VALUE OF J CSP133500031 00 858OFFFC A 11 -4 ADD THE VALUE OF JLAST C5P133600033 0 80E0 A ONE+1 ADD CONSTANT OF ONE CSP133700034 01 4C300040 BSC L JHASH.-Z IF POSITIVE GO TO JHASH CSP133800036 0 FOF7 EOR HFFFF+1 OTHERWISE COMPLIMENT AND ADD CSP133900037 0 80DA A TWO+1 ONE GIVING LEADING PART KCARD CSP134000038 0 DOOR STO ZIPCT+1 STORE THIS COUNT AT ZIPCT CSP134100039 00 858OFFFE A 11 -2 ADD VALUE OF K CSP13420-170-


PAGE 20038 0 9008 S ONE*1 SUBTRACT CONSTANT OF ONE CSP13430A1A3003C 0 DOC3 STO ICOMP STORE TEMPORARILY CSP13440003D 0 C1FDLD 1 — 3 GET KCARD ADDRESSCSP13450003E 0 90C1SICOMP SUBTRACT TEMPORARY VALUE GIVING CSP13460A1DEC003F 0 D006 STO KPICI+1 ADDR FOR SEARCHING BEGINNING CSP13470OF KCARDC5P13480A3A1ICOMP. — KSIGNCSP134900040 0 CO37 LD KSIGN LOAD SIGN OF KCARD CSP13500 CARRY0041 0 FOEC EOR HFFFF+1 NEGATE IT CSP135100042 0 DOBD STO !COMP STORE IT IN ICOMPC5P13520•KNOW-K.CSP13530DECA10043 00 65000000 ZIPCT LDX Ll •—• LOAD IR1 WITH BEGINNING KCARD CT CSP135400045 00 C5000000 KPIC1 LD Ll •••• PICKUP KCARDIKNOW1C5P13550DIV•IS KCARDIKNOW1 POSITIVECSP135600047 01 4C30006CBSC L FIN.Z IF POSITIVE. GO TO FINCSP13570DPACKSEE IF KNOW IS LESS THAN KSTRT. CSP13580• IF YES, KNOW*KNOW+1 AND LOOK AT CSP13590DUNPKNEXT KCARD WORD. IF NO. GO TO C5P13600•JHASH.CSP136100049 0 71FFMD% 1 -1 OTHERWISE. DECREMENT FIELD WIDTH CSP13620EDIT004A 0 70FA MDX KPIC1 NOT DONE —GO BACK FOR NEXT DIGIT CSP13630•JHASH-0CSP13640FILL0048 0 1810 JHASH SRA 16 DONE—CLEAR ACCUMULATOR CSP13650004C 0 DOB3 STO ICOMP CLEAR !COMP CSP13660 GETKNOW*KSTRT+1 CSP13670•KSTRT-JCSP136800040 00 65000000 CNTCO LDX L/ ••■• LOAD IR1 WITH FIELD WIDTHC5P13690ICOMP•JHASH•JHASH*JCARDIKSTRT/CSP13700004F 00 85000000 JPIC1 A Ll •..• ADD JCARDIKSTRT/ TO JHASHCSP13710IOND0051 0 1890 SRT 16 STORE JHASH IN EXTENSION CSP13720ADD• ICOMP*JCARDIKSTRT1—KCARDIKNOW) CSP13730 KEYBDKPIC2 S Ll •■• SUBTRACT KCARDIKNOW/CSP13750STO ICOMP STORE RESULTCSP13760MOVE•IS ICOMP ZERO NO — GO TO NEO CSP13770BSC L NE0.2 IF NOT ZERO. GO TO NEO.CSP13780MPY• KNOW*KNOW41 CSP13800 NCOMPSEE IF KSTRT IS LESS THAN JLAST. CSP13810IF YES. KSTRT*KSTRT+1 AND TRY CSP13820•NEXT PAIR OF DIGITS. IF NO, CSP13830NSIGNMDX 1 — 1 DECREMENT FIELD WIDTHCSP13840MD% JPIC1 NOT DONE -, GO BACKC5P13850NZONE•IF NO IS JSIGN•CSIGN•JHASH NEGATIVE. CSP13860BSC L FIN.+ — DONE— IF JHASH IS ZERO GO FIN CSP13870PACK0052 00 C5000000 JPIC2 LO Ll •—• LOAD JCARDIKSTRT) C5P137400054 00 950000000056 0 DOA90057 01 4C2000630059 0 1090 SLT 16 OTHERWISE. PUT JHASH IN ACCUM CSP13790005A 00058 071FF70F3005C 01 4C18006C005E 0 C018 LD JSIGN OTHERWISE COMPUTE JSIGN CSP13880005F 0 F018 EOR KSIGN TIMES KSIGN CSP13890PRINT0060 01 4C10006C BSC L FIN... IF NOT NEGATIVE. GO TO FIN CSP139000062 0 7004 MDX OVR1 OTHERWISE GO TO OVR1CSP13910•15 KSIGN•JSIGN NEGATIVECSP13920PUNCH0063 0 C013NEO LD JSIGN COMPUTE JSIGNCSP139300064 0 F013EOR KSIGN TIMES KSIGNCSP13940PUT0065 01 4C100069 BSC L OVR2s .. IF NOT NEGATIVE. GO TO OVR2 CSP139500067 0 COE5• ICOMP-1 CSP13960P1403OVR1 LD CNTCO OTHERWISE, SET !COMP CSP13970P1442READR2501SKIPSTACKPAGE 3SUB0068 0 D097■STOS1403ICOMP TO A POSITIVE NUMBERICOMPmJSIGN•ICOMPCSP13980CSP139900069006A00C096FOOCOVR2 LDEORICOMP LOAD !COMP ANDJSIGN MULTIPLY BY JSIGNCSP14000CSP14010TYPERRESTORE THE SIGNS ON THE JCARD C5P14030UNPAC• AND THE KCARD FIELDS CSP14040006C 0 COOA FIN LO JSIGN RESTORE THE ORIGINAL C5P14050WHOLE006D 01 0480001A STO I SONJ+1 SIGN OF JCARD CSP140600068 0 D094 STOICOMP STORING THE RESULT IN !COMP CSP14020006F 0 C008 LD KSIGN RESTORE THE ORIGINAL CSP140700070 01 04800022 STO I SGNK*1 SIGN OF KCARD CSP140800072 0 C080 LO ICOMP PUT ICOMP IN THE ACCUMULATOR CSP14090• EXIT CSP141000073 00 65000000 SAVE1 LOX Ll •• RESTORE IR1 CSP141100075 00 4C000000 DONE1 BSC L •..* RETURN TO CALLING PROGRAM CSP141200077 0 0000 JSIGN DC •• SIGN OF JCARD CSP141300078 0 0000 KSIGN DC •..• SIGN OF KCARD CSP14140007A END CSP14150NO ERRORS IN ABOVE ASSEMBLY.9// OUP•STORE WS UA ICOMP3378 0008CSP14160CSP14170-171-


ADDA 1A3A 1DECA3A 1CARRYDE CA1DIVDPA CKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN ZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHO LE// ASM CSP14180** IOND SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101 CSP14190• NAME IOND 1101 CSPI4200* LIST CSP142100000 09595100 ENT IOND SUBROUTINE NAME CSPI4220•CALL IOND NO PARAMETERSC5P14230•CALL IOND ALLOWS I/O OPERATIONS TO END BEFORE A CSP14240* PAUSE OR STOP IS ENTERED CSP142500000 0001 IOND BSS 1 ARGUMENT ADDRESS CSP142600001 00 74000032 IOPND MDX L 50,0 ANY INTERRUPTS PENDING CSPI42700003 0 70FD MDX IOPND YES KEEP CHECKING CSP142800004 01 4C800000 BACK BSC I IOND NO ■ RETURN TO CALLING PRG CSP142900006 END CSP14300NO ERRORS IN ABOVE ASSEMBLY.// DUP CSP14310•STORE WS UA IOND3380 0002CSP14320// ASM CSP14330►• MOVE SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID) CSP14340• NAME MOVE IID/ CSPI4350• LISTCSP143600000 143A5140 ENT MOVE MOVE SUBROUTINE ENTRY POINT CSP14370• CALL MOVEIJCARD.J.JLAST,KCARD.K/ CSP14380• THE WORDS JCARD(J) THROUGH CSP14390• JCARD(JLAST) ARE MOVED TO KCARD CSP14400• STARTING AT KCARD(K). CSP144100000 0 0000 MOVE DC •■• ARGUMENT ADDRESS COMES IN HERE CW144200001 0 691F STX 1 SAVE1+I SAVE IR1 CSP144300002 01 65800000 LDX II MOVE PUT ARGUMENT ADDRESS IN IR1 CSP144400004 0 C100 LD 1 0 GET JCARD ADDRESS CSP144500005 00 95800002 S Il 2 SUBTRACT JLAST VALUE CSP144600007 0 0013 STO LD1+1 PLACE ADDR OF JCARDIJLAST/ IN CSP14470• PICKUP OF MOVE CSP144800008 00 C5800002 LD 11 2 GET JLAST VALUE CSP14490000A 00 95800001 ONE S 11 1 SUBTRACT J VALUE CSP14500000C 0 4828 BSC +Z CHECK FIELD WIDTH CSP14510000D 0 1810 SRA 36 NEGATIVE ■ MAKE IT ZERO CSP14520000E 0 DOOA STO LDX+1 STORE FIELD WIDTH IN LDX CSP14530000F 0 C103 LD 1 3 GET KCARD ADDRESS CSP145400010 00 95800004 S 11 4 SUBTRACT K VALUE CSP145500012 0 9006 5 LDX+1 SUBTRACT FIELD WIDTH CSP145600013 0 D009 STO ST0+1 PLACE ADDR OF KCARD(KLAST) IN CSP14570• STORE OF MOVE CSP145800014 01 74010019 MDX L LDX+1.1 ADD ONE TO FIELD WIDTH CSP14590• MAKING IT TRUE CSP146000016 0 7105 MD% 1 5 MOVE OVER FIVE ARGUMENTS CSP146100017 0 6908 STX 1 DONE1+1 CREATE RETURN ADDRESS CSP14620• JNOW.J CSP14650• KNOW*K+JNOW■J CSP146400018 00 65000000 LDX LDX LI •..* LOAD IR1 WITH FIELD WIDTH CSP14650• KCARDIKNOW1•JCARDIJNOW) CSP14660001A 00 C5000000 LOl LD LI •■11 PICKUP JCARDIJNOW1 CSP14670001C 00 05000000 STO STO LI •■• STORE IT IN KCARDIKNOW/ CSP14680• SEE IF JNOW IS LESS THAN JLAST. CSP14690• IF YES. JNOW*JNOW+1 AND MOVE CSP14700• NEXT CHARACTER. IF NO. EXIT.... CSP14710001E 0 TIFF MDX 1 ■ 1 DECREMENT THE FIELD WIDTH CSP14720001F 0 70FA MDX LD1 NOT DONE ■ GET NEXT WORDCSP14730• EXIT0020 00 65000000 SAVE1 LOX LI ••RESTORE IR1 g:12:0022 00 4C000000 DONE1 BSC L 'P ..* RETURN TO CALLING PROGRAM CSP147600024 END CSP14770NO ERRORS IN ABOVE ASSEMBLY.// DUP CSP14780•STORE WS UA MOVEC5P147903382 0003-172-


CSP14800ADDCSP14810CSP14820CSP14830A1A3CSP14840CSP14850A1DECC5P14860JCARDULASTI MULTIPLY THE WORDS C5P14870 A3A1KCARD(K) THROUGH KCARD1KLASTl. CSP14880• THE RESULT IS IN THE KCARD FIELD CSP14890EXTENDED TO THE LEFT.CSP14900CARRYMPY DC •-• ARGUMENT ADDRESS COMES IN HERE CSP14910STX 2 SAVE2+1 SAVE IR2CSP14920DECA1STX 1 SAVE1+1 SAVE IR1C5P14930LDX Il MPY PUT ARGUMENT ADDRESS IN IR1 CSP14940DIVSTO KI STORE FOR FILL OF ZEROESCSP14960•CALCULATE P. 1CSP14970DPACKLD I K1 GET VALUE OF KC5P14980S ONE*1 SUBTRACT CONSTANT OF ONECSP14990DUNPKSTO MPY STORE IN MPYCSP15000LO 1 0 GET JCARD ADDRESSCSP15010EDIT// ASM•• MPY SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (101• NAME MPY(ID)• LIST0000 145E8000•ENT MPY MPY SUBROUTINE ENTRY POINTCALL MPYIJCARD.J.JLASTOCCARD.K.KLAST.NER1THE WORDS JCARD1J1 THROUGH0000 00001 00000GAGA0002 0 0003 01 658000000005 0 C104 LD 1 4 GET K ADDRESS CSP149500006 0 DOSE0007 010009 0C4800065900B000A 0 OOPS0008 0 C100000C 00 94800002 S 11 2 SUBTRACT JLAST VALUE CSP15020000E 0 D04E STO SRCH+1 SAVE FOR JFRST SEARCH C5P15030FILLGOOF 0 0075 STO MULT1+1 SAVE FOR MULTIPLICATION CSP15040GET0010 00011 08004002FA 00E+1 ADD CONSTANT OF ONESTO 011+2 CREATE ADDRESS OF JCARDULASTICSP15050CSP150600012 00 TWO LD II 2 GET JLAST VALUECSP150700014 00 95800001 ONE S 11 1 SUBTRACT J VALUECSP15080ICOMPIOND0018 0 COFC LD 00E+1 NEGATIVE OR ZERO-MAKE IT ONE CSP151100019 0 D024STO SCHCT+1 SAVE FIELD WIDTH FOR SEARCH CSP15120001A 0 C103LD 1 3 GET KCARD ADDRESSC5P15130KEYBD0018 0 003CSTO KCRD1 SAVE FOR FILLCSP15140001C 0 D047STO KCRD2 SAVE FOR FILLCSP15150MOVE0016 00017 080FE4808A 00E+1 ADD CONSTANT OF ONEBSC • CHECK FIELD WIDTHCSP15090CSP151000010 0001E 00 0074STO KCRD3 SAVE FOR CARRYCSP1516095800005S 11 5 SUBTRACT JLAST VALUECSP15170MPY0020 0 0054 STO PICK+1 SAVE FOR MULTIPLICATION CSP151800021 0 D059STO PUT1+1 SAVE FOR MULTIPLICATIONCSP15190NCOMP0022 0 80F2A 00E+1 ADD CONSTANT OF ONECSP152000023 0 0027STO SGNK+1 CREATE ADDRESS OF KCARD(KLAST) CSP152100024 0 0105LD 1 5 GET KLAST ADDRESSCSPI5220NSIGN0025 0 DOSESTO KLAS2 SAVE FOR CARRYCSP152300026 0 003FSTO KLAS1 SAVE FOR FILLCSP15240NZONE0027 00 CSB0000S LD Il 5 GET KLAST VALUE CSP152500029 00 95800004 S Il 4 SUBTRACT K VALUE CSP15260 PACK0028 0 80E9 A 00E+1 ADD CONSTANT OF ONE CSP15270PRINT002C 0002D 04808COE7BSC + CHECK FIELD WIDTHLD ONE+1 NEGATIVE OR ZERO-MAKE IT ONECSP15280CSPI5290002E 0 0043STO MULTC+1 SAVE FOR MULTIPLICATIONCSP15300002F 0 7107MDX 1 7 MOVE OVER SEVEN ARGUMENTSCSP15310PUNCH0030 0 693F STX 1 DONE1*1 CREATE RETURN ADDRESS CSP15320• KSTRT=K-JLAST+J-1 CSP15330 PUT, P1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE0031 0 COCE LD MPY LOAD K-1 C5P153400032 00 8S8OFFFAA II -6 ADD VALUE OF JCSP153500094 00 958OFFFB5 11 -5 SUBTRACT VALUE OF JLASTCSP15360-173-


ADDA1A3A1DECPACKPRINTPAGE 20036 01 4C300030 BSC L SCHCT.-2 IF KSTRT POSITIV-G0 TO SCHCTNER-KLASTCSP15370CSP1S3800038 00 C58OFFFE LO 11 -2 NOT POSITIVE-LOAD KLAST VALUE CSP15390003A 00 058OFFFF MONE STO II -1 AND STORE AT NERCSP15400A3A1003C 0 7030MDX SAVE1 GO TO EXITCSP15410• JERST.JCSP154200030 00 65000000 SCHCT LOX LI •..• LOAD IR1 WITH JCARD FIELD WIDTH CSPI5430CARRYCLEAR AND SAVE THE SIGNS ON THE C5P15450003F 0 DOFEOK STO SCHCT+1 SAVE KSTRT IN SCHCT+1•CSP15440• JCARD AND THE KCARD FIELDS CSP15460DECA10040 00 C4000000LD L •• GET JCARD1JLAST1 VALUEC5P154700042 0 DOSC STO JSIGN SAVE SIGN IN JSIGN CSP154800043 01 4C100049BSC L OVRJ,.. IF NOT NEGATIVE-GO TO OVRJ CSP15490DIV0045 0 FOFSEOR MONE+1 NEGATIVE-MAKE SIGN POSITIVE CSP155000046 01 04800041STO I 0K+2 AND PUT BACK IN JCARDIJLAST/ CSP15510DPACK 0048 0 COF2LD MONE+I PICKUP A MINUS ONECSP155200049 0 1890OVRJ SRT 16 PUT JSIGN INDICATION IN EXTENTON CSP15530DUNPK004A 00 C4000000 SGNK LD L •• PICKUP KCARDIKLAST)CSP15540004C 01 4C100054 BSC L KPLUS... IF NOT NEGATIVE-GO TO KPLUS CSP15550004E 0 FOECEOR MONE+1 NEGATIVE-MAKE POSITIVE AND CSP15560EDIT004F 01 04800048STO I SGNK+1 PUT BACK IN KCAROCKLAST1CSP155700051 0 1090SLT 16 GET JSIGN INDICATIONCSP155110FILL 0052 0 FOESEOR MONE+1 CHANGE ITCSP155900053 0 7001MDX OVRK SKIP THE NEXT INSTRUCTIONCSP15600GET0054 0 1090 KPLUS SLT 16 GET JSIGN INDICATIONCSP156100055 0 004A OVRK STO KSIGN SAVE SIGN FOR RESULT CSP15620• FILL LEFT EXTENSION OF KCARDICOMPCSP15630• WITH ZEROESCSP156400056 30 062534C0CALL FILL FILL KCARD EXTENSION WITH ZEROES CSP156S0IOND 0058 0 0000KCRD1 DC •-• ADDRESS OF KCARDCSP156600059 1 003EDC SCHCT+1 ADDRESS OF KSTRTCSP15670KEYBD 005A 1 0000DC MPY ADDRESS OF K ■ 1CSP15680005B 1 00A1DC ZIP ADDRESS OF ZEROCSP15690MOVE• IS JCARD(JLASTI POSITIVECSP15700005C 00 C5000000 SRCH LD LI •...• PICKUP JCARDWERST1 CSPI5710DOSE 01 4C300071BSC L MULTC....2 IF POSITIVE-GO TO MULTC CSP15720MPY• SEE IF JFRST IS LESS THAN JLAST. C5P15730• IF YES. JFRST-JFRST+1 AND GO CSP15740NCOMP• BACK FOR MORE. IF NO.CSP15750• MULTIPLICATION IS BY ZERO.NSIGN 0060 0 71FFMDX 1 -1 NOT POSITIVEDECREMENT IR1CSP15760CSP15770NZONE0061 0 TOPA MD% SRCH NOT DONE .. GO BACK FOR MORE CSP15780• FILL WITH ZERO SINCE MULTIPLIER CSPI5790• IS ZEROCSP158000062 30 062534C0CALL FILL DONE-MAKE ENTIRE RESULT ZERO CSPI58100064 0 0000•..• ADDRESS OF KCARDKCRD2 DC CSP158200065 0 0000KI DC •-• ADDRESS OF KCSP158300066 0 0000KLAS1 DC •• ADDRESS OF KLASTCSP158400067 1 00A1 DC ZIP ADDRESS OF ZERO CSP158S0PUNCH• RESTORE THE SIGN OF JCARD CSP15860• EXITCSP158700068 0 CO36FIN 1.0 JSIGN PICKUP JCARD SIGNCSP15880PUT0069 01 D4800041STO I 011+2 AND RESTORE ITCSP158900068 00 66000000 SAVE2 LOX L2 •• RESTORE IRiCSP15900P1403 , 0060 00 65000000 SAVEI LDX LI •...• RESTORE IR1CSP15910P1442READR2501SKIPSTACKSUB51403TYPERUNPACWHOLEtita-174-


$tPAGE 3ADD006F 00 4C000000 DONEI BSC L • + 11 RETURN TO CALLING PROGRAM C5P15920A 1A3• KM•KC5P159300071 00 66000000 MULTC LOX L2 •+. POSITIVE-LOAD IR2 WITH KCARD CNT CSP159400073 0 69F1 STX 1 KI SAVE JFRST AT K1CSPI5950A 1 DEC• MULT•KCARDIKM)CSP159600074 00 C6000000 PICK LD L2 •+* PICKUP KCARDIKM)CSP15970 A3A 10076 01 4C08008E BSC L MO.+ IS IT POSITIVE —NO—GO TO MOCSP159800078 0 DOED STO KLAS1 YES—SAVE. KCARDIKM)CSP15990CARRY0079 0 1810 SRA 16 CLEAR ACCUMULATOR CSP16000• KCARDIKM)•0CSP16010007A 00 D6000000 PUT1 STO L2 •+. SET KCARDIKM)*0CSP16020DECA 1• KNOW.KM+JFRST+JLASTCSPI6030007C 0 6AF5 SIX 2 MULTC+1 GET THE VALUECSP16040DIV0070 0 COF4 LO MULTC+1 OF KMCSP16050007E 0 80E6 A KI AND ADD JFRSTCSP16060DPACK007F 0 8088 A MONE+1 TO IT AND CALCULATECSP160700080 0 SOFA A PUT1+1 THE ADDRESS OF CSPI6080 DUNPK0081 0 0007 STO PUT2+1 KCARDIKNOW) CSP16090• JNOJFRSTW•0082 01 65800065 LDX Il K1 LOAD IR1 WITH JFRST g:1:12: EDIT• KCARDIKNOW)*MULT*JCARDIJNOW) CSP16120• +KCARDIKNOWI CSP16130FILL0084 00 C5000000 MULTI LD LI *+ .11 PICKUP JCARDIJNOWI CSP161400086 0 AODF KLAS1 MULTIPLY BY MULT CSP16150 GET0087 0 1090 SLT 16 RE—ALIGN THE PRODUCT CSP161600088 00 04000000 PUT2 STO L II+ . STORE IN KCARDIKNOW)CSP16170• KNOW-KNOW+1CSP16180ICOMP008A 01 74FF0089 MDX L PUT2+1.+I MODIFY ADDR OF KCARDIKNOWI CSP16190* SEE IF JNOW IS LESS THAN JLAST. CSP16200IOND• IF YES. JNOW.JNOW+1 AND GO BACK CSP16210• FOR MORE. IF NO. CHECK KM. CSP16220 KEYBD008C 0 71FF MDX 1 — 1 DECREMENT IR1C5P162300080 0 70F6 MD% MULTI NOT DONE-GO BACK FOR MORECSP16240• SEE IF KM IS LESS THAN KLAST. CSP16250MOVE• IF YES. KM•KM+1 AND GO BACK FOR CSP16260• MORE. IF NO, RESOLVE CARRIES. CSP16270MPY008E 0 72FF MO MDX 2 — 1 DONE —DECREMENT 1R2C5P16280008F 0 70E4 MDX PICK NOT DONE —GO BACK FOR MORECSP16290NCOMP• RESOLVE CARRIES IN THE PRODUCT CSP163000090 30 03059668 CALL CARRY DONE —RESOLVE CARRIES IN THE RES CSP16310NSIGN0092 0 0000 KCRD3 DC *+* ADDRESS OF KCARDCSP163200093 1 003E DC SCHCT.1 ADDRESS OF KSTRTCSP163300094 0 0000 KLAS2 DC *+* ADDRESS OF KLASTCSP16340N ZONE0095 1 0092 DC KCRO3 DUMMY• GENERATE THE SIGN OF THE PRODUCTCSP16350CSP16360PACK'0096 0 0009 LD KSIGN PICKUP THE- SIGN INDICATOR CSP163700097 01 4C100068 BSC L FINS — IF NOT NEGATIVE-ALL DONE — EXIT CSP16380 PRINT0099 01 C4800048 LD I SGNK+1 NEGATIVE —PICKUP KCARDIKLASTI CSP163900098 0 FO9F FOR MONE+1 CHANGE THE SIGNCSP16400009C 01 04800048 STO I SGNK+1 RESTORE KCARDIKLAST)CSP16410PUNCH009E 0 70C9 MDX FIN GO TO EXITCSP16420009F 0 0000 JSIGN DC *+* SIGN OF JCARDCSP16430PUT00A0 0 0000 KSIGN DC *+* SIGN OF PRODUCTCSP1644000A1 0 0000 ZIP DC 0 CONSTANT OF ZERO CSP16450 P140300A2 ENDCSP16460NO ERRORS IN ABOVE ASSEMBLY.P1442READR2501SKIPSTACKSUB// DUP CSP16470 S1403*STORE WS UA MPY C5P16480 TYPER3385 000A UNPACWHO LERs-175-


ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE•/1 ASM CSP16490•• NCOMP SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 110) CSP16500• NAME NCOMP (ID) CSP16510• LIST CSP165200000 15006517 ENT NCOMP NCOMP SUBROUTINE ENTRY POINT CSP16530• NCOMPIJCARD.J.JLASTIDKCARD.K) CSP16540• THE WORDS JCARDIJ) THROUGH CSP16550• JCARD1JLAST/ STARTING WITH CSP16560• JCARDIJ) ARE COMPARED LOGICALLY CSP16570• TO THE FIELD STARTING AT CSP16580• KCARD1K)• ALL DATA MUST BE IN CSP16590• Al FORMAT. CSP166000000 0 0000 NCOMP DC •■• ARGUMENT ADDRESS COMES IN HERE CSP166100001 0 6925 STX 1 SAVE1+1 SAVE IR1 CSP166200002 01 65800000 LDX 11 NCOMP PUT ARGUMENT ADDRESS IN IR1 CSP166300004 0 C100 LD 1 0 GET JCARD ADDRESS CSP166400005 00 95800002 S 11 2 SUBTRACT JLAST VALUE CSP166500007 0 D017 STO L01+1 CREATE END OF JCARD ADDRESS CSP166600008 00 C5800002 LD 11 2 GET JLAST VALUE CSP16670000A 00 95800001 ONE S II 1 SUBTRACT J VALUE CSP16680000C 0 4828 BSC +2 CHECK FIELD WIDTH CSP166900000 0 1810 SRA 16 NEGATIVE ■ MAKE IT ZERO CSPI6700000E 0 DOOA STO LOX+l SAVE FIELD WIDTH CSP16710000F 0 C103 LD 1 3 GET KCARD ADDRESS CSP167200010 00 95800004 S 11 4 SUBTRACT K VALUE CSP167300012 0 9006 S LDX+1 SUBTRACT FIELD WIDTH CSP167400013 0 0007 STO LD2+1 CREATE END OF KCARD ADDRESS CSP167500014 01 74010019 MD% L LDX+1111 MAKE FIELD WIDTH TRUE CSP167600016 0 7105 MDX 1 5 MOVE OVER FIVE ARGUMENTS CSP167700017 0 6911 STX 1 DONE1+1 CREATE RETURN ADDRESS CSP16780• JNOW*J CSP16790• KNOW*K+JNOW■J CSP168000018 00 65000000 LOX LDX LI ►■• PUT FIELD WIDTH IN IR1 CSP16810001A 00 C5000000 L02 LD LI •■• PICKUP JCARDWNOW) CSP16820001C 0 1804 SRA 4 DIVIDE BY EIGHT CSP168300010 0 DOFB STO LOX+1 SAVE TEMPORARILY CSP16840001E 00 C5000000 LD1 LD LI •■• PICKUP KCARD1KNOW) CSP168500020 0 1804 SRA 4 DIVIDE BY EIGHT CSP168600021 0 90F7 S LDX+1 CALCUL JCARDIJNOW) ■KCARD1KNOW) CSP168700022 01 4C200026 BSC L SAVEla IS NCOMP ZERO-NO-ALL DONE CSP16880• SEE IF JNOW IS LESS THAN JLAST. CSP16890• IF YES, JNOWmJNOW+1 AND GO BACK CSP16900• FOR MORE. IF NO, EXIT. CSP169100024 0 71FF MD% 1 ■ I YES-DECREMENT FIELD WIDTH CSP169200025 0 70F4 MDX LD2 GO BACK FOR MORE CSP16930• ALL DONE EXIT CSP169400026 00 65000000 SAVE1 LDX Ll'•- • RESTORE IRS CSP169500028 00 4C000000 DONE1 BSC L •■• RETURN TO CALLING PROGRAM CSP16960002A END CSP16970NO ERRORS IN ABOVE ASSEMBLY.// DUP CSP16980•STORE WS UA NCOMP338F 0004C5P1699041.-176-


ASM CSP17000•• NSIGN SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101 CSP17010• NAME NSIGN IID) C5P17020• LIST CSP170300000 15889105 ENT NSIGN NSIGN SUBROUTINE ENTRY POINT CSP17040• CALL NSIGNIJCARD,J,NEWS.NOLDS1 CSP17050THE SIGN OF THE DIGIT AT CSP17060• JCARDIJI IS TESTED AND NOLDS IS CSPI7070• SET. THE SIGN IS MODIFIED AS CSP17080• INDICATED BY NEWS. CSP170900000 0 0000 NSIGN DC •..• ARGUMENT ADDRESS COMES IN MERE CSPI7100,,,,Ir"\ 0001 0 691A SIX 1 SAVE1+1 SAVE IR1CSP171100002 01 658000000004 0 C100LOX 11 NSIGN PUT ARGUMENT ADDRESS IN IR1LD 1 0 GET JCARD ADDRESSCSP17120CSPI71300005 00 95800001 ONE 5 11 1 SUBTRACT J VALUE CSP171400007 0 BOFE A ONE+1 ADD CONSTANT OF ONE CSP171500008 0 0001 STO CHAR+1 CREATE JCARDIJI ADDRESS CSP17160JTEST-JCARDIJICSP171700009 00 C4000000 ZHAR LD L •-• PICKUP DIGIT CSP17180000B 01 4C10001F BSC L PLUS.- IS JTEST NEGATIV-NO-GO TO PLUS CSP171900000 0 1890 SRT 16 YES-SAVE TEMPORARILY CSP17200• NOLDS•-1 CSP17210000E 0 C019 LD HFFFF PICKUP MINUS ONE CSPI7220GOOF 00 05800003 STO 11 3 STORE IN MOLDSCSP17230NEWS•JTEST IS COMPARED TO ZERO CSP17240NEWS IS COMPARED TO ZERO CSP172500011 00 C5800002 LD 11 2 PICKUP NEWS CSP172600013 01 4C280019 BSC L FIN.+Z IF NEGATIVE ALL DONE CSPI7270• JTEST•..JTEST■1 CSP172800015 0 1090 REV SLT 16 RESTORE JTEST CSPI72900016 0 F011 FOR HFFFF CHANGE THE SIGN CSP17300JCARD(J)•JTESTCSP173100017 01 0480000A STO I CHAR+1 PUT NEW SIGN IN JCARDIJI CSP173200019 0 7104 FIN MD% 1 4 MOVE OVER FOUR ARGUMENTS CSP17330001A 0 6903 STX 1 DONE1+1 CREATE RETURN ADDRESS CSP17340• EXIT CSP173500018 00 65000000 SAVE1 LOX Ll •-• RESTORE IR1 CSP17360001D 00 4C000000 DON•1 BSC L •-• RETURN TO CALLING PROGRAM CSP17370001F 0 1890 PLUS SRI 16 SAVE TEMPORARILY CSP17380• NOLDS•1 CSP173900020 0 COE5 LD ONE+1 PICKUP CONSTANT OF ONE CSP17400.i. 0021 00 05800003 STO Il 3 STORE IT IN NOLDS CSP17410• NEWS•JTEST IS COMPARED TO ZERO CSPI7420• NEWS IS COMPARED TO ZERO CSP174300023 00 C5800002 LD II 2 PICKUP NEWS CSP174400025 01 4C300019 BSC L FINv4 IF POSITIVE ■ ALL DONE CSPI74500027 0 70ED MDX REV REVERSE SIGN - GO TO REV CSP174600028 0 FFFF HFFFF DC /FFFF CONSTANT OF MINUS ONE CSPI7470002A END CSPI7480NO ERRORS IN ABOVE ASSEMBLY.// OUP CSPI7490•STORE WS UA NSIGN3393 0004CSPI7500ADDA1A3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE0-177-0111,11 I IIIMPIE


ADDA1A3A1DEC// ASM•• NZONE SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE 1101C5P17510C5P17520• NAME NZONEMI CSP17530* LISTCSP175400000 15A56545 ENT NZONE NZONE SUBROUTINE ENTRY POINT CSP17550• CALL NZONEWCARD•J•NEWZ•NOLD2) CSP17560A3A1* THE ZONE OF THE CHARACTER AT CSP17570* JCARDIJ1 IS TESTED AND NOLDZ IS CSP17580CARRY* SET. THE ZONE IS MODIFIED AS C5P17590* INDICATED BY NEWZ.CSP176000000 0 0000NZONE DC 41..* ARGUMENT ADDRESS COMES IN HERE CSP176100001 0 6925STX 1 SAVE1+1 SAVE IR1CSP17620DECA1 0002 01 65800000LDX 11 NZONE PUT ARGUMENT ADDRESS IN IR1 CSP176300004 0 C100LD 1 0 GET JCARD ADDRESSCSP17640DIV0005 00 95800001 ONE S 11 1 SUBTRACT J VALUECSP17650DPACK0007 0 80FE A ONE+1 ADD CONSTANT OF ONE CSP176600008 0 DOIA STO ST0+1 CREATE JCARDIJ/ ADDRESS CSP176700009 0 D001 STO LD1+1 CREATE JCARDIJ, ADDRESS CSP17680JTEST•JCARDIJ/CSP17690DUNPK 000A 00 C4000000 !D1 LD L 11* PICKUP THE CHARACTERC5P17700000C 0 DOFESTO L01+1 SAVE IT TEMPORARILYCSP17710EDITIS JTEST NEGATIVECSP17720GOOD 01 4C10003A BSC L PLUS• .• IF NOT NEGATIVE-GO TO PLUS CSPI7730FILL 000F 0 9018 S ZERO NEGATIVE -CHECK TO SEE IF IT 15 CSP177400010 01 4C18002E BSC L TWO• .. AN EBCDIC ZERO - YES -GO TO TWO CSPI7750NOLD2 m 5+IJTEST ..40964/4096CSP17760GETSHIFT 12 IS EQUIVALENT TO DIVIDE CSP17770• BY 4096CSP17780ICOMPAND 3000 IS EQUIVALENT TOCSP17790• SUBTRACT 4096 AND SHIFTCSP17800IOND 0012 COF8LD LD1+1 NO -RELOAD JTESTCSP178100013 E019 AND H3000 REMOVE ALL BUT BITS 2 AND 3 CSP178200014 180CSRAKEYBD12 PUT IN LOW ORDER OF ACCUMULATOR CSP178300015 80F0A ONE+1 ADD CONSTANT OF ONECSP178400016 0 05800003 STO 11 3 STORE IN NOLDZCSP17850MOVEIS NEWZ LESS THAN FIVECSP178600018 0 C5800002LD Il 2 PICKUP VALUE OF NEWZCSP17870MPY001A 90115 FOUR AND CHECK FOR LESS THAN FIVE CSP178800018 1 4C300024 BSC L FINIS• ..2 NO -GO TO EXIT CSP17890NCOMP 001D 800E A FOUR YES .• RESTORE NEWZ CSP17900JCARDIJ) . JTEST+4096*INEWZNOLDZI CSP17910001E 0 958000035 11 3 SUBTRACT NOLDZCSP17920NSIGN0020 100CSLA 12 PUT RESULT IN BITS 2 AND 3CSP179300021 80E9A LD1.+1 ADD ORIGINAL CHARACTERCSP17940NZONE 0022 0 04000000 STO STO L *-* STORE BACK IN JCARDIACSP17950• EXITCSP17960PACK 0024 7104FINIS MDX 1 4 MOVE OVER FOUR ARGUMENTSC5P17970PRINT0025 6903 STX 1 DONE1+1 CREATE RETURN ADDRESS CSP179800026 0 65000000 SAVE1 LDX Ll I. * RESTORE IR1C5P179900028 0 4C000000 DONE1 BSC L ...•., RETURN TO CALLING PROGRAMCSP18000PUNCHZERO DC /F040 CONSTANT OF EBCDIC ZEROC5P18020002A002B6040F040MINUS DC /6040 CONSTANT OF EBCDIC MINUS SIGN CSP18010002C 0004FOUR DC 4 CONSTANT OF FOURCSP18030PUT0020 3000H3000 DC /3000 CONSTANT FOR STRIPING BITS CSP18040IS NEWZ TWOCSP18050P1403 002E 0 C5800002 TWO LD Il 2 PICKUP VALUE OF NEWZ CSP180600030 90FE S TWO+1 15 IT TWO CSP18070P1442READR2501SKIPSTACKSUBPAGE 2S14030031 01 4C200036 BSC L NOT•Z NO .- GO TO NOT CSP18080• JCARDCJ/•24640CSP18090TYPER 0033 0 COF6LD MINUS YES .- SET JCARDIJ)CSP181000034 01 D4800023 STO I ST0+1 EQUAL TO AN EBCDIC MINUS SIGN CSP18110UNPAC• NOLDZ•4CSP18120WHOLE0036 0 COPS NOT LD FOUR SET NOLDZ C5P181300037 00 058000030039 0 70EASTO 11 3 EQUAL TO FOURMDX FINIS GO TO EXITCSP18140CSP18150• IS JTEST AN EBCDIC MINUS SIGN CSP18160003A 0 90EF PLUS S MINUS NOT NEGATIVE .- CHECK FOR EBCDIC CSP181700038 01 4C200049 BSC L SPEC•2 MINUS SIGN-NO-GO TO SPEC CSP18180• NOLDZ•2CSP18190003D 0 COF1 LD TWO+1 YES-LOAD TWO AND STORE CSP18200003E 00 05800003 STO 11 3 IT IN NOLDZ CSP18210IS NEWZ FOURCSP182200040 00 C5800002 LD 11 2 PICKUP VALUE OF NEWZ AND CSP182300042 0 90E9 S FOUR CHECK FOR VALUE OF FOUR CSP182400043 01 4C200024 BSC L FINI5•2 NO-GO TO FINIS CSP18250JCARDIJ/•4032CSP182600045 0 COES LD ZERO YES-LOAD EBCDIC ZERO AND CSP182700046 01 04800023 STO I ST0+1 STORE IT AT JCARDIJI C5P182800048 0 7008 BIG MD% FINIS GO TO EXIT CSP182900049 0 COFE SPEC LD BIG SPECIAL CHARACTER-LOAD LARGE CSP18300004A 00 05800003 STO 11 3 NUMBER AND STORE AT NOLDZ CSP18310004C 0 7007 MD% FINIS ALL DONE GO TO EXIT CSP18320004E END CSP18330NO ERRORS IN ABOVE ASSEMBLY.// DUP CSP18340*STORE WS UA NZONEC5P183503397 0006-178-


ASMCSP18360*• PRINT AND SKIP SUBROUTINES FOR <strong>1130</strong> CSPIIDI CSP18370• NAME PRINT(ID) CSP18380A 1A3• LISTCSP183900041 17649563 ENT PRINT SUBROUTINE ENTRY POINT CSP18400CSP18410A 1DE C• CALL PRINT LICARI:4 J. JLAST. NERR3)• PRINT JCARDIJ) THROUGH JCARDIJLASTI ON THECSP18420• 1132 PRINTER. PUT ERROR PARAMETER IN NERR3.CSP18430A 3A10069 224895C0• CALL SKIPIN/ CSP18450CARRY* EXECUTE CONTROL FUNCTION SPECIFIED BY INTEGER N CSA18460CSP18470DE CA 10000 0 00010001 0 2000ONE DC 1 CONSTANT OF 1SPACE DC /2000 PRINT FUNCTION WITH SPACE CSP18480ENT SKIP SUBROUTINE ENTRY POINT CSP184400002 0 00000003 0 0000JCARD DC JCARD J ADDRESSJLAST DC *-* JCARD JLAST ADDRESSCSP18490CSP18500ti..*DIV0041 0 0000PRINT DC 4... ADDRESS OF 1ST ARGUMENT CSP185200004 003DAREA BSS 61 WORD COUNT 6 PRINT AREA CSP18510DPACK0043 0 00000044 0 70FDDCMDX TEST REPEAT TEST IF BUSY CSP185500042 20 176558F1 TEST LIBF PRNT1 CALL BUSY TEST ROUTINE CSP18530/0000 BUSY TEST PARAMETER CSP18540DUNPK0046 01 65800041LDX 11 PRINT LOAD 15T ARGUMENT ADDRESS CSP185700045 0 691ASTX 1 SAVE161 STORE IR1CSP18560EDIT0048 20 01647880LIBF ARGS CALL ARGS ROUTINECSA185800049 1 0002DC JCARD JCARD J PICKED UPCSP18590FILL004B 1 0004 DC AREA CHARACTER COUNT PICKED UP CSP18610GET004C 0 0078 DC 120 MAX CHARACTER COUNT CSP186200040 0 COB6LD AREA GET CHARACTER COUNTCSP18630ICO MP004E 0 8081A ONE HALF ADJUSTCSP18640004A 1 0003 DC JLAST JCARD JLAST PICKED UP CSP18600004F 0 18010050 0 DOB3STO AREA STORE WORD COUNTCSP18660SRA 1 DIVIDE BY TWOCSP18650ION D0052 0 D012STO ERR61 STORE IT IN ERROR ROUTINE CSP186800051 0 C103LD 1 3 GET ERROR WORD ADDRESS CSP18670KEYBD0055 1 0003DCDC JLAST JCARD JLAST ADDRESSCSP187100053 20 195C1002 LIBF RPACK CALL REVERSE PACK ROUTINE CSP186900054 1 0002JCARD JCARD J ADDRESSCSP18700MOVE0057 20 176558F1LIBF PRNT1 CALL PRINT ROUTINECSP187300056 1 0005DC AREAS]. PACK INTO I/O AREACSP18720MPY0058 0 2000WRITE DC /2000 PRINT PARAMETERCSP187400059 1 0004DC AREA I/O AREA BUFFERCSP18750NCOMP005A 1 0063 DC ERROR ERROR PARAMETER CSP187600058 0 COAS LD SPACE LOAD PRINT WITH SPACE CSP18770NS IGN0050 0 DOFB STO WRITE STORE IN PRINT PARAMETER CSP187800050 0 7104MD% 1 4 INCREMENT OVER 4 ARGUMENTS CSP18790005E 0 6903ST% 1 DONE161 STORE IR1CSP18800N ZONE005F 00 65000000 SAVE1 LD% L1 ....II 'RELOAD OR RESTORE IR1 CSP188100061 00 4C000000 DONE1 BSC L 'I..* RETURN TO CALLING PROGRAM CSP18820PACK0063 0 0000ERROR DC *.4 RETURN ADDRESS GOES MERE CSP188300064 00 D4000000 ERR STO L *-* STORE ACC IN ERROR PARAM CSP18840PRINT0066 0 1810 SRA 16 CLEAR ACC CSP188500067.01 4C800063BSC I ERROR RETURN TO PRNT1 PROGRAM CSP18800PUNCH0069 0 0000SKIP DC i.i. ADDRESS OF ARGUMENT ADDR CSP18870006A 01 C4800069LD I SKIP GET ARGUMENT ADDRESSCSP18880006C 0 D001STO ARG61 DROP IT ANDCSP18890PUT006D 00 C4000000 ARG LD L *-* GET ARGUMENTCSP18900006F 01 4C300074BSC L NOSUP.-2 GO TO NOSUPPRESSION IF 6 CSP18910P14030071 0 0009 LD NOSPC SET UP SPACE SUPPRESSION CSP18920P1442READR2501SKIPSTACKPAGE 20072 0 DOES STO WRITE CHANGE PRINT FUNCTION C5P18930S14030073 0 7003 MD% DONE GO TO RETURN CSP189400074 0 D001NOSUP STO CNTRL SET UP COMMANDCSP189500073 20 176558F1LIBF PRNT1 CALL THE PRNT ROUTINE CSP18960TY PER0076 0 3000CNTRL DC /3000 CARRIAGE COMMAND WORD CSP189700077 01 74010069 DONE MDX L SKIP01 ADJUST RETURN ADDRESS CSP18980UNPAC0079 01 4C800069BSC I SKIP RETURN TO CALLING PROGRAM CSP189900078 0 2010NOSPC DC /2010 SUPPRESS SPACE COMMAND CSP19000WHOLE007C END END OF PRINT SUBPROGRAM CSP19010NO ERRORS IN ABOVE ASSEMBLY.ADDSUB// DUP CSA19020•STORE WS UA PRINT339D 0005CSP19030-179-


ADDA1A3A1DECA3A1// ASM•• PUT SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID)C5P19040CSP19050• NAME PUT• LIST(ID) CSP19060CSP190700000 17923000 ENT PUT PUT SUBROUTINE ENTRY POINT CSP19080•CALL PUTIJCARDoJ t JLAST IIVARoADJST.N1 CSPI9090•THE REAL NUMBER VAR IS HALF — CSP19100•ADJUSTED WITH ADJST ANDCSP19110•TRUNCATED. THEN DIGITS ARE CSP19120CARRY• CONVERTED FROM REAL TO EBCDIC CSP19130• AND PLACED IN THE JCARD FIELD CSP19140DECA1FROM JCARD(JLASTI TO JCARDIJI. CSP191500000 0 0000:UT DC •• ARGUMENT ADDRESS COMES IN HERE CSP191600001 0 6957STX 1 FIN+1 SAVE IR1CSP19170DIV0004 0 C100LD 1 0 GET JCARD ADDRESSCSP191900002 01 65800000LOX- II PUT PUT ARGUMENT ADDRESS IN IR1 CSP191800005 0 004ESTO JCRD1 SAVE FOR NZONE SUBROUTINECSP19200DPACK 0006 00 95800002S 11 2 SUBTRACT JLAST VALUECSP19210DUNPK0008 0 800E A ONE+1 ADD CONSTANT OF ONE CSPI92200009 0 D03D STO PUT1+1 CREATE JCARDULASTI ADDRESS CSP19230000A 0 C103 LD 1 3 GET VAR ADDRESS CSP19240EDIT 000C 0 800AA ONE+1 ADD CONSTANT OF ONECSP192600008 0 D014STO VAR SAVE FOR PICKUPCSP192500000 0 0041STO SIGN +1 SAVE SIGN POSITION ADDRESS CSP19270FILL000e 0 C104LD 1 4 GET ADJST ADDRESSCSP19280000F 0 0012 STO ADJST AND SAVE CSP19290GET 0010 00 C5800005 LD II 5 GET N VALUE AND CSP193000012 0 D017 STO ADRN2+1 SAVE FOR TRUNCATION CSP193100013 00 C5800002 TWO LD 11 2 GET JLAST VALUE ANDCSP19320ICOMP0015 0 0024STO JLAST SAVE IT AT JLASTCSP193300016 00 95800001 ONE S II 1 SUBTRACT J VALUECSP19340IOND0018 0 BOFEA ONE+1 ADD CONSTANT OF ONECSP193500019 0 4808BSC + CHECK FIELD WIDTHCSP19360KEYBD 001A 0 COFCLD ONE+1 NEGATIVE OR ZERO—MAKE IT ONE CSP193700018 0 D017 STO PUTCT+1 OK-SAVE FIELD WIDTH CSP19380MOVE 001C 0 7106 MDX 1 6 MOVE OVER SIX ARGUMENTS CSP19390001D 0 693D STX 1 DONE1+1 CREATE RETURN ADDRESS CSP19400• DIGS4WHOLE(ABS(VAR)+ADJST)CSP19410MPY001E 30 05042880CALL EABS TAKE THE ABSOLUTE VALUECSP194200020 0 0000VAR DC •.0• OF VARCSP19430NCOMP 0021 20 05044100LIBF EADD ADD TO IT THECSP194400022 0 0000ADJST DC •• HALF—ADJUSTMENT VALUECSP19450NSIGN 0023 30 262164C5CALL WHOLE TRUNCATE ANY FRACTIONCSP19460NZONE0025 0 F040 ZERO DC /F040 CONSTANT OF EBCDIC ZERO CSP19470• IS N GREATER THAN ZEROCSP194800026 0 0003LD ADRN2+1 CHECK TO SEE IF N IS GREATER CSP19490PACK•JNOW41CSP195100027 01 4C080032BSC L PUTCTio+ THAN ZERO-NO—GO TO PUTCT CSP195000029 00 65000000 ADRN2 LDX LI •..• YES —PUT VALUE OF N IN IR1CSP19520PRINT 0028 20 05517A00 AGAIN LIBF EMPY MULTIPLY BYCSP19530PUNCH002C 1 005C DC PNT1 ONE TENTH CSP19340002D 30 262164C5 CALL WHOLE TRUNCATE THE FRACTION CSP19550002F 0 0000 DC 0 DUMMY CSP19560•SEE IF JNOW IS LESS THAN No CSP19570PUT•IF YES, JNOW4JNOW+1 AND GO BACK CSP19580•FOR MORE. IF NO. STARTCSP19590P1403•CONVERTING.CSP19600P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-180-119


ii.PAGE 20030 0 TIFF MDX 1 . 1 DECREMENT N BY ONE CSP196100031 0 70F9 MDX AGAIN NOT DONE-GO BACK FOR MORE C5P19620• JNOWJLAST CSP196300032 00 65000000 PUTCT LDX LI 41• DONE-PUT FIELD WIDTH IN IR1 CSP196400034 20 058A3580 BACK LIBF ESTO STORE FAC CSP196500035 1 0062 DC DIGS IN DIGS C5P19660• DIGT•WHOLEIDIGS/10.01 CSP196700036 20 05517A00 LIBF EMPY MULTIPLY BY CSP196800037 1 005C. DC PNT1 ONE TENTH AND CSP196900038 30 262164C5 CALL WHOLE TRUNCATE ANY FRACTION CSPI9700003A 0 0000 JLAST DCJLAST VALUEC5P19710003B 20 058A3580 LIBF ESTO STORE RESULT IN CSP19720003C 1 0065 DC DIGS1 DIGS1-SAME AS DIGT CSP19730• JCARDIJNOW/•256*IFIXIDIGS C5P19740• .. 10.0*DIGT/4032 CSP19750• MULTIPLY BY 256 IS SAME AS SHIFT CSP19760• EIGHT CSP19770• SUBTRACT 4032 IS SAME AS OR F040 CSP197800030 20 05517A00 LIBF EMPY MULTIPLY DIGT BY CSP19790003E 1 005F DC ETEN TEN ANDCSPI9800003F 20 15599500 LIBF NORM NORMALIZE THE RESULT C5P198100040 20 22559000 LIBF SNR REVERSE THE SIGN CSP198200041 20 05044100 LIBF EADD AND ADD IN THE CSP198300042 1 0062 DC DIGS VALUE OF DIGS C5P198400043 20 091899C0 LIBF IFIX FIX THE RESULT CSP198500044 0 1008 SLA 8 AND PLACE IN BITS 47 CSP198600045 0 EBDF OR ZERO MAKE AN Al CHARACTER CSP198700046 00 D4000000 PUT1 STO L •* AND STORE IN JCARDIJNOW CSP198800048 20 054C4000 LIBF ELD SET FAC EQUAL CSP198900049 1 0065 DC DIGS1 TO DIGS1 CSP19900• SEE IF JNOW IS GREATER THAN J. CSP19910• IF YES, JNOW .JNOW .. 1 AND GO BACK CSP19920* FOR MORE. IF NO, SET ZONE. CSP19930004A 01 74010047 MDX L PUT1♦1.1 CHANGE JCARD ADDRESS CSP19940004C 0 TIFF MDX 1 1 DECREMENT COUNT CSP199500040 0 70E6 MDX BACK NOT DONE-GO BACK FOR MORE CSP19960• IS VAR LESS THAN ZERO CSP19970004E 00 C4000000 SIGN LD L *-* DONE-PICKUP ORIGINAL SIGN CSP199800050 01 4C100058 BSC L FIN.- IF NOT NEG-ALL DONE-GO TO EXIT CSP199900052 30 15A56545 CALL NZONE CALL NZONE FOR ZONE SETTING CSP200000054 0 0000 JCRD1 DC 41■* ADDRESS OF JCARD CSP200100055 1 003A DC JLAST ADDRESS OF JLAST CSP200200056 1 0014 DC TWO+1 ADDRESS OF NEW ZONE INDICATOR CSP200300057 1 0054 DC JCRD1 DUMMY CSP20040* EXIT CSP200500058 00 65000000 FIN LOX LI *41 RESTORE IR1 CSP20060005A 00 4C000000 DONE1 BSC L 4.41 RETURN TO CALLING PROGRAM CSP20070005C 7D 66666666 PNT1 XFLC 0.1 CONSTANT OF ONE TENTH CSP20080005F 84 50000000 ETEN XFLC 10.0 CONSTANT OF TEN POINT ZERO CSP200900062 0003 DIGS BSS 3 TEMPORARY AREA FOR GETTING A DGT CSP201000065 0003 DIGS1 BSS 3 TEMPORARY AREA FOR GETTING A DOT CSP201100068 END CSP20120NO ERRORS IN ABOVE ASSEMBLY.// DUP C5P20130•STORE WS VA PUT33A2 0007CSP20140ADDA1A3A1DECA3A1CARRYDECALDIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-181-i pp,pni unwl 11 11 .,I MI


1111111 1 11111111111111111111111111111// ASMADDA 1A3 * LISTA 1DE CA 3A1 0072 22C74C33•I) PRINT AND SKIP SUBROUTINES FOR <strong>1130</strong> CSC.. 140311D1 C5P20160* NAME P1403 I1D) CSP20170CSP201800041 17C74C33 ENT P1403 SUBROUTINE ENTRY POINT CSP20190* CALL P1403 (JCARD. J. JLAST. NERR3) C5P20200* PRINT JCARDIJI THROUGH JCARD)JLASTI ON CSP20210 THE* 1403 PRINTER. PUT ERROR PARAMETER IN NERR3.CSP20220ENT S1403 SUBROUTINE ENTRY PO/NT CSP20230* CALL 51403(N) CSP20240CARRY * EXECUTE CONTROL FUNCTION SPECIFIED BY INTEGER N CSP202500000 0 0001 ONE DC 1 CONSTANT OF 1 C0P202600001 0 2000 SPACE DC /2000 PRINT FUNCTION WITH SPACE CSP20270DE CA10002 0 0000 JCA1D DC Um* JCARD J ADDRESS CSP202800003 0 0000JLAST DC U..*DIV0004 0030AREA BSS 61JCARD JLAST ADDRESS CSP20290WORD COUNT G. PRINT AREA CSP203000041 0 0000 P1403 DC U..* ADDRESS OF 1ST ARGUMENTCK 0042 0 6926 STX 1 SAVE'S). STORE IR1 CSP203200043 01 45800041 LOX Il P1403 LOAD 1ST ARGUMENT ADDRESS CSP203300045 20 01647880 LIBF ARGS CALL ARGS ROUTINE CSP20340DUNPK0046 1 0002 DC JCARD JCARD J PICKED UP CSP203500047 I 0003DC JLAST JCARD JLAST PICKED UP CSP20360EDIT 00481 0004DC AREA CHARACTER COUNT PICKED UP CSP203700049 0 0078 DC 120 MAX CHARACTER COUNT CSP20380FILL 004A 0 COB9 LD AREA GET CHARACTER COUNT CSP203900048 0 8084 A ONE HALF ADJUST CSP20400GET004C 0 1801 SRA 1 DIVIDE BY TWO CSP20410004D 0 0086 STO AREA STORE WORD COUNT CSP20420004E 0 1001SLA1DOUBLE IT m CHARACTER CSP20430ICOMP 004F 0 000ASTO CNTCOUNT AND STORE COUNT CSP204400050 0 C103LD 1 3GET ERROR WORD ADDRESS CSP20450IOND0051 0 001CSTO ERRSI STORE IT IN ERROR ROUTINE CSP204600052 20 195C1002 LIBF RPACK CALL REVERSE PACK ROUTINE CSP20470KEYBD 0053 1 0002 DC JCARD JCARD J ADDRESS CSP204800054 1 0003 DC JLAST JCARD JLAST ADDRESS CSP204900055 I 0005 DC AREAS" PACK INTO I/0 AREA CSP20500MOVE0056 20 29257006 LISP ZIPCO CALL CONVERSION ROUTINE CSP205100057 0 0000DC /0000 FROM EBCDIC TO 1403 CODESMPY0058 1 0005DC AREA+1I/0 AREA CsP20530CSP205300059 1 0005DC AREA+1 TO I/O AREA CSP20540N COMP 005A 0 0000 CNT DC 4.4 CHARACTER COUNT CSP205500058 30 050978F3 CALL EBPT3 CONVERSION TABLE FOR ZIPCO CSP20560NSIGN0050 20 176558F3 TEST LIBF PRNT3 CALL BUSY TEST ROUTINE CSP20570005E 0 0000 DC /0000 BUSY TEST PARAMETER CSP20580005F 0 70FD MDX TEST REPEAT TEST IF BUSY CSP20590N Z ONE0060 20 176558F3 LIBF PRNT3 CALLPRINT ROUTINE CSP206000061 0 2000WRITE DC /2000 PRINT PARAMETERCSP20610PACK 0062 1 0004DC AREAI/0 AREA BUFFERCSP206200063 1 006C DC ERROR ERROR PARAMETER CSP20630PRINT 0064 0 CO9C LD SPACE LOAD PRINT WITH SPACE CSP206400085 0 DOFB STO WRITE STORE IN PRINT PARAMETER CSP206500066 0 7104 MD% 1 4 INCREMENT OVER 4 ARGUMENTS CSP20660P ITN CH0067 0 6903 STX 1 DONE161 STORE IR1 CSP206700068 00 65000000 SAVE1 LDX L1 *..*RELOAD OR RESTORE 181 CSP20680PUT006A 00 4C000000 DONE1 BSC L *-.*RETURN TO CALLING PROGRAM CSP20690006C 0 0000ERROR DC *m.*RETURN ADDRESS GOES HERE CSP20700P1403 006D 00 04000000 ERR STO L .1*STORE ACC IN ERROR PARAM CSP20710P1442READR2501SKIPSTACKSUBPAGE 2S1403TYPERUNPACWHO LE006F 0 1810 SRA 16 CLEAR ACC CSP207200070 01 4C80006C BSC I ERROR RETURN TO PRNT3 PROGRAM CSP207300072 0 0000 51403 DC *.). ADDRESS OF ARGUMENT ADDR CSP207400073 01 C4800072 LD I $1403 GET ARGUMENT ADDRESS CSP207500075 0 D001 STO ARG61 DROP IT AND CSP207600076 00 C4000000 ARG LD L .11). GET ARGUMENT CSP207700078 01 4C300070 BSC L NOSUP.-2 GO TO NOSUPPRESSION IF E. CSP20780007A 0 0009 LD NOSPC SET UP SPACE SUPPRESSION CSP207900078 0 DOES STO WRITE CHANGE PRINT FUNCTION CSP208000070 0 7003 MDX DONE GO TO RETURN CSP20810007D 0 D001 NOSUP STO CNTRL SET UP COMMAND CSP20820007E 20 176558F3 LIBF PRNT3 CALL THE PRNT3 ROUTINE CSP20830007F 0 3000 CNTRL DC /3000 CARRIAGE COMMAND WORD CSP208400080 01 74010072 DONE MDX L 51403.1 ADJUST RETURN ADDRESS CSP208500082 01 4C800072 BSC I 51403 RETURN TO CALLING PROGRAM CSP208600084 0 2010 NOSPC DC /2010 SUPPRESS SPACE COMMAND CSP208700086 END END OF P1403 SUBPROGRAM CSP20880NO ERRORS IN ABOVE ASSEMBLY.// DUP CSP20890*STORE WS UA P1403CSP2090033A9 0006-182-1111 II


ASMCSP20910•• PUNCH SUBROUTINE FOR <strong>1130</strong> CSP. 1442*5/ID) C5P20920• NAME P1442 11D) CSP20930A1A3• LISTCSP209400053 17C74032 ENT P1442 SUBROUTINE ENTRY POINT CSP20950A1DEC• CALL P1442 (JCARD. J. JLAST. NERR2)CSP20960• PUNCH JCARD1J) THROUGH JCARD1JLAST) INTO THE CSP20970• BEGINNING OF A CARD. PUT ERROR PARAMETER INTO CSP20980A3A1• NERR2.CSP209900000 0 0000JCARD DC •*• JCARD J ADDRESSCSP21000CARRY0001 0051 ARES BSS 81 I/0 AREA BUFFER C5P210100052 0 0000 FLAG DC •*• ERROR INDICATOR CSP21020DECA10053 0 0000 P1442 DC •-• FIRST ARGUMENT ADDRESS CSP210300054 0 6922ST% 1 SAVE161 SAVE IR1CSP210400055 01 65800053LOX 11 P1442 LOAD 1ST ARGUMENT ADDRESS CSP21050DIV0057 20 01647880LIBF ARGS CALL ARGS SUBPROGRAMCSP210600058 1 0000DC JCARD GET JCARDIJ1 ADDRESSCSP21070DPACK0059 1 0067DC JLAS2 GET JCARD1JLAST) ADDRESS CSP21080005A 1 0001DC AREA GET CHARACTER COUNTCSP21090DUNPK005B 0 0050 DC 80 MAX CHARACTER COUNT CSP21100005C 0 COA4LD AREA DISTRIBUTE COUNTCSP21110005D 0 0005STO CNT2 INTO CNT2CSP21120EDITCSP2<strong>1130</strong>FILL005E 0005F 0C103001CLD 1 3 GET ERROR WORD ADDRESSSTO ERR+1 STORE INSIDE ERROR ROUTINE CSP211400060 0 1810SRA 16 CLEAR ACCCSP211500061 0 DOFOSTO FLAG CLEAR ERROR INDICATOR CSP21160GET0063 1 0000 DC JCARD FROM JCARD JICOMP0064 1 0067 DC JLAS2 TO JCARD JLAST CSP211900065 20 225C5144LIBF SPEED CALL CONVERSION ROUTINE CSP212000066 0 0011DC /0011 FROM EBCDIC TO CARD CODE CSP21210IOND0062 20 22989547 LIBF SWING CALL REVERSE ARRAY CSP21170CSP211800067 0 0000JLAS2 DC •..• FROM JCARD JLASTCSP212200068 1 0002DC AREAS]. TO THE I/O AREA BUFFER CSP2I230KEYBD0069 0 0000 CNT2 DC •.• CHARACTER COUNT CSP21240006A 20 17543231 LIBF PNCH1 CALL PUNCH ROUTINE CSP21250MOVE0068 0 2000 DC /2000 PUNCH CSP21260006C 1 0001DC AREA I/O AREA BUFFERCSP21270006D 1 007ADC ERROR ERROR PARAMETERCSP21280MPY006E 20 22989547LISP SWING REVERSE THE ARRAYCSP21290006F 1 0000DC JCARD FROM JCARD1J)CSP21300NCOMP0070 1 0067DC JLAS2 TOJCARD1JLAST)CSP213100071 20 17543231 TEST LIBF PNCH1 CALL BUSY TEST ROUTINE CSP21320NSIGN0072 0 0000 DC /0000 BUSY TEST PARAMETER CSP213300073 0 70F0MD% TEST REPEAT IF BUSYCSP2I340NZONE0074 0 7104MDX 1 4 INCREMENT 4 ARGUMENTS CSP213506903STX 1 DONE+1 STORE IR1CSP21360PACK0075 00076 00 65000000 SAVE1 LOX LI •*• RESTORE IR1CSP213700078 00007A 04C0000000000DONEERROR DC •*• START OF ERROR ROUTINE CSP21390BSC L •*• RETURN TO CALLING PROGRAM CSP21380PRINT007B 00 D4000000 ERR STO L •*• STORE ACC IN ERROR WORD CSP21400007D 01 74010052 MDX L FLAG.1 SET THE FLAG INDICATOR CSP21410007F 01 4C80007A BSC I ERROR RETURN TO INTERRUPT PROGRM CSP21420PUNCH0082 END END OF P1442 SUBPROGRAM CSP21430// OUPNO ERRORS IN ABOVE ASSEMBLY.•STORE WS UA P144233AF 0004CSP21440CSP21450ADDPUTP1403P144gREADR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE-183-


ADDA1A3A1DECA3A1/I APICSP21460•• READ AND PUNCH SUBROUTINES FOR <strong>1130</strong> CSP(ID) CSP21470* NAME READ11D1 CSP21480• LISTCSP214900053 19141100 ENT READ SUBROUTINE ENTRY POINT C5P21500• CALL READ (JCARD. J. JLAST. NERR1)CSP21510• READ COLUMNS FROM BEGINNING OF CARD INTO JCARD1J) CSP21520• THROUGH JCARDWLAST). PUT ERROR PARAMETER IN CSP21530• NERR1.CSP21940008C 17915008CARRYENT PUNCH SUBROUTINE ENTRY POINT CSP21550* CALL PUNCH (JCARD. J. JLAST. NERR2)CSP21560• PUNCH JCARD1J1 THROUGH JCARDULAST/ INTO THEDECA1CSP21570• BEGINNING OF A CARD. PUT ERROR PARAMETER INTO CSP21580* NERR2.CSP21590DIV 0000 0 0000JCARD DC JCARD J ADDRESSCSP216000001 0051AREA 855 al I/O AREA BUFFERCSP21610DPACK0052 0 0000FLAG DC ERROR INDICATORCSP216200053 0 0000 READ DC FIRST ARGUMENT ADDRESS CSP216300054 0 6918ST% 1 SAVE161 SAVE IR1DUNPK CSP216400055 01 65800053LOX 11 READ GET 15T ARGUMENT ADDRESS CSP216500057 0 4022BSI SETUP GO TO SETUPCSP21660EDIT0058 20 03059131LIBF CARD1 CALL CARD READ ROUTINE CSP216700059 0 1000DC /1000 READCSP21680FILL005A 1 0001DC AREA AREA PARAMETERCSP216900058 1 0073 DC ERROR ERROR PARAMETER CSP21700005C 20 225C5144 CONVT LIBF SPEEDGET CALL CONVERSION ROUTINE CSP217100050 0 0010DC /0010 CARD CODE TO EBCDICCSP21720005E 1 0002DC AREA61 FROM AREACSP21730ICOMP 005F 0 0000JLAS1 DC itmi* TO JCARD JLASTCSP217400060 0 0000CNT1 DC CHARACTER COUNTCSP21750IOND0061 0 COFOLO FLAG ERROR INDICATORCSP217600062 01 4C180067BSC L FINALia, ALL DONE IF ZEROCSP21770KEYBD0064 0 1810-SRA 16 CLEAR ACCCSP217800065 0 DOEC STO FLAG CLEAR THE INDICATOR CSP217900066 0 70F5MDX CONVTMOVECONVERT AGAINCSP218000067 20 22989547 FINAL LIBF SWING REVERSE THE ARRAYCSP218100068 1 0000DC JCARD FROM JCARD JCSP21820MPY0069 1 005FDC JLAS1 TO JCARD JLASTCSP21830006A 20 03059131 TEST , LIBF CARD1 CALL BUSY TEST ROUTINE CSP21840NCOMP 0068 0 0000DC /0000 BUSY TEST PARAMETERCSP21850006C 0 70F0 MDX TEST REPEAT IF BUSY CSP21860006D 0 7104NSIGNMD% 1 4 INCREMENT 4 ARGUMENTS CSP21870006E 0 6903ST% 1 =Nal STORE IR1CSP21880006F 00 65000000 SAVE1 LD% LI •• RESTORE IR1CSP21890NZONE 0071 00 4C000000 DONE -BSC L RETURN TO CALLING PROGRAM CSP219000073 0 0000ERROR DC START OF ERROR ROUTINE CSP21910PACK 0074 00 04000000 ERR STO L STORE ACC IN ERROR WORD CSP219200076 01 74010052MDX L FLAG.1 SET THE FLAG INDICATOR CSP21930PRINT0078 01 4C800073BSC I ERROR RETURN TO INTERRUPT PROGRM CSP21940007A 0 0000' SETUP DC . START OF SETUP ROUTINE CSP21950007B 20 01647880LIBF ARGS CALL ARGS SUBPROGRAMCSP21960PUNCH 007C 1 0000DC .JCARD GET JCARD J ADDRESSCSP21970007D 1 005FDC JLAS1 GET JCARD JLAST ADDRESS CSP21980PUT007E 1 0001DC AREA GET CHARACTER COUNTC5P21990007F 0 0050DC 80 MAX CHARACTER COUNTCSP22000P14030080 0 CODELD JLAS1 DISTRIBUTE JCARD JLAST CSP220100081 0 D014 6TO JLAS2 INTO JLAS2 CSP22020P1442READR2501SKIPSTACKSUBS1403PAGE 2TYPER0082 01 C4000001 LD L AREA DISTRIBUTE COUNT CSP220300084 00085 0DOD8D012STO CNT1 INTO CNT1STO CNT2 AND CNT2CSP22040CSP22050UNPAC 0087 0 DOEDSTO ERR61 STORE INSIDE ERROR ROUTINE CSP220700086 0 C103LD 1 3 GET ERROR WORD ADDRESS CSP220600088 0 1810SRA 16 CLEAR ACCCSP22080WHOLE 0089 0 DOCKSTO FLAG CLEAR ERROR INDICATOR CSP22090008A 01 4C80007A BSC I SETUP RETURN TO CALLING PROG CSP22100008C 0 0000 PUNCH DC PUNCH ROUTINE STARTS HERE CSP22110008D 0 69E2 ST% 1 SAVE161 SAVE IR1 CSP22120008E 01 6580008C LOX 11 PUNCH LOAD 1ST ARGUMENT ADDRESS CSP221300090 0 40E9 BSI SETUP GO TO SETUP ROUTINE CSP221400091 20 22989547 LIBF SWING CALL REVERSE ARRAY CSP221500092 1 0000 DC JCARD FROM JCARD J CSP221600093 1 005F DC JLAS1 TO JCARD JLAST CSP221700094 20 225C5144 LIBF SPEED CALL CONVERSION ROUTINE CSP221800095 0 0011 DC /0011 FROM EBCDIC TO CARD CODE CSP221900096 0 0000 JLAS2 DC FROM JCARD JLAST CSP222000097 1 0002 DC AREAS]. TO THE I/O AREA BUFFER CSP222100098 0 0000 CNT2 DC CHARACTER COUNT CSP222200099 20 03059131 LIBF CARD1 CALL PUNCH ROUTINE CSP22230009A 0 2000 DC /2000 PUNCH CSP222400098 1 0001 DC AREA I/0 AREA BUFFER CSP22250009C 1 0073 DC ERROR ERROR PARAMETER CSP22260009D 0 70C9 MDX FINAL ALL THROUGH. GO TO FINAL CSP22270009E END END OF READ SUBPROGRAM CSP22280NO ERRORS IN ABOVE ASSEMBLY.// OUP CSP22290•STORE WS UA READ3383 0006CSP22300-184-


ASM0• READ SUBROUTINE FOR <strong>1130</strong> CSP, 2501 1101CSP22310CSP22320• NAME R2501(ID) CSP22330• LISTCSP22340A 1A3CSP22350• CALL R25014JCARD. J. JLAST. NERR11CSP22360A 1DEC• READ COLUMNS FROM BEGINNING OF CARD INTO JCARDIJ/ CSP22370• THROUGH JCARDULAST1. PUT ERROR PARAMETER IN CSP22380A3A 1• NERRleCSP223900053 19CB5C31 ENT 82501 SUBROUTINE ENTRY POINT0001 0051ADDRESSAREA BSS 81 I/0 AREA BUFFERCSP22400CSP224100000 0 0000JCARD DC •..• JCARD JCARRY0052 0 0000FLAG DC 0—• ERROR INDICATORC5P224200053 0 0000R2501 DC 0-0 FIRST ARGUMENT ADDRESS CSP22430 DE CA 111 R2501 GET 1ST ARGUMENT ADDRESS CSP22450 DIV0097 20 01647880 LIBF ARGS CALL ARGS SUBPROGRAM CSP224600058 1 0000DC JCARD GET JCARD J ADDRESSCSP22470DPACK0059 1 0072DC JLAS1 GET JCARD JLAST ADDRESS CSP224800054 0 692C0095 01 65800053STX 1 SAVE1151 SAVE IR1LDXCSP224400056 0 0050DC 80 MAX CHARACTER COUNTCSP22500005A 1 0001DC AREA GET CHARACTER COUNT .CSP22490DUNPK009C 0 COA4LD AREA DISTRIBUTE COUNTCSP22510005D 0 0015STO CNT1 INTO CNT1CSP22520EDIT005E 0 C103 LD 1 3 GET ERROR WORD ADDRESS CSP22530005F 0 D026STO ERRS]. STORE INSIDE ERROR ROUTINE CSP225400060 0 1810SRA 16 CLEAR ACCCSP22550FILL0061 0 DOFO0062 0 7104STO FLAG CLEAR ERROR INDICATORMO% 1 4 INCREMENT 4 ARGUMENTSCSP22560CSP22570GET0063 0 691FSTX 1 DONEE./ STORE IR1CSP225800064 0 CO26LD ONE SET AREA TO ALL ONESCSP22590ICOMP0067 01 D5000001 MO STO Ll AREA STORE A ONE IN AREA CSP22610 IOND0069 0 71FF MD% 1 — 1 GO TO NEXT WORD OF AREA CSP22620006A 0 70FCMDX MO GO BACK UNTIL FINISHEDCSP22630ROUTINEKEYBD0068 20 19141131LIBF READ1 CALL CARD READ CSP226400065 00 65000050 LOX LI 80 LOAD IR1 WITH AREA SIZE CSP22600006C 0 1000DC /1000 READCSP22650006D 1 0001DC AREA AREA PARAMETERCSP22660MOVE006E 1 0084DC ERROR ERROR PARAMETERCSP22670006F 20 225C5144 CONVT LIBF SPEED CALL CONVERSION ROUTINE CSP22680MPY0070 0 00100071 1 00020072 0 0000DC /0010 CARD CODE TO EBCDICDC AREA&1 FROM AREAJLAS1 DC 0-0 TO JCARD JLASTCSP22690CSP22700CSP22710NCOMP0073 0 0000CNT1 DC •—• CHARACTER COUNTCSP227200074 0 CORDLD FLAG ERROR INDICATORCSP22730NSIGN0075 01 4C18007ABSC L FINAL 14 .. ALL DONE IF ZEROCSP227400077 0 1810SRA 16 CLEAR ACCCSP22790N ZONE0079 0 70F5 MDX CONVT CONVERT AGAIN CSP22770 PACK007A 20 22989547 FINAL LIBF SWING REVERSE THE ARRAY CSP22780DC JCARD FROM JCARD JPRINT00713 1 0000007C 1 0072DC JLAS1 TO JCARD JLASTCSP22790CSP228000078 0 0009 STO FLAG CLEAR THE INDICATOR CSP22760007D 20 19141131007E 0 0000TEST LIBF READ1 CALL BUSY TEST ROUTINEDC /0000 BUSY TEST PARAMETERCSP22810CSP22820PUNCH007F 0 70FDMDX TEST REPEAT IF BUSYCSP228300080 00 65000000 SAVE1 LOX LI •..• RESTORE IR1CSP22840PUT0082 00 4C000000 DONE BSC L • .-0 RETURN TO CALLING PROGRAM CSP228500084 0 0000 ERROR DC 0-0 START OF ERROR ROUTINE CSP22860 P14030085 00 04000000 ERR STO L •• STORE ACC IN ERROR WORD CSP22870P1442REA DR2501SKIPSTACK0087 01 740100520089 01 4C800084008B 0 0001008CNO ERRORS IN ABOVE ASSEMBLY.PAGE 2MDX L FLAG.1 SET THE FLAG INDICATOR CSP22880BSC I ERROR RETURN TO INTERRUPT PROGRM CSP22890ONE DC 1 CONSTANT OF ONECSP22900END END OF R2501 SUBPROGRAM CSP22910ADDSUBS1403TYPERUNPACWHO LE// DUP CSP22920•STORE WS UA R2501CSP229303389 0005/.1 ASM•0 STACKER SELECT SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE(IDICSP22940CSP22950• NAME STACKIID1 CSP22960• LISTCSP229700002 228C1002 ENT STACK STACK SUBROUTINE POINT CSP22980• CALL STACK CSP22990• SELECTS THE NEXT CARD THROUGH CSP23000• THE PUNCH STATION TO THE CSP23010• ALTERNATE STACKER ON THE 1442 ..5. CSP23020• 6.0R 7. CSP230300000 0 0000 IOCC DC 0 I/O COMMAND FIRST WORD CSP230400001 0 1480 DC /1480 I/0 COMMAND .. SECOND WORD CSP230500002 0 0000 STACK DC •-.• .RETURN ADDRESS COMES IN HERE CSP230600003 0 08FC X10 IOCC SELECT STACKER CSP230700004 01 4C800002 BSC I STACK RETURN TO CALLING PROG CSP230800006 END CSP23090NO ERRORS IN ABOVE ASSEMBLY.-185-01.1.1,41.1.11111..nliwiii1111111.11mIliiiniiill1111111411111mHull 11


ADDA 1A3A 1DECA 3A /CARRYDE CA1DIVDPA CKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNN Z ONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHO LE// DUP•STORE WS UA STACK33BE 0002// ASM•• TYPE AND KEYBD SUBROUTINES FOR <strong>1130</strong> CSP• NAME TYPER• LIST003F 23A17159ENT TYPER SUBROUTINE ENTRY POINT• CALL TYPE IJCARD. J. JLASTI• TYPE JCARDIJ1 THROUGH JCARDIJLAST)IID)IID/0069 12168084 ENT KEYBD SUBROUTINE ENTRY POINT• CALL KEYBD IJCARD. J. JLAST)• ENTER AT KEYBOARD JCARDIJ) THROUGH JCARDIJLAST10000 0 0001 ONE DC 1 CONSTANT OF 10001 0 0000 JCARD DC •..• JCARD J ADDRESS0002 0030 AREA 855 61 I/O AREA BUFFER003F 0 0000TYPER DCFIRST ARGUMENT ADDR HERE0040 0 691A STX 1 SAVE161 SAVE IR10041 0 6178 LDX 1 120PUT 120 IN IR10042 0 6923 STX 1 MARCH STORE IT AS MAX CHARS0043 01 6580003F LDX 11 TYPER PUT FIRST ADDR IN IR10045 0 4018 BSI SETUP GO TO SETUP0046 0 COBB LD AREAGET CHARACTER COUNT0047 0 8088 A ONEHALF ADJUST IT AND0048 0 1801 SRA 1DIVIDE IT BY TWO0049 0 0088 STO AREA AND REPLACE IT004A 0 1001SLA 1DOUBLE IT0048 0 0008 STO CNT1AND PUT IT IN CNT1004C 20 195C1002LIBF RPACK CALL REVERSE PACK ROUTINE004D 1 0001DC JCARD FROM JCARD J004E 1 0083DC JLAST TO JCARD JLAST004F 1 0003DC AREAS]. PACK INTO I/O AREA0050 20 05097663 LIBF EBPRT CALL CONVERSION ROUTINE0051 0 0000 DC /0000 FROM EBCDIC0052 1 0003 DC AREA61 TO PRINTER CODE.0053 1 0003 DC AREA61 ALL IN THE I/O AREA0054 0 0000 CNT1 DCHALF ADJSTD CHARACTER CNT0055 20 23A17170 LIBF TYPEO CALL TYPE ROUTINE0056 0 2000 DC /2000 TYPE PARAMETER0057 1 0002 DC AREAI/O AREA BUFFERFINAL MD% 1 30039 0 6903 STX 1 DORM STORE IR1005A 00 65000000 SAVE1 LDX LlRESTORE IR1005C 00 4C000000 DONE BSC LRETURN TO CALLING PROGRAM005E 0 0000SETUP DC •-•START OF SETUP ROUTINE005F 20 23A17170CALL BUSY TEST ROUTINE0060 0 0000 DC /0000 BUSY TEST PARAMETER0061 0 70FD MDX TESTREPEAT TEST IF BUSY0062 20 01647880 LIBF ARGSCALL ARGS ROUTINE0063 1 0001 DC JCARD 1ST ARGUMENT TO JCARD J0064 1 0083 DC JLAST TO JCARD JLAST0065 1 0002 DC AREATO CHARACTER COUNT0066 0 0000 MAXCH DCMAXIMUM NUMBER OF CHARS0067 01 4C80005E BSC I SETUP END OF SETUP. RETURN0069 0 0000 KEYBD DCSTART OF KEYBOARD ROUTINE006A 0 69F0STX 1 SAVE161 SAVE IR100613 0 613C LDX 1 60PUT BUFFER LENGTH IN IR1006C 0 69F9STX 1 MARCH 60 IS MAX NO OF CHARS006D 01 65800069LD% 11 KEYBD 1ST ARGUMENT ADDR IN IR1006F 0 40EEBSI SETUP GO TO SETUP0058 0 7103 INCREMENT OVER 3 ARGUMENTSTEST LIBF TYPEOCSP23100CSP23110CSP23120CSP23130CSP23140CSP23150CSP23160CSP23170CSP23180CSP23190CSP23200CSP23210CSP23220CSP23230CSP23240CSP23250CSP23260CSP23270CSP23280CSP23290CSP23300C5P23310CSP23320CSP23330CSP23340CSP23350CSP23360CSP23370CSP23380CSP23390CSP23400CSP23410CSP23420CSP23430CSP23440CSP23450CSP23460CSP23470CSP23480CSP23490CSP23500CSP23510CSP23520CSP23530CSP23540CSP23550CSP23560CSP23570CSP23580CSP23590CSP23600CSP23610CSP23620CSP23630CSP23640CSP23650CSP23660CSP23670CSP23680PAGE 20070 0 613C LOX 1 600071 0 1810 SRA 160072 01 05000002 CLEAR STO Ll AREA0074 0 71FF MDX 1 -10075 0 70FC MDX CLEAR0076 01 65000069 LDX 11 KEYBD0078 0 C089 LD AREA0079 0 DOOA STO CNT2007A 20 23A17170 LIEF TYPEO0075 0 1000 DC /1000007C 1 0002 DC AREA007D 20 23A17170 TEST1 LIBF TYPEO007E 0 0000 DC /0000007F 0 70FD MD% TEST10080 20 225C5144 LIBF SPEED0081 0 0010 DC /00100082 1 0003 DC AREA610083 0 0000 JLAST DC ••0084 0 0000 CNT2 DC •. 1.0085 20 22989547 LIBF SWING0086 1 0001 DC JCARD0087 1 0083 DC JLAST0088 0 70CF MDX FINAL008AENDNO ERRORS IN ABOVE ASSEMBLY.PUT BUFFER LENGTH IN IR1CLEAR THE ACCCLEAR THE I/O BUFFERDECREMENT IR1AND CONTINUE CLEARING1ST ARGUMENT ADDR IN IR1PUT CHARACTER COUNTIN CNT2CALL KEYBOARD ROUTINEKEYBOARD PARAMETERI/O AREA BUFFERCALL BUSY TEST ROUTINEBUSY TEST PARAMETERREPEAT TEST IF BUSYCALL CONVERSION ROUTINECARD CODE TO EBCDICFROM THE I/0 AREA BUFFERTO JCARD JLASTCHARACTER COUNTCALL REVERSE ARRAYREVERSE FROM JCARD JTO JCARD JLASTALL THROUGH, GO TO FINALEND OF TYPE SUBPROGRAMCSP23690CSP23700CSP23710CSP23720CSP23730CSP23740CSP23750CSP23760CSP23770CSP23780CSP23790CSP23800CSP23810CSP23820CSP23830CSP23840C5P23850CSP23860CSP23870CSP23880CSP23890CSP23900CSP23910CSP23920-186-


DUP'STORE WS UA33C0 0006TYPERCSP23930CSP23940ADDA 1A3A 1 DE CA3A 1CARRYDECALDIVDPACKDUNPKEDITFILLCSP23950// ASM** PACK/UNPAC SUBROUTINES FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID) CSP23960CSP23970• LIST• NAME UNPAC(ID) C5P239800000 24557043ENT UNPAC UNPACK SUBROUTINE ENTRY POINT CSP23990* CALL UNPACIJCARD.J.JLAST.KCARDA1 C5P24000• THE WORDS JCARD J THROUGHCSP240100006 17043480• JCARD JLAST IN A2 FORMAT AREC5P24020• UNPACKED INTO KCARD K IN Al FORMAT. C5P24030 GETENT PACK PACK SUBROUTINE ENTRY POINT CSP24040• CALL PACKIJCARD.J.JLAST.KCARDIIK/ CSP24050CSP24060ICOMP• THE WORDS JCARD J THROUGH• JCARD JLAST IN Al FORMAT ARE PACKED CSP24070• INTO KCARD K IN Al FORMAT.C5P24080ION D0000 00000001 0003LD 5W2 LOAD NOP INSTRUCTIONKEYBD0002 001E STO SWTCH STORE NOP AT SWITCH CSP241100003 7007MDX START COMPUTINGCSP24120MOVE0004 7009SW1 MD% X ELSE-SWTCH-1 BRANCH TO ELSECSP24130CSP24140MPY0005000670000000SW2 MDX X 0 NOP INSTRUCTIONPACK DC 1..* ARGUMENT ADDRESS COMES IN HERE C5P24150UNPAC DC .**. ARGUMENT ADDRESS COMES IN HERE CSP24090CSP241000007 COFELD PACK PICK UP ARGUMENT ADDRESSCSP241600008 DOF7STO UNPAC AND STORE IT IN UNPACCSP24170NCOMP000A D016STO SWTCH STORE BRANCH AT SWITCHCSP24190NSIGN0008 6930START STX 1 SAVE161 SAVE IR1CSP2420011 UNPAC PUT ARGUMENT ADDRESS IN IR1 CSP24210N ZONE000C000E1 65800000C100LDXLD 1 0 GET JCARD ADDRESSCSP242200009 COFA LD SW1 LOAD BRANCH TO ELSE C5P24180GOOF 8001A ONE+1 ADD CONSTANT OF 1C5P242300010 0 95800001 ONE S 11 1 SUBTRACT J VALUECSP24240PACK0013 C103LD 1 3 GET KCARD ADDRESSCSP24260PRINT0014 BOFC A• ONE+1 ADD CONSTANT OF 1 CSP242700 11 4 SUBTRACT K VALUECSP24280PUNCH0015001795800004D006SSTO KCARD+1 CREATE KCARD(K) ADDRESSCSP242900012 DOODSTO. JCARD+1 CREATE JCARDIJ) ADDRESSCSP242500018 C100LD 1 0 GET JCARD ADDRESSCSP243000019 80F7A ONE+1 ADD CONSTANT OF 1CSP24310PUT0001C DOE9STO PACK CREATE JCARD JLAST ADDRESS CSP24330P1403001D 0 65000000 KCARD LOX LI .1.* PUT KCARD ADDRESS IN IR1 CSP243400 JCARD LD L "I..* P1CK UP JCARDIJ/CSP24350P1442001F0021C40000007000SWTCH MDX X 0 SWITCH BETWEEN PACK AND UNPACK CSP24360001A 958000025 11 2 SUBTRACT JLAST VALUEC5P243200022002318881008SLA 8 REPOSITION HIGH ORDER BITSCSP24380SRT 8 SHIFT LOW ORDER BITS TO EXTC5P24370READ00240025E81AD100STO 1 0 PUT IN KCARD KCSP24400OR BMASK PUT BLANK IN LOW ORDER BITS CSP24390R25010027002810881008SLT B MOVE THE EXTEN INTO THE ACCUMSLA 8 IN TWO STEPS CSP244300026 71FF MDX 1 -1 DECREMENT KCARD ADDRESS CSP24410CSP24420SKIP002A 7006MDX FINIS BRANCH AROUND PACK ROUTINE CSP244500029 E815OR BMASK PUT BLANK IN LOW ORDER BITS C5P24440STACK0020 1898ELSE SRT 24 SHIFT HIGH ORDER BITS INTO EXT C5P24460002C 1 74FF0020MDX L JCARD+1.1 DECREMENT JCARD ADDRESS CSP24470SUB002E 1 C4800020 LD I JCARD+1 PICK UP JCARDIJ+1) CSP244800030 18C8 RTE B SHIFT IN BITS FROM EXT CSP24490S14030031 D100 FINIS STO 1 0 PUT IN KCARD K CSP245000032 1 74FF0020 MDX L JCARD+1.1 DECREMENT JCARD ADDRESS C5P24510TYPERUNPACWHOLEPAGE 20034 0 71FF MDX 1 -1 DECREMENT KCARD ADDRESS C5P245200035 0 COEA LD JCARD+1 GET JCARDW) ADDRESS CSP245300036 0 90CF S PACK SUBTRACT JCARD JLAST ADDRESS CSP245400037 01 4C10001F BSC L JCARD., CONTINUE IF DIFFERENCE E. OR C5P245500039 01 74050000 MDX L UNPAC.5 CREATE RETURN ADDRESS CSP245600038 00 65000000 SAVE1 LDX LI 41-.1 RESTORE IR1 CSP245700030 01 4C800000 BSC I UNPAC RETURN TO CALLING PROGRAM CSP24580003F 0 0040 BMASK DC /40 MASK 0000000001000000 C5P245900040 END C5P24600NO ERRORS IN ABOVE ASSEMBLY.// DUP C5P24610*STORE WS UA UNPACC5P246203306 0005-187-


ADDAlA3A1DECA3A1CARRYDECA1DIVDPACKDUNPKEDITFILLGETICOMPIONDKEYBDMOVEMPYNCOMPNSIGNNZONEPACKPRINTPUNCHPUTP1403P1442READR2501SKIPSTACKSUBS1403TYPERUNPACWHOLE// ASM CSP24630•• WHOLE NUMBER SUBROUTINE FOR <strong>1130</strong> COMMERCIAL SUBROUTINE PACKAGE (ID) CSP24640• NAME WHOLE - (IDI CSP24650• LIST CSP246600006 262164C5 ENT WHOLE SUBROUTINE ENTRY POINT CSP24670• X • WHOLEIMI WITH Y IN FAC TO START CSP24680• X IN FAC BECOMES THE INTEGRAL PART OF Y. CSP246900000 0 0000 DBL1 DC 0 DBL CONSTANT OF 1 CSP247000001 0 0001 DC 1 REST OF DBL1 CONSTANT CSP24710001F MANT EOU 31 MANTISSA LENGTH CSP247200002 0 009F. C159 DC 128+MANT EXPONENT OF FULL INTEGER CSP247300003 0 001F C31 DC MANT MANTISSA LENGTH CSP247400004 0 189F SRT SRT MANT SRI MANTISSA LENGTH CSP247500005 0 0800 H0800 DC /0800 DIFF BETWEEN SRT AND SLT CSP247600006 0 0000 WHOLE DC •• ARGUMENT ADDRESS HERE CSP247700007 0 COFA LD C159 EXP OF FULL INTEGER CSP247800008 0 937D S 3 125 SUBTRACT EXP OF Y CSP247900009 01 4C28001A BSC L DONE t +2 BRANCH IF ALL INTEGER CSP248000008 0 90F7' S Cal SUBTRACT MANTISSA LENGTH C5P24810000C 01 4C10001E BSC L FRACT. –BRANCH IF ALL FRACTIONAL C5P24820000E 0 80F5 A SRI CREATE RIGHT SHIFT CSP24830000F 0 D009 STO RIGHT STORE RIGHT SHIFT CSP248400010 0 90F4 S H0800 CREATE LEFT SHIFT CSP248500011 0 0006 STO LEFT STORE LEFT SHIFT CSP248600012 0 CB7E LOD 3 126 PICK UP MANTISSA CSP248700013 0 4828 BSC +2 CHECK FOR NEGATIVE MANTISA CSP248800014 0 98E8 SD DBL1 SUBTRACT 1 IF NEGATIVE CSP248900015 0 1880 RIGHT SRT •m• RIGHT SHIFT CSP249000016 0 4828 BSC +Z CHECK FOR NEGATIVE MANTISA CSP249100017 0 88E8 AD DBL1 ADD 1 IF NEGATIVE CSP249200018 0 1080 LEFT SLT •■• LEFT SHIFT CSP249300019 0 EWE STORE STD 3 126 STORE MANTISSA CSP24940001A 01 74010006 DONE MD% L WHOLE.' CREATE RETURN ADDRESS CSP24950001C 01 4C800006 BSC I WHOLE RETURN TO CALLING PROGRAM CSP24960001E 0 10E0 FRACT SLC 32 ZERO ACC AND EXT CSP24970001F 0 0370 STO 3 125 ZERO THE EXPONENT CSP249800020 0 70F8 MDX STORE ZERO THE MANTISSA CSP249900022 END END OF WHOLE SUBROUTINE CSP2S000// DUPNO ERRORS IN ABOVE ASSEMBLY.•STORE WS UA WHOLE33C8 0003CSP25010CSP25020-188-


3// ASM•• ARGS. RPACK AND SWING SUBROUTINES FOR <strong>1130</strong> CSP (ID)CSP25030C5P25040• NAME ARGS• LISTCSP25050(ID) CSP25060A1A3• THESE SUBROUTINES CANNOT BE CALLED FROM FORTRAN CSP25080LIBR LISP TYPE ROUTINES FOLLOW C5P25070A1DEC0030 195C1002GETS THE ARGUMENT FOR THE I/0 ROUTINESENT RPACK SUBROUTINE ENTRY POINT0002 01647880 ENT ARGS SUBROUTINE ENTRY POINT CSP25090• ARGS CSP25100CSP25110A3A1004F 22989547ENT SWING SUBROUTINE ENTRY POINT• RPACK REVERSES AND PACKS EBCDIC STRINGSCSP25120CSP25130CARRY• SWING REVERSES AN EBCDIC STRINGCSP251400000 0 0001ONE DC 1 CONSTANT OF ONECSP25150DECA10002 0 6A2A ARGS STX 2 SAVE261 ARGS ROUTINE STARTS HERE CSP25170DIV0003 00 66800000 LOX 12 0 GET 1ST ARGUMENT ADDR CSP25180GET JCARD ADDRCSP25190DPACK0005 0 C1000006 00 95800002LD 1 0S Il 2 SUBTRACT JLAST VALUECSP252000001 0 0000 JLAST DC •..• JCARDIJLAST) ADDRESS C5P251600008 0 80F7A ONE ADD ONECSP252100009 00 D6800001STO 12 1 STORE IN 2ND ARGCSP25220DUNPK000C 00 95800001 S 11 1 SUBTRACT J VALUE CSP25240 EDIT000E 0 80F1 A ONE ADD ONE CSP25250STO 12 0 STORE IN 1ST ARGCSP25260FILL000F 00 D68000000011 00 96800001S 12 1 SUBTRACT JLAST ADDRCSP252700008 0 C100 LO 1 0 GET JCARD ADDR CSP252300013 00014 01 4C0800113BSC L ERORI++ CHECK FOR NEG OR 0 CHARS CSP2529080ECA ONE ADD ONECSP25280GET0016 0 92030017 01 4C3000212 3BSC L ERROR.-2 CHECK MORE THAN MAX CHARS CSP25310S OK. SUBTRACT MAX CHARS CSP25300ICOMP001A 0 70000018 00 C6800000 ER091 LD 12 0 PICK UP JCARDIJ] CSP253400019 0 8203 A 2 3 ADD MAX CHARS BACK CSP25320MDX OK ADDRESSES OK CSP25330IOND001F 0 COEDLD ONE SET UP CHAR COUNT OF 1 CSP25360001D 00 06800001STO 12 1 AND STORE IN JCARD1JLAST) CSP25350KEYBD0020 0 7007MDX OK GO TO STORE CHAR COUNT CSP253700021 00 C6800000 ERROR LD 12 0 PICK UP JCARDIJ)CSP25380MOVE0024 0 BODE ONE MPY0025 00 D6800001 STO 12 1 STORE ADDR IN JCARDIJLAST1 CSP254100027 0 C203LD 2 3 LOAD CHARACTER COUNTCSP254200028 00 D6800002 OK STO 12 2 STORE CHARACTER COUNT CSP25430NCOMP0023 0 9203 S 2 3 AND CALCULATE JCAROWLAST)A TO BE JCARD1J+MAX-1)CSP25390CSP25400002A 0 7204MDX 2 4 CREATE RETURN ADDRCSP25440002B 0 6A03LAST STX 2 DONE61 STORE RETURN ADDRESSCSP25450NSIGNBSC L NZONE0030 0 6AFC RPACK STX 2 SAVE261 RPACK ROUTINE STARTS HERE CSP254800031 00 66800000LDX 12 0 GET 1ST ARGUMENT ADDRESS CSP2549CPACK0033 00 C6800000LD 12 0 GET JCARD ADDRCSP25500002C 00 66000000002E 00 4C000000SAVE2 LOX L2 •..• RESTORE IR2DONE •-• RETURN TO CALLING PROGRAMC5P25460CSP254700035 0 0006STO JCARD&1 INITIALIZE JCARD ADDRESS CSP255100036 00 C6800001LD 12 1 GET SECOND ARGUMENT ADDR CSP25520PRINT0039 0 C202 LD 2 2 GET AREA ADDRESS CSP25540 PUNCH003A 0 D009 STO KCARD61 INITIALIZE PACK TO ADDRESS CSP25550003B 00 C4000000 JCARD LD L •• LOAD FIRST CHARACTERCSP25560003D 0 1898SRT 24 SHIFT INTO EXTCSP25570PUT0038 0 DOC8 STO JLAST INITIALIZE JCARD JLAST CSP25530003E 01 74FF003CMD% L JCARD611,1 DECREMENT ADDRESSCSP255800040 01 C480003CLD I JCARD61 GET SECOND CHARACTERCSP25590ADDP1403P1442READR2501SKIPSTACKPAGE 2SUB0042 0 18C8 RTE 8 SHIFT RIGHT. RETRIEVE EXT CSP25600 S14030043 00 040000000047 01 74010044KCARD STO L •-• STORE IN AREAMD% L KCARDS141 INCREMENT AREA ADDRESSCSP25610CSP25620CSP256300045 01 74FF003C MD% L JCARD6111-1 DECREMENT ADDRESSTYPER004A 0 9086S JLAST SUBTRACT JCARD JLAST ADDR CSP256500049 0 COF2LD JCARD6I GET ENDING ADDRESSCSP25640UNPAC0048 01 4C10003BBSC L JCARDI, REPEAT IF NOT MINUSCSP256600040 0 7203MD% 2 3 INCREMENT OVER 3 ARGS CSP25670WHOLE. 004E 0 70DC MDX LAST ALL THROUGHt G0 TO LAST CSP25680004F 0 6ADD SWING ST% 2 SAVE261 SWING ARRAY END FOR END CSP256900050 00 66800000 LOX 12 0 GET 1ST ARGUMENT ADDRESS CSP257000052 00 C6800000 LD 12 0 GET FIRST ARGUMENT CSP257100054 0 D007 STO BACK61 STORE AT BACK ADDRESS CSP257200055 00 C6800001 LD 12 1 GET 2ND ARGUMENT CSP257300057 0 D001 STO FRONTS]. STORE AT FRONT ADDRESS CSP257400058 00 C4000000 FRONT LD L •■• GET WORD FROM FRONT CSP25750005A 0 1890 SRT 16 PUT IT IN THE UT CSP257600058 00 C4000000 BACK LD L •..• GET A WORD FROM THE BACK CSP257700050 0 E810 OR HEX40 OR IN AN EBCDIC BLANK CSP25780005E 01 04800059 STO I FRONT61 PUT IT IN THE FRONT CSP257900060 0 1090 SLT 16 RETRIEVE THE EXT CSP258000061 0 E80C OR HEX40 OR IN AN EBCDIC BLANK CSP25810V 0062 01 0480005C STO I BACK61 PUT IT IN THE BACK CSP258200064 01 74010059 MDX L FRONTS1.61 INCREMENT THE FRONT ADDR CSP258300066 01 74FF005C MD% L BACK1S11,1 DECREMENT THE BACK ADDR CSP258400068 0 COFO LD FRONTS]. GET THE FRONT ADDRESS CSP258500069 0 90F2 S BACK+1 SUBTRACT THE BACK ADDRESS CSP25860006A 01 4C080058 BSC L FRONT.E. REPEAT IF MINUS CSP258706006C 0 7202 MD% 2 2 INCREMENT OVER 2 ARGS CSP258800060 0 70BD MDX LAST ALL THROUGH. GO TO LAST CSP25890006E 0 0040 HEX40 DC /0040 EBCDIC BLANK CODE CSP259000070 END OF ARGS SUBPROGRAM END CSP25910NO ERRORS IN ABOVE ASSEMBLY.// OUP•STORE WS UA ARGS33CE 0008CSP25920CSP25930-189-


APPENDIXCORE ALLOCATIONTo calculate <strong>the</strong> core requirements, sum <strong>the</strong> number of words for all routines used. IfNZONE, CARRY, NSIGN, SERVICE, WHOLE, ADD, and/or FILL are not included in <strong>the</strong>first sum, and <strong>the</strong>y are CALLed by a routine in <strong>the</strong> first sum, add <strong>the</strong>ir number of wordsto <strong>the</strong> first sum. Then calculate <strong>the</strong> Reference core requirements. Keep in mind that nomatter how many times a Reference is used, it should be considered only once. Sum <strong>the</strong>core requirements of all References used. Add this sum to <strong>the</strong> first sum. The resultingtotal is <strong>the</strong> core requirement for <strong>the</strong> <strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong>. Notice that<strong>the</strong> FORTRAN subroutines a, b, and c will be used by most FORTRAN programs and sowill be present whe<strong>the</strong>r <strong>the</strong> package is used or not.


,CSP Routine NameNumber ofWordsCalls These CSPRoutinesCalls These <strong>Subroutine</strong>Library RoutinesA1DEC 74 NZONE -A1A3/A3A1 152 - ADD/SUB 170 CARRY, FILL ARGS 112 - -CARRY 54 - -DECA1 76 NZONE -DIV 238 CARRY, FILL DPACK/DUNPK 100 - EDIT 204 NZONE, FILL FILL 30 - -GET 96 NZONE ref. a and bICOMP 122 - -IOND 6 - -MOVE 36 - -MPY 164 CARRY, FILL -NCOMP 42 - NSIGN 42 - -NZONE 78 - PA CK/UNPAC 66 - -PRINT/SKIP 124 ARGS ref. ePUT 104 NZONE, WHOLE ref. a, b, and cP1403/S1403 134 ARGS ref. jP1442 130 ARGS ref. iREAD/PUNCH 158 ARGS ref. f and hR2501 140 ARGS ref. d and hSTACK 6 - -TYPER/KEYBD 138 ARGS ref. g and hWHOLE 34 - -Referencesaa. (EADD, EMPY, ESTO, FLOAT, NORM) 342 wordsb. (SNR) 8 wordsc. (EABS, IFIX) 74 wordsd. (READ1) 110 wordse. (PRNT1) 404 wordsf. (CARD1) 264 wordsg. (TYPEO, EBPRT) 638 wordsh. (SPEED, ILSO4) 360 wordsi. (PNCH1) 218 wordsj. (PRNT3, ZIPCO, EBPT3) 544 words


EBCDIC CHARACTERS AND DECIMAL EQUIVALENTSA -16064 S -7616 blank 16448B -15808 T -7360 . (period) 19264C -15552 U -7104 < (less than) 19520D -15296 V -6848 19776E -15040 -6592 20032F -14784 X -6336 20544G -14528 Y -6080 23360H -14272 Z -5824 23616I -14016 0 -4032 23872J -11968 1 -3776 - (minus) 24640K -11712 2 -3520 24896L -11456 3 -3264 27456M -11200 4 -3008 27712N -10944 5 -2752 31552-10688 6 -2496 31808P -10432 7 -2240 (apostrophe) 32064Q -10176 8 -1984 32320R -9920 9 -1728


TIMING DATASubprogram NameApproximate* Execution Time in Microseconds**GET2250 + 2190 CPUT3450 + 3090 CEDIT630 + 90 S + 180 MMOVE300 + 45 CFILL300 + 30 CWHOLE 1400NCOMP250 + 75 CNZONE 350ICOMP500 + 95 CNSIGN 240ADD2160 + 216 LSUB2160 + 216 LMPY2400 + 120 PDIV4000 + Q (445 + 667 DIV)A1DECDECALA1A3A3A1PACKUNPACDPACKDUNPK700 + 54 A180 + 117 A470 + 1084 A545 + 156 A360 + 63 A420 + 66 A392D360DC = Length of <strong>the</strong> field, in charactersS = Length of <strong>the</strong> source fieldM = Length of <strong>the</strong> edit maskP = Length of <strong>the</strong> multiplier field x length of <strong>the</strong> multiplicand field (significantdigits only--don't count leading zeros)A = Length of <strong>the</strong> Al fieldD = Length of <strong>the</strong> packed decimal (D4) fieldL = Length of <strong>the</strong> longer of <strong>the</strong> two fields (significant digits only--don't countleading zeros)Q = Number of significant digits in <strong>the</strong> quotient (result) fieldDIV = Number of significant digits in <strong>the</strong> divisor (denominator) field* <strong>All</strong> timings are approximate, and are based on test runs of "typical"cases, using fields of "average" size, magnitude, etc. Unusual casesmay (or may not) differ significantly from <strong>the</strong> timings obtained from <strong>the</strong>given equations. This is particularly true of <strong>the</strong> decimal arithmeticroutines (ADD, SUB, MPY, DIV).** Based on 3.6-microsecond CPU cycle speed. Multiply by 0.6 to obtaintimings on 2. 2-microsecond CPU.


This page intentionally left blank.


j<strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong> (<strong>1130</strong>-SE-25X), Version 3, Programmers Reference CardFormat of <strong>Commercial</strong> <strong>Subroutine</strong> Calls (and Parameters*)*ONE WORD INTEGERS*EXTENDED PRECISION*IOCS (DISK)CALL ADD(JCARD,J, J LAST, KCARD, K, KLAST, NER)CALL AlA3(.1CARD,J,JLAST,KCARD,K, ICHAR)CALL Al DEC(JCARD,J,JLAST,NER)CALL A3A1(JCARD,J,JLAST,KCARD,K,ICHAR)CALL DECA1(JCARD,J,JLAST, NER)CALL DIV(JCARD,J,JLAST,KCARD,K,KLAST, NER)CALL DPACK(JCARD,J,JLAST,KCARD,K)CALL DUNPK(JCARD,J,JLAST,KCARD,K)CALL EDIT(JCARD,J,JLAST,KCARD,K,KLAST)CALL Fl LL(JCARD,J,J LAST, NCH)GET(JCARD,J,JLAST, SHIFT)ICOMP(JCARD,J,JLAST,KCARD,K,KLAST)CALL IONDCALL KEYBD(JCARD,J,JLAST)CALL MOVE(JCARD,J,JLAST,KCARD,K)CALL MPY(JCARD,J,JLAST,KCARD,K,KLAST,NER)NCOMP(JCARD,J,JLAST,KCARD,K)CALL NSIGN(JCARD,J,NEWS,NOLDS)CALL NZONE(JCARD,J, NEWZ, NOLDZ)CALL PACK(JCARD,J,JLAST,KCARD,K)CALL PRINT(JCARD,J,JLAST,NER)CALL PUNCH(JCARD,J,JLAST, NER)CALL PUT(JCARD,J,JLAST,VAR,ADJST, N)CALL P1403(JCARD,J,JLAST, NER)CALL P1442(JCARD,J,JLAST,NER)CALLREAD(JCARD,J,JLAST, NER)CALL R2501(JCARD,J,JLAST,NER)CALL SKIP(N)CALL 51403(N)CALL STACKCALL SUB(JCARD,J,JLAST,KCARD,K,KLAST,NER)CALL TYPER(JCARD,J,JLAST)CALL UNPAC(JCARD,J,JLAST,KCARD,K)WHOLE(EXPRESSION)Format of DataComments on ParametersPage Before AfterNos.**Must use for every CSP programMust use if GET or PUT is presentOnly DISK can be specified for CSP I/O13 DI DI Initialize NER to 0; error if NER=KLAST15 Al A3 You must define ICHAR array, and it must contain 40 characters.18 Al DI Initialize NER to 0; error if NEVO21 A3 Al You must define ICHAR array, and it must contain 40 characters-26 Dl Al Initialize NER to 0; error if NER4028 DI DI Initialize NER to 0; error if NER=K LAST31 Dl D434 D4 DI36 Al Al Control characters in mask are: b0.,CR-*S41 Dec. Al, See reverse side for decimal values for NCH42 AlReal*** I SHIFT must be real, extended precision. (1.0 .io shift)45 Al-0+ Minus:JCARDKCARD.47 None None Use before PAUSE or STOP (Monitor Version 1 Only)48 Al Al Maximum of 60 Characters allowed50 AnySame52 DIDI Initialize NER to 0; error if NER=K LAST54 Al-0+ Minus:JCARDKCARD.56 DlInteger See reverse side for values for NEWS and NOLDS58 Al --- Integer See reverse side for values for NEWZ and NOLDZ60 AlA262 Al --- Al Initialize NER to 0; if NER=3, reached chan.9; if NER=4, reached chan. 1264 Al --- Al Initialize NER to -1; if NERD, last card, if NER=1, feed or punch check- -66 Real*** Al VAR and ADJST must be real, extended precision68 Al --- Al Initialize NER to 0; if NER=3, reached chan. 9; if NER=4, reached chan. 1270 Al --- Al Initialize NER to -1; if NER"O, last card; if NER=1, feed or punch check73 Al --- Al Initialize NER to -1; if NERD, last card; if NER=1, feed or read check76 Al --- Al Initialize NER to -1; if NERD, lastcard; if NER=1, feed or read check79 Dec. --- None See reverse side for functional values for N84 Dec. None See reverse side for functional values for N81 None None82 DID1 Initialize NER to 0; error if NER=KLAST86 Al Al See reverse side for values for functional characters89 A2 Al91 RealReal The expression must be "real" not "integer".<strong>All</strong> parameters required by each subroutine must be supplied.** Page Number in <strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong> (<strong>1130</strong>-SE-25X), Version 3 Program Reference Manual (H20-0241-3)* ** Must use extended precision in calling program.


FILL andNCOMPLowHighEBCDIC Char. Dec. Equiv. NSIGN — used with DI fields(12-0) -16320A -16064 If NOLDS IS: Then sign was:B -15808 +1 positiveC -15552 -1 negativeD -15296E -15040FGH-14784-14528-14272-14016(11-0)-12224J -11968K-11712L-11456M-11200N-109440-10688P-10432Q-10176When NEWS is: Sign is set to:+1 positive0 opposite of old signnegativeNOLDS no changeNZONE — used with Al fieldsIf NOLDZ is:Then character was:1 A-I2 J -R3 S-Z4 0-9more than 4 specialRS-9920-7616-7360U -7104V -6848 When NEWZ is: Character is set to:W -6592 1 12 zoneX -6336 2 11 zoneZ-6080 3 0 zone-5824 4 no zonemore than 4 no change0 -40321 -37762 -3520 SKIP and S1403 function Value for N3 -32644 -3008 Immediate skip to channe 1 125445 -2752 Immediate skip to channe 2 128006 -2496 Immediate skip to channe 3 130567 -2240 Immediate skip to channe 4 133128 -1984 Immediate skip to channe 5 135689 -1728 Immediate skip to channe 6 13824Immediate skip to channe 9 14592Immediate skip to channe 12 15360blank 16448 Immediate space of 1 space 15616. (period) 19264 Immediate space of 2 spaces 15872


OPERATING INSTRUCTIONSThe procedures set forth in <strong>IBM</strong> <strong>1130</strong> Card/Paper Tape Programming System Operator'sGuide (C26-3629) and in <strong>IBM</strong> <strong>1130</strong> DISK Monitor System Reference Manual (C26-3750 orC26-3717) should be followed to execute <strong>the</strong> sample problems and all user-writtenprograms.Switch settings for <strong>the</strong> sample problems are as follows:InputDeviceOutputDeviceSwitches0 1 21442 console printer down down down1442 1132 up down down1442 1403 up up down2501 console printer down down up2501 1132 up down up2501 1403 up up upMake sure that <strong>the</strong> switches are set properly before <strong>the</strong> program begins.Note: Sample Problem 2 cannot be executed if Version 1 of <strong>the</strong> Monitor is being used.q


HALT LISTINGConditions A and B (see list below) have <strong>the</strong> following meaning:A Device not ready.B Internal subroutine error. Rerun job. If error persists, verify that <strong>the</strong> subroutinedeck is accurate, using <strong>the</strong> listings in this manual. If <strong>the</strong> deck is <strong>the</strong>same, contact your local <strong>IBM</strong> representative. Save all output.IAR Accumulator (hex) Device Condition41 lxx0 1442 Card Read Punch A41 lxx1 1442 Card Read Punch B41 2xx0 Console printer or keyboard A41 220E1 Console printer or keyboard B41 4xx0 2501 Card Reader A41 4xxl 2501 Card Reader B41 6xx0 1132 Printer A41 6=1 1132 Printer B41 9xx0 1403 Printer A41 9xx1 1403 Printer B


BIBLIOGRAPHY<strong>IBM</strong> <strong>1130</strong> Functional Characteristics (A26-5881)Core Requirements for <strong>1130</strong> FORTRAN (C20-1641)<strong>1130</strong> FORTRAN Programming Techniques (C20-1642)<strong>IBM</strong> <strong>1130</strong> Card/Paper Tape Programming System Operator's Guide (C26-3629)<strong>IBM</strong> <strong>1130</strong> DISK Monitor System Reference Manual (C26-3750)<strong>IBM</strong> <strong>1130</strong> Assembler Language (C26-5927)<strong>IBM</strong> <strong>1130</strong> <strong>Subroutine</strong> Library (C26-5929)<strong>IBM</strong> <strong>1130</strong>/1800 Basic FORTRAN IV Language (C26-3715)<strong>IBM</strong> <strong>1130</strong> DISK Monitor System, Version 2 (C26-3717)


Ts)


', W.P.M. RP


H20-0241-3Eli3MInternational Business Machines CorporationData Processing Division112 East Post Road, White Plains, N.Y. 10601(USA Only)<strong>IBM</strong> World Trade Corporation821 United Nations Plaza, New York, New York 10017(International)


<strong>1130</strong> <strong>Commercial</strong> <strong>Subroutine</strong> <strong>Package</strong>(<strong>1130</strong>-SE-25X), Version 3Program Reference ManualREADER'S COMMENT FORMH20-0241-3Please comment on <strong>the</strong> usefulness and readability of this publication, suggest additions anddeletions, and list specific errors and omissions ( give page numbers ). <strong>All</strong> comments and suggestionsbecome <strong>the</strong> property of rem. If you wish a reply, be sure to include your name and address.COMMENTSfoldfoldfoldfold• Thank you for your cooperation. No postage necessary if mailed in <strong>the</strong> U.S.A.FOLD ON TWO LINES, STAPLE AND MAIL.111111111111,1•101111111 11111111,11111111111111111111111111 III


IH20-0241-3YOUR COMMENTS PLEASE ...Your comments on <strong>the</strong> o<strong>the</strong>r side of this form will help us improve future editions of this publication.Each reply will be carefully reviewed by <strong>the</strong> persons responsible for writing and publishingthis material.Please note that requests for copies of publications and for assistance in utilizing your ismsystem should be directed to your thm representative or <strong>the</strong> ism branch office serving yourlocality.foldfoldFIRST CLASSPERMIT NO. 1359WHITE PLAINS, N. Y.BUSINESS REPLY MAILNO POSTAGE STAMP NECESSARY IF MAILED IN THE UNITED STATESPOSTAGE WILL BE PAID BY.<strong>IBM</strong> Corporation112 East Post RoadWhite Plains, N. Y. 10601Attention: Technical PublicationsfoldfoldInternational Business Machines CorporationData Processing Division112 East Post Road, White Plains, N.Y.10801[USA Only]<strong>IBM</strong> World Trade Corporation821 United Nations Plaza, New York, New York 10017[International]

Hooray! Your file is uploaded and ready to be published.

Saved successfully!

Ooh no, something went wrong!