From a6c34b62ceb7bef9a5cf53f7c70b32c1ea75b51c Mon Sep 17 00:00:00 2001 From: Joel Matthew Rees Date: Sat, 18 Feb 2023 19:55:22 +0900 Subject: [PATCH] Working on alignment in DOTQ and ERROR --- FIG68K.S | 242 +++++++++++++++++++++++++++++++++++++++---------------------- notes.text | 12 +++ 2 files changed, 168 insertions(+), 86 deletions(-) diff --git a/FIG68K.S b/FIG68K.S index f1b7791..3829d05 100644 --- a/FIG68K.S +++ b/FIG68K.S @@ -1267,35 +1267,54 @@ QODD DC.L *+NATWID MOVE.L D0,-(PSP) ; Save the test result as the flag. BRA.W NEXT * -* Not in fig, -* for CPUs that don't like odd addresses. -* Floor top of stack even. -* ( n --- even ) +* Not in fig -- +* Calculate the bump adjustment necessary for odd or even alignment. +* Odd for odd alignment, even for even. +* ( n alignment --- n bump ) EVEN DC.B 0 DC.B $86 - DC.B 'FLOOR' ; 'FLOOR2' - DC.B '2'|$80 - DC.L QODD-5-NATWID -FLOOR2 DC.L *+NATWID - AND.W #$FFFE,NATWID/2(PSP) + DC.B 'ALIGN' ; 'ALIGN-BUMP' + DC.B '+'|$80 + DC.L ALLOT-6-NATWID +ALGNB DC.L *+NATWID + MOVE.L (PSP),D0 + AND.L #1,D0 ; Even or odd alignment? + MOVE.L NATWID(PSP),D1 + AND.W #1,D1 ; Even address or odd? + EOR.W D0,D1 ; odd on even or even on odd is 1, else 0 + MOVE.L D1,(PSP) BRA.W NEXT * -* Not in fig, -* for CPUs that don't like odd addresses. -* Make top of stack even by adjusting it up. -* ( n --- even ) - EVEN - DC.B 0 - DC.B $88 - DC.B 'CIELING' ; 'CIELING2' - DC.B '2'|$80 - DC.L FLOOR2-7-NATWID -CIEL2 DC.L *+NATWID - BCLR #0,NATWID-1(PSP) - BEQ.S CIEL2X - ADDQ.L #2,(PSP) -CIEL2X BRA.W NEXT +** Not in fig, +** for CPUs that don't like odd addresses. +** Floor top of stack even. +** ( n --- even ) +* EVEN +* DC.B 0 +* DC.B $86 +* DC.B 'FLOOR' ; 'FLOOR2' +* DC.B '2'|$80 +* DC.L QODD-5-NATWID +* FLOOR2 DC.L *+NATWID +* AND.W #$FFFE,NATWID/2(PSP) +* BRA.W NEXT +** +** Not in fig, +** for CPUs that don't like odd addresses. +** Make top of stack even by adjusting it up. +** ( n --- even ) +* EVEN +* DC.B 0 +* DC.B $88 +* DC.B 'CIELING' ; 'CIELING2' +* DC.B '2'|$80 +* DC.L FLOOR2-7-NATWID +* CIEL2 DC.L *+NATWID +* BCLR #0,NATWID-1(PSP) +* BEQ.S CIEL2X +* ADDQ.L #2,(PSP) +* CIEL2X BRA.W NEXT * * ######>> screen 26 << * ======>> 23 << @@ -1950,6 +1969,18 @@ NATP DC.L *+NATWID MOVE.L D0,(PSP) BRA.W NEXT * +* Useful constant, not in model, needed for abstraction: +* ( --- NATWID/2 ) +* Half the byte width of objects on stack. + EVEN + DC.B 0 + DC.B $8A + DC.B 'HALFNATWI' ; 'HALFNATWID' + DC.B 'D'|$80 + DC.L NATP-5-NATWID +HNATWC DC.L DOCON +HNATWCV DC.L NATWID/2 +* PAGE * * ======>> 56 << @@ -1960,7 +1991,7 @@ NATP DC.L *+NATWID DC.B $82 DC.B 'B' ; 'BL' DC.B 'L'|$80 - DC.L NATP-5-NATWID + DC.L HNATWC-11-NATWID BL DC.L DOCON ; ascii blank DC.L $20 * @@ -2417,6 +2448,17 @@ HERE DC.L DOCOL,DICTPT,AT ALLOT DC.L DOCOL,DICTPT,PSTORE DC.L SEMIS * +* ( n --- ) +* Bump the DICTPT if necessary to odd or even alignment, according to n. +* Odd n for odd alignment, even n for even. + EVEN + DC.B $85 + DC.B 'ALIG' ; 'ALIGN-HERE' + DC.B 'N'|$80 + DC.L ALLOT-6-NATWID +ALIGNH DC.L DOCOL,ALGNB,ALLOT + DC.L SEMIS +* * ======>> 87 << * ( n --- ) * Store word n at DP++, @@ -2424,7 +2466,7 @@ ALLOT DC.L DOCOL,DICTPT,PSTORE EVEN DC.B $81 ; , (COMMA) DC.B ','|$80 - DC.L ALLOT-6-NATWID + DC.L ALIGNH-6-NATWID COMMA DC.L DOCOL,HERE,STORE,NATWC,ALLOT ; race condition DC.L SEMIS * COMMA DC.L DOCOL,HERE,STORE,TWO,ALLOT ; The model hard-coded TWO @@ -2443,19 +2485,32 @@ COMMA DC.L DOCOL,HERE,STORE,NATWC,ALLOT ; race condition CCOMM DC.L DOCOL,HERE,CSTORE,ONE,ALLOT ; race condition DC.L SEMIS * +* Not in model, but needed for 32-bit. +* ( h --- ) +* Store half cell h at DP+. +* Should ERROR check stack/heap. + EVEN + DC.B 0 + DC.B $82 + DC.B 'H' ; 'H,' + DC.B ','|$80 + DC.L CCOMM-3-NATWID +HCOMM DC.L DOCOL,HERE,HSTORE,HNATWC,ALLOT ; race condition + DC.L SEMIS +* * ======>> 89 << * ( n1 n2 --- n1-n2 ) * Subtract top two words. EVEN DC.B $81 ; - DC.B '-'|$80 - DC.L CCOMM-3-NATWID + DC.L HCOMM-3-NATWID SUB DC.L *+NATWID MOVE.L (PSP)+,D0 ; Subtraction is not commutative. SUB.L D0,(PSP) ; left side operand is the deeper one on the stack. BRA.W NEXT * SUB DC.L DOCOL,MINUS,PLUS -* DC.L SEMIS ; Costs lots of bytes and lots of cycles compared to native code. +* DC.L SEMIS ; Costs extra bytes and lots of cycles compared to native code. * * ( d1 d2 --- d1-d2 ) * Subtract top two integers. @@ -2769,11 +2824,12 @@ SCSP DC.L DOCOL,SPAT,CSP,STORE DC.B 'R'|$80 DC.L SCSP-5-NATWID * QERR DC.L *+NATWID -* LDD NATWID,U -* BNE QERROR -* LEAU 2*NATWID,U -* LBRA NEXT -** this doesn't work anyway: QERROR LBRA ERROR +* TST.L NATWID(PSP) +* BNE.S QERROR +* LEA NATWID(PSP),PSP +* BRA.W NEXT +** this doesn't work anyway: +* QERROR BRA.W ERROR QERR DC.L DOCOL,SWAP,ZBRAN DC.L QERR2-*-NATWID DC.L ERROR,BRAN @@ -3155,8 +3211,11 @@ DTRAL4 DC.L XLOOP DC.L DTRAIL-10-NATWID * PDOTQ DC.L DOCOL,R,TWOP,COUNT,DUP,ONEP * PDOTQ DC.L DOCOL,R,NATP,COUNT,DUP,ONEP -PDOTQ DC.L DOCOL,R,COUNT,DUP,ONEP ; A5/IP is post-inc. - DC.L FROMR,PLUS,TOR,TYPE +PDOTQ DC.L DOCOL,R ; A5/IP is post-inc. + DC.L COUNT,DUP,ONEP ; There's a count byte, too. + DC.L ALGNB,PLUS ; Align it. + DC.L FROMR,PLUS,TOR ; IP ready to continue after the string. + DC.L TYPE DC.L SEMIS * * ======>> 125 << @@ -3177,7 +3236,7 @@ DOTQ DC.L DOCOL DC.L STATE,AT,ZBRAN DC.L DOTQ1-*-NATWID DC.L COMPIL,PDOTQ,WORD - DC.L HERE,CAT,ONEP,ALLOT,BRAN + DC.L HERE,CAT,ONEP,ALGNB,PLUS,ALLOT,BRAN DC.L DOTQ2-*-NATWID DOTQ1 DC.L WORD,HERE,COUNT,TYPE DOTQ2 DC.L SEMIS @@ -3371,6 +3430,7 @@ HOLD DC.L DOCOL,LIT * ( --- adr ) * Give the address of the output PAD buffer. * PAD points to the end of a 68 byte buffer for numeric conversion. +* 68 bytes is enough to convert a 64-bit integer to binary. EVEN DC.B $83 DC.B 'PA' ; 'PAD' @@ -3483,6 +3543,66 @@ DFIND DC.L DOCOL,BL,WORD,HERE,CONTXT,AT,AT DFIND2 DC.L SEMIS * PAGE +* ######>> screen 50 << +* ======>> 142 << +* ( anything --- nothing ) ( anything *** nothing ) +* An indirection for ABORT, for ERROR, +* which may be modified carefully. + EVEN + DC.B $87 + DC.B '(ABORT' ; '(ABORT)' + DC.B ')'|$80 + DC.L DFIND-6-NATWID +PABORT DC.L DOCOL,ABORT + DC.L SEMIS +* +* ======>> 143 << +* ERROR ( anything line --- IN BLK ) ( anything *** nothing ) +* ( anything --- nothing ) +* ( anything *** nothing ) WARNING < 0 +* Prints out the last symbol scanned and MESSAGE number line. If +* WARNING is less than zero, ABORTs through (ABORT), otherwise, +* clears the parameter stack, pushes the INput cursor and +* interpretaion BLK, and QUITs. + EVEN + DC.B $85 + DC.B 'ERRO' ; 'ERROR' + DC.B 'R'|$80-NATWID + DC.L PABORT-8-NATWID +* This really should not be high level, according to best practices. +* But fixing that cascades through MESSAGE, +* requiring re-architecting the disk block system. +* First, we need to get this transliteration running. +ERROR DC.L DOCOL,WARN,AT,ZLESS + DC.L ZBRAN + DC.L ERROR2-*-NATWID +* note: WARNING is +* -1 to abort, +* 0 to print error # +* and 1 to print error message from disc + DC.L PABORT +ERROR2 DC.L HERE,COUNT,TYPE,PDOTQ + DC.B 4,7 ; ( bell ) + DC.B " ? " + DC.B 0 ; hand-align + DC.L MESS,SPSTOR,IN,AT,BLK,AT,QUIT + DC.L SEMIS +* +* ======>> 144 << +* ( n adr --- ) +* Mask byte at adr with n. +* Not in FIG, don't need it for 8 bit characters after all. +* EVEN +* DC.B $85 +* DC.B 'CMAS' ; 'CMASK' +* DC.B $CB ; 'K' +* DC.L ERROR-8 +* CMASK DC.L *+NATWID +* MOVE.L (PSP)+,A0 ; adr +* MOVE.L (PSP)+,D0 ; prepare for mask +* AND.B D0,(A0) +* BRA.W NEXT +* * * ######>> screen 63 << @@ -3694,56 +3814,6 @@ TRON FDB *+NATWID ******* Continue from the LOOP variables ******** -* ######>> screen 50 << -* ======>> 142 << -* ( anything --- nothing ) ( anything *** nothing ) -* An indirection for ABORT, for ERROR, -* which may be modified carefully. - FCB $87 - FCC '(ABORT' ; '(ABORT)' - FCB $A9 - FDB DFIND-8 -PABORT FDB DOCOL,ABORT - FDB SEMIS -* -* ======>> 143 << - FCB $85 - FCC 'ERRO' ; 'ERROR' - FCB $D2 - FDB PABORT-10 -* This really should not be high level, according to best practices. -* But fixing that cascades through MESSAGE, -* requiring re-architecting the disk block system. -* First, we need to get this transliteration running. -ERROR FDB DOCOL,WARN,AT,ZLESS - FDB ZBRAN - FDB ERROR2-*-NATWID -* note: WARNING is -* -1 to abort, -* 0 to print error # -* and 1 to print error message from disc - FDB PABORT -ERROR2 FDB HERE,COUNT,TYPE,PDOTQ - FCB 4,7 ( bell ) - FCC " ? " - FDB MESS,SPSTOR,IN,AT,BLK,AT,QUIT - FDB SEMIS -* -* ======>> 144 << -* ( n adr --- ) -* Mask byte at adr with n. -* Not in FIG, don't need it for 8 bit characters after all. -* FCB $85 -* FCC 'CMAS' ; 'CMASK' -* FCB $CB ; 'K' -* FDB ERROR-8 -* CMASK FDB *+NATWID -* LDX ,U++ ; adr -* LDD ,U++ ; mask -* ANDB ,X -* STB ,X -* LBRA NEXT -* * ( adr --- adr ) * Mask high bit of tail of name in PAD buffer. * Not in FIG, need it for 8 bit characters. diff --git a/notes.text b/notes.text index b6db753..44abc01 100644 --- a/notes.text +++ b/notes.text @@ -49,3 +49,15 @@ * That shouldn't be PCR in LATEST, it should be XCURR-UORIG,X . * Need to go back and check all allocating words for integer alignment issues. + +* No description for ERROR for some reason. + +* Need to figure out whether TYPE or PDOTQ will handle odd lenght strings. + +* PDOTQ and DOTQ have alignment adjuctment stuff. + +* PAD needs comment on buffer width + +* ERROR gets alignment adjustment. + + -- 2.11.0