?PUNCH FOOL:FANT.O
?NOCHECK
?DEBUG
GLOBAL FMEM, FPC, FSP, TMP, TEMP, INLEN, OPD, SEED, OBJ,
       MTSPTR, MTSBEND,
       FSTK#8, OFSTK#8, BUFF#8, APAR#8,
       /* TMP AND APAR ARE EXCLUSIVE TO RUN */
       INSTLEN#68,
       CC#1, OPC#1, ERRFLG#1, TC#1,
       STCHARS#256, MTSBUF#255, LCFLAG#1;

GCONS KINT=1#1, KSTR=2#1, KLST=3#1, KTAB=4#1,
      KPRC=5#1, KPRP=6#1, KAB=7#1, KNULL=8#1,
      PERMSTRG=0#1, TEMPSTRG=1#1,
      PNULL=0, TDEL=-1, E=32#1, S=16#1, Z=8#1, V=4#1, N=2#1, A=1#1,
      HALT='00'#1, ZERO='00'#1, SONE='FF'#1,
      HBIT='80000000', NHBIT='7FFFFFFF', MODLC='00000010';

RECORDS WORD(FTYPE#1, FVALU#3), FSTACK(SADDR, SSIZE),
	INSTR5(OPCDE#1, OPD5#4), INSTR4(OPCDE#1, OPD4#3),
	LIST(NEXT, SVAL), STRING(STAD, STLEN), STTYPE(STYPE#1),
	TABLE(TSIZE, TUSE, TMAX, TTAB), TENTRY(TINDX, TVAL),
	_BYTE(BYTE#1), _HALF(HALF#2), _TQUART(TQUART#3), _WORD(WORD#4),
	_LOAD(KEY#8, ENTRY, LENGTH, DICT), LENG(RL#2,WL#2,AL#2),
	_STACK(STK0, STK1, STK2, STK3);
?EJECT
?CDES
?PUNCH 100
PROC AVAL#0@NSA;
PAR WD@REF;

/* RETURNS REAL POINTER, REAL INT, OR WD DEPENDING ON FTYPE IN WD */

   IFV WD@FTYPE = KINT THEN
       /* INTEGER, SO SIGN EXTEND */
       TEMP@FVALU := WD@FVALU;
       IF WD@FVALU#1 ONES 128 THEN TEMP@FTYPE := SONE
       ELSE TEMP@FTYPE := ZERO FI;
       TEMP
   ELSE IFV WD@FTYPE >= KSTR AND WD@FTYPE <= KPRC THEN
       /* GET AMDAHL ADDRESS */
       WD@FVALUE+FMEM
   ELSE WD
   FI FI
.
?EJECT
?CDES
?PUNCH 200
PROC FVAL#0@NSA;
PAR WD@REF, TYPE#1@REF;

/* TAKES 470 VALUE AND A TYPE CODE AND RETURNS A FWORD */

   IF TYPE = KINT OR TYPE = KPRP THEN
       /* NO OVERFOW CHECK FOR NOW
       CC CLEAR V;
       IF WD@FTYPE ~= 'FF' OR WD@FTYPE ~= '00' THEN
           CC SET V
       FI;
       */
       TEMP@FVALU := WD@FVALU;
       TEMP@FTYPE := TYPE
   ELSE IF TYPE = KSTR AND TYPE <= KTAB THEN
       /* MAKE ADDRESS */
       TEMP := WD - FMEM;
       TEMP@FTYPE := TYPE;
   ELSE
       TEMP@FTYPE := TYPE
   FI FI;
   TEMP
.
?EJECT