File: IOH.SB of Tape: Sources/Fortran/os8-f4-5
(Source file text)
/IOH SUBROUTINE OS8 FORTRAN II LIBRARY / / / / / / / / / /COPYRIGHT (C) 1974,1977, 1980 / BY DIGITAL EQUIPMENT CORPORATION / AND BY DATAPLAN GMBH, LAUDA, BRD / / / / / / / / / /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. / / / / / / / / / / / VERSION 40A / JULY 3, 1980 / 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 40 /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 40 /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 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 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 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 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 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 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 40 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 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 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