ASMB,R,L,C * * **************************************************************** * * (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 HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED FMTIO NAM FMTIO,7 24998-1X230 REV.2001 790417 SPC 2 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 SPC 2 * 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 SKIP FREE-FIELD & NULL ? SZA ISZ .IOR. YES. SKIP. SZA ISZ .IOR. LDA TEMP1 LOAD UP RESULT. LDB TEMP1+1 JMP .IOR.,I EXIT. 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 BFLAG = 1. STA BFLAG CLA SKIP = 0. STA SKIP 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 SKP WAITI NOP WAITS FOR INPUT LDB UNIT IGNORE SZB,RSS CALL IF JMP WAITI,I UNIT=0. JSB BCHEK BINARY OR ASCII? ARS BINARY--CONVERT TO WORD COUNT. CMA STORE AS NEGATIVE IN STA CCNT COUNTER. STA CMAX LDB .IBUF GET BUFFER ADDRESS JSB BCHEK BINARY ? JMP WTI3 YES RBL FOR ASCII SET BCR TO POINT TO WTI2 ADB MIN1 THE FIRST CHARACTER PRECEDING WTI4 STB BCR THE BUFFER. JMP WAITI,I WTI3 LDA CNTRL ALF,ALF SSA,RSS PAPER TAPE ? JMP WTI2 NO ISZ CCNT YES JMP WTI4 * INPUT ERROR * * WAITO NOP WAITS FOR OUTPUT TO BE COMPLETED LDA UNIT IGNORE CALL IF SZA,RSS UNIT=0. JMP WAITO,I LDA .OBUF SET UP BUFFER ADDRESS AND CCB LENGTH. ADB CLEN JSB BCHEK BINARY. JMP WTO6 RAL ADJUST BUFFER ADDRESS FOR ADA MIN1 CHARACTERS STA BCR STB CCNT STB CMAX JMP WAITO,I WTO6 BRS ADJUST LENGTH FOR WORDS. ADA MIN1 STA BCR STB CCNT (DON'T NEED CMAX FOR BINARY) LDA CNTRL ALF,ALF SSA,RSS TEST FOR PAPER TAPE. JMP WAITO,I NOT PAPER TAPE. ISZ CCNT IF PAPER TAPE, BUMP BUFFER ISZ BCR ADDRESS AND COUNTER. JMP WAITO,I RETURN SKP SETLU BSS 1 SZA,RSS IF LU = 0 THEN JMP SETLU,I RETURN JSB EXEC ELSE DEF *+3+1 TEST FOR PAPER TAPE AND CONFIGURE DEF ...13 THE CONTROL WORD DEF UNIT DEF STXXX LDA STXXX AND PAPER CPA .4000 CLA SZA CLA,RSS LDA PBIT IOR UNIT IOR BASIC JMP SETLU,I SKP IOCIN NOP INPUT CALL TO IOC INAGN JSB REIO DEF *+5 DEF ....1 DEF CNTRL .IBUF DEF BUFI DEF CLEN STA STATS SAVE STATUS FOR LATER STB TLOG SAVE TRANSMISSION LOG FOR LATER RAL TEST DOWN BIT SSA ARE WE OK? JMP INAGN NO GO TRY AGAIN AND O500 IS EOT OR EOF BITS SET? SZA,RSS JMP IOCI1 NO, CONTINUE JSB BCHEK CHECK IF BINARY OR ASCII RSS BINARY JMP ENDLS,I ASCII, EXIT LDB CLEN YES, DUMMY THE TLOG SSB -? CMB,INB YES, MAKE POSITIVE IOCI1 LDA B JMP IOCIN,I SPC 3 IOCOU NOP OUTPUT CALL TO IOC LDA CNTRL CLEAR BIT 7 AND =B177577 FOR OUTPUT REQUESTS STA CNTRO JSB REIO DEF *+5 DEF ....2 DEF CNTRO BUFOA DEF BUFO DEF OUTBL STA STATS STB TLOG SAVE STATUS AND TLOG JMP IOCOU,I OUTBL BSS 1 CNTRO BSS 1 SKP * ITLOG - GET LAST TRANSMISSION LOG. * ITLOG NOP ENTRY TO GET LAST TRANSMISSION LOG LDA TLOG GET LAST TRANSMITTION LOG LDB ITLOG GET RETURN ADDRESS STB ISTAT DUMMY UP ENTRY JMP ISTAT+2 SPC 4 * ISTAT - GET LAST STATUS WORD. * ISTAT NOP ENTRY TO GET LAST STATUS WORD LDA STATS GET LAST STATUS LDB ISTAT,I GET RETURN ADDRESS STB ITLOG SAVE TEMP ISZ ISTAT CHECK IF PARAMETER PASSED CPB ISTAT CLB,RSS SET DUMMY ADDRESS IN B-REG LDB ISTAT,I GET PARAMETER ADDRESS STA B,I RETURN PARAMETER JMP ITLOG,I RETURN SPC 1 STATS NOP LAST I/O STATUS WORD TLOG NOP LAST I/O TRANSMITTION LOG O500 EQU ASC2B SPC 4 * LGBUF - SUBSTITUTE USER BUFFER FOR FMTIO BUFFER. * LGBUF BSS 1 ISZ LGBUF LDA LGBUF FETCH THE BUFFER ADDRESS LGLP1 LDA A,I RAL,CLE,SLA,ERA TEST AND CLEAR INDIRECT BIT JMP LGLP1 TRY AGAIN STA BUFOA FIX THE ADDRESS POINTERS STA .IBUF STA .OBUF ISZ LGBUF LDA LGBUF,I FETCH THE BUFFER LENGTH LDA A,I ALS MAKE IT INTO A BYTE COUNT CMA,INA STA ASCRY STA BINRY ISZ LGBUF JMP LGBUF,I HED ERROR PROCESSING. * PRINT ON LU "FMT.E" THE FORMAT ERROR IN THE FORM: * " /PROGM: FMT ERR 3 @12345B" * (WITHOUT QUOTES) THIS EXAMPLE HAS ERROR #3 FROM THE FORMAT AT * ADDRESS 12345 OCTAL, AND THE CALLING PROGRAM IS NAMED "PROGM". SPC 1 ERROR LDA UNIT INHIBIT ERRORS WHEN SZA,RSS INTERNAL CONVERSION JMP ENDLS,I LDA SWITH GET ERROR NUMBER ADA "^0" CONVERT TO ASCII " 0" STA MESSS+8 FIRST WORD OF ERROR CODE LDA FMTAD GET FORMAT ADDRESS LDB DFADS GET ADDRESS OF MEM BUFFER RAL,CLE,SLA POSITION MEM ADDRESS & SKIP AGAIN LDA IOCOU GET NEXT OCT DIGIT ALF,RAR ROTATE LEFT 3 STA IOCOU SAVE FOR NEXT PASS AND ....7 MASK DOWN TO DIGIT IOR "0" MIRGE IN TO ASCII SEZ,RSS SKIP IF LO-CHAR IN WORD ALF,SLA,ALF POSITION TO HI-HALF IOR B,I MIRGE IN HI-HALF STA B,I AND PUT IN WORD SEZ,CME BUMP WORD TO NEXT WORD? INB YES, DONE WITH BOTH CHARS CPB DFEND DONE WITH 5 CHARS? SEZ,RSS YES JMP AGAIN NO, FINISH CONVERSION IOR "B" LAST CHAR IS "B" STA B,I AND PUT IN LAST WORD JSB PNAME COPY PROGRAM NAME DEF *+2 DEF MESSS+1 LDA MESSS+3 CHANGE 6TH CHAR TO ":" ADA SPCOL STA MESSS+3 3RD WORD OF NAME JSB REIO DEF *+5 DEF ....2 DEF FMT.E DEF MESSS DEF ...13 JMP ENDLS,I SPC 1 DFADS DEF MESSS+10 DFEND DEF MESSS+12 SUP MESSS ASC 13, /PROGS: FMT ERR 4 @12345B UNS LITERALS, IF ANY: END