X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape3%2FIOH.SB;fp=sw%2Fos8%2Fv3d%2Fsources%2Fsystem%2Fdectapes%2Fdectape3%2FIOH.SB;h=b7f452879add0f362de473e8da6708e52dd8e010;hb=7af5ad59491ddf2066641aef1e0025a337c0f247;hp=0000000000000000000000000000000000000000;hpb=919757fd611e482003ce51f366f6783cab73dea3;p=pdp8.git 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 index 0000000..b7f4528 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape3/IOH.SB @@ -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. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + / 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 + 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