*
*
*
*     UNARY AND BUILT IN FUNCTION ACTION ROUTINES
*
*  ALL EXPECT DE= # DE
*
*
*     UNARY NEGATE
*
FNEG LDAX D
 ORA A
 RZ .  ITS ZERO
 DCX D  POINT TO SIGN
 LDAX D  GET SIGN
 XRI 1  FLIP BIT 0
FNEG3 STAX D
 RET
*
*
*  RETURN ABSOLUTE VALUE OF ARG
*
FABS DCX D
 XRA A
 STAX D
 RET
*
*
*  RETURN: -1 IFF ARG < 0
*           0 IFF ARG = 0
*           1 IFF ARG > 0
*
FSGN LDAX D
 ORA A
 RZ .  IF ZERO RETURN ZERO
 DCX D
 LDAX D
 ORA A
 INX D
 LXI H,FPONE
 JZ VCOPY  RETURN A 1
 LXI H,FPNONE
 JMP VCOPY  RETURN -1
*
*
*    CALL AN ASSEMBLY LANGUAGE ROUTINE
*
FCALL CALL EATL0
 CALL PFIXE
 PUSH D
 CALL SCOMA
 JNZ ACAL1
 CALL PFIXE  COLLECT THE OPTIONAL ARGUMENT WHICH GOES IN D
*
ACAL1 LXI H,ACAL2
 XTHL
 PCHL
ACAL2 CALL FLOAT
ACAL3 CALL EATRP
 JMP EXPR2
*
*
*  STRING LENGTH
*
FLEN CALL EATL0  (
 CALL VAR
 JNZ TYERR
 XCHG .  LEN TO DE
 JMP ACAL2  GO RETURN THE VALUE IN DE
*
*
*  CONVERT CHARACTER TO ITS ASCII VALUE
*
FASC CALL EATL0
*
 LHLD TSTKA  GET STRING EXPRESSION
 PUSH H
 CALL SEXPG
 POP D
 XCHG
 SHLD TSTKA  POP STRING OFF
*
 MOV A,D
 ORA E
 JZ OBERR  STRING HAD 0 CHARS
 MOV L,M  FIRST CHAR OF STRING
 MVI H,0
 JMP ACAL2  FLOAT THE ASC CHARACTER AND RETURN
*
*
*   INT FUNCTION ACTION ROUTINE
*
FINT LDAX D
 SUI 81H  SUBTRACT EXPONENT BIAS
 MVI B,-FPSIZ*2
 JM FINT3  LESS THAN ONE, MAKE ZERO
*
*  EXP => 1
*
 SUI FPNIB-1
 RNC .  RETURN IF ALREADY INTEGER
 MOV B,A
 DCX D
*
FINT2 DCX D
 LDAX D
 ANI 0F0H  HIGH NIBBLE GONE
 STAX D
 INR B
 RZ
*
FINT3 XRA A
 STAX D
 INR B
 JNZ FINT2
 RET
*
*   INPUT FROM A I/O PORT
*
FINP CALL PFIX
 MVI A,333Q  OUT OPCODE
 CALL OSET
 CALL OBUF
 MOV L,A
AINP1 MVI H,0
 JMP FLOAT
*
*
*   RETURNS THE AMOUNT OF FREE SPACE
*
FFREE CALL PFIX
 MOV A,D
 ORA E
 JNZ OBERR
 LHLD STA
 XCHG
 LHLD TSTKA
 CALL DSUB
 JMP FLOAT  PUTS THE VALUE ON STACK AND RETURNS
*
*
*  RETURNS THE VALUE AT MEMORY LOCATION
*  POINTED TO BY DE
*
FEXAM CALL PFIX
 XCHG
 MOV L,M
 JMP AINP1
*
*
*    PRINTER HEAD POSITION
*
FPOS CALL PFIX
 MOV A,D
 ORA E
 JNZ OBERR
 LDA PHEAD
 MOV L,A
 JMP AINP1
*
*
*  RETURNS THE VALUE OF THE STRING
*
FVAL CALL EATL0
 LXI H,WMAX-1  THIS IS THE MAXIMUM SIZED VALUE WE CAN USE
 SHLD STRMX  THIS MUST BE SET UP FOR STASS
 LXI H,OBUF  WE ARE GOING TO HAVE STASS STORE THE STRING I
 XRA A  TO SET Z AND PERMIT EXPRESSIONS AT STASS
 STC .  MAKE STASS THINK IT IS STORING INTO A SUBSTRING
 CALL STASS
 MVI A,CR  PUT CR AFTER LAST CHAR OF STRING IN CASE TERMIN
 STAX B
*
*  NOW STRING IS AT OBUF
*
 LXI H,FPSINK
 LXI D,OBUF
*
FVAL0 CALL FPIN
 JC CCERR  CAN'T CONVERT ERROR
 LXI H,FPSINK
 CALL PSHAS
 JMP ACAL3
*
*
*
*     EOF FUNCTION
*       RETURNS: 0  NO SUCH FILE OPEN
*                1  LAST WAS OPEN FILE
*                2  LAST WAS READ
*                3  LAST WAS WRITE
*                4  LAST WAS REWIND
*                5  LAST WAS EOR (ONLY ON PTDOS)
*                6  LAST WAS EOF
*
FEOF CALL PFIX  FIX THE ARGUMENT TO DE
 CALL OPEEOF  GET FCB FOR THIS FILE
 MVI L,0
 JNZ AINP1  NO FCB, ZERO
 LDA CEOF
 MOV L,A
 JMP AINP1
*
*
*
*     TYP     RETURNS:
*                1  NEXT DATA ITEM IS A NUMBER
*                2  NEXT DATA ITEM IS A STRING
*                3  THERE ARE NO MORE DATA ITEMS TO READ
*
FTYP LDAX D
 ORA A
 JNZ OBERR  ARG MUST BE ZERO
 CALL POPFP  GET RID OF IT
*
 LHLD RTXA  REMEMBER THE OLD RTXA
 PUSH H
 CALL XTXA
*
 CALL SCOMA  A COMMA?
 JNC FTYP2  YES
*
 LXI B,DATARW*256+DATARW  FIND NEXT DATA STATEMENT
 CALL LSTAT
 LXI H,3  OUT OF DATA IF CARRY
 JC FTYP3
*
FTYP2 MVI A,'"'
 CALL SCANC
 LXI H,1  IF NO QUOTE THEN A NUMBER
 JC FTYP3
 INX H  ELSE A STRING
*
FTYP3 CALL XTXA
 CALL FLOAT  FLOAT(HL) TO TOS
 POP H  OLD RTXA
 SHLD RTXA
 RET .  ALL DONE
*
*
*     SYST    A MISC FUNCTION
*      0      RETURN PTDOS ERROR NUMBER
*
FSYST CALL PFIX  FIX ARG TO DE
 MOV A,D
 ORA A
 JNZ OBERR  TOO BIG
 ORA E
 JNZ OBERR  AT THIS TIME THERE IS ONLY ONE--0
*
*  SYST(0)
*
 LDA DKERC  GET THE LAST ERROR
 MOV L,A
 JMP AINP1  RETURN IT
*
*