/ 10.A IOH SUBROUTINE OS8 FORTRAN II LIBRARY / / 25-SEP-78 W. HOUBEN / / COPYRIGHT 1978, DIGICOS SOFTWARE DEVELOPMENT GROUP / / 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 TADI 7 /PICK UP DEVICE NUMBER AND (17 /TAKE IT MOD 16(10) 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,]CLR 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,]PUT 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 TAD DV CALL 0,]GET AND (177 /STRIP PARITY TAD (7763 SNA /CARRIAGE RETURN? JMP BH TAD (7655 CLL TAD (100 /IS CHAR IN RANGE 237