--- /dev/null
+<PACKAGE "MMQGEN">
+
+<ENTRY MEMQ-GEN>
+
+<USE "CODGEN" "COMCOD" "CACS" "CHKDCL" "COMPDEC">
+
+
+<DEFINE MEMQ-GEN (N W
+ "OPTIONAL" (NOTF <>) (BRANCH <>) (DIR <>)
+ "AUX" (STR <2 <KIDS .N>>) (THING <1 <KIDS .N>>)
+ (TYP <RESULT-TYPE .STR>) (TPS <STRUCTYP .TYP>)
+ (TYP1 <COND (<ISTYPE? .TYP>) (ELSE .TPS)>)
+ (FLS <==? .W FLUSHED>) (SDIR .DIR)
+ (TTYP <RESULT-TYPE .THING>) (TAC <>)
+ (ETY <GET-ELE-TYPE .TYP ALL>)
+ (TWIN <TYPESAME .ETY .TTYP>)
+ (B2
+ <COND (<AND .FLS .BRANCH> .BRANCH) (ELSE <MAKE:TAG>)>)
+ SAC NAC STRD NUMD DEAD (TWOW <>) TEM TY DAC DCOD
+ (B3 <MAKE:TAG>) (RW .W) (FC <0? <MINL .TYP>>)
+ (LP <MAKE:TAG>) B4 (DEADV <>))
+ #DECL ((N STR THING) NODE (STRD NUMD) DATUM (DAC SAC NAC) AC (DCOD) FIX
+ (TPS TYP1 B2 B3 B4) ATOM (DEAD) <PRIMTYPE LIST>
+ (NK FLS DIR SDIR NOTF BRANCH) <OR FALSE ATOM>)
+ <SET W <GOODACS .N .W>>
+ <AND .NOTF <SET DIR <NOT .DIR>>>
+ <COND (<OR <==? .TPS STRING> <==? .TPS BYTES>> <SET TWOW T>)>
+ <SET TEM
+ <COND (<TYPE? .W DATUM> <GOODACS .N .W>)
+ (<AND .TWOW
+ <OR <AND <==? <NODE-TYPE .STR> ,LVAL-CODE>
+ <==? <LENGTH <SET DEAD <TYPE-INFO .STR>>> 2>
+ <NOT <2 .DEAD>>
+ <SET DEADV T>>
+ .FLS>>
+ DONT-CARE)
+ (.TWOW <DATUM ANY-AC ANY-AC>)
+ (ELSE <DATUM .TYP1 ANY-AC>)>>
+ <COND (<AND <NOT <SIDE-EFFECTS .N>>
+ <NOT <MEMQ <NODE-TYPE .STR> ,SNODES>>
+ <MEMQ <NODE-TYPE .THING> ,SNODES>>
+ <SET STRD <GEN .STR .TEM>>
+ <SET NUMD <GEN .THING DONT-CARE>>)
+ (ELSE
+ <SET NUMD
+ <GEN .THING
+ <COND (<AND <NOT <==? <NODE-TYPE .STR> ,QUOTE-CODE>>
+ <NOT .TWOW>
+ <SIDE-EFFECTS .STR>>
+ <GOODACS .THING <DATUM ANY-AC ANY-AC>>)
+ (ELSE DONT-CARE)>>>
+ <SET STRD <GEN .STR .TEM>>)>
+ <VAR-STORE <>>
+ <COND
+ (<NOT .TWIN>
+ <COND
+ (<SET TY <ISTYPE? .ETY>>
+ <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .NUMD>>>
+ <EMIT <INSTRUCTION `CAIE `O <FORM TYPE-CODE!-OP!-PACKAGE .TY>>>
+ <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>
+ <SET TWIN T>)
+ (<==? .TPS UVECTOR>
+ <EMIT <INSTRUCTION `HLRE
+ <ACSYM <SET SAC <GETREG <>>>>
+ !<ADDR:VALUE .STRD>>>
+ <PUT .SAC ,ACPROT T>
+ <TOACV .STRD>
+ <EMIT <INSTRUCTION `SUBM <ACSYM <DATVAL .STRD>> <ADDRSYM .SAC>>>
+ <PUT .SAC ,ACPROT <>>
+ <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
+ <ACSYM .SAC>
+ (<ADDRSYM .SAC>)>>
+ <COND (<SET TEM <ISTYPE? .TTYP>>
+ <EMIT <INSTRUCTION `CAIE
+ <ACSYM .SAC>
+ <FORM TYPE-CODE!-OP!-PACKAGE .TEM>>>)
+ (ELSE
+ <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O !<ADDR:TYPE .NUMD>>>
+ <EMIT <INSTRUCTION `CAIE `O (<ADDRSYM .SAC>)>>)>
+ <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>
+ <SET TWIN T>)>)>
+ <COND (<NOT .TWOW>
+ <TOACV .STRD>
+ <COND (<ISTYPE-GOOD? .TPS>
+ <DATTYP-FLUSH .STRD>
+ <PUT .STRD ,DATTYP .TPS>)>)>
+ <COND (<TYPE? <DATVAL .STRD> AC>
+ <PUT <SET SAC <DATVAL .STRD>> ,ACPROT T>)>
+ <COND (<NOT .TWOW>
+ <TOACV .NUMD>
+ <PUT <SET NAC <DATVAL .NUMD>> ,ACPROT T>)>
+ <COND (<ASSIGNED? SAC> <MUNG-AC .SAC .STRD>)>
+ <AND <TYPE? <DATTYP .STRD> AC>
+ <MUNG-AC <DATTYP .STRD> .STRD>>
+ <COND (<AND <NOT <ISTYPE? .TTYP>>
+ <NOT .TY>
+ <N==? .TPS UVECTOR>
+ <NOT .TWOW>>
+ <PUT <SET TAC <GETREG <>>> ,ACPROT T>
+ <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
+ <ACSYM .TAC>
+ !<ADDR:TYPE .NUMD>>>)>
+ <COND (<ASSIGNED? SAC> <PUT .SAC ,ACPROT <>>)>
+ <COND (<NOT .TWOW> <PUT .NAC ,ACPROT <>>)>
+ <COND (<AND .BRANCH <NOT .FLS> .DIR <NOT .NOTF> <=? .W .STRD>>
+ <SET B2 .BRANCH>)>
+ <COND
+ (<==? .TPS LIST>
+ <COND (<G=? <SET DCOD <MIN <DEFERN .ETY> <DEFERN .TTYP>>> 1>
+ <SET DAC <GETREG <>>>)>
+ <COND (.FC
+ <EMIT <INSTRUCTION `JUMPE
+ <ACSYM .SAC>
+ <COND (.DIR .B3) (ELSE .B2)>>>)>
+ <LABEL:TAG .LP>
+ <COND (<0? .DCOD> <SET DAC .SAC>)
+ (<1? .DCOD>
+ <EMIT <INSTRUCTION `MOVE <ACSYM .DAC> 1 (<ADDRSYM .SAC>)>>)
+ (ELSE
+ <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE `O (<ADDRSYM .SAC>)>>
+ <EMIT <INSTRUCTION `MOVE <ACSYM .DAC> <ADDRSYM .SAC>>>
+ <EMIT '<`CAIN `O TDEFER!-OP!-PACKAGE>>
+ <EMIT <INSTRUCTION `MOVE <ACSYM .DAC> 1 (<ADDRSYM .DAC>)>>)>
+ <CHECK-VAL 1
+ .NAC
+ .DAC
+ .TAC
+ .TTYP
+ <COND (.DIR .B2) (ELSE .B3)>
+ .TWIN>
+ <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> (<ADDRSYM .SAC>)>>
+ <EMIT <INSTRUCTION `JUMPN <ACSYM .SAC> .LP>>)
+ (<==? .TPS UVECTOR>
+ <COND (.FC
+ <EMIT <INSTRUCTION `JUMPGE
+ <ACSYM .SAC>
+ <COND (.DIR .B3) (ELSE .B2)>>>)>
+ <LABEL:TAG .LP>
+ <CHECK-VAL 0
+ .NAC
+ .SAC
+ .TAC
+ .TTYP
+ <COND (.DIR .B2) (ELSE .B3)>
+ .TWIN>
+ <EMIT <INSTRUCTION `AOBJN <ACSYM .SAC> .LP>>)
+ (<NOT .TWOW>
+ <COND (.FC
+ <EMIT <INSTRUCTION `JUMPGE
+ <ACSYM .SAC>
+ <COND (.DIR .B3) (ELSE .B2)>>>)>
+ <LABEL:TAG .LP>
+ <CHECK-VAL 1
+ .NAC
+ .SAC
+ .TAC
+ .TTYP
+ <COND (.DIR .B2) (ELSE .B3)>
+ .TWIN>
+ <EMIT <INSTRUCTION `ADD <ACSYM .SAC> '[<2 (2)>]>>
+ <EMIT <INSTRUCTION `JUMPL <ACSYM .SAC> .LP>>)
+ (.FLS
+ <COND (<TYPE? <DATTYP .STRD> AC>
+ <COND (<AND <ACRESIDUE <SET SAC <DATTYP .STRD>>>
+ <G? <FREE-ACS T> 0>>
+ <EMIT <INSTRUCTION `MOVEI
+ <SET SAC <GETREG <>>>
+ (<ADDRSYM <DATTYP .STRD>>)>>)
+ (ELSE
+ <MUNG-AC .SAC .STRD>
+ <EMIT <INSTRUCTION `MOVEI <ACSYM .SAC> (<ADDRSYM .SAC>)>>)>)
+ (ELSE
+ <SET SAC <GETREG <>>>
+ <EMIT <INSTRUCTION `HRRZ <ACSYM .SAC> !<ADDR:TYPE .STRD>>>)>
+ <PUT .SAC ,ACPROT T>
+ <OR .DEADV
+ <TYPE? <DATVAL .STRD> TEMP>
+ <SET STRD <TOACV .STRD>>>
+ <PUT .SAC ,ACPROT <>>
+ <COND (.FC
+ <EMIT <INSTRUCTION `JUMPE
+ <ACSYM .SAC>
+ <COND (.DIR .B3) (ELSE .B2)>>>)>
+ <LABEL:TAG .LP>
+ <EMIT <INSTRUCTION `ILDB `O !<ADDR:VALUE .STRD>>>
+ <IMCHK (`CAMN `CAIN ) `O <DATVAL .NUMD>>
+ <BRANCH:TAG <COND (.DIR .B2) (ELSE .B3)>>
+ <EMIT <INSTRUCTION `SOJG <ACSYM .SAC> .LP>>)
+ (ELSE
+ <LABEL:TAG .LP>
+ <COND (<TYPE? <DATTYP .STRD> AC>
+ <EMIT <INSTRUCTION `TRNN <ACSYM <SET SAC <DATTYP .STRD>>> -1>>
+ <BRANCH:TAG <COND (.DIR .B3) (ELSE .B2)>>)
+ (ELSE
+ <EMIT <INSTRUCTION `HRRZ `O !<ADDR:TYPE .STRD>>>
+ <EMIT <INSTRUCTION `JUMPE `O <COND (.DIR .B3) (ELSE .B2)>>>)>
+ <EMIT <INSTRUCTION `MOVE `O !<ADDR:VALUE .STRD>>>
+ <EMIT '<`ILDB `O `O >>
+ <IMCHK '(`CAMN `CAIN ) `O <DATVAL .NUMD>>
+ <BRANCH:TAG <COND (.DIR .B2) (ELSE .B3)>>
+ <EMIT <INSTRUCTION `IBP !<ADDR:VALUE .STRD>>>
+ <COND (<TYPE? <DATTYP .STRD> AC>
+ <EMIT <INSTRUCTION `SOJA <ACSYM .SAC> .LP>>)
+ (ELSE
+ <EMIT <INSTRUCTION `SOS !<ADDR:TYPE .STRD>>>
+ <BRANCH:TAG .LP>)>)>
+ <AND .TAC <PUT .TAC ,ACPROT <>>>
+ <RET-TMP-AC .TAC>
+ <RET-TMP-AC .NUMD>
+ <COND (<AND .BRANCH .FLS>
+ <COND (<NOT .DIR> <BRANCH:TAG .B2> <LABEL:TAG .B3>)
+ (ELSE <LABEL:TAG .B3>)>
+ <RET-TMP-AC .STRD>)
+ (<OR .NOTF <NOT <==? <NOT .BRANCH> <NOT .DIR>>>>
+ <RET-TMP-AC .STRD>
+ <COND (<AND .NOTF .DIR> <BRANCH:TAG .B3>)>
+ <LABEL:TAG .B2>
+ <MOVE:ARG <REFERENCE .SDIR> .W>
+ <BRANCH:TAG .BRANCH>
+ <LABEL:TAG .B3>)
+ (ELSE
+ <COND (.BRANCH
+ <COND (<==? .B2 .BRANCH>
+ <LABEL:TAG .B3>
+ <SET W <MOVE:ARG .STRD .W>>)
+ (ELSE
+ <BRANCH:TAG .B3>
+ <LABEL:TAG .B2>
+ <SET W <MOVE:ARG .STRD .W>>
+ <BRANCH:TAG .BRANCH>
+ <LABEL:TAG .B3>)>)
+ (ELSE
+ <RET-TMP-AC .STRD>
+ <LABEL:TAG .B2>
+ <RET-TMP-AC <SET W <MOVE:ARG <REFERENCE <>> .W>>>
+ <COND (<TYPE? <DATTYP .STRD> AC>
+ <PUT <DATTYP .STRD> ,ACLINK (.STRD)>)>
+ <COND (<TYPE? <DATVAL .STRD> AC>
+ <PUT <DATVAL .STRD> ,ACLINK (.STRD)>)>
+ <COND (<=? .W .STRD>
+ <LABEL:TAG .B3>
+ <SET W <MOVE:ARG .STRD .W>>)
+ (ELSE
+ <BRANCH:TAG <SET B4 <MAKE:TAG>>>
+ <LABEL:TAG .B3>
+ <SET W <MOVE:ARG .STRD .W>>
+ <LABEL:TAG .B4>)>)>)>
+ <MOVE:ARG .W .RW>>
+
+<DEFINE CHECK-VAL (OFFS VAC SAC TAC TTYP BR TWIN)
+ #DECL ((OFFS) FIX (SAC VAC) AC (TAC) <OR AC FALSE>)
+ <COND (.TWIN
+ <EMIT <INSTRUCTION `CAMN <ACSYM .VAC> .OFFS (<ADDRSYM .SAC>)>>
+ <BRANCH:TAG .BR>)
+ (ELSE
+ <EMIT <INSTRUCTION GETYP!-OP!-PACKAGE
+ `O*
+ <- .OFFS 1>
+ (<ADDRSYM .SAC>)>>
+ <EMIT <INSTRUCTION
+ `CAIN
+ `O*
+ <COND (<SET TTYP <ISTYPE? .TTYP>>
+ <FORM TYPE-CODE!-OP!-PACKAGE .TTYP>)
+ (ELSE (<ADDRSYM .TAC>))>>>
+ <EMIT <INSTRUCTION `CAME <ACSYM .VAC> .OFFS (<ADDRSYM .SAC>)>>
+ <EMIT '<`SKIPA >>
+ <BRANCH:TAG .BR>)>>
+
+<ENDPACKAGE>
+\f\ 3\ 3
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff