2023-11-16 18:19:54 -05:00

135 lines
3.1 KiB
Plaintext

SUBTTL BRANCHES - CONTROL OPERATIONS
PAGE +
PUBLIC OPCALL1
OPCALL1 PROC
MOV ARGBLK,AX ; (A0) PUT ARG IN ARGBLK
MOV AX,1 ; (A0) SET AX TO NUMBER OF ARGS
JMP OPCALL ; (A0) NOW PROCEED NORMALLY
OPCALL1 ENDP
PUBLIC OPCALL,OPXCALL,OPCALL2
;CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), # OF ARGS IN AX
OPCALL PROC
OPXCALL:
OPCALL2:
NOP ;TELL CALLER TO USE ARGUMENT BLOCK
MOV DX,AX ;NUMBER OF ARGUMENTS TO CALL
MOV AX,ARGBLK ;FUNCTION TO CALL
CMP AX,0
JNE OCL1$ ;ZERO?
SUB AX,AX ;YES, SIMPLY RETURN A ZERO
JMP PUTVAL
OCL1$: PUSHZ ZPC1 ;OTHERWISE, SAVE OLD ZPC
PUSHZ ZPC2
MOV CX,ZLOCS ;AND OLD LOCAL POINTER
PUSHZ CX ;AND SAVE IT
CALL BSPLITQ ; (A0) SPLIT FUNCTION POINTER (QUAD)
MOV ZPC1,AX ;MAKE IT THE NEW ZPC
MOV ZPC2,BX
CALL NEWZPC ;UPDATE ZPC STUFF
MOV ZLOCS,DI ;LOCALS WILL START AT NEXT STACK SLOT
SUB ZLOCS,2
CALL NXTBYT ;NUMBER OF LOCALS
MOV BX,AX
MOV BP,OFFSET ARGBLK[2] ;POINT TO FIRST OPTIONAL ARG
OCL2$: DEC BX ;ANY MORE LOCALS?
JL OCL4$ ;NO, WE'RE DONE
CALL NXTWRD ;YES, GET THE NEXT LOCAL DEFAULT VALUE
DEC DX ;ANY MORE OPTIONALS GIVEN?
JLE OCL3$ ;NO
PUSHZ [BP] ;(6) YES, USE ITS VALUE
ADD BP,2
JMP OCL2$ ;AND CONTINUE LOOP
OCL3$: PUSHZ AX ;OTHERWISE, USE DEFAULT
JMP OCL2$ ;AND LOOP
OCL4$: RET
OPCALL ENDP
PUBLIC OPRETU
;RETURN (FROM CURRENT FUNCTION CALL)
OPRETU PROC
MOV DI,ZLOCS ;RESTORE OLD TOP OF STACK
POPZ DX ;DUMMY POP [WHY?]
POPZ ZLOCS ;AND OTHER VALUES
POPZ ZPC2
POPZ ZPC1
CMP ZPC1,1 ; (A0) FAKE BLOCK SET BY OPREAD
JNZ OPRET1 ; (A0) NO, NORMAL RETURN
JMP INRETU ; (A0) FIX ZPC AND RETURN
OPRET1: PUSH AX ;VALUE TO RETURN
CALL NEWZPC ;UPDATE ZPC STUFF
POP AX
JMP PUTVAL ;RETURN THE VALUE
OPRETU ENDP
PUBLIC OPRTRU,OPRFAL,OPJUMP,OPRSTA,OPFSTA,OPNOOP
;RTRUE
OPRTRU PROC
MOV AX,1 ;RETURN A 1
JMP OPRETU
OPRTRU ENDP
;RFALSE
OPRFAL PROC
SUB AX,AX ;RETURN A 0
JMP OPRETU
OPRFAL ENDP
;JUMP (TO A NEW LOCATION)
OPJUMP PROC
ADD ZPC2,AX ;ADD OFFSET TO CURRENT ZPC
SUB ZPC2,2 ;ADJUST IT
CMP ZPC2,200H ;(A16) DID WE CROSS A PAGE BOUNDARY?
JAE OPJMP1 ;(A16) YES, FIX PAGE POINTERS
MOV LSTNGD,0 ; (A16) RESET THE LAST NEXT BYTE
RET ; (A16) NO, GO ONWARD QUICKLY
OPJMP1: JMP NEWZPC ;NORMALIZE IT & UPDATE ZPC STUFF
OPJUMP ENDP
;RSTACK (RETURN STACK)
OPRSTA PROC
POPZ AX ;POP A VALUE
JMP OPRETU ;AND RETURN IT
OPRSTA ENDP
;FSTACK (FLUSH A VALUE OFF THE STACK)
OPFSTA PROC
POPZ DX ;FLUSH ONE
RET
OPFSTA ENDP
;NOOP (NO OPERATION)
OPNOOP PROC
RET ;DO NOTHING
OPNOOP ENDP
PUBLIC INCALL
INCALL PROC
PUSH BX
PUSH CX
PUSH DX
PUSH SI
PUSH ZPC1 ; (A0) SAVE REAL ZPC1
MOV ZPC1,1 ; (A0) FAKE ZPC FOR INTERNAL CALL
MOV ARGBLK,AX ; (A0) SAVE ARGUMENT
MOV AX,1 ; (A0) NUMBER ARGS HERE
CALL OPCALL ; (A0) NOW BLK READY FOR OPCALL
MOV LSTNGD,0 ; (A16) RESET LAST BYTE FLAG
JMP NXTINS ; (A0) GO GET NEXT INSTRUCTION
INCALL ENDP
PUBLIC INRETU
INRETU PROC
ADD SP,2 ; (A0) FLUSH RETURN ADDR FROM NXTINS
POP ZPC1 ; (A0) RESTORE REAL BLOCK
PUSH AX ; (A0) SAVE ARG
CALL NEWZPC ; (A0) GET BLOCK
POP AX ; (A0) RESTORE ARG
POP SI ; (A0) RESTORE STATE
POP DX
POP CX
POP BX
RET ; (A0) GO BACK TO READ
INRETU ENDP