mirror of
https://github.com/PDP-10/its.git
synced 2026-05-09 09:10:32 +00:00
CODGEN - Character set compiler from SSV to MIGS.
From RRS; AR1 THINGS. Courtesy of Rick Shiffman.
This commit is contained in:
Lars Brinkhoff
@@ -1672,6 +1672,7 @@ rms/macros.18 197511040224.09
|
||||
rms/palx.143 197204150602.24
|
||||
rrs/ar2.migspk 198211190021.46
|
||||
rrs/ar9.1 197706070441.38
|
||||
rrs/codgen.urs001 197812281952.48
|
||||
rrs/displa.urs017 198207271850.38
|
||||
rrs/hptek.urs001 198005282134.20
|
||||
rrs/jsys.order 197810181754.50
|
||||
|
||||
379
src/rrs/codgen.urs001
Normal file
379
src/rrs/codgen.urs001
Normal file
@@ -0,0 +1,379 @@
|
||||
|
||||
<PACKAGE "CODEGEN">
|
||||
<ENTRY CHARCOMP PPSSVCHR>
|
||||
<BLOCK (<GET INITIAL OBLIST><ROOT>)>
|
||||
E X ON OFF CNTL
|
||||
<ENDBLOCK>
|
||||
<BLOCK (!.OBLIST <GET INITIAL OBLIST>)>
|
||||
|
||||
|
||||
|
||||
<DEFINE CHARCOMP (INSTR OUTSTR
|
||||
"OPTIONAL" (OPTSW <>)
|
||||
"AUX" (CHANIN <OPEN "READ" .INSTR>))
|
||||
;"CHARCOMP IS THE MAIN FUNCTION USED TO COMPILE A NEW CHARACTER SET FOR
|
||||
XSWTXT, THE SOFTWARE CHARACTER GENERATER IN C2G. THIS FUNCTION TAKES 2
|
||||
STRING AND A OPTIONAL FLAG. THE STRINGS ARE THE SOURCE FILE (CHARACTER
|
||||
SET) AND THE OBJECT FILE (5 PLITS THAT ARE USED BY XSWTXT IN C2G)."
|
||||
#DECL ((INSTR OUTSTR) STRING (CHANIN) <OR CHANNEL FALSE>
|
||||
(OPTSW) <OR ATOM FALSE>)
|
||||
<COND (<TYPE? .CHANIN CHANNEL>
|
||||
<CMPL <READ .CHANIN> .OUTSTR .OPTSW>
|
||||
<CLOSE .CHANIN>)
|
||||
(T <ERROR CHARCOMP INPUT-FILE-NOT-FOUND!-ERRORS .CHANIN>)>>
|
||||
|
||||
<DEFINE CMPL (SORCE OUTFILE-STR "OPTIONAL" (OPTSW <>) "AUX" PCHRS)
|
||||
#DECL ((SORCE) <VECTOR [REST <OR ATOM CHARACTER FLOAT>]>
|
||||
(OUTFILE-STR) STRING
|
||||
(PCHRS) <LIST <VECTOR [REST <LIST ATOM FIX FIX>]>
|
||||
[3 <VECTOR [REST FLOAT]>]> (OPTSW) <OR ATOM FALSE>)
|
||||
<COND (.OPTSW <SET PCHRS <PARSER <ONCAT <OFCAT .SORCE>>>>)
|
||||
(T <SET PCHRS <PARSER .SORCE>>)>
|
||||
<CODEGEN .PCHRS .OUTFILE-STR>>
|
||||
|
||||
<DEFINE PARSER (LIST
|
||||
"AUX" OP XC YC L OPV XV YV (I 1) (J 0) CHR
|
||||
(CHARD
|
||||
(<IVECTOR 130 '(NIL 0 0)>
|
||||
<IVECTOR 1800 '0.0000000>
|
||||
<IVECTOR 1800 '0.0000000>
|
||||
<IVECTOR 1800 '0.0000000>))
|
||||
"ACT" P1)
|
||||
;"THIS FUNCTION PARSES THE SOURCE OF THE CHARACT SET
|
||||
AND BUILDS THE DATA STRUCTURES USED BY THE CODE GENERATERS"
|
||||
#DECL ((LIST) <VECTOR [REST <OR ATOM CHARACTER FLOAT>]>
|
||||
(OP XC YC) <OR ATOM CHARACTER FLOAT>
|
||||
(OPV XV YV) <VECTOR [REST FLOAT]>
|
||||
(L) <VECTOR [REST <LIST ATOM FIX FIX>]> (I J) FIX (CHR) CHARACTER
|
||||
(CHARD VALUE) <LIST <VECTOR [REST <LIST ATOM FIX FIX>]>
|
||||
[3 <VECTOR [REST FLOAT]>]>
|
||||
(P1 P2 P3) ACTIVATION)
|
||||
<REPEAT P2 ()
|
||||
<AND <EMPTY? .LIST> <RETURN .CHARD .P1>>
|
||||
<SET OP <1 .LIST>>
|
||||
<SET LIST <REST .LIST>>
|
||||
<COND (<MEMBER !\: <UNPARSE .OP>> <RETURN .OP .P2>)>>
|
||||
<SET L <1 .CHARD>>
|
||||
<SET OPV <2 .CHARD>>
|
||||
<SET XV <3 .CHARD>>
|
||||
<SET YV <4 .CHARD>>
|
||||
<SET J <+ .J 1>>
|
||||
<PUT <NTH .L .J> 1 .OP> ;"ENTER LABLE"
|
||||
<SET OP <1 .LIST>>
|
||||
<SET LIST <REST .LIST>>
|
||||
<OR <==? .OP E> <ERROR NOT-AN-E>>
|
||||
<PUT <NTH .L .J> 2 .I> ;"ENTER STARTING ADDR"
|
||||
<REPEAT P3 () ;"BODY PARSER"
|
||||
<SET OP <1 .LIST>>
|
||||
<SET LIST <REST .LIST>>
|
||||
<COND (<==? .OP ON> ;"DRDRAW"
|
||||
<PUT .OPV .I 1.0> ;"ENTER OP-CODE"
|
||||
<SET XC <FLOAT <1 .LIST>>>
|
||||
<SET YC <FLOAT <2 .LIST>>>
|
||||
<SET LIST <REST .LIST 2>>
|
||||
<PUT .XV .I .XC> ;"ENTER X-COORD"
|
||||
<PUT .YV .I .YC> ;"ENTER Y-COORD"
|
||||
<SET I <+ .I 1>>)
|
||||
(<==? .OP OFF> ;"DRMOVE"
|
||||
<PUT .OPV .I 0.0000000> ;"ENTER OP-CODE"
|
||||
<SET XC <FLOAT <1 .LIST>>>
|
||||
<SET YC <FLOAT <2 .LIST>>>
|
||||
<SET LIST <REST .LIST 2>>
|
||||
<PUT .XV .I .XC> ;"ENTER X-CORD"
|
||||
<PUT .YV .I .YC> ;"ENTER Y-COORD"
|
||||
<SET I <+ .I 1>>)
|
||||
(<==? .OP CNTL> ;"ITS A CNTL CHR, DISPLAY HAT AND CHR."
|
||||
<SET CHR <1 .LIST>>
|
||||
<SET LIST <REST .LIST>>
|
||||
<PUT .OPV .I -1.0>
|
||||
<PUT .XV .I 128.0> ;"PUT CALL TO CNTL HAT IN XV"
|
||||
<PUT .YV .I <FLOAT <ASCII .CHR>>>
|
||||
;"PUT CALL TO CHR IN YV"
|
||||
<SET I <+ .I 1>>)
|
||||
(<==? .OP X> <PUT <NTH .L .J> 3 <- .I 1>> <AGAIN .P1>)
|
||||
(T <ERROR BAD-CHR-BODY>)>>>
|
||||
|
||||
<DEFINE ONCAT (LIST
|
||||
"AUX" (PVECT <IVECTOR <LENGTH .LIST> #LOSE *000000000000*>) ATC X
|
||||
Y (SX 0.0000000) (SY 0.0000000))
|
||||
;"ONCAT IS USED TO CONCATENATE RELATIVE DRAWS THAT HAVE THE
|
||||
SAME SLOPE. ONCAT USES THE FUNCTION RATIO? TO DETERMIN IF
|
||||
THE SLOPES ARE THE SAME"
|
||||
<REPEAT ((I 1))
|
||||
<AND <EMPTY? .LIST> <RETURN .PVECT>>
|
||||
<SET ATC <1 .LIST>>
|
||||
<SET LIST <REST .LIST>>
|
||||
<COND (<N==? .ATC ON> <PUT .PVECT .I .ATC> <SET I <+ .I 1>>)
|
||||
(T
|
||||
<SET SX <FLOAT <1 .LIST>>> ;"GET ON'S X,Y COORDS"
|
||||
<SET SY <FLOAT <2 .LIST>>>
|
||||
<SET LIST <REST .LIST 2>>
|
||||
<REPEAT () ;"LOOK FOR MORE ONS IN A ROW"
|
||||
<AND <EMPTY? .LIST> <ERROR END-NOW??>>
|
||||
<SET ATC <1 .LIST>>
|
||||
<AND <N==? .ATC ON> <RETURN T>> ;"IF NOT AN ON"
|
||||
<SET X <FLOAT <2 .LIST>>>
|
||||
<SET Y <FLOAT <3 .LIST>>>
|
||||
<COND (<RATIO? .X .Y .SX .SY> ;"CAN I CONCAT?"
|
||||
<SET SX <+ .SX .X>> ;"YES"
|
||||
<SET SY <+ .SY .Y>>
|
||||
<SET LIST <REST .LIST 3>>)
|
||||
(T
|
||||
<PUT .PVECT .I ON> ;"NO"
|
||||
<SET I <+ .I 1>>
|
||||
<PUT .PVECT .I .SX>
|
||||
<SET I <+ .I 1>>
|
||||
<PUT .PVECT .I .SY>
|
||||
<SET I <+ .I 1>>
|
||||
<SET LIST <REST .LIST 3>>
|
||||
<SET SX .X> ;"RESET SX,SY"
|
||||
<SET SY .Y>)>>
|
||||
<PUT .PVECT .I ON>
|
||||
<SET I <+ .I 1>>
|
||||
<PUT .PVECT .I .SX>
|
||||
<SET I <+ .I 1>>
|
||||
<PUT .PVECT .I .SY>
|
||||
<SET I <+ .I 1>>)>>>
|
||||
|
||||
<DEFINE RATIO? (X1 Y1 X2 Y2 "ACT" R1)
|
||||
<AND <0? .X1> <0? .Y1> <RETURN T .R1>>
|
||||
<AND <0? .X2> <0? .Y2> <RETURN T .R1>>
|
||||
<AND <0? .X1> <0? .X2> <RETURN T .R1>>
|
||||
<AND <0? .Y1> <0? .Y2> <RETURN T .R1>>
|
||||
<AND <0? .Y1> <N==? .Y1 .Y2> <RETURN #FALSE () .R1>>
|
||||
<AND <0? .Y2> <N==? .Y1 .Y2> <RETURN #FALSE () .R1>>
|
||||
<==? </ <FLOAT .X1> <FLOAT .Y1>>
|
||||
</ <FLOAT .X2> <FLOAT .Y2>>>>
|
||||
|
||||
<DEFINE OFCAT (LIST
|
||||
"AUX" (PVECT <IVECTOR <LENGTH .LIST> #LOSE *000000000000*>) ATC X
|
||||
Y (SX 0.0000000) (SY 0.0000000) (OFFL <>))
|
||||
;"OFCAT CONCATENATES RELATIVE MOVES"
|
||||
<REPEAT ((I 1))
|
||||
<AND <EMPTY? .LIST> <RETURN .PVECT>>
|
||||
<SET ATC <1 .LIST>>
|
||||
<SET LIST <REST .LIST>>
|
||||
<COND (<==? .ATC OFF>
|
||||
<SET OFFL T>
|
||||
<SET SX <FLOAT <1 .LIST>>>
|
||||
<SET SY <FLOAT <2 .LIST>>>
|
||||
<SET LIST <REST .LIST 2>>
|
||||
<REPEAT ()
|
||||
<AND <EMPTY? .LIST> <ERROR END-NOW??>>
|
||||
<SET ATC <1 .LIST>>
|
||||
<COND (<NOT <==? .ATC OFF>>
|
||||
<SET OFFL <>>
|
||||
<RETURN T>)>
|
||||
<SET X <FLOAT <2 .LIST>>>
|
||||
<SET Y <FLOAT <3 .LIST>>>
|
||||
<SET LIST <REST .LIST 3>>
|
||||
<SET SX <+ .SX .X>>
|
||||
<SET SY <+ .SY .Y>>>
|
||||
<PUT .PVECT .I OFF>
|
||||
<SET I <+ .I 1>>
|
||||
<PUT .PVECT .I .SX>
|
||||
<SET I <+ .I 1>>
|
||||
<PUT .PVECT .I .SY>
|
||||
<SET I <+ .I 1>>)
|
||||
(T <PUT .PVECT .I .ATC> <SET I <+ .I 1>>)>>>
|
||||
|
||||
<DEFINE CODEGEN (PCHRS STR "AUX" WCNT L CHAN N1 N2)
|
||||
;"THIS FUNCTION CONTROLS THE CODE GENERATERS, 1DICT AN 1OP-X-Y"
|
||||
<SET CHAN <1DICT .PCHRS .STR>> ;"GENERATE THE 2 DICTIONARY
|
||||
PLITS; DICB AND DICE"
|
||||
<SET L <1 .PCHRS>>
|
||||
<SET N1 <SET N2 0>>
|
||||
<SET WCNT
|
||||
<REPEAT ((I 0) (L1 .L) (N1 <1 .L1>) N2)
|
||||
;"DETERMIN THE NUMBER OF WORD NEED IN THE
|
||||
PILTS, OP AND X AND Y."
|
||||
<SET L1 <REST .L1>>
|
||||
<AND <EMPTY? .L1> <RETURN <3 .N1>>>
|
||||
<SET N2 <1 .L1>>
|
||||
<COND (<==? <1 .N2> NIL>
|
||||
<RETURN <3 .N1>>)
|
||||
(T <SET N1 .N2>)> > >
|
||||
<1OP-X-Y .PCHRS .CHAN .WCNT> ;"GENERATE THE LAST 3 PLITS;
|
||||
OP,X,AND Y" >
|
||||
|
||||
<DEFINE 1DICT (PCHRS STR "AUX" (L <1 .PCHRS>) O)
|
||||
;"GENERATE THE TWO DICTIONARY PLITS (DICB AND DICE). DICB
|
||||
CONTAINS THE STARTING INDEXS DATA FOR EACH CHARACTER.
|
||||
DICE CONTAINS THE ENDING INDEXS FOR EACH CHARACTER'S DATA."
|
||||
<AND <=? #FALSE () <SET O <OPEN "PRINT" .STR>>> <ERROR .O>>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND DICB=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT (L1 (I 1) (L0 .L))
|
||||
<AND <EMPTY? .L0> <RETURN T>>
|
||||
<AND <==? <1 <SET L1 <1 .L0>>> NIL> <RETURN T>>
|
||||
<PRINC <STRING " %"
|
||||
<PNAME <1 .L1>>
|
||||
"% "
|
||||
<UNPARSE <- <2 .L1> 1>>
|
||||
",">
|
||||
.O>
|
||||
<TERPRI .O>
|
||||
<SET L0 <REST .L0>>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND DICE=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT (L1 (I 1) (L0 .L))
|
||||
<AND <EMPTY? .L0> <RETURN T>>
|
||||
<AND <==? <1 <SET L1 <1 .L0>>> NIL> <RETURN T>>
|
||||
<PRINC <STRING " " <UNPARSE <- <3 .L1> 1>> ","> .
|
||||
O>
|
||||
<TERPRI .O>
|
||||
<SET L0 <REST .L0>>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
.O>
|
||||
|
||||
<DEFINE 1OP-X-Y (PCHRS O
|
||||
"OPTIONAL" (WCNT <LENGTH <2 .PCHRS>>)
|
||||
"AUX" (OP <2 .PCHRS>) (X <3 .PCHRS>) (Y <4 .PCHRS>) )
|
||||
;"THIS FUNCTION GENERATES THE THREE DATA PLITS, OP, X, AND Y
|
||||
OP CONTAINS THE OPCODES, X AND Y CONTAIN THE OPERANDS."
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND OP=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT ((I 1))
|
||||
<PRINC <STRING " " <UNPARSE <NTH .OP .I>> ","> .O
|
||||
>
|
||||
<TERPRI .O>
|
||||
<COND (<G=? .I .WCNT> <RETURN T>) (T <SET I <+ .I 1>>)>>
|
||||
<TERPRI .O>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND X=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT ((I 1))
|
||||
<PRINC <STRING " " <UNPARSE <NTH .X .I>> ","> .O>
|
||||
<TERPRI .O>
|
||||
<COND (<G=? .I .WCNT> <RETURN T>) (T <SET I <+ .I 1>>)>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND Y=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT ((I 1))
|
||||
<PRINC <STRING " " <UNPARSE <NTH .Y .I>> ","> .O>
|
||||
<TERPRI .O>
|
||||
<COND (<G=? .I .WCNT> <RETURN T>) (T <SET I <+ .I 1>>)>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<CLOSE .O>>
|
||||
|
||||
<DEFINE PPSSVCHR (CHRS "OPTIONAL" (CHAN .OUTCHAN) "AUX" T)
|
||||
;"THIS IS THE CHARACTER SET PRETTY PRINTER."
|
||||
<OR <TYPE? .CHAN CHANNEL>
|
||||
<ERROR PPSSVCHR .CHAN NOT-A-CHANNEL!-ERRORS>>
|
||||
<TERPRI .CHAN>
|
||||
<PRINC "[" .CHAN>
|
||||
<TERPRI .CHAN>
|
||||
<REPEAT ((OUTCHAN .CHAN))
|
||||
<AND <EMPTY? .CHRS> <RETURN T>>
|
||||
<SET T <1 .CHRS>>
|
||||
<COND
|
||||
(<TYPE? .T ATOM>
|
||||
<COND (<MEMQ !\: <PNAME .T>>
|
||||
<TERPRI>
|
||||
<PRIN1 .T>
|
||||
<TERPRI>
|
||||
<SET CHRS <REST .CHRS>>)
|
||||
(<OR <==? .T E> <==? .T X>>
|
||||
<PRINC " ">
|
||||
<PRIN1 .T>
|
||||
<TERPRI>
|
||||
<SET CHRS <REST .CHRS>>)
|
||||
(<==? .T CNTL>
|
||||
<PRINC " CNTL ">
|
||||
<PRIN1 <2 .CHRS>>
|
||||
<TERPRI>
|
||||
<SET CHRS <REST .CHRS 2>>)
|
||||
(<OR <==? .T ON> <==? .T OFF>>
|
||||
<PRINC <STRING " "
|
||||
<PNAME .T>
|
||||
" "
|
||||
<COND (<0? <2 .CHRS>> "0.0")
|
||||
(T <UNPARSE <2 .CHRS>>)>
|
||||
" "
|
||||
<COND (<0? <3 .CHRS>> "0.0")
|
||||
(T <UNPARSE <3 .CHRS>>)>>>
|
||||
<TERPRI>
|
||||
<SET CHRS <REST .CHRS 3>>)
|
||||
(T <SET CHRS <REST .CHRS>>)>)
|
||||
(T <SET CHRS <REST CHRS>>)>>
|
||||
<TERPRI .CHAN>
|
||||
<PRINC "]" .CHAN>>
|
||||
|
||||
NULL;"THE FOLLOWING FUNCTIONS ARE NOT FOR GENERAL USE!!!!"
|
||||
|
||||
<DEFINE OP-X-Y (PCHRS STR
|
||||
"OPTIONAL" (WCNT <LENGTH <2 .PCHRS>>)
|
||||
"AUX" (OP <2 .PCHRS>) (X <3 .PCHRS>) (Y <4 .PCHRS>) O)
|
||||
<AND <=? <SET O <OPEN "PRINT" .STR>> #FALSE ()> <ERROR .O>>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND OP=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT ((I 1))
|
||||
<PRINC <STRING " " <UNPARSE <NTH .OP .I>> ","> .O
|
||||
>
|
||||
<TERPRI .O>
|
||||
<COND (<G=? .I .WCNT> <RETURN T>) (T <SET I <+ .I 1>>)>>
|
||||
<TERPRI .O>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND X=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT ((I 1))
|
||||
<PRINC <STRING " " <UNPARSE <NTH .X .I>> ","> .O>
|
||||
<TERPRI .O>
|
||||
<COND (<G=? .I .WCNT> <RETURN T>) (T <SET I <+ .I 1>>)>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND Y=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT ((I 1))
|
||||
<PRINC <STRING " " <UNPARSE <NTH .Y .I>> ","> .O>
|
||||
<TERPRI .O>
|
||||
<COND (<G=? .I .WCNT> <RETURN T>) (T <SET I <+ .I 1>>)>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<CLOSE .O>>
|
||||
|
||||
<DEFINE DICT (PCHRS STR "AUX" (L <1 .PCHRS>) O)
|
||||
<AND <=? #FALSE () <SET O <OPEN "PRINT" .STR>>> <ERROR .O>>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND DICB=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT (L1 (I 1) (L0 .L))
|
||||
<AND <EMPTY? .L0> <RETURN T>>
|
||||
<AND <==? <1 <SET L1 <1 .L0>>> NIL> <RETURN T>>
|
||||
<PRINC <STRING " %"
|
||||
<PNAME <1 .L1>>
|
||||
"% "
|
||||
<UNPARSE <- <2 .L1> 1>>
|
||||
",">
|
||||
.O>
|
||||
<TERPRI .O>
|
||||
<SET L0 <REST .L0>>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<PRINC "BIND DICE=PLIT(" .O>
|
||||
<TERPRI .O>
|
||||
<REPEAT (L1 (I 1) (L0 .L))
|
||||
<AND <EMPTY? .L0> <RETURN T>>
|
||||
<AND <==? <1 <SET L1 <1 .L0>>> NIL> <RETURN T>>
|
||||
<PRINC <STRING " " <UNPARSE <- <3 .L1> 1>> ","> .
|
||||
O>
|
||||
<TERPRI .O>
|
||||
<SET L0 <REST .L0>>>
|
||||
<PRINC " 0);" .O>
|
||||
<TERPRI .O>
|
||||
<CLOSE .O>>
|
||||
|
||||
<ENDBLOCK>
|
||||
<ENDPACKAGE>
|
||||
|
||||
|
||||
Reference in New Issue
Block a user