mirror of
https://github.com/PDP-10/its.git
synced 2026-03-26 02:05:51 +00:00
Add replacements for the RSUBRs defined in TELL.
At present we only have the Muddle interpreter, so we can't assemble the functions in TELL. TELMID translates some of these to MIDAS, and TELMDL either implements or stubs out the rest using Muddle. The READST replacement uses READSTRING, which expects input to be terminated by ALTMODE. It works, but it's not very convenient!
This commit is contained in:
Adam Sampson
53
src/lcf/telmdl.1
Normal file
53
src/lcf/telmdl.1
Normal file
@@ -0,0 +1,53 @@
|
||||
;"-*-Muddle-*-"
|
||||
;"Muddle replacements for some of the RSUBRs in TELL.
|
||||
These were largely inspired by the implementations in the Confusion
|
||||
Muddle interpreter (ported back to Muddle 56)."
|
||||
|
||||
<DEFINE TELL (S1 "OPTIONAL" (F1 ,POST-CRLF) S2 S3)
|
||||
#DECL ((S1) <PRIMTYPE STRING> (F1) FIX (S2 S3) <OR STRING FALSE>)
|
||||
<AND <NOT <0? <CHTYPE <ANDB .F1 ,PRE-CRLF> FIX>>> <CRLF>>
|
||||
<PRINTSTRING .S1 .OUTCHAN>
|
||||
; "warn if <CHTYPE <GETBITS .F1 <BITS 18 18>> FIX> != 0?"
|
||||
<AND <ASSIGNED? S2> <PRINTSTRING .S2 .OUTCHAN>>
|
||||
<AND <ASSIGNED? S3> <PRINTSTRING .S3 .OUTCHAN>>
|
||||
<AND <NOT <0? <CHTYPE <ANDB .F1 ,POST-CRLF> FIX>>> <CRLF>>
|
||||
<SETG TELL-FLAG T>>
|
||||
|
||||
<DEFINE CTRL-S () <>>
|
||||
|
||||
;"DSKDATE - in TELMID"
|
||||
;"GXUNAME - not needed on Muddle 56"
|
||||
;"GET-NAME - not needed on ITS"
|
||||
|
||||
<DEFINE STARTER () 1>
|
||||
|
||||
;"GETSYS - not needed on ITS"
|
||||
;"ATMFIX - in TELMID"
|
||||
;"FIXSTR - in TELMID"
|
||||
|
||||
<DEFINE DISPATCH (NO "OPT" OV)
|
||||
<COND (<TYPE? .NO FUNCTION SUBR>
|
||||
<COND (<AND <ASSIGNED? OV> .OV> <APPLY .NO .OV>)
|
||||
(ELSE <APPLY .NO >)>)
|
||||
(ELSE <ERROR "Wrong dispatch type" <TYPE .NO> .NO>)>>
|
||||
|
||||
<PSETG READER-STRING <STRING <ASCII 27> <ASCII 13> <ASCII 10>>>
|
||||
<DEFINE READST (INBUF PROMPT ALT "AUX" S)
|
||||
<PRINC .PROMPT>
|
||||
<PRINC !\ >
|
||||
<RESET ,INCHAN>
|
||||
<SET S <READSTRING .INBUF ,INCHAN ,READER-STRING>>
|
||||
<TERPRI>
|
||||
;<SUBSTRUC "open mailbox" 0 12 .INBUF>
|
||||
;<SET S 12>
|
||||
.S>
|
||||
;<SETG SCRIPT-CHANNEL <>>
|
||||
|
||||
<DEFINE TTY-INIT (ARG) T>
|
||||
|
||||
<DEFINE TTY-UNINIT () T>
|
||||
|
||||
<DEFINE EXCRUCIATINGLY-UNTASTEFUL-CODE () <>>
|
||||
|
||||
;"STRINGP - in TELMID"
|
||||
;"PSTRING - in TELMID"
|
||||
249
src/lcf/telmid.1
Normal file
249
src/lcf/telmid.1
Normal file
@@ -0,0 +1,249 @@
|
||||
;-*-MIDAS-*- (73)
|
||||
;MIDAS translations of some of the RSUBRs in TELL.
|
||||
;This compiles to a program that writes out a TELMID BINARY file with
|
||||
;the RSUBR definitions.
|
||||
|
||||
;Muddle's AC definitions
|
||||
O=0
|
||||
A=1 ;A/B used as return value of subroutine
|
||||
B=2
|
||||
C=3
|
||||
D=4
|
||||
E=5
|
||||
PVP=6
|
||||
TVP=7
|
||||
SP=10
|
||||
AB=11 ;pointer to args of current subroutine
|
||||
TB=12 ;pointer to frame of current subroutine
|
||||
TP=13 ;current process's stack pointer
|
||||
FRM=14 ;internal frame pointer
|
||||
M=15 ;RSUBR code vector base
|
||||
R=16 ;RSUBR reference vector base
|
||||
P=17 ;interpreter stack pointer
|
||||
|
||||
PDLLEN==100
|
||||
PDL: BLOCK PDLLEN
|
||||
|
||||
OUTCH==1
|
||||
|
||||
;XXX Get these symbols from SQUOZE TAB
|
||||
GLOTOP=1574
|
||||
FINIS==703144 ;return type word in A, value in B
|
||||
MPOPJ==762661 ;SUBM M,(P) ? POPJ P,
|
||||
|
||||
DEFINE RSUBR NAME,(DECL,REFS)\CBEGIN,CEND
|
||||
MOVE C,[-<CEND-CBEGIN>,,CBEGIN]
|
||||
MOVEI D,[ASCIZ /NAME/]
|
||||
MOVEI E,[ASCIZ /DECL/]
|
||||
MOVEI R,[ASCIZ /REFS/]
|
||||
PUSHJ P,OUTDEF
|
||||
JRST CEND
|
||||
CBEGIN!:
|
||||
|
||||
DEFINE ENDRS
|
||||
CEND!:
|
||||
TERMIN
|
||||
|
||||
DEFINE MREL LABEL
|
||||
LABEL-CBEGIN(M)!TERMIN
|
||||
|
||||
TERMIN
|
||||
|
||||
OPNBLK: SETZ
|
||||
SIXBIT /OPEN/
|
||||
[.UAO,,OUTCH]
|
||||
[SIXBIT /DSK/]
|
||||
[.IFNM1]
|
||||
SETZ [SIXBIT /BINARY/]
|
||||
|
||||
START: MOVE P,[-PDLLEN,,PDL-1]
|
||||
.CALL OPNBLK
|
||||
.LOSE
|
||||
|
||||
MOVEI A,[ASCIZ /<NEWTYPE PSTRING WORD>
|
||||
/]
|
||||
PUSHJ P,OUTSTR
|
||||
|
||||
;XXX TELL
|
||||
;XXX CTRL-S
|
||||
|
||||
RSUBR DSKDATE,"VALUE" WORD,<TYPE-W WORD>
|
||||
.CALL MREL RQDATE
|
||||
SETO B
|
||||
MOVE A,7(R) ;value from <TYPE-W WORD>
|
||||
JRST FINIS
|
||||
|
||||
RQDATE: SETZ
|
||||
SIXBIT /RQDATE/
|
||||
SETZM B
|
||||
ENDRS
|
||||
|
||||
;(Don't need GXUNAME: it's a builtin with Muddle 56)
|
||||
;(Don't need GET-NAME: Tenex only)
|
||||
;XXX STARTER
|
||||
;(Don't need GETSYS: Tenex only)
|
||||
|
||||
RSUBR ATMFIX,"VALUE" FIX <OR ATOM PSTRING>,<TYPE-W FIX> <TYPE-C ATOM> <RGLOC SRUNM T>
|
||||
PUSH TP,(AB)
|
||||
PUSH TP,1(AB)
|
||||
MOVE A,7(R) ;<TYPE-W FIX>
|
||||
MOVE B,(TP)
|
||||
LDB O,MREL GETYP ;as in GETYP macro
|
||||
CAMN O,11(R) ;<TYPE-C ATOM> - is it ATOM?
|
||||
MOVE B,3(B) ; yes, get first words of its pname
|
||||
MOVE D,MREL MAGIC1
|
||||
AND D,B
|
||||
LSH D,-1
|
||||
TDO B,D
|
||||
MOVE C,13(R) ;<RGLOC SRUNM T>
|
||||
ADD C,GLOTOP+1
|
||||
MOVE C,1(C)
|
||||
MOVE C,1(C)
|
||||
XOR B,C
|
||||
SUB TP,MREL TUTU1
|
||||
JRST FINIS
|
||||
|
||||
GETYP: 221500,,-1(TP)
|
||||
MAGIC1: 402010040200
|
||||
TUTU1: 2,,2
|
||||
ENDRS
|
||||
|
||||
RSUBR FIXSTR,"VALUE" STRING FIX,<RGLOC SAVSTR T> <RGLOC SRUNM T> <TYPE-W FALSE>
|
||||
.VALUE
|
||||
PUSH TP,(AB)
|
||||
PUSH TP,1(AB)
|
||||
MOVE B,7(R) ;<RGLOC SAVSTR T>
|
||||
ADD B,GLOTOP+1
|
||||
MOVE A,(B)
|
||||
MOVE B,1(B)
|
||||
SKIPN C,(TP)
|
||||
JRST MREL FIXFLS
|
||||
MOVE D,11(R) ;<RGLOC SRUNM T>
|
||||
ADD D,GLOTOP+1
|
||||
MOVE D,1(D)
|
||||
XOR C,1(D)
|
||||
MOVE D,MREL MAGIC2
|
||||
AND D,C
|
||||
LSH D,-1
|
||||
TDZ C,D
|
||||
MOVEM C,1(B)
|
||||
FIXOUT: SUB TP,MREL TUTU2
|
||||
JRST FINIS
|
||||
|
||||
FIXFLS: MOVE A,13(R) ;<TYPE-W FALSE>
|
||||
SETZ B
|
||||
JRST MREL FIXOUT
|
||||
|
||||
MAGIC2: 402010040200
|
||||
TUTU2: 2,,2
|
||||
ENDRS
|
||||
|
||||
;XXX DISPATCH
|
||||
;XXX READST
|
||||
;XXX TTY-INIT
|
||||
;XXX TTY-UNINIT
|
||||
;XXX EXCRUCIATINGLY-UNTASTEFUL-CODE
|
||||
|
||||
RSUBR STRINGP,"VALUE" STRING <PRIMTYPE WORD>,<TYPE-W STRING> <RGLOC PPSTRING T>
|
||||
PUSH TP,(AB)
|
||||
PUSH TP,1(AB)
|
||||
MOVE A,7(R) ;<TYPE-W STRING>
|
||||
MOVE B,11(R) ;<RGLOC PPSTRING T>
|
||||
ADD B,GLOTOP+1
|
||||
MOVE B,1(B)
|
||||
MOVE C,(TP)
|
||||
MOVE D,MREL STRPBP
|
||||
SETZ E,
|
||||
STRPLP: ILDB D
|
||||
JUMPE MREL STRPGO
|
||||
CAIN E,5
|
||||
JRST MREL STRPGO
|
||||
AOJA E,MREL STRPLP
|
||||
|
||||
STRPGO: HRR A,E
|
||||
MOVEM C,1(B)
|
||||
SUB TP,MREL TUTU3
|
||||
JRST FINIS
|
||||
|
||||
STRPBP: 440700,,C
|
||||
TUTU3: 2,,2
|
||||
ENDRS
|
||||
|
||||
RSUBR PSTRING,"VALUE" PSTRING STRING,<TYPE-W PSTRING>
|
||||
PUSH TP,(AB)
|
||||
PUSH TP,1(AB)
|
||||
MOVE A,(TP)
|
||||
HLRZ C,A
|
||||
CAIN C,10700
|
||||
JRST MREL PSTR1
|
||||
MOVE B,(A)
|
||||
HRRZ C,-1(TP)
|
||||
SUBI C,5
|
||||
MOVNS C
|
||||
IMULI C,7
|
||||
LSH B,(C)
|
||||
CAIA
|
||||
PSTR1: MOVE B,1(A)
|
||||
MOVE A,7(R) ;<TYPE-W PSTRING>
|
||||
SUB TP,MREL TUTU4
|
||||
JRST FINIS
|
||||
|
||||
TUTU4: 2,,2
|
||||
ENDRS
|
||||
|
||||
.CLOSE OUTCH,
|
||||
.LOGOUT 1,
|
||||
|
||||
;Output RSUBR definition
|
||||
;C has AOBJN pointer to code, D has name, E has decl, R has additional refs
|
||||
OUTDEF: MOVEI A,[ASCIZ /<SETG /]
|
||||
PUSHJ P,OUTSTR
|
||||
MOVE A,D
|
||||
PUSHJ P,OUTSTR
|
||||
MOVEI A,[ASCIZ / <RSUBR [#CODE ![ /]
|
||||
PUSHJ P,OUTSTR
|
||||
LOOP: .IOT OUTCH,["*]
|
||||
MOVE A,(C)
|
||||
PUSHJ P,OUTOCT
|
||||
.IOT OUTCH,["*]
|
||||
.IOT OUTCH,[" ]
|
||||
AOBJN C,LOOP
|
||||
MOVEI A,[ASCIZ /!] /]
|
||||
PUSHJ P,OUTSTR
|
||||
MOVE A,D
|
||||
PUSHJ P,OUTSTR
|
||||
MOVEI A,[ASCIZ / #DECL (/]
|
||||
PUSHJ P,OUTSTR
|
||||
MOVE A,E
|
||||
PUSHJ P,OUTSTR
|
||||
MOVEI A,[ASCIZ /) /]
|
||||
PUSHJ P,OUTSTR
|
||||
MOVE A,R
|
||||
PUSHJ P,OUTSTR
|
||||
MOVEI A,[ASCIZ /]>>
|
||||
/]
|
||||
PUSHJ P,OUTSTR
|
||||
POPJ P,
|
||||
|
||||
;Output ASCIZ string in A
|
||||
OUTSTR: HRLI A,440700
|
||||
OUTST1: ILDB B,A
|
||||
JUMPE B,CPOPJ
|
||||
.IOT OUTCH,B
|
||||
JRST OUTST1
|
||||
|
||||
;Output octal number in A
|
||||
OUTOCT: PUSH P,A
|
||||
LSH A,-3
|
||||
SKIPE A
|
||||
PUSHJ P,OUTOCT
|
||||
MOVE A,(P)
|
||||
ANDI A,7
|
||||
ADDI A,"0
|
||||
.IOT OUTCH,A
|
||||
POP P,A
|
||||
CPOPJ: POPJ P,
|
||||
|
||||
;CONSTANTS
|
||||
|
||||
END START
|
||||
Reference in New Issue
Block a user