software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape3 / IOH.SB
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/IOH.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/IOH.SB
new file mode 100644 (file)
index 0000000..b7f4528
--- /dev/null
@@ -0,0 +1,921 @@
+/IOH SUBROUTINE                     OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1974,1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 10A
+/      APRIL 28,1977
+/      INPUT OUTPUT CONVERSION SUBROUTINE
+/      FOR 8K ALICS-FORTRAN SYSTEM
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+       ABSYM SACH 23           /SAVE FPAC FOR MANIPULATION OF AC
+       ABSYM SACM 24
+       ABSYM SACL 25
+       ABSYM N2 175            /LAST ACCUMULATED NUMBER
+       ABSYM ARGUMT 176
+       DUMMY   ARGUMT
+       DUMMY   FPNT
+       ENTRY   READ
+       ENTRY   WRITE
+       ENTRY   IOH
+/
+/      THE FOLLOWING IS NECESSARY BECAUSE CERTAIN SUBROUTINES SKIP
+/
+       OPDEF TADI 1400
+       OPDEF DCAI 3400
+       OPDEF ANDI 0400
+       OPDEF JMPI 5400
+       OPDEF JMSI 4400
+       OPDEF ISZI 2400
+       SKPDF JMSKP 4000
+       LAP
+
+/
+A2,    BLOCK   14
+/
+/      IOH ERROR ROUTINES
+/
+ERRNO, BLOCK   1
+ERR2,  ISZ     WHI     /SEE IF THIS WAS I FORMAT OR THE EXPONENT
+ERR3,  ISZ     ERRNO   /IN E FORMAT
+       ISZ     ERRNO
+       SKP
+ERR1,  ISZ     DV      /ERR1 IS ALWAYS FATAL
+       CLA
+       TAD     DV
+       SNA CLA         /WAS THIS AN INPUT ERROR FROM THE TELETYPE?
+       CLA CLL CML RAR         /YES - NON-FATAL
+       TAD     (615
+       DCA     IO
+       TAD     ERRNO           /IOH ERROR NUMBER
+       TAD     (2461           /MAKE INTO BCD
+       DCA     SW              /TO ERROR COMMENT
+       CALL    1,ERROR
+       ARG     IO
+
+       JMP     RETRY           /DO ENTIRE READ STATEMENT OVER
+DV,    0                       /SAVE DEVICE CODE
+CS,    A2                      /INITIAL PUSH POINTER
+PARN,  0
+       NOP             /CDF N
+       TADI    WRITE#
+       INC     WRITE#
+       JMP I   PARN
+CH,    0
+TW,    12
+READ,  BLOCK 1
+       10                      /ENTRY POINT FOR READ
+RETRY, TAD     READ            /SNEAK IN
+       DCA     WRITE
+       TAD     READ#
+       DCA     WRITE#          /SAVE SECOND RETURN WORD
+       JMP     ET
+       CPAGE 4
+IO,    0
+SW,    0                       /LEFT OR RIGHT HALF OF FORMAT
+WRITE, BLOCK 1
+       10                      /ENTRY POINT
+       CLA IAC                 /INITIALIZE SWITCH
+ET,    DCA     IO
+       DCA     CH              /CLEAR CHARACTER
+       DCA     ERRNO           /ZERO ERROR NUMBER IN CASE ERROR RESTART
+       TAD     WRITE
+       DCA     PARN#
+       JMS     PARN
+       DCA     DEVNO1
+       JMS     PARN
+       DCA     7
+DEVNO1,        NOP             /CDF N
+       CLA CMA
+       TADI    7               /PICK UP DEVICE NUMBER
+       CLL RTR                 /ROTATE IT INTO BITS 0-3
+       RTR
+       RAR
+       DCA     DV
+       TAD     CS              /INITIALIZE PUSH STACK
+       DCA     PUSH            /-
+       JMS     PARN
+       DCA     FPNT01
+       JMS     PARN
+       DCA     FPNT
+       CLA IAC         /SET UP "SW" TO START FORMAT
+       DCA     SW      /FROM SECOND CHARACTER (FIRST IS LPAREN)
+       DCA     BA      /ZAP END-OF-LINE SWITCH
+       TAD     PENTER  /FAKE RE-ENTRY TO SET UP FIRST LPAREN
+       DCA     GLST    /ON PUSHDOWN STACK
+       RETRN   WRITE
+PENTER,        FENTER
+
+FPNT,  0
+GFRM,  0
+       TAD     SW
+       INC     SW
+       CLL RAR
+       TAD     FPNT            /FORM ADDRESS IN AC AND LEFT/RIGHT
+       DCA     7               /SWITCH IN LINK
+FPNT01,        NOP                     /CDF N
+       TADI    7
+       SZL                     /LEFT OR RIGHT?
+       JMP     HR
+       RTR
+       RTR
+       RTR
+HR,    AND     (77
+       JMP I   GFRM
+       CPAGE   5
+       0               /I1000
+       0               /I100
+       0               /I10
+I1,    0               /I1
+       4000
+SV,    BLOCK 3         /FLOATING POINT TEMPORARY
+       CPAGE 3
+TN,    2045            /10.0
+       0
+       0
+\f      PAGE            /EXPERIMENTAL
+RETN,  DCA     SACH            /SET SACH TO 0
+RTUR,  JMS     GFRM            /GET NEXT CHAR IN FORMAT
+       CPAGE 24
+       JMS     CHTYPE  /CLASSIFY FORMAT CHARACTER
+       DG              /DIGIT EXIT
+       -57;    SL
+       -56;    PER
+       -54;    CM
+       -51;    RPAR
+       -50;    LP
+       -47;    QT
+       -40;    RTUR
+       0;      SVCHR
+SVCHR, DCA     CH
+       JMS     NU              /GET THE ACCUMULATED NUMBER
+       CMA                     /KRONK IT
+       DCA     N1              /AND SAVE       COUNT FOR ALL CONVERSIONS
+       TAD     CH
+       AND     (7757
+       TAD     (7770           /THIS TESTS IF CH IS AN ,X, OR ,H,
+       SNA CLA
+CM,    JMS     PR              /IT WAS , PROCESS IT
+       JMP     RETN            /NOT X OR H, KILL NUMBER AND TRY AGAIN
+N1,    0
+
+SL,    JMS     PR              /GO PROCESS THE PREVIOUS ITEM (IF ANY)
+       JMS     EJ
+       JMP     RETN
+QT,    JMS     PR              /PROCESS PREVIOUS ITEM, IF ANY
+QT1,   JMS     GFRM
+       TAD     (-47
+       SNA                     /ANOTHER QUOTE?
+       JMP     RETN
+       TAD     (47
+       JMS     PRINT           /PRINT CHAR
+       JMP     QT1
+DG,    JMS     DGT             /ACCUMULATE DIGIT INTO SACH
+       JMP     RTUR            /TRY ANOTHER CHARACTER
+LP,    ISZ     PUSH            /LEFT PAREN
+       CLA CMA                 /COUNT NESTING DEPTH, NEGATIVE
+       TAD     NPAR
+       DCA     NPAR
+       TAD     SW              /PICK UP THE FORMAT POINTER
+       DCA I   PUSH            /CRAM IT INTO THE LIST
+       ISZ     PUSH            /KICK AGAIN
+       JMS     NU              /THERE MAY BE AN ACCUMULATED NUMBER
+       CIA                     /SAVE NUMBER
+       DCA I   PUSH            /*
+       CLA CLL CML RTL         /HERE WE SEE IF THIS IS A POSSIBLE
+       TAD     NPAR            /RESTART POINT
+       SPA CLA                 /IF FIRST SAVE SW IN S1
+       JMP     RETN            /NOPE- FORGET IT
+       TAD     SW              /YES--FIRST CRAM FORMAT---
+       DCA     S1              /---INTO SAVE1
+       TAD I   PUSH            /AND THAT STUFF IN THE LIST---
+       DCA     S2              /---GOES INTO SAVE 2
+       JMP     RETN            /READY FOR ANYTHING, HERE WE GO
+PUSH,  0               /PARENTHESIS PUSHDOWN LIST POINTER
+
+RPAR,  JMS     PR              /PROCESS PREVIOUS ITEM, IF ANY
+       ISZ I   PUSH
+       JMP     TR
+       CLA CLL CMA RAL         /-2
+       TAD     PUSH            /DELETE THIS ITEM FORM THE LIST
+       DCA     PUSH            /PUSH = PUSH-2
+       ISZ     NPAR            /NPAR = NPAR +1 ]-1[ SINCE MINUS COUNT
+       JMP     RETN
+       JMS     WH              /THIS PAREN WAS THE BALANCING PAREN
+       TAD     S1              /GET THE FORMAT POINTER OF THE--
+       DCA     SW              /RESTART POINT AND CRAM IT
+       TAD     S2              /GET SWITCH AND THE COUNT
+       CIA
+FENTER,        DCA     SACH
+       CLA CMA
+       TAD     SW              /TEST TO SEE IF SW IS ORIGINAL POINTER
+       SNA CLA
+       JMP     L2              /YES - FAKE A RESTART
+       ISZ     PUSH            /NO - PUSH ORIGINAL POINTER
+       CLA IAC                 /SINCE WE ARE RETURNING TO DEPTH 2
+       DCA I   PUSH
+       ISZ     PUSH
+       CLA CMA                 /SET COUNT = 1, SWITCH = 1
+       DCA I   PUSH
+       CMA
+L2,    DCA     NPAR            /PARNRN = -1
+       JMP     LP
+
+TR,    CLA CMA                 /GET OUT THE FORMAT POINTER--
+       TAD     PUSH            /*
+       DCA     N3
+       TAD I   N3
+       DCA     SW              /HAA-- IT IS NOW RESTORED
+       JMP     RETN            /AWAY WE GO
+N3,    0                       /W FOR E AND F CONVER
+PER,   JMS     NU              /GOT A PERIOD, MUST BE  OR F TYPE
+       DCA     N3
+       JMP     RETN
+S1,    0
+S2,    0                       /SAVE THE COUNT AND SWITCH
+NPAR,  0
+\f      PAGE            /EXPERIMENTAL
+
+EX,    JMS     GLST            /THIS IS E FORMAT CONVERSION
+EE,    JMS     NR      /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
+       TAD     C
+       DCA     GLST            /STORE C AWAY IN A SAFE PLACE
+       DCA     C
+       CLA CMA
+       DCA     EFLG            /SET "E FORMAT FAKEOUT" FLAG
+       TAD     (-5
+       JMP     FFAKE           /FAKE OUT "F" FORMAT TO PRINT DIGITS
+PRNTE, TAD     (5              /PUT OUT THE E
+       JMS     PRINT
+
+
+/      NOW PRINT 'C' DIGITS UNDER I3 FORMAT
+       TAD     GLST
+       SPA SNA CLA
+       CLA CLL CMA RAL
+       TAD     (55
+       JMS     PRINT           /PRINT A MINUS OR PLUS
+       TAD     GLST
+       SPA
+       CIA
+       CALL    1,DIV
+       ARG     TW
+       TAD     (60
+       JMS     PRINT           /PRINT
+       CPAGE 4
+       CALL    0,IREM          /IREM NEEDS AN ARGUMENT TO IGNORE
+EFLG,  0
+CRX,   0
+       TAD     (60
+       JMS     PRINT           /PRINT SECOND DIGIT
+       JMP     EX              /DONE, DO NEXT
+
+FX,    CLA
+       JMS     GLST            /THIS IS F      FORMAT CONVERSION
+FF,    JMS     NR      /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
+       DCA     EFLG
+       TAD     C               /C CONTAINS NUMBER OF MULTS TO RANGE NUMBER
+       SMA
+       CLA CMA                 /0 MULTS NEEDED OR ALREADY THERE
+FFAKE, TAD     N3              /NUM3 IS THE FIELD WIDTH
+       CIA                     /MINUS SPACE FOR DADP+DP
+       TAD     N2
+       JMS     SA              /PUT OUT REQUIRED BLANKS + SIGN
+       TAD     C
+       SMA
+       JMP     PRZRO   /NO LEADING DIGIT - PRINT A ZERO FOR LOOKS
+       CIA
+       JMS     DT
+PRDCPT,        TAD     (56
+       JMS     PRINT
+       TAD     C               /GET MULTIPLY COUNT
+       SPA SNA
+       JMP     PAS2
+       CMA                     /THEY WERE MULTIPLIES, 0 TO N OF THEM
+       DCA     CRX
+       TAD     N2              /DIGITS AFTER DEC POINT, DADP
+       CMA
+       DCA     NR
+       JMP     PASA            /TEST FOR 0 MULTIPLIES
+RETR,  TAD     (60             /PUT OUT A ZERO
+       JMS     PRINT           /ALL MULTIPLIES REPRESENTED
+PASA,  ISZ     CRX             /NO, TRY RUN OFF FIELD
+       SKP
+       JMP     PASS            /YES
+       ISZ     NR              /ALL WIDTH ACCOUNTED FOR%
+       JMP     RETR            /NO, TRY NEXT POSITION
+
+
+PASS,  TAD     C               /YES, GET MULT COUNT
+       CIA                     /-MULT COUNT
+       SKP
+PAS2,  CLA
+       TAD     N2              /N2-MULT COUNT
+       SMA SZA                 /IS MULT COUNT .GE. N2?
+       JMS     DT              /NO - PRINT REMAINING DIGITS
+       ISZ     EFLG            /WERE WE FAKED OUT BY "E" FORMAT?
+       JMP     FX              /NO
+       JMP     PRNTE           /YES - GO PRINT EXPONENT
+PRZRO, CLA
+       TAD     (60
+       JMS     PRINT
+       JMP     PRDCPT          /GO BACK TO PRINT THE DECIMAL POINT
+
+SA,    0
+       TAD     SN
+       SMA                     /THIS IS -(NUM OF BLANKS)
+       JMP     AS3             /POSITIVE, NUMBER TOO BIG FOR FIELD
+       DCA     CRX
+       SKP CLA
+RETC,  JMS     PRINT           /HERE WE PUT OUT THAT MANY BLANKS
+       TAD     (40
+       ISZ     CRX
+       JMP     RETC            /YES
+       CLA
+       TAD     SN
+       SNA CLA                 /IS SIGN MINUS?
+       JMP I   SA              /EVIDENTLY NOT
+       TAD     (55
+       JMS     PRINT           /PUT OUT A MINUS SIGN
+       JMP I   SA
+
+\f      PAGE            /EXPERIMENTAL
+FN,    TAD     N3              /GET WIDTH, INPUT FOR E OR F FORMAT
+       CMA                     /1'S COMPLEMENT
+       DCA     CR              /TO COUNTER
+       DCA     D1              /0 TO D1
+       CALL    0,CLEAR
+       CMA
+       DCA     D2              /-1 TO DECIMAL POINT SWITCH
+       CMA             /-0 TO SGN FLAG
+RRTSGN,        DCA     SN
+RRT,   CLA
+       ISZ     CR              /INDEX TO SEE IF WIDTH EXCEEDED
+       SKP
+       JMP     FP              /GET AN INPUT CHARACTER AND TEST IT
+       JMS     GCHR
+       CPAGE 20
+       JMS     CHTYPE  /CLASSIFY INPUT CHAR
+       FDIGIT          /DIGIT
+       -56;    PUNT
+       -40;    RRT
+       -53;    RRT
+       -55;    RRTSGN
+       -5;     EPRO
+       0
+PERR3, ERR3
+FDIGIT,        DCA     IS
+       CALL    1,FMP
+       ARG     TN
+       CALL    1,STO           /SAVE FLOATING POINT ACCUMULATOR
+       ARG     SV
+       TAD     IS
+       CALL    0,FLOT          /FLOAT NEW DIGIT
+       CALL    1,FAD
+       ARG     SV
+       INC     D1              /COUNT OF DIGITS
+       JMP     RRT
+PUNT,  ISZ     D2              /TST DP SWITCH
+       JMPI    PERR3           /***** TWO DECIMAL POINTS *****
+       DCA     D1
+       JMP     RRT
+EPRO,  CLA CMA                 /AN E
+FP,    DCA     IS              /-1 TO IS IF E, 0 TO IS IF END OF FIELD
+       ISZ     D2              /TEST DP SWITCH
+       JMP     FA              /ONE HAS OCCURRED
+       TAD     N2              /ONE HAS NOT OCCURRED, GET NDP
+       SKP
+FA,    TAD     D1              /COUNT OF DIGITS AFTER EXPLICIT DP
+       CMA                     /-COUNT
+       JMS     DH              /DIVIDE FPAC BY TEN COUNT TIMES
+       TAD     ACH             /IF ACH=0,DON'T CHK. SIGN
+       SNA
+       JMP     ZR              /ZERO-DON'T CHECK
+       ISZ     SN              /TEST SIGN
+       TAD     (4000           /SET SIGN BIT
+       DCA     ACH
+ZR,    ISZ     IS      /DID WE GET AN "E"?
+       JMP     VZA     /NO - STORE RESULT AND GET OUT
+       JMP     VQ      /YES - FAKE INTEGER ROUTINE TO ACCEPT EXPONENT
+D1,    0
+D2,    0
+IS,    0
+CR,    0
+
+PRO2,  CMA             /GOT EXPONENT - MAKE IT NEGATIVE
+       ISZ     SN      /WHAT WAS ITS ORIGINAL SIGN?
+       JMP     VZB     /NEGATIVE - DIVIDE BY 10^EXP
+       DCA     D1              /SAVE COUNT
+       JMP     VZD
+VZC,   CALL    1,FMP
+       ARG     TN
+VZD,   ISZ     D1              /INDEX COUNT
+       JMP     VZC
+       JMP     VZA
+VZB,   JMS     DH
+VZA,   CALL    1,ISTO          /STORE IN PLACE
+       ARG     ARGUMT
+       JMP     FX
+\f      PAGE            /EXPERIMENTAL
+XX,    JMS     MR              /TEST FOR MORE
+       TAD     IO              /TEST FOR INPUT-OUTPUT
+       SNA CLA
+       JMP     XX1             /INPUT, PSEUDO-JUMP
+       TAD     (40             /OUTPUT A BLANK
+       JMS     PRINT
+       JMP     XX              /CYCLE
+XX1,   JMS     GCHR            /IGNORE SPACES ON INPUT
+       CLA
+       JMP     XX
+
+HH,    JMS     MR      /THE H FIELD PROCESSOR
+       JMS     GFRM    /SAME AS XXX, BUT PRINT NEXT
+       JMS     PRINT   /----- FORMAT CHARACTER
+       JMP     HH      /OUTPUT ONLY
+
+PRINT, 0
+       TAD     (-40
+       SPA
+       TAD     (100            /CONVERT 6-BIT TO 8-BIT
+       TAD     (240
+       TAD     DV              /ADD ON DEVICE NUMBER IN BITS 0-3
+       CALL    0,GENIO
+       JMP I   PRINT
+
+WH,    0
+       JMS     EJ      /END THE RECORD
+       TAD     ARGUMT#
+       SNA CLA         /TEST PARAMETER FOR 0
+       JMS     GLST    /RETURN TO MAIN PROGRAM ON 0 PAR
+       JMP I   WH      /MORE AGRUMENTS RETURN
+
+EJ,    0                       /ROUTINE TO END RECORD
+       TAD     IO
+       SZA CLA                 /INPUT OR OUTPUT?
+       JMP     E1              /OUTPUT
+E2,    CLA
+       TAD     BA
+       SZA CLA
+       JMP     BG              /CARRIAGE RETURN SEEN - GOODBYE
+       JMS     GCHR            /GET A CHARACTER
+       JMP     E2              /KEEP LOOKING FOR CR
+BG,    DCA     BA
+       JMP I   EJ
+E1,    TAD     (7715           /7715 TRANSLATES TO 215
+       JMS     PRINT
+       TAD     (7712
+       JMS     PRINT           /PRINT CR-LF
+       JMP I   EJ
+
+BA,    0               /THIS IS THE END OF LINE SWITCH
+BH,    ISZ     BA      /ENTRY TO LOOK FOR AN END OF LINE
+BL,    TAD     (40
+       AND     (77             /KEEP THIS - BL IS REFERENCED BY GCHR
+       JMP I   GCHR
+
+GCHR,  0               /GET AN INPUT STRING CHARACTER
+JD,    CLA
+       TAD     BA      /GET EOR SWITCH
+       SZA CLA
+       JMP     BL      /IS EOR, RETURN BLANK
+       CLA CLL CML RTR         /****** IF # OF DEVICES IS CHANGED,
+       TAD     DV              /THIS SHOULD BE CHANGED TOO *****
+       CALL    0,GENIO         /CALL GENIO WITH OFFSET DEVICE NUMBER
+       AND     (177            /STRIP PARITY
+       TAD     (7763
+       SNA                     /CARRIAGE RETURN?
+       JMP     BH
+       TAD     (7655
+       CLL
+       TAD     (100            /IS CHAR IN RANGE 237<CHAR<340?
+       SNL
+       JMP     JD              /NO - IGNORE
+       JMP     BL              /CONVERT TO SIXBIT AND RETURN
+\f      PAGE            /EXPERIMENTAL
+/     GET F.P. NUMBER INTO THE RANGE   .1 .LE. N .L. 1.0
+NR,    0
+       JMSKP   BB      /CHECK DIRECTION OF I/O
+       JMP     FN      /INPUT
+       CALL    1,IFAD  /OUTPUT - LOAD NUMBER INTO FLOATING AC
+       ARG     ARGUMT
+       DCA     SN      /CLEAR THESE LOCS
+       DCA     C
+       TAD     ACH
+       SNA
+       JMP     NREX    /NUMBER IS ZERO
+       SMA             /IS IT A MINUS F P NUMBER
+       JMP     RETM
+       TAD     (4000   /YES-- MAKE IT POSITIVE
+       ISZ     SN      /SET SIGN
+       DCA     ACH
+RETM,  CLA                     /MULTIPLY BY 10 UNTIL NR .GT. (1.0)
+       TAD     ACH
+       TAD     (5764
+       SMA CLA
+       JMP     TB      /GOT IT IT IS .GE.1
+       CALL    1,FMP
+       ARG     TN
+       ISZ     C       /AND COUNT
+       JMP     RETM    /GO TRY TO DO IT AGAIN
+TB,    JMS     SE      /NOTE SE ' XR-1
+       CALL    1,STO
+       ARG     SV
+       TAD     (2004
+       DCA     ACH     /200400000000=.50000 IN AC
+       TAD     CH      /TEST FORMAT
+       TAD     (7772
+       SNA CLA         /IS IT E FORMAT?
+       TAD     C       /NO - COUNT # OF MULTS NEEDED
+       CIA
+       TAD     N2      /< DADP
+       SMA
+       CMA             /NUMBER OF THIMES TO DIVIDE .5 BY 10 TO RND
+       JMS     DH      /DO THE DIVIDES
+       CALL    1,FAD
+       ARG     SV
+       JMS     SE      /REDUCE TO NORMAL RANGE AGAIN
+
+
+GD,    TAD     ACH
+       RAL
+       SPA CLA
+       JMP     ZP      /NUMBER IS ? 1/2
+       TAD     ACH
+       CLL RAR         /WE ARE GETTING EXP TO 200
+       DCA     ACH
+       TAD     ACM
+       RAR
+       DCA     ACM
+       TAD     ACL
+       RAR
+       DCA     ACL
+       TAD     ACH
+       AND     (7774
+       TAD     ACH
+       TAD     (10
+       DCA     ACH
+       JMP     GD
+ZP,    TAD     ACH
+       AND     (7
+       DCA     ACH
+NREX,  JMP I   NR
+SN,    0
+
+C,     0                       /COUNTER FOR DEC. EXP.
+SE,    0                       /DIVIDE BY 10 UNTIL N < 1.0
+XR,    TAD     ACH             /TEST NUMBER FOR .GE. 1
+       TAD     (5764
+       SPA CLA
+       JMP I   SE              /NUMBER IS IN RANGE, RETURN
+       CLA CLL CMA RAL
+       JMS     DH
+       CLA CMA                 /REDUCE COUNT
+       TAD     C
+       DCA     C
+       JMP     XR
+\f      PAGE            /EXPERIMENTAL
+GLST,  0               /GET NEXT ARGUMENT ROUTINE
+       CALL    0,CLEAR /CLEAR FLOATING AC
+       ISZ     IOHCNT  /ARE WE IN AN ARRAY I/O LOOP?
+       JMP     ARMORE  /YES - GET NEXT ELEMENT
+       INC     IOH#
+       RETRN   IOH     /RETURN TO USERS PROGRAM FOR MORE DATA
+ARMORE,        TAD     ARGUMT#
+       TAD     IOHINC  /BUMP ARGUMENT POINTER BY ELEMENT LENGTH
+       JMP     IOHBAK  /RESUME I/O CONVERSIONS WITH UPDATED ARGUMT
+
+       CPAGE 33
+IOH,   BLOCK   1
+       10      
+       SZA CLA         /IS THIS A SCALAR OR AN ARRAY CALL?
+       JMP     IOHAR   /AN ARRAY CALL
+       CLA CMA
+IOGTAR,        DCA     IOHCNT  /SET UP ARGUMENT COUNT FOR THIS CALL
+       TAD     IOH
+       DCA     IOH1
+IOH1,  NOP             /SET DATA FIELD TO ARGUMENT LIST
+       TADI    IOH#
+       DCA     ARGUMT
+       INC     IOH#
+       TADI    IOH#
+IOHBAK,        DCA     ARGUMT#
+       JMP I   GLST    /RETURN TO I/O CONVERSION
+IOHAR, INC     IOH#
+       CLA CLL CML RAR
+       AND I   IOH     /GET TYPE OF ARRAY
+       CLL RTL
+       CML RAL         /FORM A 1 OR A 3, DEPENDING ON ARRAY TYPE
+       DCA     IOHINC
+       CLA CLL CMA RAR
+       ANDI    7       /GET THE ELEMENT COUNT
+       CIA
+       INC     IOH#
+       JMP     IOGTAR  /SAVE IT AND GET ARRAY POINTER
+IOHINC,        0
+IOHCNT,        0
+
+CHTYPE,        0               /SUBROUTINE TO CLASSIFY CHARACTERS
+       DCA     CHCH
+       TAD     CHCH
+       TAD     (7706
+       CLL
+       TAD     (12
+       SZL             /IS THE CHARACTER NUMERIC?
+       JMP     JMPOUT  /YES - TAKE FIRST EXIT
+       INC     CHTYPE
+CHLOOP,        CLA
+       TAD I   CHTYPE
+       INC     CHTYPE
+       SNA             /CHARACTER LIST EXHAUSTED?
+       JMP     JMPOTX  /YES - TAKE LAST EXIT WITH CHAR IN AC
+       TAD     CHCH
+       SNA CLA         /MATCH?
+       JMP     JMPOUT  /YES - TAKE EXIT WITH AC=0
+       INC     CHTYPE
+       JMP     CHLOOP  /NO MATCH - GO ON TO NEXT CHAR
+JMPOUT,        DCA     CHCH
+JMPOTX,        TAD I   CHTYPE
+       DCA     CHTYPE
+       TAD     CHCH
+       JMP I   CHTYPE
+CHCH,  0
+
+DT,    0
+       CIA
+       DCA     CHCH    /STORE COUNT
+RETT,  JMS     LS      /LEFT SHIFT 1
+       TAD     ACL     /SAVE THE FPAC
+       DCA     SACL
+       TAD     ACM
+       DCA     SACM
+       TAD     ACH
+       AND     (17
+       DCA     SACH
+       TAD     SACH
+       DCA     ACH     /TRIM AC TO 28 BITS
+       JMS     LS      /LEFT SHIFT 2
+       JMS     LS
+       TAD     ACL     /ADD THE DSAVE TO THE ACC
+       TAD     SACL
+       DCA     ACL
+       RAL             /*
+       TAD     ACM
+       TAD     SACM
+       DCA     ACM
+       RAL             /*
+       TAD     ACH
+       TAD     SACH
+       DCA     ACH
+       TAD     ACH
+       CLL RAR         /ROTATE 3 RIGHT
+       RTR
+       AND     (17
+       TAD     (60     /MAKE DIGIT
+       JMS     PRINT   /DUMP IT AND SEE IF ANY MORE
+       ISZ     CHCH    /LOOP ON COUNT
+       JMP     RETT    /*
+       JMP I   DT
+
+LS,    0               /LEFT SHIFT THE FPAC 1
+       TAD     ACL
+       CLL RAL
+       DCA     ACL
+       TAD     ACM
+       RAL
+       DCA     ACM
+       TAD     ACH
+       RAL
+       DCA     ACH
+       JMP I   LS      /DONE
+\f      PAGE            /EXPERIMENTAL
+PR,    0
+       TAD     SACH    /GET THE LAST NUMBER ACCUMULATED
+       DCA     N2      /SAVE IT
+PR2,   TAD     CH
+       SNA
+       JMP I   PR      /NOTHING TO DO
+       CPAGE 22
+       JMS     CHTYPE  /CLASSIFY CH
+       ERR1            /DIGIT IS ILLEGAL
+       -30;XX
+       -11;II
+       -10;HH
+       -6;FF
+       -5;EE
+       -1;AA
+       0;ERR1
+
+MR,    0               /MORE?
+       ISZ     N1      /SEE IF IT GOES TO ZERO
+       JMP I   MR
+       DCA     CH      /NO MORE FIELDS, FIRST WIPE CHAR
+       JMP I   PR      /GO BACK TO FORMAT SCANNER
+NU,    0               /ROUTINE TO FETCH THE ACCUM NUMB
+       TAD     SACH
+       SNA             /IF IT IS ZERO, SET IT TO 1
+       CLA IAC         /IT IS AND WE DO
+       JMP I   NU      /GO HOME
+BB,    0
+       JMS     MR      /MORE?
+       TAD     ARGUMT#
+       SNA CLA         /IF ARG=0,
+       JMS     WH      /END RECORD AND RETURN TO USERS PROGRAM
+       TAD     IO      /TEST IN OUT SWITCH
+       SZA CLA         /OUTPUT
+       INC     BB      /INPUT
+       JMP I   BB
+AX,    JMS     GLST
+AA,    TAD     N2
+       CIA
+       DCA     CX
+       JMSKP   BB
+       JMP     AR
+AS,    JMS     GADR    /GET CHARACTER ADDRESS
+       TADI    7
+       SZL
+       JMP     ASNORT
+       RTR
+       RTR
+       RTR
+ASNORT,        AND     (77     /MASK 6 BITS
+       JMS     PRINT
+       ISZ     CX
+       JMP     AS      /LOOP FOR CHARACTER COUNT
+       JMP     AX      /GET NEXT ARGUMENT(IF ANY)
+
+AR,    JMS     GCHR
+       DCA     DH      /GET AND SAVE INPUT CHAR
+       JMS     GADR    /GET CHARACTER POINTER
+       TAD     DH
+       SZL             /WHICH HALF?
+       JMP     ARNORT  /RIGHT HALF
+       IAC
+       RTL
+       RTL
+       RTL
+       SKP
+ARNORT,        TADI    7
+       TAD     (7740   /CANCEL BLANK CHAR
+ARCOMN,        DCAI    7
+       ISZ     CX
+       JMP     AR
+       JMP     AX
+
+GADR,  0               /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT
+       TAD     ARGUMT
+       DCA     AS1
+       TAD     N2
+       TAD     CX
+       CLL RAR
+       TAD     ARGUMT# /AC=WORD POINTER, LINK=LEFT/RIGHT FLAG
+       DCA     7
+AS1,   NOP             /SET UP DATA FIELD OF ARGUMENT
+       JMPI    GADR
+CX,    0
+
+DH,    0
+       DCA     CX      /DIVIDE FPAC BY TEN CX TIMES
+       JMP     DTA
+DTB,   CALL    1,FDV
+       ARG     TN
+DTA,   ISZ     CX
+       JMP     DTB
+       JMP I   DH
+AS3,   CLA             /PRINT ASTERISKS FOR WHOLE FIELD SIZE
+       TAD     N3      /GET FIELD SIZE, E OR F
+       CMA
+       DCA     CX      /-COUNT
+       JMP     QQ
+QQA,   TAD     (52     /PRINT CX ASTERISKS
+       JMS     PRINT
+QQ,    ISZ     CX      /INDEX COUNT
+       JMP     QQA
+       JMS     GLST    /TEST FOR MORE
+       JMP     PR2     /RETURN TO FORMAT PROCESSOR, SAME TYPE
+\f      PAGE            /EXPERIMENTAL
+IN,    TAD     N2      /INTEGER INPUT, GET WIDTH OF FIELD
+       CMA             /1,S COMP TO COUNTER, CR
+       DCA     CR
+       CMA
+VQ,    DCA     WHI     /-1 TO NUMBER ACCUMULATED
+       CMA             /-1 TO SIGN
+RRSIGN,        DCA     SN
+       DCA     SACH
+RRS,   ISZ     CR      /HAS WHOLE NUMBER BEEN ACCUMULATED
+       SKP
+       JMP     PRO
+       JMS     GCHR
+       CPAGE 14
+       JMS     CHTYPE  /CLASSIFY CHARACTER
+       DIGIT           /ITS A DIGIT
+       -40;    RRS
+       -53;    RRS
+       -55;    RRSIGN
+       0;      ERR2
+DIGIT, JMS     DGT     /ACCUMULATE DIGIT INTO SACH
+       JMP     RRS     /GET NEXT DIGIT
+PRO,   TAD     SACH    /WE HAVE AN INTEGER ...
+       ISZ     WHI     /WHAT KIND?
+       JMP     PRO2
+       ISZ     SN      / 'I' FORMAT
+       CIA
+       DCA I   ARGUMT
+
+IX,    CLA
+       JMS     GLST    /INTEGER CONVERSION
+II,    JMSKP   BB      /TEST MORE AND NON ZERO CURRENT LIST ITEM
+       JMP     IN      /INPUT
+       TAD     AB
+       DCA     SACL    /OUTPUT
+       TAD     (-4
+       DCA     WHI     /-4
+       DCA     SN      /0
+       TAD I   ARGUMT
+       SMA             /SET SN 0 FOR PLUS, 1 FOR MINUS
+       JMP     XZ      /PLACE MAGNITUDE IN 20
+       CIA
+       ISZ     SN
+XZ,    CALL    1,DIV
+       ARG     TW
+       DCA     SACH
+       CPAGE 4
+       CALL    0,IREM  /IREM NEEDS AN ARGUMENT TO IGNORE
+AB,    I1
+WHI,   0
+
+
+       DCA I   SACL    /SAVE REMAINDER
+       CMA
+       TAD     SACL    /SACL=SACL-1
+       DCA     SACL
+       ISZ     WHI     /INDEX COUNT
+       TAD     SACH    /AND CHECK NUM FOR 0
+       SZA
+       JMP     XZ      /CYCLE
+IB,    TAD     N2
+       DCA     N3      /IN CASE OF OVERFLOW
+       TAD     N2
+       CMA
+       TAD     WHI
+       TAD     (4      /COMPUTE NUMBER OF LEADING BLANKS
+       JMS     SA      /PRINT LEADING BLANKS AND SIGN
+ID,    INC     SACL    /POINT TO DIGIT TO PRINT NEXT
+       TAD I   SACL    /GET IT
+       SPA             /TERMINATOR?
+       JMP     IX      /YUP
+       TAD     (60
+       JMS     PRINT   /NOPE - PRINT THE DIGIT
+       JMP     ID      /GET NEXT
+
+DGT,   0
+       DCA     SACM
+       TAD     SACH
+       CLL RTL
+       TAD     SACH
+       RAL
+       TAD     SACM
+       DCA     SACH
+       JMP I   DGT
+
+       END
+\f