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

ADDA1A3A1DEC// ASM•• NZONE SUBROUTINE FOR 1130 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-