From d719f6d41a078733af1c363bf8e909a1d4f6f439 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Sat, 29 Aug 2020 03:56:38 +0100 Subject: [PATCH] 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! --- src/lcf/telmdl.1 | 53 ++++++++++ src/lcf/telmid.1 | 249 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 302 insertions(+) create mode 100644 src/lcf/telmdl.1 create mode 100644 src/lcf/telmid.1 diff --git a/src/lcf/telmdl.1 b/src/lcf/telmdl.1 new file mode 100644 index 00000000..84b46716 --- /dev/null +++ b/src/lcf/telmdl.1 @@ -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)." + + (F1) FIX (S2 S3) ) + FIX>>> > + + ; "warn if > FIX> != 0?" + > + > + FIX>>> > + > + +> + +;"DSKDATE - in TELMID" +;"GXUNAME - not needed on Muddle 56" +;"GET-NAME - not needed on ITS" + + + +;"GETSYS - not needed on ITS" +;"ATMFIX - in TELMID" +;"FIXSTR - in TELMID" + + + .OV> ) + (ELSE )>) + (ELSE .NO>)>> + + >> + + + + > + + ; + ; + .S> +;> + + + + + +> + +;"STRINGP - in TELMID" +;"PSTRING - in TELMID" diff --git a/src/lcf/telmid.1 b/src/lcf/telmid.1 new file mode 100644 index 00000000..33bdd094 --- /dev/null +++ b/src/lcf/telmid.1 @@ -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,[-,,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 / +/] + PUSHJ P,OUTSTR + +;XXX TELL +;XXX CTRL-S + +RSUBR DSKDATE,"VALUE" WORD, + .CALL MREL RQDATE + SETO B + MOVE A,7(R) ;value from + 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 , + PUSH TP,(AB) + PUSH TP,1(AB) + MOVE A,7(R) ; + MOVE B,(TP) + LDB O,MREL GETYP ;as in GETYP macro + CAMN O,11(R) ; - 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) ; + 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, + .VALUE + PUSH TP,(AB) + PUSH TP,1(AB) + MOVE B,7(R) ; + ADD B,GLOTOP+1 + MOVE A,(B) + MOVE B,1(B) + SKIPN C,(TP) + JRST MREL FIXFLS + MOVE D,11(R) ; + 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) ; + 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 , + PUSH TP,(AB) + PUSH TP,1(AB) + MOVE A,7(R) ; + MOVE B,11(R) ; + 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, + 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) ; + 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 /> +/] + 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