ASMB,R,L,C,Z ** ASSEMBLE FOR DS/1000 USAGE ** IFN # HED FMTIO NAM FMTIO,7 24998-16002 REV.1913 790129 XIF # IFZ # HED DS/1000 I/O AND CONTROL FOR FRMTR *(C) HEWLETT-PACKARD CO. 1979* NAM RMTIO,7 91740-16037 REV 1913 790129 XIF # UNL # IFZ # LST # * *************************************************************** # * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * # * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * # * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* # * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * # * *************************************************************** # * # * NAME: FMTIO ('N' ASSEMBLY OPTION) RMTIO ('Z' ASSEMBLY OPTION) # * SOURCE: 24998-18002 24998-18002 # * RELOC: 24998-16002 91740-16037 # * PGMR: D.L.B./E.A.S./B.G. C.C.H. (01-29-79) # * # * ** SEE ENTRY POINT 'DNODE' FOR DS/1000 MODIFICATIONS 1-16-79 (CH) ** # UNL # XIF # LST # * * THE FOLLOWING MODIFICATIONS HAVE BEEN MADE AS OF 042277: * THE CARD READER BUG (REPORT 3668) HAS BEEN CORRECTED. * ADDITIONS WERE INCLUDED TO ALLOW THE USER TO DECLARE HIS OWN * LARGE BUFFERS FOR USE BY THE FORMATTER. * THIS IS DONE BY CALLING LGBUF(ARRAY,LENGTH). (EAS) * BUG FIX 092677: FAILURE TO RESTORE B AFTER EXEC CALL IN .DIO. * CAUSED "SZB,RSS / JSB WAITO" TO FAIL (EXEC CALL IN SETLU). * THIS CAUSED FAILURE ON DOS AND WOULD HAVE FOR RTE-LC. (EAS). * THE FOLLOWING MODIFICATION WAS MADE AS OF 022778: * THE PROGRAM NAME IS FETCHED VIA "PNAME" SO THAT RTE-IV * TYPE 4 PROGRAMS WORK. (BG) SPC 2 IFZ # ENT DNODE # EXT D65MS,#NODE # XIF # ENT .IOI.,.IOJ.,.IOR. ENT .IIO.,.JIO.,.RIO.,.XIO.,.TIO. ENT .IAR.,.JAR.,.RAR.,.XAR.,.TAR. ENT .IAY.,.JAY.,.RAY.,.XAY.,.TAY. ENT .DIO.,.BIO.,.DTA. ENT NEWIO,OLDIO,CODE,ACODE,ITLOG,ISTAT,LGBUF EXT .FRMN,.LS2F,.INPN,.DTAN,FMT.E EXT PNAME,REIO,EXEC,.SBT * A EQU 0 B EQU 1 SKP * SPECIAL ENTRY POINTS: * ************************************************************************ * ASSEMBLY FORTRAN (IV) * * JSB CODE CALL CODE(ICHRS) * DEF *+2 READ (IBUF,*) A,B,C * DEF ICHRS * LDA IBUFR(,I) * CLB(,INB) * JSB .DIO. * DEF FORMT * DEF ENDLS * * WHERE: * IBUFR = THE IN MEMORY BUFFER TO CONVERT TO BINARY * ICHRS = THE NUMBER OF ASCII CHARACTERS IN " IBUFR " * * NOTES: * THE ENTRY POINT " CODE " IS NOW IN THE FORMATTER WHICH * ALLOWS THE OPTIONAL PARAMETTER " ICHRS " TO BE PASSED * TO LIMIT THE SIZE OF THE BUFFER THAT THE FORMATTER WILL * READ. IF " IBUFR " IS NOT PASSED, THEN THE FORMATTER WILL * SEARCH ALL OF MEMORY, IF NECESSARY, TO SATISFY THE VARIABLE * LIST. (A,B,C) SKP * JSB ITLOG ICHRS = ITLOG(IXXXX) * DEF *+1 * STA ICHRS * WHERE: * ICHRS = THE NUMBER OF CHARACTORS READ OR WRITTEN BY THE FORMATTER * BY ITS LAST INPUT/OUTPUT REQUEST TO THE SYSTEM. " ICHRS " VALUE * WILL BE 0 TO 134 (120 OF BINARY) REGARDLESS OF THE SPECIFIED * BUFFER SIZE IN THE READ OR WRITE STATEMENT. * IXXXX = THE SAME AS " ICHRS " *********************************************************************** * JSB ISTAT ISTUS = ISTAT(IXXXX) * DEF *+1 * STA ISTUS * WHERE: * ISTUS = THE STATUS WORD RETURNED FROM THE EXEC IN THE LAST * INPUT/OUTPUT CALL THE FORMATTER DID. * IXXXX = SAME AS " ISTUS " ************************************************************************ * JSB LGBUF CALL LGBUF(IBUFF,LENTH) * DEF *+3 * DEF IBUFF * DEF LENTH * WHERE: * IBUFF = ADDRESS OF A USER BUFFER. * LENTH = LENGTH OF BUFFER, IN WORDS. THIS BECOMES THE NEW MAXIMUM * RECORD LENGTH. *********************************************************************** * FORTRAN EXAMPLES. *** * CALL EXEC (1,401B,IBUFR,-80) * CALL ABREG(IA,ICHRS) * CALL CODE(ICHRS) * READ(IBUFR,*) A,B,C,D *** * 5 READ (1,10) (IBUF(I),I=1,36) * 10 FORMAT (36A2) * IF (ITLOG(ICHRS)) 20,5,20 * 20 ISTRC = 1 * CALL NAMR(IPBUF,IBUF,ICHRS,ISTRC) * * NOTE: ICHRS CAN BE AS LARGE AS 134 IF 134 CHARACTERS ARE INPUT. *** * READ (8,10) (IBUF(I),I=1,80) * 10 FORMAT (40A2) * IF (IAND(ISTAT(ISTUS),240B)) 99,20,99 * 20 CONTINUE * --- * 99 CONTINUE (END OF FILE OR END TAPE DETECTED) *** * DIMENSION IBUFF(1000) * --- * CALL LGBUF(IBUFF,1000) * READ(8,10) (ARRAY(I),I=1,2000) * 10 FORMAT(2000A1) HED COMMUNICATION WITH FRMTR. * FOLLOWING LOCATIONS REFERENCED IN FRMTR: * ADX BSS 1 ADDRESS VARIABLE. TYPE BSS 1 TYPE LENTH BSS 1 LENGTH (IN WORDS) SKIP BSS 1 FLAG TO SKIP STORE IN .IOI./.IOJ./.IOR. FCR BSS 1 POINTS TO CHARACTER IN FORMAT CCNT BSS 1 COUNTS WORDS/CHARS IN BUFFER CMAX BSS 1 MAX VALUE OF CCNT AT TAB LEFT. BCR BSS 1 IO BSS 1 FLAG...=0 FOR OUTPUT, 1 FOR IN SKIPL BSS 1 FLAG TO AVOID SPURIOUS RTN TO LIST. TSCAL BSS 1 SCALE BSS 1 SCALE FACTOR NEST BSS 1 PAREN LVLS. INIT -6, -5 IN FMT, * -4 TO -1 FOR NESTING. CFLAG BSS 1 BCRS BSS 1 USED FOR REMEMBERING BCR F2LSI BSS 1 SWITH BSS 1 RNEST BSS 1 NEST VALUE OF UNLIMITED GROUPS. ADRFD DEF RFSV USED FOR INDEXING IN RFLD. RF BSS 1 FORMAT REPEAT FIELD COUNTER WSAVE BSS 1 HOLDS INITIAL W FOR REPEATS DSAVE BSS 1 HOLDS INITIAL D FOR REPEATS GFLAG BSS 1 = -1 IF G FIELD, +1 OTHERWISE. .OBUF DEF BUFO EORD BSS 1 ALSO DTAI & ATMP. OFLAG DEC 0 =0,-1 FOR ASA/OLD FORMATS. HED CONSTANTS & LOCALS. * CONSTANTS. * CNTRL BSS 1 MIN6 DEC -6 MIN2 DEC -2 MIN1 DEC -1 ....1 DEC 1 ....2 DEC 2 ....3 DEC 3 ....7 DEC 7 ...13 DEC 13 PAPER OCT 34000 TEST FOR PAPER TAPE. O76K OCT 76000 O2000 OCT 2000 PBIT OCT 200 SET BIT FOR IOC. BASIC OCT 400 .4000 OCT 4000 CHECK FOR TYPE CODE = 1X ASC2B OCT 500 SPCOL ABS 72B-40B ":" - " " "B" OCT 102 "^0" BYT 40,60 " 0" "0" OCT 60 BLANK OCT 40 MXPS OCT 77777 MAX POS # DMXPS DEF MXPS * * LOCALS. * FMTAD BSS 1 ADDR FORMAT TEMP1 BSS 2 TEMPORARY TEMP2 BSS 1 STORAGE RFLD BSS 5 REPEAT FIELD FOR GROUPS. RFSV BSS 5 INITIAL VALUE OF R-FIELD. LPRN BSS 5 ADDRESS OF LEFT PAREN'S IN GROUP UNIT OCT 1 INPUT/OUTPUT UNIT ENDLS BSS 1 POINTS TO ENDOF CALLING SEQUENCE ALNTH BSS 1 AND .IAR. BFLAG BSS 1 =1 FOR BINARY I/O, 0 FOR DECIMAL STXXX NOP BUFBN EQU 60 BUFLN EQU 67 BUFI BSS BUFLN BUFO EQU BUFI BINRY ABS -BUFBN-BUFBN BINARY RECORD LENGTH ASCRY ABS -BUFLN-BUFLN FORMATTED RECORD LENGTH CLEN ABS -BUFLN-BUFLN HED ROUTINES TO PASS LIST ITEMS. ******************************************************************** * THIS SET OF ROUTINES IS USED TO PASS THE ADDRESS, TYPE AND * * LENGTH (IF ARRAY). FOR EACH VARIABLE OR ARRAY OF TYPE: * * INTEGER (I), DOUBLE INTEGER (J), REAL/2-WD FLOATING (R), * * EXTENDED PRECISION/3-WD FLOATING (X) OR DOUBLE PRECISION/4-WD * * FLOATING (T), THERE IS A SINGLE CALL TO ONE OF THE FOLLOWING: * * .IOZ., Z=I,J,R; .ZIO./.ZAR./.ZAY., Z=I,J,R,X,T. * * THERE IS INITIALLY A SINGLE CALL TO EITHER .DIO. OR .BIO. . * ******************************************************************** SPC 3 IOCHK NOP A SWITCH ON THE VALUE OF IO. RE- STB TEMP2 SAVE B LDB IO TURN TO P+1 FOR OUTPUT, P+2 FOR SZB INPUT. ISZ IOCHK LDB TEMP2 RESTORE B JMP IOCHK,I SPC 3 BCHEK NOP RETURNS TO P+1 IF BINARY, ELSE 2 STB TEMP2 LDB BFLAG SZB,RSS ISZ BCHEK LDB TEMP2 JMP BCHEK,I SPC 2 * ROUTINE TO INITIALIZE .ZIO. / .ZAR. / .ZAY. * CTYPE NOP ADB MIN2 ACTUAL ENTRY POINT ADDR. LDA B,I COPY ENTRY POINT. STA .TIO. CMB COMPUTE OFFSET FROM FIRST ONE. ADB CTYPE,I CMB BRS TYPE = OFFSET / 2 STB TYPE SZB TYPE = 0 CPB ....1 OR 1 ? INB YES, LENTH IS ONE LARGER (ELSE EQUAL) STB LENTH ISZ CTYPE EXIT JMP CTYPE,I SKP * .IOI. / .IOJ. / .IOR. * * CALLING SEQUENCE: * * * JSB ROUTINE * SPC 2 .IOI. NOP STORE ARG & CALL .IIO. STA TEMP1 JSB .IIO. DEF TEMP1 LDA TEMP1 LDB SKIP IF FREE-FIELD & NULL, SKIP STORE. SZB ISZ .IOI. JMP .IOI.,I * .IOJ. NOP STORE ARG & CALL .JIO. STA TEMP1 STB TEMP1+1 JSB .JIO. DEF TEMP1 LDA .IOJ. SAVE A LITTLE SPACE HERE. STA .IOR. JMP IOR1 * .IOR. NOP STORE ARG & CALL .RIO. STA TEMP1 STB TEMP1+1 JSB .RIO. DEF TEMP1 IOR1 LDA TEMP1 LDB TEMP1+1 ISZ SKIP IF FREE-FIELD & NULL, SKIP STORE. JMP .IOR.,I ISZ .IOR. ISZ .IOR. JMP .IOR.,I SKP * .IIO. / .JIO. / .RIO. / .XIO. / .TIO. * * CALLING SEQUENCE: * * JSB ROUTINE * DEF SPC 2 .IIO. NOP JSB TIO .JIO. NOP JSB TIO .RIO. NOP JSB TIO .XIO. NOP JSB TIO .TIO. NOP JSB TIO SPC 1 TIO NOP LDB TIO COMPUTE TYPE, LENTH. JSB CTYPE DEF .IIO. LDB A,I B = BASE ADDR. ISZ .TIO. CLA,INA A = # ELEMENTS = 1. JMP TAY1 SKP * .IAR./.JAR./.RAR./.XAR./.TAR. .IAY./.JAY./.RAY./.XAY./.TAY. * * CALLING SEQUENCES: * * LDA <# ELEMENTS> JSB ROUTINE * LDB DEF * JSB ROUTINE DEC <# ELEMENTS> * * INDIRECTION IS ALLOWED ON BOTH VALUES (THE # OF ELEMENTS * IS TREATED AS AN ADDRESS). SPC 3 .IAR. NOP JSB TAR .JAR. NOP JSB TAR .RAR. NOP JSB TAR .XAR. NOP JSB TAR .TAR. NOP JSB TAR * TAR NOP STB ADX SAVE A,B. STA ALNTH LDB TAR SET TYPE, LENTH. JSB CTYPE DEF .IAR. LDB ADX B = BASE ADDR. LDA ALNTH A = # ELEMENTS. JMP TAY1 SPC 2 .IAY. NOP JSB TAY .JAY. NOP JSB TAY .RAY. NOP JSB TAY .XAY. NOP JSB TAY .TAY. NOP JSB TAY * TAY NOP LDB TAY SET TYPE, LENTH. JSB CTYPE DEF .IAY. LDB A,I B = BASE ADDR. ISZ .TIO. LDA .TIO.,I A = # ELEMENTS. ISZ .TIO. JMP TAY1 SKP * AT THIS POINT: TYPE, LENTH & RETURN ADDR ARE * SET UP, AND: B=BASE ADDR, A=# ELEMENTS. SPC 2 LDB B,I REMOVE INDIRECTS FROM BASE ADDR. TAY1 RBL,CLE,SLB,ERB JMP *-2 STB ADX JMP *+2 REMOVE "INDIRECTS" ON LENGTH LDA A,I RAL,CLE,SLA,ERA JMP *-2 JSB BCHEK BINARY ? JMP TAY3 YES. CMA,INA,SZA,RSS - # ELEMENTS. JMP .TIO.,I IF NONE. STA ALNTH TAY2 JSB LST2J GO CONVERT. LDA ADX BUMP TO NEXT ELEMENT. ADA LENTH STA ADX ISZ ALNTH DONE ? JMP TAY2 NO, DO ANOTHER. JMP .TIO.,I YES, EXIT. * * BINARY ARRAY I/O. * TAY3 MPY LENTH A = TOTAL LENGTH. CMA,INA,SZA,RSS SET UP COUNT. JMP .TIO.,I IF ZERO. STA ALNTH TAY4 ISZ CCNT TEST FOR END OF BUFFER. JMP TAY5 NO. JSB DTA YES, DO I/O. JMP TAY4 AND TRY AGAIN. TAY5 ISZ BCR BUMP BUFFER POINTER. LDA ADX,I FOR OUTPUT. JSB IOCHK WHICH ? STA BCR,I OUTPUT. LDA BCR,I INPUT. JSB IOCHK WHICH ? JMP *+2 OUTPUT - DONE. STA ADX,I INPUT - STORE IN VARIABLE. ISZ ADX TO NEXT ELEMENT. ISZ ALNTH DONE ? JMP TAY4 NO, DO AGAIN. JMP .TIO.,I EXIT. HED CODE - ENCODE/DECODE. * THE FOLLOWING CODE WAS ADDED FOR THE "CALL CODE" PROBLEM * CALLING: * JSB CODE JSB CODE * DEF *+1 DEF *+2 * LDA IBUFR(,I) DEF TLOG +CHARS * CLB(,INB) - OR - LDA IBUFR(,I) * JSB .DIO. CLB(,INB) * DEF FORMT JSB .DIO. * DEF ENDLS DEF FORMT * ETC. DEF ENDLS * ETC. ****************************************** CODE NOP SPECIAL ENTRY FOR INTERNAL CONVERSION ACODE EQU CODE DO THE ALGOL THING ******************************************* LDB CODE,I GET RETURN ADDRESS + LDA BUFFR(,I) ISZ CODE BUMP TO FIND OUT IF TLOG LDA CODE,I GET POSSIBLE PRAM ADDRESS CPB CODE CHECK IF PASSED PARM LDA DMXPS NO, GET DEF MAX POS #. LDA A,I GET TLOG IN CHARS OR MAX POS #. CMA MAKE -TLOG-1 OR MAX NEG #. STA CCNT SAVE AS BUFFER LEN STA CMAX STB BFLAG SAVE RETURN ADDRESS LDA B,I LOAD: "LDA IBUFR(,I)". AND O2000 MASK TO FIND IF CLE,SZA CURRENT OF BASE PAGE? LDA B CURRENT, GET PAGE BITS XOR B,I LOAD IF BASE, MIRGE IF CURRENT AND O76K MASK OFF PAGE IF BASE, XOR B,I MIRGE IN IF CURRENT RSS NOW TRACK DOWN ANY LDA A,I INDIRECT ADDRESSES RAL,CLE,SLA,ERA INDIRECT? JMP *-2 YES, DO IT AGAIN RAL DOUBLE IT AND ADA MIN1 SUBTRACT ONE STA BCR SAVE THE BUFFER ADDRESS ADB ....3 POINT TO THE P+1 OF JSB .DIO. STB CODE SAVE IN CONVENENT PLACE JMP BFLAG,I RETURN TO EXECUTE LDA IBUFF,CLB,JSB .DIO. HED .DIO. & .BIO. - INITIALIZATION. *************************** .DIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR FORMATTED INPUT/ *************************** OUTPUT. STA UNIT STB IO LDA .DIO. CHECK IF CALL CODE BEFORE CPA CODE MUST BE SAME JMP INTCN YES, CALL CODE CONVERSION LDA UNIT SET FUNCTION BITS JSB SETLU STA CNTRL LDA UNIT NO, PROCESS AS BEFORE CCE,SZA CHECK FOR UNIT=0. (E=1) JMP DIO1 NO-IO TRANSFER. ERA INTERNAL CONVERSION. (A=MAX NEG #) STA CCNT SET CCNT = MAX NEG #. STA CMAX LDB .DIO.,I B = BUFFER ADDR. LDA B,I VERIFY ABOVE FENCE. STA B,I RBL FORM BYTE ADDR - 1: BCR. ADB MIN1 STB BCR ISZ .DIO. INTCN CLA,RSS CALL CODE INTERNAL CONVERSION DIO1 CLA,RSS STA UNIT STA BFLAG STA SKIP STA SKIPL STA TSCAL INITIAL SCALE FACTOR = 0 STA SCALE CLEAR SCALE FACTOR FOR FREE INPT STA SWITH LDA ASCRY STA CLEN RECORD SIZE LDA MIN6 STA NEST OUTSIDE LEVEL 0 PARENS. CCA STA CFLAG FREE-FIELD COMMAS. SKP * COPY FORMAT AND END-OF-LIST ADDRESSES. * LDA .DIO. GET FORMAT ADDRESS LDA A,I GET DOWN TO NEXT LEVEL RAL,CLE,SLA,ERA TEST FOR INDIRECT (1 LEVEL) JMP *-2 SEARCH FOR EVER IF NEED BE STA FMTAD SAVE FORMAT ADDRESS LDB A,I VERIFY ABOVE FENCE. STB A,I RAL CONVERT TO A CHARACTER CMA,INA,SZA ADDRESS CMA STA FCR ISZ .DIO. GET THE END-OF LIST LDA .DIO.,I ADDRESS STA ENDLS LDB A,I VERIFY ABOVE FENCE. STB A,I * * IF FORMATTED OUTPUT, WAIT FOR PREV. OUTPUT & GO. * IF INPUT, READ RECORD. IF FORMATTED, GO. * ISZ .DIO. SET UP LDA .DIO. THE RETURN STA LST2J ADDRESS JSB IOCHK IF OUTPUT, JSB WAITO WAIT. JSB IOCHK JMP FORMT GO. JSB DTA INPUT. READ A RECORD. LDA FCR FORMATTED ? SZA JMP FORMT YES, GO. * * FREE-FIELD INPUT. * NXTON JSB F2LST LIST DEFINITION IOTST LDB UNIT CHECK IF INTERNAL CONVERSION LDA CCNT IF CCNT = 0, SZA CHECK IF SLASH WAS ENCOUNTERED JMP NSLSH NO SZB,RSS SLASH, BUT INTERNAL CONVERSION? JMP ENDLS,I YES RETURN, UNSATISFYING LIST JSB DTA SO READ NEXT RECORD NSLSH JSB .INPN ENTER FRMTR TO CONVERT DATA DEF ADX LDA SWITH CPA ....7 IF SWITH = 7, GO TO END OF LIST JMP ENDLS,I SZA JMP NXTON STORE ELEMENT JMP IOTST MUST BE SLASH SKP *************************** .BIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR NON-FORMATTED *************************** INPUT/OUTPUT STA UNIT STB IO JSB SETLU CONFIGURE THE LU CONTROL WORD XOR ASC2B MAKE IT BINARY STA CNTRL AND PUT IT AWAY CLA,INA STA BFLAG LDA BINRY STA CLEN RECORD SIZE LDB IO TEST FOR I/O DIRECTION SZB JMP BIO1 IF INPUT. JSB WAITO OUTPUT, WAIT. JMP .BIO.,I BIO1 JSB DTA INPUT, READ. JMP .BIO.,I SPC 3 *************************** SET NEW FORMAT DEFS. NEWIO NOP * CALLING SEQUENCE: * JSB NEWIO *************************** DEF *+1 CLA STA OFLAG ISZ NEWIO JMP NEWIO,I SPC 3 *************************** SET OLD FORMAT DEFS. OLDIO NOP * CALLING SEQUENCE: * JSB OLDIO *************************** DEF *+1 CCA STA OFLAG ISZ OLDIO JMP OLDIO,I HED LINKAGE TO "FRMTR". * MAIN LOOP. CALL FRMTR & ACCEPT REQUESTS: * SWITH<6: PRODUCE ERROR MSG & QUIT. * SWITH=6: GET A LIST ITEM. * SWITH=8: DO I/O. * FORMT JSB .FRMN ENTER FRMTR TO PROCESS LIST DEF ADX TSTSW LDA MIN6 ADA SWITH SSA JMP ERROR SWITCH < 6 = ERROR. SZA,RSS JMP NRML SWITCH=6=F2LST JSB DTA SWITCH=8 JSB .DTAN ENTER FRMTR AFTER DATA I/O DEF ADX JMP TSTSW NRML JSB F2LST JSB .LS2F CONTINUE LIST PROCESS DEF ADX JMP TSTSW SPC 3 * COROUTINE MECHANISM FOR LIST ITEMS: * THE CONVERSION ROUTINES IN FRMTR AND THE LIST-ITEM * HANDLERS IN FMTIO ACT AS COROUTINES. THE LINKAGE IS * PERFORMED BY LST2J AND F2LST. WHEN FRMTR IS READY * FOR A LIST ITEM, IT RETURNS TO THE FREE-FIELD OR * FORMATTED LOOP IN FMTIO, WHICH CALLS F2LST. * F2LST RETURNS THRU LST2J TO THE PREVIOUSLY CALLED * ITEM HANDLER, WHICH RETURNS TO THE CALLER. THE * CALLER CALLS ANOTHER ITEM HANDLER, WHICH CALLS LST2J * (SAVING ITS RETURN POINT). LST2J RETURNS THRU F2LST * TO THE CONVERSION LOOP, WHICH "RETURNS" TO FRMTR BY * CALLING THE APPROPRIATE ENTRY POINT. * SINCE FORMATTED I/O CALLS FRMTR FIRST, FORMATTED * I/O IS DRIVEN BY THE FORMAT. SINCE FREE-FIELD * I/O RETURNS FOR A LIST ITEM FIRST, FREE-FIELD * INPUT IS DRIVEN THE THE LIST. SPC 1 LST2J NOP LDA ADX,I VERIFY DATA ABOVE FENCE. STA ADX,I JMP F2LST,I SPC 1 F2LST NOP LDA BCR STA BCRS ISZ SKIPL PROCESSING FINAL RIGHT PAREN ? JMP LST2J,I NO, RETURN TO .IOI. & FRIENDS. JMP F2LST,I YES, RETURN TO FORMAT PROCESSOR. HED I/O ROUTINES. DTA NOP PERFORMS A COMPLETE I/O OPERA- JSB .DTA. TION. JSB IOCHK JMP *+3 JSB WAITI INPUT WAIT JMP DTA,I JSB WAITO OUTPUT WAIT JMP DTA,I SPC 2 .DTA. NOP LDA UNIT SET UP STATUS CONTROL SZA,RSS IF UNIT=0, JMP .DTA.,I IGNORE CALL. JSB IOCHK NOW TEST FOR INPUT OR OUTPUT. JMP DTAO * INPUT SECTION * JSB IOCIN PERFORM IOC CALL. JMP .DTA.,I RETURN * OUTPUT SECTION * DTAO LDB CCNT GET NUMBER OF CHARACTERS/WORDS. JSB BCHEK BINARY ? JMP DTAO2 YES. CMB,CLE,INB -CCNT ADB CMAX CMAX-CCNT (E=0 IFF B<0) LDB CCNT NORMALLY USE CCNT. SEZ CMAX > CCNT ? LDB CMAX YES, USE IT. CMB # CHARS UNUSED. ADB CLEN CHAR COUNT. STB OUTBL STORE AS # OF CHARS. OUTPUT. CMB,SLB,INB B=# CHARS. EVEN ? JMP DTAO1 YES, IS O.K. ADB BUFOA NO. FORM ADDR CHAR AFTER LAST. ADB BUFOA LDA BLANK STORE A BLANK AFTER LAST CHAR. JSB .SBT DTAO1 JSB IOCOU PERFORM IOC CALL JMP .DTA.,I RETURN DTAO2 SZB BINARY RECORD CONTINUATION ? CMB NO. B = # WORDS NOT USED. BLS B = # CHARS NOT USED. ADB CLEN B = -(# CHARS USED) STB OUTBL CMB,INB B = REC LENGTH BLF,BLF POSITION AS HIGH CHARACTER RBR IN WORDS. LDA CNTRL ALF,ALF ROTATE P-BIT TO SIGN SSA IF NOT ZERO, STORE AS STB .IBUF,I FIRST CHARACTER IN BUFFER. JMP DTAO1