ref: a73cbb099ae671c0d68709a96876b0940370e37d
parent: d1b0478470d6cffc5c89a457ae357adab199b37c
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Jun 17 18:36:02 EDT 2024
more stuff
--- a/otf.rkt
+++ b/otf.rkt
@@ -32,7 +32,7 @@
(define/contract (format f)
(-> procedure? string?)
(define-values (a b) (partition c-typedef? (flatten (map f cmplxs))))
- (define ps (list "/* this file is generated. do not modify. */\n" a b (map f types) ""))
+ (define ps (list "/* this file is generated. do not modify. */" a b (map f types) ""))
(string-join (flatten ps) "\n"))
(define-generics code
@@ -75,17 +75,20 @@
(define (wrap-cond-c cond lst)
(match cond
[#f lst]
- [(list 'cond op ref n) (block (~a "if(v->" ref " " op " " n ")") (indent lst))]))
+ [(list 'cond op ref n ...)
+ (block (~a "if(" (string-join (map (λ (n) (~a "v->" ref " " op " " n)) n) " || ") ")")+ (indent (flatten lst)))]))
(define (field-fprint-c f)
(define t (field-type f))
(define count (field-count f))
(define end (and count (if (cmplx? t) (~a "v->" (cadr count)) (cadr count))))
- (define fixed-array (and (type? t) (number? end)))
+ (define basic-array (and (type? t) end))
+ (define fixed-array (and basic-array (number? end)))
(define array-index (if (field-count f) "[i]" ""))
(define verb (if (type? t) (if (field-verb f) (cadr (field-verb f)) (type-verb t)) ""))
(define fprint-index
- (if fixed-array
+ (if basic-array
(~a "fprint(f, \"%*s%s[%d]: "
verb
"\\n\", indent, \"\", \""
@@ -99,7 +102,7 @@
(if count
(λ (lst)
(block (~a "for(int i = 0; i < " (if fixed-array "" "v->") (cadr count) "; i++)")
- (indent (list* fprint-index (if fixed-array empty lst)))))
+ (indent (list* fprint-index (if basic-array empty lst)))))
identity))
(define lst
(list
@@ -117,7 +120,7 @@
(define (invert-c op)
(match op
- ['= '!=]
+ ['== '!=]
['<= '>]
['>= '<]
['< '>=]
@@ -160,11 +163,16 @@
(~a "if(read_" (name (field-type f)) "(ctx, &" ref ") < 0){"))) (if index empty (~a "if(skip_bytes(ctx, " (size (field-type f)) ") < 0){")))][count
- #:when (and (number? (cadr count)) (type? (field-type f)))
+ #:when (type? (field-type f))
(if (field-unused? f)
empty
- (list (~a "for(int i = 0; i < " (cadr count) "; i++)")
- (~a "\t" ref "[i] = " ((type-parse (field-type f)) b index "i") ";")))]
+ (list
+ (~a "for(int i = 0; i < " (if (number? (cadr count)) "" "v->") (cadr count) "; i++)")
+ (~a "\t"
+ ref
+ "[i] = "
+ ((type-parse (field-type f)) b index (~a "i*" (size (field-type f))))
+ ";")))]
[count
(~a "if(ctxarray(ctx, &"
ref
@@ -211,12 +219,17 @@
(define/generic super-gen-c gen-c)
(define (gen-h c)
(flatten (append (list (~a "typedef struct " (cmplx-name c) " " (cmplx-name c) ";")
+ (~a "")
(~a "struct " (cmplx-name c) " {"))(indent (flatten (map super-gen-h (cmplx-fields c))))
(indent (filter-extra (cmplx-extra c) 'field))
(list (~a "};")
+ (~a "")
(~a "int read_" (cmplx-name c) "(Ctx *ctx, " (cmplx-name c) " *v);")))))
(define (gen-c c b index)
+ (define (no-vla? f)
+ (define cnt (field-count f))
+ (or (not cnt) (number? (cadr cnt))))
; group fields to minimize number of reads
; complex types are always alone
; simple types can be combined unless versioned
@@ -226,6 +239,8 @@
(or (empty? g)
(and (type? (field-type f))
(type? (field-type (car g)))
+ (no-vla? f)
+ (no-vla? (car g))
(equal? (field-cond f) (field-cond (car g))))))
(define (group- g fields)
(match fields
@@ -238,23 +253,33 @@
[#f (type-size (field-type f))]
[count
#:when (type? (field-type f))
- (* (cadr count) (type-size (field-type f)))]))
+ ((if (number? (cadr count))
+ (λ (sz) (* (cadr count) sz))
+ (λ (sz) (~a "v->" (cadr count) "*" sz)))
+ (type-size (field-type f)))]))
+ (define (add x y)
+ (match (list x y)
+ [(list _ 0) x]
+ [(list 0 _) y]
+ [_ (if (and (number? x) (number? y)) (+ x y) (~a x "+" y))]))
(define (parse-group g)
(define (p fs index)
(if (pair? fs)
- (cons (super-gen-c (car fs) "b" index) (p (cdr fs) (+ index (field-size (car fs)))))
+ (cons (super-gen-c (car fs) "b" index) (p (cdr fs) (add index (field-size (car fs)))))
empty))
(p g 0))
(define (gen-group-c fields)
- (if (cmplx? (field-type (car fields)))
- (map (λ (f) (super-gen-c f #f #f)) fields)
- (let* ([sum (apply + (map (λ (f) (field-size f)) fields))]
- [lst (flatten (list* (~a "if((b = ctxreadn(ctx, " sum ")) == nil)")
- (~a "\tgoto err;")
- (parse-group fields)))])
- (wrap-cond-c (field-cond (car fields)) lst))))
+ (wrap-cond-c (field-cond (car fields))
+ (if (cmplx? (field-type (car fields)))
+ (map (λ (f) (super-gen-c f #f #f)) fields)
+ (let* ([sum (foldr (λ (f accu) (add (field-size f) accu)) 0 fields)]
+ [lst (flatten (list* (~a "if((b = ctxreadn(ctx, " sum ")) == nil)")
+ (~a "\tgoto err;")
+ (parse-group fields)))])
+ lst))))
(flatten
- (append (list (~a "int")
+ (append (list (~a "")
+ (~a "int")
(~a "read_" (cmplx-name c) "(Ctx *ctx, " (cmplx-name c) " *v)")
(~a "{")(~a "\tu8int *b;"))
@@ -265,7 +290,8 @@
(~a "\twerrstr(\"%s: %r\", \"" (cmplx-name c) "\");")
(~a "\treturn -1;")
(~a "}"))
- (list (~a "void")
+ (list (~a "")
+ (~a "void")
(~a "fprint_" (cmplx-name c) "(int f, int indent, " (cmplx-name c) " *v)")
(~a "{")(indent (flatten (map field-fprint-c (cmplx-fields c))))
@@ -315,11 +341,11 @@
[(_ (n:number)) #''(count n)]
[(_ {~literal hex}) #''(verb "%#ux")][(_ (p:expr vs:number ...+)) #''(test p vs ...)]
- [(_ (p:expr ref:id n:number))
+ [(_ (p:expr ref:id vs:number ...+))
#''(cond
p
ref
- n)]
+ vs ...)]
[(_ ({~literal count} n:id))(begin
(define counter (assoc (syntax->datum #`n) fields))
@@ -384,19 +410,19 @@
(mkfields {uint16 platformID (<= 4)} {uint16 encodingID} {Offset32 subtableOffset}))(mkcmplx TableCmap
- (mkfields {uint16 version unused (= 0)}+ (mkfields {uint16 version unused (== 0)} {uint16 numTables} {EncodingRecord encodingRecords (count numTables)})#:tag "cmap")
(mkcmplx TableHead
- (mkfields {uint16 majorVersion unused (= 1)}- {uint16 minorVersion unused (= 0)}+ (mkfields {uint16 majorVersion unused (== 1)}+ {uint16 minorVersion unused (== 0)} {Fixed fontRevision unused} {uint32 checksumAdjustment unused}- {uint32 magicNumber unused (= #x5f0f3cf5)}+ {uint32 magicNumber unused (== #x5f0f3cf5)} {uint16 flags}- {uint16 unitsPerEm}+ {uint16 unitsPerEm (>= 16) (<= 16384)} {LONGDATETIME created} {LONGDATETIME modified} {int16 xMin}@@ -407,12 +433,12 @@
{uint16 lowestRecPPEM} {int16 fontDirectionHint unused (>= -2) (<= 2)} {int16 indexToLocFormat (<= 1)}- {int16 glyphDataFormat unused (= 0)})+ {int16 glyphDataFormat unused (== 0)})#:tag "head")
(mkcmplx TableHhea
- (mkfields {uint16 majorVersion (= 1)}- {uint16 minorVersion (= 0)}+ (mkfields {uint16 majorVersion (== 1)}+ {uint16 minorVersion (== 0)} {FWORD ascender} {FWORD descender} {FWORD lineGap}@@ -424,12 +450,21 @@
{int16 caretSlopeRun} {int16 caretOffset} {int16 reserved [4] unused}- {int16 metricDataFormat (= 0)}+ {int16 metricDataFormat (== 0)} {uint16 numberOfHMetrics})#:tag "hhea")
+(mkcmplx LongHorMetric (mkfields {UFWORD advanceWidth} {FWORD lsb}))+
+#|
+FIXME what. WHAT.
+(mkcmplx TableHmtx
+ (mkfields {LongHorMetric hMetrics (count (TableHhea numberOfHMetrics))}+ {FWORD leftSideBearings (count (- (TableMaxp numGlyphs) (TableHhea numberOfHMetrics)))}))+|#
+
(mkcmplx TableMaxp
- (mkfields {Version16Dot16 version (= #x05000 #x10000) unused}+ (mkfields {Version16Dot16 version (== #x05000 #x10000) unused} {uint16 numGlyphs}; a bunch of fields ignored here
)
@@ -436,7 +471,7 @@
#:tag "maxp")
(mkcmplx TablePost
- (mkfields {Version16Dot16 version (= #x10000 #x20000 #x25000 #x30000) unused}+ (mkfields {Version16Dot16 version (== #x10000 #x20000 #x25000 #x30000) unused} {Fixed italicAngle} {FWORD underlinePosition} {FWORD underlineThickness}@@ -445,6 +480,25 @@
)
#:tag "post")
+(mkcmplx NameRecord
+ (mkfields {uint16 platformID}+ {uint16 encodingID}+ {uint16 languageID}+ {uint16 nameID}+ {uint16 length}+ {Offset16 stringOffset}))+
+(mkcmplx LangTagRecord (mkfields {uint16 length} {Offset16 langTagOffset}))+
+(mkcmplx TableName
+ (mkfields {uint16 version (== 0 1)}+ {uint16 count}+ {Offset16 storageOffset}+ {NameRecord nameRecord (count count)}+ {uint16 langTagCount (>= version 1)}+ {LangTagRecord langTagRecord (count langTagCount) (>= version 1)})+ #:tag "name")
+
(mkcmplx BigGlyphMetrics
(mkfields {uint8 height} {uint8 width}@@ -486,12 +540,207 @@
{int8 flags}))(mkcmplx TableEBLC
- (mkfields {uint16 majorVersion (= 2) unused}- {uint16 minorVersion (= 0) unused}+ (mkfields {uint16 majorVersion (== 2) unused}+ {uint16 minorVersion (== 0) unused} {uint32 numSizes} {BitmapSize bitmapSizes (count numSizes)})#:tag "EBLC")
+(mkcmplx AttachList
+ (mkfields {Offset16 coverageOffset}+ {uint16 glyphCount}+ {Offset16 attachPointOffsets (count glyphCount)}))+
+(mkcmplx AttachPoint (mkfields {uint16 pointCount} {uint16 pointIndices (count pointCount)}))+
+(mkcmplx LigCaretList
+ (mkfields {Offset16 coverageOffset}+ {uint16 ligGlyphCount}+ {Offset16 ligGlyphOffsets (count ligGlyphCount)}))+
+(mkcmplx LigGlyph (mkfields {uint16 caretCount} {Offset16 caretValueOffsets (count caretCount)}))+
+(mkcmplx CaretValue
+ (mkfields {uint16 format (>= 1) (<= 3)}+ {int16 coordinate (== format 1 3)}+ {uint16 caretValuePointIndex (== format 2)}+ {Offset16 deviceOffset (== format 3)}))+
+(mkcmplx ValueRecord
+ (mkfields {int16 xPlacement}+ {int16 yPlacement}+ {int16 xAdvance}+ {int16 yAdvance}+ {Offset16 xPlaDeviceOffset}+ {Offset16 yPlaDeviceOffset}+ {Offset16 xAdvDeviceOffset}+ {Offset16 yAdvDeviceOffset}))+
+(mkcmplx SinglePos
+ (mkfields {uint16 format (== 1 2)}+ {Offset16 coverageOffset}+ {uint16 valueFormat}+ {ValueRecord valueRecord (== format 1)}+ {uint16 valueCount (== format 2)}+ {ValueRecord valueRecords (== format 2) (count valueCount)}))+
+(mkcmplx TableGDEF
+ (mkfields {uint16 majorVersion (== 1) unused}+ {uint16 minorVersion (== 0 2 3)}+ {Offset16 glyphClassDefOffset}+ {Offset16 attachListOffset}+ {Offset16 ligCaretListOffset}+ {Offset16 markAttachClassDefOffset}+ {Offset16 markGlyphSetsDefOffset (>= minorVersion 2)}+ {Offset32 itemVarStoreOffset (>= minorVersion 3)})+ #:tag "GDEF")
+
+(mkcmplx TableGPOS
+ (mkfields {uint16 majorVersion (== 1) unused}+ {uint16 minorVersion (<= 1)}+ {Offset16 scriptListOffset}+ {Offset16 featureListOffset}+ {Offset16 lookupListOffset}+ {Offset32 featureVariationsOffset (== minorVersion 1)})+ #:tag "GPOS")
+
+(mkcmplx TableGSUB
+ (mkfields {uint16 majorVersion (== 1) unused}+ {uint16 minorVersion (<= 1)}+ {Offset16 scriptListOffset}+ {Offset16 featureListOffset}+ {Offset16 lookupListOffset}+ {Offset32 featureVariationsOffset (== minorVersion 1)})+ #:tag "GSUB")
+
+(mkcmplx TableMATH
+ (mkfields {uint16 majorVersion (== 1) unused}+ {uint16 minorVersion (== 0) unused}+ {Offset16 mathConstantsOffset}+ {Offset16 mathGlyphInfoOffset}+ {Offset16 mathVariantsOffset})+ #:tag "MATH")
+
+(mkcmplx MathValueRecord (mkfields {FWORD value} {Offset16 deviceOffset}))+
+(mkcmplx MathConstants
+ (mkfields {int16 scriptPercentScaleDown}+ {int16 scriptScriptPercentScaleDown}+ {UFWORD delimitedSubFormulaMinHeight}+ {UFWORD displayOperatorMinHeight}+ {MathValueRecord mathLeading}+ {MathValueRecord axisHeight}+ {MathValueRecord accentBaseHeight}+ {MathValueRecord flattenedAccentBaseHeight}+ {MathValueRecord subscriptShiftDown}+ {MathValueRecord subscriptTopMax}+ {MathValueRecord subscriptBaselineDropMin}+ {MathValueRecord superscriptShiftUp}+ {MathValueRecord superscriptShiftUpCramped}+ {MathValueRecord superscriptBottomMin}+ {MathValueRecord superscriptBaselineDropMax}+ {MathValueRecord subSuperscriptGapMin}+ {MathValueRecord superscriptBottomMaxWithSubscript}+ {MathValueRecord spaceAfterScript}+ {MathValueRecord upperLimitGapMin}+ {MathValueRecord upperLimitBaselineRiseMin}+ {MathValueRecord lowerLimitGapMin}+ {MathValueRecord lowerLimitBaselineDropMin}+ {MathValueRecord stackTopShiftUp}+ {MathValueRecord stackTopDisplayStyleShiftUp}+ {MathValueRecord stackBottomShiftDown}+ {MathValueRecord stackBottomDisplayStyleShiftDown}+ {MathValueRecord stackGapMin}+ {MathValueRecord stackDisplayStyleGapMin}+ {MathValueRecord stretchStackTopShiftUp}+ {MathValueRecord stretchStackBottomShiftDown}+ {MathValueRecord stretchStackGapAboveMin}+ {MathValueRecord stretchStackGapBelowMin}+ {MathValueRecord fractionNumeratorShiftUp}+ {MathValueRecord fractionNumeratorDisplayStyleShiftUp}+ {MathValueRecord fractionDenominatorShiftDown}+ {MathValueRecord fractionDenominatorDisplayStyleShiftDown}+ {MathValueRecord fractionNumeratorGapMin}+ {MathValueRecord fractionNumDisplayStyleGapMin}+ {MathValueRecord fractionRuleThickness}+ {MathValueRecord fractionDenominatorGapMin}+ {MathValueRecord fractionDenomDisplayStyleGapMin}+ {MathValueRecord skewedFractionHorizontalGap}+ {MathValueRecord skewedFractionVerticalGap}+ {MathValueRecord overbarVerticalGap}+ {MathValueRecord overbarRuleThickness}+ {MathValueRecord overbarExtraAscender}+ {MathValueRecord underbarVerticalGap}+ {MathValueRecord underbarRuleThickness}+ {MathValueRecord underbarExtraDescender}+ {MathValueRecord radicalVerticalGap}+ {MathValueRecord radicalDisplayStyleVerticalGap}+ {MathValueRecord radicalRuleThickness}+ {MathValueRecord radicalExtraAscender}+ {MathValueRecord radicalKernBeforeDegree}+ {MathValueRecord radicalKernAfterDegree}+ {int16 radicalDegreeBottomRaisePercent}))+
+(mkcmplx MathGlyphInfo
+ (mkfields {Offset16 mathItalicsCorrectionInfoOffset}+ {Offset16 mathTopAccentAttachmentOffset}+ {Offset16 extendedShapeCoverageOffset}+ {Offset16 mathKernInfoOffset}))+
+(mkcmplx MathItalicsCorrectionInfo
+ (mkfields {Offset16 italicsCorrectionCoverageOffset}+ {uint16 italicsCorrectionCount}+ {MathValueRecord italicsCorrection (count italicsCorrectionCount)}))+
+(mkcmplx MathTopAccentAttachment
+ (mkfields {Offset16 topAccentCoverageOffset}+ {uint16 topAccentAttachmentCount}+ {MathValueRecord topAccentAttachment (count topAccentAttachmentCount)}))+
+(mkcmplx MathKernInfoRecord
+ (mkfields {Offset16 topRightMathKernOffset}+ {Offset16 topLeftMathKernOffset}+ {Offset16 bottomRightMathKernOffset}+ {Offset16 bottomLeftMathKernOffset}))+
+(mkcmplx MathKernInfo
+ (mkfields {Offset16 mathKernCoverageOffset}+ {uint16 mathKernCount}+ {MathKernInfoRecord mathKernInfoRecords (count mathKernCount)}))+
+(mkcmplx MathKern
+ (mkfields {uint16 heightCount}+ {MathValueRecord correctionHeight (count heightCount)}+ {MathValueRecord kernValues (count heightCount)}))+
+(mkcmplx MathVariants
+ (mkfields {UFWORD minConnectorOverlap}+ {Offset16 vertGlyphCoverageOffset}+ {Offset16 horizGlyphCoverageOffset}+ {uint16 vertGlyphCount}+ {uint16 horizGlyphCount}+ {Offset16 vertGlyphConstructionOffsets (count vertGlyphCount)}+ {Offset16 horizGlyphConstructionOffsets (count horizGlyphCount)}))+
+(mkcmplx MathGlyphVariantRecord (mkfields {uint16 variantGlyph} {UFWORD advanceMeasurement}))+
+(mkcmplx MathGlyphConstruction
+ (mkfields {Offset16 glyphAssemblyOffset}+ {uint16 variantCount}+ {MathGlyphVariantRecord mathGlyphVariantRecords (count variantCount)}))+
+(mkcmplx GlyphPart
+ (mkfields {uint16 glyphID}+ {UFWORD startConnectorLength}+ {UFWORD endConnectorLength}+ {UFWORD fullAdvance}+ {uint16 partFlags}))+
+(mkcmplx GlyphAssembly
+ (mkfields {MathValueRecord italicsCorrection}+ {uint16 partCount}+ {GlyphPart partRecords (count partCount)}))+
(mkcmplx TableOS∕2
(mkfields {uint16 version (<= 5)} {FWORD xAvgCharWidth}@@ -555,7 +804,7 @@
(~a "'" (string-ref t i) "'" (if (< i 3) (~a "<<" (* 8 (- 3 i))) "")))
(define case-tag (~a "(u32int)(" (string-join (map (λ (i) (ft tag i)) (range 4)) "|") ")"))(list (~a "\tcase " case-tag ":")
- (~a "\t\tv->" (ptr c) " = malloc(sizeof(" (cmplx-name c) "));")+ (~a "\t\tv->" (ptr c) " = calloc(1, sizeof(" (cmplx-name c) "));") (~a "\t\tif(read_" (cmplx-name c) "(ctx, v->" (ptr c) ") < 0){")(~a "\t\t\twerrstr(\"%s: %r\", \"" tag "\");")
(~a "\t\t\tfree(v->" (ptr c) ");")
@@ -579,7 +828,7 @@
(~a "}")))))
(mkcmplx TableDirectory
- (mkfields {uint32 sfntVersion (= #x00010000 #x4f54544f) hex}+ (mkfields {uint32 sfntVersion (== #x00010000 #x4f54544f) hex} {uint16 numTables} {uint16 searchRange} {uint16 entrySelector}@@ -597,6 +846,7 @@
#pragma varargck type "V" u32int
void otfinit(void);
+
EOF
)