mirror of
https://github.com/PDP-10/its.git
synced 2026-03-03 18:26:16 +00:00
115 lines
3.3 KiB
Plaintext
115 lines
3.3 KiB
Plaintext
|
|
<PACKAGE "CODER">
|
|
|
|
<ENTRY CODER CODE-DEFAULT>
|
|
|
|
<SETG CODE-DEFAULT "CODE"> ;"dir to look for samples on"
|
|
|
|
<GDECL (CODE-DEFAULT) STRING>
|
|
|
|
"CODER -- Convert raw form code sample into a UVECTOR of floats"
|
|
|
|
<DEFINE CODER (FS
|
|
"OPTIONAL" (CHECK? T) (INFO? T)
|
|
"AUX" LAST TMP (INFO <>) COD XLIST C (OUTCHAN .OUTCHAN))
|
|
#DECL ((FS) STRING (CHECK? INFO?) <OR ATOM FALSE> (TMP) <OR UVECTOR FALSE>
|
|
(COD) UVECTOR (LAST) FIX
|
|
(INFO) <OR FALSE VECTOR> (XLIST) LIST (C) <OR FALSE CHANNEL>
|
|
(OUTCHAN) CHANNEL (VALUE) <OR FALSE <LIST ANY <UVECTOR FLOAT> LIST>>)
|
|
<PROG ()
|
|
<COND (<SET C
|
|
<PROG ((SNM ,CODE-DEFAULT))
|
|
#DECL ((SNM) <SPECIAL STRING>)
|
|
<OPEN "READB" .FS>>>
|
|
<COND (<SET TMP <READ-BLOCK .C>>)
|
|
(ELSE <CLOSE .C> <RETURN .TMP>)>
|
|
<COND (<AND .INFO? <NOT <EMPTY? .TMP>>>
|
|
<SET INFO <CODE-HEADER .TMP <STRCH .C>>>)>
|
|
<COND (<SET TMP <READ-BLOCK .C>>)
|
|
(ELSE <CLOSE .C> <RETURN .TMP>)>
|
|
<SET COD .TMP>
|
|
<MAPR <>
|
|
<FUNCTION (UV)
|
|
#DECL ((UV) UVECTOR)
|
|
<COND (<NOT .CHECK?>)
|
|
(<0? <CHTYPE <ANDB <EQVB <1 .UV> .LAST> 32768>
|
|
FIX>>)
|
|
(<G=? <CHTYPE <1 .UV> FIX> 32768>
|
|
<PRINT "TWO-MARKS-IN-A-ROW-AT">
|
|
<PRIN1 <- <LENGTH .COD> <LENGTH .UV>>>)
|
|
(ELSE
|
|
<PRINT "TWO-SPACES-IN-A-ROW-AT">
|
|
<PRIN1 <- <LENGTH .COD> <LENGTH .UV>>>)>
|
|
<SET LAST <CHTYPE <1 .UV> FIX>>
|
|
<PUT .UV 1 <FLOAT <CHTYPE <ANDB <1 .UV> 32767> FIX>>>>
|
|
<CHUTYPE .COD FLOAT>>
|
|
<COND (<SET XLIST <READ .C '()>>)>
|
|
<CLOSE .C>
|
|
<LIST .INFO .COD .XLIST>)>>>
|
|
|
|
<DEFINE READ-BLOCK (C "AUX" BUF (UV ,TUV) L TMP)
|
|
#DECL ((C) CHANNEL (BUF UV) <UVECTOR [REST FIX]> (L) FIX (TMP) <OR FIX FALSE>)
|
|
<COND (<AND <SET TMP <READB .UV .C '<>>> <L? <1 .UV> 0>>
|
|
<COND (<G? <SET L <- <- <1 .UV>> 1>> 0>
|
|
<SET BUF <IUVECTOR .L 0>>
|
|
<COND (<AND <SET TMP <READB .BUF .C '<>>> <==? .TMP .L>>
|
|
.BUF)
|
|
(ELSE #FALSE ("SAMPLE SIZE INCORRECT"))>)
|
|
(ELSE '[])>)
|
|
(.TMP #FALSE ("BAD SAMPLE HEADER"))>>
|
|
|
|
<DEFINE CODE-HEADER (I C)
|
|
#DECL ((I) UVECTOR (C) STRING)
|
|
<VECTOR .C ;"file"
|
|
<SIXSTR <1 .I>> ;"message name"
|
|
<2 .I> ;"message id"
|
|
<3 .I> ;"sender name"
|
|
<4 .I> ;"version number"
|
|
<COND (<==? <5 .I> -1> -1)
|
|
(<MQDATE <5 .I>>)> ;"when sent"
|
|
<COND (<==? <6 .I> -1> -1)
|
|
(<CHTYPE <6 .I> FLOAT>)> ;"time constant">>
|
|
|
|
<DEFINE STRCH (C)
|
|
#DECL ((C) CHANNEL (VALUE) STRING)
|
|
<STRING <9 .C> ":"
|
|
<10 .C> ";"
|
|
<7 .C> " "
|
|
<8 .C>>>
|
|
|
|
<SETG TUV ![0!]>
|
|
|
|
<GDECL (TUV) <UVECTOR FIX>>
|
|
|
|
"MQDATE -- make standard date/time list from disk format date"
|
|
|
|
<DEFINE MQDATE (X "AUX" (HS <CHTYPE <GETBITS .X <BITS 18>> FIX>))
|
|
#DECL ((X HS) FIX)
|
|
<LIST <LIST <CHTYPE <GETBITS .X <BITS 7 27>> FIX>
|
|
<CHTYPE <GETBITS .X <BITS 4 23>> FIX>
|
|
<CHTYPE <GETBITS .X <BITS 5 18>> FIX>>
|
|
<LIST </ .HS 7200>
|
|
<PROG () <SET HS <MOD .HS 7200>> </ .HS 120>>
|
|
<PROG () <SET HS <MOD .HS 120>> </ .HS 2>>>>>
|
|
|
|
<DEFINE SIXSTR (X "AUX" C)
|
|
#DECL ((X) <PRIMTYPE WORD> (C) FIX)
|
|
<MAPF ,STRING
|
|
<FUNCTION (B)
|
|
#DECL ((B) BITS)
|
|
<COND (<0? <SET C <CHTYPE <GETBITS .X .B> FIX>>> <MAPSTOP>)
|
|
(ELSE <MAPRET <CHTYPE <+ .C 32> CHARACTER>>)>>
|
|
,SIXBITS>>
|
|
|
|
<SETG SIXBITS
|
|
<UVECTOR <BITS 6 30>
|
|
<BITS 6 24>
|
|
<BITS 6 18>
|
|
<BITS 6 12>
|
|
<BITS 6 6>
|
|
<BITS 6>>>
|
|
|
|
<MANIFEST SIXBITS>
|
|
|
|
<ENDPACKAGE>
|