SEARCH FORPRM TV FORFMT FORMAT PROCESSOR,6(2033) ;COPYRIGHT (C) 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. COMMENT \ ***** Begin Revision History ***** 1100 JLC New 1164 CKS 27-Oct-80 Prevent TL from going off left end of record 1207 JLC 19-Dec-80 Prevent %%GETIO from substituting REAL for COMPLEX for list-directed I/O 1215 JLC 6-Jan-81 SFDEL was dropping off the end into dollar format. Inserted a POPJ. Edit revhist actually inserted 9-Feb-81, was lost. 1230 JLC 20-Jan-81 Increased size of repeat count to 9 bits, decreased size of exponent field to 3 bits. 1306 DAW 26-Feb-81 New arg list format from %SAVE 1321 DAW 6-Mar-81 More changes for extended addressing support. 1324 EDS 9-Mar-81 Q20-01396 Add an encoding address for DOLLAR ($) and COLON (:) format so that ($10A5) is not treated as ($10,A5). These should use the same encoding as SLASH (/) format. 1334 DAW 12-Mar-81 Use new macros $BLDBP, $LODBP, $STRBP to clean up the code. 1416 JLC 10-Apr-81 Q format must use IRBUF. 1464 DAW 12-May-81 Error messages. 1467 CKS 18-May-81 Change EXTADD to I.EXT, change TITLE to FORFMT to correspond to file name 1473 CKS 21-May-81 Error message fixes. 1521 JLC 26-Jun-81 Fix formatted EOF processing: in input loop, check if pending EOF. If so, toss rest of I/O list. 1532 DAW 14-Jul-81 OPEN rewrite: Base level 1 1535 JLC 14-Jul-81 Remove EOF handling from here, now handled in %DOIO. 1552 DMN 21-Jul-81 Performance enhancements. 1562 DMN 28-Jul-81 Performance enhancements. 1566 JLC 29-Jul-81 Add error diagnostics for digits with no formats, any repeat count for $,/,Q, etc. 1575 JLC 05-Aug-81 Edit 1566 was too all-inclusive, made repeat count of left paren break. Fix by making left paren not a delimiter, then check in left paren routine for previous format. 1600 DAW 11-Aug-81 Allow "X" to mean "1X" (as it used to!) 1605 JLC 12-Aug-81 Fix ambiguous (A419X) to be error. Fix T to be a delimiter. 1615 DAW 19-Aug-81 Get rid of two word BP option. 1622 JLC 21-Aug-81 Fix Q format encoding, was accumulating digits after it. Fix no-comma syntax, compile prev format if leftover format char. 1625 DAW 21-Aug-81 Get rid of "DF". 1705 JLC 11-Sep-81 Fixed serious T-format bug. Now send %SPOS position desired for next character (minimum 1) so that ORVIR in %OBYTE will never have zero for a positioning command. 1730 JLC 18-Sep-81 Another bug fix for T-format. Sped up format encoding by eliminating FMTSS and using a local stack instead. 1775 JLC 9-Oct-81 Fix X format. Was being truncated to 8 bits. 2033 JLC 15-Nov-81 Make "Data in IO list but not in format" go to %ABORT. Fix A free format. ***** End Revision History ***** \ ENTRY %FORMT EXTERN %OBYTE,%GETIO,%IBYTE,%IBYTC,%IREC,%ORECS,%RPOS,%SPOS EXTERN %ALPHI,%ALPHO,%DIRT,%DOUBT,%ERIN,%EOUT,%FLIRT,%FLOUT EXTERN %LINT,%LOUT,%GRIN,%GROUT,%INTI,%INTO,%RIGHI,%RIGHO EXTERN %GLINT,%GLOUT,%GINTI,%GINTO,%GOCTI,%GOCTO EXTERN %OCTI,%OCTO,%HEXI,%HEXO,%SIZTB EXTERN %GTBLK,%FREBL,%SAVE4,%IBACK,%OVNUM EXTERN %ABORT,%POPJ,%POPJ1 EXTERN FMT.LS EXTERN A.FMT,T.FMT,A.FMS EXTERN I.EXT INTERN %FMTSV,%FMTCL INTERN SCL.SV,USR.AD,USR.TY,USR.SZ,ENC.WD INTERN W.PNTR,D.PNTR,X.PNTR INTERN FMT.BG,FMT.BP,FMT.SZ ;ENCODED FORMAT BLOCK PARAMS %FMTNX==0 ;NEXT ENCODED FORMAT ADDR %FMTAD==1 ;ACTUAL ADDR OF FORMAT STATEMENT %FMTRP==2 ;INDEFINITE REPEAT PNTR %FMTEN==3 ;FIRST WORD OF ENCODED FORMAT TP%LBL==7 DATFLG==1,,0 ;DATA READ OR WRITTEN FDFLG==2,,0 ;FORMAT DELIMITER REGFLG==4,,0 ;REGISTER FORMAT CHARACTER IGNFLG==10,,0 ;IGNORE CHARACTER IOLFLG==20,,0 ;I/O LIST ENTRY NEEDED SKPFLG==40,,0 ;SKIP TO DELIM AFTER SCAN DRFLG==FDFLG+REGFLG ;DELIMITER+REGISTER DRIFLG==DRFLG+IOLFLG ;DELIMITER+REGISTER+I/O LIST ENTRY DTIFLG==DATFLG+REGFLG+IOLFLG ;DATA+REGISTER+I/O LIST ENTRY DTISFL==DTIFLG+SKPFLG ;DATA+REGISTER+I/O LIST ENTRY+CALL SFDEL SEGMENT DATA ;DDB BLOCK VARIABLES - USED DURING EXECUTION FMT.LK: 0 ;PNTR TO ENCODED LEFT PAREN (RH=LINK TO AFTER LOOP) SCL.SV: 0 ;SCALE FACTOR ENC.AD: 0 ;ADDRESS OF CURRENT ENCODED FORMAT ENC.PT: 0 ;FORMAT STACK POINTER ENC.RP: 0 ;LOOP EXECUTION REPEAT COUNT ENC.LR: 0 ;LOCAL REPEAT COUNT ;LOCAL VARIABLES - USED BY THE FORMAT ENCODER AND/OR AS TEMPS ;BY THE FORMAT EXECUTION SAV.EF: 0 ;ADDR OF LOC TO SAVE ADDR OF ENCODED FORMAT RPT.PT: 0 ;INDEFINITE REPEAT POINTER FMT.BG: 0 ;BYTE POINTER TO BEGINNING OF FORMAT FMT.BP: 0 ;FORMAT BYTE POINTER FMT.IU: 0 ;I/O LIST ENTRY USED FLAG NUM.AD: 0 ;DIGIT ACCUMULATOR PNTR ENC.WD: 0 ;ENCODED FORMAT WORD USR.TY: 0 ;FORMAT ARG TYPE USR.AD: 0 ;ACTUAL FORMAT ADDRESS USR.SZ: 0 ;SIZE OF FORMAT IN WORDS FMT.CC: 0 ;CURRENT FORMAT CHAR FMT.PC: 0 ;PREVIOUS CHAR FMT.SZ: 0 ;SIZE OF FORMAT IN CHARS FMT.DB: ;ENCODING DATABASE - CLEARED BY FMTINT FMT.SG: 0 ;SIGN FMT.WD: 0 ;FORMAT WIDTH FMT.DW: 0 ;DECIMAL WIDTH FMT.CH: 0 ;FORMAT CHARACTER (SIXBIT) FMT.EW: 0 ;EXPONENT WIDTH (do not split FMT.EW and FMT.RP) FMT.RP: 0 ;REPEAT COUNT FMT.EN==.-1 ;END OF ENCODING DATABASE SEGMEN CODE ;BYTE POINTERS TO FORMAT ATTRIBUTES (WIDTH, DECIMAL WIDTH, ETC.) W.PNTR: WIDPNT: POINT 8,ENC.WD,8 ;TOTAL WIDTH OF FORMAT ELEMENT ;AVOID BIT 0 SO IT WON'T BE NEGATIVE ;AS NEGATIVE MEANS PAREN REPEAT RPTPNT: POINT 12,ENC.WD,20 ;REPEAT COUNT D.PNTR: DECPNT: POINT 6,ENC.WD,26 ;DECIMAL WIDTH X.PNTR: EWPNT: POINT 3,ENC.WD,29 ;EXPONENT WIDTH CODPNT: POINT 6,ENC.WD,35 ;FORMAT CODE (SIXBIT CHAR) ;THE FOLLOWING TABLE CONTAINS INFORMATION ON HOW TO TREAT ;EACH CHARACTER FOUND IN A FORMAT STATEMENT. THE ;TABLE IS ARRANGED SO THAT THE CHARACTER (TRANSLATED TO SIXBIT) ;CAN BE USED AS AN INDEX INTO THE TABLE. THE LEFT HALF OF EACH ;WORD CONTAINS THE FLAGS ASSOCIATED WITH THE CHARACTER (FOR INSTANCE, ;THE LEFT HALF OF THE ENTRY FOR 'A' HAS DTIFLG, WHICH IS A COMPOSITE ;OF FLAGS WHICH DIRECT THE FORMAT ENCODER TO REGISTER THE FORMAT, ;THAT IS, IT IS A "MAIN" FORMAT CHARACTER, ;AND THAT THIS FORMAT CHARACTER HAS AN ITEM OF DATA ASSOCIATED WITH IT). ;THE RIGHT HALF OF EACH ENTRY IS THE ADDRESS OF ANOTHER TABLE ENTRY ;WHICH CONTAINS THE ADDRESS OF ANY SPECIAL ;CODE TO EXECUTE FOR THE PROCESSING OF THE FORMAT CHARACTER. FMT.CT: IGNFLG ;SPACE 0 ;! 0 ;" 0 ;# DRFLG+DOLFMT ;$ 0 ;% 0 ;& DRFLG+SQFMT ;' LPRFMT ;( FDFLG+RPRFMT ;) 0 ;* IGNFLG ;+ FDFLG ;COMMA MINFMT ;- PERFMT ;. DRFLG+SLHFMT ;/ DIGFMT ;0 DIGFMT ;1 DIGFMT ;2 DIGFMT ;3 DIGFMT ;4 DIGFMT ;5 DIGFMT ;6 DIGFMT ;7 DIGFMT ;8 DIGFMT ;9 DRFLG+COLFMT ;: 0 ;; 0 ;< 0 ;= 0 ;> 0 ;? 0 ;@ DTIFLG+AFMT ;A DRFLG+BFMT ;B 0 ;C DTISFL+DFMT ;D DTISFL+EFMT ;E DTISFL+FFMT ;F DTISFL+GFMT ;G REGFLG+HFMT ;H DTISFL+IFMT ;I 0 ;J 0 ;K DTISFL+LFMT ;L 0 ;M 0 ;N DTISFL+OFMT ;O REGFLG+PFMT ;P DRIFLG+QFMT ;Q DTISFL+RFMT ;R DRFLG+SFMT ;S DRFLG+TFMT ;T 0 ;U 0 ;V 0 ;W REGFLG+XFMT ;X 0 ;Y DTISFL+ZFMT ;Z 0 ;[ 0 ;\ 0 ;] 0 ;^ 0 ;_ ;THERE ARE TWO STEPS INVOLVED HERE, FORMAT ENCODING AND FORMAT ;EXECUTION. FORMAT ENCODING INVOLVES CODING EACH "MAIN" FORMAT ;CHARACTER (SUCH AS A,E,I, ETC.) INTO A WORD (OR 2) CONTAINING ;THE FORMAT WIDTH, REPEAT COUNT, DECIMAL WIDTH, ETC. THIS ENCODING ;IS DONE BECAUSE STRAIGHT INTERPRETIVE EXECUTION OF FORMAT ;STATEMENTS IS SLOW AND AWKWARD (ESPECIALLY WITH INDEFINITE REPEAT). ;ONCE A FORMAT STATEMENT IS ENCODED, THE ENCODED VERSION IS SAVED ;FOR LATER USE. THERE IS SOME OVERHEAD SEARCHING FOR THE ;ENCODED VERSION, BUT THIS IS CUT DOWN BY HAVING FMTN DIFFERENT LINKED ;LISTS WHERE IT CAN RESIDE. (DIVIDING BY FMTN GIVES ;WHICH LIST TO SEARCH). FORMATS IN ARRAYS ARE ALSO ENCODED, BUT ;UNDER NORMAL CIRCUMSTANCES THE ENCODED VERSIONS ARE NOT SAVED; ;THE USER MAY FORCE FOROTS TO KEEP THEM, HOWEVER, WITH ;A SPECIAL SUBROUTINE CALL (FMTSAV). ;IN ORDER TO FACILITATE THE PROCESSING OF PARENS IN THE FORMAT ;STATEMENT, THE CODE FOR PROCESSING IS FULLY RECURSIVE. A PAREN ;IS ENCODED WITH AN ASSOCIATED COUNT AND A LINK ;TO THE ENCODED ENTRIES AFTER THE ASSOCIATED RIGHT PAREN. A ;RIGHT PAREN IS ENCODED AS A ZERO ENTRY. THIS STRUCTURE FACILITATES ;A SIMPLE RECURSIVE PROCEDURE FOR EXECUTION OF THE FORMAT ;AND ALSO FACILITATES THE PROCESSING OF INDEFINITE REPEAT. ITS ;DISADVANTAGE IS THAT THE STACK LENGTH RESTRICTS THE NUMBER ;OF IMBEDDED PARENS. ;THERE ARE SEVERAL PATHOLOGICAL CASES OF INTEREST. ;IF THE USER SPECIFIES A FORMAT IN AN ARRAY, S/HE MAY LEAVE OFF ;ONE OR BOTH PARENS. IF THE LEFT PAREN IS MISSING, AND THERE ARE ;NO LEFT PARENS IN THE REST OF THE FORMAT STATEMENT, THE ENCODER ;WILL NEVER BE CALLED RECURSIVELY; WHETHER OR NOT THE FORMAT ENDS ;WITH A RIGHT PAREN, AN "END PAREN" ENTRY (A ZERO WORD) WILL ;BE PLACED AT THE END OF THE ENCODED FORMAT, AND WILL THUS ;EXECUTE CORRECTLY. IF THERE ARE LEFT PARENS IMBEDDED IN THE FORMAT, ;THE ENCODER WILL BE CALLED CORRECTLY, RECURSIVELY. THE ENCODER ;WILL CONTINUE BEYOND THE MATCHING RIGHT PARENS UNTIL IT ENCOUNTERS ;EITHER AN UNMATCHED RIGHT PAREN OR THE END OF THE FORMAT; IN THIS CASE ;IT WILL ALSO EXECUTE CORRECTLY, AS IF THERE HAD BEEN A BEGINNING ;LEFT PAREN. ;INDEFINITE REPEAT IS HANDLED BY SAVING A POINTER TO THE LAST ENCODED ;LEFT PAREN IN THE FORMAT STATEMENT MATCHING THE ;NEXT TO LAST RIGHT PAREN (WHICH MAY BE THE INITIAL LEFT ;LEFT PAREN, OR IMPLIED LEFT PAREN IF THE USER FORGOT IT...). THUS, ;IN ACCORDANCE WITH THE ANSI-66 AND ANSI-77 STANDARDS, THE LOOP ;USED IS THE ONE PRECEDING THE FINAL RIGHT PAREN, OR THE ENTIRE ;FORMAT STATEMENT IF THERE IS NO INTERNAL LOOP. ;AN ENCODED FORMAT IS AS FOLLOWS: ; ;WORD DESCRIPTION ; ; 0 ADDR OF NEXT ENCODED FORMAT IN THIS LIST ; 1 LINK NUMBER ,, ADDR OF ACTUAL FORMAT ; 2 INDEFINITE REPEAT POINTER ; 3 ENCODED WORD 1 ; 4 ENCODED WORD 2 ; . . ; . . ; ;THERE ARE MANY SUCH LINKED LISTS OF ENCODED FORMATS, THE NUMBER ;DETERMINED BY THE FORPRM PARAMETER FMTN, WHICH SERVES AS A ;HASHING NUMBER - THE USER'S FORMAT ADDRESS IS DIVIDED BY THIS ;NUMBER, AND THE REMAINDER IS USED AS AN INDEX INTO THE ENCODED ;FORMAT LIST OF LISTS (FMT.LS). EACH ENTRY IN FMT.LS POINTS ;TO THE BEGINNING OF A LINKED LIST OF ENCODED FORMATS. ; ;PROVISION HAS BEEN MADE FOR THE USER TO SPECIFY THAT A FORMAT ;IN AN ARRAY SHOULD BE ENCODED AND STORED (UNDER NORMAL CIRCUMSTANCES ;THE ENCODED FORMAT FROM AN ARRAY IS THROWN AWAY). THIS FEATURE IS ;PROVIDED VIA TWO SPECIAL CALLS - FMTSAV & FMTCLR: ; ; CALL FMTSAV (array name, number of array elements) ; ; THIS CALL CALLS THE FORMAT ENCODER AND FORCES IT ; TO SAVE THE ENCODED FORMAT. IF THIS ROUTINE IS ; CALLED WITH AN ARRAY WHICH HAS ALREADY BEEN ; ENCODED, THE OLD ENCODING WILL BE THROWN AWAY ; AND A NEW ONE CREATED. ; ; CALL FMTCLR (array name) ; ; THIS CALL THROWS AWAY THE ENCODED FORMAT BY ; DEALLOCATING THE CORE AND RELINKING THE ; OTHER ENCODED FORMATS IN THE LIST. ; ;THE IMPLEMENTATION OF THESE SUBROUTINES MAKES IT NECESSARY TO ;SEARCH THE LISTS OF ENCODED FORMATS WHETHER OR NOT THE FORMAT IS ;IN AN ARRAY. HOWEVER, SINCE THE LISTS HAVE BEEN HASH-CODED, THIS ;SHOULD NOT SLOW PROCESSING SIGNIFICANTLY. ;%FORMT IS THE FORMAT CALL FROM FOROTS. WE FIRST SEARCH FOR ;THE FORMAT IN THE LIST OF ENCODED FORMATS. IF IT EXISTS, ;WE GO ON TO FORMAT EXECUTION. OTHERWISE, WE ENCODE IT AND THEN ;EXECUTE IT. %FORMT: MOVE T1,A.FMT ;GET ADDRESS OF FORMAT PUSHJ P,%OVNUM ;GET LINK NUMBER ALSO MOVEM T1,USR.AD ;SAVE IT MOVE T2,A.FMS ;GET SIZE MOVEM T2,USR.SZ ;SAVE IT MOVE T1,T.FMT ;GET ARG TYPE MOVEM T1,USR.TY ;SAVE IT PUSHJ P,FMTSRH ;SEARCH FOR ENCODED FORMAT MOVEM T1,ENC.AD ;SAVE THE ADDR FOUND JUMPN T1,NOENC ;GO EXECUTE IF ALREADY ENCODED PUSHJ P,FMTENC ;ENCODE THE FORMAT MOVE T1,USR.TY ;GET FORMAT TYPE CAIN T1,TP%LBL ;LABEL? JRST SAVENC ;YES. GO SAVE IT PUSHJ P,FMTEXC ;NO. EXECUTE THE FORMAT MOVE T1,ENC.AD ;FREE THE CORE WE GOT PJRST %FREBL ;FREE IT UP SAVENC: MOVE T1,ENC.AD ;GET THE ENCODED ADDR MOVEM T1,@SAV.EF ;SAVE IT ON LINKED LIST NOENC: PJRST FMTEXC ;EXECUTE THE FORMAT %ADR==0 ;USER ARRAY ADDRESS %SIZ==1 ;USER ARRAY SIZE (IN ARRAY ELEMENTS) ;THIS IS THE FAMOUS ARRAY FORMAT ENCODER. IT ALLOWS THE USER ;TO HAVE FOROTS SAVE AWAY THE ENCODED VERSION OF THE FORMAT IN AN ARRAY. ;IF IT HAS ALREADY BEEN ENCODED, THE OLD ENCODING IS THROWN AWAY ;AND THE NEW ONE IS INSERTED AT THE END OF THE APPROPRIATE LINKED ;ENCODED FORMAT LIST. %FMTSV: MOVEI T1,@%ADR(L) ;GET ARRAY ADDR PUSHJ P,%OVNUM ;GET LINK NUMBER ALSO MOVEM T1,USR.AD ;SAVE IT LDB T1,[POINTR %ADR(L),ARGTYP];GET ARRAY TYPE MOVE T2,@%SIZ(L) ;GET # ARRAY ELEMENTS IMUL T2,%SIZTB(T1) ;GET # WORDS MOVEM T2,USR.SZ ;SAVE IT PUSHJ P,FMTSRH ;SEARCH FOR THE FORMAT JUMPE T1,GOENC ;IF NOT FOUND, GO ENCODE IT PUSHJ P,FMTDEL ;FOUND. DELETE IT PUSHJ P,FMTSR1 ;SEARCH AGAIN JUMPN T1,FMTER3 ;BETTER NOT BE THERE AGAIN! GOENC: PUSHJ P,FMTENC ;ENCODE THE FORMAT MOVE T1,ENC.AD ;AND LINK INTO THE LIST MOVEM T1,@SAV.EF POPJ P, ;AND THIS IS THE FAMOUS ENCODED FORMAT DEALLOCATOR, WHICH ;IS HERE MAINLY FOR SYMMETRY (OR FOR THE USER WHO REALLY CARES ;ABOUT THE EXTRA FEW WORDS OF CORE ALLOCATED FOR THE ENCODED ;FORMAT). %FMTCL: MOVEI T1,@%ADR(L) ;GET ARRAY ADDR MOVEM T1,USR.AD ;SAVE FOR SEARCH PUSHJ P,FMTSRH ;SEARCH FOR THE FORMAT JUMPE T1,%POPJ ;NOT FOUND. JUST LEAVE ; PJRST FMTDEL ;DELETE IT ;SUBROUTINE TO DELETE AN ENCODED FORMAT FROM A LINKED LIST. ;T1 POINTS TO THE ENCODED FORMAT TO BE DELETED, SAV.EF POINTS ;TO THE PREVIOUS ENCODED FORMAT. FMTDEL: MOVE T2,(T1) ;GET ADDR OF NEXT FORMAT MOVEM T2,@SAV.EF ;RELINK THE LIST PJRST %FREBL ;FREE THE ALLOCATED CORE ;THIS IS THE FORMAT ENCODER SETUP. THE SIZE OF THE CORE WE ALLOCATE ;IS DETERMINED BY THE SIZE OF THE FORMAT STATEMENT OR ARRAY, IN ;CHARACTERS. WHILE THIS IS AN INEXACT MEASURE (USUALLY MUCH MORE ;THAN NECESSARY), IT IS AT LEAST SAFE, AND WE HAVE NO BETTER ;WAY TO DO IT OTHER THAN DOING A PRESCAN OF THE FORMAT. FMTENC: SETZM FMT.PC ;CLEAR PREV CHAR MOVE T1,USR.SZ ;GET SIZE OF FORMAT STRING IMULI T1,5 ;GET # CHARS MOVEM T1,FMT.SZ ;SAVE THE SIZE ADDI T1,%FMTEN+5 ;PLUS A FEW FOR LINK, ADDR, & INDEF RPT MOVNI P4,(T1) ;GET NEGATIVE SIZE HRLZI P4,(P4) ;IN LEFT HALF FOR FORMAT LIST PUSHJ P,%GTBLK ;GET SOME CORE HRRI P4,-1(T1) ;CREATE A DECODED STACK PNTR MOVEM T1,ENC.AD ;SAVE ADDR FOR EXECUTION PUSH P4,[0] ;CLEAR "NEXT LINK" ADDR PUSH P4,USR.AD ;SAVE THE ENCODED FORMAT ADDR PUSH P4,[0] ;CLEAR INDEF RPT PNTR MOVEM P4,FMT.LK ;SAVE THE CURRENT STACK PNTR MOVEI T1,1(P4) ;GET ADDR FOR ENCODED CHARS MOVEM T1,RPT.PT ;INIT INDEF RPT PNTR MOVE T1,USR.AD ;GET FORMAT ADDR AGAIN $BLDBP T1 ;Make 7-bit byte ptr. MOVEM T1,FMT.BP ;Store it in FMT.BP MOVEM T1,FMT.BG ;Store ptr to beginning of format PUSHJ P,FMTPRC ;PROCESS FORMAT MOVE T1,ENC.AD ;GET BLOCK ADDR MOVE T2,RPT.PT ;GET INDEF RPT PNTR MOVEM T2,%FMTRP(T1) ;SAVE IT IN BLOCK POPJ P, ;FMTINT - INITIALIZE THE FORMAT PARAMETERS. THE DIGIT COLLECTOR ;IS SET UP TO POINT TO THE REPEAT COUNT, THE SIGN IS ;SET TO +, AND THE TEMP FMT DATABASE IS CLEARED. FMTINT: SETZM FMT.DB ;CLEAR 1ST DATABASE WORD MOVE T1,[FMT.DB,,FMT.DB+1] ;CLEAR REST WITH BLT BLT T1,FMT.EN MOVEI T1,1 ;SET SIGN TO 1 MOVEM T1,FMT.SG XMOVEI T1,FMT.RP ;SET TO COLLECT REPEAT COUNT MOVEM T1,NUM.AD POPJ P, ;FMTPRC - THIS IS THE FORMAT PROCESSOR OR ENCODER. EACH CHARACTER ;(OTHER THAN IN QUOTED STRINGS AND HOLLERITH CONSTANTS) ARE CONVERTED ;TO SIXBIT. THE RESULTING VALUE IS USED AS AN INDEX INTO A TABLE ;GIVING A SET OF FLAGS (LEFT HALF) AND POSSIBLY AN ADDRESS OF ;A WORD WHICH MAY HAVE THE ADDRESS OF A SPECIAL PROCESSING ROUTINE ;FOR THAT CHARACTER. FOR INSTANCE, THE TABLE ENTRY FOR LEFT PAREN ;HAS FDFLG IN THE LEFT HALF, WHICH INDICATES THAT ANY PREVIOUS DATA ;ENCOUNTERED SHOULD BE ENCODED INTO A FORMAT WORD AND REGISTERED INTO ;THE ENCODED FORMAT. IT HAS THE ADDRESS "RPRFMT" IN THE RIGHT HALF. ;"RPRFMT" CONTAINS THE ADDRESS OF THE LEFT PAREN ENCODING SUBROUTINE - LPRENC. ;IF "REGFLG" IS ON IN THE LEFT HALF OF THE TABLE ENTRY, IT MEANS THAT ;THE CHARACTER IS A "MAIN" FORMAT CHARACTER, THAT IS, IT WILL EVENTUALLY ;BE ENCODED AS A WORD IN THE ENCODED FORMAT AFTER ;ITS WIDTH, DECIMAL WIDTH, EXPONENT WIDTH, AND REPEAT COUNT ARE COLLECTED. FMTPRC: PUSHJ P,FMTINT ;INIT DATABASE FMTLP: SKIPG FMT.SZ ;ANYTHING LEFT? JRST REGRP ;NO. FAKE A RIGHT PAREN PUSHJ P,GTFCHR ;GET A CHAR PUSHJ P,SIXVRT ;CONVERT TO SIXBIT MOVEI P1,(T1) ;COPY IT MOVEM P1,FMT.CC ;SAVE AS CURRENT CHAR SKIPN FMT.CT(P1) ;ANY STUFF? JRST FMTERR ;NO. BAD CHAR PUSHJ P,ETEST ;SPECIAL TEST FOR E-FORMAT MOVE P3,FMT.CT(P1) ;GET FLAGS TXNE P3,FDFLG ;DELIMITER? PUSHJ P,FMTCMP ;YES. COMPILE PREV FORMAT TXNN P3,REGFLG ;REGISTER THE CHAR? JRST NOREG ;NO SKIPE FMT.WD ;IS THE FORMAT WIDTH ZERO? $ECALL ARC,%ABORT ;NO, AMBIGUOUS REPEAT COUNT SKIPE FMT.CH ;ANY LEFTOVER FORMAT CHAR? PUSHJ P,FMTCMP ;YES. COMPILE PREV FORMAT XMOVEI T1,FMT.WD ;SET TO COLLECT FORMAT WIDTH MOVEM T1,NUM.AD MOVE T1,FMT.SG ;ACCUMULATE THE SIGN IMULM T1,FMT.RP ;INTO THE REPEAT COUNT MOVEM P1,FMT.CH ;SAVE THE CHAR AWAY NOREG: HRRZ P3,FMT.CT(P1) ;GET TABLE ADDR JUMPE P3,FMTLP ;BACK IF NO DISPATCHES HRRZ T1,(P3) ;GET ADDR OF DISPATCH JUMPE T1,FMTLP ;BACK IF NO ADDR PUSHJ P,(T1) ;IF ADDR, DO IT JRST FMTLP ;BACK FOR MORE POPJ P, ;RECURSIVE RETURN REGRP: PUSHJ P,FMTCMP ;COMPILE ANY INCOMPLETE FORMAT PUSHJ P,RPRENC ;FAKE A RIGHT PAREN JFCL ;ALWAYS SKIP RETURNS POPJ P, ETEST: CAIE P1,'E' ;IS IT AN 'E'? POPJ P, ;NO. LEAVE MOVE T2,FMT.CH ;GET THE FORMAT CHAR CAIE T2,'D' ;YES. IS IT A "D" CAIN T2,'E' ;OR AN 'E'? JRST ASMEXW ;YES. SET FOR EXPONENT WIDTH CAIE T2,'G' ;SAME FOR 'G' POPJ P, ;NO. LEAVE ASMEXW: XMOVEI T1,FMT.EW ;ROUTE DIGITS TO EXP WIDTH MOVEM T1,NUM.AD EXPLP: SETZ P1, ;MAKE THE CHAR A SPACE SKIPN FMT.SZ ;ANY CHARS LEFT? PJRST FMTCMP ;NO. COMPILE THE FORMAT PUSHJ P,GTFCHR ;YES. GET ONE PUSHJ P,SIXVRT ;CONVERT TO SIXBIT MOVEI P1,(T1) ;COPY THE CHAR CAIG P1,'9' ;IS IT A DIGIT? CAIGE P1,'0' PJRST FMTCMP ;NO. GO USE AS NEXT CHAR PUSHJ P,DIGENC ;YES. ACCUMULATE IT JRST EXPLP ;AND GO BACK FOR MORE ;FMTSRH - SEARCHES FOR AN ENCODED FORMAT IN ONE OF THE ;LINKED LISTS (ADDR IN SAV.EF) MATCHING THE SPECIFIED ;USER'S FORMAT (ADDR IN USR.AD). RETURNS THE ADDR OF THE ;ENCODED FORMAT IN T1 IF FOUND, 0 IF NOT FOUND. ALSO, SAV.EF ;IS LEFT WITH THE ADDR OF THE FORMAT PREVIOUS TO ;ONE FOUND, OR THE ADDR OF THE LAST ENCODED FORMAT ;IN THE LINKED LIST, IF NOT FOUND. [NOTE: THE ORDER OF WHEN THE ;ADDRESS OF THE FORMAT IS SAVED IN SAV.EF (AFTER THE COMPARE ;AND EXIT) IS CRUCIAL FOR THE PROPER OPERATION OF FMTDEL, ;WHICH NEEDS THE ADDRESS PREVIOUS TO THE ONE MATCHED ;FOR RELINKING THE LIST.] FMTSRH: MOVE T1,USR.AD ;GET FORMAT ADDR IDIVI T1,FMTN ;HASH CODE...CHOOSE LIST XMOVEI T1,FMT.LS(T2) ;GET ADDR OF PNTR TO BEG ENTRY MOVEM T1,SAV.EF ;SAVE IT FMTSR1: MOVE T1,SAV.EF ;GET ENC ADDR PNTR MOVE T2,USR.AD ;AND UNENCODED ADDR FSLP1: SKIPE T1,%FMTNX(T1) ;GET NEXT ADDR, RETURN IF NO MORE FORMATS CAMN T2,%FMTAD(T1) ;ADDRESSES EQUAL? POPJ P, ;YES. RETURN WITH ADDR IN T1 MOVEM T1,SAV.EF ;NO. SAVE NEW ADDR JRST FSLP1 ;AND TRY AGAIN ;FORMAT COMPILATION - THROWS TOGETHER THE VARIOUS PARAMETERS ;ASSEMBLED SO FAR FOR A FORMAT CODE AND ASSEMBLES IT INTO ;AN ENCODED FORMAT WORD. SPECIAL HANDLING IS USED FOR THE ;CURRENT CHARACTER BEING "E" - THE ANSI-77 STANDARD ;ALLOWS THIS CHARACTER TO BE USED FOR BOTH E FORMAT AND ;FOR THE EXPONENT PART OF SCIENTIFIC NOTATION. THEREFORE ;IF THE CURRENT CHARACTER IS "E", WE CHECK IF THE FORMAT ABOUT ;TO BE COMPILED IS D,E,F OR G. IF SO, WE DEFER COMPILATION ;UNTIL COLLECTING THE EXPONENT WIDTH. XENC: MOVEI T1,1 ;Incase "X" by itself SKIPN FMT.RP MOVEM T1,FMT.RP ;"X" = "1X" (DEC extension) SKIPG FMT.RP ;X REPEAT COUNT MUST BE POSITIVE $ECALL IRC,%ABORT ;IOERR (IRC,,,?,Illegal repeat count,,%ABORT) FMTCMP: SKIPE T1,FMT.CH ;ANY FORMAT CHAR YET? JRST FMTOK ;YES. SKIPE FMT.RP ;NO. IS REPEAT COUNT ZERO? $ECALL IRC,%ABORT ;NO. ILLEGAL REPEAT COUNT POPJ P, ;YES. JUST IGNORE THE WHOLE THING FMTOK: SETZM ENC.WD ;CLEAR THE ENCODED WORD SKIPGE T1,FMT.WD ;FIELD WIDTH MUST BE POSITIVE $ECALL IFW,%ABORT ;NEGATIVE IS FATAL DPB T1,WIDPNT ;RECORD IT MOVE T2,FMT.DW ;GET DECIMAL WIDTH DPB T2,DECPNT DMOVE T1,FMT.EW ;AND EXPONENT WIDTH AND REPEAT COUNT DPB T1,EWPNT DPB T2,RPTPNT MOVE T1,FMT.CH ;AND FORMAT CODE DPB T1,CODPNT PUSH P4,ENC.WD ;STORE WORD ON STACK PJRST FMTINT ;INITIALIZE THE DATABASE ;SIXVRT - CONVERTS ASCII CHARACTERS FROM THE FORMAT STATEMENT ;TO SIXBIT. CONVERTS ALL CRUD CHARACTERS (.LT.SPACE) TO SPACE. SIXVRT: CAILE T1,140 ;LOWER CASE? SUBI T1,40 ;YES. CONVERT TO UPPER CAIGE T1,40 ;CONTROL CHAR? MOVEI T1,40 ;YES. CONVERT TO SPACE SUBI T1,40 ;CONVERT TO SIXBIT POPJ P, ;RIGHT PAREN ENCODER - A RIGHT PAREN IS TRANSLATED INTO A ZERO ;WORD DROPPED ONTO THE STACK. SINCE THE FORMAT ENCODER IS RECURSIVE, ;THE RETURN FROM THIS SUBROUTINE IS ALWAYS A SKIP RETURN TO SPECIFY ;A RECURSIVE RETURN RPRENC: PUSH P4,[0] ;DROP A ZERO ON THE STACK PJRST %POPJ1 ;AND SKIP RETURN ;THIS ROUTINE IS CALLED BY I,O, AND Z FORMATS. THE ANSI STANDARD ;SPECIFIES THAT A FORMAT SUCH AS "I5.0" MEANS THAT NO DIGITS ARE ;PRINTED IF THE VALUE OF THE VARIABLE IS ZERO. THE DEFAULT FOR ;A FORMAT SUCH AS "I5" IS AT LEAST ONE DIGIT PRINTED. THUS THIS ;ROUTINE MUST BE CALLED TO SET THE DEFAULT NUMBER OF CHARACTERS ;PRINTED TO 1; WHEN A PERIOD IS ENCOUNTERED IT IS RESET TO ZERO ;TO PROPERLY COLLECT THE DIGITS. MENC: MOVEI T1,1 ;SET DEFAULT FOR I,O,Z TO 1 MOVEM T1,FMT.DW ;FOR DECIMAL WIDTH POPJ P, ;PERIOD ENCODING - UPON ENCOUNTERING A PERIOD, THE DECIMAL WIDTH ;(POSSIBLY SET TO NON-ZERO DEFAULT) IS CLEARED, AND THE DIGIT ;COLLECTER IS SET TO POINT TO THE DECIMAL WIDTH PERENC: SETZM FMT.DW ;CLEAR DEC WIDTH XMOVEI T1,FMT.DW ;POINT DIGACC AT DEC WIDTH MOVEM T1,NUM.AD POPJ P, ;DIGENC - THE DIGIT ENCODER. NUM.AD POINTS TO THE CURRENT ;DIGIT COLLECTOR. DIGENC: MOVE T1,@NUM.AD ;GET ACC NUM IMULI T1,12 ;MUL BY 10 ADDI T1,-20(P1) ;ADD IT IN MOVEM T1,@NUM.AD ;SAVE IT AGAIN POPJ P, ;LPRENC - THE LEFT PAREN ENCODER. A LEFT PAREN IS ;ENCODED AS A WORD CONTAINING THE NEGATIVE OF ITS REPEAT COUNT ;IN THE LEFT HALF, AND THE ADDRESS OF A "LINK" IN THE RIGHT HALF. ;A "LINK" IS THE ADDRESS OF THE 1ST WORD ENCODED AFTER THE RIGHT ;PAREN CORRESPONDING TO THE CURRENT LEFT PAREN. THE LEFT PAREN ;INITIATES A RECURSIVE CALL TO THE FORMAT ENCODER, AND THE LINK ;IS ESTABLISHED AFTER THE RETURN FROM THIS RECURSIVE CALL. ;UPON RETURNING, WE MUST DO SOMETHING WHICH LOOKS RATHER CURIOUS - WE SAVE ;THE CURRENT LINK (THAT IS, LEFT PAREN) POINTER IN THE INDEFINITE REPEAT ;POINTER, UNLESS WE ARE AT THE TOP LEVEL. THIS HAS THE EFFECT OF POINTING ;TO THE LEFT PAREN WHICH MATCHES THE NEXT TO LAST RIGHT PAREN (WE AVOID ;RESETTING IT TO THE OUTERMOST PAREN (THE INITIAL SETTING) BY NOT SAVING ;THE NO-LINK ENTRY. ;IF, AFTER RETURNING, THE SAVED FORMAT STACK ADDRESS IS THE ;BEGINNING OF THE FORMAT STACK, WE HAVE REACHED THE END OF ;THE FORMAT, SO THE LINK IS SET TO ZERO. IN THIS CASE, ;WE ALSO SKIP RETURN, TO INDICATE A RECURSIVE ;RETURN, AND THUS THE END OF ENCODING. LPRENC: SKIPE T1,FMT.CH ;ANY PREVIOUS FORMAT CHARACTER? PUSHJ P,FMTCMP ;YES. PROCESS IT PUSH P,P4 ;PUSH CURRENT STACK PNTR SKIPN T1,FMT.RP ;GET LATEST REPEAT COUNT MOVEI T1,1 ;ASSUME COUNT OF 1 IF 0 MOVNI T1,(T1) ;NEGATE IT HRLZI T1,(T1) ;-REPEAT COUNT,,0 FOR NOW PUSH P4,T1 ;SAVE ON STACK PUSHJ P,FMTPRC ;RECURSIVE CALL POP P,T2 ;GET FORMAT LINK ADDR CAMN T2,FMT.LK ;IF LINK ADDR IS START ADDR JRST %POPJ1 ;WE'RE DONE MOVEI T1,1(P4) ;NEXT ADDR IS CONTINUATION ADDI T2,1 ;POINT TO THE REPEAT WORD HRRM T1,(T2) ;SAVE IT IN LINK HRRZM T2,RPT.PT ;SAVE LOOP ADDR FOR INDEF RPT POPJ P, ;BENC - THE B FORMAT ENCODER - BN FORMAT IS ENCODED AS A 'B' FOR ;THE FORMAT CHARACTER AND "N" FOR THE WIDTH. BZ IS ENCODED WITH ;A "Z" FOR THE FORMAT WIDTH. BENC: PUSHJ P,GTFCHR ;GET FORMAT CHAR CAIE T1,"N" ;N OR Z? CAIN T1,"Z" JRST GOTNZ ;YES, OK JRST FMTERR ;NO. ERROR GOTNZ: MOVEM T1,FMT.WD ;SAVE AS WIDTH FIELD PJRST FMTCMP ;COMPILE IT ;A MINUS IN THE FORMAT MERELY NEGATES THE SIGN. THIS ALSO ALLOWS ;FOR MULTIPLE NEGATIVE SIGNS TO CANCEL EACH OTHER, A RESULT I'M NOT ;SURE IS DESIRABLE... MINENC: MOVNS FMT.SG ;NEGATE THE SIGN POPJ P, ;SENC - FOR S,SS, &SP FORMATS. AN "S" OR "P" ARE ENCODED ;INTO THE WIDTH POSITION OF THE FORMAT WORD. SENC: PUSHJ P,GTFCHR ;GET A FORMAT CHAR CAIE T1,"S" ;IS IT AN S CAIN T1,"P" ;IS IT A P JRST MATPS ;YES MOVEM T1,FMT.PC ;NO. SAVE AS PREVIOUS CHAR MOVEI T1,"S" ;DEFAULT IS AN S MATPS: MOVEM T1,FMT.WD ;SAVE AS WIDTH PJRST FMTCMP ;COMPILE IT ;HOLLERITH ENCODING - WE ARE ALLOWING ANY CHARACTERS WHATSOEVER ;IN HOLLERITH AND QUOTED STRINGS, SO WE USE THE ACTUAL BYTE ;PNTR INTO THE FORMAT STATEMENT TO RETRIEVE THE CHARS RATHER ;THAN THE SUBROUTINE GTFCHR. THE FORMAT WORD IS COMPILED AND THE ;BYTE POINTER IS SAVED AS A SECOND WORD IN THE FORMAT STACK. HENC: SKIPG T1,FMT.RP ;GET THE REPEAT COUNT ; IOERR (IHC,,,?,Illegal Hollerith constant,,%ABORT) $ECALL IHC,%ABORT PUSH P,FMT.BP ;SAVE THE BYTE PNTR HENCLP: IBP FMT.BP ;INCR PAST H CONSTANT SOSL FMT.SZ ;QUIT IF NO MORE FORMAT SOJG T1,HENCLP MOVNI T1,(T1) ;GET NEG LEFT OVER ADDM T1,FMT.RP ;AND REDUCE SIZE PUSHJ P,FMTCMP ;COMPILE THE FORMAT POP P,T1 ;GET THE BYTE PNTR AGAIN PUSH P4,T1 ;SAVE THE B.P. ON ENCODED STACK POPJ P, ;SIMILAR TO HOLLERITH, EXCEPT THE COUNT MUST EXCLUDE THE ;EXTRA SINGLE QUOTES WHEN THEY ARE PAIRED TO OUTPUT A SINGLE ;QUOTE OR APOSTROPHE. ALSO, IF A SINGLE QUOTE IS NOT ;FOLLOWED BY ANOTHER, IT IS THE END OF THE QUOTED STRING; ;HOWEVER, WE HAVE ALREADY RETRIEVED THE CHARACTER, SO WE HAVE TO ;SAVE IT FOR LATER. SQENC: SETZM FMT.WD ;CLEAR WIDTH PUSH P,FMT.BP ;SAVE THE B.P. SQLP1: SOSGE FMT.SZ ;ANY CHARS LEFT? JRST SQEDON ;NO. CLOSE THE QUOTE ILDB T1,FMT.BP ;NON-CHECKING SCAN CAIE T1,"'" ;SINGLE QUOTE? JRST NOTSQ ;NOPE SOSGE FMT.SZ ;ANY CHARS LEFT? JRST SQEDON ;NO. CLOSE THE QUOTE ILDB T1,FMT.BP ;GET THE NEXT CHAR CAIE T1,"'" ;ANOTHER QUOTE? JRST SQEDON ;NO. STOP AOS FMT.WD ;YES. COUNT BOTH OF THEM NOTSQ: AOS FMT.WD ;NO. INCR THE COUNT JRST SQLP1 ;AND TRY FOR MORE SQEDON: MOVEM T1,FMT.PC ;NO. SAVE AS PREVIOUS CHAR PUSHJ P,FMTCMP ;COMPILE THE FORMAT POP P,T1 ;GET THE BYTE PNTR PUSH P4,T1 ;STORE ON STACK POPJ P, ;T FORMAT - THE ANSI STANDARD HAS CREATED 2 MORE CONFUSING FORMATS - ;TR AND TL (TAB RIGHT AND TAB LEFT). SINCE WE ONLY HAVE A SIXBIT ;CHARACTER POSITION FOR THE FORMAT CHAR, WE STORE THE "R" OR "L" ;IN THE DECIMAL WIDTH PORTION OF THE FORMAT WORD. TENC: PUSHJ P,GTFCHR ;GET NEXT CHAR CAIE T1,"L" ;L OR R CAIN T1,"R" JRST GOTLR ;YES MOVEM T1,FMT.PC ;NO. SAVE THE CHAR FOR LATER POPJ P, GOTLR: PUSHJ P,SIXVRT ;CONVERT TO SIXBIT MOVEM T1,FMT.DW ;SAVE AS DECIMAL WIDTH POPJ P, ;THIS IS THE LIST OF EXECUTION/ENCODING ADDRESSES. LH=EXECUTION ADDR, ;RH=ENCODING ADDR. IF THERE IS NO ENCODING ADDR, IT ;MEANS THERE IS NO SPECIAL ENCODING, AND IS HANDLED BY THE ;ENCODER DEFAULTING MECHANISMS AND THE FLAGS IN FMT.CT. COLFMT: COLEXE,,FMTCMP SLHFMT: SLHEXE,,FMTCMP DOLFMT: DOLEX,,FMTCMP MINFMT: MINENC DIGFMT: DIGENC LPRFMT: LPRENC RPRFMT: RPRENC PERFMT: PERENC SQFMT: SQEXEC,,SQENC VARFMT: VAREXE,,0 AFMT: AEXEC,,0 BFMT: BEXEC,,BENC DFMT: DEXEC,,0 EFMT: EEXEC,,0 FFMT: FEXEC,,0 GFMT: GEXEC,,0 HFMT: HEXEC,,HENC IFMT: IEXEC,,MENC LFMT: LEXEC,,0 OFMT: OEXEC,,0 PFMT: PEXEC,,FMTCMP QFMT: QEXEC,,FMTCMP RFMT: REXEC,,0 SFMT: SEXEC,,SENC TFMT: TEXEC,,TENC XFMT: XEXEC,,XENC ZFMT: ZEXEC,,0 ;EXECUTION TRANSFER VECTORS - THIS IS A TABLE OF ;ROUTINE ADDRESSES. THE LEFT HALF OF EACH WORD ;IS THE ADDRESS FOR INPUT, THE RIGHT FOR OUTPUT. COLEXE: NOEXEC,,CHKDAT SLHEXE: %IREC,,%ORECS DOLEX: NOCR,,NOCR SQEXEC: SQIN,,SQOUT VAREXE: GETVAR,,GETVAR AEXEC: %ALPHI,,%ALPHO BEXEC: BNZ,,BNZ DEXEC: %DIRT,,%DOUBT EEXEC: %ERIN,,%EOUT FEXEC: %FLIRT,,%FLOUT GEXEC: GIN,,GOUT HEXEC: HIN,,HOUT IEXEC: %INTI,,%INTO LEXEC: %LINT,,%LOUT OEXEC: %OCTI,,%OCTO PEXEC: PFACT,,PFACT QEXEC: QIN,,QOUT REXEC: %RIGHI,,%RIGHO SEXEC: SSP,,SSP TEXEC: TABREC,,TABREC XEXEC: POSREC,,POSREC ZEXEC: %HEXI,,%HEXO ;G-FORMAT CONVERSION ROUTINE ADDRESS TABLE. ;LH=INPUT, RH=OUTPUT GTAB: %GINTI,,%GINTO ;NO TYPE GIVEN %GLINT,,%GLOUT ;LOGICAL %GINTI,,%GINTO ;INTEGER NOEXEC,,NOEXEC ;UNDEFINED %GRIN,,%GROUT ;REAL NOEXEC,,NOEXEC ;UNDEFINED %GOCTI,,%GOCTO ;OCTAL NOEXEC,,NOEXEC ;LABEL %GRIN,,%GROUT ;DOUBLE REAL %GINTI,,%GINTO ;DOUBLE INTEGER %OCTI,,%OCTO ;DOUBLE OCTAL %GRIN,,%GROUT ;EXTENDED DOUBLE REAL %GRIN,,%GROUT ;COMPLEX NOEXEC,,NOEXEC ;BYTE STRING NOEXEC,,NOEXEC ;CHARACTER NOEXEC,,NOEXEC ;ASCIZ NOEXEC: GETVAR: POPJ P, ;THIS IS THE CALL TO FORMAT EXECUTION, EXEPRC. FMTEXC: SETZM ENC.RP ;CLEAR LOOP REPEAT COUNT SETZM ENC.LR ;AND LOCAL REPEAT COUNT SETZM FMT.LK ;AND LINK WORD SETZM SCL.SV ;CLEAR SCALE FACTOR SETZM FMT.IU ;CLEAR I/O LIST USED FLAG MOVE T2,FLAGS(D) ;T2= DDB flags TXZ T2,D%SP+D%BZ ;Default is BN and SS LOAD T1,BLNK(U) ;UNLESS SET OTHERWISE IN DDB CAIN T1,BL.ZERO ;BLANK=ZERO? TXO T2,D%BZ ;YES, SET BZ MOVEM T2,FLAGS(D) ;Set new DDB flags MOVE T1,ENC.AD ;GET ENCODED FORMAT ADDR ADDI T1,%FMTEN ;POINT TO 1ST FMT WORD MOVEM T1,ENC.PT ;SAVE IN STACK PNTR PUSHJ P,EXEPRC ;EXECUTE THE FORMAT SKIPN ENC.PT ;WAS I/O ABORTED? POPJ P, ;YES. LEAVE (NO INDEF RPT) EXELP: SKIPE IO.ADR ;ANY I/O ADDR READY? JRST EXEOK ;YES PUSHJ P,%%GETIO ;GET MORE I/O ADDR SKIPN IO.ADR ;ANY MORE I/O LIST? POPJ P, ;NO. LEAVE EXEOK: SKIPN FMT.IU ;DATA USED BY LAST SCAN? JRST FMTER2 ;NO. GIVE WARNING AND EXIT MOVEI T1,SLHEXE ;EXECUTE EOL FOR EACH REPEAT PUSHJ P,DOEXE MOVE T1,ENC.AD ;GET ENCODED BLOCK ADDR MOVE T1,%FMTRP(T1) ;GET INDEF RPT PNTR MOVEM T1,ENC.PT ;FOR FORMAT STACK SETZM ENC.RP ;CLEAR LOOP REPEAT COUNT SETZM ENC.LR ;AND LOCAL REPEAT COUNT SETZM FMT.LK ;CLEAR THE FORMAT LINK SETZM FMT.IU ;CLEAR I/O LIST ENTRY USED FLAG PUSHJ P,EXEPRC ;GO EXECUTE FORMAT JRST EXELP ;GO BACK FOR MORE FMTER2: ;IOERR (DLF,,,%,Data in IO list but not in format,,%ABORT) $ECALL DLF,%ABORT USEIO: SETZM IO.ADR ;CLEAR LAST I/O ADDR PUSHJ P,%%GETIO ;GET ANOTHER SKIPE IO.ADR ;GOT ANOTHER? JRST USEIO ;YES. SCRAP IT SETZM ENC.PT ;STOP EXECUTION, JUST IN CASE POPJ P, ;NO. LEAVE ;EXEPRC - THE ENCODED FORMAT EXECUTIONER (SIMILAR TO ;LORD HIGH EXECUTIONER). THIS IS A TOTALLY RECURSIVE EXECUTION SEQUENCE. ;STARTING AT THE GIVEN FORMAT STACK POINTER, ENCODED WORDS ARE ;LOADED, AND DEPENDING ON THE FORMAT CODE, A DATA ITEM MAY BE RETRIEVED, ;AND THEN THE PROPER SUBROUTINE IS CALLED. THE FORMAT ENCODER HAS ;ENCODED LEFT PARENS AS WORDS WITH A NEGATIVE LEFT HALF (NEGATIVE REPEAT COUNT), ;AND A LINK TO THE FORMAT CODES AFTER THE LOOP IN THE RIGHT HALF. THE FIRST ;ENCODED LEFT PAREN HAS A ZERO LINK, AS THERE ARE NO FORMAT ITEMS AFTER ;ITS MATCHING RIGHT PAREN. HERE, WHEN A NEGATIVE ENTRY (AN ENCODED LEFT PAREN) ;IS ENCOUNTERED, THE EXECUTION SEQUENCE IS CALLED RECURSIVELY, SAVING ;THE CURRENT VALUE OF THE LOOP REPEAT COUNT AND CURRENT LEFT PAREN ;ADDRESS (REFFERED TO AS THE "LINK" ADDRESS) ON THE PUSHDOWN STACK. ;UPON RETURN, THE FORMAT STACK POINTER IS SET TO THE ADDRESS SPECIFIED BY ;THE ENCODED LEFT PAREN (IN FMT.LK). ;AT THIS POINT, WE MUST DO SOMETHING WHICH LOOKS RATHER CURIOUS - WE SAVE ;THE CURRENT LINK (THAT IS, LEFT PAREN) POINTER IN THE INDEFINITE REPEAT ;POINTER, UNLESS THERE IS NO LINK (RH=0). THIS HAS THE EFFECT OF POINTING ;TO THE LEFT PAREN WHICH MATCHES THE NEXT TO LAST RIGHT PAREN (WE AVOID ;RESETTING IT TO THE OUTERMOST PAREN (THE INITIAL SETTING) BY NOT SAVING ;THE NO-LINK ENTRY). ;THE PATHOLOGICAL CASES "FALL OUT" FROM THIS PROCEDURE - IF THE ;INITIAL LEFT PAREN IS MISSING, FMT.LK, THE LINK, WILL BE ZERO WHEN ;THE MATCHING RIGHT PAREN (OR FAKE RIGHT PAREN PLACED THERE BY THE ;FORMAT ENCODER) IS EXECUTED. THIS HAS BEEN CODED TO END FORMAT EXECUTION. EXEPRC: SKIPN ENC.PT ;IF PNTR IS 0 POPJ P, ;WE ABORTED I/O SKIPL @ENC.PT ;PAREN? JRST EXENRM ;NO. NORMAL EXECUTION PUSH P,ENC.RP ;YES. SAVE OLD REPEAT COUNT PUSH P,FMT.LK ;AND LINK ADDR HLRE T1,@ENC.PT ;GET THE NEW REPEAT COUNT MOVN T1,T1 ;POSITIVE MOVEM T1,ENC.RP ;SAVE IT MOVE T1,ENC.PT ;GET THE PAREN WORD MOVEM T1,FMT.LK ;SAVE FOR LINK AOS ENC.PT ;INC THE FORMAT PNTR PUSHJ P,EXEPRC ;RECURSIVE CALL SKIPN ENC.PT ;DID WE STOP? JRST ENDEXE ;YES. LEAVE MOVE T1,FMT.LK ;GET THE LINK HRRZ T2,(T1) ;GET THE ADDR JUMPE T2,ENDEXE ;DON'T STORE ZERO! XMOVEI T2,(T2) ;GET SECTION NUMBER ALSO MOVEM T2,ENC.PT ;LINK THE PROCESSOR ENDEXE: POP P,FMT.LK ;RESTORE PREVIOUS LINK POP P,ENC.RP ;AND REPEAT COUNT JRST EXEPRC ;AND START AGAIN EXENRM: SKIPN T1,@ENC.PT ;GET FORMAT WORD JRST EXENLP ;HIT END OF LIST MOVEM T1,ENC.WD ;SAVE FOR CODE RETRIEVAL LDB T1,CODPNT ;GET FORMAT CHAR MOVE T1,FMT.CT(T1) ;GET TABLE ENTRY TXNN T1,IOLFLG ;DO WE NEED I/O LIST ENTRY? JRST NODATA ;NO MOVEM T1,IO.TBL ;Save flags and table entry for later SKIPLE ENC.LR ;ANY LEFTOVER REPEAT COUNT? JRST LROK ;YES. USE IT LDB T1,RPTPNT ;NO. GET IT FROM FORMAT WORD MOVEM T1,ENC.LR ;SAVE IT LROK: SETOM FMT.IU ;YES, SET I/O LIST ENTRY USED FLAG DATLP: SKIPN IO.ADR ;DO WE HAVE ADDR ALREADY? JRST GETADR ;NO. GO GET IT GOTADR: HRRZ T1,IO.TBL ;GET I/O ROUTINE PNTR HLRZ T1,(T1) ;GET JUST EXEC ADDR MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%IO ;OUTPUT? JRST DATIN ;NO. GO DO INPUT HRRZ T1,(T1) ;GET OUTPUT SUBR ADDR PUSHJ P,(T1) ;DO IT JRST DATINC ;DID NOT END. GO INC DATA PNTR POPJ P, ;WE HAVE BEEN TOLD TO STOP! GETADR: PUSHJ P,%%GETIO ;NO. GET THE DATA ADDR SKIPE IO.ADR ;DID WE GET IT? JRST GOTADR ;YES. SETZM ENC.PT ;NO. END EXECUTION POPJ P, DATIN: HLRZ T1,(T1) ;GET INPUT SUBR ADDR PUSHJ P,(T1) ;DO IT LDB T1,WIDPNT ;FREE FORMAT? JUMPN T1,DATINC ;NO. MOVE T1,IO.TBL ;Get flags and table entry TXNE T1,SKPFLG ;YES. DID WE ACTUALLY READ DATA? PUSHJ P,SFDEL ;YES. SCAN FOR NEXT DELIM DATINC: SKIPN T1,IO.INC ;ADD OFFSET TO I/O ADDR JRST CPXINC ;IF IT'S ZERO, ADD COMPLEX INCREMENT DATIN2: ADDM T1,IO.ADR ;TO I/O ADDR SOSG IO.NUM ;DECR LOCAL DATA COUNT SETZM IO.ADR ;CLEAR I/O ADDR IF NONE LEFT SOSLE ENC.LR ;DECR LOCAL REPEAT COUNT JRST DATLP ;MORE TO GO AOS ENC.PT ;ON TO NEXT FORMAT JRST EXEPRC ;AND BACK FOR MORE FORMAT CPXINC: HRRE T1,CP.INC ;GO TO IMAG PART OR NEXT ENTRY MOVSS CP.INC ;AND PREPARE FOR NEXT TIME JRST DATIN2 ;BACK TO USUAL INCREMENT CODE EXENLP: SKIPE T1,FMT.LK ;GET ADDR BEFORE START SOSG ENC.RP ;DECR REPEAT COUNT POPJ P, ;END OF LIST OR COUNT EXHAUSTED ADDI T1,1 ;RESET PNTR MOVEM T1,ENC.PT ;TO LOOP JRST EXEPRC ;START AGAIN NODATA: HRRZ T1,T1 ;GET I/O ROUTINE PNTR HLRZ T1,(T1) ;GET EXECUTION TABLE PNTR PUSHJ P,DOEXE ;DO IT AOS ENC.PT ;ON TO NEXT FORMAT JRST EXEPRC DOEXE: MOVE T1,(T1) ;GET THE ADDR PAIR MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%IO ;OUTPUT? HLRZ T1,T1 ;NO. GET THE INPUT ADDR HRRZ T1,T1 ;CLEAR OUT THE LEFT HALF PJRST (T1) ;DO IT ;G-FORMAT I/O. USES THE DATA TYPE TO FIGURE OUT WHAT TO DO GIN: MOVE T1,IO.TYP ;GET VARIABLE TYPE HLRZ T1,GTAB(T1) ;GET I/O CONV ADDRESS PJRST (T1) ;DO IT GOUT: MOVE T1,IO.TYP ;GET VARIABLE TYPE HRRZ T1,GTAB(T1) ;GET OUTPUT CONV ADDRESS PJRST (T1) ;DO IT ;SCAN FOR A DELIMITER - FOR "FREE-FORMAT" INPUT, ;WE HAVE TO SCAN UNTIL WE REACH A "DELIMITER" FOR THIS TYPE ;OF INPUT, TO AVOID GETTING FAKE NULL VALUES FOR SUCH THINGS ;AS . THE DELIMITERS FOR ;FREE-FORMAT ARE ANY NON-BLANK CHARACTERS AND END-OF-LINE. ;IF THE NON-BLANK CHARACTER IS NOT A COMMA, THE BYTE POINTER ;IS BACKED UP VIA A CALL TO %IBACK SO THAT THE NEXT CALL ;TO %IBYTE WILL GET IT. SFDEL: PUSHJ P,%IBYTC ;GET CURRENT CHAR JRST DELGOT ;SKIP NEW CHAR SFDLP1: PUSHJ P,%IBYTE ;GET NEXT CHAR DELGOT: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%EOR ;REACH END OF RECORD? POPJ P, ;YES CAIE T1," " ;SKIP SPACES AND TABS CAIN T1," " JRST SFDLP1 CAIE T1,"," ;LEAVE ON COMMA JRST %IBACK ;ELSE PUSH THE POINTER BACK POPJ P, ;DOLLAR SIGN EXECUTION (SOUNDS LIKE SOCIALISM OR SOMETHING)... ;IGNORE IT ON INPUT, CALL SPECIAL ROUTINE ON OUTPUT WHICH OUTPUTS ;THE RECORD WITHOUT A CARRIAGE RETURN FOR OUTPUT. NOCR: MOVX T0,D%STCR ;Suppress trailing CR IORM T0,FLAGS(D) POPJ P, ;COLON - FOR OUTPUT, IF THE I/O LIST IS DONE, CLEAR THE ENCODED STACK POINTER ;AS A SIGNAL TO THE FORMAT EXECUTION TO STOP. CHKDAT: SKIPN IO.ADR ;DO WE HAVE I/O ADDR? PUSHJ P,%%GETIO ;NO. GET NEXT I/O ADDR SKIPE IO.ADR ;DID WE GET IT? POPJ P, ;YES. EVERYTHING'S FINE SETZM ENC.PT ;NO. END EXECUTION AOS (P) ;AND SKIP RETURN POPJ P, ;BNZ - BN AND BZ FORMAT ;IF THE LETTER AFTER THE B WAS A "Z", TURN ON THE ;BZ FORMAT FLAG, WHICH FORCES BLANKS TO BE INTERPRETED ;AS ZEROES FOR FIXED FORMAT FIELDS. OTHERWISE TURN OFF ;THE BZ FORMAT FLAG BNZ: LDB T1,WIDPNT ;GET ARG MOVX T0,D%BZ ;Assume not Z ANDCAM T0,FLAGS(D) CAIN T1,"Z" IORM T0,FLAGS(D) ;Was "Z", set flag POPJ P, ;H-FORMAT - THE BYTE POINTER TO THE HOLLERITH STRING HAS ;BEEN STORED IN THE NEXT ENTRY IN THE FORMAT STACK. THE ;NUMBER OF CHARACTERS IS IN THE WIDTH FIELD. HOUT: AOS ENC.PT ;INCR TO BYTE PNTR LDB T2,RPTPNT ;GET # CHARS MOVE T3,@ENC.PT ;Get byte ptr HOUTLP: ILDB T1,T3 ;GET CHAR PUSHJ P,%OBYTE ;OUTPUT IT SOJG T2,HOUTLP ;BACK FOR MORE POPJ P, ;Q FORMAT - RETURNS THE NUMBER OF CHARS LEFT IN THE RECORD ;INTO THE SPECIFIED VARIABLE (INTEGER!). QIN: SKIPGE T1,IRCNT(D) ;GET # CHARS LEFT SETZ T1, ;PAST END OF RECORD, RETURN 0 MOVEM T1,@IO.ADR ;PUT INTO USER'S VARIABLE ; POPJ P, QOUT: POPJ P, ;P FORMAT - SETS THE SCALE FACTOR. THE SCALE FACTOR ;HAS BEEN STORED AS IF IT WERE A REPEAT COUNT, SO WE ;HAVE TO DO SOME CONTORTIONS IN ORDER TO EXTEND THE SIGN PFACT: LDB T1,RPTPNT ;GET REPEAT COUNT TRNE T1,400 ;SIGN BIT ON? ORCMI T1,777 ;YES. TURN THE REST ON MOVEM T1,SCL.SV ;SAVE IT POPJ P, ;SSP - HANDLES S,SP, AND SS FORMATS. ;THE DEC IMPLEMENTATION OF THIS FORMAT MEANS THAT S FORMAT ;MEANS SS, SINCE WE DO NOT OUTPUT A PLUS SIGN ;UNDER NORMAL CIRCUMSTANCES. SO THERE IS A SINGLE FLAG, WHICH JUST ;SAYS WHETHER OR NOT TO FORCE A PLUS SIGN (AND THEN ONLY IF IT WILL ;FIT!), CORRESPONDING TO SP AND SS. SSP: LDB T1,WIDPNT ;GET THE CODE MOVX T0,D%SP ;Assume not "P" ANDCAM T0,FLAGS(D) CAIN T1,"P" ;IS IT P? IORM T0,FLAGS(D) ;Yes, set flag POPJ P, ;T FORMAT - POSITIONS RECORD POINTER. ;ARGUMENT IS IN WIDTH FIELD TABREC: LDB P3,DECPNT ;GET L OR R JUMPN P3,LRPOS ;GO PROCESS THEM IF THERE LDB T1,WIDPNT ;GET VALUE JUMPG T1,%SPOS ;SEND REQUESTED POSITION MOVEI T1,1 ;IF LESS THAN 1, SET TO 1 PJRST %SPOS LRPOS: PUSHJ P,%RPOS ;GET CURRENT POSITION LDB T2,WIDPNT ;GET FORMAT ARG CAIN P3,'L' ;IS IT TAB LEFT? MOVNI T2,(T2) ;YES. NEGATE TAB ADD T1,T2 ;AND SET NEW POSITION JUMPG T1,%SPOS ;SEND REQUESTED POSITION MOVEI T1,1 ;REQ COL 1 IF OFF LEFT OF RECORD PJRST %SPOS ;X FORMAT - SIMILAR TO T FORMAT, BUT WITH REPEAT COUNT INSTEAD ;OF WIDTH FOR ITS VALUE POSREC: PUSHJ P,%RPOS ;GET CURRENT RECORD POSITION LDB T2,RPTPNT ;GET ARG OF X-FORMAT ADD T1,T2 ;ADD THE 2 JUMPG T1,%SPOS ;INCR TO POS WHERE WE WANT NEXT CHAR MOVEI T1,1 ;BUT IF NEG OR ZERO PJRST %SPOS ;JUST SUPPLY 1 ;SINGLE QUOTE OUTPUT - LIKE HOLLERITH, THE BYTE POINTER IS STORED ;AS THE NEXT (1 OR 2) WORD ON THE FORMAT STACK, AND THE CHARACTER COUNT IS ;STORED AS THE WIDTH. UNLIKE HOLLERITH, DOUBLE APOSTROPHES MUST BE ;TURNED INTO SINGLE APOSTROPHES. SQOUT: AOS ENC.PT ;INCR TO BYTE PNTR LDB T2,WIDPNT ;GET THE # CHARS JUMPE T2,SQODON ;DONE IF NO CHARS MOVE T3,@ENC.PT ;Get the byte ptr. SQOLP: ILDB T1,T3 ;GET CHAR CAIE T1,"'" ;IS IT A QUOTE? JRST PUTNSQ ;NO. GO OUTPUT IT SOJLE T2,SQODON ;DECR AND LEAVE IF NO MORE IBP T3 ;INCR PAST THE NEXT CHAR PUTNSQ: PUSHJ P,%OBYTE ;AND PRINT CHAR SOJG T2,SQOLP ;BACK FOR MORE SQODON: POPJ P, ;SINGLE QUOTE INPUT - ALLOWS THE USER TO OVERWRITE A QUOTED STRING ;IN THE FORMAT STATEMENT. DISALLOWED BY THE ANSI STANDARD, BUT WE ;DO IT ANYWAY. SQIN: AOS ENC.PT ;INCR TO BYTE POINTER LDB T2,WIDPNT ;GET # CHARS TO INPUT JRST HIN0 ;REST IS SAME AS HOLLERITH ;HOLLERITH INPUT - A STUPID WAY TO WRITE PROGRAMS, BUT ELLIOT ;ORGANICK USES IT AS AN EXAMPLE IN HIS INTRO TO FORTRAN! THE NUMBER ;OF CHARACTERS SPECIFIED IN THE FIELD ARE READ FROM THE INPUT RECORD ;AND WRITTEN INTO THE ORIGINAL FORMAT STATEMENT. HIN: AOS ENC.PT ;INCR TO BYTE PNTR LDB T2,RPTPNT ;GET # CHARS TO INPUT HIN0: MOVE T3,@ENC.PT ;Get the byte ptr HINLP: PUSHJ P,%IBYTE ;GET A CHAR IDPB T1,T3 ;DEPOSIT INTO FORMAT SOJG T2,HINLP ;BACK FOR MORE POPJ P, ;GTFCHR - GET THE NEXT CHARACTER IN THE FORMAT. ;EXCEPT FOR H-FORMAT AND QUOTED STRINGS, WE DO NOT WANT ;NULL CHARACTERS FROM THE FORMAT STATEMENT. ADDITIONALLY, ;PROVISION HAS BEEN MADE IF WE READ TOO FAR WE SAVE THE ;CHARACTER READ AS THE "PREVIOUS CHAR" AND RETRIEVE IT THE ;NEXT TIME GTFCHR IS CALLED. GTFCHR: SKIPE T1,FMT.PC ;Is there a previous char? JRST PREVCH ;Yes, go clear it NOPREV: SOSGE FMT.SZ ;ANY CHARS LEFT? POPJ P, ;NO. RETURN WITH NULL ILDB T1,FMT.BP ;GET A CHAR JUMPE T1,NOPREV ;SKIP NULLS CAILE T1,140 ;LOWER CASE? SUBI T1,40 ;YES. CONVERT TO UPPER POPJ P, PREVCH: SETZM FMT.PC ;IF ONE, NOW CLEAR IT POPJ P, ;SO WE WON'T GET IT AGAIN FMTERR: ;IOERR (ILF,,,?,Illegal character in format,,%ABORT) $ECALL ILF,%ABORT FMTER3: $SNH ;ROUTINE TO CONVERT CALLING CONVENTIONS ;RETURN: IO.ADR = ADDRESS OF I/O ITEM ; IO.TYP = DATA TYPE ; ** WARNING: Smashes perm acs ** %%GETIO:: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%EOI ;IO LIST ALREADY AT END? POPJ P, ;YES. RETURN NIOEND: PUSHJ P,%GETIO ;NO, GO GET IT JUMPN T1,GETIO1 ;JUMP IF NOT END OF IO LIST MOVX T0,D%EOI ;Flag it IORM T0,FLAGS(D) GETIO1: SETZM CP.INC ;CLEAR THE COMPLEX INCREMENT MOVEM T1,IO.ADR ;STORE ADDRESS MOVE T0,FLAGS(D) TXNN T0,D%LSD ;LIST-DIRECTED? CAIE T2,TP%CPX ;No, COMPLEX? JRST NOTCPX ;LIST-DIRECTED OR NOT COMPLEX MOVEI T2,TP%SPR ;YES. SUBSTITUTE REAL ASH T3,1 ;DOUBLE COUNT SUBI T4,1 ;PREPARE COMPLEX INCREMENT HRLI T4,1 MOVSM T4,CP.INC ;[INCR-1,,1] SETZ T4, ;AND ZERO STANDARD INCREMENT NOTCPX: MOVEM T2,IO.TYP ;STORE TYPE DMOVEM T3,IO.NUM ;AND COUNT AND INCREMENT POPJ P, ;DONE SEGMENT DATA CP.INC: BLOCK 1 IO.ADR:: BLOCK 1 IO.TYP:: BLOCK 1 IO.NUM:: BLOCK 1 ;Do not split IO.NUM and IO.INC IO.INC:: BLOCK 1 IO.INF:: BLOCK 1 IO.TBL: BLOCK 1 ;Save flags and table address in EXENRM ILLEG.:: 0 SEGMENT CODE PURGE $SEG$ END