adventure: Initial commit

[pdp8.git] / sw / adventure / PUT.RA

diff --git a/sw/adventure/PUT.RA b/sw/adventure/PUT.RA
new file mode 100644 (file)
index 0000000..143b9bf
--- /dev/null
+++ b/sw/adventure/PUT.RA
@@ -0,0 +1,53 @@
+       SECT    PUT\r
+/       INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL)\r
+/       C\r
+/       C PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE\r
+/       C NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS.\r
+/       C\r
+/       IMPLICIT INTEGER (A-Z)\r
+/       C\r
+\r
+       EXTERN  MOVE\r
+       JA      #ST\r
+#XR,   ORG     .+10\r
+       TEXT    +PUT  +\r
+#RET,  SETX    #XR\r
+       SETB    #BASE\r
+       JA      .+3\r
+#BASE, ORG     .+6\r
+PVAL,  ORG     .+3\r
+M1,    F       -1.0\r
+       ORG     #BASE+30\r
+       FNOP\r
+       JA      #RET\r
+       FNOP\r
+#GOBAK,        0;0\r
+       #LBL=.\r
+       ORG     #LBL\r
+#RTN,  BASE    #BASE\r
+       JA      #GOBAK\r
+#ST,   STARTD\r
+       0210\r
+       FSTA    #GOBAK,0\r
+       0200\r
+       SETX    #XR\r
+       SETB    #BASE\r
+       LDX     0,1\r
+       FSTA    #BASE\r
+       FLDA%   #BASE,1+\r
+       FSTA    #G1\r
+       FLDA%   #BASE,1+\r
+       FSTA    #G2\r
+       FLDA%   #BASE,1+\r
+       FSTA    PVAL\r
+       STARTF\r
+/       CALL MOVE(OBJECT,WHERE)\r
+       JSR     MOVE\r
+       JA      .+6\r
+#G1,   JA      .\r
+#G2,   JA      .\r
+/       PUT=(-1)-PVAL\r
+       FLDA    M1\r
+       FSUB%   PVAL\r
+       JA      #RTN\r
+       END\r