|
DataMuseum.dkPresents historical artifacts from the history of: Jet Computer Jet80 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Jet Computer Jet80 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7296 (0x1c80)
Types: TextFile
Names: »FCTMAC.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
└─ ⟦this⟧ »FCTMAC.SRC«
EXT ILODV,ILODV1,ILODV2,ILOD1,ILOD11,ILOD12,ILOD2,ILOD21,ILOD22 EXT FSUB,XADDR,YADDR,FADD,ENTRSC,ENTER,EXITF,FPEQ,SEQUL,IEQUL EXT FPNEQ,SNE,INE,FPLTE,SLE,ILE,FPLT,SLT,ILT,FPGTE,SGE,IGE EXT FPGT,SGT,IGT,FDIVD,FMULT,IMULT,QMULT,IMOD,PSTAT,FOUT EXT CVTFLT,FLTERR,DIVERR,MLTERR IF NOT $FXDCVT EXT FXDCVT ENDIF ; ; MLOAD: MACRO WHERE,VALUE ;;DO A MINIMUM LENGTH LOAD FOR ILOD1, ILOD2.... IF VALUE ;;CHECK FOR A NON-ZERO VALUE IF VALUE&0FF00H ;;CHECK FOR A VALUE > 255 LXI B,VALUE ;;LOAD THE VALUE CALL WHERE!2 ;;GO TO THE ROUTINE ELSE MVI C,VALUE ;;LOAD ONLY THE LOW BYTE CALL WHERE!1 ;;GO TO THE ROUTINE ENDIF ELSE CALL WHERE ;;GO TO THE ROUTINE AND LOAD A ZERO ENDIF ENDMAC ; ; ILOD: MACRO Q,SIZE,OFST ;;INDIRECT LOAD (FOR CALL BY REF VARS IF SIZE&8000H ;;NEGATIVE SIZE MLOAD ILODV,OFST ;;LOAD AND GO ELSE ;;VARIABLE SIZE IS KNOWN IF SIZE-1 ;;IF VARIABLE SIZE IS NOT 1 MLOAD ILOD2,OFST ;;LOAD AND GO ELSE ;;DO VARS WITH A SIZE OF 1 MLOAD ILOD1,OFST ;;LOAD AND GO ENDIF ENDIF ENDMAC ;;END OF ILOD ; ; ; ADDR: MACRO Q ;;CALCULATE ADDRESS USING SPECIFIED REG TEMP SET 'Q'-'IY' IF 'Q'-'Y'*TEMP ;;DEFAULT IS X-REG CALL XADDR ;;CALL ROUTINE TO DO IT ELSE CALL YADDR ;;OTHERWISE USE Y-REG ENDIF ENDMAC ; ; DSUB: MACRO Q,SIZE IF 0!SIZE&8000H ;;CHECK FOR FLOATING POINT SUBTRACTION CALL FSUB IF F ;;CHECK FOR ERROR IF REQUIRED JC FLTERR ENDIF ELSE ;;SUBTRACT Q OR DE FROM HL XRA A ;;CLEAR CARRY DSBC Q D ;;SUBTRACT IT ENDIF ENDMAC ;;DONE ; ; DADD MACRO Q,SIZE IF 0!SIZE&8000H ;;CHECK FOR FLOATING POINT ADD CALL FADD IF F ;;CHECK FOR ERROR IF REQUIRED JC FLTERR ENDIF ELSE DAD Q D ;;ADD Q OR DE TO HL ENDIF ENDMAC ; ; ; ; ENTR: MACRO Q,LVL,VSIZ ;;ENTER A PROC/FCT ON LVL WITH VSIZ VARS IF LVL-1 ;;CHECK FOR INNER LEVELS MVI B,LVL ;;SAVE LEVEL NUMBER LXI D,1-VSIZ ;;SAVE VSIZ BYTES OF STACK IF S ;;DO STACK CHECKING CALL ENTRSC ;;ENTER WITH STACK CHEKING ELSE CALL ENTER ;;A SUBROUTNE WILL FINISH ENDIF ELSE ;;LEVEL 1 LXI H,1-VSIZ ;;SET UP STACK POINTER DAD S SPHL ;; LABEL TO JUMP TO FOR A CHAINED PROGRAM CHAIN$: EXX LXI H,LAST ;;INDICATE TOP OF HEAP EXX LXI H,0 ;;CHECK FOR A STACK OVERFLOW DAD S LXI D,LAST+MARGIN ;;DO STACK CHECKING FOR LEVEL 1 DSUB D ;;SUBTRACT DE FROM HL JC STKERR ;;OVERFLOW!! ENDIF ENDMAC ;;ALL ENTERED ; ; EXIT: MACRO Q,SSIZ ;;EXIT FROM A PROC/FCT LXI H,SSIZ+8 ;;GET NUMBER OF STACK BYTES JMP EXITF ;;FINISH UP IN A SUBROUTINE ENDMAC ; ; ; EQUL: MACRO Q,SIZE ;;EQUALITY TEST IF SIZE ;;TEST FOR STRUCTURED RELOP IF SIZE&8000H ;;CHECK FOR FP OPERATION CALL FPEQ ;;YES, DO FP OP ELSE LXI B,SIZE ;;SAVE VAR SIZE CALL SEQUL ENDIF ELSE CALL IEQUL ;;INTEGER TEST ENDIF ENDMAC ; ; ; LE: MACRO Q,SIZE ;;LESS THAN OR EQUAL TEST IF SIZE ;;TEST FOR STRUCTURED RELOP IF SIZE&8000H ;;CHECK FOR FP OPERATION CALL FPLTE ;;YES, DO FP OP ELSE LXI B,SIZE ;;SAVE VAR SIZE CALL SLE ENDIF ELSE CALL ILE ;;INTEGER TEST ENDIF ENDMAC ; ; LESS: MACRO Q,SIZE ;;LESS THAN TEST IF SIZE ;;TEST FOR STRUCTURED RELOP IF SIZE&8000H ;;CHECK FOR FP OPERATION CALL FPLT ;;YES, DO FP OP ELSE LXI B,SIZE ;;SAVE VAR SIZE CALL SLT ENDIF ELSE CALL ILT ;;INTEGER TEST ENDIF ENDMAC ; ; GE: MACRO Q,SIZE ;;GREATER THAN OR EQUAL TO TEST IF SIZE ;;TEST FOR STRUCTURED RELOP IF SIZE&8000H ;;CHECK FOR FP OPERATION CALL FPGTE ;;YES, DO FP OP ELSE LXI B,SIZE ;;SAVE VAR SIZE CALL SGE ENDIF ELSE CALL IGE ;;INTEGER TEST ENDIF ENDMAC ; ; GRET: MACRO Q,SIZE ;;GREATER THAN TEST IF SIZE ;;TEST FOR STRUCTURED RELOP IF SIZE&8000H ;;CHECK FOR FP OPERATION CALL FPGT ;;YES, DO FP OP ELSE LXI B,SIZE ;;SAVE VAR SIZE CALL SGT ENDIF ELSE CALL IGT ;;INTEGER TEST ENDIF ENDMAC ; ; MULT: MACRO Q,SIZE ;;CALL MULTIPLY ROUTINE IF 0!SIZE&8000H ;;CHECK FOR FLOATING POINT OPERATION CALL FMULT IF F ;;CHECK FOR ERROR IF REQUIRED JC MLTERR ENDIF ELSE IF M ;;CHECK FOR OVERFLOW CALL IMULT ELSE ;;USE FAST ROUTINE CALL QMULT ENDIF ENDIF ENDMAC ; ; NEGT: MACRO REG ;;NEGATE SPECIFIED REGISTER PAIR IF 'REG'-'H' ;;DO DE PAIR OR FLOAT IF 'REG'-'D' ;;DO FLOAT NUMBER POP H ;;GET LOW WORD POP D ;;GET HIGH WORD MVI A,80H ;;SET HIGH BIT XRA E ;;TOGGLE HIGH BIT OF E MOV E,A ;;REPLACE HIGH WORD OF MANTISSA PUSH D ;;RESTORE HIGH WORD PUSH H ;;RESTORE LOW WORD ELSE ;;DO DE PAIR MOV A,E CMA ;;COMPLEMENT LOW BYTE MOV E,A MOV A,REG CMA ;;COMPLEMENT HIGH BYTE MOV REG,A INX REG ;;AND INCREMENT ENDIF ELSE MOV A,L CMA ;;COMPLEMENT LOW BYTE MOV L,A MOV A,REG CMA ;;COMPLEMENT HIGH BYTE MOV REG,A INX REG ;;AND INCREMENT ENDIF XRA A ;;CLEAR ACCUMULATOR ENDMAC ; ; FDVD: MACRO Q,SIZE ;;FLOATING POINT DIVISION CALL FDIVD IF F ;;CHECK FOR ERROR IF REQUIRED JC DIVERR ENDIF ENDMAC ; ; ; convert an integer to floating point, or fp to ASCII ; cvtf: macro where,value ;;where is the argument and what is it? ;; ;; A -> process immediate argument and push ;; ;; B -> process top of stack ;; ;; C -> process 2nd on stack ;; ;; D -> process # in de ;; ;; H -> process # in hl ;; ;; S -> convert top of stack to a string if 'A'-'where' ;;check for NOT A if 'B'-'where' ;;check for NOT B if 'C'-'where' ;;check for not C if 'D'-'where' ;;check for not D if 'H'-'where' ;;check for not H ;; ;;process option S if value-4 ;;should we attempt to convert to fixed pt mov a,l ;;yes, first save fraction length pop b pop d ;;get fp number pop h ;;get field info mov h,a ;;save fraction length push h ;;restore stack push d push b xra a ;;clear acc call fout ;;convert to form ' sx.xxxxxxesxx' lxi h,13 ;;point to top of string dad s push h ;;save the parameter call fxdcvt ;;try to convert to fixed point else ;;otherwise simply print the string call fout ;;process fp -> ascii string endif else ;;process option H call cvtflt ;;process # in hl endif else ;;process option D xchg ;;put # in hl call cvtflt ;;process # in hl endif else ;;process option C pop b ;;get top of stack in bc, de pop d pop h ;;get integer in hl push d ;;save float # on stack push b call cvtflt ;;convert hl -> float xcfp ;;...and exchange op1 & op2 endif else ;;process option B pop h ;;get 2's complement value call cvtflt ;;call routine to convert # in hl endif else ;;process option A lxi h,value ;;get 16 bit value call cvtflt ;;convert to float, and done!! endif endmac ; ; MMOD: MACRO ;;CALL MOD ROUTINE CALL IMOD IF M ;;CHECK FOR OVERFLOW JC DIVERR ENDIF ENDMAC ; NEQL: MACRO Q,SIZE ;;NON-EQUALITY TEST IF SIZE ;;TEST FOR STRUCTURED RELOP IF SIZE&8000H ;;CHECK FOR FP OPERATION CALL FPNEQ ;;YES, DO FP OP ELSE LXI B,SIZE ;;SAVE VAR SIZE CALL SNE ENDIF ELSE CALL INE ;;INTEGER TEST ENDIF ENDMAC ; dsb1 macro reg xra a dsbc reg d endmac cmpi macro q,value cpi value endmac «eof»